tests/testthat/test-variable-folders.R

In Crunch-io/rcrunch: Crunch.io Data Tools

context("Variable folders")

with_mock_crunch({
    ds <- cachedLoadDataset("test ds")

    test_that("Can load the root public variable folder", {
        expect_is(publicFolder(ds), "VariableFolder")
    })
    test_that("Folder contents are ordered by @graph", {
        expect_identical(names(publicFolder(ds)), c("Group 1", "Group 2"))
    })
    test_that("Other folder methods", {
        expect_identical(types(publicFolder(ds)), c("folder", "folder"))
    })

    test_that("Can [[ from a folder", {
        expect_is(publicFolder(ds)[[1]], "VariableFolder")
        expect_identical(name(publicFolder(ds)[[1]]), "Group 1")
        expect_is(publicFolder(ds)[["Group 2"]], "VariableFolder")
        expect_identical(name(publicFolder(ds)[["Group 2"]]), "Group 2")
    })

    g1 <- publicFolder(ds)[[1]]
    test_that("Folder with heterogeneous types", {
        expect_identical(names(g1), c("Birth Year", "Nested", "Text variable ftw"))
        expect_identical(types(g1), c("numeric", "folder", "text"))
        expect_identical(aliases(g1), c("birthyr", NA, "textVar"))
        # Extracting by alias
        expect_identical(
            names(g1[c("birthyr", "textVar")]),
            c("Birth Year", "Text variable ftw")
        )
    })
    test_that("variables() method on folders", {
        expect_identical(aliases(variables(g1)), c("birthyr", "textVar"))
    })
    test_that("Get folder from a folder (via $)", {
        expect_is(g1$Nested, "VariableFolder")
        expect_identical(name(g1$Nested), "Nested")
    })
    test_that("Get a variable from a folder", {
        expect_is(g1[[1]], "NumericVariable")
        expect_identical(name(g1[[1]]), "Birth Year")
        ## Not identical to ds$birthyr bc the catalog tuples have different
        ## contents, but they work the same
        expect_identical(self(g1[[1]]), self(ds$birthyr))
        expect_identical(summary(g1[[1]]), summary(ds$birthyr))
    })

    test_that("Extract from a folder by path", {
        expect_is(publicFolder(ds)[["Group 1/Nested"]], "VariableFolder")
        expect_identical(publicFolder(ds)[["Group 1/Nested"]], g1$Nested)
        expect_is(publicFolder(ds)[["Group 1/Birth Year"]], "NumericVariable")
        expect_identical(name(publicFolder(ds)[["Group 1/Birth Year"]]), "Birth Year")
        expect_is(publicFolder(ds)[["Group 1/birthyr"]], "NumericVariable")
    })

    test_that("Folder extract error handling", {
        expect_null(publicFolder(ds)[["foo"]])
        expect_null(publicFolder(ds)[["Group 1/foo"]])
        expect_error(
            publicFolder(ds)[["Group 1/foo/bar/baz"]],
            '"Group 1/foo/bar/baz" is an invalid path: foo is not a folder'
        )
        expect_error(
            publicFolder(ds)[["Group 1/Birth Year/bar/baz"]],
            '"Group 1/Birth Year/bar/baz" is an invalid path: Birth Year is not a folder'
        )
        expect_error(
            publicFolder(ds)[["Group 1/birthyr/bar/baz"]],
            '"Group 1/birthyr/bar/baz" is an invalid path: birthyr is not a folder'
        )
    })

    test_that("Set a folder's name", {
        expect_PATCH(
            name(publicFolder(ds)[[1]]) <- "First",
            "https://app.crunch.io/api/datasets/1/folders/1/",
            '{"element":"shoji:catalog","body":{"name":"First"}}'
        )
    })
    test_that("But top-level folder doesn't have a name and you can't set it", {
        skip("TODO")
    })
    test_that("Set names of objects inside a folder", {
        expect_PATCH(
            names(publicFolder(ds)[[1]]) <- c(
                "Year of Birth", "A folder in a folder", "Plain text"
            ),
            "https://app.crunch.io/api/datasets/1/folders/1/",
            '{"element":"shoji:catalog","index":',
            '{"https://app.crunch.io/api/datasets/1/variables/birthyr/":',
            '{"name":"Year of Birth"},',
            '"https://app.crunch.io/api/datasets/1/folders/3/":',
            '{"name":"A folder in a folder"},',
            '"https://app.crunch.io/api/datasets/1/variables/textVar/":',
            '{"name":"Plain text"}}}'
        )
    })
    test_that("Set a variable's name inside a folder", {
        ## Note that this patches the catalog (folder) instead of the entity.
        ## Historical reasons, plus ensuring that name<- on entity and
        ## names<- on catalog do the same thing
        expect_PATCH(
            name(publicFolder(ds)[["Group 1/Birth Year"]]) <- "Year of birth",
            "https://app.crunch.io/api/datasets/1/folders/1/",
            '{"https://app.crunch.io/api/datasets/1/variables/birthyr/":',
            '{"name":"Year of birth"}}'
        )
    })

    test_that("folder() finds the parent folder", {
        expect_identical(ds %>% cd("Group 1") %>% folder(), publicFolder(ds))
        expect_identical(folder(cd(ds, "Group 1/Nested")), cd(ds, "Group 1"))
        expect_identical(
            folder(publicFolder(ds)[["Group 1/Birth Year"]]),
            cd(ds, "Group 1")
        )
        expect_null(folder(publicFolder(ds)))
        expect_error(folder("string"), "No folder for object of class character")
    })

    test_that("rootFolder() finds the top level", {
        expect_identical(rootFolder(publicFolder(ds)), publicFolder(ds))
        expect_identical(rootFolder(publicFolder(ds)[["Group 1/Nested"]]), publicFolder(ds))
        expect_identical(rootFolder(ds$birthyr), publicFolder(ds))
    })

    test_that("delete folder", {
        expect_error(
            delete(publicFolder(ds)[["Group 1/Nested"]]),
            "Must confirm deleting folder"
        )
        with_consent({
            expect_DELETE(
                delete(publicFolder(ds)[["Group 1/Nested"]]),
                "https://app.crunch.io/api/datasets/1/folders/3/"
            )
        })
        expect_error(
            delete(publicFolder(ds)),
            "Cannot delete root folder"
        )
    })

    test_that("path()", {
        expect_identical(path(publicFolder(ds)[["Group 1/Nested"]]), "/Group 1/Nested") # nolint
        expect_identical(path(ds$birthyr), "/Group 1/Birth Year") # nolint
        expect_identical(path(publicFolder(ds)), "/")
    })

    with(temp.option(crayon.enabled = FALSE), {
        test_that("print folders: basic", {
            ## Coloring aside, the default print method should look like you
            ## printed the vector of names (plus the path printed above)
            expect_output(
                print(publicFolder(ds)),
                capture.output(print(names(publicFolder(ds)))),
                fixed = TRUE
            )
        })
        test_that("An empty folder doesn't error on printing", {
            expect_output(
                print(VariableFolder()),
                "folder(0)",
                fixed = TRUE
            )
        })
        test_that("If there are names longer than 'width', it still prints", {
            skip_on_jenkins("Unskip when testthat is next updated on jenkins")
            alphabet <- paste(letters, collapse = "")
            expect_output(
                colored_print(alphabet),
                '[1] "abcdefghijklmnopqrstuvwxyz"',
                fixed = TRUE,
                width = 10
            )
        })
        test_that("Folder tree printing", {
            ## These are obfuscated because of archaic restrictions on UTF-8
            skip_on_cran()
            source("print-folders.R", encoding = "UTF-8", local = TRUE)
        })
    })

    test_that("copyFolders returns the target dataset with the order applied", {
        ds_again <- cachedLoadDataset("test ds")
        expect_silent(new_order <- copyFolders(ds, ds_again))
        expect_is(new_order, "CrunchDataset")
        expect_identical(entities(ordering(ds)), entities(ordering(new_order)))
    })

    test_that("copyFolders input validation", {
        expect_error(
            copyFolders(ds, "foo"),
            "Both source and target must be Crunch datasets."
        )
    })
})


with_test_authentication({
    ds <- createDataset(name = now())
    test_that("folders are enabled by default in the tests", {
        expect_true(settings(ds)$variable_folders)
    })

    ds <- newDataset(df)
    test_that("copyFolders copies across datasets with simple order", {
        ds_fork <- forkDataset(ds)
        old_order <- capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10))
        ds %>% cd("/") %>% setOrder(c("v1", "v2", "v5", "v6", "v3", "v4"))
        ds <- refresh(ds)

        # test that ds_fork has the old order still
        expect_identical(
            capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
            old_order
        )
        expect_false(identical(
            capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
            capture_output_lines(publicFolder(ds) %>% print(depth = 10))
        ))

        # copy order, and check that ds_fork has the new order.
        ds_fork <- copyFolders(ds, ds_fork)

        expect_identical(
            capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
            capture_output_lines(publicFolder(ds) %>% print(depth = 10))
        )
    })

    test_that("copyFolders copies across datasets with simple(-ish) order (and one nesting)", {
        ds_fork <- forkDataset(ds)
        old_order <- capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10))
        ds %>% cd("/") %>% mkdir("Group A") %>% mv(c("v4", "v3"), "Group A")

        # test that ds_fork has the old order still
        expect_identical(
            capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
            old_order
        )
        expect_false(identical(
            capture_output_lines(publicFolder(ds) %>% print(depth = 10)),
            capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10))
        ))

        # copy order, and check that ds_fork has the new order.
        ds_fork <- copyFolders(ds, ds_fork)
        expect_identical(
            capture_output(publicFolder(ds_fork) %>% print(depth = 10)),
            capture_output(publicFolder(ds) %>% print(depth = 10))
        )
    })


    test_that("copyFolders copies across datasets with nested hierarchical order", {
        ds_fork <- forkDataset(ds)
        old_order <- capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10))

        # reset order
        ds %>% mv(aliases(allVariables(ds)), "/")

        ds %>%
            mkdir("Group 1") %>%
            mv(c("v1", "v2"), "Group 1") %>%
            mkdir("Group 1/Group 1.5") %>%
            mv(c("v5", "v6"), "/Group 1/Group 1.5") %>% # nolint
            mkdir("Group 2") %>%
            mv(c("v4", "v3"), "/Group 2") # nolint

        # test that ds_fork has the old order still
        expect_identical(
            capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
            old_order
        )
        expect_false(identical(
            capture_output_lines(publicFolder(ds) %>% print(depth = 10)),
            capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10))
        ))

        # copy order, and check that ds_fork has the new order.
        ds_fork <- copyFolders(ds, ds_fork)
        expect_identical(
            capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
            capture_output_lines(publicFolder(ds) %>% print(depth = 10))
        )
    })

    test_that("copyFolders copies across disparate datasets", {
        # setup an alternative dataset that has some overlap with ds
        df_alt <- df
        df_alt$v12 <- df_alt$v1
        df_alt$v1 <- NULL
        df_alt$v2 <- NULL
        df_alt$new_var <- 1
        df_alt$new_var2 <- letters[20:1]
        ds_alt <- newDataset(df_alt)

        old_order <- capture_output_lines(publicFolder(ds_alt) %>% print(depth = 10))

        # reset order
        with_consent(
            ds %>%
                mv(aliases(allVariables(ds)), "/") %>%
                rmdir(c("Group 1")) %>%
                rmdir(c("Group 2")) %>%
                rmdir(c("Group A"))
        )


        ds %>% mkdir("Group A") %>% mv(c("v4", "v3"), "Group A")

        # test that ds_alt has the old order still
        expect_identical(
            capture_output_lines(publicFolder(ds_alt) %>% print(depth = 10)),
            old_order
        )

        expect_false(identical(
            capture_output_lines(publicFolder(ds_alt) %>% print(depth = 10))[-c(4, 5, 6)],
            capture_output_lines(publicFolder(ds) %>% print(depth = 10))[-c(2, 3)]
        ))

        # copy order, and check that ds_alt has the new order.
        ds_alt <- copyFolders(ds, ds_alt)
        expect_identical(
            # ignore lines 4, 5, and 6 because they are vars in ds_alt that are
            # not in ds
            capture_output_lines(publicFolder(ds_alt) %>% print(depth = 10))[-c(4, 5, 6)],
            # ignore lines 3 and 2 because they are vars in ds that are
            # not in ds_alt
            capture_output_lines(publicFolder(ds) %>% print(depth = 10))[-c(2, 3)]
        )
    })
})