Cover lint rstudio#15 (rstudio#17)

Fix linting issues * add r_binary_packages and after_success * fix lintr * r_github_packages, not r_binary_packages * covr comes from r-lib now * add .lintr file (does this set line_length_linter?) * function call, instead of assignment * update linter options * remove NULL in .lintr * add space to allow .lintr to parse * lint > 100 line widths * revert curly bracket in tryCatch (follow hadley style guide) * more 100 line length linting * disable object linter (cannot find global variables bug) * more lint 100 width * nolint * add the grader Rproj file * fix lint on snake_case and (change var name and docs) * nolint some inline pipes for testing * revert tryCatch block { } to own line
chendaniely · Jun 14, 2019 · dc63a6f · dc63a6f
1 parent 7cf0d3d
commit dc63a6f
Show file tree

Hide file tree

Showing 30 changed files with 209 additions and 149 deletions.
diff --git a/.gitignore b/.gitignore
@@ -24,7 +24,6 @@ vignettes/*.pdf
 *.knit.md
 .Rproj.user
 .DS_Store
-grader.Rproj
 scratch.R
 NEXT_STEPS.Rmd
 tmp

diff --git a/.lintr b/.lintr
@@ -0,0 +1,4 @@
+linters: with_defaults(
+    object_usage_linter = NULL,
+    line_length_linter = line_length_linter(100)
+  )
diff --git a/.travis.yml b/.travis.yml
@@ -49,3 +49,11 @@ jobs:
         github-token:
           secure:
             "BuNSl2Tp1GGS2ikn0zTzqUXu9bC6KaQBOYV6G8y8msidJAj/1M1sjhLO8BmP4moQ7XsoxAG1Zd+pvuE+vWVIQ/A7oMZU/WXQiymLtUXajSM4lj6+RwK9OS4/BiXia0B1rEUUmUJbX4C+yRBKHU9prNcuyZhG7RO6DTJPwodspL2ABPf4yap1Dfptj3O0ZheziC4NqPqndSGdjZos6sgvIGjEUNfjXQmBv9irpSfpZmzMzWNQvnkF9aCnsgxNcjLwClY73EfJTq3z9FN9EGpk8gRw+M2mhIKwT3N2P6XB4BCHtlIgXCw2TwwJpmuj1qLm2JvUdWx3LfBidxcv5pd9PKQffoYkdaOsX00kImEZtxH4xMCAzsKALLa4B8JyMls7lwEZsEAyU6JYDBraWIXM7s1GOu2lTcqQBpRk6bFU46FGaFfNglPgYbynP3PwGo12W+UsXK6LvuvnbfQKsNzXE2t7WEuMDOQraBU3NoZSQUwX37bAL28Iq5Vyx6XpgwHcayY+vRkNTZXGd7HK/refdhecpAAWi5SRx8I2ExEZ+9qFpw0KijWA2yJ/ksCfSX85EcIZka8PfvSgYYZWzcnD1iuHB+sLb6074h5ePJ+YIQRjZJAeXrOiyHHvmXRfKXUvPymX99VkSiqbVEFMfIendeMw6AcYynP+6WI+pqRf6EQ="
+
+r_github_packages:
+  - jimhester/lintr
+  - r-lib/covr
+
+after_success:
+  - Rscript -e 'covr::codecov()'
+  - Rscript -e 'lintr::lint_package()'
diff --git a/R/check_code.R b/R/check_code.R
@@ -26,10 +26,13 @@
 #'
 #' @param correct A character string to display if the student answer matches
 #'   the solution code.
-#'   This character string will be run through \code{glue::\link[glue]{glue_data}} with \code{list(correct = TRUE, message = NULL)}.
+#'   This character string will be run through \code{glue::\link[glue]{glue_data}} with
+#'   \code{list(correct = TRUE, message = NULL)}.
 #' @param incorrect A character string to display if the student answer matches
 #'   the solution code.
-#'   This character string will be run through \code{glue::\link[glue]{glue_data}} with \code{list(correct = FALSE, message = "<STRING>")} where message is the error found while comparing the user solution to the known solution.
+#'   This character string will be run through \code{glue::\link[glue]{glue_data}} with
+#'   \code{list(correct = FALSE, message = "<STRING>")}
+#'   where message is the error found while comparing the user solution to the known solution.
 #' @template grader_args
 #' @template learnr_args
 #'

diff --git a/R/check_result.R b/R/check_result.R
@@ -8,12 +8,16 @@
 #' @template correct
 #' @param incorrect A character string to display if the student answer matches
 #'   a known answer.
-#'   This character string will be run through \code{glue::\link[glue]{glue_data}} with \code{list(correct = FALSE, message = "<result message>")}. where message is the matched result message.
+#'   This character string will be run through
+#'   \code{glue::\link[glue]{glue_data}} with
+#'   \code{list(correct = FALSE, message = "<result message>")}.
+#'   where message is the matched result message.
 #' @template grader_args
 #' @template learnr_args
 #' @param ... ignored
 #'
-#' @return a \code{grader_graded} structure from \code{\link{result}} containing a formatted \code{correct} or \code{incorrect} message and whether or not a match was found.
+#' @return a \code{grader_graded} structure from \code{\link{result}} containing a formatted
+#'   \code{correct} or \code{incorrect} message and whether or not a match was found.
 #'
 #' @export
 #' @examples
@@ -53,7 +57,7 @@ check_result <- function(
       correct = final_result$correct,
       message = final_result$message
     ),
-    {if (final_result$correct) correct else incorrect}
+    {if (final_result$correct) correct else incorrect} # nolint
   )
 
   return(graded(

diff --git a/R/detect_mistakes.R b/R/detect_mistakes.R
@@ -15,7 +15,7 @@ detect_mistakes <- function(user,
 
     # Did the user miss something?
     if (i > length(user)) {
-      return(missing_argument(this_call = user[[i-1]],
+      return(missing_argument(this_call = user[[i - 1]],
                               that = solution[[i]],
                               that_name = names(solution[i])))
     }

diff --git a/R/grade_learnr.R b/R/grade_learnr.R
@@ -82,7 +82,7 @@ grade_learnr <- function(label = NULL,
 
   had_error_checking <- FALSE
   checked_result <- tryCatch(
-    {
+    { # nolint
       # Run checking code to get feedback
       parsed_check_code <- parse(text = check_code)
       if (length(parsed_check_code) > 1) {
@@ -91,21 +91,17 @@ grade_learnr <- function(label = NULL,
           eval(parsed_check_code[[i]], envir_prep)
         }
       }
-      grading_code <- pryr::standardise_call(parsed_check_code[[length(parsed_check_code)]], envir_prep)
+      grading_code <- pryr::standardise_call(parsed_check_code[[length(parsed_check_code)]],
+                                             envir_prep)
 
-      ## TODO - barret try to no force check fn to be last part of code
-
-      # # set args to . args for the environment
-      # envir_prep$.grader_args <- grader_args
-      # envir_prep$.learnr_args <- learnr_args
-
-      # get all grader_args
+      # get all grader args
       grader_args <- list(
         user_quo = rlang::as_quosure(user_code[[length(user_code)]], envir_result)
       )
 
       if (!is.null(solution_code)) {
-        grader_args$solution_quo <- rlang::as_quosure(solution_code[[length(solution_code)]], envir_prep)
+        grader_args$solution_quo <- rlang::as_quosure(solution_code[[length(solution_code)]],
+                                                      envir_prep)
       }
 
       # copy in all learnr arguments
@@ -169,7 +165,9 @@ grade_learnr <- function(label = NULL,
 
 #' Get Code
 #'
-#' Helper methods around \code{rlang::\link[rlang]{eval_tidy}} to extract user code and solution 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

diff --git a/R/grading_demo.R b/R/grading_demo.R
@@ -5,13 +5,16 @@
 #'
 #' The tutorial sets the learnr exercise. checker option to
 #' \code{grade_learnr()} in the document's setup chunk.
-#' It then uses three different exercise checking methods: \code{\link{check_result}}, \code{\link{test_result}}, and \code{\link{check_code}}.
+#' It then uses three different exercise checking methods:
+#' \code{\link{check_result}}, \code{\link{test_result}}, and \code{\link{check_code}}.
 #' To use a checking method, follow the exercise chunk with a chunk whose label
 #' matches the label of the exercise chunk (ex: \code{myexercise}) but includes the suffix
-#' \code{-check} (ex: \code{myexercise-check}). Call any checking method in that chunk. To ensure that
-#' checking method can provide informative feedback, you may provide custom \code{correct} and \code{incorrect} messages.
+#' \code{-check} (ex: \code{myexercise-check}). Call any checking method in that chunk.
+#' To ensure that checking method can provide informative feedback,
+#' you may provide custom \code{correct} and \code{incorrect} messages.
 #'
-#' If you are not using RStudio IDE, you can access the demo file at \code{system.file("extdata", "grading-demo/grading-demo.Rmd", package = "grader")}.
+#' If you are not using RStudio IDE, you can access the demo file at
+#' \code{system.file("extdata", "grading-demo/grading-demo.Rmd", package = "grader")}.
 #'
 #' @export
 #' @importFrom utils browseURL
@@ -20,6 +23,6 @@ grading_demo <- function() {
   if (rstudioapi::isAvailable()) {
     rstudioapi::navigateToFile(grading_demo_path)
   } else {
-    browseURL(paste0('file://', grading_demo_path))
+    browseURL(paste0("file://", grading_demo_path))
   }
 }
diff --git a/R/order_calls.R b/R/order_calls.R
@@ -41,7 +41,7 @@ repipe <- function(lst, .call = FALSE) {
   text <- purrr::reduce(text, paste, sep = " %>% ")
   text <- gsub("\\(NULL\\)", "()", text)
 
-  if(.call) parse(text = text)[[1]]
+  if (.call) parse(text = text)[[1]]
   else text
 }
 

diff --git a/R/praise.R b/R/praise.R
@@ -1,58 +1,64 @@
 # Praise messages
-.praise <- c("Absolutely fabulous!",
-             "Amazing!",
-             "Awesome!",
-             "Beautiful!",
-             "Bravo!",
-             "Cool job!",
-             "Delightful!",
-             "Excellent!",
-             "Fantastic!",
-             "Great work!",
-             "I couldn't have done it better myself.",
-             "Impressive work!",
-             "Lovely job!",
-             "Magnificent!",
-             "Nice job!",
-             "Out of this world!",
-             "Resplendent!",
-             "Smashing!",
-             "Someone knows what they're doing :)",
-             "Spectacular job!",
-             "Splendid!",
-             "Success!",
-             "Super job!",
-             "Superb work!",
-             "Swell job!",
-             "Terrific!",
-             "That's a first-class answer!",
-             "That's glorious!",
-             "That's marvelous!",
-             "Very good!",
-             "Well done!",
-             "What first-rate work!",
-             "Wicked smaht!",
-             "Wonderful!",
-             "You aced it!",
-             "You rock!",
-             "You should be proud.",
-             ":)")
+.praise <- c(
+  "Absolutely fabulous!",
+  "Amazing!",
+  "Awesome!",
+  "Beautiful!",
+  "Bravo!",
+  "Cool job!",
+  "Delightful!",
+  "Excellent!",
+  "Fantastic!",
+  "Great work!",
+  "I couldn't have done it better myself.",
+  "Impressive work!",
+  "Lovely job!",
+  "Magnificent!",
+  "Nice job!",
+  "Out of this world!",
+  "Resplendent!",
+  "Smashing!",
+  "Someone knows what they're doing :)",
+  "Spectacular job!",
+  "Splendid!",
+  "Success!",
+  "Super job!",
+  "Superb work!",
+  "Swell job!",
+  "Terrific!",
+  "That's a first-class answer!",
+  "That's glorious!",
+  "That's marvelous!",
+  "Very good!",
+  "Well done!",
+  "What first-rate work!",
+  "Wicked smaht!",
+  "Wonderful!",
+  "You aced it!",
+  "You rock!",
+  "You should be proud.",
+  ":)"
+)
 
 # Encouragement messages
-.encourage <- c("Please try again.",
-                "Give it another try.",
-                "Let's try it again.",
-                "Try it again; next time's the charm!",
-                "Don't give up now, try it one more time.",
-                "But no need to fret, try it again.",
-                "Try it again. I have a good feeling about this.",
-                "Try it again. You get better each time.",
-                "Try it again. Perseverence is the key to success.",
-                "That's okay: you learn more from mistakes than successes. Let's do it one more time.")
+.encourage <- c(
+  "Please try again.",
+  "Give it another try.",
+  "Let's try it again.",
+  "Try it again; next time's the charm!",
+  "Don't give up now, try it one more time.",
+  "But no need to fret, try it again.",
+  "Try it again. I have a good feeling about this.",
+  "Try it again. You get better each time.",
+  "Try it again. Perseverence is the key to success.",
+  "That's okay: you learn more from mistakes than successes. Let's do it one more time."
+)
 
 #' Random praise and encouragement
 #'
-#' Generate a random praise or encouragement phrase.  This can be used in conjunction with \code{glue::\link[glue]{glue}} to generate praise or encouragement within feedback to users.
+#' Generate a random praise or encouragement phrase.
+#' This can be used in conjunction with
+#' \code{glue::\link[glue]{glue}} to generate praise or encouragement within feedback to users.
 #'
 #' @examples
 #' replicate(5, glue::glue("Random praise: {random_praise()}"))

diff --git a/R/result.R b/R/result.R
@@ -1,6 +1,8 @@
 #' Result
 #'
-#' The \code{result} method returns an object containing information about what has been graded or what could be graded against.
+#' The \code{result} method returns an object containing information about what has been graded
+#' or what could be graded against.
+#'
 #' @param x object graded or being compared against
 #' @param message possible message value to be displayed
 #' @param correct a boolean that determines if the result is a correct result
@@ -25,7 +27,8 @@ result <- function(x, message = NULL, correct = FALSE) {
 
 #' Graded submission value
 #'
-#'The return value from \code{graded} should be returned by every \code{*-check} chunk when used with \code{link{grade_learnr}}.
+#'The return value from \code{graded} should be returned by every
+#'\code{*-check} chunk when used with \code{link{grade_learnr}}.
 #'
 #' @param message A character string of the message to be displayed.
 #' @param correct A boolean value of whether or not the checked code is correct.

diff --git a/R/test_result.R b/R/test_result.R
@@ -21,7 +21,8 @@
 #' @template learnr_args
 #' @param ... ignored
 #'
-#' @return a \code{grader_graded} structure from \code{\link{result}} containing a formatted \code{correct} or \code{incorrect} message.
+#' @return a \code{grader_graded} structure from \code{\link{result}} containing
+#'   a formatted \code{correct} or \code{incorrect} message.
 #' @seealso \code{test}
 #' @export
 #' @examples
@@ -46,7 +47,7 @@ test_result <- function(
 
   results <- lapply(tests$fns, function(test_fn) {
     tryCatch(
-      {
+      { # nolint
         test_fn(user_answer)
         graded(
           correct = TRUE,
@@ -74,7 +75,7 @@ test_result <- function(
         if (!resu$correct) resu$message else NULL
       }))
     ),
-    {if (is_correct) correct else incorrect}
+    {if (is_correct) correct else incorrect} # nolint
   )
 
   return(graded(
@@ -87,7 +88,8 @@ test_result <- function(
 #' Tests to check
 #'
 #' Collect a set of test to execute against a user's result value
-#' @param ... a set of functions that will accept the evaluated user solution. If the test fails, it should throw an error with the message to display.
+#' @param ... a set of functions that will accept the evaluated user solution.
+#'   If the test fails, it should throw an error with the message to display.
 #' @noRd
 #' @rdname test
 #' @examples
@@ -131,11 +133,12 @@ grader_tests <- function(...) {
 #' @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.
+#' @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) {