Add export_manifest function

.Rbuildignore

@@ -1 +1,3 @@
+.github/
+^.lintr$
 ^LICENSE\.md$

.lintr

@@ -0,0 +1,4 @@
+linters: all_linters()
+exclusions: list(
+    "tests/testthat.R"
+  )

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: pacta.workflow.utils
 Title: Utility functions for PACTA workflows
-Version: 0.0.0.9000
+Version: 0.0.0.9003
 Authors@R: 
     c(person(given = "Alex",
              family = "Axthelm",
@@ -14,4 +14,18 @@ Description: Provide utility functions to be called across RMI-PACTA's workflows
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.1
+Imports: 
+    digest,
+    gert,
+    jsonlite,
+    logger,
+    pkgdepends,
+    pkgload
+Suggests: 
+    covr,
+    devtools,
+    pak,
+    testthat (>= 3.0.0),
+    withr
+Config/testthat/edition: 3

NAMESPACE

@@ -1,2 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+export(export_manifest)
+importFrom(logger,log_debug)
+importFrom(logger,log_error)
+importFrom(logger,log_info)
+importFrom(logger,log_trace)
+importFrom(logger,log_warn)

R/export_manifest.R

@@ -0,0 +1,104 @@
+#' Export manifest file with metadata
+#'
+#' @param manifest_path Path to the manifest file.
+#' @param input_files List or vector (named or unnamed) of files that are
+#' inputs to the workflow. Passed to `[get_file_metadata()]`.
+#' @param output_files List or vector (named or unnamed) of files that are
+#' outputs from the workflow. Passed to `[get_file_metadata()]`.
+#' @param params List parameters used to define the workflow.
+#' @param ... Nested list to be included in manifest. Passed on to
+#' `create_manifest`.
+#'
+#' @return (invisible) JSON string with metadata manifest.
+#'
+#' @export
+export_manifest <- function(
+  manifest_path,
+  input_files,
+  output_files,
+  params,
+  ...
+) {
+
+  manifest_list <- create_manifest(
+    input_files = input_files,
+    output_files = output_files,
+    params = params,
+    ...
+  )
+
+  manifest_json <- jsonlite::toJSON(
+    manifest_list,
+    pretty = TRUE,
+    auto_unbox = TRUE,
+    null = "null",
+    na = "string"
+  )
+
+  logger::log_debug("Writing metadata to file: ", manifest_path)
+  writeLines(
+    text = manifest_json,
+    con = manifest_path
+  )
+  return(invisible(manifest_json))
+}
+
+create_manifest <- function(
+  input_files,
+  output_files,
+  ...
+) {
+  log_debug("Creating metadata manifest")
+  log_trace("Checking ... arguments")
+  args_list <- list(...)
+  if (length(args_list) > 0L) {
+    clean_args <- check_arg_type(args_list)
+  }
+  manifest_list <- list(
+    input_files = get_file_metadata(input_files),
+    output_files = get_file_metadata(output_files),
+    envirionment = get_manifest_envirionment_info(),
+    manifest_creation_datetime = format.POSIXct(
+      x = Sys.time(),
+      format = "%F %R",
+      tz = "UTC",
+      usetz = TRUE
+    )
+  )
+  if (exists("clean_args")) {
+    manifest_list <- c(manifest_list, clean_args)
+  }
+  return(manifest_list)
+}
+
+# Check that arguments are nicely coercible to JSON. called for side effect of
+# `stop` if not.
+check_arg_type <- function(arg) {
+  log_trace("Checking argument type")
+  if (inherits(arg, "list")) {
+    if (
+      length(arg) != length(names(arg)) ||
+        any(names(arg) == "")
+    ) {
+      log_error("elements of lists in ... must be named")
+      stop("unnamed arguments in ... of create_manifest (or in nested list)")
+    }
+    lapply(
+      X = arg,
+      FUN = check_arg_type
+    )
+  } else {
+    if (
+      inherits(arg, "character") ||
+        inherits(arg, "numeric") ||
+        inherits(arg, "integer") ||
+        inherits(arg, "logical")
+    ) {
+      log_trace("arg is a simple type")
+    } else {
+      log_error("arg is not a simple type")
+      stop("Arguments in ... must be simple types")
+    }
+  }
+  return(arg)
+}

R/get_environment.R

@@ -0,0 +1,33 @@
+#' Get Environment information for manifest
+#'
+#' This function takes no arguments and returns a nested list, suitable for
+#' inclusion in manifest export.
+#'
+#' @return nested list of file details, length the same as the input vector.
+get_manifest_envirionment_info <- function() {
+  environment_list <- list(
+    session = get_r_session_info(),
+    packages = get_package_info()
+  )
+  return(environment_list)
+}
+
+#' Get session information for manifest
+#'
+#' This function takes no arguments and returns a list, suitable for
+#' inclusion in manifest export.
+#'
+#' @return list of session details, including R Version, platform, OS
+#' (`running`), locale, timezone, and library paths.
+get_r_session_info <- function() {
+  return(
+    list(
+      R.version = utils::sessionInfo()[["R.version"]],
+      platform = utils::sessionInfo()[["platform"]],
+      running = utils::sessionInfo()[["running"]],
+      locale = utils::sessionInfo()[["locale"]],
+      tzone = utils::sessionInfo()[["tzone"]],
+      libPaths = .libPaths() # nolint: undesirable_function_linter
+    )
+  )
+}

R/get_file_metadata.R

@@ -0,0 +1,104 @@
+#' Get Metadata for a vector of filepaths
+#'
+#' This function takes a vector of filepaths and returns a list of file
+#' details, suitable for inclusion in manifest export.
+#'
+#' @param filepaths vector of filepaths
+#'
+#' @return nested list of file details, length the same as the input vector.
+get_file_metadata <- function(filepaths) {
+  logger::log_trace("Getting metadata for files.")
+
+  file_metadata <- lapply(filepaths, get_single_file_metadata)
+
+  return(file_metadata)
+}
+
+#' Get Metadata for a file
+#'
+#' This function takes a single filepaths and returns a list of file
+#' details, suitable for inclusion in manifest export.
+#'
+#' @param filepath vector of filepaths
+#'
+#' @return list of file details
+get_single_file_metadata <- function(filepath) {
+  if (length(filepath) > 1L) {
+    logger::log_error("get_single_file_metadata only accepts single files.")
+    stop("Only one file path can be passed to get_single_file_metadata.")
+  }
+  if (!file.exists(filepath)) {
+    logger::log_error("File does not exist: \"{filepath}\".")
+    stop("File does not exist.")
+  }
+
+  logger::log_trace("Getting metadata for file: \"{filepath}\".")
+
+  file_name <- basename(filepath)
+  file_extension <- tools::file_ext(filepath)
+  file_path <- filepath
+  file_size <- file.info(filepath)[["size"]]
+  class(file_size) <- "object_size"
+  file_last_modified <- format(
+    as.POSIXlt(file.info(filepath)[["mtime"]], tz = "UTC"),
+    "%Y-%m-%dT%H:%M:%S+00:00"
+  )
+  file_md5 <- digest::digest(filepath, algo = "md5", file = TRUE)
+
+  file_metadata <- list(
+    file_name = file_name,
+    file_extension = file_extension,
+    file_path = file_path,
+    file_size_human = format(
+      file_size,
+      units = "auto",
+      standard = "SI"
+    ),
+    file_size = as.integer(file_size),
+    file_last_modified = file_last_modified,
+    file_md5 = file_md5
+  )
+
+  logger::log_trace("Getting summary information for file: \"{filepath}\".")
+  if (tolower(tools::file_ext(filepath)) == "rds") {
+    contents <- readRDS(filepath)
+  } else if (tolower(tools::file_ext(filepath)) == "csv") {
+    contents <- utils::read.csv(filepath)
+  } else if (tolower(tools::file_ext(filepath)) == "json") {
+    contents <- jsonlite::fromJSON(filepath)
+  } else {
+    logger::log_trace(
+      "File not supported for summary information: \"{filepath}\"."
+    )
+    contents <- NULL
+  }
+  # expecting a data.frame for output files
+  if (inherits(contents, "data.frame")) {
+    summary_info <- list(
+      nrow = nrow(contents),
+      colnames = colnames(contents),
+      class = class(contents)
+    )
+  } else if (inherits(contents, "list")) {
+    summary_info <- list(
+      length = length(contents),
+      names = names(contents),
+      class = class(contents)
+    )
+  } else if (!is.null(contents)) {
+    logger::log_trace(
+      "Only data.frame and list objects supported for summary information."
+    )
+    summary_info <- list(
+      class = class(contents)
+    )
+  } else {
+    summary_info <- NULL
+  }
+
+  if (exists("summary_info")) {
+    file_metadata[["summary_info"]] <- summary_info
+  }
+
+  return(file_metadata)
+}