From 5d7037fb9f02a3c4537ba169ba98f588fcd63bf4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 16 Oct 2021 21:30:31 +0200 Subject: [PATCH 1/2] rpp plugin and typed annotations --- .Rbuildignore | 1 + DESCRIPTION | 8 +- NAMESPACE | 1 + R/cc.R | 9 +- R/check-data.R | 3 +- R/comment-chks.R | 28 ++++++ R/zzz.R | 4 + chk.Rproj | 2 +- man/rpp_elide_chk_calls.Rd | 11 +++ tests/testthat/_snaps/comment-chks.md | 20 +++++ tests/testthat/test-cc.R | 19 ++-- tests/testthat/test-comment-chks.R | 120 ++++++++++++++++++++++++++ 12 files changed, 207 insertions(+), 19 deletions(-) create mode 100644 R/comment-chks.R create mode 100644 R/zzz.R create mode 100644 man/rpp_elide_chk_calls.Rd create mode 100644 tests/testthat/_snaps/comment-chks.md create mode 100644 tests/testthat/test-comment-chks.R diff --git a/.Rbuildignore b/.Rbuildignore index 5812a831..bafb3b37 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -17,3 +17,4 @@ ^\.github$ ^scripts$ ^\.gitignore$ +^Q$ diff --git a/DESCRIPTION b/DESCRIPTION index 2d790947..4ff7bd34 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,8 +39,13 @@ Suggests: covr, knitr, rmarkdown, + rpp, testthat (>= 3.0.0), + typed, withr +Remotes: + Q-language/rpp, + Q-language/typed VignetteBuilder: knitr RdMacros: @@ -48,5 +53,6 @@ RdMacros: Config/testthat/edition: 3 Encoding: UTF-8 Language: en-US -Roxygen: list(markdown = TRUE) +Roxygen: list(markdown = TRUE, roclets = c("collate", "namespace", "rd", "rpp::rpp_prod_roclet")) RoxygenNote: 7.1.2 +Config/rpp/plugins: list(typed::rpp_elide_types()) diff --git a/NAMESPACE b/NAMESPACE index c9d40c51..68f75a74 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -97,6 +97,7 @@ export(message_chk) export(msg) export(p) export(p0) +export(rpp_elide_chk_calls) export(unbacktick_chk) export(vld_all) export(vld_all_equal) diff --git a/R/cc.R b/R/cc.R index 06c787a8..1675c0bf 100644 --- a/R/cc.R +++ b/R/cc.R @@ -17,15 +17,16 @@ #' @return A string. #' @export #' +#' @name cc #' @examples #' cc(1:2) #' cc(1:2, conj = " or") #' cc(3:1, brac = "'") #' cc(1:11) #' cc(as.character(1:2)) -cc <- function(x, conj = ", ", sep = ", ", - brac = if (is.character(x) || is.factor(x)) "'" else "", - ellipsis = 10L, chk = TRUE) { +cc <- function(x , conj = ", ", sep = ", ", # !q cc <- Character()? function(x = ?Any(), conj = ", " ?Character(1), sep = ", " ?Character(1), + brac = if (is.character(x) || is.factor(x)) "'" else "", # !q brac = if (is.character(x) || is.factor(x)) "'" else "" ?Character(), + ellipsis = 10L, chk = TRUE) { # !q ellipsis = 10L ?Any(1), chk = TRUE ?Logical(1)) { if (chk) { chk_string(conj) chk_string(sep) @@ -39,7 +40,7 @@ cc <- function(x, conj = ", ", sep = ", ", return(character(0)) } x <- p0(brac[1], x, brac[length(brac)]) - n <- length(x) + n <- length(x) # not sure why not working with Integer # !q Any(1)? n <- length(x) # not sure why not working with Integer if (n == 1L) { return(x) } diff --git a/R/check-data.R b/R/check-data.R index 6cf33da7..876859fa 100644 --- a/R/check-data.R +++ b/R/check-data.R @@ -16,7 +16,8 @@ #' try(check_data(data.frame(x = 2), list(y = 1L))) #' try(check_data(data.frame(x = 2), list(y = 1))) #' try(check_data(data.frame(x = 2), nrow = 2)) -check_data <- function(x, values = NULL, exclusive = FALSE, order = FALSE, nrow = numeric(0), key = character(0), x_name = NULL) { +check_data <- function(x, values = NULL, exclusive = FALSE, order = FALSE, # !q check_data <- ?function(x, values = NULL, exclusive = FALSE ?Logical(1), order = FALSE ?Logical(1), + nrow = numeric(0), key = character(0), x_name = NULL) { # !q nrow = numeric(0), key = character(0) ?Character(), x_name = NULL ?Character(1, null_ok = TRUE)) { chk_data(x, "data.frame") if (is.null(values)) values <- structure(list(), .Names = character(0)) diff --git a/R/comment-chks.R b/R/comment-chks.R new file mode 100644 index 00000000..0f2cd791 --- /dev/null +++ b/R/comment-chks.R @@ -0,0 +1,28 @@ +comment_chks <- function(lines, ...) { + chk_vector(lines) + chk_character(lines) + chk_not_any_na(lines) + + rx <- "(^\\s*)((?:chk\\s*::\\s*)?che{0,1}c{0,1}k_[[:alpha:]](?:\\w|\\.)*\\s*\\()(.*#\\s*[+]chk(?:\\s|$))$" + + sub(rx, "\\1# !chk \\2\\3", lines, perl = TRUE) +} + +uncomment_chks <- function(lines, ...) { + chk_vector(lines) + chk_character(lines) + chk_not_any_na(lines) + + rx <- "^(\\s*)#\\s*!\\s*chk\\s" + + sub(rx, "\\1", lines) +} + +#' Elide Chk Calls +#' +#' @export +rpp_elide_chk_calls <- function() { + stopifnot(rlang::is_installed("rpp")) + + rpp::inline_plugin(dev = uncomment_chks, prod = comment_chks) +} diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 00000000..96938e3b --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,4 @@ +.onLoad <- function(libname, pkgname) { + # Called for the side effect of loading but not attaching the typed package: + requireNamespace("typed", quietly = TRUE) +} diff --git a/chk.Rproj b/chk.Rproj index 88ff2b5d..e97bec51 100644 --- a/chk.Rproj +++ b/chk.Rproj @@ -18,4 +18,4 @@ StripTrailingWhitespace: Yes BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source -PackageRoxygenize: rd,collate,namespace +PackageRoxygenize: rd,collate,namespace,rpp::rpp_prod_roclet diff --git a/man/rpp_elide_chk_calls.Rd b/man/rpp_elide_chk_calls.Rd new file mode 100644 index 00000000..583331f7 --- /dev/null +++ b/man/rpp_elide_chk_calls.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/comment-chks.R +\name{rpp_elide_chk_calls} +\alias{rpp_elide_chk_calls} +\title{Elide Chk Calls} +\usage{ +rpp_elide_chk_calls() +} +\description{ +Elide Chk Calls +} diff --git a/tests/testthat/_snaps/comment-chks.md b/tests/testthat/_snaps/comment-chks.md new file mode 100644 index 00000000..466ea177 --- /dev/null +++ b/tests/testthat/_snaps/comment-chks.md @@ -0,0 +1,20 @@ +# opt-in elision + + Code + writeLines(comment_chks(c("chk_stuff()", "chk_stuff() #+chk", + "chk_stuff() #+chk", "chk_stuff() #+chk anything", + "chk_stuff() # +chk", "chk_stuff() # +chk", + "chk_stuff() # +chk anything", "chk_stuff() # +chk", + "chk_stuff() # +chk", "chk_stuff() # +chk anything", NULL))) + Output + chk_stuff() + # !chk chk_stuff() #+chk + # !chk chk_stuff() #+chk + chk_stuff() #+chk anything + # !chk chk_stuff() # +chk + # !chk chk_stuff() # +chk + chk_stuff() # +chk anything + # !chk chk_stuff() # +chk + # !chk chk_stuff() # +chk + chk_stuff() # +chk anything + diff --git a/tests/testthat/test-cc.R b/tests/testthat/test-cc.R index 7364c4ac..15d6b488 100644 --- a/tests/testthat/test-cc.R +++ b/tests/testthat/test-cc.R @@ -16,21 +16,17 @@ test_that("cc with atomic vectors", { }) test_that("cc errors", { - expect_chk_error( + expect_error( cc(1, conj = 1), - "^`conj` must be a string [(]non-missing character scalar[)][.]$" ) - expect_chk_error( + expect_error( cc(1, conj = character(0)), - "^`conj` must be a string [(]non-missing character scalar[)][.]$" ) - expect_chk_error( - cc(1, conj = as.character(1:2)), - "^`conj` must be a string [(]non-missing character scalar[)][.]$" + expect_error( + cc(1, conj = as.character(1:2)) ) - expect_chk_error( + expect_error( cc(1, brac = 1), - "^`brac` must inherit from S3 class 'character'[.]$" ) expect_chk_error( cc(1, brac = character(0)), @@ -40,9 +36,8 @@ test_that("cc errors", { cc(1, brac = as.character(1:3)), "^`length[(]brac[)]` must be between 1 and 2, not 3[.]$" ) - expect_chk_error( - cc(1, sep = as.character(1:3)), - "^`sep` must be a string [(]non-missing character scalar[)][.]$" + expect_error( + cc(1, sep = as.character(1:3)) ) }) diff --git a/tests/testthat/test-comment-chks.R b/tests/testthat/test-comment-chks.R new file mode 100644 index 00000000..30dd46db --- /dev/null +++ b/tests/testthat/test-comment-chks.R @@ -0,0 +1,120 @@ +test_that("comment_chks works no length", { + expect_identical(comment_chks(character(0)), character(0)) +}) + +test_that("comment_chks requires opt in", { + expect_identical(comment_chks("chk_flag(TRUE)"), + "chk_flag(TRUE)") +}) + +test_that("comment_chks works single row", { + expect_identical(comment_chks("chk_flag(TRUE) # +chk"), + "# !chk chk_flag(TRUE) # +chk") +}) + +test_that("comment_chks works check", { + expect_identical(comment_chks("check_flag(TRUE) # +chk"), + "# !chk check_flag(TRUE) # +chk") +}) + +test_that("comment_chks works single row chk::", { + expect_identical(comment_chks("chk::chk_flag(TRUE) # +chk"), + "# !chk chk::chk_flag(TRUE) # +chk") +}) + +test_that("comment_chks works single row with spaces ", { + expect_identical(comment_chks(" chk :: chk_flag ( TRUE) # +chk "), + " # !chk chk :: chk_flag ( TRUE) # +chk ") +}) + +test_that("comment_chks works single row with two chk statements ", { + expect_identical(comment_chks("chk::chk_flag(TRUE); chk::chk_string(TRUE) # +chk"), + "# !chk chk::chk_flag(TRUE); chk::chk_string(TRUE) # +chk") +}) + +test_that("comment_chks works multiple rows ", { + expect_identical(comment_chks(c( + "chk_flag(TRUE) # +chk", + "chk_string(TRUE) # +chk")), + c("# !chk chk_flag(TRUE) # +chk", "# !chk chk_string(TRUE) # +chk")) +}) + +test_that("comment_chks works multiple rows only 1 chk ", { + expect_identical(comment_chks(c( + "chk_flag(TRUE) # +chk", + "is.string(TRUE) # +chk")), + c("# !chk chk_flag(TRUE) # +chk", "is.string(TRUE) # +chk")) +}) + +test_that("uncomment_chks works no length", { + expect_identical(uncomment_chks(character(0)), character(0)) +}) + +test_that("uncomment_chks works single row", { + expect_identical(uncomment_chks(comment_chks("# !chk chk_flag(TRUE)")), + "chk_flag(TRUE)") +}) + +test_that("uncomment_chks works check::", { + expect_identical(uncomment_chks(comment_chks("# !chk chk::check_flag(TRUE)")), + "chk::check_flag(TRUE)") +}) + +test_that("uncomment_chks works anything", { + expect_identical(uncomment_chks(comment_chks("# !chk anything(TRUE)")), + "anything(TRUE)") +}) + +test_that("uncomment_chks works single row with spaces ", { + expect_identical(uncomment_chks(comment_chks(" # !chk chk :: chk_flag ( TRUE)")), + " chk :: chk_flag ( TRUE)") +}) + +test_that("uncomment_chks works single row with two chk statements ", { + expect_identical(uncomment_chks(comment_chks("# !chk chk::chk_flag(TRUE); chk::chk_string(TRUE)")), + "chk::chk_flag(TRUE); chk::chk_string(TRUE)") +}) + +test_that("uncomment_chks works multiple rows ", { + expect_identical(uncomment_chks(comment_chks(c( + "# !chk chk_flag(TRUE)", + "# !chk chk_string(TRUE)"))), + c( + "chk_flag(TRUE)", + "chk_string(TRUE)")) +}) + +test_that("uncomment_chks works multiple rows only 1 chk ", { + expect_identical(uncomment_chks(comment_chks(c( + "# !chk chk_flag(TRUE)", + "is.string(TRUE)"))), + c("chk_flag(TRUE)", "is.string(TRUE)")) +}) + +test_that("uncomment_chks works gaps ", { + expect_identical(uncomment_chks(" # !chk chk_flag(TRUE)"), + " chk_flag(TRUE)") +}) + +test_that("uncomment_chks preserves indentation ", { + expect_identical(uncomment_chks(" # !chk chk_flag(TRUE)"), + " chk_flag(TRUE)") +}) + +test_that("opt-in elision", { + expect_snapshot({ + writeLines(comment_chks(c( + "chk_stuff()", + "chk_stuff() #+chk", + "chk_stuff() #+chk", + "chk_stuff() #+chk anything", + "chk_stuff() # +chk", + "chk_stuff() # +chk", + "chk_stuff() # +chk anything", + "chk_stuff() # +chk", + "chk_stuff() # +chk", + "chk_stuff() # +chk anything", + NULL + ))) + }) +}) From ddfa8294185c282dc833c7f8170de187f57c0ac0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 16 Oct 2021 21:41:25 +0200 Subject: [PATCH 2/2] Need import for now --- DESCRIPTION | 4 ++-- NAMESPACE | 1 + R/namespace.R | 1 + R/zzz.R | 4 ---- 4 files changed, 4 insertions(+), 6 deletions(-) delete mode 100644 R/zzz.R diff --git a/DESCRIPTION b/DESCRIPTION index 4ff7bd34..dd678231 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -34,14 +34,14 @@ Imports: lifecycle, methods, rlang, - tools + tools, + typed Suggests: covr, knitr, rmarkdown, rpp, testthat (>= 3.0.0), - typed, withr Remotes: Q-language/rpp, diff --git a/NAMESPACE b/NAMESPACE index 68f75a74..d28c7956 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -170,3 +170,4 @@ export(vld_wnum) export(wrn) import(lifecycle) import(rlang) +import(typed) diff --git a/R/namespace.R b/R/namespace.R index 099943bd..a879e41f 100644 --- a/R/namespace.R +++ b/R/namespace.R @@ -1,2 +1,3 @@ #' @import rlang lifecycle +#' @import typed NULL diff --git a/R/zzz.R b/R/zzz.R deleted file mode 100644 index 96938e3b..00000000 --- a/R/zzz.R +++ /dev/null @@ -1,4 +0,0 @@ -.onLoad <- function(libname, pkgname) { - # Called for the side effect of loading but not attaching the typed package: - requireNamespace("typed", quietly = TRUE) -}