Rework R6 classes for better separation of concerns

DESCRIPTION

@@ -30,6 +30,8 @@ Imports:
     yaml (>= 2.3.5)
 Suggests: 
     covr,
+    fontawesome,
+    gt,
     rmarkdown,
     testthat,
     waldo (>= 0.3.0),

NAMESPACE

@@ -28,6 +28,7 @@ importFrom(jsonlite,toJSON)
 importFrom(purrr,iwalk)
 importFrom(purrr,list_assign)
 importFrom(purrr,list_flatten)
+importFrom(purrr,list_modify)
 importFrom(purrr,list_rbind)
 importFrom(purrr,list_transpose)
 importFrom(purrr,map)

NEWS.md

@@ -8,6 +8,14 @@
 
 ## Minor improvements and bug fixes
 
+* R6 classes have been overhauled for a better separation of concerns (#5, #12).
+
+  * `$set_*` methods have been moved to their own classes.
+
+  * `PlumeQuarto` now only does what it is designed for: injecting author metadata into the YAML header of Quarto files. This means that `PlumeQuarto` can no longer generate author information as character strings.
+
+  * `Plume` now drops variables that are `PlumeQuarto`-specific. `Plume`'s constructor also lost the `by` parameter as it was only used in `$set_corresponding_authors()`.
+
 * `$new()` and `plm_template()` gain a new parameter `credit_roles` to facilitate the use of the [Contributor Roles Taxonomy](https://credit.niso.org).
 
 * Fixed issues when pushing metadata to empty YAML headers (#9).

R/aaa.R

@@ -2,7 +2,7 @@
   protected = list(
     crt = list(
       conceptualization = "Conceptualization",
-      curation = "Data curation",
+      data_curation = "Data curation",
       analysis = "Formal analysis",
       funding = "Funding acquisition",
       investigation = "Investigation",

R/name-handler.R

@@ -5,16 +5,22 @@ NameHandler <- R6Class(
   public = list(
     initialize = function(names) {
       check_list(names, allow_duplicates = FALSE)
-      private$names <- names
+      private$keys <- map(names, base::names)
+      private$names <- flatten(names)
     }
   ),
 
   private = list(
+    keys = NULL,
     names = NULL,
 
-    get_names = function(..., use_keys = TRUE) {
+    get_names = function(..., use_keys = FALSE) {
       dots <- c(...)
-      nms <- if (is.list(dots)) unlist(dots) else dots
+      if (length(dots) == 1L && dots %in% names(private$keys)) {
+        nms <- private$keys[[dots]]
+      } else {
+        nms <- dots
+      }
       unlist(private$names[nms], use.names = use_keys)
     },
 

R/plm-template.R

@@ -5,22 +5,32 @@
 #' @param minimal If `TRUE`, returns an empty tibble with the following columns:
 #'   `given_name`, `family_name`, `email`, `orcid`, `affiliation`, `role` and
 #'   `note`. Otherwise the function returns a template with all columns that can
-#'   be supplied to plume classes.
+#'   be supplied to plume classes that are not `PlumeQuarto`-specific.
 #' @param credit_roles Should `r link("crt")` be used?
 #' @return An empty tibble.
 #' @export
 plm_template <- function(minimal = TRUE, credit_roles = FALSE) {
   check_args("bool", list(minimal, credit_roles))
-  vars <- list_assign(default_names, nestable = get_nestables(credit_roles))
-  to_ignore <- vars$internal
-  if (minimal) {
-    to_ignore <- c(to_ignore, "phone", "fax", "url", "dropping_particle", "number")
-  }
-  vars <- flatten(vars)
-  vars <- vars[!vars %in% to_ignore]
+  vars <- get_template_vars(minimal, credit_roles)
   tibble(!!!vars, .rows = 0)
 }
 
+get_template_vars <- function(minimal, credit_roles) {
+  vars <- list_assign(default_names, nestables = get_nestables(credit_roles))
+  to_ignore <- get_ignored_vars(vars, minimal)
+  vars <- flatten(vars)
+  vars[!vars %in% to_ignore]
+}
+
+get_ignored_vars <- function(vars, minimal) {
+  to_ignore <- vars$internals
+  if (!minimal) {
+    return(to_ignore)
+  }
+  secondaries <- vars$secondaries
+  c(to_ignore, secondaries[!secondaries %in% c("email", "orcid")])
+}
+
 get_nestables <- function(crt) {
   names_crt <- if (crt) names(.names$protected$crt)
   role <- if (!crt) "role"

R/plume-handler.R

@@ -1,56 +1,52 @@
 default_names <- list(
-  internal = list(
+  internals = list(
     id = "id",
     initials = "initials",
     literal_name = "literal_name",
-    corresponding = "corresponding",
-    deceased = "deceased",
-    equal_contributor = "equal_contributor"
+    corresponding = "corresponding"
   ),
-  primary = list(
+  primaries = list(
     given_name = "given_name",
     family_name = "family_name"
   ),
-  secondary = list(
-    number = "number",
-    dropping_particle = "dropping_particle",
+  secondaries = list(
     email = "email",
     orcid = "orcid",
     phone = "phone",
     fax = "fax",
     url = "url"
   ),
-  nestable = list(
+  nestables = list(
     affiliation = "affiliation",
     role = "role",
     note = "note"
   )
 )
 
 #' @title PlumeHandler class
-#' @description Internal class processing and shaping tabular data into a `plume`
-#'   object.
+#' @description Internal class processing and shaping tabular data into a
+#'   `plume` object.
 PlumeHandler <- R6Class(
   classname = "PlumeHandler",
   inherit = NameHandler,
   public = list(
     initialize = function(
         data,
         names,
-        initials_given_name,
-        family_name_first,
         credit_roles,
-        interword_spacing
+        initials_given_name,
+        family_name_first = FALSE,
+        interword_spacing = TRUE
     ) {
       check_df(data)
       check_character(names, force_names = TRUE, allow_duplicates = FALSE)
       check_args("bool", list(
+        credit_roles,
         initials_given_name,
         family_name_first,
-        credit_roles,
         interword_spacing
       ))
-      super$initialize(flatten(private$plume_names))
+      super$initialize(private$plume_names)
       private$plume <- as_tibble(data)
       private$initials_given_name <- initials_given_name
       private$family_name_first <- family_name_first
@@ -61,7 +57,7 @@ PlumeHandler <- R6Class(
       if (!is.null(names)) {
         private$set_names(names)
       }
-      private$check_col(private$get_names(private$plume_keys$primary))
+      private$check_col(private$get_names("primaries"))
       private$check_authors()
       private$mount()
     },
@@ -78,7 +74,6 @@ PlumeHandler <- R6Class(
   private = list(
     plume = NULL,
     plume_names = default_names,
-    plume_keys = map(default_names, names),
     initials_given_name = NULL,
     family_name_first = NULL,
     crt = NULL,
@@ -87,7 +82,7 @@ PlumeHandler <- R6Class(
     mount = function() {
       private$build()
       private$sanitise()
-      for (col in private$get_names(private$plume_keys$nestable)) {
+      for (col in private$get_names("nestables")) {
         if (private$is_nestable(paste0("^", col))) {
           private$nest(col)
         }
@@ -104,15 +99,12 @@ PlumeHandler <- R6Class(
     },
 
     mold = function(...) {
-      keys <- private$plume_keys
-      primary <- private$get_names(keys$primary, use_keys = FALSE)
-      secondary <- private$get_names(keys$secondary, use_keys = FALSE)
-      nestables <- private$get_nestables()
+      vars <- private$get_vars()
       private$plume <- select(
         private$plume,
-        all_of(primary),
-        any_of(secondary),
-        starts_with(nestables),
+        all_of(vars$primaries),
+        any_of(vars$secondaries),
+        starts_with(vars$nestables),
         if (private$crt) any_of(names(.names$protected$crt)),
         ...
       )
@@ -128,12 +120,16 @@ PlumeHandler <- R6Class(
       private$plume <- nest(out, !!col := any_of(col))
     },
 
-    get_nestables = function() {
-      nestables <- private$get_names(private$plume_keys$nestable)
-      if (!private$crt) {
-        return(nestables)
+    get_vars = function() {
+      nestables <- private$get_names("nestables", use_keys = TRUE)
+      if (private$crt) {
+        nestables <- nestables[names(nestables) != "role"]
       }
-      nestables[names(nestables) != "role"]
+      list(
+        primaries = private$get_names("primaries"),
+        secondaries = private$get_names("secondaries"),
+        nestables = nestables
+      )
     },
 
     crt_process = function() {
@@ -156,7 +152,7 @@ PlumeHandler <- R6Class(
     },
 
     make_literals = function() {
-      nominal <- private$get_names("given_name", "family_name")
+      nominal <- private$get_names("primaries")
       if (private$family_name_first) {
         nominal <- rev(nominal)
       }
@@ -211,7 +207,7 @@ PlumeHandler <- R6Class(
     },
 
     check_authors = function() {
-      nominal <- private$get_names("given_name", "family_name")
+      nominal <- private$get_names("primaries")
       authors <- select(private$plume, all_of(nominal))
       authors <- reduce(authors, \(x, y) {
         if_else(is_void(x) | is_void(y), NA, 1L)

R/plume-package.R

@@ -10,6 +10,7 @@
 #' @importFrom purrr set_names partial reduce
 #' @importFrom purrr map map_vec map2_vec iwalk walk2
 #' @importFrom purrr list_rbind list_flatten list_transpose list_assign
+#' @importFrom purrr list_modify
 #' @importFrom readr read_file write_lines
 #' @importFrom rlang %||% := abort
 #' @importFrom rlang expr exprs sym syms

R/plume-quarto.R

@@ -1,35 +1,44 @@
+default_names_quarto <- list_modify(
+  default_names,
+  internals = list(
+    deceased = "deceased",
+    equal_contributor = "equal_contributor"
+  ),
+  secondaries = list(
+    number = "number",
+    dropping_particle = "dropping_particle",
+    acknowledgements = "acknowledgements"
+  )
+)
+
 #' @title PlumeQuarto class
-#' @description Class extending `Plume` that allows you to push or update author
-#'   metadata in the YAML header of a `.qmd` file. The generated YAML complies
-#'   with Quarto's author and affiliations
-#'   [schemas](https://quarto.org/docs/journals/authors.html).
+#' @description Class that pushes or updates author metadata in a Quarto file.
 #' @export
 PlumeQuarto <- R6Class(
   classname = "PlumeQuarto",
-  inherit = Plume,
+  inherit = StatusSetterQuarto,
   public = list(
-    #' @description Set equal contributors.
-    #' @param ... Values in the column defined by `by` used to specify which
-    #'   authors are equal contributors. Matching of values is case-insensitive.
-    #'   Use `"all"` to assign equal contribution to all authors.
-    #' @param by Variable used to specify which authors are equal contributors.
-    #'   By default, uses authors' ids.
-    #' @return The class instance.
-    set_equal_contributor = function(..., by) {
-      private$set_status("equal_contributor", ..., by = by)
-    },
-
-    #' @description Set deceased authors.
-    #' @param ... Values in the column defined by `by` used to specify whether
-    #'   an author is deceased or not. Matching of values is case-insensitive.
-    #' @param by Variable used to specify whether an author is deceased or not.
-    #'   By default, uses authors' ids.
-    #' @return The class instance.
-    set_deceased = function(..., by) {
-      private$set_status("deceased", ..., by = by)
+    #' @description Create a `PlumeQuarto` object.
+    #' @param data A data frame or tibble containing author-related data.
+    #' @param names A vector of column names.
+    #' @param credit_roles Should the `r link("crt")` be used?
+    #' @param initials_given_name Should the initials of given names be used?
+    #' @param by A character string defining the default variable used to assign
+    #'   authors' status in all `set_*` methods. By default, uses authors' id.
+    #' @return A `PlumeQuarto` object.
+    initialize = function(
+        data,
+        names = NULL,
+        credit_roles = FALSE,
+        initials_given_name = FALSE,
+        by = NULL
+    ) {
+      super$initialize(data, names, credit_roles, initials_given_name, by)
     },
 
-    #' @description Push or update author information in a YAML header.
+    #' @description Push or update author information in a YAML header. The
+    #'   generated YAML complies with Quarto's author and affiliations
+    #'   [schemas](https://quarto.org/docs/journals/authors.html).
     #' @param file A `.qmd` file.
     #' @details
     #' If missing, `to_yaml()` pushes author information into a YAML header. If
@@ -43,6 +52,7 @@ PlumeQuarto <- R6Class(
   ),
 
   private = list(
+    plume_names = default_names_quarto,
     meta_prefix = "meta-",
 
     mold = function(...) {
@@ -72,6 +82,7 @@ PlumeQuarto <- R6Class(
         url = private$get("url"),
         roles = private$author_roles(),
         note = private$author_notes(),
+        acknowledgements = private$get("acknowledgements"),
         attributes = private$author_attributes(),
         affiliations = private$author_affiliations(),
         metadata = private$author_metadata()