Patrikios · March 10, 2023 07:15 · Mar 10, 2023 · Sep 11, 2022 · Sep 11, 2022 · Sep 11, 2022
diff --git a/conditions.R b/conditions.R
@@ -6,7 +6,7 @@
 # - conditions are being signalled from functions
 # - R conditions system was inpsired by Common Lisp
 #
-ä
+#
 # Ressources:
 #
 # - 'A Prototype of a Condition System for R' by Robert Gentleman and Luke Tierney 

diff --git a/conditions.R b/conditions.R
@@ -1,4 +1,5 @@
 # DOCUMENTATION
+#
 # Sources: http://adv-r.had.co.nz/Exceptions-Debugging.html & https://adv-r.hadley.nz/conditions.html
 #
 # - all conditions inherit from abstract class 'condition'

diff --git a/conditions.R b/conditions.R
@@ -1,4 +1,5 @@
 # DOCUMENTATION
+# Sources: http://adv-r.had.co.nz/Exceptions-Debugging.html & https://adv-r.hadley.nz/conditions.html
 #
 # - all conditions inherit from abstract class 'condition'
 # - conditions are being signalled from functions

diff --git a/conditions.R b/conditions.R
@@ -1,3 +1,21 @@
+# DOCUMENTATION
+#
+# - all conditions inherit from abstract class 'condition'
+# - conditions are being signalled from functions
+# - R conditions system was inpsired by Common Lisp
+#
+ä
+# Ressources:
+#
+# - 'A Prototype of a Condition System for R' by Robert Gentleman and Luke Tierney 
+# - @ http://homepage.stat.uiowa.edu/~luke/R/exceptions/simpcond.html
+# Early version of the R conditions system, shows the big picture
+# 
+# - '19. Beyond Exception Handling: Conditions and Restarts' 
+# @ https://gigamonkeys.com/book/beyond-exception-handling-conditions-and-restarts.html
+# - Lisp Exceptions handlich which is very similar to R
+
+
 #' condition
 #'
 #' @description

diff --git a/conditions.R b/conditions.R
@@ -0,0 +1,84 @@
+#' condition
+#'
+#' @description
+#' condition constructor as in http://adv-r.had.co.nz/Exceptions-Debugging.html
+#'
+#' @param subclass
+#' @param message
+#' @param call
+#' @param ...
+#'
+#' @return new condition of its own type
+#'
+#' @examples
+#'
+#' # simple usage
+#' e <- condition(c("my_error", "error"), "This is an error")
+#' signalCondition(e)
+#' # NULL
+#' stop(e)
+#' # Error: This is an error
+#' w <- condition(c("my_warning", "warning"), "This is a warning")
+#' warning(w)
+#' # Warning message: This is a warning
+#' m <- condition(c("my_message", "message"), "This is a message")
+#' message(m)
+#' # This is a message
+#'
+#' # Usage with 'tryCatch()'
+#' custom_stop <- function(subclass, message, call = sys.call(-1), ...) {
+#'   c <- condition(c(subclass, "error"), message, call = call, ...)
+#'   stop(c)
+#' }
+#' my_log <- function(x) {
+#'   if (!is.numeric(x)) {
+#'     custom_stop("invalid_class", "my_log() needs numeric input")
+#'   }
+#'   if (any(x < 0)) {
+#'     custom_stop("invalid_value", "my_log() needs positive inputs")
+#'   }
+#'   log(x)
+#' }
+#' tryCatch(
+#'   my_log("a"),
+#'   invalid_class = function(c) "class",
+#'   invalid_value = function(c) "value"
+#' )
+#' #> [1] "class"
+#'
+condition <- function(subclass, message, call = sys.call(-1), ...) {
+  structure(
+    class = c(subclass, "condition"),
+    list(message = message, call = call),
+    ...
+  )
+}
+
+#' is.condition
+#'
+#' @description
+#' check if is of the abstract class condition
+#'
+#' @param x
+#'
+#' @return bool
+#'
+is.condition <- function(x) inherits(x, "condition")
+
+#' custom_stop
+#'
+#' @param subclass 
+#' @param message 
+#' @param call 
+#' @param ... 
+#'
+#' @return
+#' @export
+#'
+#' @examples
+#' custom_stop("invalid_class", "my_log() needs numeric input")
+#' 
+custom_stop <- function(subclass, message, call = sys.call(-1), ...) {
+  c <- condition(c(subclass, "error"), message, call = call, ...)
+  stop(c)
+}