Merge pull request #61 from OxfordIHTM/dev

re-factor check functions and test; fix #38; fix #60
OxfordIHTM · Feb 16, 2024 · c701dcd · c701dcd
2 parents d61a86b + 7e8612d
commit c701dcd
Show file tree

Hide file tree

Showing 5 changed files with 37 additions and 9 deletions.
diff --git a/R/icd_check.R b/R/icd_check.R
@@ -9,7 +9,8 @@
 #'
 #' @return A message or an error if `release` provided is recognised or not. A
 #'   message or a warning if `language` requested is available or not for
-#'   `release` provided.
+#'   `release` provided. For `icd_check_language()`, returns a character value
+#'   or a character vector of acceptable language codes.
 #'
 #' @examples
 #' icd_check_release("2024-01")
@@ -68,9 +69,12 @@ icd_check_language <- function(release = NULL, language, verbose = TRUE) {
       )
     } else {
       warning(
-        paste0("Language `", language, "` is not available for the release specified.
-                Returning results for `en` (default).")
+        paste0(
+          "Language `", language,
+          "` is not available for the release specified. Returning results for `en` (default)."
+        )
       )
+      language <- "en"
     }
   }
 
@@ -80,14 +84,22 @@ icd_check_language <- function(release = NULL, language, verbose = TRUE) {
       language_result <- language[language %in% languages_available]
 
       message(
-        paste0("The following languages requested are available for the release
-                specified: ", language_result, ".")
+        paste0(
+          "The following languages requested are available for the release specified: ",
+          language_result, "."
+        )
       )
+
+      language <- language_result
     } else {
       warning(
-        paste0("None of the languages requested are available for the release
-                specified. Returning results for `en` (default).")
+        paste0(
+          "None of the languages requested are available for the release specified. Returning results for `en` (default).")
       )
+      language <- "en"
     }
   }
+
+  ## Return acceptable languages ----
+  language
 }
diff --git a/R/icd_search.R b/R/icd_search.R
@@ -82,7 +82,8 @@ icd_search_foundation <- function(q,
   if (!is.null(release)) icd_check_release(release, verbose = verbose)
 
   ## Check language ----
-  if (!is.null(language)) icd_check_language(release, language, verbose = verbose)
+  if (!is.null(language))
+    language <- icd_check_language(release, language, verbose = verbose)
 
   ## Make base request ----
   req <- httr2::request(file.path(base_url, "icd/entity/search")) |>

diff --git a/man/icd_check.Rd b/man/icd_check.Rd
diff --git a/tests/testthat/test-check.R b/tests/testthat/test-check.R
@@ -0,0 +1,11 @@
+# Test check functions ---------------------------------------------------------
+
+## Check single non-available language ----
+testthat::expect_warning(icd_check_language(language = "pp"))
+
+## Check multiple with some available language ----
+testthat::expect_message(icd_check_language(language = c("zh", "fr", "pp")))
+testthat::expect_equal(icd_check_language(language = c("zh", "fr", "pp")), c("zh", "fr"))
+
+## Check multiple non-available languages ----
+testthat::expect_warning(icd_check_language(language = c("aa", "bb", "pp")))
diff --git a/tests/testthat/test-search.R b/tests/testthat/test-search.R
@@ -22,6 +22,9 @@ testthat::expect_s3_class(test_search_release, "tbl_df")
 testthat::expect_type(test_search_release, "list")
 testthat::expect_error(icd_search_foundation(q = "cholera", release = "2025-01"))
 
+## Test language specification ----
+testthat::expect_warning(icd_search_foundation(q = "cholera", language = "pp"))
+
 ## Test subtrees query ----
 test_search_subtree <- icd_search_foundation(q = "cholera", subtree = "http://id.who.int/icd/entity/1435254666")
 testthat::expect_message(icd_search_foundation(q = "cholera", subtree = "http://id.who.int/icd/entity/1435254666"))