Do not allow target_keys of length more than 1 in v4.0.1 and above wh…

…en creating programmatically. Rsolves #89

R/create_target_metadata_item.R

@@ -11,13 +11,14 @@
 #' @param target_name character string. A longer human readable target description
 #' that could be used, for example, as a visualisation axis label.
 #' @param target_units character string. Unit of observation of the target.
-#' @param target_keys named list or `NULL`. Should be `NULL`, in the case
-#' where the target is not specified as a task_id but is specified solely through
-#' the `target_id` argument. Otherwise, should be a named list of one or more
-#' character strings. The name of each element should match a task_id variable
-#' within the same model_tasks object. Each element should be of length 1.
-#' Each value, or the combination of values if multiple keys are specified,
-#' define a single target value.
+#' @param target_keys named list or `NULL`. The `target_keys` value defines a
+#' single target.
+#' Should be `NULL`, in the case where the target is not specified as a task_id
+#' but is specified solely through the `target_id` argument.
+#' Otherwise, should be a named list containing a single character string element
+#' The name of the element should match a `task_id`
+#' variable name within the same `model_tasks` object and the value match a
+#' single value of that variable.
 #' @param description character string (optional). An optional verbose description
 #' of the target that might include information such as definitions of a 'rate' or similar.
 #' @param target_type character string. Target statistical data type. Consult the
@@ -117,7 +118,7 @@ create_target_metadata_item <- function(target_id, target_name, target_units,
     }
   )
 
-  check_target_keys(target_keys, call = call)
+  check_target_keys(target_keys, schema_version, call = call)
 
   structure(mget(property_names),
     class = c("target_metadata_item", "list"),
@@ -127,7 +128,8 @@ create_target_metadata_item <- function(target_id, target_name, target_units,
   )
 }
 
-check_target_keys <- function(target_keys, call = rlang::caller_env()) {
+check_target_keys <- function(target_keys, schema_version,
+                              call = rlang::caller_env()) {
   if (is.null(target_keys)) {
     return()
   }
@@ -149,6 +151,20 @@ check_target_keys <- function(target_keys, call = rlang::caller_env()) {
       call = call
     )
   }
+  is_gte_v4_0_1 <- hubUtils::version_gte(
+    "v4.0.1",
+    schema_version = schema_version
+  )
+  target_key_n <- length(target_keys)
+  if (is_gte_v4_0_1 && target_key_n > 1L) {
+    cli::cli_abort(
+      c(
+        "!" = "{.arg target_keys} must be a named {.cls list} of
+        length {.val {1L}} not {.val {target_key_n}}."
+      ),
+      call = call
+    )
+  }
 
   purrr::walk2(
     target_keys,

tests/testthat/_snaps/create_target_metadata_item.md

@@ -162,3 +162,14 @@
       - "https://raw.githubusercontent.com/hubverse-org/schemas/main/v3.0.1/tasks-schema.json"
       + "https://raw.githubusercontent.com/hubverse-org/schemas/main/v4.0.0/tasks-schema.json"
 
+# Target_keys of length more than 1 are not allowed post v4.0.1
+
+    Code
+      create_target_metadata_item(target_id = "flu inc hosp", target_name = "Weekly incident influenza hospitalizations",
+        target_units = "rate per 100,000 population", target_keys = list(target = "flu",
+          target_metric = "inc hosp"), target_type = "discrete", is_step_ahead = TRUE,
+        time_unit = "week")
+    Condition
+      Error in `create_target_metadata_item()`:
+      ! `target_keys` must be a named <list> of length 1 not 2.
+

tests/testthat/test-create_target_metadata_item.R

@@ -131,7 +131,7 @@ test_that("schema version option works for create_target_metadata_item", {
   withr::with_options(
     list(
       hubAdmin.schema_version = "v3.0.1",
-      hubAmin.branch = "main"
+      hubAdmin.branch = "main"
     ),
     {
       opt_version <- create_target_metadata_item(
@@ -148,3 +148,70 @@ test_that("schema version option works for create_target_metadata_item", {
   expect_equal(arg_version, opt_version)
   expect_snapshot(waldo::compare(opt_version, version_default))
 })
+
+test_that("Target_keys of length more than 1 are not allowed post v4.0.1", {
+  skip_if_offline()
+  withr::with_options(
+    list(
+      hubAdmin.schema_version = "v4.0.1",
+      # TDOD: remove branch argument when v4.0.1 is released.
+      hubAdmin.branch = "ak/v4.0.1/restrict-target-key-value-pair-n/117"
+    ),
+    {
+      # One target_key is allowed in v4.0.1 and later versions.
+      target_keys_n1 <- create_target_metadata_item(
+        target_id = "inc hosp",
+        target_name = "Weekly incident influenza hospitalizations",
+        target_units = "rate per 100,000 population",
+        target_keys = list(target = "inc hosp"),
+        target_type = "discrete",
+        is_step_ahead = TRUE,
+        time_unit = "week",
+        branch = "ak/v4.0.1/restrict-target-key-value-pair-n/117"
+      )
+      expect_s3_class(target_keys_n1, "target_metadata_item")
+      expect_length(target_keys_n1$target_keys, 1L)
+
+      # More than one target_key is NOT allowed in v4.0.1 and later versions
+      # and throws error.
+      expect_snapshot(
+        create_target_metadata_item(
+          target_id = "flu inc hosp",
+          target_name = "Weekly incident influenza hospitalizations",
+          target_units = "rate per 100,000 population",
+          target_keys = list(
+            target = "flu",
+            target_metric = "inc hosp"
+          ),
+          target_type = "discrete",
+          is_step_ahead = TRUE,
+          time_unit = "week"
+        ),
+        error = TRUE
+      )
+    }
+  )
+  # More than 1 target_keys still allowed in earlier versions to conform to
+  # schema.
+  withr::with_options(
+    list(
+      hubAdmin.schema_version = "v4.0.0"
+    ),
+    {
+      target_keys_n2 <- create_target_metadata_item(
+        target_id = "flu inc hosp",
+        target_name = "Weekly incident influenza hospitalizations",
+        target_units = "rate per 100,000 population",
+        target_keys = list(
+          target = "flu",
+          target_metric = "inc hosp"
+        ),
+        target_type = "discrete",
+        is_step_ahead = TRUE,
+        time_unit = "week"
+      )
+      expect_s3_class(target_keys_n2, "target_metadata_item")
+      expect_length(target_keys_n2$target_keys, 2L)
+    }
+  )
+})