Merge pull request #271 from carpentries/all-in-one

Add all in one page

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sandpaper
 Title: Create and Curate Carpentries Lessons
-Version: 0.3.6
+Version: 0.4.0
 Authors@R: c(
     person(given = "Zhian N.",
            family = "Kamvar",

NEWS.md

@@ -1,3 +1,21 @@
+# sandpaper 0.4.0
+
+NEW FEATURES
+------------
+
+* An all-in-one page is now available for lesson websites at `/aio.html` and
+  `instructor/aio.html`. 
+
+MISC
+----
+
+* Provisioning of the global lesson element cache (metadata, AST, and global
+  variables for varnish) is now all executed via `this_lesson()`, which is run
+  during `validate_lesson()`. This simplifies the setup a bit, and provides the
+  same method of cache invalidation (checking git outputs) for all of these
+  elements
+
+
 # sandpaper 0.3.6
 
 MISC

R/build_aio.R

@@ -0,0 +1,136 @@
+#' Build the All-in-one page
+#'
+#' @param pkg an object created by {pkgdown}, supplied by [build_site()].
+#' @param quiet If `TRUE` then no messages will be shown when building.
+#'
+#' This function will build the all-in-one page for the lesson website. Because
+#' the bottleneck is often the internal processes of {pkgdown}, we are first 
+#' templating the AIO page as a blank page and then adding in the contents using
+#' {xml2}.
+#' @keywords internal
+build_aio <- function(pkg, quiet) {
+  path <- root_path(pkg$src_path)
+  out_path <- pkg$dst_path
+  this_lesson(path)
+  aio <- provision_aio(pkg, quiet)
+  if (aio$needs_episodes) {
+    remove_fix_node(aio$learner)
+    remove_fix_node(aio$instructor)
+  }
+  lesson_content <- ".//main/div[contains(@class, 'lesson-content')]"
+  learn <- get_sections(aio$learner, pkg, aio = TRUE)
+  learn_parent <- xml2::xml_find_first(aio$learner, lesson_content)
+  instruct <- get_sections(aio$instructor, pkg, aio = TRUE)
+  instruct_parent <- xml2::xml_find_first(aio$instructor, lesson_content)
+  the_episodes <- .resources$get()[["episodes"]]
+  the_slugs <- paste0("episode-", get_slug(the_episodes))
+  old_names <- names(learn)
+
+  for (episode in seq(the_episodes)) {
+    this_episode <- the_episodes[episode]
+    ename       <- the_slugs[episode]
+    ep_learn    <- get_sections(this_episode, pkg)
+    ep_instruct <- get_sections(this_episode, pkg, instructor = TRUE)
+    if (ename %in% old_names) {
+      update_section(learn[[ename]], ep_learn)
+      update_section(instruct[[ename]], ep_instruct)
+    } else {
+      make_section(ename, ep_learn, learn_parent)
+      make_section(ename, ep_instruct, instruct_parent)
+    }
+  }
+  writeLines(as.character(aio$learner), fs::path(out_path, "aio.html"))
+  writeLines(as.character(aio$instructor), fs::path(out_path, "instructor", "aio.html"))
+}
+get_sections <- function(episode, pkg, aio = FALSE, instructor = FALSE) {
+  if (!inherits(episode, "xml_document")) {
+    if (instructor) {
+      path <- fs::path(pkg$dst_path, "instructor", as_html(episode))
+    } else {
+      path <- fs::path(pkg$dst_path, as_html(episode))
+    }
+    episode <- xml2::read_html(path)
+  }
+  XPath <- ".//main/div[contains(@class, 'lesson-content')]/{content}"
+  content <- if (aio) "section" else "*"
+  res <- xml2::xml_find_all(episode, glue::glue(XPath))
+  if (aio) {
+    names(res) <- xml2::xml_attr(res, "id")
+  }
+  res
+}
+
+provision_aio <- function(pkg, quiet) {
+  page_globals <- setup_page_globals()
+  aio <- fs::path(pkg$dst_path, "aio.html")
+  iaio <- fs::path(pkg$dst_path, "instructor", "aio.html")
+  needs_episodes <- TRUE || !fs::file_exists(iaio) # this only saves us ~100ms in reality
+  if (needs_episodes) {
+    html <- xml2::read_html("<section id='FIXME'></section>")
+
+    this_dat <- list(
+      this_page = "aio.html",
+      body = html,
+      pagetitle = "All in one view"
+    )
+
+    page_globals$instructor$update(this_dat)
+    page_globals$learner$update(this_dat)
+    page_globals$meta$update(this_dat)
+
+    build_html(template = "extra", pkg = pkg, nodes = html,
+      global_data = page_globals, path_md = "aio.html", quiet = quiet)
+  }
+  return(list(learner = xml2::read_html(aio), 
+    instructor = xml2::read_html(iaio),
+    needs_episodes = needs_episodes)
+  )
+}
+
+remove_fix_node <- function(html) {
+  fix_node <- xml2::xml_find_first(html, ".//section[@id='FIXME']")
+  xml2::xml_remove(fix_node)
+  return(html)
+}
+
+move_section <- function(html, section, sibling, where = "after") {
+  XPath <- ".//section[@id='{id}']"
+  section <- xml2::xml_find_first(html, glue::glue(XPath, id = section))
+  sibling <- xml2::xml_find_first(html, glue::glue(XPath, id = sibling))
+  xml2::xml_add_sibling(sibling, section, .where = where)
+  xml2::xml_remove(section)
+  html
+}
+
+section_contents <- function(section) {
+  contents <- "./section | ./div"
+  xml2::xml_find_all(section, contents)
+}
+
+update_section <- function(section, new) {
+  to_clean <- section_contents(section)
+  info     <- xml2::xml_find_first(section, "./hr")
+  xml2::xml_remove(to_clean)
+  for (node in rev(new)) {
+    xml2::xml_add_sibling(info, node, .where = "after")
+  }
+  section
+}
+
+make_section <- function(name, contents, parent) {
+  uri <- sub("episode-", "", name)
+  title <- xml2::xml_text(contents[[1]])
+  new_section <- "<section id='{name}'><p>Content from <a href='{uri}.html'>{title}</a></p><hr/></section>"
+  section <- xml2::read_xml(glue::glue(new_section))
+  for (element in contents[-1]) {
+    xml2::xml_add_child(section, element)
+  }
+  xml2::xml_add_child(parent, section)
+}
+
+
+get_title <- function(doc) {
+  xml2::xml_find_first(doc, ".//h1")
+}
+
+

R/build_episode.R

@@ -67,8 +67,10 @@ build_episode_html <- function(path_md, path_src = NULL,
                                page_back = "index.md", page_forward = "index.md", 
                                pkg, quiet = FALSE, page_progress = NULL, 
                                sidebar = NULL, date = NULL) {
-  page_globals <- setup_page_globals()
   home <- root_path(path_md)
+  this_lesson(home)
+  page_globals <- setup_page_globals()
+  slug <- get_slug(path_md)
   body <- render_html(path_md, quiet = quiet)
   if (body == "") {
     # if there is nothing in the page then we build nothing.

R/build_lesson.R

@@ -33,18 +33,17 @@ build_lesson <- function(path = ".", rebuild = FALSE, quiet = !interactive(), pr
   # step 1: validate that the lesson structure makes sense
   slug <- if (fs::is_file(path)) get_slug(path) else NULL
   path <- set_source_path(path)
-  # n.b. validate_lesson sets the lesson store cache
-  validate_lesson(path, quiet = quiet)
-  # define the files we are looking to build and the order they exist
-  set_resource_list(path)
-  # define the globals variables needed for varnish to build the site
-  set_globals(path)
-
   on.exit({
     reset_build_paths()
-    clear_resource_list()
-    clear_globals()
   })
+  # Validate the lesson and set the global values for the lesson. This includes
+  #
+  #   .store: the lesson as a pegboard::Lesson object
+  #   .resources: a list of markdown resources for the lesson
+  #   this_metadata: metadata with template for including in the pages
+  #   learner_globals: variables for the learner version of the pages
+  #   instructor_globals: variables for the instructor version of the pages
+  validate_lesson(path, quiet = quiet)
 
   built <- build_markdown(path = path, rebuild = rebuild, quiet = quiet, slug = slug)
 

R/build_markdown.R

@@ -24,6 +24,8 @@ build_markdown <- function(path = ".", rebuild = FALSE, quiet = FALSE, slug = NU
   } else {
     create_site(path)
   }
+  # check if the lesson needs to be reset
+  this_lesson(path)
 
   episode_path <- path_episodes(path)
   outdir       <- path_built(path)
@@ -92,8 +94,10 @@ build_markdown <- function(path = ".", rebuild = FALSE, quiet = FALSE, slug = NU
     # Render the episode files to the built directory --------------------------
     renv_check_consent(path, quiet, sources)
     build_me <- db$build[needs_building]
+    slugs    <- get_slug(build_me)
 
     for (i in seq_along(build_me)) {
+      .html$set(slugs[i], "") # reset the html cache
       build_episode_md(
         path    = build_me[i],
         outdir  = outdir,

R/build_site.R

@@ -13,6 +13,7 @@
 build_site <- function(path = ".", quiet = !interactive(), preview = TRUE, override = list(), slug = NULL, built = NULL) {
   # step 1: check pandoc
   check_pandoc(quiet)
+  this_lesson(path)
   cl <- getOption("sandpaper.links")
   on.exit(options(sandpaper.links = cl), add = TRUE)
   set_common_links(path)
@@ -31,6 +32,8 @@ build_site <- function(path = ".", quiet = !interactive(), preview = TRUE, overr
   }
   pkgdown::init_site(pkg)
   fs::file_create(fs::path(pkg$dst_path, ".nojekyll"))
+  # future plans to reduce build times 
+  rebuild_template <- TRUE || !template_check$valid()
 
   new_setup <- any(grepl("[/]setup[.]md", built))
   db <- get_built_db(fs::path(built_path, "md5sum.txt"))
@@ -80,13 +83,16 @@ build_site <- function(path = ".", quiet = !interactive(), preview = TRUE, overr
       quiet        = quiet
     )
   }
+  # if (rebuild_template) template_check$set()
+
   fs::dir_walk(built_path, function(d) copy_assets(d, pkg$dst_path), all = TRUE)
 
   if (!quiet) cli::cli_rule(cli::style_bold("Creating learner profiles"))
   build_profiles(pkg, quiet = quiet, sidebar = sidebar)
   if (!quiet) cli::cli_rule(cli::style_bold("Creating keypoints summary"))
   build_keypoints(pkg, quiet = quiet, sidebar = sidebar)
-
+  if (!quiet) cli::cli_rule(cli::style_bold("Creating All-in-one page"))
+  build_aio(pkg, quiet = quiet)
   if (!quiet) cli::cli_rule(cli::style_bold("Creating homepage"))
   build_home(pkg, quiet = quiet, sidebar = sidebar, new_setup = new_setup, 
     next_page = abs_md[er[1]]

R/ci_deploy.R

@@ -23,16 +23,6 @@ ci_deploy <- function(path = ".", md_branch = "md-outputs", site_branch = "gh-pa
   check_git_user(path, name = "GitHub Actions", email = "[email protected]")
 
   validate_lesson(path)
-  # define the files we are looking to build and the order they exist
-  set_resource_list(path)
-  # define the globals variables needed for varnish to build the site
-  set_globals(path)
-  on.exit({
-    reset_build_paths()
-    clear_resource_list()
-    clear_globals()
-  }, add = TRUE)
-
 
   # Step 1: build markdown source files
   del_md <- ci_build_markdown(path, branch = md_branch, remote = remote, reset = reset)

R/get_syllabus.R

@@ -13,7 +13,7 @@
 #' @keywords internal
 #' @export
 get_syllabus <- function(path = ".", questions = FALSE, use_built = TRUE) {
-  check_lesson(path)
+  this_lesson(path)
 
   # The home page contains three things: 
   # 0. The main title as a header

R/test-fixtures.R

@@ -74,6 +74,9 @@ generate_restore_fixture <- function(repo) {
     # clear the site and recreate it
     fs::dir_delete(fs::path(repo, "site"))
     create_site(repo)
+    # reset the lesson cache
+    clear_this_lesson()
+    set_this_lesson(repo)
     repo
   }
 }

R/utils-store.R

@@ -77,16 +77,42 @@ clear_resource_list <- function(path) {
       .this_status <<- gert::git_status(repo = path)
       .this_commit <<- gert::git_log(repo = path, max = 1L)$commit
       .this_lesson <<- pegboard::Lesson$new(path, jekyll = FALSE)
+      set_globals(path)
+      set_resource_list(path)
       invisible(.this_lesson)
     },
     clear = function() {
       .this_diff   <<- NULL
       .this_lesson <<- NULL
       .this_commit <<- NULL
+      clear_globals()
+      clear_resource_list()
     }
   )
 }
 
+#nocov start
+create_template_check <- function() {
+  .varnish_store <- NULL
+  list(
+    valid = function() {
+      path <- system.file("pkgdown/templates", package = "varnish")
+      res  <- tools::md5sum(list.files(path, full.names = TRUE))
+      identical(res, .varnish_store)
+    },
+    set = function() {
+      path <- system.file("pkgdown/templates", package = "varnish")
+      .varnish_store <<- tools::md5sum(list.files(path, full.names = TRUE))
+    },
+    clear = function() {
+      .varnish_store <<- NULL
+    }
+  )
+}
+
+template_check <- create_template_check()
+#nocov end
+
 # create a global list of things
 .list_store <-  function() {
   .this_list <- list()
@@ -140,6 +166,9 @@ clear_resource_list <- function(path) {
 # storage for get_resource_list()
 .resources <- .list_store()
 
+# storage for rendered pages
+.html <- .list_store()
+
 # storage for global variables for the lesson site (those that get passed on to
 # {varnish})
 instructor_globals <- .list_store()

R/utils-varnish.R

@@ -25,6 +25,7 @@ varnish_vars <- function() {
     sandpaper_version = ver("sandpaper"),
     sandpaper_cfg     = cfg("sandpaper"),
     pegboard_version  = ver("pegboard"),
+    pegboard_cfg      = cfg("pegboard"),
     varnish_version   = ver("varnish"),
     varnish_cfg       = cfg("varnish")
   )
@@ -51,13 +52,18 @@ varnish_vars <- function() {
 #'
 #' @keywords internal
 set_globals <- function(path) {
+  template_check$set()
   initialise_metadata(path)
   # get the resources if they exist (but do not destroy the global environment)
   old <- .resources$get()
   on.exit(.resources$set(key = NULL, old))
   set_resource_list(path)
   these_resources <- .resources$get()
 
+  for (slug in get_slug(unlist(these_resources, use.names = FALSE))) {
+    .html$set(slug, "")
+  }
+
   # Sidebar information is largely duplicated across the views. The only thing
   # that is different is the name of the index node.
   idx <- these_resources[["."]]
@@ -78,6 +84,7 @@ set_globals <- function(path) {
 
   learner_globals$set(key = NULL, 
     c(list(
+      aio = TRUE,
       instructor = FALSE,
       sidebar = learner_sidebar,
       more = paste(learner$extras, collapse = ""),
@@ -86,6 +93,7 @@ set_globals <- function(path) {
   )
   instructor_globals$set(key = NULL, 
     c(list(
+      aio = TRUE,
       instructor = TRUE,
       sidebar = instructor_sidebar,
       more = paste(instructor$extras, collapse = ""),