tidylab · Copilot · Jul 26, 2025 · Jul 26, 2025 · Jul 26, 2025 · Jul 26, 2025
diff --git a/.Rprofile b/.Rprofile
@@ -24,10 +24,10 @@ assign(".Rprofile", new.env(), envir = globalenv())
         )
     )
 
-    # Programming Logic
-    pkgs <- c("usethis", "devtools", "magrittr", "testthat")
-    invisible(sapply(pkgs, require, warn.conflicts = FALSE, character.only = TRUE))
-    .Rprofile$tasks$update_template()
+    # Programming Logic
+    pkgs <- c("usethis", "devtools", "magrittr", "testthat")
+    invisible(sapply(pkgs, require, warn.conflicts = FALSE, character.only = TRUE))
+    .Rprofile$tasks$update_templates()
 }
 
 # .Last -------------------------------------------------------------------
@@ -132,8 +132,8 @@ assign(".Rprofile", new.env(), envir = globalenv())
 }
 
 # Utils -------------------------------------------------------------------
-.Rprofile$utils$run_script <- function(path, name){
-    .Rprofile$tasks$update_template()
+.Rprofile$utils$run_script <- function(path, name){
+    .Rprofile$tasks$update_templates()
 
     withr::with_envvar(
         c(TESTTHAT = "true"),

diff --git a/R/ddd-add_value_object.R b/R/ddd-add_value_object.R
@@ -1,30 +1,155 @@
-#' @title Add a Value Object to a Domain
-#' @description Value Object
-#' @param name (`character`) \code{Value Object} name.
-#' @param domain (`character`) \code{Value Object} domain name.
-#' @includeRmd vignettes/articles/add_value_object.Rmd
-#' @family domain object generators
-#' @export
-add_value_object <- function(name, domain){
-    # Defensive Programming ---------------------------------------------------
-    assert$is_character(name)
-    assert$is_character(domain)
+# Helper functions for dynamic value object generation ---------------------
+
+#' Infer R type default from data frame column
+#' @param x A vector from a data.frame column
+#' @return Character string representing the default value for the type
+#' @noRd
+infer_type_default <- function(x) {
+    if (is.logical(x)) {
+        return("NA")
+    } else if (is.integer(x)) {
+        return("0L")
+    } else if (is.numeric(x)) {
+        return("0.0")
+    } else if (is.character(x)) {
+        return("NA_character_")
+    } else if (is.factor(x)) {
+        return("factor()")
+    } else {
+        return("NULL")
+    }
+}
+
+#' Infer type string for documentation
+#' @param x A vector from a data.frame column
+#' @return Character string representing the type name
+#' @noRd
+infer_type_string <- function(x) {
+    if (is.logical(x)) {
+        return("logical")
+    } else if (is.integer(x)) {
+        return("integer")
+    } else if (is.numeric(x)) {
+        return("numeric")
+    } else if (is.character(x)) {
+        return("character")
+    } else if (is.factor(x)) {
+        return("factor")
+    } else {
+        return("unknown")
+    }
+}
+
+#' Infer appropriate conversion function
+#' @param x A vector from a data.frame column
+#' @return Character string representing the conversion function
+#' @noRd
+infer_conversion_function <- function(x) {
+    if (is.logical(x)) {
+        return("as.logical")
+    } else if (is.integer(x)) {
+        return("as.integer")
+    } else if (is.numeric(x)) {
+        return("as.numeric")
+    } else if (is.character(x)) {
+        return("as.character")
+    } else if (is.factor(x)) {
+        return("as.factor")
+    } else {
+        return("identity")
+    }
+}
+
+#' Generate dynamic template for value object
+#' @param name Value object name
+#' @param domain Domain name
+#' @param fields Data frame with columns to use as fields
+#' @return Character string with the complete value object code
+#' @noRd
+generate_dynamic_template <- function(name, domain, fields) {
+    col_names <- names(fields)
+
+    # Generate @param documentation for each field
+    param_docs <- sapply(col_names, function(col) {
+        type_str <- infer_type_string(fields[[col]])
+        paste0("#' @param ", col, " ('", type_str, "') ?")
+    })
+
+    # Generate function parameters
+    func_params <- sapply(col_names, function(col) {
+        default_val <- infer_type_default(fields[[col]])
+        paste0("    ", col, " = ", default_val)
+    })
+
+    # Generate tibble add_column calls
+    add_column_calls <- sapply(col_names, function(col) {
+        conv_func <- infer_conversion_function(fields[[col]])
+        paste0("   |> tibble::add_column(", col, " = ", conv_func, "(", col, "))")
+    })
+
+    # Construct the complete template using paste instead of str_glue
+    template_parts <- c(
+        paste0("#' @title ", name, " Value Object"),
+        param_docs,
+        paste0("#' @return (`", name, "`) ", name, " Value Object"),
+        "#' @export",
+        paste0("#' @family ", domain),
+        paste0(name, " <- function("),
+        paste(func_params, collapse = ",\n"),
+        "){",
+        "    tibble::tibble()",
+        add_column_calls,
+        "   |> dplyr::distinct()",
+        "   |> tidyr::drop_na()",
+        "}"
+    )
+
+    template <- paste(template_parts, collapse = "\n")
+    return(template)
+}
+
+#' @title Add a Value Object to a Domain
+#' @description Value Object
+#' @param name (`character`) \code{Value Object} name.
+#' @param domain (`character`) \code{Value Object} domain name.
+#' @param path (`character`) Path where the R files should be created. Defaults to "R".
+#' @param fields (`data.frame`, optional) A data.frame whose columns will be used as fields 
+#'   for the value object. When provided, the value object will be generated with 
+#'   parameters matching the column names and types of the data.frame.
+#' @includeRmd vignettes/articles/add_value_object.Rmd
+#' @family domain object generators
+#' @export
+add_value_object <- function(name, domain, path = "R", fields = NULL){
+    # Defensive Programming ---------------------------------------------------
+    assert$is_character(name)
+    assert$is_character(domain)
+    assert$is_character(path)
+    if (!is.null(fields)) {
+        stopifnot(is.data.frame(fields))
+    }
 
     # Setup -------------------------------------------------------------------
     name <- title$value(name)
     domain <- title$domain(domain)
 
-    # Add Value Object --------------------------------------------------------
-    file_path <- file.path(getwd(), "R", filename$value(name, domain))
-    file.create(file_path)
-
-    template <- read_lines(find.template("templates", "value-object", "template.R"))
-    excerpts <- str_glue(template, name = name, domain = domain)
-
-    excerpts %>%
-        unlist(use.names = FALSE) %>%
-        paste0(collapse = "\n\n") %>%
-        write(file = file_path, append = FALSE, sep = "\n")
+    # Add Value Object --------------------------------------------------------
+    file_path <- file.path(path, filename$value(name, domain))
+    file.create(file_path)
+
+    if (is.null(fields)) {
+        # Use existing template for backward compatibility
+        template <- read_lines(find.template("templates", "value-object", "template.R"))
+        excerpts <- str_glue(template, name = name, domain = domain)
+
+        content <- excerpts %>%
+            unlist(use.names = FALSE) %>%
+            paste0(collapse = "\n\n")
+    } else {
+        # Generate dynamic template based on fields
+        content <- generate_dynamic_template(name, domain, fields)
+    }
+
+    write(content, file = file_path, append = FALSE, sep = "\n")
 
     if(interactive()) fs::file_show(file_path) # nocov
 

diff --git a/tests/testthat/test-ddd-add_value_object_exact.R b/tests/testthat/test-ddd-add_value_object_exact.R
@@ -0,0 +1,53 @@
+# Test to verify exact requirements from the issue
+
+# Setup -------------------------------------------------------------------
+create_package(test_wd)
+withr::local_dir(test_wd)
+
+test_that("add_value_object matches the exact requirements from the issue", {
+    # Create test data using mtcars subset (just a few columns for testing)
+    mtcars_subset <- data.frame(
+        mpg = c(21.0, 21.0, 22.8, 21.4),
+        cyl = c(6L, 6L, 4L, 6L),
+        hp = c(110L, 110L, 93L, 110L),
+        stringsAsFactors = FALSE
+    )
+
+    # The exact call from the issue:
+    # add_value_object(path = "./R", domain = "showroom", name = "car", fields = "mtcars")
+    # But since we're using a data.frame instead of the name, we adjust:
+    expect_null(add_value_object(path = "R", domain = "showroom", name = "car", fields = mtcars_subset))
+
+    # Check that file was created in ./R/showroom-value-objects (or similar)
+    file_path <- file.path("R", filename$value("car", "showroom"))
+    expect_file_exists(file_path)
+
+    # Read the generated content
+    file_content <- readLines(file_path)
+    content_str <- paste(file_content, collapse = "\n")
+
+    # Verify it follows the template pattern from the issue:
+    # Should have @title, @param for each column, @return, @export, @family
+    expect_match(content_str, "#' @title Car Value Object")
+    expect_match(content_str, "#' @param mpg \\('numeric'\\)")
+    expect_match(content_str, "#' @param cyl \\('integer'\\)") 
+    expect_match(content_str, "#' @param hp \\('integer'\\)")
+    expect_match(content_str, "#' @return \\(`Car`\\) Car Value Object")
+    expect_match(content_str, "#' @export")
+    expect_match(content_str, "#' @family Showroom")
+
+    # Should have the function with proper arguments
+    expect_match(content_str, "Car <- function\\(")
+    expect_match(content_str, "mpg = 0\\.0")
+    expect_match(content_str, "cyl = 0L")
+    expect_match(content_str, "hp = 0L")
+
+    # Should use tibble::add_column pattern as specified
+    expect_match(content_str, "tibble::add_column\\(mpg = as\\.numeric\\(mpg\\)\\)")
+    expect_match(content_str, "tibble::add_column\\(cyl = as\\.integer\\(cyl\\)\\)")
+    expect_match(content_str, "tibble::add_column\\(hp = as\\.integer\\(hp\\)\\)")
+
+    # Should include distinct() and drop_na()
+    expect_match(content_str, "dplyr::distinct\\(\\)")
+    expect_match(content_str, "tidyr::drop_na\\(\\)")
+})
diff --git a/tests/testthat/test-ddd-add_value_object_fields.R b/tests/testthat/test-ddd-add_value_object_fields.R
@@ -0,0 +1,56 @@
+# Test for new add_value_object functionality with fields parameter
+
+# Setup -------------------------------------------------------------------
+create_package(test_wd)
+withr::local_dir(test_wd)
+
+test_that("add_value_object creates dynamic template with fields parameter", {
+    # Create test data similar to mtcars subset
+    test_fields <- data.frame(
+        mpg = c(21.0, 21.0),
+        cyl = c(6L, 6L),
+        hp = c(110L, 110L),
+        stringsAsFactors = FALSE
+    )
+
+    # Test the new functionality
+    name <- title$value("Car")
+    domain <- title$domain("Showroom")
+
+    expect_null(add_value_object(name = name, domain = domain, fields = test_fields))
+
+    # Check that file was created (using same pattern as original test)
+    file_path <- file.path(getwd(), "R", filename$value(name, domain))
+    expect_file_exists(file_path)
+
+    # Read and check file content
+    file_content <- readLines(file_path)
+    content_str <- paste(file_content, collapse = "\n")
+
+    # Verify the content contains expected elements
+    expect_match(content_str, "@param mpg \\('numeric'\\)")
+    expect_match(content_str, "@param cyl \\('integer'\\)")
+    expect_match(content_str, "@param hp \\('integer'\\)")
+    expect_match(content_str, "mpg = 0\\.0")
+    expect_match(content_str, "cyl = 0L")
+    expect_match(content_str, "hp = 0L")
+    expect_match(content_str, "tibble::add_column\\(mpg = as\\.numeric\\(mpg\\)\\)")
+    expect_match(content_str, "tibble::add_column\\(cyl = as\\.integer\\(cyl\\)\\)")
+    expect_match(content_str, "tibble::add_column\\(hp = as\\.integer\\(hp\\)\\)")
+    expect_match(content_str, "dplyr::distinct\\(\\)")
+    expect_match(content_str, "tidyr::drop_na\\(\\)")
+})
+
+test_that("add_value_object maintains backward compatibility without fields", {
+    name <- title$value("Pizza Slice")
+    domain <- title$domain("Pizza Ordering")
+
+    # Test legacy functionality (without fields parameter)
+    expect_null(add_value_object(name, domain))
+    file_path <- file.path(getwd(), "R", filename$value(name, domain))
+    expect_file_exists(file_path)
+
+    file_content <- readLines(file_path)
+    expect_match(file_content, name)
+    expect_match(file_content, domain)
+})