From 827ca97b8fb7bdcbf33b8c6ff20e91e522125e59 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 13:06:39 -0500 Subject: [PATCH 01/32] Project files. --- .Rbuildignore | 4 ++++ .Rprofile | 1 + .gitignore | 4 ++++ DESCRIPTION | 10 ++++++++++ NAMESPACE | 1 + check-install.sh | 31 +++++++++++++++++++++++++++++++ interface.Rproj | 20 ++++++++++++++++++++ renv.lock | 23 +++++++++++++++++++++++ 8 files changed, 94 insertions(+) create mode 100644 .Rbuildignore create mode 100644 .Rprofile create mode 100644 DESCRIPTION create mode 100644 NAMESPACE create mode 100755 check-install.sh create mode 100644 interface.Rproj create mode 100644 renv.lock diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..d821302 --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,4 @@ +^renv$ +^renv\.lock$ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/.Rprofile b/.Rprofile new file mode 100644 index 0000000..81b960f --- /dev/null +++ b/.Rprofile @@ -0,0 +1 @@ +source("renv/activate.R") diff --git a/.gitignore b/.gitignore index e75435c..aabb83a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,7 @@ +# renv +/renv/ +!renv.lock + # History files .Rhistory .Rapp.history diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..b6939d7 --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,10 @@ +Package: interface +Type: Package +Title: Data validation and typing in R +Version: 0.1.0 +Author: Dereck Mezquita +Maintainer: Dereck Mezquita +Description: Easy to use TypeScript-like data validation and typing for R +License: MIT + file LICENSE +Encoding: UTF-8 +LazyData: true diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..d75f824 --- /dev/null +++ b/NAMESPACE @@ -0,0 +1 @@ +exportPattern("^[[:alpha:]]+") diff --git a/check-install.sh b/check-install.sh new file mode 100755 index 0000000..cf07667 --- /dev/null +++ b/check-install.sh @@ -0,0 +1,31 @@ +#!/usr/bin/env bash + +# if $1 does not match either check or install +if [[ $1 != "check" ]] && [[ $1 != "install" ]] && [[ $1 != "check-install" ]]; then + echo "Usage: package-management.sh [check|install|check-install]" +fi + +if [[ $1 == "check" ]]; then + Rscript -e "devtools::check()" +fi + +if [[ $1 == "install" ]]; then + # get name of current directory + PROJECT_DIR=$(pwd) + PKGNAME=$(basename $(pwd)) + cd .. + R CMD build $PKGNAME + R CMD INSTALL --no-multiarch --with-keep.source $PKGNAME + cd $PROJECT_DIR +fi + +if [[ $1 == "check-install" ]]; then + Rscript -e "devtools::check()" + # get name of current directory + PROJECT_DIR=$(pwd) + PKGNAME=$(basename $(pwd)) + cd .. + R CMD build $PKGNAME + R CMD INSTALL --no-multiarch --with-keep.source $PKGNAME + cd $PROJECT_DIR +fi diff --git a/interface.Rproj b/interface.Rproj new file mode 100644 index 0000000..a648ce1 --- /dev/null +++ b/interface.Rproj @@ -0,0 +1,20 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 4 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +AutoAppendNewline: Yes +StripTrailingWhitespace: Yes + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/renv.lock b/renv.lock new file mode 100644 index 0000000..9ba7f80 --- /dev/null +++ b/renv.lock @@ -0,0 +1,23 @@ +{ + "R": { + "Version": "4.4.1", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://lib.stat.cmu.edu/R/CRAN" + } + ] + }, + "Packages": { + "renv": { + "Package": "renv", + "Version": "1.0.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "397b7b2a265bc5a7a06852524dabae20" + } + } +} From fecaf8ee1418727dd4eb7eb08e4cd775a1a1bb17 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 13:07:31 -0500 Subject: [PATCH 02/32] Docs for devs. --- dev-docs/renv.md | 95 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 dev-docs/renv.md diff --git a/dev-docs/renv.md b/dev-docs/renv.md new file mode 100644 index 0000000..65a2821 --- /dev/null +++ b/dev-docs/renv.md @@ -0,0 +1,95 @@ +### Notes on Using `renv` with This R Package + +#### Purpose of `renv` + +- **Isolate Development Environment**: Keeps the package development isolated from other projects, preventing conflicts. +- **Reproducibility**: Ensures the exact same package versions are used by everyone, aiding in consistent development and testing. +- **Manage Development Dependencies**: Handles dependencies required for development, testing, and documentation that are not listed in `DESCRIPTION`. + +#### Initial Setup + +1. **Initialize `renv`**: + +```R +renv::init() +``` +This sets up a local project-specific library and creates the necessary `renv` files. + +2. **Install Development Dependencies**: + +```R +# install.packages(c("devtools", "roxygen2", "testthat")) +renv::install(c("devtools", "roxygen2", "testthat")) +renv::snapshot() +``` +This records the versions of these packages in `renv.lock`. + +#### Regular Workflow + +1. **Activate `renv`** (each time you start working on the package): + +```R +renv::activate() +``` + +2. **Install New Dependencies**: + +- Install any new packages you need: + +```R +install.packages("new_package") +``` + +- Update the lockfile: + +```R +renv::snapshot() +``` + +3. **Document and Build**: + +- Document the package: + +```R +devtools::document() +``` + +- Build and check the package: + +```R +devtools::build() +devtools::check() +``` + +#### Sharing the Project + +- **Include `renv.lock`** in version control to share the exact environment setup. +- Other developers can **restore the environment**: + +```R +renv::restore() +``` + +#### Ignoring `renv` Files + +- Ensure the following lines are in `.Rbuildignore`: + +``` +^renv$ +^renv.lock$ +^renv/activate.R$ +``` + +.gitingore should also include `renv/` to prevent the entire directory from being tracked. + +#### Updating Dependencies + +- When adding or updating dependencies, always run: + +```R +renv::snapshot() +``` + +This updates `renv.lock` with the current package versions. + +By following these notes, future developers will be able to maintain a consistent and reproducible development environment, ensuring smooth collaboration and development. \ No newline at end of file From f94e8b5dbcf8a456ce3fd5f418016f0ee0ec8cd9 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 13:58:20 -0500 Subject: [PATCH 03/32] Implementing interface systems in different approaches. --- research/interface-R6.R | 83 ++++++++++++++++++++++++++++++++++++ research/interface-list.R | 70 ++++++++++++++++++++++++++++++ research/interface-s4.R | 89 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 242 insertions(+) create mode 100644 research/interface-R6.R create mode 100644 research/interface-list.R create mode 100644 research/interface-s4.R diff --git a/research/interface-R6.R b/research/interface-R6.R new file mode 100644 index 0000000..63b191e --- /dev/null +++ b/research/interface-R6.R @@ -0,0 +1,83 @@ +library(R6) + +InterfaceSystem <- R6Class("InterfaceSystem", + public = list( + interfaces = list(), + + define_interface = function(name, properties) { + self$interfaces[[name]] <- properties + }, + + implement = function(interface_name, ...) { + if (is.null(self$interfaces[[interface_name]])) { + stop(paste("Interface", interface_name, "not defined")) + } + + obj <- list(...) + interface <- self$interfaces[[interface_name]] + + # Check if all required properties are present + missing_props <- setdiff(names(interface), names(obj)) + if (length(missing_props) > 0) { + stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) + } + + # Check types of properties + for (prop in names(interface)) { + expected_type <- interface[[prop]] + actual_value <- obj[[prop]] + + if (!inherits(actual_value, expected_type)) { + stop(paste("Property", prop, "should be of type", expected_type)) + } + } + + # Create an R6 class dynamically + className <- paste0(interface_name, "Impl") + ImplClass <- R6Class(className, + public = obj, + active = lapply(names(obj), function(n) function(value) { + if (missing(value)) self[[n]] + else stop("Cannot modify readonly property") + }) + ) + + ImplClass$new() + } + ) +) + +# Example usage +system <- InterfaceSystem$new() + +# Define an interface +system$define_interface("Person", list( + name = "character", + age = "numeric", + email = "character" +)) + +# Create an object implementing the interface +john <- system$implement("Person", + name = "John Doe", + age = 30, + email = "john@example.com" +) + +# Accessing properties +print(john$name) # "John Doe" +print(john$age) # 30 + +# This would raise an error due to incorrect type +# try(system$implement("Person", +# name = "Jane Doe", +# age = "thirty", # This should be a number +# email = "jane@example.com" +# )) + +# This would raise an error due to missing property +# try(system$implement("Person", +# name = "Bob Smith", +# age = 25 +# # missing email +# )) \ No newline at end of file diff --git a/research/interface-list.R b/research/interface-list.R new file mode 100644 index 0000000..8a7eb68 --- /dev/null +++ b/research/interface-list.R @@ -0,0 +1,70 @@ +# Define the interface system +interface_system <- list( + interfaces = list(), + + define_interface = function(name, properties) { + self$interfaces[[name]] <- properties + }, + + implement = function(interface_name, ...) { + if (is.null(self$interfaces[[interface_name]])) { + stop(paste("Interface", interface_name, "not defined")) + } + + obj <- list(...) + interface <- self$interfaces[[interface_name]] + + # Check if all required properties are present + missing_props <- setdiff(names(interface), names(obj)) + if (length(missing_props) > 0) { + stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) + } + + # Check types of properties + for (prop in names(interface)) { + expected_type <- interface[[prop]] + actual_value <- obj[[prop]] + + if (!inherits(actual_value, expected_type)) { + stop(paste("Property", prop, "should be of type", expected_type)) + } + } + + # Add a class to the object for identification + class(obj) <- c(interface_name, class(obj)) + obj + } +) + +# Example usage +# Define an interface +interface_system$define_interface("Person", list( + name = "character", + age = "numeric", + email = "character" +)) + +# Create an object implementing the interface +john <- interface_system$implement("Person", + name = "John Doe", + age = 30, + email = "john@example.com" +) + +# Accessing properties +print(john$name) # "John Doe" +print(john$age) # 30 + +# This would raise an error due to incorrect type +# try(interface_system$implement("Person", +# name = "Jane Doe", +# age = "thirty", # This should be a number +# email = "jane@example.com" +# )) + +# This would raise an error due to missing property +# try(interface_system$implement("Person", +# name = "Bob Smith", +# age = 25 +# # missing email +# )) \ No newline at end of file diff --git a/research/interface-s4.R b/research/interface-s4.R new file mode 100644 index 0000000..1ceb9fa --- /dev/null +++ b/research/interface-s4.R @@ -0,0 +1,89 @@ +library(methods) + +# Define the Interface class +setClass("Interface", slots = list( + interface_name = "character", + properties = "list" +)) + +# Function to create an interface +interface <- function(interface_name, ...) { + properties <- list(...) + new("Interface", interface_name = interface_name, properties = properties) +} + +# Function to create an object that implements an interface +implement <- function(interface, ...) { + obj <- list(...) + + # Check if all required properties are present + missing_props <- setdiff(names(interface@properties), names(obj)) + if (length(missing_props) > 0) { + stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) + } + + # Check types of properties + type_errors <- character() + for (prop in names(interface@properties)) { + expected_type <- interface@properties[[prop]] + actual_value <- obj[[prop]] + + if (!is(actual_value, expected_type)) { + type_errors <- c(type_errors, sprintf("Property '%s' should be of type '%s', but got '%s'", prop, expected_type, class(actual_value)[1])) + } + } + + if (length(type_errors) > 0) { + stop(paste("Type mismatch errors:", paste(type_errors, collapse = "\n"), sep = "\n")) + } + + # Create an S4 class dynamically + class_name <- paste0(interface@interface_name, "Implementation") + slot_def <- interface@properties + if (!isClass(class_name)) { + setClass(class_name, slots = slot_def) + } + + # Create and return the object + do.call(new, c(class_name, obj)) +} + +# Example usage +# Define an interface +Person <- interface("Person", + name = "character", + age = "numeric", + email = "character" +) + +# Create an object implementing the interface +john <- implement(Person, + name = "John Doe", + age = 30, + email = "john@example.com" +) + +sally <- implement(Person, + name = "Sally Doe", + age = "30", + email = 2121 +) + +# Accessing properties +print(john@name) # Should print "John Doe" +print(john@age) # Should print 30 +print(john@email) # Should print "john@example.com" + +# This would raise an error with all type mismatches +try(implement(Person, + name = 123, # Should be character + age = "thirty", # Should be numeric + email = TRUE # Should be character +)) + +# This would raise an error due to missing property +try(implement(Person, + name = "Bob Smith", + age = 25 + # missing email +)) \ No newline at end of file From bdd06669c9406c7a37b83f6dd09c074cec2a8b87 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 14:19:49 -0500 Subject: [PATCH 04/32] Developing interfaces in S4 to support more types and custom types from R6 or others as well as nesting types. --- research/interface-s4.R | 161 +++++++++++++++++++++++++--------------- research/temp.R | 132 ++++++++++++++++++++++++++++++++ 2 files changed, 234 insertions(+), 59 deletions(-) create mode 100644 research/temp.R diff --git a/research/interface-s4.R b/research/interface-s4.R index 1ceb9fa..42e845b 100644 --- a/research/interface-s4.R +++ b/research/interface-s4.R @@ -2,88 +2,131 @@ library(methods) # Define the Interface class setClass("Interface", slots = list( - interface_name = "character", - properties = "list" + interface_name = "character", + properties = "list" )) # Function to create an interface interface <- function(interface_name, ...) { - properties <- list(...) - new("Interface", interface_name = interface_name, properties = properties) + properties <- list(...) + new("Interface", interface_name = interface_name, properties = properties) +} + +# Helper function to check if a value matches a type specification +check_type <- function(value, type_spec) { + if (is(type_spec, "Interface")) { + # If type_spec is an Interface, check if value implements the interface + if (is(value, paste0(type_spec@interface_name, "Implementation"))) { + return(TRUE) + } + + return( + all(names(type_spec@properties) %in% slotNames(value)) && + all(mapply(check_type, sapply(names(type_spec@properties), slot, object = value), type_spec@properties)) + ) + } else if (is.character(type_spec)) { + # Handle base R types and S3/S4/R6 classes + return(is(value, type_spec)) + } else if (is.function(type_spec)) { + # Custom validation function + return(type_spec(value)) + } else { + stop("Unsupported type specification") + } } # Function to create an object that implements an interface implement <- function(interface, ...) { - obj <- list(...) - - # Check if all required properties are present - missing_props <- setdiff(names(interface@properties), names(obj)) - if (length(missing_props) > 0) { - stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) - } - - # Check types of properties - type_errors <- character() - for (prop in names(interface@properties)) { - expected_type <- interface@properties[[prop]] - actual_value <- obj[[prop]] + obj <- list(...) + + # Check if all required properties are present + missing_props <- setdiff(names(interface@properties), names(obj)) + if (length(missing_props) > 0) { + stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) + } - if (!is(actual_value, expected_type)) { - type_errors <- c(type_errors, sprintf("Property '%s' should be of type '%s', but got '%s'", prop, expected_type, class(actual_value)[1])) + # Check types of properties + type_errors <- character() + for (prop in names(interface@properties)) { + expected_type <- interface@properties[[prop]] + actual_value <- obj[[prop]] + + if (!check_type(actual_value, expected_type)) { + type_errors <- c( + type_errors, + sprintf("Property '%s' does not match the expected type specification", prop) + ) + } } - } - - if (length(type_errors) > 0) { - stop(paste("Type mismatch errors:", paste(type_errors, collapse = "\n"), sep = "\n")) - } - - # Create an S4 class dynamically - class_name <- paste0(interface@interface_name, "Implementation") - slot_def <- interface@properties - if (!isClass(class_name)) { - setClass(class_name, slots = slot_def) - } - - # Create and return the object - do.call(new, c(class_name, obj)) + + if (length(type_errors) > 0) { + stop(paste("Type mismatch errors:", paste(type_errors, collapse = "\n"), sep = "\n")) + } + + # Create an S4 class dynamically + class_name <- paste0(interface@interface_name, "Implementation") + slot_def <- sapply(interface@properties, function(x) if(is(x, "Interface")) "ANY" else x) + if (!isClass(class_name)) { + setClass(class_name, slots = slot_def) + } + + # Create and return the object + do.call(new, c(class_name, obj)) } # Example usage -# Define an interface +# Define interfaces Person <- interface("Person", - name = "character", - age = "numeric", - email = "character" + name = "character", + age = "numeric", + email = "character" ) -# Create an object implementing the interface +# Define an interface that uses another interface +Employee <- interface("Employee", + person = Person, + job_title = "character", + salary = "numeric", + tasks = "list" +) + +# Create objects implementing the interfaces john <- implement(Person, - name = "John Doe", - age = 30, - email = "john@example.com" + name = "John Doe", + age = 30, + email = "john@example.com" +) + +jane <- implement(Employee, + person = john, + job_title = "Manager", + salary = 50000, + tasks = list("Task 1", "Task 2") ) -sally <- implement(Person, - name = "Sally Doe", - age = "30", - email = 2121 +# Example with custom validation function +positiveNumber <- function(x) { + return(is.numeric(x) && x > 0) +} + +Account <- interface("Account", + id = "character", + balance = positiveNumber +) + +my_account <- implement(Account, + id = "ACC123", + balance = 1000 ) # Accessing properties print(john@name) # Should print "John Doe" -print(john@age) # Should print 30 -print(john@email) # Should print "john@example.com" - -# This would raise an error with all type mismatches -try(implement(Person, - name = 123, # Should be character - age = "thirty", # Should be numeric - email = TRUE # Should be character -)) +print(jane@person@name) # Should print "John Doe" +print(my_account@balance) # Should print 1000 -# This would raise an error due to missing property +# This would raise an error with type mismatches try(implement(Person, - name = "Bob Smith", - age = 25 - # missing email + name = 123, # Should be character + age = "thirty", # Should be numeric + email = TRUE # Should be character )) \ No newline at end of file diff --git a/research/temp.R b/research/temp.R new file mode 100644 index 0000000..42e845b --- /dev/null +++ b/research/temp.R @@ -0,0 +1,132 @@ +library(methods) + +# Define the Interface class +setClass("Interface", slots = list( + interface_name = "character", + properties = "list" +)) + +# Function to create an interface +interface <- function(interface_name, ...) { + properties <- list(...) + new("Interface", interface_name = interface_name, properties = properties) +} + +# Helper function to check if a value matches a type specification +check_type <- function(value, type_spec) { + if (is(type_spec, "Interface")) { + # If type_spec is an Interface, check if value implements the interface + if (is(value, paste0(type_spec@interface_name, "Implementation"))) { + return(TRUE) + } + + return( + all(names(type_spec@properties) %in% slotNames(value)) && + all(mapply(check_type, sapply(names(type_spec@properties), slot, object = value), type_spec@properties)) + ) + } else if (is.character(type_spec)) { + # Handle base R types and S3/S4/R6 classes + return(is(value, type_spec)) + } else if (is.function(type_spec)) { + # Custom validation function + return(type_spec(value)) + } else { + stop("Unsupported type specification") + } +} + +# Function to create an object that implements an interface +implement <- function(interface, ...) { + obj <- list(...) + + # Check if all required properties are present + missing_props <- setdiff(names(interface@properties), names(obj)) + if (length(missing_props) > 0) { + stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) + } + + # Check types of properties + type_errors <- character() + for (prop in names(interface@properties)) { + expected_type <- interface@properties[[prop]] + actual_value <- obj[[prop]] + + if (!check_type(actual_value, expected_type)) { + type_errors <- c( + type_errors, + sprintf("Property '%s' does not match the expected type specification", prop) + ) + } + } + + if (length(type_errors) > 0) { + stop(paste("Type mismatch errors:", paste(type_errors, collapse = "\n"), sep = "\n")) + } + + # Create an S4 class dynamically + class_name <- paste0(interface@interface_name, "Implementation") + slot_def <- sapply(interface@properties, function(x) if(is(x, "Interface")) "ANY" else x) + if (!isClass(class_name)) { + setClass(class_name, slots = slot_def) + } + + # Create and return the object + do.call(new, c(class_name, obj)) +} + +# Example usage +# Define interfaces +Person <- interface("Person", + name = "character", + age = "numeric", + email = "character" +) + +# Define an interface that uses another interface +Employee <- interface("Employee", + person = Person, + job_title = "character", + salary = "numeric", + tasks = "list" +) + +# Create objects implementing the interfaces +john <- implement(Person, + name = "John Doe", + age = 30, + email = "john@example.com" +) + +jane <- implement(Employee, + person = john, + job_title = "Manager", + salary = 50000, + tasks = list("Task 1", "Task 2") +) + +# Example with custom validation function +positiveNumber <- function(x) { + return(is.numeric(x) && x > 0) +} + +Account <- interface("Account", + id = "character", + balance = positiveNumber +) + +my_account <- implement(Account, + id = "ACC123", + balance = 1000 +) + +# Accessing properties +print(john@name) # Should print "John Doe" +print(jane@person@name) # Should print "John Doe" +print(my_account@balance) # Should print 1000 + +# This would raise an error with type mismatches +try(implement(Person, + name = 123, # Should be character + age = "thirty", # Should be numeric + email = TRUE # Should be character +)) \ No newline at end of file From 6a6b39a39ce5176a6076456f0d91e05af55fd302 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 14:21:58 -0500 Subject: [PATCH 05/32] Support any type. --- research/interface-s4.R | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/research/interface-s4.R b/research/interface-s4.R index 42e845b..3e060e9 100644 --- a/research/interface-s4.R +++ b/research/interface-s4.R @@ -14,12 +14,14 @@ interface <- function(interface_name, ...) { # Helper function to check if a value matches a type specification check_type <- function(value, type_spec) { - if (is(type_spec, "Interface")) { + if (identical(type_spec, "ANY")) { + # "ANY" type always returns TRUE + return(TRUE) + } else if (is(type_spec, "Interface")) { # If type_spec is an Interface, check if value implements the interface if (is(value, paste0(type_spec@interface_name, "Implementation"))) { return(TRUE) } - return( all(names(type_spec@properties) %in% slotNames(value)) && all(mapply(check_type, sapply(names(type_spec@properties), slot, object = value), type_spec@properties)) @@ -65,7 +67,9 @@ implement <- function(interface, ...) { # Create an S4 class dynamically class_name <- paste0(interface@interface_name, "Implementation") - slot_def <- sapply(interface@properties, function(x) if(is(x, "Interface")) "ANY" else x) + slot_def <- sapply(interface@properties, function(x) { + return(if(identical(x, "ANY") || is(x, "Interface")) "ANY" else x) + }) if (!isClass(class_name)) { setClass(class_name, slots = slot_def) } @@ -82,12 +86,13 @@ Person <- interface("Person", email = "character" ) -# Define an interface that uses another interface +# Define an interface that uses another interface and includes an "any" type Employee <- interface("Employee", person = Person, job_title = "character", salary = "numeric", - tasks = "list" + tasks = "list", + additional_info = "ANY" # This can be any type ) # Create objects implementing the interfaces @@ -101,7 +106,8 @@ jane <- implement(Employee, person = john, job_title = "Manager", salary = 50000, - tasks = list("Task 1", "Task 2") + tasks = list("Task 1", "Task 2"), + additional_info = data.frame(skill = c("Leadership", "Communication"), level = c(9, 8)) ) # Example with custom validation function @@ -111,18 +117,22 @@ positiveNumber <- function(x) { Account <- interface("Account", id = "character", - balance = positiveNumber + balance = positiveNumber, + metadata = "ANY" # This can be any type ) my_account <- implement(Account, id = "ACC123", - balance = 1000 + balance = 1000, + metadata = list(created_at = Sys.time(), last_transaction = "2023-07-01") ) # Accessing properties print(john@name) # Should print "John Doe" print(jane@person@name) # Should print "John Doe" +print(jane@additional_info) # Should print the data frame print(my_account@balance) # Should print 1000 +print(my_account@metadata) # Should print the list # This would raise an error with type mismatches try(implement(Person, From 88412a3ad5fe31b28d3fb045d553826e7bca282b Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 14:29:10 -0500 Subject: [PATCH 06/32] Updated R6 implementation. --- research/interface-R6.R | 207 ++++++++++++++++++++++++++-------------- research/interface-s4.R | 2 +- 2 files changed, 137 insertions(+), 72 deletions(-) diff --git a/research/interface-R6.R b/research/interface-R6.R index 63b191e..3a5c710 100644 --- a/research/interface-R6.R +++ b/research/interface-R6.R @@ -1,83 +1,148 @@ library(R6) -InterfaceSystem <- R6Class("InterfaceSystem", - public = list( - interfaces = list(), - - define_interface = function(name, properties) { - self$interfaces[[name]] <- properties - }, - - implement = function(interface_name, ...) { - if (is.null(self$interfaces[[interface_name]])) { - stop(paste("Interface", interface_name, "not defined")) - } - - obj <- list(...) - interface <- self$interfaces[[interface_name]] - - # Check if all required properties are present - missing_props <- setdiff(names(interface), names(obj)) - if (length(missing_props) > 0) { +# Define the Interface class +Interface <- R6Class("Interface", + public = list( + interface_name = NULL, + properties = NULL, + initialize = function(interface_name, ...) { + self$interface_name <- interface_name + self$properties <- list(...) + } + ) +) + +# Function to create an interface +interface <- function(interface_name, ...) { + Interface$new(interface_name, ...) +} + +# Helper function to check if a value matches a type specification +check_type <- function(value, type_spec) { + if (identical(type_spec, "ANY")) { + return(TRUE) + } else if (inherits(type_spec, "Interface")) { + if (inherits(value, paste0(type_spec$interface_name, "Implementation"))) { + return(TRUE) + } + return( + all(names(type_spec$properties) %in% names(value)) && + all(mapply(check_type, value[names(type_spec$properties)], type_spec$properties)) + ) + } else if (is.character(type_spec)) { + return(inherits(value, type_spec)) + } else if (is.function(type_spec)) { + return(type_spec(value)) + } else { + stop("Unsupported type specification") + } +} + +# Function to create an object that implements an interface +implement <- function(interface, ...) { + obj <- list(...) + + # Check if all required properties are present + missing_props <- setdiff(names(interface$properties), names(obj)) + if (length(missing_props) > 0) { stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) - } - - # Check types of properties - for (prop in names(interface)) { - expected_type <- interface[[prop]] + } + + # Check types of properties + type_errors <- character() + for (prop in names(interface$properties)) { + expected_type <- interface$properties[[prop]] actual_value <- obj[[prop]] - if (!inherits(actual_value, expected_type)) { - stop(paste("Property", prop, "should be of type", expected_type)) + if (!check_type(actual_value, expected_type)) { + type_errors <- c( + type_errors, + sprintf("Property '%s' does not match the expected type specification of %s", prop, expected_type) + ) } - } - - # Create an R6 class dynamically - className <- paste0(interface_name, "Impl") - ImplClass <- R6Class(className, - public = obj, - active = lapply(names(obj), function(n) function(value) { - if (missing(value)) self[[n]] - else stop("Cannot modify readonly property") - }) - ) - - ImplClass$new() } - ) -) + + if (length(type_errors) > 0) { + stop(paste("Type mismatch errors:", paste(type_errors, collapse = "\n"), sep = "\n")) + } + + # Create an R6 class dynamically + Implementation <- R6Class( + paste0(interface$interface_name, "Implementation"), + public = c( + obj, + list(initialize = function(...) { + args <- list(...) + for (name in names(args)) { + self[[name]] <- args[[name]] + } + }) + ) + ) + + # Create and return the object + Implementation$new(...) +} # Example usage -system <- InterfaceSystem$new() - -# Define an interface -system$define_interface("Person", list( - name = "character", - age = "numeric", - email = "character" -)) - -# Create an object implementing the interface -john <- system$implement("Person", - name = "John Doe", - age = 30, - email = "john@example.com" +# Define interfaces +Person <- interface("Person", + name = "character", + age = "numeric", + email = "character" +) + +# Define an interface that uses another interface and includes an "any" type +Employee <- interface("Employee", + person = Person, + job_title = "character", + salary = "numeric", + tasks = "list", + additional_info = "data.table" # This can be any type +) + +# Create objects implementing the interfaces +john <- implement(Person, + name = "John Doe", + age = 30, + email = "john@example.com" +) + +jane <- implement(Employee, + person = john, + job_title = "Manager", + salary = 50000, + tasks = list("Task 1", "Task 2"), + additional_info = data.frame(skill = c("Leadership", "Communication"), level = c(9, 8)) +) + +# Example with custom validation function +positiveNumber <- function(x) { + return(is.numeric(x) && x > 0) +} + +Account <- interface("Account", + id = "character", + balance = positiveNumber, + metadata = "ANY" # This can be any type +) + +my_account <- implement(Account, + id = "ACC123", + balance = 1000, + metadata = list(created_at = Sys.time(), last_transaction = "2023-07-01") ) # Accessing properties -print(john$name) # "John Doe" -print(john$age) # 30 - -# This would raise an error due to incorrect type -# try(system$implement("Person", -# name = "Jane Doe", -# age = "thirty", # This should be a number -# email = "jane@example.com" -# )) - -# This would raise an error due to missing property -# try(system$implement("Person", -# name = "Bob Smith", -# age = 25 -# # missing email -# )) \ No newline at end of file +print(john$name) # Should print "John Doe" +print(jane$person$name) # Should print "John Doe" +print(jane$additional_info) # Should print the data frame +print(my_account$balance) # Should print 1000 +print(my_account$metadata) # Should print the list + +# This would raise an error with type mismatches +try(implement(Person, + name = 123, # Should be character + age = "thirty", # Should be numeric + email = TRUE # Should be character +)) \ No newline at end of file diff --git a/research/interface-s4.R b/research/interface-s4.R index 3e060e9..9490c28 100644 --- a/research/interface-s4.R +++ b/research/interface-s4.R @@ -56,7 +56,7 @@ implement <- function(interface, ...) { if (!check_type(actual_value, expected_type)) { type_errors <- c( type_errors, - sprintf("Property '%s' does not match the expected type specification", prop) + sprintf("Property '%s' does not match the expected type specification of %s", prop, expected_type) ) } } From 0c6a8b3771da2b51a34cae22280282e43dcd0b48 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 14:46:05 -0500 Subject: [PATCH 07/32] Custom implmentation likely looks like best one, since it's simple and no overhead. --- research/interface-custom.R | 129 ++++++++++++++++++++++++++++++++++++ research/interface-list.R | 70 ------------------- 2 files changed, 129 insertions(+), 70 deletions(-) create mode 100644 research/interface-custom.R delete mode 100644 research/interface-list.R diff --git a/research/interface-custom.R b/research/interface-custom.R new file mode 100644 index 0000000..05abc7e --- /dev/null +++ b/research/interface-custom.R @@ -0,0 +1,129 @@ +# Define the Interface class +Interface <- function(interface_name, properties) { + structure(list(interface_name = interface_name, properties = properties), class = "Interface") +} + +# Function to create an interface +interface <- function(interface_name, ...) { + Interface(interface_name, list(...)) +} + +# Helper function to check if a value matches a type specification +check_type <- function(value, type_spec) { + if (identical(type_spec, "ANY")) { + return(TRUE) + } else if (inherits(type_spec, "Interface")) { + return(check_interface(value, type_spec)) + } else if (is.character(type_spec)) { + return(inherits(value, type_spec)) + } else if (is.function(type_spec)) { + return(type_spec(value)) + } else { + stop("Unsupported type specification") + } +} + +# Helper function to check if a value implements an interface +check_interface <- function(value, interface) { + if (!is.list(value)) return(FALSE) + all(names(interface$properties) %in% names(value)) && + all(mapply(check_type, value[names(interface$properties)], interface$properties)) +} + +# Function to create an object that implements an interface +implement <- function(interface, ...) { + obj <- list(...) + + # Check if all required properties are present + missing_props <- setdiff(names(interface$properties), names(obj)) + if (length(missing_props) > 0) { + stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) + } + + # Check types of properties + type_errors <- character() + for (prop in names(interface$properties)) { + expected_type <- interface$properties[[prop]] + actual_value <- obj[[prop]] + + if (!check_type(actual_value, expected_type)) { + type_errors <- c( + type_errors, + sprintf("Property '%s' does not match the expected type specification", prop) + ) + } + } + + if (length(type_errors) > 0) { + stop(paste("Type mismatch errors:", paste(type_errors, collapse = "\n"), sep = "\n")) + } + + # Return the object as a simple list + structure(obj, class = c(paste0(interface$interface_name, "Implementation"), "list")) +} + +# Example usage +# Define interfaces +Person <- interface("Person", + name = "character", + age = "numeric", + email = "character" +) + +# Define an interface that uses another interface and includes an "any" type +Employee <- interface("Employee", + person = Person, + job_title = "character", + salary = "numeric", + tasks = "list", + additional_info = "ANY" # This can be any type +) + +# Create objects implementing the interfaces +john <- implement(Person, + name = "John Doe", + age = 30, + email = "john@example.com" +) + +jane <- implement(Employee, + person = john, + job_title = "Manager", + salary = 50000, + tasks = list("Task 1", "Task 2"), + additional_info = data.frame(skill = c("Leadership", "Communication"), level = c(9, 8)) +) + +class(jane) +is.list(jane) + +# Example with custom validation function +positiveNumber <- function(x) { + return(is.numeric(x) && x > 0) +} + +Account <- interface("Account", + id = "character", + balance = positiveNumber, + metadata = "ANY" # This can be any type +) + +my_account <- implement(Account, + id = "ACC123", + balance = 1000, + metadata = list(created_at = Sys.time(), last_transaction = "2023-07-01") +) + +# Accessing properties +print(john$name) # Should print "John Doe" +print(jane$person$name) # Should print "John Doe" +print(jane$additional_info) # Should print the data frame +print(my_account$balance) # Should print 1000 +print(my_account$metadata) # Should print the list + +# This would raise an error with type mismatches +try(implement(Person, + name = 123, # Should be character + age = "thirty", # Should be numeric + email = TRUE # Should be character +)) \ No newline at end of file diff --git a/research/interface-list.R b/research/interface-list.R deleted file mode 100644 index 8a7eb68..0000000 --- a/research/interface-list.R +++ /dev/null @@ -1,70 +0,0 @@ -# Define the interface system -interface_system <- list( - interfaces = list(), - - define_interface = function(name, properties) { - self$interfaces[[name]] <- properties - }, - - implement = function(interface_name, ...) { - if (is.null(self$interfaces[[interface_name]])) { - stop(paste("Interface", interface_name, "not defined")) - } - - obj <- list(...) - interface <- self$interfaces[[interface_name]] - - # Check if all required properties are present - missing_props <- setdiff(names(interface), names(obj)) - if (length(missing_props) > 0) { - stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) - } - - # Check types of properties - for (prop in names(interface)) { - expected_type <- interface[[prop]] - actual_value <- obj[[prop]] - - if (!inherits(actual_value, expected_type)) { - stop(paste("Property", prop, "should be of type", expected_type)) - } - } - - # Add a class to the object for identification - class(obj) <- c(interface_name, class(obj)) - obj - } -) - -# Example usage -# Define an interface -interface_system$define_interface("Person", list( - name = "character", - age = "numeric", - email = "character" -)) - -# Create an object implementing the interface -john <- interface_system$implement("Person", - name = "John Doe", - age = 30, - email = "john@example.com" -) - -# Accessing properties -print(john$name) # "John Doe" -print(john$age) # 30 - -# This would raise an error due to incorrect type -# try(interface_system$implement("Person", -# name = "Jane Doe", -# age = "thirty", # This should be a number -# email = "jane@example.com" -# )) - -# This would raise an error due to missing property -# try(interface_system$implement("Person", -# name = "Bob Smith", -# age = 25 -# # missing email -# )) \ No newline at end of file From 3551fdbe87bac2fb3e8f9f8fbcc6c97c87719ba1 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 14:47:25 -0500 Subject: [PATCH 08/32] Formatting. --- research/interface-custom.R | 137 +++++++++++++++++++----------------- 1 file changed, 71 insertions(+), 66 deletions(-) diff --git a/research/interface-custom.R b/research/interface-custom.R index 05abc7e..907393b 100644 --- a/research/interface-custom.R +++ b/research/interface-custom.R @@ -1,97 +1,102 @@ # Define the Interface class Interface <- function(interface_name, properties) { - structure(list(interface_name = interface_name, properties = properties), class = "Interface") + structure(list(interface_name = interface_name, properties = properties), class = "Interface") } # Function to create an interface interface <- function(interface_name, ...) { - Interface(interface_name, list(...)) + Interface(interface_name, list(...)) } # Helper function to check if a value matches a type specification check_type <- function(value, type_spec) { - if (identical(type_spec, "ANY")) { - return(TRUE) - } else if (inherits(type_spec, "Interface")) { - return(check_interface(value, type_spec)) - } else if (is.character(type_spec)) { - return(inherits(value, type_spec)) - } else if (is.function(type_spec)) { - return(type_spec(value)) - } else { - stop("Unsupported type specification") - } + if (identical(type_spec, "ANY")) { + return(TRUE) + } else if (inherits(type_spec, "Interface")) { + return(check_interface(value, type_spec)) + } else if (is.character(type_spec)) { + return(inherits(value, type_spec)) + } else if (is.function(type_spec)) { + return(type_spec(value)) + } else { + stop("Unsupported type specification") + } } # Helper function to check if a value implements an interface check_interface <- function(value, interface) { - if (!is.list(value)) return(FALSE) - all(names(interface$properties) %in% names(value)) && - all(mapply(check_type, value[names(interface$properties)], interface$properties)) + if (!is.list(value)) { + return(FALSE) + } + + return( + all(names(interface$properties) %in% names(value)) && + all(mapply(check_type, value[names(interface$properties)], interface$properties)) + ) } # Function to create an object that implements an interface implement <- function(interface, ...) { - obj <- list(...) - - # Check if all required properties are present - missing_props <- setdiff(names(interface$properties), names(obj)) - if (length(missing_props) > 0) { - stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) - } - - # Check types of properties - type_errors <- character() - for (prop in names(interface$properties)) { - expected_type <- interface$properties[[prop]] - actual_value <- obj[[prop]] + obj <- list(...) + + # Check if all required properties are present + missing_props <- setdiff(names(interface$properties), names(obj)) + if (length(missing_props) > 0) { + stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) + } - if (!check_type(actual_value, expected_type)) { - type_errors <- c( - type_errors, - sprintf("Property '%s' does not match the expected type specification", prop) - ) + # Check types of properties + type_errors <- character() + for (prop in names(interface$properties)) { + expected_type <- interface$properties[[prop]] + actual_value <- obj[[prop]] + + if (!check_type(actual_value, expected_type)) { + type_errors <- c( + type_errors, + sprintf("Property '%s' does not match the expected type specification", prop) + ) + } } - } - if (length(type_errors) > 0) { - stop(paste("Type mismatch errors:", paste(type_errors, collapse = "\n"), sep = "\n")) - } + if (length(type_errors) > 0) { + stop(paste("Type mismatch errors:", paste(type_errors, collapse = "\n"), sep = "\n")) + } - # Return the object as a simple list - structure(obj, class = c(paste0(interface$interface_name, "Implementation"), "list")) + # Return the object as a simple list + return(structure(obj, class = c(paste0(interface$interface_name, "Implementation"), "list"))) } # Example usage # Define interfaces Person <- interface("Person", - name = "character", - age = "numeric", - email = "character" + name = "character", + age = "numeric", + email = "character" ) # Define an interface that uses another interface and includes an "any" type Employee <- interface("Employee", - person = Person, - job_title = "character", - salary = "numeric", - tasks = "list", - additional_info = "ANY" # This can be any type + person = Person, + job_title = "character", + salary = "numeric", + tasks = "list", + additional_info = "ANY" # This can be any type ) # Create objects implementing the interfaces john <- implement(Person, - name = "John Doe", - age = 30, - email = "john@example.com" + name = "John Doe", + age = 30, + email = "john@example.com" ) jane <- implement(Employee, - person = john, - job_title = "Manager", - salary = 50000, - tasks = list("Task 1", "Task 2"), - additional_info = data.frame(skill = c("Leadership", "Communication"), level = c(9, 8)) + person = john, + job_title = "Manager", + salary = 50000, + tasks = list("Task 1", "Task 2"), + additional_info = data.frame(skill = c("Leadership", "Communication"), level = c(9, 8)) ) class(jane) @@ -99,19 +104,19 @@ is.list(jane) # Example with custom validation function positiveNumber <- function(x) { - return(is.numeric(x) && x > 0) + return(is.numeric(x) && x > 0) } Account <- interface("Account", - id = "character", - balance = positiveNumber, - metadata = "ANY" # This can be any type + id = "character", + balance = positiveNumber, + metadata = "ANY" # This can be any type ) my_account <- implement(Account, - id = "ACC123", - balance = 1000, - metadata = list(created_at = Sys.time(), last_transaction = "2023-07-01") + id = "ACC123", + balance = 1000, + metadata = list(created_at = Sys.time(), last_transaction = "2023-07-01") ) # Accessing properties @@ -123,7 +128,7 @@ print(my_account$metadata) # Should print the list # This would raise an error with type mismatches try(implement(Person, - name = 123, # Should be character - age = "thirty", # Should be numeric - email = TRUE # Should be character + name = 123, # Should be character + age = "thirty", # Should be numeric + email = TRUE # Should be character )) \ No newline at end of file From 0b58b27e3a9c4d02eb43feb428044706bbf63c13 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 14:53:26 -0500 Subject: [PATCH 09/32] Validate on access functionality. --- research/interface-custom.R | 100 +++++++++++++++++++----------------- 1 file changed, 52 insertions(+), 48 deletions(-) diff --git a/research/interface-custom.R b/research/interface-custom.R index 907393b..5115818 100644 --- a/research/interface-custom.R +++ b/research/interface-custom.R @@ -28,45 +28,59 @@ check_interface <- function(value, interface) { if (!is.list(value)) { return(FALSE) } - return( all(names(interface$properties) %in% names(value)) && all(mapply(check_type, value[names(interface$properties)], interface$properties)) ) } -# Function to create an object that implements an interface -implement <- function(interface, ...) { - obj <- list(...) - - # Check if all required properties are present - missing_props <- setdiff(names(interface$properties), names(obj)) - if (length(missing_props) > 0) { - stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) - } - - # Check types of properties - type_errors <- character() +# Validation function +validate_object <- function(obj, interface) { + print("Validating object") for (prop in names(interface$properties)) { expected_type <- interface$properties[[prop]] actual_value <- obj[[prop]] if (!check_type(actual_value, expected_type)) { - type_errors <- c( - type_errors, - sprintf("Property '%s' does not match the expected type specification", prop) - ) + stop(sprintf("Property '%s' does not match the expected type specification", prop)) } } + return(TRUE) +} - if (length(type_errors) > 0) { - stop(paste("Type mismatch errors:", paste(type_errors, collapse = "\n"), sep = "\n")) +# Custom accessor function +custom_accessor <- function(x, i) { + if (isTRUE(attr(x, "validate_on_access"))) { + return(validate_object(x, attr(x, "interface"))) } + return(x[[i]]) +} + +# Function to create an object that implements an interface +implement <- function(interface, ..., validate_on_access = FALSE) { + obj <- list(...) - # Return the object as a simple list - return(structure(obj, class = c(paste0(interface$interface_name, "Implementation"), "list"))) + # Check if all required properties are present + missing_props <- setdiff(names(interface$properties), names(obj)) + if (length(missing_props) > 0) { + stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) + } + + # Initial validation + validate_object(obj, interface) + + # Return the object as a simple list with custom class and attributes + return(structure( + obj, + class = c(paste0(interface$interface_name, "Implementation"), "validated_list", "list"), + interface = interface, + validate_on_access = validate_on_access + )) } +# Define custom `$` method for our objects +`$.validated_list` <- custom_accessor + # Example usage # Define interfaces Person <- interface("Person", @@ -88,7 +102,8 @@ Employee <- interface("Employee", john <- implement(Person, name = "John Doe", age = 30, - email = "john@example.com" + email = "john@example.com", + validate_on_access = TRUE ) jane <- implement(Employee, @@ -96,39 +111,28 @@ jane <- implement(Employee, job_title = "Manager", salary = 50000, tasks = list("Task 1", "Task 2"), - additional_info = data.frame(skill = c("Leadership", "Communication"), level = c(9, 8)) + additional_info = data.frame(skill = c("Leadership", "Communication"), level = c(9, 8)), + validate_on_access = TRUE ) -class(jane) -is.list(jane) +# Accessing properties (this will trigger validation) +print(john$name) # Should print "John Doe" +print(jane$person$name) # Should print "John Doe" -# Example with custom validation function -positiveNumber <- function(x) { - return(is.numeric(x) && x > 0) -} +# Try to modify the object in a way that violates the interface +john$age <- "thirty" # This should not cause an immediate error -Account <- interface("Account", - id = "character", - balance = positiveNumber, - metadata = "ANY" # This can be any type -) +# But when we try to access any property, it will trigger validation and raise an error +try(print(john$name)) +# Create an object without validation on access my_account <- implement(Account, id = "ACC123", balance = 1000, - metadata = list(created_at = Sys.time(), last_transaction = "2023-07-01") + metadata = list(created_at = Sys.time(), last_transaction = "2023-07-01"), + validate_on_access = FALSE ) -# Accessing properties -print(john$name) # Should print "John Doe" -print(jane$person$name) # Should print "John Doe" -print(jane$additional_info) # Should print the data frame -print(my_account$balance) # Should print 1000 -print(my_account$metadata) # Should print the list - -# This would raise an error with type mismatches -try(implement(Person, - name = 123, # Should be character - age = "thirty", # Should be numeric - email = TRUE # Should be character -)) \ No newline at end of file +# This won't trigger validation +my_account$balance <- "Invalid" +print(my_account$balance) # This will print "Invalid" without raising an error \ No newline at end of file From 808660a2d3b165fd39848d6f94d9b86160a2f70a Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 15:02:01 -0500 Subject: [PATCH 10/32] Allow for validate to be optional from interface creation. --- research/interface-custom.R | 40 ++++++++++++++++++++++++------------- 1 file changed, 26 insertions(+), 14 deletions(-) diff --git a/research/interface-custom.R b/research/interface-custom.R index 5115818..f577c7e 100644 --- a/research/interface-custom.R +++ b/research/interface-custom.R @@ -1,11 +1,16 @@ # Define the Interface class -Interface <- function(interface_name, properties) { - structure(list(interface_name = interface_name, properties = properties), class = "Interface") +Interface <- function(interface_name, properties, validate_on_access = FALSE) { + return(structure(list( + interface_name = interface_name, + properties = properties, + validate_on_access = validate_on_access + ), class = "Interface")) } # Function to create an interface -interface <- function(interface_name, ...) { - Interface(interface_name, list(...)) +interface <- function(interface_name, ..., validate_on_access = FALSE) { + properties <- list(...) + return(Interface(interface_name, properties, validate_on_access)) } # Helper function to check if a value matches a type specification @@ -57,7 +62,7 @@ custom_accessor <- function(x, i) { } # Function to create an object that implements an interface -implement <- function(interface, ..., validate_on_access = FALSE) { +implement <- function(interface, ..., validate_on_access = NULL) { obj <- list(...) # Check if all required properties are present @@ -69,6 +74,11 @@ implement <- function(interface, ..., validate_on_access = FALSE) { # Initial validation validate_object(obj, interface) + # Determine validate_on_access value + if (is.null(validate_on_access)) { + validate_on_access <- interface$validate_on_access + } + # Return the object as a simple list with custom class and attributes return(structure( obj, @@ -86,7 +96,8 @@ implement <- function(interface, ..., validate_on_access = FALSE) { Person <- interface("Person", name = "character", age = "numeric", - email = "character" + email = "character", + validate_on_access = TRUE # Set default validation for Person ) # Define an interface that uses another interface and includes an "any" type @@ -95,15 +106,16 @@ Employee <- interface("Employee", job_title = "character", salary = "numeric", tasks = "list", - additional_info = "ANY" # This can be any type + additional_info = "ANY", # This can be any type + validate_on_access = FALSE # Set default validation for Employee ) # Create objects implementing the interfaces john <- implement(Person, name = "John Doe", age = 30, - email = "john@example.com", - validate_on_access = TRUE + email = "john@example.com" + # validate_on_access is not specified, so it will use the interface default (TRUE) ) jane <- implement(Employee, @@ -112,12 +124,12 @@ jane <- implement(Employee, salary = 50000, tasks = list("Task 1", "Task 2"), additional_info = data.frame(skill = c("Leadership", "Communication"), level = c(9, 8)), - validate_on_access = TRUE + validate_on_access = TRUE # Override the interface default ) -# Accessing properties (this will trigger validation) -print(john$name) # Should print "John Doe" -print(jane$person$name) # Should print "John Doe" +# Accessing properties (this will trigger validation for john, but not for jane) +print(john$name) # Should print "John Doe" and trigger validation +print(jane$job_title) # Should print "Manager" and trigger validation (due to override) # Try to modify the object in a way that violates the interface john$age <- "thirty" # This should not cause an immediate error @@ -125,7 +137,7 @@ john$age <- "thirty" # This should not cause an immediate error # But when we try to access any property, it will trigger validation and raise an error try(print(john$name)) -# Create an object without validation on access +# Create an object explicitly without validation on access my_account <- implement(Account, id = "ACC123", balance = 1000, From 13618d88a1ab9bb955bbce1ba690e00336100a69 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 16:08:56 -0500 Subject: [PATCH 11/32] Don't attach validate if the user doesn't want it avoids overhead. --- research/interface-custom.R | 53 ++++++++++++++++++++++--------------- 1 file changed, 31 insertions(+), 22 deletions(-) diff --git a/research/interface-custom.R b/research/interface-custom.R index f577c7e..1fec563 100644 --- a/research/interface-custom.R +++ b/research/interface-custom.R @@ -55,9 +55,7 @@ validate_object <- function(obj, interface) { # Custom accessor function custom_accessor <- function(x, i) { - if (isTRUE(attr(x, "validate_on_access"))) { - return(validate_object(x, attr(x, "interface"))) - } + validate_object(x, attr(x, "interface")) return(x[[i]]) } @@ -79,16 +77,27 @@ implement <- function(interface, ..., validate_on_access = NULL) { validate_on_access <- interface$validate_on_access } - # Return the object as a simple list with custom class and attributes + # Prepare class and attributes + class_name <- paste0(interface$interface_name, "Implementation") + classes <- c(class_name, "list") + attrs <- list(interface = interface) + + # Only add validation if required + if (validate_on_access) { + classes <- c("validated_list", classes) + attrs$validate_on_access <- TRUE + } + + # Return the object as a simple list with appropriate class and attributes return(structure( obj, - class = c(paste0(interface$interface_name, "Implementation"), "validated_list", "list"), + class = classes, interface = interface, - validate_on_access = validate_on_access + validate_on_access = if(validate_on_access) TRUE else NULL )) } -# Define custom `$` method for our objects +# Define custom `$` method only for validated lists `$.validated_list` <- custom_accessor # Example usage @@ -106,7 +115,7 @@ Employee <- interface("Employee", job_title = "character", salary = "numeric", tasks = "list", - additional_info = "ANY", # This can be any type + additional_info = "ANY", validate_on_access = FALSE # Set default validation for Employee ) @@ -115,36 +124,36 @@ john <- implement(Person, name = "John Doe", age = 30, email = "john@example.com" - # validate_on_access is not specified, so it will use the interface default (TRUE) ) +john + jane <- implement(Employee, person = john, job_title = "Manager", salary = 50000, tasks = list("Task 1", "Task 2"), - additional_info = data.frame(skill = c("Leadership", "Communication"), level = c(9, 8)), - validate_on_access = TRUE # Override the interface default + additional_info = data.frame(skill = c("Leadership", "Communication"), level = c(9, 8)) ) -# Accessing properties (this will trigger validation for john, but not for jane) +# Accessing properties print(john$name) # Should print "John Doe" and trigger validation -print(jane$job_title) # Should print "Manager" and trigger validation (due to override) +print(jane$job_title) # Should print "Manager" without validation -# Try to modify the object in a way that violates the interface +# Modify the object in a way that violates the interface john$age <- "thirty" # This should not cause an immediate error -# But when we try to access any property, it will trigger validation and raise an error +# This will trigger validation and raise an error try(print(john$name)) -# Create an object explicitly without validation on access -my_account <- implement(Account, - id = "ACC123", - balance = 1000, - metadata = list(created_at = Sys.time(), last_transaction = "2023-07-01"), +# Create an object explicitly without validation +no_validate_person <- implement(Person, + name = "Alice", + age = 25, + email = "alice@example.com", validate_on_access = FALSE ) # This won't trigger validation -my_account$balance <- "Invalid" -print(my_account$balance) # This will print "Invalid" without raising an error \ No newline at end of file +no_validate_person$age <- "twenty-five" +print(no_validate_person$age) # This will print "twenty-five" without raising an error \ No newline at end of file From 18b825854968b97a565a7e4d699b038a408ef277 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 16:46:50 -0500 Subject: [PATCH 12/32] Custom print methods. --- research/interface-custom.R | 57 +++++++++++++-- research/temp.R | 142 ++++++------------------------------ 2 files changed, 74 insertions(+), 125 deletions(-) diff --git a/research/interface-custom.R b/research/interface-custom.R index 1fec563..b7acb12 100644 --- a/research/interface-custom.R +++ b/research/interface-custom.R @@ -59,6 +59,26 @@ custom_accessor <- function(x, i) { return(x[[i]]) } +# Custom print method for implemented interface objects +print.InterfaceImplementation <- function(x, ...) { + interface <- attr(x, "interface") + cat("Object implementing", interface$interface_name, "interface:\n") + for (prop in names(x)) { + cat(sprintf(" %s: ", prop)) + if (is.atomic(x[[prop]]) && length(x[[prop]]) == 1) { + cat(x[[prop]], "\n") + } else if (inherits(x[[prop]], "InterfaceImplementation")) { + cat("<", class(x[[prop]])[1], ">\n", sep = "") + } else { + cat("<", class(x[[prop]])[1], ">\n", sep = "") + } + } + cat("Validation on access:", + if(isTRUE(attr(x, "validate_on_access"))) "Enabled" else "Disabled", + "\n") + invisible(x) +} + # Function to create an object that implements an interface implement <- function(interface, ..., validate_on_access = NULL) { obj <- list(...) @@ -79,13 +99,11 @@ implement <- function(interface, ..., validate_on_access = NULL) { # Prepare class and attributes class_name <- paste0(interface$interface_name, "Implementation") - classes <- c(class_name, "list") - attrs <- list(interface = interface) - - # Only add validation if required + classes <- c(class_name, "InterfaceImplementation", "list") + + # Only add validated_list if required if (validate_on_access) { classes <- c("validated_list", classes) - attrs$validate_on_access <- TRUE } # Return the object as a simple list with appropriate class and attributes @@ -100,6 +118,32 @@ implement <- function(interface, ..., validate_on_access = NULL) { # Define custom `$` method only for validated lists `$.validated_list` <- custom_accessor +# Custom print method for Interface objects +print.Interface <- function(x, ...) { + cat("Interface:", x$interface_name, "\n") + cat("Properties:\n") + for (prop in names(x$properties)) { + prop_type <- x$properties[[prop]] + if (inherits(prop_type, "Interface")) { + cat(sprintf(" %s: \n", prop, prop_type$interface_name)) + } else if (is.function(prop_type)) { + cat(sprintf(" %s: \n", prop)) + } else { + cat(sprintf(" %s: %s\n", prop, prop_type)) + } + } + cat("Default validation on access:", if(x$validate_on_access) "Enabled" else "Disabled", "\n") + invisible(x) +} + +# You might also want to add a summary method for more concise output +summary.Interface <- function(object, ...) { + cat("Interface:", object$interface_name, "\n") + cat("Number of properties:", length(object$properties), "\n") + cat("Default validation on access:", if(object$validate_on_access) "Enabled" else "Disabled", "\n") + invisible(object) +} + # Example usage # Define interfaces Person <- interface("Person", @@ -126,7 +170,8 @@ john <- implement(Person, email = "john@example.com" ) -john +summary(Person) +summary(john) jane <- implement(Employee, person = john, diff --git a/research/temp.R b/research/temp.R index 42e845b..960803a 100644 --- a/research/temp.R +++ b/research/temp.R @@ -1,132 +1,36 @@ -library(methods) - -# Define the Interface class -setClass("Interface", slots = list( - interface_name = "character", - properties = "list" -)) - -# Function to create an interface -interface <- function(interface_name, ...) { - properties <- list(...) - new("Interface", interface_name = interface_name, properties = properties) -} - -# Helper function to check if a value matches a type specification -check_type <- function(value, type_spec) { - if (is(type_spec, "Interface")) { - # If type_spec is an Interface, check if value implements the interface - if (is(value, paste0(type_spec@interface_name, "Implementation"))) { - return(TRUE) - } - - return( - all(names(type_spec@properties) %in% slotNames(value)) && - all(mapply(check_type, sapply(names(type_spec@properties), slot, object = value), type_spec@properties)) - ) - } else if (is.character(type_spec)) { - # Handle base R types and S3/S4/R6 classes - return(is(value, type_spec)) - } else if (is.function(type_spec)) { - # Custom validation function - return(type_spec(value)) - } else { - stop("Unsupported type specification") - } -} - -# Function to create an object that implements an interface -implement <- function(interface, ...) { +implement <- function(interface, ..., validate_on_access = NULL) { obj <- list(...) # Check if all required properties are present - missing_props <- setdiff(names(interface@properties), names(obj)) + missing_props <- setdiff(names(interface$properties), names(obj)) if (length(missing_props) > 0) { stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) } - # Check types of properties - type_errors <- character() - for (prop in names(interface@properties)) { - expected_type <- interface@properties[[prop]] - actual_value <- obj[[prop]] - - if (!check_type(actual_value, expected_type)) { - type_errors <- c( - type_errors, - sprintf("Property '%s' does not match the expected type specification", prop) - ) - } - } - - if (length(type_errors) > 0) { - stop(paste("Type mismatch errors:", paste(type_errors, collapse = "\n"), sep = "\n")) - } + # Initial validation + validate_object(obj, interface) - # Create an S4 class dynamically - class_name <- paste0(interface@interface_name, "Implementation") - slot_def <- sapply(interface@properties, function(x) if(is(x, "Interface")) "ANY" else x) - if (!isClass(class_name)) { - setClass(class_name, slots = slot_def) + # Determine validate_on_access value + if (is.null(validate_on_access)) { + validate_on_access <- interface$validate_on_access } - # Create and return the object - do.call(new, c(class_name, obj)) -} - -# Example usage -# Define interfaces -Person <- interface("Person", - name = "character", - age = "numeric", - email = "character" -) - -# Define an interface that uses another interface -Employee <- interface("Employee", - person = Person, - job_title = "character", - salary = "numeric", - tasks = "list" -) - -# Create objects implementing the interfaces -john <- implement(Person, - name = "John Doe", - age = 30, - email = "john@example.com" -) + # Prepare class and attributes + class_name <- paste0(interface$interface_name, "Implementation") + classes <- c(class_name, "list") + attrs <- list(interface = interface) -jane <- implement(Employee, - person = john, - job_title = "Manager", - salary = 50000, - tasks = list("Task 1", "Task 2") -) + # Only add validation if required + if (validate_on_access) { + classes <- c("validated_list", classes) + attrs$validate_on_access <- TRUE + } -# Example with custom validation function -positiveNumber <- function(x) { - return(is.numeric(x) && x > 0) + # Return the object as a simple list with appropriate class and attributes + return(structure( + obj, + class = classes, + interface = interface, + validate_on_access = if(validate_on_access) TRUE else NULL + )) } - -Account <- interface("Account", - id = "character", - balance = positiveNumber -) - -my_account <- implement(Account, - id = "ACC123", - balance = 1000 -) - -# Accessing properties -print(john@name) # Should print "John Doe" -print(jane@person@name) # Should print "John Doe" -print(my_account@balance) # Should print 1000 - -# This would raise an error with type mismatches -try(implement(Person, - name = 123, # Should be character - age = "thirty", # Should be numeric - email = TRUE # Should be character -)) \ No newline at end of file From 19a16af9f9c30956a10580819fefadce8275b7e1 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:08:38 -0500 Subject: [PATCH 13/32] Basic package functions. --- R/helpers.R | 42 ++++++++++++++++++++++++++++++++++++++++++ R/implement.R | 45 +++++++++++++++++++++++++++++++++++++++++++++ R/interface.R | 25 +++++++++++++++++++++++++ R/print_methods.R | 45 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 157 insertions(+) create mode 100644 R/helpers.R create mode 100644 R/implement.R create mode 100644 R/interface.R create mode 100644 R/print_methods.R diff --git a/R/helpers.R b/R/helpers.R new file mode 100644 index 0000000..eb9f942 --- /dev/null +++ b/R/helpers.R @@ -0,0 +1,42 @@ +# Helper function to check if a value matches a type specification +check_type <- function(value, type_spec) { + if (identical(type_spec, "ANY")) { + return(TRUE) + } else if (inherits(type_spec, "Interface")) { + return(check_interface(value, type_spec)) + } else if (is.character(type_spec)) { + return(inherits(value, type_spec)) + } else if (is.function(type_spec)) { + return(type_spec(value)) + } else { + stop("Unsupported type specification") + } +} + +# Helper function to check if a value implements an interface +check_interface <- function(value, interface) { + if (!is.list(value)) { + return(FALSE) + } + all(names(interface$properties) %in% names(value)) && + all(mapply(check_type, value[names(interface$properties)], interface$properties)) +} + +# Validation function +validate_object <- function(obj, interface) { + for (prop in names(interface$properties)) { + expected_type <- interface$properties[[prop]] + actual_value <- obj[[prop]] + + if (!check_type(actual_value, expected_type)) { + stop(sprintf("Property '%s' does not match the expected type specification", prop)) + } + } + return(TRUE) +} + +# Custom accessor function +custom_accessor <- function(x, i) { + validate_object(x, attr(x, "interface")) + x[[i]] +} \ No newline at end of file diff --git a/R/implement.R b/R/implement.R new file mode 100644 index 0000000..df215d9 --- /dev/null +++ b/R/implement.R @@ -0,0 +1,45 @@ +#' Implement an Interface +#' +#' @param interface An Interface object +#' @param ... Properties to implement the interface +#' @param validate_on_access Logical, whether to validate on access +#' +#' @return An object implementing the interface +#' @export +implement <- function(interface, ..., validate_on_access = NULL) { + obj <- list(...) + + # Check if all required properties are present + missing_props <- setdiff(names(interface$properties), names(obj)) + if (length(missing_props) > 0) { + stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) + } + + # Initial validation + validate_object(obj, interface) + + # Determine validate_on_access value + if (is.null(validate_on_access)) { + validate_on_access <- interface$validate_on_access + } + + # Prepare class and attributes + class_name <- paste0(interface$interface_name, "Implementation") + classes <- c(class_name, "InterfaceImplementation", "list") + + # Only add validated_list if required + if (validate_on_access) { + classes <- c("validated_list", classes) + } + + # Return the object as a simple list with appropriate class and attributes + structure( + obj, + class = classes, + interface = interface, + validate_on_access = if(validate_on_access) TRUE else NULL + ) +} + +#' @export +`$.validated_list` <- custom_accessor \ No newline at end of file diff --git a/R/interface.R b/R/interface.R new file mode 100644 index 0000000..5d2cb6c --- /dev/null +++ b/R/interface.R @@ -0,0 +1,25 @@ +#' Create an Interface +#' +#' @param interface_name A character string naming the interface +#' @param ... Property definitions for the interface +#' @param validate_on_access Logical, whether to validate on access by default +#' +#' @return An Interface object +#' @export +interface <- function(interface_name, ..., validate_on_access = FALSE) { + properties <- list(...) + structure(list( + interface_name = interface_name, + properties = properties, + validate_on_access = validate_on_access + ), class = "Interface") +} + +# Internal function, no need to export +Interface <- function(interface_name, properties, validate_on_access = FALSE) { + structure(list( + interface_name = interface_name, + properties = properties, + validate_on_access = validate_on_access + ), class = "Interface") +} \ No newline at end of file diff --git a/R/print_methods.R b/R/print_methods.R new file mode 100644 index 0000000..bd16af1 --- /dev/null +++ b/R/print_methods.R @@ -0,0 +1,45 @@ +#' @export +print.InterfaceImplementation <- function(x, ...) { + interface <- attr(x, "interface") + cat("Object implementing", interface$interface_name, "interface:\n") + for (prop in names(x)) { + cat(sprintf(" %s: ", prop)) + if (is.atomic(x[[prop]]) && length(x[[prop]]) == 1) { + cat(x[[prop]], "\n") + } else if (inherits(x[[prop]], "InterfaceImplementation")) { + cat("<", class(x[[prop]])[1], ">\n", sep = "") + } else { + cat("<", class(x[[prop]])[1], ">\n", sep = "") + } + } + cat("Validation on access:", + if(isTRUE(attr(x, "validate_on_access"))) "Enabled" else "Disabled", + "\n") + invisible(x) +} + +#' @export +print.Interface <- function(x, ...) { + cat("Interface:", x$interface_name, "\n") + cat("Properties:\n") + for (prop in names(x$properties)) { + prop_type <- x$properties[[prop]] + if (inherits(prop_type, "Interface")) { + cat(sprintf(" %s: \n", prop, prop_type$interface_name)) + } else if (is.function(prop_type)) { + cat(sprintf(" %s: \n", prop)) + } else { + cat(sprintf(" %s: %s\n", prop, prop_type)) + } + } + cat("Default validation on access:", if(x$validate_on_access) "Enabled" else "Disabled", "\n") + invisible(x) +} + +#' @export +summary.Interface <- function(object, ...) { + cat("Interface:", object$interface_name, "\n") + cat("Number of properties:", length(object$properties), "\n") + cat("Default validation on access:", if(object$validate_on_access) "Enabled" else "Disabled", "\n") + invisible(object) +} \ No newline at end of file From 6727d52defd4f1530fced54197e98c7f958beeeb Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:08:52 -0500 Subject: [PATCH 14/32] Moved to dev folder. --- dev/dev.R | 16 ++++++++++++++++ {research => dev/research}/interface-R6.R | 0 {research => dev/research}/interface-custom.R | 0 {research => dev/research}/interface-s4.R | 0 {research => dev/research}/temp.R | 0 5 files changed, 16 insertions(+) create mode 100644 dev/dev.R rename {research => dev/research}/interface-R6.R (100%) rename {research => dev/research}/interface-custom.R (100%) rename {research => dev/research}/interface-s4.R (100%) rename {research => dev/research}/temp.R (100%) diff --git a/dev/dev.R b/dev/dev.R new file mode 100644 index 0000000..066bd87 --- /dev/null +++ b/dev/dev.R @@ -0,0 +1,16 @@ +library('interface') + +Person <- interface("Person", + name = "character", + age = "numeric", + email = "character", + validate_on_access = TRUE +) + +john <- implement(Person, + name = "John Doe", + age = 30, + email = "john@example.com" +) + +print(john) \ No newline at end of file diff --git a/research/interface-R6.R b/dev/research/interface-R6.R similarity index 100% rename from research/interface-R6.R rename to dev/research/interface-R6.R diff --git a/research/interface-custom.R b/dev/research/interface-custom.R similarity index 100% rename from research/interface-custom.R rename to dev/research/interface-custom.R diff --git a/research/interface-s4.R b/dev/research/interface-s4.R similarity index 100% rename from research/interface-s4.R rename to dev/research/interface-s4.R diff --git a/research/temp.R b/dev/research/temp.R similarity index 100% rename from research/temp.R rename to dev/research/temp.R From 15185a24ce613648e31bc86a9c5fea0f97bc1437 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:09:05 -0500 Subject: [PATCH 15/32] Ignore dev folders. --- .Rbuildignore | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.Rbuildignore b/.Rbuildignore index d821302..8f87493 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -2,3 +2,7 @@ ^renv\.lock$ ^.*\.Rproj$ ^\.Rproj\.user$ + +research/ +dev/ +dev-docs/ \ No newline at end of file From bd131109c144d05a619c34de5560d4daf026c8b6 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:09:19 -0500 Subject: [PATCH 16/32] Docs. --- man/implement.Rd | 21 +++++++++++++++++++++ man/interface.Rd | 21 +++++++++++++++++++++ 2 files changed, 42 insertions(+) create mode 100644 man/implement.Rd create mode 100644 man/interface.Rd diff --git a/man/implement.Rd b/man/implement.Rd new file mode 100644 index 0000000..cb95c71 --- /dev/null +++ b/man/implement.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/implement.R +\name{implement} +\alias{implement} +\title{Implement an Interface} +\usage{ +implement(interface, ..., validate_on_access = NULL) +} +\arguments{ +\item{interface}{An Interface object} + +\item{...}{Properties to implement the interface} + +\item{validate_on_access}{Logical, whether to validate on access} +} +\value{ +An object implementing the interface +} +\description{ +Implement an Interface +} diff --git a/man/interface.Rd b/man/interface.Rd new file mode 100644 index 0000000..84d5e70 --- /dev/null +++ b/man/interface.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/interface.R +\name{interface} +\alias{interface} +\title{Create an Interface} +\usage{ +interface(interface_name, ..., validate_on_access = FALSE) +} +\arguments{ +\item{interface_name}{A character string naming the interface} + +\item{...}{Property definitions for the interface} + +\item{validate_on_access}{Logical, whether to validate on access by default} +} +\value{ +An Interface object +} +\description{ +Create an Interface +} From 6ed21e0becb3a8fd47a8417dc4b00bcf4f60caa1 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:09:35 -0500 Subject: [PATCH 17/32] Readme. --- README.md | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 93 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index a77b254..01d9b77 100644 --- a/README.md +++ b/README.md @@ -1 +1,93 @@ -# interface \ No newline at end of file +# interface + +`interface` provides a system for defining and implementing `interfaces` in R, with optional runtime type checking. + +## Installation + +```r +remotes::install_github("dereckmezquita/interface") +``` + +## Example + +This is a basic example which shows you how to solve a common problem: + +```r +box::use(interface[ interface, implement ]) + +# Define an interface +Person <- interface("Person", + name = "character", + age = "numeric", + email = "character" +) + +# Implement the interface +john <- implement(Person, + name = "John Doe", + age = 30, + email = "john@example.com" +) + +# Access properties +# data is type-checked at runtime when accessing properties +print(john$name) # "John Doe" +print(john$age) # 30 + +# This will raise an error due to type mismatch +try(john$age <- "thirty") + +# you can turn off type checking +Dog <- interface("Dog", + name = "character", + age = "numeric", + breed = "character", + validate_on_access = FALSE +) + +# Implement the interface +fido <- implement(Dog, + name = "Fido", + age = 5, + breed = "Golden Retriever" +) + +# data is not type checked; reduces overhead +fido$age <- "five" # no error +``` + +You can use more complex types for properties, such as `list`, `data.frame`, or even other interfaces you have defined yourself. + +```r +Address <- interface("Address", + street = "character", + city = "character", + state = "character", + zip = "numeric" +) + +# Define an interface +Person <- interface("Person", + name = "character", + age = "numeric", + email = "character", + address = Address +) + +# Implement the interface +john <- implement(Person, + name = "John Doe", + age = 30, + email = "example@example.com", + address = implement(Address, + street = "123 Main St", + city = "Anytown", + state = "NY", + zip = 12345 + ) +) +``` + +## License + +This project is licensed under the MIT License - see the [LICENSE.md](LICENSE.md) file for details \ No newline at end of file From 92d470dadfc70b50b980912c68c1e53db403e776 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:09:53 -0500 Subject: [PATCH 18/32] Namespace after build. --- NAMESPACE | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index d75f824..70079ec 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1 +1,8 @@ -exportPattern("^[[:alpha:]]+") +# Generated by roxygen2: do not edit by hand + +S3method("$",validated_list) +S3method(print,Interface) +S3method(print,InterfaceImplementation) +S3method(summary,Interface) +export(implement) +export(interface) From e15b32c9f4f09570e0c7004c0eb37b1df9ed8f33 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:10:03 -0500 Subject: [PATCH 19/32] Project files. --- DESCRIPTION | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b6939d7..7fe94e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,10 +1,16 @@ Package: interface Type: Package -Title: Data validation and typing in R +Title: Interfaces for data validation and typing in R Version: 0.1.0 -Author: Dereck Mezquita +Authors@R: + person(given = "Dereck", + family = "Mezquita", + role = c("aut", "cre"), + email = "dereck@mezquita.io", + comment = c(ORCID = "0000-0002-9307-6762")) Maintainer: Dereck Mezquita -Description: Easy to use TypeScript-like data validation and typing for R +Description: An easy to use TypeScript-like system for defining and implementing interfaces in R, with optional runtime type checking. License: MIT + file LICENSE Encoding: UTF-8 LazyData: true +RoxygenNote: 7.3.2 From 722508e812e97b6c024901b5106e87eb25fd44c3 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:11:57 -0500 Subject: [PATCH 20/32] PR template. --- .github/pull_request_template.md | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 .github/pull_request_template.md diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md new file mode 100644 index 0000000..54a338d --- /dev/null +++ b/.github/pull_request_template.md @@ -0,0 +1,7 @@ +# jira ticket + +https://dereckmezquita.atlassian.net/browse/ + +# todo list + +- [ ] Version bump From 69dd9e0c8cd7cb6679e1c401a9d4875648a23e2a Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:36:03 -0500 Subject: [PATCH 21/32] Workflow. --- .github/workflows/R-CMD-check.yaml | 84 ++++++++++++++++++++++++++++++ 1 file changed, 84 insertions(+) create mode 100644 .github/workflows/R-CMD-check.yaml diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..e7bad16 --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,84 @@ +# For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. +# https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions +on: + push: + branches: + - main + - master + pull_request: + branches: + - main + - master + +name: R-CMD-check + +jobs: + R-CMD-check: + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + + strategy: + fail-fast: false + matrix: + config: + - {os: windows-latest, r: 'release'} + - {os: macOS-latest, r: 'release'} + - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + + env: + R_REMOTES_NO_ERRORS_FROM_WARNINGS: true + RSPM: ${{ matrix.config.rspm }} + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v2 + + - uses: r-lib/actions/setup-r@v1 + with: + r-version: ${{ matrix.config.r }} + + - uses: r-lib/actions/setup-pandoc@v1 + + - name: Query dependencies + run: | + install.packages('remotes') + saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) + writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") + shell: Rscript {0} + + - name: Cache R packages + if: runner.os != 'Windows' + uses: actions/cache@v2 + with: + path: ${{ env.R_LIBS_USER }} + key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- + + - name: Install system dependencies + if: runner.os == 'Linux' + run: | + while read -r cmd + do + eval sudo $cmd + done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') + + - name: Install dependencies + run: | + remotes::install_deps(dependencies = TRUE) + remotes::install_cran("rcmdcheck") + shell: Rscript {0} + + - name: Check + env: + _R_CHECK_CRAN_INCOMING_REMOTE_: false + run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") + shell: Rscript {0} + + - name: Upload check results + if: failure() + uses: actions/upload-artifact@main + with: + name: ${{ runner.os }}-r${{ matrix.config.r }}-results + path: check From 692764a9fbb33e1a7170ac17f1313d4e9158d9ea Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:37:22 -0500 Subject: [PATCH 22/32] TODO doc. --- dev/TODO.md | 167 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 167 insertions(+) create mode 100644 dev/TODO.md diff --git a/dev/TODO.md b/dev/TODO.md new file mode 100644 index 0000000..22341e4 --- /dev/null +++ b/dev/TODO.md @@ -0,0 +1,167 @@ +# Developer Roadmap for `interface` Package + +This document outlines planned features and improvements for the `interface` package. It's intended for developers who want to contribute to the package or understand its future direction. + +## 1. Implement Atomic Types + +### Description + +Create a new way to define atomic types, similar to TypeScript's type aliases. This will allow users to define types that return single values instead of lists. + +### Implementation Ideas + +- Create a new function, say `type()`, that defines atomic types. +- Modify the `check_type()` function to handle these new atomic types. +- Update the `implement()` function to return atomic values when appropriate. + +### Example Usage + +```r +# Define an atomic type +Age <- type("Age", function(x) is.numeric(x) && x >= 0 && x <= 120) + +# Use the atomic type +john_age <- implement(Age, 30) +print(john_age) # Should print 30, not a list + +# This should raise an error +try(implement(Age, 150)) +``` + +### Integration with Existing Codebase + +- Add a new file `R/type.R` to contain the `type()` function and related helpers. +- Modify `R/implement.R` to handle atomic types differently from interfaces. +- Update `R/helpers.R` to include type checking for atomic types. + +## 2. Extend Interfaces and Existing R Types + +### Description + +Allow interfaces to extend other interfaces or existing R types, similar to inheritance in object-oriented programming. + +### Implementation Ideas + +- Modify the `interface()` function to accept a `extends` parameter. +- Update the `check_interface()` function to check properties from extended interfaces or types. +- Implement a mechanism to resolve property conflicts in case of multiple extensions. + +### Example Usage + +```r +# Extend an existing interface +Person <- interface("Person", + name = "character", + age = "numeric" +) + +Employee <- interface("Employee", + extends = Person, + job_title = "character", + salary = "numeric" +) + +# Extend an existing R type +EnhancedDataFrame <- interface("EnhancedDataFrame", + extends = "data.frame", + metadata = "list" +) + +# Usage +john <- implement(Employee, + name = "John Doe", + age = 30, + job_title = "Developer", + salary = 75000 +) + +my_df <- implement(EnhancedDataFrame, + data.frame(x = 1:3, y = c("a", "b", "c")), + metadata = list(created_at = Sys.time()) +) +``` + +### Integration with Existing Codebase + +- Modify `R/interface.R` to handle the `extends` parameter. +- Update `R/helpers.R` to include extended property checking in `check_interface()`. +- Add new test cases in `tests/testthat/test-interface.R` for extension functionality. + +## 3. Improve Type Inference + +### Description + +Enhance the package's ability to infer types, especially for complex R objects like S3 and S4 classes. + +### Implementation Ideas + +- Develop a more sophisticated type inference system that can handle S3 and S4 classes. +- Implement a caching mechanism for inferred types to improve performance. + +### Example Usage + +```r +# Improved type inference for S3 classes +Date <- interface("Date", value = "Date") + +today <- implement(Date, Sys.Date()) +print(today$value) # Should print today's date + +# Automatic type inference +inferred_interface <- interface_from(my_complex_object) +``` + +### Integration with Existing Codebase + +- Add a new file `R/type_inference.R` for type inference logic. +- Modify `R/helpers.R` to use the new type inference system in `check_type()`. + +## 4. Add Method Signatures to Interfaces + +### Description + +Allow interfaces to specify method signatures, not just properties. + +### Implementation Ideas + +- Extend the `interface()` function to accept method signatures. +- Implement a mechanism to check if an object implements the required methods. + +### Example Usage + +```r +Drawable <- interface("Drawable", + methods = list( + draw = function() NULL + ) +) + +Circle <- interface("Circle", + extends = Drawable, + radius = "numeric", + methods = list( + area = function() NULL + ) +) + +my_circle <- implement(Circle, + radius = 5, + draw = function() cat("Drawing a circle\n"), + area = function() pi * self$radius^2 +) + +my_circle$draw() +print(my_circle$area()) +``` + +### Integration with Existing Codebase + +- Modify `R/interface.R` to handle method signatures. +- Update `R/implement.R` to check and implement methods. +- Add new test cases in `tests/testthat/test-interface.R` for method functionality. + +## Conclusion + +These proposed features will significantly enhance the capabilities of the `interface` package, bringing it closer to the type systems found in languages like TypeScript. Each feature will require careful implementation and thorough testing to ensure it integrates well with the existing functionality. + +Remember to update documentation, including the README and vignettes, as new features are implemented. Also, consider the performance implications of each new feature, especially for large-scale use cases. From 3f03a059654c29330fceb39a495287237ed406ca Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:37:38 -0500 Subject: [PATCH 23/32] Wordlist. --- inst/WORDLIST | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 inst/WORDLIST diff --git a/inst/WORDLIST b/inst/WORDLIST new file mode 100644 index 0000000..7e6fa9a --- /dev/null +++ b/inst/WORDLIST @@ -0,0 +1,5 @@ +Codebase +README +Roadmap +TypeScript +TypeScript's From 742121a9d30f5f50c5444d76b39194c5c7af3f39 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:38:00 -0500 Subject: [PATCH 24/32] Ignore workflows. --- .Rbuildignore | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 8f87493..e5c6a9b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,8 +1,8 @@ -^renv$ -^renv\.lock$ ^.*\.Rproj$ ^\.Rproj\.user$ - -research/ +^\.pre-commit-config\.yaml$ +^renv$ +^renv\.lock$ +dev-docs/ dev/ -dev-docs/ \ No newline at end of file +research/ From 5ccc6fb9f442fdd49092943e9dfc5bc616b25f0c Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:38:45 -0500 Subject: [PATCH 25/32] Wordlist. --- README.md | 5 ++++- inst/WORDLIST | 1 + 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 01d9b77..143049a 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,8 @@ # interface +[![R-CMD-check](https://github.com/derecksprojects/interface/workflows/R-CMD-check/badge.svg)](https://github.com/derecksprojects/interface/actions) + + `interface` provides a system for defining and implementing `interfaces` in R, with optional runtime type checking. ## Installation @@ -90,4 +93,4 @@ john <- implement(Person, ## License -This project is licensed under the MIT License - see the [LICENSE.md](LICENSE.md) file for details \ No newline at end of file +This project is licensed under the MIT License - see the [LICENSE.md](LICENSE.md) file for details diff --git a/inst/WORDLIST b/inst/WORDLIST index 7e6fa9a..6091a5a 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,3 +1,4 @@ +CMD Codebase README Roadmap From cc18d39a8874559f295a14c5518a72cd583004a9 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:39:29 -0500 Subject: [PATCH 26/32] Deps. --- renv.lock | 613 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 613 insertions(+) diff --git a/renv.lock b/renv.lock index 9ba7f80..2b12463 100644 --- a/renv.lock +++ b/renv.lock @@ -9,6 +9,430 @@ ] }, "Packages": { + "R6": { + "Package": "R6", + "Version": "2.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "543776ae6848fde2f48ff3816d0628bc" + }, + "brio": { + "Package": "brio", + "Version": "1.1.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "c1ee497a6d999947c2c224ae46799b1a" + }, + "bslib": { + "Package": "bslib", + "Version": "0.7.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "cachem", + "fastmap", + "grDevices", + "htmltools", + "jquerylib", + "jsonlite", + "lifecycle", + "memoise", + "mime", + "rlang", + "sass" + ], + "Hash": "8644cc53f43828f19133548195d7e59e" + }, + "cachem": { + "Package": "cachem", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "fastmap", + "rlang" + ], + "Hash": "cd9a672193789068eb5a2aad65a0dedf" + }, + "callr": { + "Package": "callr", + "Version": "3.7.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "processx", + "utils" + ], + "Hash": "d7e13f49c19103ece9e58ad2d83a7354" + }, + "cli": { + "Package": "cli", + "Version": "3.6.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "b21916dd77a27642b447374a5d30ecf3" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "e8a1e41acf02548751f45c718d55aa6a" + }, + "desc": { + "Package": "desc", + "Version": "1.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "utils" + ], + "Hash": "99b79fcbd6c4d1ce087f5c5c758b384f" + }, + "diffobj": { + "Package": "diffobj", + "Version": "0.3.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "crayon", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8" + }, + "digest": { + "Package": "digest", + "Version": "0.6.36", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "fd6824ad91ede64151e93af67df6376b" + }, + "evaluate": { + "Package": "evaluate", + "Version": "0.24.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "a1066cbc05caee9a4bf6d90f194ff4da" + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "utils" + ], + "Hash": "962174cf2aeb5b9eea581522286a911f" + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "aa5e1cd11c2d15497494c5292d7ffcc8" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "c2efdd5f0bcd1ea861c2d4e2a883a67d" + }, + "fs": { + "Package": "fs", + "Version": "1.6.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "15aeb8c27f5ea5161f9f6a641fafd93a" + }, + "glue": { + "Package": "glue", + "Version": "1.7.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "e0b3a53876554bd45879e596cdb10a52" + }, + "highr": { + "Package": "highr", + "Version": "0.11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "d65ba49117ca223614f71b60d85b8ab7" + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.8.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "digest", + "fastmap", + "grDevices", + "rlang", + "utils" + ], + "Hash": "81d371a9cc60640e74e4ab6ac46dcedc" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "htmltools" + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "1.8.8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods" + ], + "Hash": "e1b9c55281c5adc4dd113652d9e26768" + }, + "knitr": { + "Package": "knitr", + "Version": "1.47", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "evaluate", + "highr", + "methods", + "tools", + "xfun", + "yaml" + ], + "Hash": "7c99b2d55584b982717fcc0950378612" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "rlang" + ], + "Hash": "b8552d117e1b808b09a832f589b79035" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "7ce2733a9826b3aeb1775d56fd305472" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cachem", + "rlang" + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" + }, + "mime": { + "Package": "mime", + "Version": "0.12", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "tools" + ], + "Hash": "18e9c28c1d3ca1560ce30658b22ce104" + }, + "pillar": { + "Package": "pillar", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "fansi", + "glue", + "lifecycle", + "rlang", + "utf8", + "utils", + "vctrs" + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" + }, + "pkgbuild": { + "Package": "pkgbuild", + "Version": "1.4.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "callr", + "cli", + "desc", + "processx" + ], + "Hash": "a29e8e134a460a01e0ca67a4763c595b" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "pkgload": { + "Package": "pkgload", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "desc", + "fs", + "glue", + "lifecycle", + "methods", + "pkgbuild", + "processx", + "rlang", + "rprojroot", + "utils", + "withr" + ], + "Hash": "2ec30ffbeec83da57655b850cf2d3e0e" + }, + "praise": { + "Package": "praise", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "a555924add98c99d2f411e37e7d25e9f" + }, + "processx": { + "Package": "processx", + "Version": "3.8.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "ps", + "utils" + ], + "Hash": "0c90a7d71988856bad2a2a45dd871bb9" + }, + "ps": { + "Package": "ps", + "Version": "1.7.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "dd2b9319ee0656c8acf45c7f40c59de7" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + }, + "rematch2": { + "Package": "rematch2", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "tibble" + ], + "Hash": "76c9e04c712a05848ae7a23d2f170a40" + }, "renv": { "Package": "renv", "Version": "1.0.7", @@ -18,6 +442,195 @@ "utils" ], "Hash": "397b7b2a265bc5a7a06852524dabae20" + }, + "rlang": { + "Package": "rlang", + "Version": "1.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "3eec01f8b1dee337674b2e34ab1f9bc1" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.27", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "evaluate", + "fontawesome", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "methods", + "tinytex", + "tools", + "utils", + "xfun", + "yaml" + ], + "Hash": "27f9502e1cdbfa195f94e03b0f517484" + }, + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "4c8415e0ec1e29f3f4f6fc108bef0144" + }, + "sass": { + "Package": "sass", + "Version": "0.4.9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ], + "Hash": "d53dbfddf695303ea4ad66f86e99b95d" + }, + "testthat": { + "Package": "testthat", + "Version": "3.2.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "brio", + "callr", + "cli", + "desc", + "digest", + "evaluate", + "jsonlite", + "lifecycle", + "magrittr", + "methods", + "pkgload", + "praise", + "processx", + "ps", + "rlang", + "utils", + "waldo", + "withr" + ], + "Hash": "3f6e7e5e2220856ff865e4834766bf2b" + }, + "tibble": { + "Package": "tibble", + "Version": "3.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "fansi", + "lifecycle", + "magrittr", + "methods", + "pillar", + "pkgconfig", + "rlang", + "utils", + "vctrs" + ], + "Hash": "a84e2cc86d07289b3b6f5069df7a004c" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.51", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "xfun" + ], + "Hash": "d44e2fcd2e4e076f0aac540208559d1d" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "62b65c52671e6665f803ff02954446e9" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.6.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang" + ], + "Hash": "c03fa420630029418f7e6da3667aac4a" + }, + "waldo": { + "Package": "waldo", + "Version": "0.5.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "diffobj", + "fansi", + "glue", + "methods", + "rematch2", + "rlang", + "tibble" + ], + "Hash": "c7d3fd6d29ab077cbac8f0e2751449e6" + }, + "withr": { + "Package": "withr", + "Version": "3.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics" + ], + "Hash": "d31b6c62c10dcf11ec530ca6b0dd5d35" + }, + "xfun": { + "Package": "xfun", + "Version": "0.45", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "stats", + "tools" + ], + "Hash": "ca59c87fe305b16a9141a5874c3a7889" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.8", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "29240487a071f535f5e5d5a323b7afbd" } } } From ec3e2422c0a58a81119b0e88b6ec1a1b783082bd Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 17:39:38 -0500 Subject: [PATCH 27/32] Precommit. --- .pre-commit-config.yaml | 76 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) create mode 100644 .pre-commit-config.yaml diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml new file mode 100644 index 0000000..e8bbabc --- /dev/null +++ b/.pre-commit-config.yaml @@ -0,0 +1,76 @@ +# All available hooks: https://pre-commit.com/hooks.html +# R specific hooks: https://github.com/lorenzwalthert/precommit +repos: +- repo: https://github.com/lorenzwalthert/precommit + rev: v0.4.2 + hooks: + - id: style-files + args: [--style_pkg=styler, --style_fun=tidyverse_style] + - id: roxygenize + # codemeta must be above use-tidy-description when both are used + # - id: codemeta-description-updated + - id: use-tidy-description + - id: spell-check + exclude: > + (?x)^( + .*\.[rR]| + .*\.feather| + .*\.jpeg| + .*\.pdf| + .*\.png| + .*\.py| + .*\.RData| + .*\.rds| + .*\.Rds| + .*\.Rproj| + .*\.sh| + (.*/|)\.gitignore| + (.*/|)\.gitlab-ci\.yml| + (.*/|)\.lintr| + (.*/|)\.pre-commit-.*| + (.*/|)\.Rbuildignore| + (.*/|)\.Renviron| + (.*/|)\.Rprofile| + (.*/|)\.travis\.yml| + (.*/|)appveyor\.yml| + (.*/|)NAMESPACE| + (.*/|)renv/settings\.dcf| + (.*/|)renv\.lock| + (.*/|)WORDLIST| + \.github/workflows/.*| + data/.*| + )$ + - id: lintr + - id: readme-rmd-rendered + - id: parsable-R + - id: no-browser-statement + - id: no-print-statement + - id: no-debug-statement + - id: deps-in-desc + - id: pkgdown +- repo: https://github.com/pre-commit/pre-commit-hooks + rev: v4.6.0 + hooks: + - id: check-added-large-files + args: ['--maxkb=200'] + - id: file-contents-sorter + files: '^\.Rbuildignore$' + - id: end-of-file-fixer + exclude: '\.Rd' +- repo: https://github.com/pre-commit-ci/pre-commit-ci-config + rev: v1.6.1 + hooks: + # Only required when https://pre-commit.ci is used for config validation + - id: check-pre-commit-ci-config +- repo: local + hooks: + - id: forbid-to-commit + name: Don't commit common R artifacts + entry: Cannot commit .Rhistory, .RData, .Rds or .rds. + language: fail + files: '\.(Rhistory|RData|Rds|rds)$' + # `exclude: ` to allow committing specific files + +ci: + autoupdate_schedule: monthly + skip: [pkgdown] From 0a318db2b535389921c22166805cf6267f5d467c Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Mon, 1 Jul 2024 18:39:06 -0500 Subject: [PATCH 28/32] Trying to get styler to work --- .Rprofile | 3 + .lintr | 6 + .pre-commit-config.yaml | 6 +- DESCRIPTION | 6 + NEWS.md | 7 ++ R/helpers.R | 6 +- R/implement.R | 10 +- R/interface.R | 2 +- R/print_methods.R | 14 ++- dev/dev.R | 4 +- dev/research/interface-R6.R | 28 ++--- dev/research/interface-custom.R | 36 +++--- dev/research/interface-s4.R | 30 ++--- dev/research/temp.R | 6 +- inst/WORDLIST | 16 +++ renv.lock | 88 +++++++++++++ tests/testthat.R | 4 + tests/testthat/test-implement.R | 56 +++++++++ tests/testthat/test-interface.R | 25 ++++ vignettes/introduction.Rmd | 213 ++++++++++++++++++++++++++++++++ 20 files changed, 499 insertions(+), 67 deletions(-) create mode 100644 .lintr create mode 100644 NEWS.md create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-implement.R create mode 100644 tests/testthat/test-interface.R create mode 100644 vignettes/introduction.Rmd diff --git a/.Rprofile b/.Rprofile index 81b960f..1104e61 100644 --- a/.Rprofile +++ b/.Rprofile @@ -1 +1,4 @@ source("renv/activate.R") +options( + styler.addins_style_transformer = "styler::tidyverse_style(indent_by = 4L)" +) diff --git a/.lintr b/.lintr new file mode 100644 index 0000000..bb2863c --- /dev/null +++ b/.lintr @@ -0,0 +1,6 @@ +linters: linters_with_defaults( + object_name_linter = NULL, + indentation_linter = indentation_linter(indent = 4), + line_length_linter = line_length_linter(120), + commented_code_linter = NULL +) diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index e8bbabc..1442e62 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -5,7 +5,7 @@ repos: rev: v0.4.2 hooks: - id: style-files - args: [--style_pkg=styler, --style_fun=tidyverse_style] + args: [--style_pkg=styler, --style_fun=tidyverse_style, --indent_by=4] - id: roxygenize # codemeta must be above use-tidy-description when both are used # - id: codemeta-description-updated @@ -41,12 +41,16 @@ repos: data/.*| )$ - id: lintr + args: [--warn_only] + exclude: dev/.*| - id: readme-rmd-rendered - id: parsable-R - id: no-browser-statement - id: no-print-statement + exclude: dev/.*| - id: no-debug-statement - id: deps-in-desc + args: [--allow_private_imports] - id: pkgdown - repo: https://github.com/pre-commit/pre-commit-hooks rev: v4.6.0 diff --git a/DESCRIPTION b/DESCRIPTION index 7fe94e7..625cb59 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,4 +13,10 @@ Description: An easy to use TypeScript-like system for defining and implementing License: MIT + file LICENSE Encoding: UTF-8 LazyData: true +VignetteBuilder: knitr RoxygenNote: 7.3.2 +Suggests: + testthat (>= 3.0.0), + knitr, + rmarkdown, + box diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..4ba9735 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,7 @@ +# interface 0.1.0 + +- Initial CRAN submission. +- Implemented core functionality for defining and implementing interfaces. +- Added support for optional runtime type checking. +- Included support for nested interfaces and custom validation functions. +- Created comprehensive documentation and vignettes. diff --git a/R/helpers.R b/R/helpers.R index eb9f942..c1e875a 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -19,7 +19,7 @@ check_interface <- function(value, interface) { return(FALSE) } all(names(interface$properties) %in% names(value)) && - all(mapply(check_type, value[names(interface$properties)], interface$properties)) + all(mapply(check_type, value[names(interface$properties)], interface$properties)) } # Validation function @@ -27,7 +27,7 @@ validate_object <- function(obj, interface) { for (prop in names(interface$properties)) { expected_type <- interface$properties[[prop]] actual_value <- obj[[prop]] - + if (!check_type(actual_value, expected_type)) { stop(sprintf("Property '%s' does not match the expected type specification", prop)) } @@ -39,4 +39,4 @@ validate_object <- function(obj, interface) { custom_accessor <- function(x, i) { validate_object(x, attr(x, "interface")) x[[i]] -} \ No newline at end of file +} diff --git a/R/implement.R b/R/implement.R index df215d9..f0a8368 100644 --- a/R/implement.R +++ b/R/implement.R @@ -14,7 +14,7 @@ implement <- function(interface, ..., validate_on_access = NULL) { if (length(missing_props) > 0) { stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) } - + # Initial validation validate_object(obj, interface) @@ -26,7 +26,7 @@ implement <- function(interface, ..., validate_on_access = NULL) { # Prepare class and attributes class_name <- paste0(interface$interface_name, "Implementation") classes <- c(class_name, "InterfaceImplementation", "list") - + # Only add validated_list if required if (validate_on_access) { classes <- c("validated_list", classes) @@ -35,11 +35,11 @@ implement <- function(interface, ..., validate_on_access = NULL) { # Return the object as a simple list with appropriate class and attributes structure( obj, - class = classes, + class = classes, interface = interface, - validate_on_access = if(validate_on_access) TRUE else NULL + validate_on_access = if (validate_on_access) TRUE else NULL ) } #' @export -`$.validated_list` <- custom_accessor \ No newline at end of file +`$.validated_list` <- custom_accessor diff --git a/R/interface.R b/R/interface.R index 5d2cb6c..6a36325 100644 --- a/R/interface.R +++ b/R/interface.R @@ -22,4 +22,4 @@ Interface <- function(interface_name, properties, validate_on_access = FALSE) { properties = properties, validate_on_access = validate_on_access ), class = "Interface") -} \ No newline at end of file +} diff --git a/R/print_methods.R b/R/print_methods.R index bd16af1..2374f4b 100644 --- a/R/print_methods.R +++ b/R/print_methods.R @@ -12,9 +12,11 @@ print.InterfaceImplementation <- function(x, ...) { cat("<", class(x[[prop]])[1], ">\n", sep = "") } } - cat("Validation on access:", - if(isTRUE(attr(x, "validate_on_access"))) "Enabled" else "Disabled", - "\n") + cat( + "Validation on access:", + if (isTRUE(attr(x, "validate_on_access"))) "Enabled" else "Disabled", + "\n" + ) invisible(x) } @@ -32,7 +34,7 @@ print.Interface <- function(x, ...) { cat(sprintf(" %s: %s\n", prop, prop_type)) } } - cat("Default validation on access:", if(x$validate_on_access) "Enabled" else "Disabled", "\n") + cat("Default validation on access:", if (x$validate_on_access) "Enabled" else "Disabled", "\n") invisible(x) } @@ -40,6 +42,6 @@ print.Interface <- function(x, ...) { summary.Interface <- function(object, ...) { cat("Interface:", object$interface_name, "\n") cat("Number of properties:", length(object$properties), "\n") - cat("Default validation on access:", if(object$validate_on_access) "Enabled" else "Disabled", "\n") + cat("Default validation on access:", if (object$validate_on_access) "Enabled" else "Disabled", "\n") invisible(object) -} \ No newline at end of file +} diff --git a/dev/dev.R b/dev/dev.R index 066bd87..cfc75d8 100644 --- a/dev/dev.R +++ b/dev/dev.R @@ -1,4 +1,4 @@ -library('interface') +library("interface") Person <- interface("Person", name = "character", @@ -13,4 +13,4 @@ john <- implement(Person, email = "john@example.com" ) -print(john) \ No newline at end of file +print(john) diff --git a/dev/research/interface-R6.R b/dev/research/interface-R6.R index 3a5c710..dabb045 100644 --- a/dev/research/interface-R6.R +++ b/dev/research/interface-R6.R @@ -27,7 +27,7 @@ check_type <- function(value, type_spec) { } return( all(names(type_spec$properties) %in% names(value)) && - all(mapply(check_type, value[names(type_spec$properties)], type_spec$properties)) + all(mapply(check_type, value[names(type_spec$properties)], type_spec$properties)) ) } else if (is.character(type_spec)) { return(inherits(value, type_spec)) @@ -47,13 +47,13 @@ implement <- function(interface, ...) { if (length(missing_props) > 0) { stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) } - + # Check types of properties type_errors <- character() for (prop in names(interface$properties)) { expected_type <- interface$properties[[prop]] actual_value <- obj[[prop]] - + if (!check_type(actual_value, expected_type)) { type_errors <- c( type_errors, @@ -98,7 +98,7 @@ Employee <- interface("Employee", job_title = "character", salary = "numeric", tasks = "list", - additional_info = "data.table" # This can be any type + additional_info = "data.table" # This can be any type ) # Create objects implementing the interfaces @@ -124,7 +124,7 @@ positiveNumber <- function(x) { Account <- interface("Account", id = "character", balance = positiveNumber, - metadata = "ANY" # This can be any type + metadata = "ANY" # This can be any type ) my_account <- implement(Account, @@ -134,15 +134,15 @@ my_account <- implement(Account, ) # Accessing properties -print(john$name) # Should print "John Doe" -print(jane$person$name) # Should print "John Doe" -print(jane$additional_info) # Should print the data frame -print(my_account$balance) # Should print 1000 -print(my_account$metadata) # Should print the list +print(john$name) # Should print "John Doe" +print(jane$person$name) # Should print "John Doe" +print(jane$additional_info) # Should print the data frame +print(my_account$balance) # Should print 1000 +print(my_account$metadata) # Should print the list # This would raise an error with type mismatches try(implement(Person, - name = 123, # Should be character - age = "thirty", # Should be numeric - email = TRUE # Should be character -)) \ No newline at end of file + name = 123, # Should be character + age = "thirty", # Should be numeric + email = TRUE # Should be character +)) diff --git a/dev/research/interface-custom.R b/dev/research/interface-custom.R index b7acb12..dca1b93 100644 --- a/dev/research/interface-custom.R +++ b/dev/research/interface-custom.R @@ -35,7 +35,7 @@ check_interface <- function(value, interface) { } return( all(names(interface$properties) %in% names(value)) && - all(mapply(check_type, value[names(interface$properties)], interface$properties)) + all(mapply(check_type, value[names(interface$properties)], interface$properties)) ) } @@ -45,7 +45,7 @@ validate_object <- function(obj, interface) { for (prop in names(interface$properties)) { expected_type <- interface$properties[[prop]] actual_value <- obj[[prop]] - + if (!check_type(actual_value, expected_type)) { stop(sprintf("Property '%s' does not match the expected type specification", prop)) } @@ -73,9 +73,11 @@ print.InterfaceImplementation <- function(x, ...) { cat("<", class(x[[prop]])[1], ">\n", sep = "") } } - cat("Validation on access:", - if(isTRUE(attr(x, "validate_on_access"))) "Enabled" else "Disabled", - "\n") + cat( + "Validation on access:", + if (isTRUE(attr(x, "validate_on_access"))) "Enabled" else "Disabled", + "\n" + ) invisible(x) } @@ -88,7 +90,7 @@ implement <- function(interface, ..., validate_on_access = NULL) { if (length(missing_props) > 0) { stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) } - + # Initial validation validate_object(obj, interface) @@ -100,7 +102,7 @@ implement <- function(interface, ..., validate_on_access = NULL) { # Prepare class and attributes class_name <- paste0(interface$interface_name, "Implementation") classes <- c(class_name, "InterfaceImplementation", "list") - + # Only add validated_list if required if (validate_on_access) { classes <- c("validated_list", classes) @@ -109,9 +111,9 @@ implement <- function(interface, ..., validate_on_access = NULL) { # Return the object as a simple list with appropriate class and attributes return(structure( obj, - class = classes, + class = classes, interface = interface, - validate_on_access = if(validate_on_access) TRUE else NULL + validate_on_access = if (validate_on_access) TRUE else NULL )) } @@ -132,7 +134,7 @@ print.Interface <- function(x, ...) { cat(sprintf(" %s: %s\n", prop, prop_type)) } } - cat("Default validation on access:", if(x$validate_on_access) "Enabled" else "Disabled", "\n") + cat("Default validation on access:", if (x$validate_on_access) "Enabled" else "Disabled", "\n") invisible(x) } @@ -140,7 +142,7 @@ print.Interface <- function(x, ...) { summary.Interface <- function(object, ...) { cat("Interface:", object$interface_name, "\n") cat("Number of properties:", length(object$properties), "\n") - cat("Default validation on access:", if(object$validate_on_access) "Enabled" else "Disabled", "\n") + cat("Default validation on access:", if (object$validate_on_access) "Enabled" else "Disabled", "\n") invisible(object) } @@ -150,7 +152,7 @@ Person <- interface("Person", name = "character", age = "numeric", email = "character", - validate_on_access = TRUE # Set default validation for Person + validate_on_access = TRUE # Set default validation for Person ) # Define an interface that uses another interface and includes an "any" type @@ -160,7 +162,7 @@ Employee <- interface("Employee", salary = "numeric", tasks = "list", additional_info = "ANY", - validate_on_access = FALSE # Set default validation for Employee + validate_on_access = FALSE # Set default validation for Employee ) # Create objects implementing the interfaces @@ -182,11 +184,11 @@ jane <- implement(Employee, ) # Accessing properties -print(john$name) # Should print "John Doe" and trigger validation -print(jane$job_title) # Should print "Manager" without validation +print(john$name) # Should print "John Doe" and trigger validation +print(jane$job_title) # Should print "Manager" without validation # Modify the object in a way that violates the interface -john$age <- "thirty" # This should not cause an immediate error +john$age <- "thirty" # This should not cause an immediate error # This will trigger validation and raise an error try(print(john$name)) @@ -201,4 +203,4 @@ no_validate_person <- implement(Person, # This won't trigger validation no_validate_person$age <- "twenty-five" -print(no_validate_person$age) # This will print "twenty-five" without raising an error \ No newline at end of file +print(no_validate_person$age) # This will print "twenty-five" without raising an error diff --git a/dev/research/interface-s4.R b/dev/research/interface-s4.R index 9490c28..ef53973 100644 --- a/dev/research/interface-s4.R +++ b/dev/research/interface-s4.R @@ -24,7 +24,7 @@ check_type <- function(value, type_spec) { } return( all(names(type_spec@properties) %in% slotNames(value)) && - all(mapply(check_type, sapply(names(type_spec@properties), slot, object = value), type_spec@properties)) + all(mapply(check_type, sapply(names(type_spec@properties), slot, object = value), type_spec@properties)) ) } else if (is.character(type_spec)) { # Handle base R types and S3/S4/R6 classes @@ -46,13 +46,13 @@ implement <- function(interface, ...) { if (length(missing_props) > 0) { stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) } - + # Check types of properties type_errors <- character() for (prop in names(interface@properties)) { expected_type <- interface@properties[[prop]] actual_value <- obj[[prop]] - + if (!check_type(actual_value, expected_type)) { type_errors <- c( type_errors, @@ -68,7 +68,7 @@ implement <- function(interface, ...) { # Create an S4 class dynamically class_name <- paste0(interface@interface_name, "Implementation") slot_def <- sapply(interface@properties, function(x) { - return(if(identical(x, "ANY") || is(x, "Interface")) "ANY" else x) + return(if (identical(x, "ANY") || is(x, "Interface")) "ANY" else x) }) if (!isClass(class_name)) { setClass(class_name, slots = slot_def) @@ -92,7 +92,7 @@ Employee <- interface("Employee", job_title = "character", salary = "numeric", tasks = "list", - additional_info = "ANY" # This can be any type + additional_info = "ANY" # This can be any type ) # Create objects implementing the interfaces @@ -118,7 +118,7 @@ positiveNumber <- function(x) { Account <- interface("Account", id = "character", balance = positiveNumber, - metadata = "ANY" # This can be any type + metadata = "ANY" # This can be any type ) my_account <- implement(Account, @@ -128,15 +128,15 @@ my_account <- implement(Account, ) # Accessing properties -print(john@name) # Should print "John Doe" -print(jane@person@name) # Should print "John Doe" -print(jane@additional_info) # Should print the data frame -print(my_account@balance) # Should print 1000 -print(my_account@metadata) # Should print the list +print(john@name) # Should print "John Doe" +print(jane@person@name) # Should print "John Doe" +print(jane@additional_info) # Should print the data frame +print(my_account@balance) # Should print 1000 +print(my_account@metadata) # Should print the list # This would raise an error with type mismatches try(implement(Person, - name = 123, # Should be character - age = "thirty", # Should be numeric - email = TRUE # Should be character -)) \ No newline at end of file + name = 123, # Should be character + age = "thirty", # Should be numeric + email = TRUE # Should be character +)) diff --git a/dev/research/temp.R b/dev/research/temp.R index 960803a..a893488 100644 --- a/dev/research/temp.R +++ b/dev/research/temp.R @@ -6,7 +6,7 @@ implement <- function(interface, ..., validate_on_access = NULL) { if (length(missing_props) > 0) { stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) } - + # Initial validation validate_object(obj, interface) @@ -29,8 +29,8 @@ implement <- function(interface, ..., validate_on_access = NULL) { # Return the object as a simple list with appropriate class and attributes return(structure( obj, - class = classes, + class = classes, interface = interface, - validate_on_access = if(validate_on_access) TRUE else NULL + validate_on_access = if (validate_on_access) TRUE else NULL )) } diff --git a/inst/WORDLIST b/inst/WORDLIST index 6091a5a..cf53023 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,6 +1,22 @@ +aut CMD Codebase +cre +dereck +Dereck +io +knitr +LazyData +mezquita +Mezquita +ORCID README +rmarkdown Roadmap +RoxygenNote +testthat TypeScript TypeScript's +validator +Validators +VignetteBuilder diff --git a/renv.lock b/renv.lock index 2b12463..e463e0e 100644 --- a/renv.lock +++ b/renv.lock @@ -9,6 +9,60 @@ ] }, "Packages": { + "R.cache": { + "Package": "R.cache", + "Version": "0.16.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R.methodsS3", + "R.oo", + "R.utils", + "digest", + "utils" + ], + "Hash": "fe539ca3f8efb7410c3ae2cf5fe6c0f8" + }, + "R.methodsS3": { + "Package": "R.methodsS3", + "Version": "1.8.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "278c286fd6e9e75d0c2e8f731ea445c8" + }, + "R.oo": { + "Package": "R.oo", + "Version": "1.26.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R.methodsS3", + "methods", + "utils" + ], + "Hash": "4fed809e53ddb5407b3da3d0f572e591" + }, + "R.utils": { + "Package": "R.utils", + "Version": "2.12.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R.methodsS3", + "R.oo", + "methods", + "tools", + "utils" + ], + "Hash": "3dc2829b790254bfba21e60965787651" + }, "R6": { "Package": "R6", "Version": "2.5.1", @@ -413,6 +467,21 @@ ], "Hash": "dd2b9319ee0656c8acf45c7f40c59de7" }, + "purrr": { + "Package": "purrr", + "Version": "1.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "rlang", + "vctrs" + ], + "Hash": "1cba04a4e9414bdefc9dcaa99649a8dc" + }, "rappdirs": { "Package": "rappdirs", "Version": "0.3.3", @@ -501,6 +570,25 @@ ], "Hash": "d53dbfddf695303ea4ad66f86e99b95d" }, + "styler": { + "Package": "styler", + "Version": "1.10.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R.cache", + "cli", + "magrittr", + "purrr", + "rlang", + "rprojroot", + "tools", + "vctrs", + "withr" + ], + "Hash": "93a2b1beac2437bdcc4724f8bf867e2c" + }, "testthat": { "Package": "testthat", "Version": "3.2.1.1", diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..5377adf --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(YourPackageName) + +test_check("YourPackageName") diff --git a/tests/testthat/test-implement.R b/tests/testthat/test-implement.R new file mode 100644 index 0000000..195d6eb --- /dev/null +++ b/tests/testthat/test-implement.R @@ -0,0 +1,56 @@ +test_that("implement works with valid input", { + Person <- interface("Person", + name = "character", + age = "numeric", + email = "character" + ) + + john <- implement(Person, + name = "John Doe", + age = 30, + email = "john@example.com" + ) + + expect_s3_class(john, "PersonImplementation") + expect_s3_class(john, "InterfaceImplementation") + expect_equal(john$name, "John Doe") + expect_equal(john$age, 30) + expect_equal(john$email, "john@example.com") +}) + +test_that("implement fails with invalid input", { + Person <- interface("Person", + name = "character", + age = "numeric", + email = "character" + ) + + expect_error(implement(Person, + name = "John Doe", + age = "thirty", + email = "john@example.com" + ), "Property 'age' does not match the expected type specification") + + expect_error(implement(Person, + name = "John Doe", + age = 30 + ), "Missing properties: email") +}) + +test_that("validation on access works", { + Person <- interface("Person", + name = "character", + age = "numeric", + email = "character", + validate_on_access = TRUE + ) + + john <- implement(Person, + name = "John Doe", + age = 30, + email = "john@example.com" + ) + + john$age <- "thirty" + expect_error(john$name, "Property 'age' does not match the expected type specification") +}) diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R new file mode 100644 index 0000000..8a233cb --- /dev/null +++ b/tests/testthat/test-interface.R @@ -0,0 +1,25 @@ +test_that("interface creation works", { + Person <- interface("Person", + name = "character", + age = "numeric", + email = "character", + validate_on_access = TRUE + ) + + expect_s3_class(Person, "Interface") + expect_equal(Person$interface_name, "Person") + expect_equal(Person$properties, list(name = "character", age = "numeric", email = "character")) + expect_true(Person$validate_on_access) +}) + +test_that("interface with custom validator works", { + positive_number <- function(x) is.numeric(x) && x > 0 + + Account <- interface("Account", + id = "character", + balance = positive_number + ) + + expect_s3_class(Account, "Interface") + expect_true(is.function(Account$properties$balance)) +}) diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd new file mode 100644 index 0000000..4ebe76e --- /dev/null +++ b/vignettes/introduction.Rmd @@ -0,0 +1,213 @@ +--- +title: "Introduction to interface" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Getting Started with interface} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +box::use(interface[interface, implement]) +``` + +## Introduction + +The `interface` package provides a system for defining and implementing interfaces in R, with optional runtime type checking. This approach brings some of the benefits of statically-typed languages to R, allowing for more structured and safer code. + +## Why Use Interfaces? + +Interfaces in R can be beneficial for several reasons: + +1. **Code Structure**: They provide a clear contract for what properties and methods an object should have. +2. **Type Safety**: They allow for runtime type checking, catching errors early. +3. **Documentation**: They serve as self-documenting code, clearly stating the expected structure of objects. +4. **Flexibility**: They allow for implementation of multiple interfaces, promoting code reuse. + +## Basic Usage + +### Defining an Interface + +To define an interface, use the `interface()` function: + +```{r} +Person <- interface("Person", + name = "character", + age = "numeric", + email = "character" +) +``` + +This creates an interface named "Person" with three properties: + +1. name (a character) +1. age (a numeric) +1. email (a character) + +### Implementing an Interface + +To create an object that implements an interface, use the `implement()` function: + +```{r} +john <- implement(Person, + name = "John Doe", + age = 30, + email = "john@example.com" +) +``` + +### Accessing Properties + +You can access properties of the implemented object just like a regular list: + +```{r} +print(john$name) +print(john$age) +``` + +### Type Checking + +By default, type checking occurs when you access properties: + +```{r, error=TRUE} +john$age <- "thirty" +``` + +This error is raised because we're trying to assign a character value to a numeric property. + +## Advanced Features + +### Disabling Type Checking + +You can disable type checking to reduce overhead: + +```{r} +Dog <- interface("Dog", + name = "character", + age = "numeric", + breed = "character", + validate_on_access = FALSE +) + +fido <- implement(Dog, + name = "Fido", + age = 5, + breed = "Golden Retriever" +) + +fido$age <- "five" # No error, type checking is disabled +print(fido$age) +``` + +### Nested Interfaces + +You can use interfaces as property types for other interfaces: + +```{r} +Address <- interface("Address", + street = "character", + city = "character", + state = "character", + zip = "numeric" +) + +Employee <- interface("Employee", + name = "character", + age = "numeric", + email = "character", + address = Address +) + +jane <- implement(Employee, + name = "Jane Doe", + age = 28, + email = "jane@company.com", + address = implement(Address, + street = "123 Main St", + city = "Anytown", + state = "CA", + zip = 12345 + ) +) + +print(jane$address$city) +``` + +### Custom Validation Functions + +You can use custom functions for more complex validation: + +```{r} +positive_number <- function(x) is.numeric(x) && x > 0 + +Account <- interface("Account", + id = "character", + balance = positive_number +) + +my_account <- implement(Account, + id = "ACC123", + balance = 1000 +) + +print(my_account$balance) + +# This will raise an error +tryCatch( + implement(Account, id = "ACC124", balance = -500), + error = function(e) print(e$message) +) +``` + +### Using with Other R Types + +The `interface` package supports various R types: + +```{r} +ComplexPerson <- interface("ComplexPerson", + name = "character", + age = "numeric", + hobbies = "list", + scores = "data.frame", + metadata = "ANY" # ANY allows any type +) + +person <- implement(ComplexPerson, + name = "Alice Johnson", + age = 35, + hobbies = list("painting", "cycling"), + scores = data.frame(subject = c("Art", "Physics"), score = c(95, 88)), + metadata = list(last_updated = Sys.time()) +) + +print(person$hobbies) +print(person$scores) +``` + +## Best Practices + +1. **Be Specific**: Define your interfaces as specifically as possible. This helps catch errors early. +2. **Use Custom Validators**: For complex rules, create custom validator functions. +3. **Compose Interfaces**: Use nested interfaces to create more complex structures. +4. **Document Your Interfaces**: Good documentation helps other developers understand how to use your interfaces. + +## Conclusion + +The `interface` package provides a powerful way to bring interface-like structures to R programming. By using interfaces, you can create more robust, self-documenting code that's easier to maintain and extend. + +Remember, while interfaces provide many benefits, they also add a layer of complexity to your code. Use them judiciously where their benefits outweigh the added complexity. + +This vignette provides a comprehensive introduction to your `interface` package. It covers: + +1. The motivation behind using interfaces in R +2. Basic usage of the package +3. Advanced features like disabling type checking, nested interfaces, and custom validation functions +4. Examples of using interfaces with various R types +5. Best practices for using the package From 4ec2c77b36e18265587fd474c2156fe75461177e Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Fri, 5 Jul 2024 23:00:56 -0500 Subject: [PATCH 29/32] Delete workflow for now. --- .github/workflows/R-CMD-check.yaml | 84 ------------------------------ 1 file changed, 84 deletions(-) delete mode 100644 .github/workflows/R-CMD-check.yaml diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml deleted file mode 100644 index e7bad16..0000000 --- a/.github/workflows/R-CMD-check.yaml +++ /dev/null @@ -1,84 +0,0 @@ -# For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. -# https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions -on: - push: - branches: - - main - - master - pull_request: - branches: - - main - - master - -name: R-CMD-check - -jobs: - R-CMD-check: - runs-on: ${{ matrix.config.os }} - - name: ${{ matrix.config.os }} (${{ matrix.config.r }}) - - strategy: - fail-fast: false - matrix: - config: - - {os: windows-latest, r: 'release'} - - {os: macOS-latest, r: 'release'} - - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - - env: - R_REMOTES_NO_ERRORS_FROM_WARNINGS: true - RSPM: ${{ matrix.config.rspm }} - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - - steps: - - uses: actions/checkout@v2 - - - uses: r-lib/actions/setup-r@v1 - with: - r-version: ${{ matrix.config.r }} - - - uses: r-lib/actions/setup-pandoc@v1 - - - name: Query dependencies - run: | - install.packages('remotes') - saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) - writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") - shell: Rscript {0} - - - name: Cache R packages - if: runner.os != 'Windows' - uses: actions/cache@v2 - with: - path: ${{ env.R_LIBS_USER }} - key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- - - - name: Install system dependencies - if: runner.os == 'Linux' - run: | - while read -r cmd - do - eval sudo $cmd - done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') - - - name: Install dependencies - run: | - remotes::install_deps(dependencies = TRUE) - remotes::install_cran("rcmdcheck") - shell: Rscript {0} - - - name: Check - env: - _R_CHECK_CRAN_INCOMING_REMOTE_: false - run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") - shell: Rscript {0} - - - name: Upload check results - if: failure() - uses: actions/upload-artifact@main - with: - name: ${{ runner.os }}-r${{ matrix.config.r }}-results - path: check From 7fbd705990c2b9cb9d293910842492ce5a0fd7e8 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Fri, 5 Jul 2024 23:11:55 -0500 Subject: [PATCH 30/32] More robus functions. --- R/helpers.R | 21 ++++++++++++++++++--- R/implement.R | 31 ++++++++++++++++++++++--------- man/implement.Rd | 2 +- 3 files changed, 41 insertions(+), 13 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index c1e875a..e841c3c 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -5,11 +5,26 @@ check_type <- function(value, type_spec) { } else if (inherits(type_spec, "Interface")) { return(check_interface(value, type_spec)) } else if (is.character(type_spec)) { - return(inherits(value, type_spec)) + if (type_spec %in% c("numeric", "integer", "logical", "character", "list")) { + return(inherits(value, type_spec)) + } else { + stop(sprintf("Unsupported character type specification: %s", type_spec)) + } } else if (is.function(type_spec)) { - return(type_spec(value)) + tryCatch( + { + result <- type_spec(value) + if (!is.logical(result) || length(result) != 1) { + stop("Custom type check function must return a single logical value") + } + return(result) + }, + error = function(e) { + stop(sprintf("Error in custom type check function: %s", e$message)) + } + ) } else { - stop("Unsupported type specification") + stop(sprintf("Unsupported type specification: %s", class(type_spec)[1])) } } diff --git a/R/implement.R b/R/implement.R index f0a8368..d59b980 100644 --- a/R/implement.R +++ b/R/implement.R @@ -6,13 +6,26 @@ #' #' @return An object implementing the interface #' @export -implement <- function(interface, ..., validate_on_access = NULL) { +implement <- function(interface, ..., validate_on_access = NULL, allow_extra = FALSE) { obj <- list(...) - # Check if all required properties are present + # Check if all required properties are present and not NULL missing_props <- setdiff(names(interface$properties), names(obj)) - if (length(missing_props) > 0) { - stop(paste("Missing properties:", paste(missing_props, collapse = ", "))) + null_props <- names(obj)[vapply(obj, is.null, logical(1))] + if (length(missing_props) > 0 || length(null_props) > 0) { + stop(paste( + "Missing or NULL properties:", + paste(c(missing_props, null_props), collapse = ", ") + )) + } + + # Remove extra properties if not allowed + if (!allow_extra) { + extra_props <- setdiff(names(obj), names(interface$properties)) + if (length(extra_props) > 0) { + obj <- obj[names(interface$properties)] + warning(paste("Removed extra properties:", paste(extra_props, collapse = ", "))) + } } # Initial validation @@ -27,18 +40,18 @@ implement <- function(interface, ..., validate_on_access = NULL) { class_name <- paste0(interface$interface_name, "Implementation") classes <- c(class_name, "InterfaceImplementation", "list") - # Only add validated_list if required if (validate_on_access) { classes <- c("validated_list", classes) } - # Return the object as a simple list with appropriate class and attributes - structure( + # Return the object with appropriate class and attributes + return(structure( obj, class = classes, interface = interface, - validate_on_access = if (validate_on_access) TRUE else NULL - ) + validate_on_access = if (validate_on_access) TRUE else NULL, + allow_extra = allow_extra + )) } #' @export diff --git a/man/implement.Rd b/man/implement.Rd index cb95c71..0a85b10 100644 --- a/man/implement.Rd +++ b/man/implement.Rd @@ -4,7 +4,7 @@ \alias{implement} \title{Implement an Interface} \usage{ -implement(interface, ..., validate_on_access = NULL) +implement(interface, ..., validate_on_access = NULL, allow_extra = FALSE) } \arguments{ \item{interface}{An Interface object} From 9db674899e32daa44812ce2b6b6d7f56ce00b44a Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Fri, 5 Jul 2024 23:14:20 -0500 Subject: [PATCH 31/32] Version. --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 625cb59..b1e7f3b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: interface Type: Package Title: Interfaces for data validation and typing in R -Version: 0.1.0 +Version: 0.0.1 Authors@R: person(given = "Dereck", family = "Mezquita", From 6d4a88ff0b78807992f391c4ec5cf06c32585cd0 Mon Sep 17 00:00:00 2001 From: dereckmezquita Date: Fri, 5 Jul 2024 23:15:01 -0500 Subject: [PATCH 32/32] Update owner. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 143049a..b932388 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # interface -[![R-CMD-check](https://github.com/derecksprojects/interface/workflows/R-CMD-check/badge.svg)](https://github.com/derecksprojects/interface/actions) +[![R-CMD-check](https://github.com/dereckmezquita/interface/workflows/R-CMD-check/badge.svg)](https://github.com/dereckmezquita/interface/actions) `interface` provides a system for defining and implementing `interfaces` in R, with optional runtime type checking.