Add tests for css-reading functions

R/css.R

@@ -1,25 +1,15 @@
 read_css_vars <- function(file = NULL) {
   if (is.null(file)) {
     css_candidates <- find_xaringan_themer_css()
-    if (!length(css_candidates)) {
-      stop("Unable to locate a xaringanthemer css file.")
-    } else if (length(css_candidates) == 1) {
-      file <- css_candidates
-    } else if (length(css_candidates) > 1) {
-      is_xaringan_themer_css <- grepl("xaringan-themer.css", css_candidates, fixed = TRUE)
-      if (any(is_xaringan_themer_css)) {
-        file <- css_candidates[is_xaringan_themer_css][1]
-      } else {
-        file <- css_candidates[1]
-        message(glue::glue("Using xaringanthemer theme in {file}"))
-      }
-    }
+    file <- choose_xaringan_themer_css(css_candidates)
   }
 
   css_get_root(file)
 }
 
 find_xaringan_themer_css <- function() {
+  # finds xaringan themer files within or below current working directory
+  # and is only ever intended to be called in that situation
   css_files <- list.files(pattern = "css$", recursive = TRUE, full.names = TRUE)
   css_files_head <- purrr::map(css_files, readLines, n = 5)
   is_xt <- grepl(pattern = "generated by xaringanthemer", css_files_head, fixed = TRUE)
@@ -27,6 +17,23 @@ find_xaringan_themer_css <- function() {
   css_files[is_xt]
 }
 
+choose_xaringan_themer_css <- function(css_candidates = character(0)) {
+  if (!length(css_candidates)) {
+    stop("Unable to locate a xaringanthemer css file.", call. = FALSE)
+  } else if (length(css_candidates) == 1) {
+    file <- css_candidates
+  } else if (length(css_candidates) > 1) {
+    is_xaringan_themer_css <- grepl("xaringan-themer.css", css_candidates, fixed = TRUE)
+    if (any(is_xaringan_themer_css)) {
+      file <- css_candidates[is_xaringan_themer_css][1]
+    } else {
+      file <- css_candidates[1]
+      message(glue::glue("Using xaringanthemer theme in {file}"))
+    }
+  }
+  file
+}
+
 css_get_root <- function(file) {
   x <- readLines(file, warn = FALSE)
   x <- paste(x, collapse = "\n")

tests/testthat/test-css.R

@@ -22,3 +22,71 @@ test_that("read theme settings from css variables", {
     expect_equal(!!css_vars[[var]], !!expected_vars[[var]])
   }
 })
+
+describe("find and choose xaringan themer files", {
+  tmpdir <- tempfile()
+  dir.create(tmpdir)
+
+  mono_light_css <- normalizePath(test_path("css/mono_light.css"))
+
+  xaringan_css <- normalizePath(test_path("css/xaringan.css"))
+
+  owd <- setwd(tmpdir)
+  on.exit(setwd(owd))
+
+  file.copy(mono_light_css, tmpdir)
+
+  it("finds xaringan themer files with non-standard names", {
+    candidates <- find_xaringan_themer_css()
+    picked <- choose_xaringan_themer_css(candidates)
+    expect_equal(candidates, "./mono_light.css")
+    expect_equal(picked, "./mono_light.css")
+  })
+
+  it("finds xaringan themer files in presence of other .css files", {
+    writeLines(c(
+      "html {",
+      "  color: red;",
+      "}"
+    ), "styles.css")
+    expect_equal(find_xaringan_themer_css(), "./mono_light.css")
+    expect_equal(read_css_vars()$text_color, "#18273F")
+  })
+
+  it("finds all xaringan themer files", {
+    file.copy(xaringan_css, "xaringan-themer.css")
+    candidates <- find_xaringan_themer_css()
+    picked <- choose_xaringan_themer_css(candidates)
+    expect_equal(candidates, c("./mono_light.css", "./xaringan-themer.css"))
+    expect_equal(picked, "./xaringan-themer.css")
+    expect_equal(read_css_vars()$text_color, "#000")
+  })
+
+  it("chooses the first from the list if ambiguous", {
+    file.rename("xaringan-themer.css", "xaringan.css")
+    candidates <- find_xaringan_themer_css()
+    picked <- expect_message(choose_xaringan_themer_css(candidates))
+    expect_equal(candidates, c("./mono_light.css", "./xaringan.css"))
+    expect_equal(picked, "./mono_light.css")
+    expect_equal(read_css_vars()$text_color, "#18273F")
+  })
+
+  it("throws error if no xaringan themer css files", {
+    file.remove("xaringan.css")
+    file.remove("mono_light.css")
+    candidates <- find_xaringan_themer_css()
+    expect_equal(candidates, character())
+    expect_error(choose_xaringan_themer_css(candidates))
+  })
+})
+
+test_that("css_get_root() returns null if no :root exists", {
+  tmpfile <- tempfile("style", fileext = ".css")
+  writeLines(c(
+    "html {",
+    "  color: red;",
+    "}"
+  ), tmpfile)
+  expect_null(css_get_root(tmpfile))
+  unlink(tmpfile)
+})