Move error checking from render_exercise() to evaluate_exercise()

NEWS.md

@@ -47,6 +47,7 @@ learnr (development version)
 * `exercise_result()` no longer combines the code output and feedback; this now happens just before presenting the exercise result to the user ([#522](https://github.com/rstudio/learnr/pull/522)).
 * Correct/incorrect question markers are now configurable via CSS. You can change or style these markers using the `.tutorial-question .question-final .correct::before` and `.tutorial-qusetion .question-final .incorrect::before` selectors. A new helper function, `finalize_question()`, can be used to apply the `.question-final` class to custom learnr questions. ([#531](https://github.com/rstudio/learnr/pull/531))
 * `options()` and environment variables are now reset after rendering exercises so changes made by user input or checking code cannot affect other exercises. ([#542](https://github.com/rstudio/learnr/pull/542))
+* Exercise checking is now conducted in the same temporary directory where exercises are evaluated. ([#544](https://github.com/rstudio/learnr/pull/544/))
 
 ## Bug fixes
 

R/exercise.R

@@ -264,7 +264,7 @@ upgrade_exercise <- function(exercise, require_items = NULL) {
 # returns NULL if everything is okay, otherwise a character string describing
 # the reason the validation check failed.
 validate_exercise <- function(exercise, require_items = NULL) {
-required_names <- c("code", "label", "options", "chunks", require_items)
+  required_names <- c("code", "label", "options", "chunks", require_items)
   missing_names <- setdiff(required_names, names(exercise))
   if (length(missing_names)) {
     return(paste("Missing exercise items:", paste(missing_names, collapse = ", ")))
@@ -273,6 +273,22 @@ required_names <- c("code", "label", "options", "chunks", require_items)
   NULL
 }
 
+standardize_code <- function(code) {
+  if (inherits(code, "AsIs")) {
+    return(code)
+  }
+  if (is.null(code) || !length(code)) {
+    return("")
+  }
+  str_trim(paste0(code, collapse = "\n"))
+}
+
+standardize_exercise_code <- function(exercise) {
+  ex_code_items <- c("error_check", "code_check", "check", "code", "global_setup")
+  exercise[ex_code_items] <- lapply(exercise[ex_code_items], standardize_code)
+  exercise
+}
+
 # evaluate an exercise and return a list containing output and dependencies
 # @param evaluate_global_setup - If `FALSE`, will not evaluate the global setup
 #   code. Instead, it just concatenates the exercise- specific setup code and
@@ -295,11 +311,14 @@ evaluate_exercise <- function(
     require_items = if (evaluate_global_setup) "global_setup"
   )
 
+  # standardize exercise code to single string (code, *check, global_setup)
+  exercise <- standardize_exercise_code(exercise)
+
   i18n_set_language_option(exercise$tutorial$language)
 
   # return immediately and clear visible results
   # do not consider this an exercise submission
-  if (!nzchar(str_trim(paste0(exercise$code, collapse = "\n")))) {
+  if (!nzchar(exercise$code)) {
     # " " since html_output needs to pass a req()
     return(exercise_result(html_output = " "))
   }
@@ -308,17 +327,9 @@ evaluate_exercise <- function(
     eval(parse(text = exercise$global_setup), envir = envir)
   }
 
-  # Setup a temporary directory for rendering the exercise
-  exercise_dir <- tempfile(pattern = "lnr-ex")
-  dir.create(exercise_dir)
-  on.exit(unlink(exercise_dir), add = TRUE)
-
-  # Copy files from data directory into exercise
-  copy_data_dir(data_dir, exercise_dir)
-
   checker_feedback <- NULL
-  # Run the checker pre-evaluation _if_ there is code checking to do
-  if (length(exercise$code_check)) {
+  # Check the code pre-evaluation, if code_check is provided
+  if (nzchar(exercise$code_check)) {
     checker_feedback <- try_checker(
       exercise, "exercise.checker",
       check_code = exercise$code_check,
@@ -333,18 +344,45 @@ evaluate_exercise <- function(
     }
   }
 
-  # Render exercise in temporary exercise directory
-  rmd_results <- withr::with_dir(
-    exercise_dir,
-    render_exercise(exercise, envir)
+  # Setup a temporary directory for rendering the exercise
+  exercise_dir <- withr::local_tempdir(pattern = "lrn-ex")
+
+  # Copy files from data directory into exercise
+  copy_data_dir(data_dir, exercise_dir)
+
+  # Move into the temp exercise directory for evaluation and checking
+  withr::local_dir(exercise_dir)
+
+  # Evaluate the submitted code by rendering the exercise in a special .Rmd
+  rmd_results <- tryCatch(
+    render_exercise(exercise, envir),
+    error = function(err_render) {
+      if (nzchar(exercise$error_check)) {
+        # Check the error thrown by the submitted code when there's error
+        # checking: the exercise could be to throw an error!
+        checker_feedback <- try_checker(
+          exercise, "exercise.checker",
+          check_code = exercise$error_check,
+          envir_result = err_render$envir_result,
+          evaluate_result = err_render$evaluate_result,
+          envir_prep = err_render$envir_prep,
+          last_value = err_render,
+          engine = exercise$engine
+        )
+        if (is_exercise_result(checker_feedback)) {
+          return(checker_feedback)
+        }
+      }
+      exercise_result_error(err_render$error_message)
+    }
   )
 
   if (is_exercise_result(rmd_results)) {
     return(rmd_results)
   }
 
   # Run the checker post-evaluation (for checking code results)
-  if (length(exercise$check)) {
+  if (nzchar(exercise$check)) {
     checker_feedback <- try_checker(
       exercise, "exercise.checker",
       check_code = exercise$check,
@@ -356,7 +394,7 @@ evaluate_exercise <- function(
     )
   }
 
-  # include any checker feedback with the exercise results
+  # Return checker feedback (if any) with the exercise results
   exercise_result(
     feedback = checker_feedback$feedback,
     html_output = rmd_results$html_output
@@ -565,25 +603,18 @@ render_exercise <- function(exercise, envir) {
     if (grepl(pattern, msg, fixed = TRUE)) {
       return(exercise_result_timeout())
     }
-    if (length(exercise$error_check)) {
-      # Run the condition through an error checker (the exercise could be to throw an error!)
-      checker_feedback <- try_checker(
-        exercise, "exercise.checker",
-        check_code = exercise$error_check,
-        envir_result = envir_result,
-        evaluate_result = evaluate_result,
-        envir_prep = envir_prep,
-        last_value = e,
-        engine = exercise$engine
-      )
-      if (is_exercise_result(checker_feedback)) {
-        return(checker_feedback)
-      }
-    }
-    exercise_result_error(msg)
+    rlang::abort(
+      class = "learnr_render_exercise_error",
+      envir_result = envir_result,
+      evaluate_result = evaluate_result,
+      envir_prep = envir_prep,
+      last_value = e,
+      error_message = msg
+    )
   })
 
   if (is_exercise_result(output_file)) {
+    # this only happens when the render result is a timeout error
     return(output_file)
   }
 

docs/examples.html

@@ -13,7 +13,6 @@
 
 <title>Examples</title>
 
-<script src="site_libs/header-attrs-2.9/header-attrs.js"></script>
 <script src="site_libs/jquery-1.11.3/jquery.min.js"></script>
 <meta name="viewport" content="width=device-width, initial-scale=1" />
 <link href="site_libs/bootstrap-3.3.5/css/cosmo.min.css" rel="stylesheet" />

docs/exercises.html

@@ -13,7 +13,6 @@
 
 <title>Exercises</title>
 
-<script src="site_libs/header-attrs-2.9/header-attrs.js"></script>
 <script src="site_libs/jquery-1.11.3/jquery.min.js"></script>
 <meta name="viewport" content="width=device-width, initial-scale=1" />
 <link href="site_libs/bootstrap-3.3.5/css/cosmo.min.css" rel="stylesheet" />

docs/formats.html

@@ -13,7 +13,6 @@
 
 <title>Formats</title>
 
-<script src="site_libs/header-attrs-2.9/header-attrs.js"></script>
 <script src="site_libs/jquery-1.11.3/jquery.min.js"></script>
 <meta name="viewport" content="width=device-width, initial-scale=1" />
 <link href="site_libs/bootstrap-3.3.5/css/cosmo.min.css" rel="stylesheet" />

docs/index.html

@@ -13,7 +13,6 @@
 
 <title>Interactive Tutorials for R</title>
 
-<script src="site_libs/header-attrs-2.9/header-attrs.js"></script>
 <script src="site_libs/jquery-1.11.3/jquery.min.js"></script>
 <meta name="viewport" content="width=device-width, initial-scale=1" />
 <link href="site_libs/bootstrap-3.3.5/css/cosmo.min.css" rel="stylesheet" />

docs/publishing.html

@@ -13,7 +13,6 @@
 
 <title>Publishing</title>
 
-<script src="site_libs/header-attrs-2.9/header-attrs.js"></script>
 <script src="site_libs/jquery-1.11.3/jquery.min.js"></script>
 <meta name="viewport" content="width=device-width, initial-scale=1" />
 <link href="site_libs/bootstrap-3.3.5/css/cosmo.min.css" rel="stylesheet" />
@@ -388,7 +387,7 @@ <h2>R Package</h2>
 <pre class="r"><code>install.packages(&quot;learnr&quot;)
 learnr::run_tutorial(&quot;introduction&quot;, package = &quot;mypackage&quot;)</code></pre>
 <div id="exercise-checkers" class="section level3 toc-ignore">
-<h3 class="toc-ignore">Exercise Checkers</h3>
+<h3>Exercise Checkers</h3>
 <p>Note that if your tutorial performs <a href="exercises.html#checking-exercises">exercise checking</a> via an external package then you should be sure to add the package you use for checking as an <code>Imports</code> dependency of your package so it’s installed automatically along with your package.</p>
 <p>Note that it’s likely that the <strong>learnr</strong> package will eventually include or depend on another package that provides checking functions. For the time being though explicit installation of external checking packages is a requirement.</p>
 </div>

docs/questions.html

@@ -13,7 +13,6 @@
 
 <title>Questions</title>
 
-<script src="site_libs/header-attrs-2.9/header-attrs.js"></script>
 <script src="site_libs/jquery-1.11.3/jquery.min.js"></script>
 <meta name="viewport" content="width=device-width, initial-scale=1" />
 <link href="site_libs/bootstrap-3.3.5/css/cosmo.min.css" rel="stylesheet" />