refactor test-translate

tests/testthat/helper-translate.R

@@ -0,0 +1,96 @@
+#' Expect translations are rendered properly in the HTML page
+#'
+#' One of the challenges of translations is that we need to test both that the
+#' translation works and that the default text does not work.
+#'
+#' We are using the `tr_()` function to ensure that our translations are
+#' working, so we expect that we can use the following to test that the
+#' translation works:
+#'
+#' ```
+#' expected <- withr::with_language("ja", tr_("Summary and Setup"))
+#' expect_equal(xml2::xml_text(node, trim = TRUE), expected)
+#' ```
+#'
+#' This logic is not wrong, but it will almost always give a successful result
+#' because if the `tr_()` function does not find a translation, it will return
+#' the same string. Thus, we need to pair this with an expectation that we know
+#' should fail---translating the default state for English:
+#'
+#' ```
+#' unexpected <- withr::with_language("en", tr_("Summary and Setup"))
+#' expect_failure({
+#'   expect_equal(xml2::xml_text(node, trim = TRUE), unexpected)
+#' })
+#' ```
+#'
+#' It's with this pair of expectations that we can confirm that a translation
+#' is working correctly. This function also expands this idea to compare sets of
+#' translations when there may be duplicates.
+#'
+#' @param node an xml_node or xml_nodeset object
+#' @param strings a character vector of _untranslated_ strings
+#' @param language a character vector of length 1 defining the language to use
+#'   for translations
+#' @noRd
+#' @examples
+#' sitepath <- fs::path(lsn, "site/docs")
+#' profiles <- xml2::read_html(fs::path(sitepath, "profiles.html"))
+#' h1_profiles <- xml2::xml_find_first(profiles, "//main/div/h1")
+#' expect_set_translated(h1_profiles, "Learner Profiles")
+expect_set_translated <- function(node, strings, language = "ja") {
+  # translate a vector into the defined langage and english for comparison
+  expected_strings <- withr::with_language(language, {
+    unname(vapply(strings, tr_, character(1)))
+  })
+  en_strings <- withr::with_language("en", {
+    unname(vapply(strings, tr_, character(1)))
+  })
+  actual <- xml2::xml_text(node, trim = TRUE)
+
+  # The translations should work.
+  # NOTE: this will work even if the translation function is not working and
+  # falls back to English.
+  # --- reasons why this would not work:
+  # --- 1. the language of the web page is different than the language
+  # --- 2. the web page has no text
+  # --- 3. the tr_() function returns NA
+  expect_setequal(actual, expected = expected_strings)
+
+  # The English should NOT work
+  # --- reasons why this would not work:
+  # --- 1. the tr_() function is not actually performing any translations
+  expect_failure({
+    expect_setequal(actual, expected = en_strings)
+  })
+}
+
+expect_h1_translated <- function(doc, string, language = "ja") {
+  node <- xml2::xml_find_first(doc, "//main/div/h1")
+  expect_set_translated(node, string, language)
+}
+
+
+expect_title_translated <- function(doc, string, language = "ja") {
+  # translate a vector into the defined langage and english for comparison
+  # NOTE: we need to set the regex to end with the string in question
+  expected_string <- paste0("\\: ", withr::with_language("ja", tr_(string)), "$")
+  en_string <- paste0("\\: ", withr::with_language("en", tr_(string)), "$")
+  node <- xml2::xml_find_first(doc, "//head/title")
+  actual <- xml2::xml_text(node, trim = TRUE)
+
+  # The translations should work.
+  # NOTE: this will work even if the translation function is not working and
+  # falls back to English.
+  # --- reasons why this would not work:
+  # --- 1. the language of the web page is different than the language
+  # --- 2. the web page has no text
+  # --- 3. the tr_() function returns NA
+  expect_match(actual, regex = expected_string)
+
+  # The English should NOT work
+  # --- reasons why this would not work:
+  # --- 1. the tr_() function is not actually performing any translations
+  expect_no_match(actual, regex = en_string)
+
+}