#107 refactor, dynamic templates

R/generate_code.R

@@ -86,35 +86,47 @@ generate_code <- function(spec, domain, out_dir = ".") {
     domain = domain,
     spec = spec_domain
   ) |>
-    style_the_code()
+    style_the_code(domain)
 
   file_name <- paste0(domain, "_sdtm_oak_code.R")
   writeLines(styled_code, file.path(out_dir, file_name))
 }
 
-style_the_code <- function(code_by_topics) {
+#' Style the code
+#'
+#' This function styles the code using the styler package and adds the necessary
+#' templates to the code (e.g. cm_template_prefix, cm_template_suffix).
+#'
+#' @param code_by_topics A list of character vectors.
+#' @inheritParams generate_code
+#'
+#' @return The styled code as a string.
+#' @keywords internal
+#'
+style_the_code <- function(code_by_topics, domain) {
 
   admiraldev::assert_list_of(code_by_topics, "character")
 
-  one_topic <- identical(length(code_by_topics), 1L)
+  prefix_f <- paste0(domain, "_template_prefix")
+  suffix_f <- paste0(domain, "_template_suffix")
+
+  assertthat::assert_that(exists(prefix_f), msg = paste0("The function ", prefix_f, " does not exist."))
+  assertthat::assert_that(exists(suffix_f), msg = paste0("The function ", suffix_f, " does not exist."))
+
+  prefix <- do.call(prefix_f, list())
+  suffix <- do.call(suffix_f, list())
 
-  # TODO
-  # - dynamically select the templates based on domain
-  if (one_topic) {
-    styled_code <- code_by_topics |>
-      unlist() |>
-      append(cm_template_prefix, after = 0L) |>
-      append(cm_template_suffix) |>
-      styler::style_text()
+  multiple_topics <- !identical(length(code_by_topics), 1L)
 
-    return(styled_code)
+  if (multiple_topics) {
+    code_by_topics <- code_by_topics |>
+      purrr::map(remove_last_pipe)
   }
 
   code_by_topics |>
-    purrr::map(remove_last_pipe) |>
     unlist() |>
-    append(vs_template_prefix, after = 0L) |>
-    append(vs_template_suffix) |>
+    append(prefix, after = 0L) |>
+    append(suffix) |>
     styler::style_text()
 }
 

R/generate_code_tempates.R

@@ -2,7 +2,8 @@
 #'
 #' @noRd
 #' @keywords internal
-cm_template_prefix <- stringr::str_glue('
+cm_template_prefix <- function() {
+  stringr::str_glue('
 library(sdtm.oak)
 library(dplyr)
 
@@ -27,12 +28,15 @@ dm <- read.csv("./datasets/dm.csv")
 
 dm <- admiral::convert_blanks_to_na(dm)
 ')
+}
+
 
 #' The template suffix for the cm code
 #'
 #' @noRd
 #' @keywords internal
-cm_template_suffix <- stringr::str_glue('
+cm_template_suffix <- function() {
+  stringr::str_glue('
 dplyr::mutate(
   STUDYID = "test_study",
   DOMAIN = "CM",
@@ -59,12 +63,14 @@ dplyr::select("STUDYID", "DOMAIN", "USUBJID", "CMSEQ", "CMTRT", "CMCAT", "CMINDC
               "CMDOSE", "CMDOSTXT", "CMDOSU", "CMDOSFRM", "CMDOSFRQ", "CMROUTE",
               "CMSTDTC", "CMENDTC","CMSTDY", "CMENDY", "CMENRTPT", "CMENTPT")
 ')
+}
 
 #' The template suffix for the vs code
 #'
 #' @noRd
 #' @keywords internal
-vs_template_prefix <- stringr::str_glue('
+vs_template_prefix <- function() {
+  stringr::str_glue('
 library(sdtm.oak)
 library(dplyr)
 
@@ -93,12 +99,14 @@ dm <- read.csv("./datasets/dm.csv")
 
 dm <- admiral::convert_blanks_to_na(dm)
 ')
+}
 
 #' The template suffix for the vs code
 #'
 #' @noRd
 #' @keywords internal
-vs_template_suffix <- stringr::str_glue('
+vs_template_suffix <- function() {
+  stringr::str_glue('
 # Combine all the topic variables into a single data frame. ----
 vs_combined <- dplyr::bind_rows(
   vs_asmntdn, vs_sys_bp, vs_dia_bp, vs_pulse, vs_temp,
@@ -173,3 +181,4 @@ vs <- vs_combined %>%
                 "VSORRES", "VSORRESU", "VSLOC", "VSLAT",
                 "VISIT", "VISITNUM", "VSDY", "VSTPT", "VSTPTNUM", "VSDTC" )
 ')
+}