continue porting

Author: b-rodrigues

.Rbuildignore

@@ -14,3 +14,4 @@ pkgdown/
 ^\.here$
 ^LICENSE\.md$
 ^codecov\.yml$
+^codemeta\.json$

.gitignore

@@ -5,3 +5,6 @@
 .RData
 .DS_Store
 .httr-oauth
+.Rdata
+.quarto
+inst/doc

DESCRIPTION

@@ -1,23 +1,44 @@
 Package: chronicler
-Version: 0.2.1.9999
 Title: Add Logging To Functions
+Version: 0.2.1.9999
+Authors@R: c(
+    person("Bruno", "Rodrigues", , "[email protected]", role = c("aut", "cre", "cph"),
+           comment = c(ORCID = "0000-0002-3211-3689")),
+    person("Matouš", "Eibich", , "[email protected]", role = "ctb")
+  )
 Description: Decorate functions to make them return enhanced output. The
-  enhanced output consists in an object of type 'chronicle' containing the
-  result of the function applied to its arguments, as well as a log detailing
-  when the function was run, what were its inputs, what were the errors (if the
-  function failed to run) and other useful information. Tools to handle
-  decorated functions are included, such as a forward pipe operator that makes
-  chaining decorated functions possible.
-Authors@R: c(person(given = "Bruno",
-         family = "Rodrigues",
-         role = c("aut", "cre", "cph"),
-         email = "[email protected]",
-         comment = c(ORCID = "0000-0002-3211-3689")),
-  person(given = "Matouš",
-         family = "Eibich",
-         role = "ctb",
-         email = "[email protected]"))
+    enhanced output consists in an object of type 'chronicle' containing
+    the result of the function applied to its arguments, as well as a log
+    detailing when the function was run, what were its inputs, what were
+    the errors (if the function failed to run) and other useful
+    information. Tools to handle decorated functions are included, such as
+    a forward pipe operator that makes chaining decorated functions
+    possible.
 License: GPL (>= 3)
+Depends: 
+    R (>= 2.10)
+Imports: 
+    clipr,
+    diffobj,
+    dplyr,
+    maybe,
+    rlang,
+    stringr,
+    tibble,
+    utils
+Suggests: 
+    knitr,
+    lubridate,
+    purrr,
+    readr,
+    rmarkdown,
+    testthat (>= 3.0.0),
+    tidyr
+VignetteBuilder: 
+    knitr
+Config/fusen/version: 0.5.2
+Config/testthat/edition: 3
 Encoding: UTF-8
+LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3

NAMESPACE

@@ -13,7 +13,6 @@ export(pick)
 export(purely)
 export(read_log)
 export(record)
-export(record_ggplot)
 export(record_many)
 importFrom(clipr,write_clip)
 importFrom(diffobj,diffObj)
@@ -23,7 +22,6 @@ importFrom(dplyr,lag)
 importFrom(dplyr,mutate)
 importFrom(dplyr,row_number)
 importFrom(dplyr,select)
-importFrom(ggplot2,ggplot_build)
 importFrom(maybe,fmap)
 importFrom(maybe,from_maybe)
 importFrom(maybe,is_nothing)
@@ -40,4 +38,5 @@ importFrom(rlang,quo_get_expr)
 importFrom(rlang,try_fetch)
 importFrom(stringr,str_remove_all)
 importFrom(tibble,tibble)
+importFrom(utils,data)
 importFrom(utils,tail)

R/.R

@@ -0,0 +1,35 @@
+# WARNING - Generated by {fusen} from dev/flat_pipe.Rmd: do not edit by hand
+
+#' Pipe a chronicle object to a decorated function.
+#' @param .c A value returned by record.
+#' @param .f A chronicle function to apply to the returning value of .c.
+#' @return A chronicle object.
+#' @importFrom rlang enquo quo_get_expr quo_get_env call_match call2 eval_tidy
+#' @importFrom maybe from_maybe nothing
+#' @examples
+#' r_sqrt <- record(sqrt)
+#' r_exp <- record(exp)
+#' 3 |> r_sqrt() %>=% r_exp()
+#' @export
+`%>=%` <- function(.c, .f) {
+
+  f_quo <- rlang::enquo(.f)
+  f_exp <- rlang::quo_get_expr(f_quo)
+  f_env <- rlang::quo_get_env(f_quo)
+  f_chr <- deparse(f_exp[[1]])
+
+  f <- get(f_chr, envir = f_env)
+
+  q_ex_std <- rlang::call_match(call = f_exp, fn = f)
+  expr_ls <- as.list(q_ex_std)
+
+  # need to set .value to empty, if not .value will be matched multiple times in call2
+  names(expr_ls)[names(expr_ls) == ".value"] <- ""
+
+  rlang::eval_tidy(rlang::call2(f,
+                                .value = maybe::from_maybe(.c$value, default = maybe::nothing()),
+                                !!!expr_ls[-1],
+                                .log_df = .c$log_df))
+
+}
+

R/bind_record.R

@@ -0,0 +1,66 @@
+# WARNING - Generated by {fusen} from dev/flat_bind_fmap.Rmd: do not edit by hand
+
+#' Evaluate a decorated function; used to chain multiple decorated functions.
+#' @param .c A chronicle object.
+#' @param .f A chronicle function to apply to the returning value of .c.
+#' @param ... Further parameters to pass to .f.
+#' @return A chronicle object.
+#' @importFrom maybe from_maybe nothing
+#' @examples
+#' r_sqrt <- record(sqrt)
+#' r_exp <- record(exp)
+#' 3 |> r_sqrt() |> bind_record(r_exp)
+#' @export
+bind_record <- function(.c, .f, ...){
+
+  .f(maybe::from_maybe(.c$value, default = maybe::nothing()), ..., .log_df = .c$log_df)
+
+}
+
+#' Flatten nested chronicle objects
+#' @param .c A nested chronicle object, where the $value element is itself a chronicle object
+#' @return Returns `.c` where value is the actual value, and logs are concatenated.
+#' @export
+#' @examples
+#' r_sqrt <- record(sqrt)
+#' r_log <- record(log)
+#' a <- as_chronicle(r_log(10))
+#' a
+#' flatten_record(a)
+flatten_record <- function(.c){
+
+  list(value = .c$value$content$value,
+       log_df = dplyr::bind_rows(.c$value$log_df,
+                                 .c$log_df)) |>
+    structure(class = "chronicle")
+
+}
+
+#' Evaluate a non-chronicle function on a chronicle object.
+#' @param .c A chronicle object.
+#' @param .f A non-chronicle function.
+#' @param ... Further parameters to pass to `.f`.
+#' @importFrom maybe fmap
+#' @importFrom dplyr bind_rows
+#' @return Returns the result of `.f(.c$value)` as a new chronicle object.
+#' @examples
+#' as_chronicle(3) |> fmap_record(sqrt)
+#' @export
+fmap_record <- function(.c, .f, ...){
+
+  res_pure <- list("log" = NA,
+                   "value" = NA)
+
+  log_df <- make_log_df(
+    success = 1,
+    fstring = "fmap_chronicle",
+    args = NA,
+    res_pure = res_pure,
+    start = Sys.time(),
+    end = Sys.time())
+
+  list(value = maybe::fmap(.c$value, .f, ...),
+       log_df = dplyr::bind_rows(.c$log_df,
+                                 log_df)) |>
+  structure(class = "chronicle")
+}

R/data.R renamed to R/included-datasets.R

@@ -1,6 +1,9 @@
+# WARNING - Generated by {fusen} from dev/flat_data_doc.Rmd: do not edit by hand
+
+#' avia
 #' Air passenger transport between the main airports of Luxembourg and their main partner airports
 #'
 #' A non-tidy dataset from EUROSTAT which can be found [here](https://ec.europa.eu/eurostat/databrowser/bookmark/f9e65cb1-39d2-4b80-9a8b-3b3076b95575?lang=en).
 #'
-#' @format A data frame with 510 rows and 238 columns.
+#' @format A data frame with 1,434 rows and 332 columns.
 "avia"

R/pipe.R

@@ -0,0 +1,35 @@
+# WARNING - Generated by {fusen} from dev/flat_pipe.Rmd: do not edit by hand
+
+#' Pipe a chronicle object to a decorated function.
+#' @param .c A value returned by record.
+#' @param .f A chronicle function to apply to the returning value of .c.
+#' @return A chronicle object.
+#' @importFrom rlang enquo quo_get_expr quo_get_env call_match call2 eval_tidy
+#' @importFrom maybe from_maybe nothing
+#' @examples
+#' r_sqrt <- record(sqrt)
+#' r_exp <- record(exp)
+#' 3 |> r_sqrt() %>=% r_exp()
+#' @export
+`%>=%` <- function(.c, .f) {
+
+  f_quo <- rlang::enquo(.f)
+  f_exp <- rlang::quo_get_expr(f_quo)
+  f_env <- rlang::quo_get_env(f_quo)
+  f_chr <- deparse(f_exp[[1]])
+
+  f <- get(f_chr, envir = f_env)
+
+  q_ex_std <- rlang::call_match(call = f_exp, fn = f)
+  expr_ls <- as.list(q_ex_std)
+
+  # need to set .value to empty, if not .value will be matched multiple times in call2
+  names(expr_ls)[names(expr_ls) == ".value"] <- ""
+
+  rlang::eval_tidy(rlang::call2(f,
+                                .value = maybe::from_maybe(.c$value, default = maybe::nothing()),
+                                !!!expr_ls[-1],
+                                .log_df = .c$log_df))
+
+}
+

R/purely.R

@@ -0,0 +1,92 @@
+# WARNING - Generated by {fusen} from dev/flat_purely.Rmd: do not edit by hand
+
+#' Capture all errors, warnings and messages.
+#' @param .f A function to decorate.
+#' @param strict Controls if the decorated function should catch only errors (1), errors and
+#'   warnings (2, the default) or errors, warnings and messages (3).
+#' @return A function which returns a list. The first element of the list, `$value`,
+#' is the result of the original function `.f` applied to its inputs. The second element, `$log` is
+#' `NULL` in case everything goes well. In case of error/warning/message, `$value` is NA and `$log`
+#' holds the message. `purely()` is used by `record()` to allow the latter to handle errors.
+#' @importFrom rlang try_fetch eval_tidy cnd_message
+#' @importFrom maybe just nothing is_nothing
+#' @examples
+#' purely(log)(10)
+#' purely(log)(-10)
+#' purely(log, strict = 1)(-10) # This produces a warning, so with strict = 1 nothing gets captured.
+#' @export
+purely <- function(.f, strict = 2){
+
+  function(.value, ..., .log_df = "Log start..."){
+
+    if(maybe::is_nothing(.value)){
+
+      final_result <- list(
+        value = maybe::nothing(),
+        log_df = "A `Nothing` was given as input."
+      )
+
+    } else {
+
+      res <- switch(strict,
+                    only_errors(.f, .value,  ...),
+                    errors_and_warnings(.f, .value, ...),
+                    errs_warn_mess(.f, .value, ...))
+
+      final_result <- list(
+        value = NULL,
+        log_df = NULL
+      )
+
+      final_result$value <- if(any(c("error", "warning", "message") %in% class(res))){
+                              maybe::nothing()
+                            } else {
+                              maybe::just(res)
+                            }
+
+      final_result$log_df <- if(any(c("error", "warning", "message") %in% class(res))){
+                               rlang::cnd_message(res)
+                             } else {
+                               NA
+                             }
+
+
+    }
+
+    final_result
+
+  }
+}
+
+
+
+#' @noRd
+only_errors <- function(.f, ...){
+
+  rlang::try_fetch(
+           rlang::eval_tidy(.f(...)),
+           error = function(err) err,
+           )
+
+}
+
+#' @noRd
+errors_and_warnings <- function(.f, ...){
+
+  rlang::try_fetch(
+           rlang::eval_tidy(.f(...)),
+           error = function(err) err,
+           warning = function(warn) warn,
+           )
+}
+
+#' @noRd
+errs_warn_mess <- function(.f, ...){
+
+  rlang::try_fetch(
+           rlang::eval_tidy(.f(...)),
+           error = function(err) err,
+           warning = function(warn) warn,
+           message = function(message) message,
+           )
+}