Merge remote-tracking branch 'origin/rel-6.5.2440'

Crunch-io · Feb 22, 2024 · 799df38 · 799df38
2 parents 9e4cc5a + b81a53d
commit 799df38
Show file tree

Hide file tree

Showing 18 changed files with 120 additions and 80 deletions.
diff --git a/.lintr b/.lintr
@@ -1,2 +1,2 @@
-linters: with_defaults(line_length_linter(100), commented_code_linter = NULL, closed_curly_linter = NULL, object_name_linter = NULL, commas_linter = NULL, spaces_left_parentheses_linter = NULL, cyclocomp_linter(complexity_limit = 16))
-exclusions: list("tests/testthat/helper-contexts.R", "tests/testthat/helper-expectations.R", "inst/crunch-test.R", "R/SO-survey.R")
+linters: linters_with_defaults(line_length_linter(100), commented_code_linter = NULL, brace_linter = NULL, object_name_linter = NULL, commas_linter = NULL, spaces_left_parentheses_linter = NULL, cyclocomp_linter(complexity_limit = 16), indentation_linter = NULL, infix_spaces_linter = NULL, T_and_F_symbol_linter = NULL, object_usage_linter = NULL, vector_logic_linter = NULL, paren_body_linter= NULL, quotes_linter = NULL)
+exclusions: list("tests/testthat/helper-contexts.R", "tests/testthat/helper-expectations.R", "inst/crunch-test.R", "R/SO-survey.R", "vignettes/")
diff --git a/Makefile b/Makefile
@@ -19,7 +19,7 @@ install-ci: deps
 	R -e 'devtools::session_info(installed.packages()[, "Package"])'
 
 test-ci: compress-fixtures |
-	R --slave -e 'library(covr); install_dir <- tempfile(); to_cobertura(package_coverage(quiet=FALSE, install_path=install_dir, clean=FALSE)); for (file in list.files(install_dir, pattern = "\\.Rout(\\.fail)?$$", recursive=TRUE, full.names=TRUE)) { cat(readLines(file), sep = "\n"); cat("\n") }'
+	R --slave -e 'library(covr); install_dir <- tempfile(); test_run <- try(to_cobertura(package_coverage(quiet=FALSE, install_path=install_dir, clean=FALSE))); for (file in list.files(install_dir, pattern = "\\.Rout(\\.fail)?$$", recursive=TRUE, full.names=TRUE)) { cat(readLines(file), sep = "\n"); cat("\n") }; if (inherits(test_run, "try-error")) stop("Test failed!\n", attr(test_run, "condition")[["message"]], "\n", format(attr(test_run, "condition")[["call"]]))'
 
 clean:
 	R --slave -e 'library(crunch); set_crunch_opts(crunch.api=envOrOption("test.api"), crunch.api.key=envOrOption("crunch.test.api.key")); lapply(urls(datasets()), crDELETE)'

diff --git a/R/AllGenerics.R b/R/AllGenerics.R
@@ -493,4 +493,7 @@ fortify.CrunchDataFrame <- function(model, data, ...) model
 #' @export fortify.CrunchDataset
 fortify.CrunchDataset <- function(model, data, ...) model
 
-setGeneric("sendCrunchAutomationScript", function(x, ...) standardGeneric("sendCrunchAutomationScript"))
+setGeneric(
+    "sendCrunchAutomationScript",
+    function(x, ...) standardGeneric("sendCrunchAutomationScript")
+)
diff --git a/R/api.R b/R/api.R
@@ -223,7 +223,10 @@ handleAPIfailure <- function(code, response) {
             # but we adapt to those on a case-by-case basis, like crunchAutomationErrorHandler)
             if (is.character(err_content$message) && length(err_content$message) == 1) {
                 msg2 <- err_content$message
-            } else if (is.character(err_content$description) && length(err_content$description) == 1) {
+            } else if (
+                is.character(err_content$description) &&
+                length(err_content$description) == 1
+            ) {
                 msg2 <- err_content$description
             }
         }

diff --git a/R/automation.R b/R/automation.R
@@ -197,39 +197,45 @@ setMethod("sendCrunchAutomationScript", "CrunchDataset", function(x,
     invisible(NULL)
 })
 
-setMethod("sendCrunchAutomationScript", "ProjectFolder", function(x,
-                                                                  script,
-                                                                  is_file = string_is_file_like(script),
-                                                                  encoding = "UTF-8",
-                                                                  ...) {
-    # project folders include a slot views with element execute,
-    # which gives us the URL to hit;
-    # but the account ('top-level folder', what you get from: `projects()`)
-    # is also of class ProjectFolder, but doesn't include this info;
-    # running CA scripts on the account is not supported currently
-    if (!is.crunchURL(x@views$execute)) {
-        halt(
-            "This folder does not support Crunch Automation scripts at this time."
-        )
-    }
+setMethod(
+    "sendCrunchAutomationScript",
+    "ProjectFolder",
+    function(
+        x,
+        script,
+        is_file = string_is_file_like(script),
+        encoding = "UTF-8",
+        ...
+    ) {
+        # project folders include a slot views with element execute,
+        # which gives us the URL to hit;
+        # but the account ('top-level folder', what you get from: `projects()`)
+        # is also of class ProjectFolder, but doesn't include this info;
+        # running CA scripts on the account is not supported currently
+        if (!is.crunchURL(x@views$execute)) {
+            halt(
+                "This folder does not support Crunch Automation scripts at this time."
+            )
+        }
 
-    dots <- list(...)
-    if (length(dots) > 0) {
-        # could have been a warning, but went with error in case a user
-        # would try running a destructive operation with dry_run = TRUE
-        stop("extra arguments (...) are not supported when x is a ProjectFolder")
-    }
+        dots <- list(...)
+        if (length(dots) > 0) {
+            # could have been a warning, but went with error in case a user
+            # would try running a destructive operation with dry_run = TRUE
+            stop("extra arguments (...) are not supported when x is a ProjectFolder")
+        }
 
-    crPOST(
-        shojiURL(x, "views", "execute"),
-        body = toJSON(wrapView(value = script)),
-        status.handlers = list(`400` = crunchAutomationErrorHandler),
-        progress.handler = crunchAutomationErrorHandler,
-        config = add_headers(`Content-Type` = "application/json")
-    )
+        crPOST(
+            shojiURL(x, "views", "execute"),
+            body = toJSON(wrapView(value = script)),
+            status.handlers = list(`400` = crunchAutomationErrorHandler),
+            progress.handler = crunchAutomationErrorHandler,
+            config = add_headers(`Content-Type` = "application/json")
+        )
 
-    invisible(NULL)
-})
+        invisible(NULL)
+    }
+)
 
 string_is_file_like <- function(x) {
     length(x) == 1 && # length 1 string

diff --git a/R/hide-variables.R b/R/hide-variables.R
@@ -15,9 +15,9 @@
 #' - `hide()` / `privatize()` - take a `CrunchVariable` or `VariableCatalog` and
 #'    make them hidden/private. (`unhide()` / `deprivatize()` put them back in the main
 #'    variable catalog).
-#' - `hiddenFolder()` / `privateFolder()` / `publicFolder()` - take a dataset and return a folder that
-#'   contains the public/hidden/private variables. This folder is like other `CrunchFolder`s and
-#'   so you can use [`mkdir()`] to create subfolders and [`mv()`] to move them in/out.
+#' - `hiddenFolder()` / `privateFolder()` / `publicFolder()` - take a dataset and return a folder
+#'   that contains the public/hidden/private variables. This folder is like other `CrunchFolder`s
+#'   and so you can use [`mkdir()`] to create subfolders and [`mv()`] to move them in/out.
 #' - `hiddenVariables()` / `privateVariabiles()` - return a character vector of variables
 #'    that are hidden/private. You can assign into the catalog to add variables or
 #'    assign to `NULL` to remove all of them.
@@ -146,4 +146,4 @@ hiddenVariables <- function(dataset, key = namekey(dataset)) {
     } else {
         return(c())
     }
-}
+}
diff --git a/data-raw/SO-survey.R b/data-raw/SO-survey.R
@@ -1,4 +1,5 @@
-stack_df <- read.csv("data-raw/survey_results_public.csv") ## This file is big and not checked into git
+## This file is big and not checked into git
+stack_df <- read.csv("data-raw/survey_results_public.csv")
 
 r_users <- grep("R;|R$", stack_df$HaveWorkedLanguage)
 keepvars <- c(

diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
@@ -21,4 +21,4 @@ decompress_fixtures()
 set_crunch_opts(
     "old.crunch.api" = crunch:::get_crunch_opt("crunch.api"),
     "crunch.api" = "https://app.crunch.io/api/"
-)
+)
diff --git a/tests/testthat/test-append-debug.R b/tests/testthat/test-append-debug.R
@@ -73,11 +73,15 @@ with_test_authentication({
             ds1 <- refresh(ds1)
             ds1$comb <- combine(ds1$petloc,
                                 name = "Comb 1",
-                                combinations = list(list(name = "Mammals", categories = c("Cat", "Dog")))
+                                combinations = list(
+                                    list(name = "Mammals", categories = c("Cat", "Dog"))
+                                )
             )
             ds1$comb2 <- combine(ds1$petloc,
                                  name = "Comb 2",
-                                 combinations = list(list(name = "Mammals", categories = c("Cat", "Dog")))
+                                 combinations = list(
+                                     list(name = "Mammals", categories = c("Cat", "Dog"))
+                                 )
             )
             test_that("The array has one fewer subvars in ds1", {
                 expect_identical(aliases(subvariables(ds1$petloc)), "petloc_home")

diff --git a/tests/testthat/test-automation.R b/tests/testthat/test-automation.R
@@ -48,7 +48,7 @@ with_mock_crunch({
         expect_POST(
             fixed = TRUE,
             suppressWarnings(
-                runCrunchAutomation(dataset = ds, script_text, foo = 1, bar = 2)  
+                runCrunchAutomation(dataset = ds, script_text, foo = 1, bar = 2)
             ),
             "https://app.crunch.io/api/datasets/1/scripts/",
             '{"element":"shoji:entity",',
@@ -281,12 +281,12 @@ with_mock_crunch({
             expected
         )
     })
-    
+
     test_that("folder-level operation fails on root", {
-        
+
         root_project_folder <- projects()
         script <- "CREATE FOLDER 'My not-to-be folder';"
-        
+
         expect_error(
             runCrunchAutomation(root_project_folder, script),
             "not support Crunch Automation scripts"
@@ -309,17 +309,17 @@ with_mock_crunch({
             fixed = TRUE
         )
     })
-    
+
     test_that("extra arguments result in an error for folder-level operations", {
-        
+
         project_folder   <- cd(projects(), 'Project One')
         script           <- "CREATE FOLDER 'My to-be folder';"
         expected_url     <- "https://app.crunch.io/api/projects/project1/execute/"
         expected_body    <- paste0(
             '{"element":"shoji:view",',
             paste0('"value":', '"', script, '"'), '}'
         )
-        
+
         expect_error(
             expect_POST(
                 runCrunchAutomation(project_folder, script, foo = 1, bar = '2'),

diff --git a/tests/testthat/test-cube-subset.R b/tests/testthat/test-cube-subset.R
@@ -102,7 +102,10 @@ if (tolower(Sys.info()[["sysname"]]) != "windows") {
                 )
             )
         )
-        expect_identical(subsetArrayDimension(cat_x_mr_x_mr@dims[[1]], 1:2, "categorical"), expected)
+        expect_identical(
+            subsetArrayDimension(cat_x_mr_x_mr@dims[[1]], 1:2, "categorical"),
+            expected
+        )
     })
 
     test_that("subsetArrayDimension MR dimension", {
@@ -285,9 +288,15 @@ if (tolower(Sys.info()[["sysname"]]) != "windows") {
         expect_equal(as.array(subset_cat_x_mr_x_mr), as.array(cat_x_mr_x_mr)[1:2, , ])
 
         subset_cat_x_mr_x_mr_withNA <- cat_x_mr_x_mr_withNA[c(1, 3), , ]
-        expect_equal(as.array(subset_cat_x_mr_x_mr_withNA), as.array(cat_x_mr_x_mr_withNA)[c(1, 3), , ])
+        expect_equal(
+            as.array(subset_cat_x_mr_x_mr_withNA),
+            as.array(cat_x_mr_x_mr_withNA)[c(1, 3), , ]
+        )
         subset_cat_x_mr_x_mr_withNA <- cat_x_mr_x_mr_withNA[c(1, 2), , ]
-        expect_equal(as.array(subset_cat_x_mr_x_mr_withNA), as.array(cat_x_mr_x_mr_withNA)[c(1, 2), , ])
+        expect_equal(
+            as.array(subset_cat_x_mr_x_mr_withNA),
+            as.array(cat_x_mr_x_mr_withNA)[c(1, 2), , ]
+        )
 
         # subset cols
         # drop the No Data row which is #2 here!
@@ -298,9 +307,15 @@ if (tolower(Sys.info()[["sysname"]]) != "windows") {
         expect_equal(as.array(subset_cat_x_mr_x_mr), as.array(cat_x_mr_x_mr)[, c(1, 3), ])
 
         subset_cat_x_mr_x_mr_withNA <- cat_x_mr_x_mr_withNA[, c(1, 3), ]
-        expect_equal(as.array(subset_cat_x_mr_x_mr_withNA), as.array(cat_x_mr_x_mr_withNA)[, c(1, 3), ])
+        expect_equal(
+            as.array(subset_cat_x_mr_x_mr_withNA),
+            as.array(cat_x_mr_x_mr_withNA)[, c(1, 3), ]
+        )
         subset_cat_x_mr_x_mr_withNA <- cat_x_mr_x_mr_withNA[, c(1, 2), ]
-        expect_equal(as.array(subset_cat_x_mr_x_mr_withNA), as.array(cat_x_mr_x_mr_withNA)[, c(1, 2), ])
+        expect_equal(
+            as.array(subset_cat_x_mr_x_mr_withNA),
+            as.array(cat_x_mr_x_mr_withNA)[, c(1, 2), ]
+        )
 
         # subset cols with drop
         subset_cat_x_mr_x_mr <- cat_x_mr_x_mr[, 3, ]

diff --git a/tests/testthat/test-cube-transforms.R b/tests/testthat/test-cube-transforms.R
@@ -696,7 +696,7 @@ if (tolower(Sys.info()[["sysname"]]) != "windows") {
         )
 
         # malform the transform for animals only
-        pet_feeling_bad_feelings@dims$feelings$references$view$transform$insertions[[2]]$anchor <- NA
+        pet_feeling_bad_feelings@dims$feelings$references$view$transform$insertions[[2]]$anchor <- NA # nolint
         expect_warning(
             expect_equivalent(applyTransforms(pet_feeling_bad_feelings), only_feelings),
             "Transforms for dimensions 1 were malformed and have been ignored."
@@ -815,8 +815,8 @@ if (tolower(Sys.info()[["sysname"]]) != "windows") {
         all <- cubify(
             7.09439811221956, 29.943091432266, 26.594536972556, 104.244359622909, 235.256710642724,
             28.3930651341193, 99.907133775628, 121.487888771867, 399.597650747672, 626.93247871747,
-            16.4723263871271, 41.5273628588211, 58.5641962784524, 183.864543659439, 234.846288302351,
-            4.82634063477261, 28.4366794845409, 36.3291555208591, 111.488747465324, 156.829479772395,
+            16.4723263871271, 41.5273628588211, 58.5641962784524, 183.864543659439, 234.846288302351, # nolint
+            4.82634063477261, 28.4366794845409, 36.3291555208591, 111.488747465324, 156.829479772395, # nolint
             12.217223612475, 42.1476791820657, 89.3309048228944, 218.631137785724, 171.129707467715,
             12.217223612475, 42.1476791820657, 89.3309048228944, 218.631137785724, 171.129707467715,
             dims = cat_mr_dims_subtotals
@@ -832,12 +832,12 @@ if (tolower(Sys.info()[["sysname"]]) != "windows") {
 
     test_that("cat by mr, with cat subtotals (margins and proportions)", {
         row_margin <- cubify(
-            51.911366492838, 69.0306061146165, 70.6657653721693, 142.042366487671, 253.602877279968,
-            197.750644752234, 263.820951392254, 276.216370215392, 509.242733468184, 726.557193538396,
-            93.7790931477866, 121.118408249056, 130.06549190286, 231.730645711963, 279.991871527124,
-            52.0601851116097, 73.6719370285819, 75.4851129403625, 135.46972126855, 192.962444731304,
-            70.2849657255216, 94.3678915294494, 135.475226421184, 251.200447977195, 215.124923979429,
-            70.2849657255216, 94.3678915294494, 135.475226421184, 251.200447977195, 215.124923979429,
+            51.911366492838, 69.0306061146165, 70.6657653721693, 142.042366487671, 253.602877279968, # nolint
+            197.750644752234, 263.820951392254, 276.216370215392, 509.242733468184, 726.557193538396, # nolint
+            93.7790931477866, 121.118408249056, 130.06549190286, 231.730645711963, 279.991871527124, # nolint
+            52.0601851116097, 73.6719370285819, 75.4851129403625, 135.46972126855, 192.962444731304, # nolint
+            70.2849657255216, 94.3678915294494, 135.475226421184, 251.200447977195, 215.124923979429, # nolint
+            70.2849657255216, 94.3678915294494, 135.475226421184, 251.200447977195, 215.124923979429, # nolint
             dims = cat_mr_dims_subtotals
         )
         expect_equivalent(as.array(margin.table(cat_mr, 1)), row_margin)

diff --git a/tests/testthat/test-expressions.R b/tests/testthat/test-expressions.R
@@ -220,7 +220,7 @@ if (tolower(Sys.info()[["sysname"]]) != "windows") {
         })
 
         test_that("Show method for expresssions", {
-            skip("TODO: something intelligent with parentheses and order of operations (GH issue #99)")
+            skip("TODO: something smart with parentheses and order of operations (GH issue #99)")
             print(ds$birthyr * 3 + 5)
             print(3 * (ds$birthyr + 5))
         })
@@ -238,7 +238,7 @@ if (tolower(Sys.info()[["sysname"]]) != "windows") {
                 unclass(toJSON(expr@expression)),
                 paste0(
                     '{"function":"difftime","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/starttime/"},', #nolint
-                    '{"variable":"https://app.crunch.io/api/datasets/1/variables/starttime/"},null]}'
+                    '{"variable":"https://app.crunch.io/api/datasets/1/variables/starttime/"},null]}' # nolint
                 )
             )
 

diff --git a/tests/testthat/test-folders.R b/tests/testthat/test-folders.R
@@ -259,7 +259,9 @@ if (tolower(Sys.info()[["sysname"]]) != "windows") {
             )
             ## Duplicates are resolved
             expect_PATCH(
-                ds %>% cd("Group 1") %>% mv(c(starts_with("Birth"), ends_with("Year")), "../Group 2"),
+                ds %>%
+                    cd("Group 1") %>%
+                    mv(c(starts_with("Birth"), ends_with("Year")), "../Group 2"),
                 add_birthyr_to_group2
             )
             expect_PATCH(