Store exercises and questions in list in cache env

NAMESPACE

@@ -1,12 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(format,learnr_available_tutorials)
+S3method(format,mock_exercise)
+S3method(format,tutorial_exercise)
 S3method(format,tutorial_question)
 S3method(format,tutorial_question_answer)
 S3method(format,tutorial_quiz)
 S3method(knit_print,tutorial_question)
 S3method(knit_print,tutorial_quiz)
 S3method(print,learnr_available_tutorials)
+S3method(print,tutorial_exercise)
 S3method(print,tutorial_question)
 S3method(print,tutorial_question_answer)
 S3method(print,tutorial_quiz)

NEWS.md

@@ -23,6 +23,7 @@ learnr (development version)
 * When a "data/" directory is found in the same directory as the tutorial R Markdown document, it is now automatically made available within exercises. An alternative directory can be specified using the `tutorial.data_dir` global option. ([#539](https://github.com/rstudio/learnr/pull/539))
 * Messages generated by R during exercises are now translated to match the tutorial language, if translations are available. ([#558](https://github.com/rstudio/learnr/pull/558))
 * Tutorial authors can now access the current state of the user's progress in a tutorial with `get_tutorial_state()` or get information about the current tutorial with `get_tutorial_info()`. ([#562](https://github.com/rstudio/learnr/pull/562))
+* Tutorial state is now returned by `get_tutorial_state()` in order of appearance in the tutorial. The full list of exercises and questions is included as `items` in the list returned by `get_tutorial_info()`. ([#570](https://github.com/rstudio/learnr/issues/570), [#571](https://github.com/rstudio/learnr/pull/571))
 
 ## Minor new features and improvements
 

R/evaluators.R

@@ -197,7 +197,7 @@ internal_external_evaluator <- function(
             exercise$options$exercise.checker <- c()
           }
 
-          json <- jsonlite::toJSON(exercise, auto_unbox = TRUE, null = "null")
+          json <- jsonlite::toJSON(exercise, auto_unbox = TRUE, null = "null", force = TRUE)
 
           if (is.null(exercise$options$exercise.timelimit) || exercise$options$exercise.timelimit == 0){
             timeout_s <- 30 * 1000

R/exercise.R

@@ -73,9 +73,6 @@ setup_exercise_handler <- function(exercise_rx, session) {
         evaluator_factory <- inline_evaluator
     }
 
-    # supplement the exercise with the global setup options
-    # TODO: warn if falling back to the `setup` chunk with an out-of-process evaluator.
-    exercise$global_setup <- get_global_setup()
     # retrieve exercise cache information:
     # - chunks (setup + exercise) for the exercise to be processed in `evaluate_exercise`
     # - checker code (check, code-check, error-check)
@@ -676,9 +673,15 @@ with_masked_env_vars <- function(code, env_vars = list(), opts = list()) {
   # Always disable connect api keys and connect server info
   env_vars$CONNECT_API_KEY <- ""
   env_vars$CONNECT_SERVER <- ""
+  env_vars$LEARNR_EXERCISE_USER_CODE <- "TRUE"
   # Hide shiny server sharedSecret
   opts$shiny.sharedSecret <- ""
 
+  # Mask tutorial cache for user code evaluation
+  cache_current <- tutorial_cache_env$objects
+  tutorial_cache_env$objects <- NULL
+  withr::defer(tutorial_cache_env$objects <- cache_current)
+
   # Disable shiny domain
   shiny::withReactiveDomain(NULL, {
     withr::with_envvar(env_vars, {
@@ -718,11 +721,12 @@ exercise_code_chunks_user <- function(exercise) {
 
 exercise_code_chunks <- function(chunks) {
   vapply(chunks, function(x) {
-    opts <- paste(names(x$opts), unname(x$opts), sep = "=")
+    opts <- x$opts[setdiff(names(x$opts), "label")]
+    opts <- paste(names(opts), unname(opts), sep = "=")
     paste(
       sep = "\n",
       # we quote the label to ensure that it is treated as a label and not a symbol for instance
-      sprintf("```{%s}", paste0(c(x$engine, dput_to_string(x$label), opts), collapse = ", ")),
+      sprintf("```{%s %s}", x$engine, paste0(c(dput_to_string(x$label), opts), collapse = ", ")),
       paste0(x$code, collapse = "\n"),
       "```"
     )
@@ -1010,3 +1014,14 @@ debug_exercise_checker <- function(
     )
   )
 }
+
+#' @export
+format.tutorial_exercise <- function (x, ...) {
+  chunks <- exercise_code_chunks(x$chunks)
+  paste(chunks, collapse = "\n\n")
+}
+
+#' @export
+print.tutorial_exercise <- function(x, ...) {
+  cat(format(x, ...))
+}

R/knitr-hooks.R

@@ -37,6 +37,9 @@ install_knitr_hooks <- function() {
       all_exercise_labels <- eval(parse(text = label_query))
       exercise_label %in% all_exercise_labels
     }
+    else if (identical(options$label, "setup-global-exercise")) {
+      TRUE
+    }
     else if ("setup" %in% type) {
       # look for another chunk which names this as it's setup chunk or if it has `exercise.setup`
       # this second condition is for support chunks that isn't referenced by an exercise yet
@@ -73,6 +76,14 @@ install_knitr_hooks <- function() {
     knitr::knit_code$get(label)
   }
 
+  get_setup_global_exercise <- function() {
+    # setup-global-exercise is a special chunk name that will over-ride the
+    # global setup chunk, but only for external evaluators. This lets tutorials
+    # have separate setup code for the local shiny app and the remote evaluator.
+    knitr::knit_code$get("setup-global-exercise") %||%
+      knitr::knit_code$get("setup")
+  }
+
   # helper function to find all the setup chunks associated with an exercise chunk
   # it goes up the chain of setup dependencies and returns a list of raw knitr chunks (if any)
   find_parent_setup_chunks <- function(options, visited = NULL) {
@@ -335,21 +346,26 @@ install_knitr_hooks <- function() {
           )
         }
 
-        exercise_cache <- list(setup = all_setup_code,
-                               chunks = all_chunks,
-                               code_check = code_check_chunk,
-                               error_check = error_check_chunk,
-                               check = check_chunk,
-                               solution  = solution,
-                               options = options,
-                               engine = options$engine)
+        exercise_cache <- structure(
+          list(
+            global_setup = get_setup_global_exercise(),
+            setup = all_setup_code,
+            chunks = all_chunks,
+            code_check = code_check_chunk,
+            error_check = error_check_chunk,
+            check = check_chunk,
+            solution  = solution,
+            options = options[setdiff(names(options), "tutorial")],
+            engine = options$engine
+          ),
+          class = "tutorial_exercise"
+        )
 
         # serialize the list of chunks to server
         rmarkdown::shiny_prerendered_chunk(
           'server',
           sprintf(
-            'learnr:::store_exercise_cache(%s, %s)',
-            dput_to_string(options$label),
+            'learnr:::store_exercise_cache(%s)',
             dput_to_string(exercise_cache)
           )
         )
@@ -436,72 +452,15 @@ install_knitr_hooks <- function() {
       }
 
     }
-
-    # Possibly redundant with the new_source_knit_hook, but that hook skips
-    # chunks that are empty. This makes it more likely that we catch the setup-
-    # global-exercise chunk. We keep the source hook, however, because we want
-    # to be less sensitive to the ordering of the chunks.
-    else if (identical(options$label, "setup-global-exercise")){
-      write_setup_chunk(options$code, TRUE)
-    }
-
   })
-
-  # Preserve any existing `source` hook
-  # We generally namespace our hooks under `tutorial` by calling `opts_chunk$set(tutorial = TRUE)`.
-  # Unfortunately, that only applies to subsequent chunks, not the current one.
-  # Since learnr is typically loaded in the `setup` chunk and we want to capture
-  # that chunk, that's unfortunately too late. Therefore we have to set a global
-  # `source` chunk to capture setup. However, we do take precautions to preserve
-  # any existing hook that might have been installed before creating our own.
-  knitr_hook_cache$source <- knitr::knit_hooks$get("source")
-
-  # Note: Empirically, this function gets called twice
-  knitr::knit_hooks$set(source = new_source_knit_hook())
-
-}
-
-# cache to hold the original knit hook
-knitr_hook_cache <- new.env(parent=emptyenv())
-
-write_setup_chunk <- function(code, overwrite = FALSE){
-  rmarkdown::shiny_prerendered_chunk(
-    'server',
-    sprintf(
-      'learnr:::store_exercise_setup_chunk("__setup__", %s, overwrite = %s)',
-      dput_to_string(code),
-      overwrite
-    )
-  )
-}
-
-# takes in the write_set_chk which we can use to mock this side-effect in testing.
-new_source_knit_hook <- function(write_set_chk = write_setup_chunk) {
-  function(x, options) {
-    # By configuring `setup` to not overwrite, and `setup-global-exercise` to
-    # overwrite, we ensure that:
-    #  1. If a chunk named `setup-global-exercise` exists, we use that
-    #  2. If not, it would return the chunk named `setup` if it exists
-    if (identical(options$label, "setup-global-exercise")){
-      write_set_chk(options$code, TRUE)
-    } else if (identical(options$label, "setup")){
-      write_set_chk(options$code, FALSE)
-    }
-
-    if(!is.null(knitr_hook_cache$source)) {
-      knitr_hook_cache$source(x, options)
-    }
-  }
 }
 
 remove_knitr_hooks <- function() {
-  knitr::opts_hooks$set(tutorial = NULL)
-  knitr::knit_hooks$set(tutorial = NULL)
-  knitr::knit_hooks$set(source = knitr_hook_cache$source)
+  knitr::opts_chunk$delete("tutorial")
+  knitr::knit_hooks$delete("tutorial")
 }
 
 exercise_server_chunk <- function(label) {
-
   # reactive for exercise execution
   rmarkdown::shiny_prerendered_chunk('server', sprintf(
 '`tutorial-exercise-%s-result` <- learnr:::setup_exercise_handler(reactive(req(input$`tutorial-exercise-%s-code-editor`)), session)

R/mock_exercise.R

@@ -33,7 +33,6 @@ mock_exercise <- function(
     fig.height = fig.height,
     fig.retina = fig.retina,
     engine = engine,
-    tutorial = TRUE,
     max.print = 1000,
     exercise.checker = exercise.checker,
     label = label,
@@ -89,10 +88,9 @@ mock_exercise <- function(
     if (version == "3") {
       ex$tutorial$language <- "en"
     }
-    return(ex)
   }
 
-  ex
+  structure(ex, class = c("mock_exercise", "tutorial_exercise"))
 }
 
 mock_prep_setup <- function(chunks, setup_label) {
@@ -135,10 +133,28 @@ mock_chunk <- function(label, code, exercise = FALSE, engine = "r", ...) {
   opts$label <- label
   opts$exercise <- exercise
 
+  if (is.null(opts[["exercise.setup"]])) {
+    opts[["exercise.setup"]] <- NULL
+  }
+
   list(
     label = label,
     code = paste(code, collapse = "\n"),
     opts = opts,
     engine = engine
   )
 }
+
+#' @export
+format.mock_exercise <- function(x, ...) {
+  # in real exercises, the chunk options are stored as un-evaluated strings
+  x$chunks <- lapply(x$chunks, function(chunk) {
+    if (!isTRUE(chunk$opts$exercise)) {
+      chunk$opts$exercise <- NULL
+    }
+    chunk$opts <- vapply(chunk$opts, dput_to_string, character(1))
+    chunk
+  })
+  class(x) <- "tutorial_exercise"
+  format(x, ...)
+}

R/quiz.R

@@ -364,9 +364,10 @@ question_prerendered_chunk <- function(question, ..., session = getDefaultReacti
       session = session
     )
 
-  observe(
+  observe({
+    req(question_state())
     set_tutorial_state(question$label, question_state(), session = session)
-  )
+  })
 
   question_state
 }