Reorganize and prune functions (rstudio#61)

* comment out unused functions, move fxns to separate R files

* remove learnr dependency (broken)

* move and edit view/add/remove tutorial fxns

waiting for feature to be implement in rstudio before putting back in

also removes learnr depedency

* remove dependencies (clean up scripts and files)

removes call to pryr in grade_learnr and replace with rlang equlivilant

move unused functions to archive.
these are flagged for deletion.

move old tutorial files to archive,
will be added in when api is finalized,
and still deemed necessary.

* lintr!

* remove test and result function from archive.

result was removed in rstudio#21

.Rbuildignore

@@ -10,3 +10,4 @@
 ^\.lintr$
 ^\.vscode$
 ^scripts/
+^archive/

DESCRIPTION

@@ -17,16 +17,9 @@ LazyData: true
 RoxygenNote: 6.1.1
 Imports:
     purrr,
-    crayon,
-    clisymbols,
-    pryr,
     rlang,
     rstudioapi,
     glue,
-    knitr,
-    callr,
-    learnr (>= 0.9.2.9001),
-    readr,
     checkmate,
     testthat
 Remotes:

NAMESPACE

@@ -1,6 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-export(add_tutorial)
 export(check_code)
 export(check_result)
 export(condition)
@@ -15,10 +14,6 @@ export(grading_demo)
 export(pass_if)
 export(random_encourage)
 export(random_praise)
-export(result)
-export(test)
 export(test_result)
-export(test_solutions)
-export(view_tutorial)
 importFrom(rlang,"%||%")
 importFrom(utils,browseURL)

R/check_code.R

@@ -33,10 +33,9 @@
 #' @param glue_pipe A glue string that returns the final message displayed when a user uses a pipe,
 #'    \code{$>$}. Defaults to \code{getOption("gradethis_glue_pipe")}.
 #'
-#' @return a \code{grader_graded} structure from \code{\link{result}}.
+#' @return a \code{\link{graded}} object.
 #'   An incorrect message will describe the first way that the answer differs,
-#'   the message will be the content of the \code{correct}
-#'   argument.
+#'   the message will be the content of the \code{glue_pipe} argument.
 #'
 #' @export
 #' @examples

R/condition.R

@@ -0,0 +1,34 @@
+#' Condition object
+#' Captures what the user passes into \code{\link{pass_if}} or \code{\link{fail_if}},
+#' figures out what type of object was passed into \code{x},
+#' and returns a \code{grader_condition} object that will be passed into \code{evaluate_condi}
+#'
+#' @param x expression to be evaluated
+#' @param message character string for message returned
+#' @param correct logical whether the condition is the correct answer
+#'
+#' @return a \code{grader_condition} object that contains
+#'   the expression \code{x},
+#'   the message \code{message},
+#'   whether or not the expression is the correct answer or not, \code{correct},
+#'   the type of expression (formula, function, or value), \code{type}
+#' @export
+condition <- function(x, message, correct) {
+  type <-
+    if (rlang::is_formula(x)) {
+      "formula"
+    } else if (rlang::is_function(x)) {
+      "function"
+    } else {
+      "value"
+    }
+
+  ret <- list(
+    x = x,
+    message = message,
+    correct = correct,
+    type = type
+  )
+  class(ret) <- "grader_condition"
+  ret
+}

R/detect_mistakes.R

@@ -149,10 +149,6 @@ isolate_mismatch <- function(user, solution, i) {
   NULL
 }
 
-# named expects a vector of length one
-named <- function(vec) {
-  !is.null(names(vec)) && names(vec) != ""
-}
 
 real_name <- function(name) {
  !is.null(name) && name != ""

R/pass_fail_condi.R → R/evaluate_condition.R

@@ -1,54 +1,3 @@
-#' Pass if condition matches
-#' @template pass_fail_x_condition
-#' @param message chracter string for message returned
-#' @export
-pass_if <- function(x, message = NULL) {
-  condition(x, message, correct = TRUE)
-}
-
-#' Fail if condition matches
-#' @template pass_fail_x_condition
-#' @param message chracter string for message returned
-#' @export
-fail_if <- function(x, message = NULL) {
-  condition(x, message, correct = FALSE)
-}
-
-#' Condition object
-#' Captures what the user passes into \code{\link{pass_if}} or \code{\link{fail_if}},
-#' figures out what type of object was passed into \code{x},
-#' and returns a \code{grader_condition} object that will be passed into \code{evaluate_condi}
-#'
-#' @param x expression to be evaluated
-#' @param message character string for message returned
-#' @param correct logical whether the condition is the correct answer
-#'
-#' @return a \code{grader_condition} object that contains
-#'   the expression \code{x},
-#'   the message \code{message},
-#'   whether or not the expression is the correct answer or not, \code{correct},
-#'   the type of expression (formula, function, or value), \code{type}
-#' @export
-condition <- function(x, message, correct) {
-  type <-
-    if (rlang::is_formula(x)) {
-      "formula"
-    } else if (rlang::is_function(x)) {
-      "function"
-    } else {
-      "value"
-    }
-
-  ret <- list(
-    x = x,
-    message = message,
-    correct = correct,
-    type = type
-  )
-  class(ret) <- "grader_condition"
-  ret
-}
-
 #' Evaluates a condition
 #'
 #' @param condi a \code{grader} \code{\link{condition}} object

R/get_code.R

@@ -0,0 +1,27 @@
+#' Get Code
+#'
+#' Helper methods around \code{rlang::\link[rlang]{eval_tidy}}
+#' to extract user code and solution code.
+#'
+#' @seealso \code{\link{check_result}}, \code{\link{test_result}}, and \code{\link{check_code}}
+#' @export
+#' @rdname get_code
+#' @param user,solution,expr An expression or quosure to evaluate.
+#' @param name Name to print if a \code{NULL} expression is provided.
+#' @inheritParams rlang::eval_tidy
+get_user_code <- function(user = NULL, env = rlang::caller_env()) {
+  get_code(user, "user", env = env)
+}
+#' @export
+#' @rdname get_code
+get_solution_code <- function(solution = NULL, env = rlang::caller_env()) {
+  get_code(solution, "solution", env = env)
+}
+#' @export
+#' @rdname get_code
+get_code <- function(expr = NULL, name = "<name not provided>", env = rlang::caller_env()) {
+  if (is.null(expr)) {
+    stop("'", name, "' not provided")
+  }
+  rlang::eval_tidy(expr, env = env)
+}

R/grade_learnr.R

@@ -5,7 +5,7 @@
 #' For exercise checking, learnr tutorials require a function that learnr can
 #' use in the background to run the code in each "-check" chunk and to format
 #' the results into a format that learnr can display. The function must accept a
-#' specific set of inputs and return a specific type of output (see \code{\link{result}}).
+#' specific set of inputs and return a specific type of output (see \code{\link{graded}}).
 #' Users are not intended to use the function themselves, but to pass it to the
 #' \code{exercise.checker} knitr chunk option within the setup chunk of the
 #' tutorial.
@@ -91,7 +91,7 @@ grade_learnr <- function(label = NULL,
           eval(parsed_check_code[[i]], envir_prep)
         }
       }
-      grading_code <- pryr::standardise_call(parsed_check_code[[length(parsed_check_code)]],
+      grading_code <- rlang::call_standardise(parsed_check_code[[length(parsed_check_code)]],
                                              envir_prep)
 
       # get all grader args
@@ -160,33 +160,3 @@ grade_learnr <- function(label = NULL,
 
   ret
 }
-
-
-
-#' Get Code
-#'
-#' Helper methods around \code{rlang::\link[rlang]{eval_tidy}}
-#' to extract user code and solution code.
-#'
-#' @seealso \code{\link{check_result}}, \code{\link{test_result}}, and \code{\link{check_code}}
-#' @export
-#' @rdname get_code
-#' @param user,solution,expr An expression or quosure to evaluate.
-#' @param name Name to print if a \code{NULL} expression is provided.
-#' @inheritParams rlang::eval_tidy
-get_user_code <- function(user = NULL, env = rlang::caller_env()) {
-  get_code(user, "user", env = env)
-}
-#' @export
-#' @rdname get_code
-get_solution_code <- function(solution = NULL, env = rlang::caller_env()) {
-  get_code(solution, "solution", env = env)
-}
-#' @export
-#' @rdname get_code
-get_code <- function(expr = NULL, name = "<name not provided>", env = rlang::caller_env()) {
-  if (is.null(expr)) {
-    stop("'", name, "' not provided")
-  }
-  rlang::eval_tidy(expr, env = env)
-}

R/order_calls.R

@@ -36,15 +36,6 @@ pre_pipe <- function(code, name = "") {
   }
 }
 
-repipe <- function(lst, .call = FALSE) {
-  text <- purrr::map(lst, deparse)
-  text <- purrr::reduce(text, paste, sep = " %>% ")
-  text <- gsub("\\(NULL\\)", "()", text)
-
-  if (.call) parse(text = text)[[1]]
-  else text
-}
-
 renest <- function(lst, .call = FALSE) {
   lst <- rev(lst)
 

R/pass_fail_if.R

@@ -0,0 +1,15 @@
+#' Pass if condition matches
+#' @template pass_fail_x_condition
+#' @param message chracter string for message returned
+#' @export
+pass_if <- function(x, message = NULL) {
+  condition(x, message, correct = TRUE)
+}
+
+#' Fail if condition matches
+#' @template pass_fail_x_condition
+#' @param message chracter string for message returned
+#' @export
+fail_if <- function(x, message = NULL) {
+  condition(x, message, correct = FALSE)
+}

R/test_result.R

@@ -21,7 +21,7 @@
 #' @template learnr_args
 #' @param ... ignored
 #'
-#' @return a \code{grader_graded} structure from \code{\link{result}} containing
+#' @return a \code{grader_graded} structure from \code{\link{graded}} containing
 #'   a formatted \code{correct} or \code{incorrect} message.
 #' @seealso \code{test}
 #' @export
@@ -125,21 +125,3 @@ grader_tests <- function(...) {
     )
   )
 }
-#' TODO document with 'tests' documentation
-#' @export
-#' @rdname test
-#' @param message Message to report back if the test throws an error.
-#' @param fn function to execute against the user solution.
-#'   If the test fails, it should throw an error to display the \code{message} provided.
-test <- function(message, fn) {
-  function(x) {
-    tryCatch(
-      { # nolint
-        fn(x)
-      },
-      error = function(e) {
-        stop(message, call. = FALSE)
-      }
-    )
-  }
-}