Merge pull request #108 from inbo/author

version 0.3.3

.github/workflows/check_on_branch.yml

@@ -17,4 +17,4 @@ jobs:
     permissions:
       contents: read
     steps:
-      - uses: inbo/actions/check_pkg@checklist-0.3.2
+      - uses: inbo/actions/check_pkg@main

.github/workflows/check_on_main.yml

@@ -19,4 +19,4 @@ jobs:
       GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
       ZENODO_SANDBOX: ${{ secrets.ZENODO_SANDBOX }}
     steps:
-      - uses: inbo/actions/check_pkg@checklist-0.3.2
+      - uses: inbo/actions/check_pkg@main

.github/workflows/release.yml

@@ -19,10 +19,13 @@ jobs:
       - uses: actions/checkout@v3
       - name: Get tag message
         run: |
-          TAG_BODY=$(git tag --contains ${{ github.sha }} -n100 | awk '(NR>1)')
-          echo "::set-output name=TAG_BODY::$TAG_BODY"
+          TAG=$(git tag --contains $(git rev-parse HEAD))
+          TAG_BODY=$(git tag --contains {{ github.sha }} -n100 | awk '(NR>1)')
+          echo "TAG=$TAG" >> $GITHUB_OUTPUT
+          echo "TAG_BODY=$TAG_BODY" >> $GITHUB_OUTPUT
         id: tag-body
       - uses: ncipollo/release-action@v1
         with:
-          name: Release ${{ github.ref }}
+          name: Release ${{ steps.tag-body.outputs.TAG }}
+          tag: ${{ steps.tag-body.outputs.TAG }}
           body: ${{ steps.tag-body.outputs.TAG_BODY }}

.zenodo.json

@@ -1,6 +1,6 @@
 {
   "title": "checklist: A Thorough and Strict Set of Checks for R Packages and Source Code",
-  "version": "0.3.2",
+  "version": "0.3.3",
   "license": "GPL-3.0",
   "upload_type": "software",
   "description": "<p>An opinionated set of rules for R packages and R source code\nprojects.<\/p>",

CITATION.cff

@@ -25,4 +25,4 @@ identifiers:
   value: 10.5281/zenodo.4028303
 - type: url
   value: https://inbo.github.io/checklist/
-version: 0.3.2
+version: 0.3.3

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: checklist
 Title: A Thorough and Strict Set of Checks for R Packages and Source Code
-Version: 0.3.2
+Version: 0.3.3
 Authors@R: c(
     person("Thierry", "Onkelinx", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-8804-4216", affiliation = "Research Institute for Nature and Forest (INBO)")),

NAMESPACE

@@ -31,6 +31,7 @@ export(is_workdir_clean)
 export(menu_first)
 export(new_branch)
 export(orcid2person)
+export(organisation)
 export(prepare_ghpages)
 export(read_checklist)
 export(set_tag)
@@ -43,6 +44,7 @@ export(tidy_desc)
 export(update_citation)
 export(use_author)
 export(validate_email)
+export(validate_orcid)
 export(write_checklist)
 export(write_citation_cff)
 export(write_zenodo_json)

NEWS.md

@@ -1,3 +1,19 @@
+# checklist 0.3.3
+
+* New `organisation()` class to hold the requirements of the organisation.
+  For the time being this is hard-coded to the Research Institute for Nature
+  and Forest (INBO).
+* Author affiliations must match one of the affiliations set in
+  `organisation()`.
+  The membership of an author is determined by their e-mail or their
+  affiliation.
+  This is checked when creating or using author information and when updating
+  citation information.
+* `read_checklist()` looks for `checklist.yml` in parent folders when it can't
+  find it in the provided path.
+* `validate_orcid()` checks the format and the checksum of the ORCID.
+* Add `vignette("folder", package = "checklist")`.
+
 # checklist 0.3.2
 
 * `citation_meta()` gains support for [`bookdown`](https://pkgs.rstudio.com/bookdown/) reports.

R/check_description.R

@@ -287,21 +287,31 @@ Please send a pull request if you need support for this license.",
 #' @importFrom utils person
 check_authors <- function(this_desc) {
   authors <- this_desc$get_authors()
-  inbo <- person(
-    given = "Research Institute for Nature and Forest (INBO)",
-    role = c("cph", "fnd"), email = "[email protected]"
+  org <- organisation$new()
+  stopifnot(
+    "TO DO: handle funder not equal to rightsholder" =
+      org$get_rightsholder == org$get_funder
   )
-  problems <- paste(
-    "`Research Institute for Nature and Forest (INBO)` must be listed as",
-    "copyright holder and funder and use [email protected] as email."
-  )[!inbo %in% authors]
-  authors <- lapply(authors, unlist, recursive = FALSE)
-  authors <- authors[!authors %in% inbo]
-  orcid <- sapply(authors, `[[`, "comment")
-  c(
-    problems,
-    "Every author and contributor must have an ORCID"[
-      any(names(orcid) != "ORCID")
-    ]
+  rightsholder <- person(
+    given = org$get_rightsholder, role = c("cph", "fnd"), email = org$get_email
   )
+  problems <- sprintf(
+    "`%s` must be listed as copyright holder and funder and use `%s` as email.",
+    org$get_rightsholder, org$get_email
+  )[!rightsholder %in% authors]
+  authors <- authors[!authors %in% rightsholder]
+  vapply(
+    authors, FUN.VALUE = vector(mode = "list", length = 1L),
+    FUN = function(author) {
+      email <- format(author, include = "email", braces = list(email = ""))
+      this_org <- org$get_organisation[[gsub(".*@", "", email)]]
+      format(author, include = c("given", "family")) |>
+        sprintf(fmt = "ORCID required for `%s`") -> problem
+      list(
+        problem[isTRUE(this_org$orcid) && !has_name(author$comment, "ORCID")]
+      )
+    }
+  ) |>
+    unlist() |>
+    c(problems)
 }

R/citation_bookdown.R

@@ -121,17 +121,18 @@ yaml_author <- function(yaml) {
     data.frame(contributor = nrow(author) + 1, role = "funder") |>
       rbind(roles) -> roles
     data.frame(
-      id = nrow(author) + 1, given = "", family = yaml$funder, orcid = "",
-      affiliation = ""
+      id = nrow(author) + 1, given = yaml$funder, family = "", orcid = "",
+      affiliation = "", organisation = known_affiliation(yaml$funder)
     ) |>
       rbind(author) -> author
   }
   if (has_name(yaml, "rightsholder")) {
     data.frame(contributor = nrow(author) + 1, role = "copyright holder") |>
       rbind(roles) -> roles
     data.frame(
-      id = nrow(author) + 1, given = "", family = yaml$rightsholder,
-      orcid = "", affiliation = ""
+      id = nrow(author) + 1, given = yaml$rightsholder, family = "",
+      orcid = "", affiliation = "",
+      organisation = known_affiliation(yaml$rightsholder)
     ) |>
       rbind(author) -> author
   }
@@ -144,7 +145,8 @@ yaml_author <- function(yaml) {
 yaml_author_format <- function(person) {
   person_df <- data.frame(
     given = character(0), family = character(0), orcid = character(0),
-    affiliation = character(0), contact = logical(0)
+    affiliation = character(0), contact = logical(0),
+    organisation = character(0)
   )
   if (!is.list(person)) {
     attr(person_df, "errors") <- list("person must be a list")
@@ -170,7 +172,8 @@ yaml_author_format <- function(person) {
     affiliation = paste0(person$affiliation, ""),
     contact = ifelse(
       is.null(person$corresponding), FALSE, person$corresponding
-    )
+    ),
+    organisation = known_affiliation(paste0(person$affiliation, ""))
   )
   c(
     "person `name` element is missing a `given` element"[

R/citation_description.R

@@ -25,7 +25,7 @@ citation_description <- function(meta) {
     upload_type = "software", description = abstract
   ) |>
     c(
-      authors$meta, keywords$meta, communities$meta, urls$meta,
+      authors, keywords$meta, communities$meta, urls$meta,
       access_right = "open"
     ) -> cit_meta
   lang <- descript$get_field("Language", default = "")
@@ -43,7 +43,7 @@ citation_description <- function(meta) {
   list(
     meta = cit_meta,
     errors = c(urls$errors, keywords$errors), warnings = communities$warnings,
-    notes = c(authors$notes, communities$notes)
+    notes = authors$notes
   )
 }
 
@@ -58,31 +58,10 @@ description_author <- function(authors) {
     family = format(authors, include = "family")
   ) |>
     merge(
-      unique(roles[, c("contributor", "orcid", "affiliation")]), by.x = "id",
-      by.y = "contributor"
+      unique(roles[, c("contributor", "orcid", "affiliation", "organisation")]),
+      by.x = "id", by.y = "contributor"
     ) -> contributors
-  contributors[
-    contributors$given == "Research Institute for Nature and Forest (INBO)",
-  ] |>
-    merge(
-      roles[, c("contributor", "role")], by.x = "id", by.y = "contributor"
-    ) -> inbo_roles
-  notes <- c(
-    paste(
-      "`Research Institute for Nature and Forest (INBO)` not listed as",
-      "copyright holder in `DESCRIPTION`."
-    )[!"copyright holder" %in% inbo_roles$role],
-    paste(
-      "`Research Institute for Nature and Forest (INBO)` not listed as funder",
-      "in `DESCRIPTION`."
-    )[!"funder" %in% inbo_roles$role]
-  )
-  list(
-    meta = list(
-      authors = contributors, roles = roles[, c("contributor", "role")]
-    ),
-    notes = notes
-  )
+  list(authors = contributors, roles = roles[, c("contributor", "role")])
 }
 
 description_author_format <- function(i, x) {
@@ -93,6 +72,9 @@ description_author_format <- function(i, x) {
       cph = "copyright holder", fnd = "funder", rev = "reviewer"
     )[x[[i]]$role]
   )
+  formatted$organisation <- ifelse(
+    is.null(x[[i]]), "", gsub(".*@", "", x[[i]]$email)
+  )
   if (is.null(x[[i]]$comment)) {
     formatted$orcid <- ""
     formatted$affiliation <- ""
@@ -104,9 +86,34 @@ description_author_format <- function(i, x) {
   formatted$affiliation <- ifelse(
     is.na(x[[i]]$comment["affiliation"]), "", x[[i]]$comment["affiliation"]
   )
+  if (formatted$organisation[1] == "" && formatted$affiliation[1] != "") {
+    formatted$organisation <- known_affiliation(formatted$affiliation[1])
+  }
   return(list(formatted))
 }
 
+#' @importFrom assertthat assert_that
+known_affiliation <- function(target) {
+  target <- gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", target)
+  org <- organisation$new()$get_organisation
+  vapply(
+    names(org), FUN.VALUE = logical(1), target = target, org = org,
+    FUN = function(x, org, target) {
+      grepl(target, org[[x]]$affiliation) |>
+        any()
+    }
+  ) -> org
+  assert_that(
+    sum(org) < 2,
+    msg = paste(
+      "multiple matching organisations:",
+      paste(names(org)[org], collapse = "; ")
+    )
+  )
+  c(names(org)[org], "") |>
+    head(1)
+}
+
 description_url <- function(urls) {
   urls <- urls[!grepl("https://github.com/", urls)]
   doi_regexp <- "https://doi.org/(.*)"
@@ -146,20 +153,19 @@ description_keywords <- function(keywords) {
 
 description_communities <- function(communities) {
   if (length(communities) == 0) {
+    org <- organisation$new()
     return(
       list(
-        meta = list(), notes = character(0),
+        meta = list(),
         warnings = paste(
           "no communities found in `DESCRIPTION`.",
-          "Please add them with `Config/checklist/communities: inbo; second`"
+          "Please add them with `Config/checklist/communities:",
+          org$get_community
         )
       )
     )
   }
-  communities <- strsplit(communities, "; ")[[1]]
-  notes <-
-    "inbo not listed as community in `DESCRIPTION`"[!"inbo" %in% communities]
   list(
-    meta = list(community = communities), warnings = character(0), notes = notes
+    meta = list(community = communities), warnings = character(0)
   )
 }

R/citation_meta_class.R

@@ -17,7 +17,6 @@ citation_meta <- R6Class(
       assert_that(is.string(path), noNA(path))
       path <- path_real(path)
       assert_that(is_dir(path), msg = "path is not an existing directory")
-
       private$path <- path
       if (is_file(path(path, "_bookdown.yml"))) {
         private$type <- "bookdown"
@@ -40,10 +39,15 @@ citation_meta <- R6Class(
       private$errors <- meta$errors
       private$notes <- meta$notes
       private$warnings <- meta$warnings
+      if (length(private$errors) == 0) {
+        validated <- validate_citation(self)
+        private$errors <- c(private$errors, validated$errors)
+        private$notes <- c(private$notes, validated$notes)
+      }
       if (length(private$errors) > 0) {
         warning(
           "Errors found parsing citation meta data. ",
-          "Citation files not updated."
+          "Citation files not updated.", call. = FALSE, noBreaks. = TRUE
         )
         return(invisible(self))
       }
@@ -160,6 +164,64 @@ citation_print <- function(errors, meta, notes, path, warnings) {
   }
 }
 
+#' @importFrom assertthat assert_that
+validate_citation <- function(meta) {
+  assert_that(inherits(meta, "citation_meta"))
+  org <- organisation$new()
+  roles <- meta$get_meta$roles
+  authors <- meta$get_meta$authors
+  rightsholder_id <- roles$contributor[roles$role == "copyright holder"]
+  funder_id <- roles$contributor[roles$role == "funder"]
+  notes <- c(
+    sprintf("rightsholder differs from `%s`", org$get_rightsholder)[
+      authors$given[authors$id == rightsholder_id] != org$get_rightsholder
+    ],
+    sprintf("funder differs from `%s`", org$get_funder)[
+      authors$given[authors$id == funder_id] != org$get_funder
+    ]
+  )
+  errors <- c(
+    sprintf("invalid ORCID for %s %s", authors$given, authors$family)[
+      !validate_orcid(authors$orcid)
+    ],
+    sprintf("missing required Zenodo community `%s`", org$get_community)[
+      !org$get_community %in% meta$get_meta$community
+    ]
+  )
+  authors <- authors[authors$given != org$get_rightsholder, ]
+  authors <- authors[authors$given != org$get_funder, ]
+  authors <- authors[authors$organisation %in% names(org$get_organisation), ]
+  vapply(
+    seq_along(authors$organisation),
+    FUN.VALUE = vector(mode = "list", length = 1), org = org$get_organisation,
+    FUN = function(i, org) {
+      paste(
+        "Non standard affiliation for %s %s as member of `%s`. ",
+        "Please use any of the following", collapse = ""
+      ) |>
+        sprintf(
+          authors$given[i], authors$family[i], authors$organisation[i]
+        ) -> error
+      error <- error[
+        !authors$affiliation[i] %in% org[[authors$organisation[i]]]$affiliation
+      ]
+      if (org[[authors$organisation[i]]]$orcid) {
+        error <- c(
+          error,
+          sprintf(
+            "No ORCID for %s %s. This is required for `%s`", authors$given[i],
+            authors$family[i], authors$organisation[i]
+          )[is.na(authors$orcid[i]) || authors$orcid[i] == ""]
+        )
+      }
+      return(list(error))
+    }
+  ) |>
+    unlist() |>
+    c(errors) -> errors
+  list(notes = notes, errors = errors)
+}
+
 #' @importFrom assertthat assert_that has_name
 #' @importFrom fs path
 #' @importFrom jsonlite toJSON