Release v0.2.0

Merge pull request #9 from riccardoporreca/develop

.Rbuildignore

@@ -6,3 +6,5 @@
 ^docs$
 ^pkgdown$
 ^\.travis\.yml$
+^codecov\.yml$
+^\.covrignore$

.covrignore

@@ -0,0 +1 @@
+R/gallery_site_generator.R

.travis.yml

@@ -3,6 +3,9 @@
 language: R
 cache: packages
 
+after_success:
+  - Rscript -e 'covr::codecov()'
+
 before_cache: Rscript -e 'install.packages("pkgdown")'
 before_deploy: Rscript -e 'pkgdown::build_site()'
 deploy:

DESCRIPTION

@@ -1,14 +1,14 @@
 Package: rmdgallery
 Title: R Markdown Website Gallery Generator
-Version: 0.1.0
+Version: 0.2.0
 Authors@R: 
     person(given = "Riccardo",
            family = "Porreca",
            role = c("aut", "cre"),
            email = "riccardo.porreca@mirai-solutions.com")
 Description: Provide an R Markdown website generator to build a website 
     including a gallery of (embedded) pages created in a dynamic way based on
-    metadata in JSON format.
+    metadata in JSON or YAML format.
 License: GPL-3
 URL: https://github.com/riccardoporreca/rmdgallery
 BugReports: https://github.com/riccardoporreca/rmdgallery/issues
@@ -20,8 +20,10 @@ Imports:
     htmltools,
     jsonlite,
     knitr,
-    rmarkdown
+    rmarkdown,
+    yaml
 Suggests: 
-    testthat (>= 2.1.0)
+    testthat (>= 2.1.0),
+    covr
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.1.0

NEWS.md

@@ -1,3 +1,16 @@
+# rmdgallery 0.2.0
+
+## New features
+
+- Metadata in YAML format are now also supported (#2).
+- Custom _page types_ are now supported as an alternative to the `template` field of the metadata. Page types are defined and mapped to actual templates in the `gallery` site configuration, using new fields `type_field` and `type_template` (#4).
+- Default values for unspecified fields in the metadata can now be defined using the new `defaults` field in the `gallery` site configuration (#3).
+
+## Maintenance
+
+- Updated package README to cover new features and point to branch `develop` for using the development version.
+- Extended test coverage for new as well as existing utilities.
+
 # rmdgallery 0.1.0
 
 ## First versioned release

R/config.R

@@ -6,7 +6,10 @@
 #'
 #' @return The function returns the contents of `_site.yml` as an \R list, with
 #'   an additional element `$gallery$meta`, a list containing the metadata of
-#'   the pages to be generated, as read from the `.json` file.
+#'   the pages to be generated, as read from the `.json`, `.yml` and `yaml`
+#'   files, where `$gallery$type_field` and `gallery$type_template` (if present)
+#'   have been already used to lookup the actual `template`. In addition,
+#'   default field values specified as `gallery$defaults` are also applied.
 #'
 #' @export
 gallery_site_config <- function(input = ".") {
@@ -15,7 +18,69 @@ gallery_site_config <- function(input = ".") {
     meta_dir <- config$gallery$meta_dir %||% "meta"
     single_meta <- config$gallery$single_meta %||% FALSE
     meta_files <- site_meta_files(file.path(input, meta_dir))
-    config$gallery$meta <- read_meta(meta_files, single_meta)
+    meta <- read_meta(meta_files, single_meta)
+    meta <- with_type_template(meta, config$gallery)
+    meta <- with_defaults(meta, config$gallery)
+    check_missing_template(meta)
+    config$gallery$meta <- meta
   }
   config
 }
+
+with_type_template <- function(meta, gallery_config)(
+  if (!is.null(gallery_config$type_field)) {
+    meta <- assign_type_template(
+      meta,
+      gallery_config$type_field,
+      gallery_config$type_template
+    )
+  }
+)
+
+assign_type_template <- function(meta, type_field, type_templates) {
+  template <- get_meta_field(meta, "template")
+  type <- get_meta_field(meta, type_field)
+  with_type <- is.na(template) & !is.na(type)
+  template_from_type <- get_type_template(type[with_type], type_templates)
+  miss_template <- is.na(template_from_type )
+  if (any(miss_template)) {
+    stop(
+      "Missing template specification for custom type(s) ",
+      toQuotedString(unique(type[with_type][miss_template]))
+    )
+  }
+  meta[with_type] <- set_meta_field(
+    meta[with_type],
+    "template", template_from_type
+  )
+  meta
+}
+
+get_type_template <- function(type, type_templates) {
+  vapply(
+    type, FUN.VALUE = NA_character_,
+    function(x) type_templates[[x]] %||% NA_character_
+  )
+}
+
+with_defaults <- function(meta, gallery_config) {
+  default_fields <- names(gallery_config$defaults)
+  for (field in default_fields) {
+    values <- get_meta_field(meta, field)
+    values <- values %|NA|% gallery_config$defaults[[field]]
+    meta <- set_meta_field(meta, field, values)
+  }
+  meta
+}
+
+check_missing_template <- function(meta) {
+  miss_template <- is.na(get_meta_field(meta, "template"))
+  if (any(miss_template)) {
+    stop(
+      "Missing template specification for: ",
+      toQuotedString(names(meta)[miss_template])
+    )
+  }
+  invisible(meta)
+}
+

R/gallery_site_generator.R

@@ -5,7 +5,7 @@
 #'
 #' Define a custom website generator to be used with [rmarkdown::render_site()].
 #' This generates a simple R Markdown website including a gallery of pages with
-#' embedded content, based on metadata in JSON format and custom site
+#' embedded content, based on metadata in JSON or YAML format and custom site
 #' configuration options.
 #'
 #' @inheritParams rmarkdown::default_site_generator
@@ -56,7 +56,7 @@ gallery_site <- function(input, ...) {
       if (any(duplicated)) {
         stop(
           "Found duplicate navbar menu entries: ",
-          toString(sQuote(gallery_entry[has_entry][duplicated])))
+          toQuotedString(gallery_entry[has_entry][duplicated]))
       }
       gallery_navbar[[1L]][[1]]$menu <- mapply(
         SIMPLIFY = FALSE, USE.NAMES = FALSE,
@@ -118,7 +118,7 @@ gallery_site <- function(input, ...) {
       if (tools::file_ext(x) == "meta") {
         name <- tools::file_path_sans_ext(x)
         meta <- config$gallery$meta[[name]]
-        if (!quiet) message("\nMetadata from: ", meta$source)
+        if (!quiet) message("\nMetadata from: ", meta$.meta_file)
         # gallery config:
         meta$gallery_config <- if (is.null(config$gallery)) list() else config$gallery
         output_file <- file.path(input, file_with_ext(name, "html"))

R/meta.R

@@ -1,22 +1,57 @@
 
 site_meta_files <- function(path) {
-  list.files(path, "[.]json$", full.names = TRUE)
+  list.files(path, "[.](json|ya?ml)$", full.names = TRUE)
+}
+
+read_meta_file <- function(file, ...) {
+  ext <- tools::file_ext(basename(file))
+  reader <- list(
+    json = jsonlite::read_json,
+    yaml = yaml::read_yaml,
+    yml = yaml::read_yaml
+  )[[ext]]
+  if (is.null(ext)) {
+    stop("Extension .", ext, " not supported.")
+  }
+  reader(file, ...)
 }
 
 read_meta <- function(files, single = FALSE) {
-  do.call(
+  meta <- do.call(
     c,
     lapply(files, function(file) {
-      meta <- jsonlite::read_json(file)
+      meta <- read_meta_file(file)
       if (isTRUE(single)) {
         meta <- list(meta)
         names(meta) <- tools::file_path_sans_ext(basename(file))
       }
-      meta <- lapply(meta, function(x) {
-        x$source <- basename(file)
-        x
-      })
+      meta <- lapply(meta, c, list(.meta_file = basename(file)))
       meta
     })
   )
+  dup_meta <- duplicated(names(meta))
+  if (any(dup_meta)) {
+    stop(
+      "Duplicated page names found in the metadata: ",
+      toQuotedString(unique(names(meta)[dup_meta]))
+    )
+  }
+  meta
+}
+
+get_meta_field <- function(meta, field, missing_value = NA_character_) {
+  vapply(
+    meta, FUN.VALUE = missing_value,
+    function(x) x[[field]] %||% missing_value
+  )
+}
+
+set_meta_field <- function(meta, field, value) {
+  Map(
+    function(x, value) {
+      x[[field]] <- if (!is.na(value)) value
+      x
+    },
+    meta, value
+  )
 }

R/templates.R

@@ -105,7 +105,7 @@ find_template <- function(template, paths = character(0)) {
     }
   }
   if (is.null(template_file)) {
-    stop("No template found for ", sQuote(template), " in ", toString(sQuote(paths)))
+    stop("No template found for ", toQuotedString(template), " in ", toQuotedString(paths))
   }
   template_file
 }

R/utils.R

@@ -3,7 +3,16 @@
   if (is.null(x)) value_if_null else x
 }
 
+`%|NA|%` <- function(x, value_if_na) {
+  x[is.na(x)] <- value_if_na
+  x
+}
+
 # define a list of utilities to be made available when rendering
 render_time_utils <- list(
   `%||%` = `%||%`
 )
+
+toQuotedString <- function(x) {
+  toString(sQuote(x, q = FALSE))
+}