RPKG-2: enum

DESCRIPTION

@@ -1,7 +1,8 @@
 Package: interface
 Type: Package
 Title: Typings and interfaces for data validation and safety in R
-Version: 0.0.21
+Version: 0.0.3
+URL: https://github.com/dereckmezquita/interface
 Authors@R: 
     person(given = "Dereck",
            family = "Mezquita",

NAMESPACE

@@ -1,14 +1,20 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("$",enum)
 S3method("$",interface_object)
+S3method("$<-",enum)
 S3method("$<-",interface_object)
 S3method("$<-",typed_frame)
+S3method("==",enum)
 S3method("[<-",typed_frame)
+S3method(print,enum)
+S3method(print,enum_generator)
 S3method(print,interface_object)
 S3method(print,typed_frame)
 S3method(print,typed_function)
 S3method(rbind,typed_frame)
 S3method(summary,typed_frame)
+export(enum)
 export(fun)
 export(interface)
 export(type.frame)

R/enum.R

@@ -0,0 +1,159 @@
+#' Create an enumerated type
+#'
+#' @description
+#' Creates an enumerated type with a fixed set of possible values. This function returns an enum generator,
+#' which can be used to create enum objects with values restricted to the specified set.
+#'
+#' @param ... The possible values for the enumerated type. These should be unique character strings.
+#' @return A function (enum generator) that creates enum objects of the defined type.
+#'
+#' @examples
+#' # Create an enum type for colors
+#' Colors <- enum("red", "green", "blue")
+#'
+#' # Create enum objects
+#' my_color <- Colors("red")
+#' print(my_color)  # Output: Enum: red
+#'
+#' # Trying to create an enum with an invalid value will raise an error
+#' try(Colors("yellow"))
+#'
+#' # Enums can be used in interfaces
+#' ColoredShape <- interface(
+#'   shape = character,
+#'   color = Colors
+#' )
+#'
+#' my_shape <- ColoredShape(shape = "circle", color = "red")
+#'
+#' # Modifying enum values
+#' my_shape$color$value <- "blue"  # This is valid
+#' try(my_shape$color$value <- "yellow")  # This will raise an error
+#'
+#' @seealso \code{\link{interface}} for using enums in interfaces
+#' @export
+enum <- function(...) {
+    values <- c(...)
+
+    new <- function(value) {
+        if (!value %in% values) {
+            stop(sprintf("Invalid value. Must be one of: %s", paste(values, collapse = ", ")))
+        }
+        return(structure(
+            list(value = value),
+            class = "enum",
+            values = values
+        ))
+    }
+
+    class(new) <- c("enum_generator", "function")
+    attr(new, "values") <- values
+    return(new)
+}
+
+#' Print method for enum objects
+#'
+#' @description
+#' Prints a human-readable representation of an enum object.
+#'
+#' @param x An enum object
+#' @param ... Additional arguments (not used)
+#' @export
+#'
+#' @examples
+#' Colors <- enum("red", "green", "blue")
+#' my_color <- Colors("red")
+#' print(my_color)  # Output: Enum: red
+print.enum <- function(x, ...) {
+    cat("Enum:", x$value, "\n")
+}
+
+#' Equality comparison for enum objects
+#'
+#' @description
+#' Compares two enum objects or an enum object with a character value.
+#'
+#' @param e1 First enum object
+#' @param e2 Second enum object or a character value
+#' @return Logical value indicating whether the two objects are equal
+#' @export
+#'
+#' @examples
+#' Colors <- enum("red", "green", "blue")
+#' color1 <- Colors("red")
+#' color2 <- Colors("blue")
+#' color1 == color2  # FALSE
+#' color1 == Colors("red")  # TRUE
+#' color1 == "red"  # TRUE
+`==.enum` <- function(e1, e2) {
+    if (inherits(e2, "enum")) {
+        e1$value == e2$value
+    } else {
+        e1$value == e2
+    }
+}
+
+#' Get value from enum object
+#'
+#' @description
+#' Retrieves the value of an enum object.
+#'
+#' @param x An enum object
+#' @param name The name of the field to access (should be "value")
+#' @return The value of the enum object
+#' @export
+#'
+#' @examples
+#' Colors <- enum("red", "green", "blue")
+#' my_color <- Colors("red")
+#' my_color$value  # "red"
+`$.enum` <- function(x, name) {
+    if (name == "value") {
+        x[["value"]]
+    } else {
+        stop("Invalid field for enum")
+    }
+}
+
+#' Set value of enum object
+#'
+#' @description
+#' Sets the value of an enum object. The new value must be one of the valid enum values.
+#'
+#' @param x An enum object
+#' @param name The name of the field to set (should be "value")
+#' @param value The new value to set
+#' @return The updated enum object
+#' @export
+#'
+#' @examples
+#' Colors <- enum("red", "green", "blue")
+#' my_color <- Colors("red")
+#' my_color$value <- "blue"  # Valid assignment
+#' try(my_color$value <- "yellow")  # This will raise an error
+`$<-.enum` <- function(x, name, value) {
+    if (name != "value") {
+        stop("Cannot add new fields to an enum")
+    }
+    if (!value %in% attr(x, "values")) {
+        stop(sprintf("Invalid value. Must be one of: %s", paste(attr(x, "values"), collapse = ", ")))
+    }
+    x[["value"]] <- value
+    return(x)
+}
+
+#' Print method for enum generators
+#'
+#' @description
+#' Prints a human-readable representation of an enum generator, showing all possible values.
+#'
+#' @param x An enum generator function
+#' @param ... Additional arguments (not used)
+#' @export
+#'
+#' @examples
+#' Colors <- enum("red", "green", "blue")
+#' print(Colors)  # Output: Enum generator: red, green, blue
+print.enum_generator <- function(x, ...) {
+    cat("Enum generator:", paste(attr(x, "values"), collapse = ", "), "\n")
+}

R/fun.R

@@ -46,13 +46,18 @@
 #' print(concat_or_add(1, 2))     # [1] 3
 #' print(concat_or_add("a", 2))   # [1] "a 2"
 #' @export
-fun <- function(..., return, impl) {
+fun <- function(...) {
     args <- list(...)
-    force(return)
-    force(impl)
+    return_type <- args$return
+    impl <- args$impl
+
+    # Remove 'return' and 'impl' from args
+    args$return <- NULL
+    args$impl <- NULL
 
-    # Ensure that 'return' and 'impl' are not in the args list
-    args <- args[!names(args) %in% c("return", "impl")]
+    if (is.null(return_type) || is.null(impl)) {
+        stop("Both 'return' and 'impl' must be specified", call. = FALSE)
+    }
 
     typed_fun <- function(...) {
         call_args <- list(...)
@@ -85,19 +90,20 @@ fun <- function(..., return, impl) {
         result <- do.call(impl, call_args)
 
         # Validate return value
-        error <- validate_property("return", result, return)
+        error <- validate_property("return", result, return_type)
         if (!is.null(error)) {
             stop(error, call. = FALSE)
         }
 
-        return(result)
+        result
     }
 
+    # Create the structure explicitly
     return(structure(
         typed_fun,
         class = c("typed_function", "function"),
         args = args,
-        return = return,
+        return = return_type,
         impl = impl
     ))
 }

R/interface.R

@@ -4,11 +4,11 @@
 #' An interface defines a structure with specified properties and their types or validation functions. 
 #' This is useful for ensuring that objects adhere to a particular format and type constraints.
 #'
-#' @param properties A named list where names are property names and values are their expected types or validation functions.
+#' @param ... Named arguments defining the properties and their types or validation functions.
+#' @param validate_on_access Logical, whether to validate properties on access (default: FALSE).
+#' @param extends A list of interfaces that this interface extends.
 #' @return A function to create objects that implement the defined interface.
-#' @details
-#' The `interface` function creates a blueprint for objects, specifying what properties they must have and what types those properties must be. 
-#' When an object is created using this interface, it ensures that the object adheres to these specifications.
+#' @export
 #'
 #' @examples
 #' # Define an interface for a person
@@ -25,18 +25,33 @@
 #'   email = "[email protected]"
 #' )
 #'
-#' # Access properties
-#' print(john$name)  # [1] "John Doe"
+#' # Using enum in an interface
+#' Colors <- enum("red", "green", "blue")
+#' ColoredShape <- interface(
+#'   shape = character,
+#'   color = Colors
+#' )
 #'
-#' # Valid assignment
-#' john$age <- c(10, 11)
+#' my_shape <- ColoredShape(shape = "circle", color = "red")
 #'
-#' # Invalid assignment (throws error)
-#' try(john$age <- "thirty")
-#' @export
+#' # In-place enum declaration
+#' Car <- interface(
+#'   make = character,
+#'   model = character,
+#'   color = enum("red", "green", "blue")
+#' )
+#'
+#' my_car <- Car(make = "Toyota", model = "Corolla", color = "red")
 interface <- function(..., validate_on_access = FALSE, extends = list()) {
     properties <- list(...)
 
+    # Process in-place enum declarations
+    for (name in names(properties)) {
+        if (inherits(properties[[name]], "enum_generator")) {
+            properties[[name]] <- properties[[name]]
+        }
+    }
+
     # Merge properties from extended interfaces
     all_properties <- properties
     for (ext in extends) {
@@ -62,6 +77,15 @@ interface <- function(..., validate_on_access = FALSE, extends = list()) {
             value <- values[[name]]
             validator <- all_properties[[name]]
 
+            if (inherits(validator, "enum_generator")) {
+                if (is.character(value)) {
+                    value <- validator(value)
+                } else if (!inherits(value, "enum")) {
+                    errors <- c(errors, sprintf("Property '%s' must be a string or an enum object", name))
+                    next
+                }
+            }
+
             error <- validate_property(name, value, validator)
             if (!is.null(error)) {
                 errors <- c(errors, error)

R/validate_property.R

@@ -7,9 +7,6 @@
 #' @param value The value of the property.
 #' @param validator The expected type or a custom validation function.
 #' @return NULL if the validation passes, otherwise an error message.
-#' @details
-#' The `validate_property` function checks whether a property value adheres to the specified type or validation function. 
-#' If the property value does not meet the criteria, an error message is returned.
 #'
 validate_property <- function(name, value, validator) {
     if (is.list(validator) && !is.function(validator)) {
@@ -23,6 +20,10 @@ validate_property <- function(name, value, validator) {
         if (!inherits(value, "interface_object") || !identical(attr(value, "properties"), attr(validator, "properties"))) {
             return(sprintf("Property '%s' must be an object implementing the specified interface", name))
         }
+    } else if (inherits(validator, "enum_generator")) {
+        if (!inherits(value, "enum") || !value$value %in% attr(validator, "values")) {
+            return(sprintf("Property '%s' must be one of the enum values: %s", name, paste(attr(validator, "values"), collapse = ", ")))
+        }
     } else if (is.function(validator)) {
         if (identical(validator, character)) {
             if (!is.character(value)) {
@@ -54,10 +55,9 @@ validate_property <- function(name, value, validator) {
             }
         } else {
             # Custom validator function
-            validation_result <- vapply(value, validator, logical(1))
-            if (!all(validation_result)) {
-                invalid_indices <- which(!validation_result)
-                return(sprintf("Invalid value(s) for property '%s' at index(es): %s", name, paste(invalid_indices, collapse = ", ")))
+            validation_result <- validator(value)
+            if (!isTRUE(validation_result)) {
+                return(sprintf("Invalid value for property '%s': %s", name, as.character(validation_result)))
             }
         }
     } else if (is.character(validator)) {
@@ -69,4 +69,4 @@ validate_property <- function(name, value, validator) {
     }
 
     return(NULL)
-}
+}