tests/testthat/test-add_flat_template.R

In fusen: Build a Package from Rmarkdown Files

# WARNING - Generated by {fusen} from dev/flat_create_flat.Rmd: do not edit by hand

# Create a new project
dummypackage <- tempfile(pattern = "add.flat.template")
dir.create(dummypackage)
pkg_name <- basename(dummypackage)

# add_flat_template ----
test_that("add_flat_template adds flat_template.Rmd and co.", {
  dev_file_path <- expect_error(add_flat_template(pkg = dummypackage, open = FALSE),
    regexp = NA
  )
  flat_file <- dev_file_path[grepl("flat_", dev_file_path)]

  expect_true(all(file.exists(dev_file_path)))
  expect_true(file.exists(file.path(dummypackage, "dev", "0-dev_history.Rmd")))
  expect_true(file.exists(file.path(dummypackage, ".here")))
  expect_true(file.exists(file.path(dummypackage, "inst", "nyc_squirrels_sample.csv")))

  rbuildignore_file <- file.path(dummypackage, ".Rbuildignore")
  expect_true(file.exists(rbuildignore_file))
  rbuildignore_lines <- readLines(rbuildignore_file)
  expect_true(any(grepl("^dev$", rbuildignore_lines, fixed = TRUE)))
  expect_true(any(grepl("[.]here", rbuildignore_lines)))

  dev_lines <- readLines(flat_file)
  expect_equal(length(grep(pkg_name, dev_lines)), 3)

  # Second time message and new file
  expect_message(add_flat_template(pkg = dummypackage))
  expect_true(file.exists(file.path(dummypackage, "dev", "flat_full_2.Rmd")))
  # _New file has path changed in title and inflate
  lines_2 <- readLines(file.path(dummypackage, "dev", "flat_full_2.Rmd"))
  expect_length(grep(x = lines_2, pattern = "flat_full_2[.]Rmd"), 2)
})
unlink(dummypackage, recursive = TRUE)

# Test with .Rproj and no .here, it works ----
# Create a new project
dummypackage2 <- tempfile(pattern = "rproj.nohere")
dir.create(dummypackage2)
cat("", file = file.path(dummypackage2, "dummy.Rproj"))

# Add
dev_file_path <- add_flat_template(pkg = dummypackage2, open = FALSE)
flat_file <- dev_file_path[grepl("flat", dev_file_path)]

test_that("add_flat_template works with .Rproj and no .here", {
  expect_true(all(file.exists(dev_file_path)))
  expect_false(file.exists(file.path(dummypackage2, ".here")))

  rbuildignore_file <- file.path(dummypackage2, ".Rbuildignore")
  expect_true(file.exists(rbuildignore_file))
  rbuildignore_lines <- readLines(rbuildignore_file)
  expect_true(any(grepl("dev", rbuildignore_lines, fixed = TRUE)))
  expect_false(any(grepl("[.]here", rbuildignore_lines)))
})
unlink(dummypackage2, recursive = TRUE)

# Test "dev_history" template ----
dummypackage <- tempfile(pattern = "dev.history.template")
dir.create(dummypackage)
# Add
test_that("add dev_history template works", {
  withr::with_dir(dummypackage, {
    dev_file_path <- expect_error(add_flat_template(pkg = dummypackage, template = "dev_history", open = FALSE), regexp = NA)

    expect_true(file.exists(dev_file_path))

    usethis::with_project(dummypackage, {
      # Extract and test the description chunk
      dev_lines <- readLines(dev_file_path)
      # Change path of project
      dev_lines <- gsub(
        "here::here()",
        # To correct for Windows path
        paste0('"', gsub("\\\\", "\\\\\\\\", dummypackage), '"'), dev_lines,
        # paste0('"', newdir, '"'), dev_lines,
        fixed = TRUE
      )
      dev_parse <- parsermd::parse_rmd(dev_lines)
      desc_code <- tempfile("desc")
      parsermd::rmd_select(dev_parse, "description")[[1]] %>%
        parsermd::rmd_node_code() %>%
        cat(., sep = "\n", file = desc_code)
      # Execute code
      expect_error(source(desc_code), regexp = NA)
    })
    expect_true(file.exists(file.path(dummypackage, "DESCRIPTION")))
    expect_true(file.exists(file.path(dummypackage, "LICENSE")))
    expect_true(file.exists(file.path(dummypackage, "LICENSE.md")))
  })
})

unlink(dummypackage)


# Test "dev_history" template ----
dummypackage <- tempfile(pattern = "dev.history.template.uu")
dir.create(dummypackage)
# Add
test_that("add dev_history template works with windows \\users path", {
  withr::with_dir(dummypackage, {
    dev_file_path <- expect_error(
      add_flat_template(
        pkg = dummypackage, template = "dev_history",
        open = FALSE
      ),
      regexp = NA
    )

    expect_true(file.exists(dev_file_path))
    # Test specific \\users path
    newdir_uu <- tempfile("aa\\Users/gzv")
    dir.create(newdir_uu, recursive = TRUE)

    usethis::with_project(dummypackage, {
      # Extract and test the description chunk
      dev_lines <- readLines(dev_file_path)
      # Change path of project
      dev_lines <- gsub(
        "here::here()",
        # To correct for Windows path
        paste0('"', gsub("\\\\", "\\\\\\\\", newdir_uu), '"'), dev_lines,
        # paste0('"', newdir_uu, '"'), dev_lines,
        fixed = TRUE
      )
      dev_parse <- parsermd::parse_rmd(dev_lines)
      desc_code <- tempfile("desc", fileext = ".R")
      parsermd::rmd_select(dev_parse, "description")[[1]] %>%
        parsermd::rmd_node_code() %>%
        cat(., sep = "\n", file = desc_code)
      # Execute code
      expect_error(source(desc_code), regexp = NA)
    })
    # DESCRIPTION in newdir_uu as created by fill_description()
    expect_true(file.exists(file.path(newdir_uu, "DESCRIPTION")))
    # LICENSE.md in dummypackage as created by use_mit_license()
    # No LICENSE because of separation of DESCRIPTION
    # expect_true(file.exists(file.path(dummypackage, "LICENSE")))
    expect_true(file.exists(file.path(dummypackage, "LICENSE.md")))
  })
})

unlink(dummypackage)

# Add failed with malformed package name ----
# Create a new project
dummypackage3 <- tempfile(pattern = "malformed_pkg")
dir.create(dummypackage3)
cat("", file = file.path(dummypackage3, "dummy.Rproj"))

# Add
test_that("add_flat_template fails", {
  expect_error(add_flat_template(pkg = dummypackage3, open = FALSE), "package name")
})
unlink(dummypackage3, recursive = TRUE)

# More complicated example for tests
# This will render the Rmd template that is supposed to build a package
# But we need to be inside a project,
# in the correct working directory,
# with the correct here()

# Test all templates to knit ----
all_templates <- fusen:::flat_template_choices[!fusen:::flat_template_choices %in% c("dev_history", "dev")] # "dev_history"
test_that("all templates to knit and inflate a second time", {
  expect_length(all_templates, 9)
})

for (template in all_templates) {
  # template <- all_templates[1]
  main_flat_file_name <- template
  if (template %in% c(
    "minimal_package", "minpkg",
    "minimal_flat", "minflat"
  )) {
    main_flat_file_name <- "minimal"
  } else if (template == "add") {
    main_flat_file_name <- "additional"
  } else if (template == "teach") {
    main_flat_file_name <- "teaching"
  }

  dummypackage4 <- tempfile(pattern = paste0("all.templates.knit", gsub("_", ".", template)))
  dir.create(dummypackage4)

  orig.proj <- here::here()

  withr::with_dir(dummypackage4, {
    # Add template
    dev_file_path <- suppressMessages(add_flat_template(template = template, open = FALSE))
    flat_file <- dev_file_path[grepl("flat", dev_file_path)]

    lines_template <- readLines(flat_file)
    # Run description chunk to build DESCRIPTION file and make it a proper pkg
    desc_line <- grep("\\{r description", lines_template)
    if (length(desc_line) != 0) {
      lines_template[desc_line] <- "```{r description, eval=TRUE}"
    }
    # pkgload::load_all in the template cannot work in non interactive R CMD Check
    if (template == "full" & !interactive()) {
      # if (template == "full" & interactive()) {
      loadall_line <- grep("^pkgload::load_all", lines_template)
      lines_template[loadall_line] <- "# pkgload::load_all() commented"
      data_line <- grep("datafile <- system.file", lines_template)
      lines_template[data_line] <-
        glue::glue('datafile <- file.path("{normalize_path_winslash(dummypackage4)}", "inst", "nyc_squirrels_sample.csv")')
    }

    cat(enc2utf8(lines_template), file = flat_file, sep = "\n")

    # description chunk as eval=TRUE
    if (any(grepl("dev_history", dev_file_path))) {
      dev_hist_path <- dev_file_path[grepl("dev_history", dev_file_path)]
      lines_dev <- readLines(dev_hist_path)
      lines_dev[grepl("\\{r description", lines_dev)] <- "```{r description, eval=TRUE}"
      cat(enc2utf8(lines_dev), file = dev_hist_path, sep = "\n")
    }

    # Simulate as being inside project
    usethis::proj_set(dummypackage4)
    here:::do_refresh_here(dummypackage4)

    if (rmarkdown::pandoc_available("1.12.3")) {
      # knitting with dev_history should transform project as a package
      # as fill_description is eval = TRUE
      if (any(grepl("dev_history", dev_file_path))) {
        test_that(paste0("dev_history can be rendered, associated with template", template), {
          expect_error(
            rmarkdown::render(
              input = dev_hist_path,
              output_file = file.path(dummypackage4, "dev", "dev_history.html"),
              envir = new.env(), quiet = TRUE
            ),
            regexp = NA
          )
        })
      } else if (template %in% c(
        "additional", "add",
        "minimal_flat", "minflat"
      )) {
        fusen::fill_description(
          pkg = here::here(),
          fields = list(Title = "Dummy Package")
        )
        # Define License with use_*_license()
        usethis::use_mit_license("John Doe")
      }

      test_that(paste0("template ", template, " can be rendered"), {
        flat_to_render <- file.path(dummypackage4, "dev", paste0("flat_", main_flat_file_name, ".Rmd"))
        expect_true(file.exists(flat_to_render))

        expect_error(
          rmarkdown::render(
            input = flat_to_render,
            output_file = file.path(dummypackage4, "dev", paste0("flat_", main_flat_file_name, ".html")),
            envir = new.env(), quiet = TRUE
          ),
          regexp = NA
        )
      })
    }

    usethis::proj_set(NULL)
    here:::do_refresh_here(orig.proj)
  })

  test_that(paste0("template ", template, " that was run as Rmarkdown gives project as a package"), {
    expect_true(file.exists(file.path(dummypackage4, "dev", paste0("flat_", main_flat_file_name, ".Rmd"))))
    if (template %in% c("full", "minimal_package")) {
      expect_true(file.exists(file.path(dirname(flat_file), "0-dev_history.Rmd")))
    }

    if (rmarkdown::pandoc_available("1.12.3")) {
      expect_true(file.exists(file.path(dummypackage4, "DESCRIPTION")))
      expect_true(file.exists(file.path(dummypackage4, "LICENSE")))
      if (template %in% c("full")) {
        expect_true(file.exists(file.path(dummypackage4, "inst", "nyc_squirrels_sample.csv")))
      } else {
        expect_false(file.exists(file.path(dummypackage4, "inst", "nyc_squirrels_sample.csv")))
      }
      expect_true(file.exists(file.path(dummypackage4, "dev", paste0("flat_", main_flat_file_name, ".html"))))
    }
  })

  # Now try to inflate from the inflate chunk
  test_that("flat file inflates after knit from command inside", {
    flat_lines <- readLines(flat_file)

    expect_true(sum(grepl(paste0("fusen::inflate\\(flat_file = \"dev/flat_", main_flat_file_name, ".Rmd\""), flat_lines)) == 1)

    withr::with_dir(dummypackage4, {
      inflate_command <- paste0("fusen::inflate(flat_file = \"dev/flat_", main_flat_file_name, ".Rmd\", open_vignette = FALSE, check = FALSE)")
      expect_error(suppressMessages(eval(parse(text = inflate_command))), regexp = NA)
    })
  })

  # Now try to inflates a second time
  test_that("flat file inflates a second time", {
    withr::with_dir(dummypackage4, {
      inflate_command_second <- paste0("fusen::inflate(flat_file = \"dev/flat_", main_flat_file_name, ".Rmd\", open_vignette = FALSE, check = FALSE, overwrite = TRUE)")
      expect_error(suppressMessages(eval(parse(text = inflate_command_second))), regexp = NA)
    })
  })

  unlink(dummypackage4, recursive = TRUE)
} # end of loop on template knit

# Test other names modifies template ----
dummypackage <- tempfile(pattern = "other.names")
dir.create(dummypackage)
# Add
test_that("Other flat_name works", {
  # Template additional used with "add"
  dev_file_path <- expect_error(
    add_flat_template(
      template = "add",
      pkg = dummypackage, flat_name = "hello", open = FALSE
    ),
    regexp = NA
  )
  expect_true(file.exists(file.path(dummypackage, "dev/flat_hello.Rmd")))
  hello_flat <- readLines(dev_file_path)
  # 8 times hello for function name
  # 2 times hello in flat_hello.Rmd
  expect_equal(length(grep("hello", hello_flat)), 8 + 2)
  expect_equal(length(grep("flat_hello[.]Rmd", hello_flat)), 2)

  # Template minimal used with "minpkg", same name, flat changes name
  expect_message(
    add_flat_template(
      template = "minpkg",
      pkg = dummypackage, flat_name = "hello", open = FALSE
    ),
    regexp = "flat_hello.Rmd already exists."
  )
  flat_file <- file.path(dummypackage, "dev/flat_hello_2.Rmd")
  expect_true(file.exists(flat_file))
  hello_flat <- readLines(flat_file)
  # 8 times hello for function name
  # 2 times hello in flat_hello_2.Rmd
  expect_equal(length(grep("hello", hello_flat)), 8 + 2)
  expect_equal(length(grep("flat_hello_2[.]Rmd", hello_flat)), 2)

  # Try inflate to see if files get hello name
  usethis::with_project(dummypackage, {
    fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package"))
    expect_error(
      inflate(
        pkg = dummypackage, flat_file = flat_file,
        vignette_name = "hello", check = FALSE,
        open_vignette = FALSE
      ),
      regexp = NA
    )
  })

  expect_true(file.exists(file.path(dummypackage, "R", "hello.R")))
  expect_true(file.exists(file.path(dummypackage, "tests", "testthat", "test-hello.R")))
  expect_true(file.exists(file.path(dummypackage, "vignettes", "hello.Rmd")))
  test_hello <- readLines(file.path(dummypackage, "tests", "testthat", "test-hello.R"))
  expect_true(any(grepl("hello works", test_hello)))
  vignette_hello <- readLines(file.path(dummypackage, "vignettes", "hello.Rmd"))
  expect_true(any(grepl("title: \"hello\"", vignette_hello)))
  expect_true(any(grepl("  %\\VignetteIndexEntry{hello}", vignette_hello, fixed = TRUE)))
  expect_true(any(grepl("hello()", vignette_hello)))
})
# Delete dummy package
unlink(dummypackage, recursive = TRUE)

# Test other dev_dir works ----
dummypackage <- tempfile(pattern = "devdir")
dir.create(dummypackage)
# Add
test_that("Other dev_dir works", {
  # Template additional used with "add"
  dev_file_path <- expect_error(
    add_flat_template(
      template = "add",
      pkg = dummypackage, flat_name = "hello",
      dev_dir = "devdir",
      open = FALSE
    ),
    regexp = NA
  )
  expect_true(file.exists(file.path(dummypackage, "devdir/flat_hello.Rmd")))
  hello_flat <- readLines(dev_file_path)

  # 8 times hello for function name
  # 2 times hello in flat_hello.Rmd
  # 1 time devdir/flat_hello.Rmd
  # O time dev/flat_hello.Rmd
  expect_equal(length(grep("hello", hello_flat)), 8 + 2)
  expect_equal(length(grep("flat_hello[.]Rmd", hello_flat)), 2)
  expect_equal(length(grep("devdir/flat_hello[.]Rmd", hello_flat)), 1)
  expect_equal(length(grep("dev/flat_hello[.]Rmd", hello_flat)), 0)
})
# Delete dummy package
unlink(dummypackage, recursive = TRUE)

# local_file_ignore works ----
test_that("local_file_ignore works", {
  tmpdirectory <- tempfile()
  dir.create(tmpdirectory)

  anyfile <- file.path(tmpdirectory, "whatever")
  local_file_ignore(file = anyfile, ignores = c("whatever", "^.other/$"))
  lines <- readLines(anyfile)
  expect_equal(
    object = lines,
    expected = c("whatever", "^.other/$")
  )

  # Add over
  local_file_ignore(file = anyfile, ignores = c("whatever", "something.else"))
  lines <- readLines(anyfile)
  expect_equal(
    object = lines,
    expected = c("whatever", "^.other/$", "something.else")
  )

  # Clean
  unlink(tmpdirectory)
})

# add_flat_template allows bad flat_name for function name ----
dummypackage <- tempfile(pattern = "bad.flat.ok")
dir.create(dummypackage)
pkg_name <- basename(dummypackage)

test_that("add_flat_template allows bad flat_name for function name with full", {
  dev_file_path <- expect_error(
    suppressMessages(
      add_flat_template(pkg = dummypackage, flat_name = "bad for function ! but.ok", open = FALSE)
    ),
    regexp = NA
  )
  flat_file <- dev_file_path[grepl("flat_", dev_file_path)]

  expect_true(all(file.exists(dev_file_path)))
  expect_true(file.exists(file.path(dummypackage, "dev", "flat_bad-for-function-but-ok.Rmd")))
  expect_true(file.exists(file.path(dummypackage, "dev", "0-dev_history.Rmd")))
})
unlink(dummypackage, recursive = TRUE)

# add_flat_template allows bad flat_name for function name ----
dummypackage <- tempfile(pattern = "bad.flat.ok.add")
dir.create(dummypackage)
pkg_name <- basename(dummypackage)

test_that("add_flat_template allows bad flat_name for function name with add", {
  dev_file_path <- expect_error(
    suppressMessages(
      add_additional(pkg = dummypackage, flat_name = "bad for function ! but.ok2", open = FALSE)
    ),
    regexp = NA
  )
  flat_file <- dev_file_path[grepl("flat_", dev_file_path)]

  expect_true(all(file.exists(dev_file_path)))
  expect_true(file.exists(file.path(dummypackage, "dev", "flat_bad-for-function-but-ok2.Rmd")))

  dev_lines <- readLines(flat_file)
  # title, function x 3, example x 2, tests x 2
  expect_equal(length(grep("bad_for_function_but_ok2", dev_lines)), 8)
})
unlink(dummypackage, recursive = TRUE)

# add_full ----
dummypackage <- tempfile(pattern = "add.wrappers")
dir.create(dummypackage)
pkg_name <- basename(dummypackage)

test_that("add_full adds flat_full.Rmd", {
  dev_file_path <- expect_error(suppressMessages(add_full(pkg = dummypackage, open = FALSE)),
    regexp = NA
  )
  flat_file <- dev_file_path[grepl("flat_", dev_file_path)]

  expect_true(all(file.exists(dev_file_path)))
  expect_true(file.exists(file.path(dummypackage, "dev", "0-dev_history.Rmd")))
  expect_true(file.exists(file.path(dummypackage, ".here")))
  expect_true(file.exists(file.path(dummypackage, "inst", "nyc_squirrels_sample.csv")))

  rbuildignore_file <- file.path(dummypackage, ".Rbuildignore")
  expect_true(file.exists(rbuildignore_file))
  rbuildignore_lines <- readLines(rbuildignore_file)
  expect_true(any(grepl("^dev$", rbuildignore_lines, fixed = TRUE)))
  expect_true(any(grepl("[.]here", rbuildignore_lines)))

  dev_lines <- readLines(flat_file)
  expect_equal(length(grep(pkg_name, dev_lines)), 3)
})
unlink(dummypackage, recursive = TRUE)

# add_minimal ----
dummypackage <- tempfile(pattern = "add.wrappers")
dir.create(dummypackage)
pkg_name <- basename(dummypackage)

test_that("add_minimal_package adds flat_minimal.Rmd", {
  dev_file_path <- expect_error(
    suppressMessages(add_minimal_package(pkg = dummypackage, open = FALSE)),
    regexp = NA
  )
  flat_file <- dev_file_path[grepl("flat_", dev_file_path)]

  expect_true(all(file.exists(dev_file_path)))
  expect_true(file.exists(file.path(dummypackage, "dev", "flat_minimal.Rmd")))
  expect_true(file.exists(file.path(dummypackage, "dev", "0-dev_history.Rmd")))
  expect_true(file.exists(file.path(dummypackage, ".here")))
  expect_false(file.exists(file.path(dummypackage, "inst", "nyc_squirrels_sample.csv")))

  dev_lines <- readLines(flat_file)
  expect_equal(length(grep("flat_minimal", dev_lines)), 2)
})
unlink(dummypackage, recursive = TRUE)

# add_additional ----
dummypackage <- tempfile(pattern = "add.wrappers")
dir.create(dummypackage)
pkg_name <- basename(dummypackage)

test_that("add_additional adds flat_additional.Rmd", {
  dev_file_path <- expect_error(
    suppressMessages(add_additional(pkg = dummypackage, open = FALSE)),
    regexp = NA
  )
  flat_file <- dev_file_path[grepl("flat_", dev_file_path)]

  expect_true(all(file.exists(dev_file_path)))
  expect_true(file.exists(file.path(dummypackage, "dev", "flat_additional.Rmd")))
  expect_false(file.exists(file.path(dummypackage, "dev", "0-dev_history.Rmd")))
  expect_true(file.exists(file.path(dummypackage, ".here")))
  expect_false(file.exists(file.path(dummypackage, "inst", "nyc_squirrels_sample.csv")))

  dev_lines <- readLines(flat_file)
  expect_equal(length(grep("additional", dev_lines)), 2)
})
unlink(dummypackage, recursive = TRUE)

# add_minimal_flat ----
dummypackage <- tempfile(pattern = "add.wrappers")
dir.create(dummypackage)
pkg_name <- basename(dummypackage)

test_that("add_minimal_flat adds add_minimal_flat.Rmd", {
  dev_file_path <- expect_error(
    suppressMessages(add_minimal_flat(pkg = dummypackage, open = FALSE)),
    regexp = NA
  )
  flat_file <- dev_file_path[grepl("flat_", dev_file_path)]

  expect_true(all(file.exists(dev_file_path)))
  expect_true(file.exists(file.path(dummypackage, "dev", "flat_minimal.Rmd")))
  expect_false(file.exists(file.path(dummypackage, "dev", "0-dev_history.Rmd")))
  expect_true(file.exists(file.path(dummypackage, ".here")))
  expect_false(file.exists(file.path(dummypackage, "inst", "nyc_squirrels_sample.csv")))

  dev_lines <- readLines(flat_file)
  expect_equal(length(grep("flat_minimal", dev_lines)), 2)
})
unlink(dummypackage, recursive = TRUE)

# add_dev_history ----
dummypackage <- tempfile(pattern = "add.wrappers")
dir.create(dummypackage)
pkg_name <- basename(dummypackage)

test_that("add_dev_history adds dev_history.Rmd only", {
  dev_file_path <- expect_error(
    suppressMessages(add_dev_history(pkg = dummypackage, open = FALSE)),
    regexp = NA
  )

  expect_true(all(file.exists(dev_file_path)))
  expect_false(file.exists(file.path(dummypackage, "dev", "flat_fake.Rmd")))
  expect_true(file.exists(file.path(dummypackage, "dev", "0-dev_history.Rmd")))
  expect_true(file.exists(file.path(dummypackage, ".here")))
  expect_false(file.exists(file.path(dummypackage, "inst", "nyc_squirrels_sample.csv")))
})
unlink(dummypackage, recursive = TRUE)