diff --git a/.Rbuildignore b/.Rbuildignore index 5163d0b5..507338f0 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1 +1,3 @@ +.github/ +^.lintr$ ^LICENSE\.md$ diff --git a/.lintr b/.lintr new file mode 100644 index 00000000..9d708aec --- /dev/null +++ b/.lintr @@ -0,0 +1,4 @@ +linters: all_linters() +exclusions: list( + "tests/testthat.R" + ) diff --git a/DESCRIPTION b/DESCRIPTION index 35ce9783..8d0ef561 100644 --- a/DESCRIPTION +++ b/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 diff --git a/NAMESPACE b/NAMESPACE index 6ae92683..631c0b56 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/export_manifest.R b/R/export_manifest.R new file mode 100644 index 00000000..e16b7e59 --- /dev/null +++ b/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) +} diff --git a/R/get_environment.R b/R/get_environment.R new file mode 100644 index 00000000..552e6add --- /dev/null +++ b/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 + ) + ) +} diff --git a/R/get_file_metadata.R b/R/get_file_metadata.R new file mode 100644 index 00000000..f21b63d2 --- /dev/null +++ b/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) +} diff --git a/R/get_package_info.R b/R/get_package_info.R new file mode 100644 index 00000000..4bab9b2e --- /dev/null +++ b/R/get_package_info.R @@ -0,0 +1,173 @@ +#' Get package information for active packages +#' +#' This function takes a vector or (possibly nested) list of package names and +#' returns a nested list of package details, suitable for inclusion in manifest +#' export. +#' +#' @param packagelist vector or list of package names. Best left as default, +#' which includes the currently loaded and attached namespaces separated into +#' useful categories. +#' +#' @return nested list of file details, length 3, with top level keys being +#' `base`, `attached`, and `loaded`. Underneath those keys are lists of package +#' details, with the package names as keys, and further details as returned by +#' [get_individual_package_info()]. +#' @seealso [get_individual_package_info()] +get_package_info <- function( + packagelist = list( + base = utils::sessionInfo()[["basePkgs"]], + attached = names(utils::sessionInfo()[["otherPkgs"]]), + loaded = names(utils::sessionInfo()[["loadedOnly"]]) + ) +) { + log_debug("Getting package info.") + if (inherits(packagelist, "character")) { + out <- vapply( + X = packagelist, + FUN = function(x) { + list(x = get_individual_package_info(x)) + }, + FUN.VALUE = list(1L), + USE.NAMES = TRUE + ) + } else { + out <- vapply( + X = packagelist, + FUN = function(x) { + list( + x = get_package_info(x) + ) + }, + FUN.VALUE = list(1L), + USE.NAMES = TRUE + ) + } + return(out) +} + +#' Get package information for a package +#' +#' This function takes a single package name and returns a list of package +#' details, suitable for inclusion in manifest export. +#' +#' @param packagename Singular charater string of package name +#' +#' @return nested list of file details, length 11, with keys: +#' - `package`: The name of the package +#' - `version`: The version of the package +#' - `loaded_with_pkgload`: Is this package loaded with `pkgload`? (logical). +#' Useful for identifying local development versions +#' - `library`: The path of the library the package is installed in +#' - `library_index`: The index of the library in the `.libPaths()` vector +#' - `repository`: The repository the package was pulled from +#' - `platform`: The platform the package was built for +#' - `built`: Information about package build (relevant for binary packages) +#' - `remotetype`: The type of remote repository the package was pulled from +#' - `remotepkgref`: The reference used by `pak` to install the package +#' - `remoteref`: The reference of the package when it was pulled from REPO +#' - `remotesha`: the SHA-1 hash of the reference (if applicable) +get_individual_package_info <- function(packagename) { + if (length(packagename) != 1L || !is.character(packagename)) { + log_error("packagename must be a single string.") + # Early return + stop("packagename must be a single string.") + } + dev_package <- pkgload::is_dev_package(packagename) + if (dev_package) { + log_warn("Package \"{packagename}\" is a development package.") + log_warn("Package information may not be accurate.") + warning("Identifying development packages may not be accurate.") + package_dev_dir <- pkgload::pkg_path( + path = dirname(system.file("DESCRIPTION", package = packagename)) + ) + git_info <- get_git_info(repo = package_dev_dir) + pkg_details <- list( + package = pkgload::pkg_name(package_dev_dir), + version = paste("DEV", pkgload::pkg_version(package_dev_dir)), + library = NULL, + library_index = NULL, + repository = NULL, + platform = NULL, + built = NULL, + remotetype = "pkgload", + remotepkgref = normalizePath(package_dev_dir), + remoteref = NULL, + remotesha = NULL, + git = git_info + ) + } else { + if (packagename %in% utils::installed.packages()[, "Package"]) { + installed_index <- which( + utils::installed.packages()[, "Package"] == packagename + ) + installed_path <- utils::installed.packages()[installed_index, "LibPath"] + if (length(installed_path) > 1L) { + log_warn( + "Multiple installations of package \"{packagename}\" found: ", + "{installed_path}" + ) + log_warn("Using installation first on the search path.") + warning("Multiple installations of package found.") + } + lib_index <- min(which(.libPaths() == installed_path)) #nolint: undesirable_function_linter + lib <- .libPaths()[lib_index] #nolint: undesirable_function_linter + log_trace("Package \"{packagename}\" is installed at {lib}") + } else { + log_error("Package \"{packagename}\" is not installed.") + stop("Package is not installed.") + } + log_trace("Getting package info for {packagename}.") + pkg_details <- as.list( + pkgdepends::lib_status( + library = lib, + packages = packagename + ) + ) + pkg_details <- lapply( + X = pkg_details, + FUN = function(x) { + if (is.na(x)) { + return(NULL) + } else { + return(x) + } + } + ) + pkg_details[["library_index"]] <- lib_index + if (is.null(pkg_details[["remotepkgref"]])) { + is_local_pkg <- FALSE + } else { + is_local_pkg <- grepl( + x = pkg_details[["remotepkgref"]], + pattern = "^local::" + ) + } + if (is_local_pkg) { + git_info <- get_git_info( + repo = gsub( + x = pkg_details[["remotepkgref"]], + pattern = "local::", + replacement = "", + fixed = TRUE + ) + ) + pkg_details[["git"]] <- git_info + } + } + details_list <- list( + package = pkg_details[["package"]], + version = pkg_details[["version"]], + loaded_with_pkgload = dev_package, + library = pkg_details[["library"]], + library_index = pkg_details[["library_index"]], + repository = pkg_details[["repository"]], + platform = pkg_details[["platform"]], + built = pkg_details[["built"]], + remotetype = pkg_details[["remotetype"]], + remotepkgref = pkg_details[["remotepkgref"]], + remoteref = pkg_details[["remoteref"]], + remotesha = pkg_details[["remotesha"]], + git = pkg_details[["git"]] + ) + return(details_list) +} diff --git a/R/git.R b/R/git.R new file mode 100644 index 00000000..f4a42cc3 --- /dev/null +++ b/R/git.R @@ -0,0 +1,157 @@ +get_git_info <- function(repo) { + log_trace("checking that directory \"{repo}\"exists.") + if (is_git_path(repo)) { + git_repo <- gert::git_find(path = repo) + info <- gert::git_info(repo = git_repo) + latest_commit <- info[["commit"]] + if (is.na(latest_commit)) { + log_debug("No commits found in repo.") + latest_commit <- NULL + } + changed_files <- git_changed_files(repo = git_repo) + # cleaning path for older versions of R on windows + repo_path <- gsub( + x = normalizePath(info[["path"]]), + pattern = "[\\]+$", # nolint: nonportable_path_linter + replacement = "" + ) + out <- list( + repo = repo_path, + is_git = TRUE, + commit = latest_commit, + clean = (length(changed_files) == 0L), + branch = git_branch_info(repo = git_repo), + changed_files = changed_files, + tags = git_tag_info(repo = git_repo) + ) + } else { + log_warn("Directory \"{repo}\" is not a git repository.") + warning("Specified path is not in a git repository.") + out <- NULL + } + return(out) +} + +is_git_path <- function(path) { + log_trace("checking that path \"{path}\" is in a git repository.") + if (file.exists(path)) { + log_trace("path \"{path}\" exists.") + git_path <- tryCatch({ + gert::git_find(path = path) + }, error = function(e) { + log_trace("error while finding git repo in parent tree for \"{path}\".") + NULL + }) + if (is.null(git_path)) { + log_trace("no git repo found in parent tree for \"{path}\".") + is_git_path <- FALSE + } else { + log_trace("git repo found in parent tree for \"{path}\".") + is_git_path <- dir.exists(git_path) + } + } else { + # dir does not exist + log_error("path \"{path}\" does not exist.") + stop("Cannot find git information for path which does not exist.") + } + return(is_git_path) +} + +git_branch_info <- function(repo) { + log_trace("checking branch information for repo \"{repo}\".") + if (is_git_path(repo)) { + git_repo <- gert::git_find(path = repo) + active_branch <- gert::git_branch(repo = git_repo) + if (is.null(active_branch)) { + log_debug("No active branch found.") + return(NULL) + } + log_debug("active branch: \"{active_branch}\".") + branch_list <- gert::git_branch_list(repo = git_repo) + active_index <- which(branch_list[["name"]] == active_branch) + active_commit <- branch_list[[active_index, "commit"]] + active_upstream <- branch_list[[active_index, "upstream"]] + if (is.na(active_upstream)) { + log_debug("Branch \"{active_branch}\" has no upstream.") + active_upstream <- NULL + up_to_date <- NULL + upstream_commit <- NULL + remote_url <- NULL + } else { + log_trace( + "Branch \"{active_branch}\" has an upstream: \"{active_upstream}\"." + ) + active_upstream <- gsub( + pattern = "refs/heads/", # nolint: nonportable_path_linter + replacement = "", + x = active_upstream + ) + upstream_index <- which(branch_list[["ref"]] == active_upstream) + upstream_commit <- branch_list[[upstream_index, "commit"]] + up_to_date <- active_commit == upstream_commit + # format of remote ref: refs/remotes/origin/branch + remote_name <- strsplit( + x = active_upstream, + split = "/", + fixed = TRUE + )[[1L]][[3L]] + remote_info <- gert::git_remote_info( + repo = git_repo, + remote = remote_name + ) + remote_url <- remote_info[["url"]] + } + out <- list( + name = active_branch, + commit = active_commit, + upstream = active_upstream, + remote_url = remote_url, + up_to_date = up_to_date, + upstream_commit = upstream_commit + ) + } else { + log_warn("Directory \"{repo}\" is not a git repository.") + warning("Specified path is not in a git repository.") + out <- NULL + } + return(out) +} + +git_changed_files <- function(repo) { + log_trace("checking for changed files in repo \"{repo}\".") + if (is_git_path(repo)) { + git_repo <- gert::git_find(path = repo) + status <- gert::git_status(repo = git_repo) + changed_files <- list() + for (f in status[["file"]]) { + changed_files[[f]] <- status[["status"]][status[["file"]] == f] + } + return(changed_files) + } else { + log_debug("Specified path is not in a git repository.") + return(NULL) + } +} + +git_tag_info <- function(repo) { + log_trace("checking for tags in repo \"{repo}\".") + if (is_git_path(repo)) { + git_repo <- gert::git_find(path = repo) + tags_df <- gert::git_tag_list(repo = git_repo) + tags <- list() + for (i in seq_along(tags_df[["name"]])) { + tag_name <- tags_df[["name"]][i] + tag_commit <- tags_df[["commit"]][i] + tag_pointer <- gert::git_commit_info(repo = git_repo, ref = tag_commit) + tags[[tag_name]] <- list( + name = tag_name, + commit = tag_commit, + points_to = tag_pointer[["id"]] + ) + } + return(tags) + } else { + log_debug("Specified path is not in a git repository.") + return(NULL) + } +} diff --git a/R/pacta.workflow.utils-package.R b/R/pacta.workflow.utils-package.R new file mode 100644 index 00000000..e181405a --- /dev/null +++ b/R/pacta.workflow.utils-package.R @@ -0,0 +1,11 @@ +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +#' @importFrom logger log_debug +#' @importFrom logger log_error +#' @importFrom logger log_info +#' @importFrom logger log_trace +#' @importFrom logger log_warn +## usethis namespace: end +NULL diff --git a/man/export_manifest.Rd b/man/export_manifest.Rd new file mode 100644 index 00000000..1a1f64eb --- /dev/null +++ b/man/export_manifest.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/export_manifest.R +\name{export_manifest} +\alias{export_manifest} +\title{Export manifest file with metadata} +\usage{ +export_manifest(manifest_path, input_files, output_files, params, ...) +} +\arguments{ +\item{manifest_path}{Path to the manifest file.} + +\item{input_files}{List or vector (named or unnamed) of files that are +inputs to the workflow. Passed to \verb{[get_file_metadata()]}.} + +\item{output_files}{List or vector (named or unnamed) of files that are +outputs from the workflow. Passed to \verb{[get_file_metadata()]}.} + +\item{params}{List parameters used to define the workflow.} + +\item{...}{Nested list to be included in manifest. Passed on to +\code{create_manifest}.} +} +\value{ +(invisible) JSON string with metadata manifest. +} +\description{ +Export manifest file with metadata +} diff --git a/man/get_file_metadata.Rd b/man/get_file_metadata.Rd new file mode 100644 index 00000000..b8817a8b --- /dev/null +++ b/man/get_file_metadata.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_file_metadata.R +\name{get_file_metadata} +\alias{get_file_metadata} +\title{Get Metadata for a vector of filepaths} +\usage{ +get_file_metadata(filepaths) +} +\arguments{ +\item{filepaths}{vector of filepaths} +} +\value{ +nested list of file details, length the same as the input vector. +} +\description{ +This function takes a vector of filepaths and returns a list of file +details, suitable for inclusion in manifest export. +} diff --git a/man/get_individual_package_info.Rd b/man/get_individual_package_info.Rd new file mode 100644 index 00000000..b7c1bc29 --- /dev/null +++ b/man/get_individual_package_info.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_package_info.R +\name{get_individual_package_info} +\alias{get_individual_package_info} +\title{Get package information for a package} +\usage{ +get_individual_package_info(packagename) +} +\arguments{ +\item{packagename}{Singular charater string of package name} +} +\value{ +nested list of file details, length 11, with keys: +\itemize{ +\item \code{package}: The name of the package +\item \code{version}: The version of the package +\item \code{loaded_with_pkgload}: Is this package loaded with \code{pkgload}? (logical). +Useful for identifying local development versions +\item \code{library}: The path of the library the package is installed in +\item \code{library_index}: The index of the library in the \code{.libPaths()} vector +\item \code{repository}: The repository the package was pulled from +\item \code{platform}: The platform the package was built for +\item \code{built}: Information about package build (relevant for binary packages) +\item \code{remotetype}: The type of remote repository the package was pulled from +\item \code{remotepkgref}: The reference used by \code{pak} to install the package +\item \code{remoteref}: The reference of the package when it was pulled from REPO +\item \code{remotesha}: the SHA-1 hash of the reference (if applicable) +} +} +\description{ +This function takes a single package name and returns a list of package +details, suitable for inclusion in manifest export. +} diff --git a/man/get_manifest_envirionment_info.Rd b/man/get_manifest_envirionment_info.Rd new file mode 100644 index 00000000..d31e5094 --- /dev/null +++ b/man/get_manifest_envirionment_info.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_environment.R +\name{get_manifest_envirionment_info} +\alias{get_manifest_envirionment_info} +\title{Get Environment information for manifest} +\usage{ +get_manifest_envirionment_info() +} +\value{ +nested list of file details, length the same as the input vector. +} +\description{ +This function takes no arguments and returns a nested list, suitable for +inclusion in manifest export. +} diff --git a/man/get_package_info.Rd b/man/get_package_info.Rd new file mode 100644 index 00000000..910150e4 --- /dev/null +++ b/man/get_package_info.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_package_info.R +\name{get_package_info} +\alias{get_package_info} +\title{Get package information for active packages} +\usage{ +get_package_info( + packagelist = list(base = utils::sessionInfo()[["basePkgs"]], attached = + names(utils::sessionInfo()[["otherPkgs"]]), loaded = + names(utils::sessionInfo()[["loadedOnly"]])) +) +} +\arguments{ +\item{packagelist}{vector or list of package names. Best left as default, +which includes the currently loaded and attached namespaces separated into +useful categories.} +} +\value{ +nested list of file details, length 3, with top level keys being +\code{base}, \code{attached}, and \code{loaded}. Underneath those keys are lists of package +details, with the package names as keys, and further details as returned by +\code{\link[=get_individual_package_info]{get_individual_package_info()}}. +} +\description{ +This function takes a vector or (possibly nested) list of package names and +returns a nested list of package details, suitable for inclusion in manifest +export. +} +\seealso{ +\code{\link[=get_individual_package_info]{get_individual_package_info()}} +} diff --git a/man/get_r_session_info.Rd b/man/get_r_session_info.Rd new file mode 100644 index 00000000..2e3d7ad3 --- /dev/null +++ b/man/get_r_session_info.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_environment.R +\name{get_r_session_info} +\alias{get_r_session_info} +\title{Get session information for manifest} +\usage{ +get_r_session_info() +} +\value{ +list of session details, including R Version, platform, OS +(\code{running}), locale, timezone, and library paths. +} +\description{ +This function takes no arguments and returns a list, suitable for +inclusion in manifest export. +} diff --git a/man/get_single_file_metadata.Rd b/man/get_single_file_metadata.Rd new file mode 100644 index 00000000..37b6f61f --- /dev/null +++ b/man/get_single_file_metadata.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_file_metadata.R +\name{get_single_file_metadata} +\alias{get_single_file_metadata} +\title{Get Metadata for a file} +\usage{ +get_single_file_metadata(filepath) +} +\arguments{ +\item{filepath}{vector of filepaths} +} +\value{ +list of file details +} +\description{ +This function takes a single filepaths and returns a list of file +details, suitable for inclusion in manifest export. +} diff --git a/man/pacta.workflow.utils-package.Rd b/man/pacta.workflow.utils-package.Rd new file mode 100644 index 00000000..bb6cc741 --- /dev/null +++ b/man/pacta.workflow.utils-package.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pacta.workflow.utils-package.R +\docType{package} +\name{pacta.workflow.utils-package} +\alias{pacta.workflow.utils} +\alias{pacta.workflow.utils-package} +\title{pacta.workflow.utils: Utility functions for PACTA workflows} +\description{ +Provide utility functions to be called across RMI-PACTA's workflows. +} +\author{ +\strong{Maintainer}: Alex Axthelm \email{aaxthelm@rmi.org} (\href{https://orcid.org/0000-0001-8579-8565}{ORCID}) [contractor] + +Other contributors: +\itemize{ + \item RMI \email{PACTA4investors@rmi.org} [copyright holder, funder] +} + +} +\keyword{internal} diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 00000000..58fa1f4e --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(pacta.workflow.utils) + +test_check("pacta.workflow.utils") diff --git a/tests/testthat/helper-git_config.R b/tests/testthat/helper-git_config.R new file mode 100644 index 00000000..022caed6 --- /dev/null +++ b/tests/testthat/helper-git_config.R @@ -0,0 +1,8 @@ +testing_git_config <- function(repo) { + gert::git_config_set(repo = repo, name = "user.name", value = "testthat") + gert::git_config_set( + repo = repo, + name = "user.email", + value = "PACTATesting@rmi.org" + ) +} diff --git a/tests/testthat/helper-remote_package.R b/tests/testthat/helper-remote_package.R new file mode 100644 index 00000000..f9e407c7 --- /dev/null +++ b/tests/testthat/helper-remote_package.R @@ -0,0 +1,12 @@ +remote_package <- list( + name = "minimal.r.package", + version = "0.0.0.9001", + old_version = "0.0.0.9000", + gh_repo = "RMI-PACTA/minimal.r.package", #nolint: nonportable_path_linter + gh_repo_old = "RMI-PACTA/minimal.r.package@28c716f", #nolint: nonportable_path_linter + branch = "main", + upstream = "refs/remotes/origin/main", #nolint: nonportable_path_linter + url = "https://github.com/RMI-PACTA/minimal.r.package.git", + sha = "93c4ff251bf4b4f0fe560cfe82cf5e836cdbab0d", + old_sha = "28c716face8bbf8787c32ae392f246177f111c00" +) diff --git a/tests/testthat/test-create_manifest.R b/tests/testthat/test-create_manifest.R new file mode 100644 index 00000000..168dee04 --- /dev/null +++ b/tests/testthat/test-create_manifest.R @@ -0,0 +1,435 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +test_that("create_manifest with minimal arguments", { + suppressWarnings({ + manifest <- create_manifest( + input_files = NULL, + output_files = NULL + ) + expected_environment_info <- get_manifest_envirionment_info() + }) + + expect_type(manifest, "list") + expect_named( + object = manifest, + expected = c( + "input_files", + "output_files", + "envirionment", + "manifest_creation_datetime" + ) + ) + expect_identical( + object = manifest[["input_files"]], + expected = list() + ) + expect_identical( + object = manifest[["output_files"]], + expected = list() + ) + # loaded packages can change during testthat testing + expected_environment_info <- suppressWarnings({ + get_manifest_envirionment_info() + }) + expected_environment_info[["packages"]][["loaded"]] <- list() + manifest[["envirionment"]][["packages"]][["loaded"]] <- list() + expect_identical( + object = manifest[["envirionment"]], + expected = expected_environment_info + ) + expect_equal( + object = as.numeric( + as.POSIXct(manifest[["manifest_creation_datetime"]], tz = "UTC") + ), + expected = as.numeric(as.POSIXct(Sys.time(), tz = "UTC")), + tolerance = 5L + ) +}) + +test_that("create_manifest with works with simple file arguments", { + csv_file <- withr::local_tempfile(fileext = ".csv") + write.csv(mtcars, csv_file, row.names = FALSE) + csv_info <- list( + file_name = basename(csv_file), + file_extension = "csv", + file_path = csv_file, + file_size_human = format( + structure(as.integer(file.size(csv_file)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(csv_file)), + file_last_modified = format( + as.POSIXlt(file.mtime(csv_file), tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(file = csv_file, algo = "md5"), + summary_info = list( + nrow = nrow(mtcars), + colnames = colnames(mtcars), + class = "data.frame" + ) + ) + + suppressWarnings({ + manifest <- create_manifest( + input_files = csv_file, + output_files = csv_file + ) + }) + + expect_type(manifest, "list") + expect_named( + object = manifest, + expected = c( + "input_files", + "output_files", + "envirionment", + "manifest_creation_datetime" + ) + ) + expect_identical( + object = manifest[["input_files"]], + expected = list(csv_info) + ) + expect_identical( + object = manifest[["output_files"]], + expected = list(csv_info) + ) +}) + +test_that("create_manifest with works with vector file arguments", { + csv_file <- withr::local_tempfile(fileext = ".csv") + write.csv(mtcars, csv_file, row.names = FALSE) + csv_info <- list( + file_name = basename(csv_file), + file_extension = "csv", + file_path = csv_file, + file_size_human = format( + structure(as.integer(file.size(csv_file)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(csv_file)), + file_last_modified = format( + as.POSIXlt(file.mtime(csv_file), tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(file = csv_file, algo = "md5"), + summary_info = list( + nrow = nrow(mtcars), + colnames = colnames(mtcars), + class = "data.frame" + ) + ) + + rds_file <- withr::local_tempfile(fileext = ".rds") + saveRDS(mtcars, rds_file) + rds_info <- list( + file_name = basename(rds_file), + file_extension = "rds", + file_path = rds_file, + file_size_human = format( + structure(as.integer(file.size(rds_file)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(rds_file)), + file_last_modified = format( + as.POSIXlt(file.mtime(rds_file), tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(file = rds_file, algo = "md5"), + summary_info = list( + nrow = nrow(mtcars), + colnames = colnames(mtcars), + class = "data.frame" + ) + ) + + suppressWarnings({ + manifest <- create_manifest( + input_files = c(csv_file, rds_file), + output_files = c(csv_file, rds_file) + ) + }) + + expect_type(manifest, "list") + expect_named( + object = manifest, + expected = c( + "input_files", + "output_files", + "envirionment", + "manifest_creation_datetime" + ) + ) + expect_identical( + object = manifest[["input_files"]], + expected = list(csv_info, rds_info) + ) + expect_identical( + object = manifest[["output_files"]], + expected = list(csv_info, rds_info) + ) +}) + +test_that("create_manifest with works with named vector file arguments", { + csv_file <- withr::local_tempfile(fileext = ".csv") + write.csv(mtcars, csv_file, row.names = FALSE) + csv_info <- list( + file_name = basename(csv_file), + file_extension = "csv", + file_path = csv_file, + file_size_human = format( + structure(as.integer(file.size(csv_file)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(csv_file)), + file_last_modified = format( + as.POSIXlt(file.mtime(csv_file), tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(file = csv_file, algo = "md5"), + summary_info = list( + nrow = nrow(mtcars), + colnames = colnames(mtcars), + class = "data.frame" + ) + ) + + rds_file <- withr::local_tempfile(fileext = ".rds") + saveRDS(mtcars, rds_file) + rds_info <- list( + file_name = basename(rds_file), + file_extension = "rds", + file_path = rds_file, + file_size_human = format( + structure(as.integer(file.size(rds_file)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(rds_file)), + file_last_modified = format( + as.POSIXlt(file.mtime(rds_file), tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(file = rds_file, algo = "md5"), + summary_info = list( + nrow = nrow(mtcars), + colnames = colnames(mtcars), + class = "data.frame" + ) + ) + + suppressWarnings({ + manifest <- create_manifest( + input_files = c(foo = csv_file, bar = rds_file), + output_files = NULL + ) + }) + + expect_type(manifest, "list") + expect_named( + object = manifest, + expected = c( + "input_files", + "output_files", + "envirionment", + "manifest_creation_datetime" + ) + ) + expect_identical( + object = manifest[["input_files"]], + expected = list(foo = csv_info, bar = rds_info) + ) + expect_identical( + object = manifest[["output_files"]], + expected = list() + ) +}) + +test_that("create_manifest with works with named list file arguments", { + csv_file <- withr::local_tempfile(fileext = ".csv") + write.csv(mtcars, csv_file, row.names = FALSE) + csv_info <- list( + file_name = basename(csv_file), + file_extension = "csv", + file_path = csv_file, + file_size_human = format( + structure(as.integer(file.size(csv_file)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(csv_file)), + file_last_modified = format( + as.POSIXlt(file.mtime(csv_file), tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(file = csv_file, algo = "md5"), + summary_info = list( + nrow = nrow(mtcars), + colnames = colnames(mtcars), + class = "data.frame" + ) + ) + + rds_file <- withr::local_tempfile(fileext = ".rds") + saveRDS(mtcars, rds_file) + rds_info <- list( + file_name = basename(rds_file), + file_extension = "rds", + file_path = rds_file, + file_size_human = format( + structure(as.integer(file.size(rds_file)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(rds_file)), + file_last_modified = format( + as.POSIXlt(file.mtime(rds_file), tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(file = rds_file, algo = "md5"), + summary_info = list( + nrow = nrow(mtcars), + colnames = colnames(mtcars), + class = "data.frame" + ) + ) + + suppressWarnings({ + manifest <- create_manifest( + input_files = list(foo = csv_file, bar = rds_file), + output_files = NULL + ) + }) + + expect_type(manifest, "list") + expect_named( + object = manifest, + expected = c( + "input_files", + "output_files", + "envirionment", + "manifest_creation_datetime" + ) + ) + expect_identical( + object = manifest[["input_files"]], + expected = list(foo = csv_info, bar = rds_info) + ) + expect_identical( + object = manifest[["output_files"]], + expected = list() + ) +}) + +test_that("create_manifest works with simple ... arguments", { + suppressWarnings({ + manifest <- create_manifest( + input_files = NULL, + output_files = NULL, + params = list(foo = "bar") + ) + }) + expect_type(manifest, "list") + expect_named( + object = manifest, + expected = c( + "input_files", + "output_files", + "envirionment", + "manifest_creation_datetime", + "params" + ) + ) + expect_identical( + object = manifest[["params"]], + expected = list(foo = "bar") + ) +}) + +test_that("create_manifest works with nested ... arguments", { + suppressWarnings({ + manifest <- create_manifest( + input_files = NULL, + output_files = NULL, + params = list(foo = "bar"), + foo = list( + bar = list( + baz = seq(1L, 5L), + quux = 3.14159 + ), + grault = "garply" + ) + ) + }) + expect_type(manifest, "list") + expect_named( + object = manifest, + expected = c( + "input_files", + "output_files", + "envirionment", + "manifest_creation_datetime", + "params", + "foo" + ) + ) + expect_identical( + object = manifest[["params"]], + expected = list(foo = "bar") + ) + expect_identical( + object = manifest[["foo"]], + expected = list( + bar = list( + baz = seq(1L, 5L), + quux = 3.14159 + ), + grault = "garply" + ) + ) +}) + +test_that("create_manifest fails with unnamed ... arguments", { + expect_error( + object = create_manifest( + input_files = NULL, + output_files = NULL, + params = list(foo = "bar"), + "Hello" + ) + ) +}) + +test_that("create_manifest fails with unnamed in nesting of ... arguments", { + expect_error( + object = create_manifest( + input_files = NULL, + output_files = NULL, + params = list(foo = "bar"), + foo = list( + bar = list( + "Hello", + "world" + ) + ) + ) + ) +}) diff --git a/tests/testthat/test-export_manifest.R b/tests/testthat/test-export_manifest.R new file mode 100644 index 00000000..3a363428 --- /dev/null +++ b/tests/testthat/test-export_manifest.R @@ -0,0 +1,73 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +test_that("export_manifest with minimal arguments", { + manifest_file <- withr::local_tempfile(fileext = ".json") + suppressWarnings({ + manifest <- export_manifest( + manifest_path = manifest_file, + input_files = NULL, + output_files = NULL, + params = list() + ) + }) + + expect_true(file.exists(manifest_file)) + expect_gt(file.size(manifest_file), 0L) + manifest_content <- jsonlite::fromJSON(txt = manifest_file) + creation_time <- as.POSIXct(Sys.time(), tz = "UTC") + attr(creation_time, "tzone") <- "UTC" + expect_type(manifest_content, "list") + expect_named( + object = manifest_content, + expected = c( + "input_files", + "output_files", + "envirionment", + "manifest_creation_datetime", + "params" + ) + ) + expect_identical( + object = manifest_content[["input_files"]], + expected = list() + ) + expect_identical( + object = manifest_content[["output_files"]], + expected = list() + ) + expect_equal( + object = as.POSIXct( + manifest_content[["manifest_creation_datetime"]], + tz = "UTC" + ), + expected = creation_time, + tolerance = 1L + ) + expect_identical( + object = manifest_content[["params"]], + expected = list() + ) + # loaded packages can change during testthat testing + expected_environment_info <- suppressWarnings({ + get_manifest_envirionment_info() + }) + expected_environment_info[["packages"]][["loaded"]] <- list() + manifest_content[["envirionment"]][["packages"]][["loaded"]] <- list() + expect_identical( + object = manifest_content[["envirionment"]], + expected = expected_environment_info + ) +}) diff --git a/tests/testthat/test-get_environment.R b/tests/testthat/test-get_environment.R new file mode 100644 index 00000000..20ea5f4d --- /dev/null +++ b/tests/testthat/test-get_environment.R @@ -0,0 +1,58 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +test_that("get_r_session_info returns expected values", { + expect_identical( + get_r_session_info(), + 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 + ) + ) +}) + +test_that("get_environment_info returns expected structure", { + suppressWarnings({ # warnings from `load_all` are expected + env_info <- get_manifest_envirionment_info() + }) + expect_type(env_info, "list") + expect_named( + object = env_info, + expected = c("session", "packages") + ) + expect_named( + object = env_info[["session"]], + expected = c( + "R.version", + "platform", + "running", + "locale", + "tzone", + "libPaths" + ) + ) + expect_named( + object = env_info[["packages"]], + expected = c( + "base", + "attached", + "loaded" + ) + ) +}) diff --git a/tests/testthat/test-get_file_metadata.R b/tests/testthat/test-get_file_metadata.R new file mode 100644 index 00000000..2e883c71 --- /dev/null +++ b/tests/testthat/test-get_file_metadata.R @@ -0,0 +1,141 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +# setup +test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + +csv_file <- withr::local_tempfile(fileext = ".csv") +write.csv(mtcars, csv_file, row.names = FALSE) +Sys.setFileTime(csv_file, test_time) +csv_metadata <- list( + file_name = basename(csv_file), + file_extension = "csv", + file_path = csv_file, + file_size_human = format( + structure(as.integer(file.size(csv_file)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(csv_file)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(csv_file, algo = "md5", file = TRUE), + summary_info = list( + nrow = 32L, + colnames = colnames(mtcars), + class = "data.frame" + ) +) + +rds_file <- withr::local_tempfile(fileext = ".rds") +saveRDS(mtcars, rds_file) +Sys.setFileTime(rds_file, test_time) +rds_metadata <- list( + file_name = basename(rds_file), + file_extension = "rds", + file_path = rds_file, + file_size_human = format( + structure(as.integer(file.size(rds_file)), class = "object_size"),# nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(rds_file)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(rds_file, algo = "md5", file = TRUE), + summary_info = list( + nrow = 32L, + colnames = colnames(mtcars), + class = "data.frame" + ) +) + +# TESTS BEGIN +test_that("get_file_metadata processes single files correctly", { + metadata <- get_file_metadata(csv_file) + expect_identical( + metadata, + list( + csv_metadata + ) + ) +}) + +test_that("get_file_metadata processes a vector of files correctly", { + metadata <- get_file_metadata(c(csv_file, rds_file)) + expect_identical( + metadata, + list( + csv_metadata, + rds_metadata + ) + ) +}) + +test_that("get_file_metadata processes a list of files correctly", { + metadata <- get_file_metadata(list(csv_file, rds_file)) + expect_identical( + metadata, + list( + csv_metadata, + rds_metadata + ) + ) +}) + +test_that("get_file_metadata respects input order", { + metadata <- get_file_metadata(c(rds_file, csv_file)) + expect_identical( + metadata, + list( + rds_metadata, + csv_metadata + ) + ) +}) + +test_that("get_file_metadata returns an empty list on empty input", { + metadata <- get_file_metadata(list()) + expect_identical( + metadata, + list() + ) +}) + +test_that("get_file_metadata returns an empty list on NULL input", { + metadata <- get_file_metadata(NULL) + expect_identical( + metadata, + list() + ) +}) + +missing_file <- withr::local_tempfile(fileext = ".foo") +test_that("missing files raise an error", { + expect_error( + object = get_file_metadata(missing_file), + regexp = "File does not exist." + ) +}) + +test_that("get_single_file_metadata without argument raises an error", { + expect_error( + object = get_file_metadata() + ) +}) diff --git a/tests/testthat/test-get_git_info.R b/tests/testthat/test-get_git_info.R new file mode 100644 index 00000000..639d37e3 --- /dev/null +++ b/tests/testthat/test-get_git_info.R @@ -0,0 +1,332 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +# TESTS BEGIN +test_that("get_git_info processes non-git-repo correctly", { + test_dir <- withr::local_tempdir() + expect_warning( + object = { + metadata <- get_git_info(repo = test_dir) + }, + regexp = "^Specified path is not in a git repository.$" + ) + expect_null(metadata) +}) + +test_that("get_git_info processes fresh git repo correctly", { + test_dir <- withr::local_tempdir() + gert::git_init(path = test_dir) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = NULL, + clean = TRUE, + branch = NULL, + changed_files = list(), + tags = list() + ) + ) +}) + +test_that("get_git_info processes fresh git repo with new file correctly", { + test_dir <- withr::local_tempdir() + gert::git_init(path = test_dir) + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = NULL, + clean = FALSE, + branch = NULL, + changed_files = list( + foo.txt = "new" + ), + tags = list() + ) + ) +}) + +test_that("get_git_info processes git repo with a single commit correctly", { + test_dir <- withr::local_tempdir() + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_init(path = test_dir) + testing_git_config(repo = test_dir) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + commit_sha <- gert::git_commit(repo = test_dir, message = "Initial commit") + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = commit_sha, + clean = TRUE, + branch = list( + name = "master", + commit = commit_sha, + upstream = NULL, + remote_url = NULL, + up_to_date = NULL, + upstream_commit = NULL + ), + changed_files = list(), + tags = list() + ) + ) +}) + +test_that("get_git_info processes git repo with dirty index correctly", { + test_dir <- withr::local_tempdir() + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_init(path = test_dir) + testing_git_config(repo = test_dir) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + commit_sha <- gert::git_commit(repo = test_dir, message = "Initial commit") + writeLines("Hello, Testing!", con = test_file) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = commit_sha, + clean = FALSE, + branch = list( + name = "master", + commit = commit_sha, + upstream = NULL, + remote_url = NULL, + up_to_date = NULL, + upstream_commit = NULL + ), + changed_files = list( + foo.txt = "modified" + ), + tags = list() + ) + ) +}) + +test_that("get_git_info processes git repo with conflicts correctly", { + test_dir <- withr::local_tempdir() + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_init(path = test_dir) + testing_git_config(repo = test_dir) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + gert::git_commit(repo = test_dir, message = "Initial commit") + + gert::git_branch_create(repo = test_dir, branch = "feature") + writeLines("Hello, feature!", con = test_file) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + gert::git_commit(repo = test_dir, message = "Feature commit") + + gert::git_branch_checkout(repo = test_dir, branch = "master") + writeLines("Hello, Testing!", con = test_file) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + commit_sha <- gert::git_commit(repo = test_dir, message = "Master commit") + + suppressMessages( + gert::git_merge(repo = test_dir, ref = "feature") + ) + + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = commit_sha, + clean = FALSE, + branch = list( + name = "master", + commit = commit_sha, + upstream = NULL, + remote_url = NULL, + up_to_date = NULL, + upstream_commit = NULL + ), + changed_files = list( + foo.txt = "conflicted" + ), + tags = list() + + ) + ) +}) + +test_that("get_git_info processes git repo with tags correctly", { + test_dir <- withr::local_tempdir() + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_init(path = test_dir) + testing_git_config(repo = test_dir) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + commit_sha <- gert::git_commit(repo = test_dir, message = "Initial commit") + foo_sha <- gert::git_tag_create( + repo = test_dir, + name = "foo", + message = "foo", + ref = commit_sha + ) + bar_sha <- gert::git_tag_create( + repo = test_dir, + name = "bar", + message = "bar", + ref = commit_sha + ) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = commit_sha, + clean = TRUE, + branch = list( + name = "master", + commit = commit_sha, + upstream = NULL, + remote_url = NULL, + up_to_date = NULL, + upstream_commit = NULL + ), + changed_files = list(), + tags = list( + bar = list( + name = "bar", + commit = bar_sha, + points_to = commit_sha + ), + foo = list( + name = "foo", + commit = foo_sha, + points_to = commit_sha + ) + ) + ) + ) +}) + +test_that("get_git_info processes cloned git repo", { + testthat::skip_on_cran() + testthat::skip_if_offline() + test_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], #nolint: nonportable_path_linter + path = test_dir, + verbose = FALSE + ) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = remote_package[["sha"]], + clean = TRUE, + branch = list( + name = remote_package[["branch"]], + commit = remote_package[["sha"]], + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = TRUE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list(), + tags = list() + ) + ) +}) + +test_that("get_git_info processes cloned git repo with local dirty", { + testthat::skip_on_cran() + testthat::skip_if_offline() + test_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], #nolint: nonportable_path_linter + path = test_dir, + verbose = FALSE + ) + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = remote_package[["sha"]], + clean = FALSE, + branch = list( + name = remote_package[["branch"]], + commit = remote_package[["sha"]], + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = TRUE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list( + foo.txt = "new" + ), + tags = list() + ) + ) +}) + +test_that("get_git_info processes cloned git repo with local commit", { + testthat::skip_on_cran() + testthat::skip_if_offline() + test_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], #nolint: nonportable_path_linter + path = test_dir, + verbose = FALSE + ) + testing_git_config(repo = test_dir) + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + commit_sha <- gert::git_commit(repo = test_dir, message = "Initial commit") + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = commit_sha, + clean = TRUE, + branch = list( + name = remote_package[["branch"]], + commit = commit_sha, + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = FALSE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list(), + tags = list() + ) + ) +}) diff --git a/tests/testthat/test-get_individual_package_info.R b/tests/testthat/test-get_individual_package_info.R new file mode 100644 index 00000000..82a5b4db --- /dev/null +++ b/tests/testthat/test-get_individual_package_info.R @@ -0,0 +1,525 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +expect_package_info <- function( + package_info, + package_identical, + version_identical, + repository_match, + remotetype_identical, + remotepkgref_match, + remoteref_identical, + remotesha_identical, + built_null = FALSE, + loaded_with_pkgload_identical = FALSE, + git = NULL +) { + testthat::expect_type(package_info, "list") + testthat::expect_named( + package_info, + expected = c( + "package", + "version", + "loaded_with_pkgload", + "library", + "library_index", + "repository", + "platform", + "built", + "remotetype", + "remotepkgref", + "remoteref", + "remotesha", + "git" + ) + ) + testthat::expect_identical( + object = package_info[["package"]], + expected = package_identical + ) + testthat::expect_identical( + object = package_info[["version"]], + expected = version_identical + ) + testthat::expect_identical( + object = package_info[["loaded_with_pkgload"]], + expected = loaded_with_pkgload_identical + ) + + if (loaded_with_pkgload_identical) { + testthat::expect_null( + object = package_info[["library"]] + ) + testthat::expect_null( + object = package_info[["library_index"]] + ) + testthat::expect_null( + object = package_info[["platform"]] + ) + testthat::expect_null( + object = package_info[["library_index"]] + ) + } else { + testthat::expect_in( + object = package_info[["library"]], + .libPaths() # nolint: undesirable_function_linter + ) + testthat::expect_gt( + object = package_info[["library_index"]], + expected = 0L + ) + testthat::expect_lte( + object = package_info[["library_index"]], + expected = length(.libPaths()) # nolint: undesirable_function_linter + ) + testthat::expect_match( + object = package_info[["platform"]], + regexp = paste0(R.version[["platform"]], "|\\*") + ) + testthat::expect_type( + object = package_info[["library_index"]], + type = "integer" + ) + testthat::expect_identical( + object = package_info[["library"]], + expected = .libPaths()[package_info[["library_index"]]] # nolint: undesirable_function_linter + ) + } + + if (is.null(repository_match)) { + testthat::expect_null( + object = package_info[["repository"]] + ) + } else { + testthat::expect_match( + object = package_info[["repository"]], + regexp = repository_match + ) + } + if (built_null) { + testthat::expect_null( + object = package_info[["built"]] + ) + } else { + testthat::expect_false( + is.null(x = package_info[["built"]]) + ) + } + testthat::expect_identical( + object = package_info[["remotetype"]], + expected = remotetype_identical + ) + if (is.null(remotepkgref_match)) { + testthat::expect_null( + package_info[["remotepkgref"]] + ) + } else { + testthat::expect_match( + object = package_info[["remotepkgref"]], + # gsub is used to make windows path work + regexp = gsub( + x = remotepkgref_match, + pattern = "\\", + replacement = "\\\\", + fixed = TRUE + ) + ) + } + testthat::expect_identical( + object = package_info[["remoteref"]], + remoteref_identical + ) + testthat::expect_identical( + object = package_info[["remotesha"]], + remotesha_identical + ) + if (is.null(git)) { + testthat::expect_null( + object = package_info[["git"]] + ) + } else { + testthat::expect_identical( + object = package_info[["git"]], + expected = git + ) + } +} + +test_that("get_individual_package_info collects information for CRAN packages correctly", { #nolint: line_length_linter + expect_package_info( + package_info = get_individual_package_info("digest"), + package_identical = "digest", + version_identical = as.character(utils::packageVersion("digest")), + repository_match = "^(CRAN|RSPM)$", #GH Actions installs from RSPM, not CRAN + remotetype_identical = "standard", + remotepkgref_match = "^digest$", + remoteref_identical = "digest", + remotesha_identical = as.character(utils::packageVersion("digest")) + ) +}) + +test_that("get_individual_package_info collects information for base packages correctly", { #nolint: line_length_linter + expect_package_info( + package_info = get_individual_package_info("utils"), + package_identical = "utils", + version_identical = paste( + R.version[["major"]], + R.version[["minor"]], + sep = "." + ), + repository_match = NULL, #GH Actions installs from RSPM, not CRAN + remotetype_identical = NULL, + remotepkgref_match = NULL, + remoteref_identical = NULL, + remotesha_identical = NULL + ) +}) + +with_local_install <- function(new_lib, package, code) { + cache_dir <- withr::local_tempdir() + withr::local_envvar(.new = c(R_USER_CACHE_DIR = cache_dir)) + withr::local_libpaths(new_lib, action = "prefix") + testthat::capture_output( #make pak quiet + pak::pak(package, lib = normalizePath(new_lib)) + ) + eval(code) +} + +test_that("get_individual_package_info collects information for local packages correctly", { #nolint: line_length_linter + testthat::skip_on_cran() + testthat::skip_if_offline() + dest_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], + path = dest_dir, + verbose = FALSE + ) + new_lib <- normalizePath(withr::local_tempdir()) + with_local_install(new_lib, paste0("local::", dest_dir), { + package_info <- get_individual_package_info(remote_package[["name"]]) + expect_package_info( + package_info, + package_identical = remote_package[["name"]], + version_identical = remote_package[["version"]], + repository_match = NULL, + remotetype_identical = "local", + remotepkgref_match = paste0("^local::", dest_dir, "$"), + remoteref_identical = NULL, + remotesha_identical = NULL, + git = list( + repo = normalizePath(dest_dir), + is_git = TRUE, + commit = remote_package[["sha"]], + clean = TRUE, + branch = list( + name = remote_package[["branch"]], + commit = remote_package[["sha"]], + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = TRUE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list(), + tags = list() + ) + ) + expect_identical( + package_info[["library"]], + normalizePath(new_lib, winslash = "/") + ) + }) +}) + +test_that("get_individual_package_info collects information for GitHub packages correctly", { #nolint: line_length_linter + testthat::skip_on_cran() + testthat::skip_if_offline() + new_lib <- normalizePath(withr::local_tempdir()) + package_info <- with_local_install(new_lib, remote_package[["gh_repo"]], { + package_info <- get_individual_package_info(remote_package[["name"]]) + expect_package_info( + package_info, + package_identical = remote_package[["name"]], + version_identical = remote_package[["version"]], + repository_match = NULL, + remotetype_identical = "github", + remotepkgref_match = paste0("^", remote_package[["gh_repo"]], "$"), + remoteref_identical = "HEAD", + remotesha_identical = remote_package[["sha"]] + ) + expect_identical( + package_info[["library"]], + normalizePath(new_lib, winslash = "/") + ) + }) +}) + +test_that("get_individual_package_info collects information for packages loaded with pkgload correctly", { #nolint: line_length_linter + testthat::skip_on_cran() + testthat::skip_if_offline() + testthat::skip_if_not_installed("pkgload") + dest_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], + path = dest_dir, + verbose = FALSE + ) + loaded <- pkgload::load_all(dest_dir, quiet = TRUE) + withr::defer({ + pkgload::unload(package = remote_package[["name"]]) + }) + testthat::expect_warning( + object = { + package_info <- get_individual_package_info(remote_package[["name"]]) + expect_package_info( + package_info, + package_identical = remote_package[["name"]], + version_identical = paste("DEV", remote_package[["version"]]), + loaded_with_pkgload_identical = TRUE, + repository_match = NULL, + remotetype_identical = "pkgload", + remotepkgref_match = paste0("^", dest_dir, "$"), + remoteref_identical = NULL, + remotesha_identical = NULL, + built_null = TRUE, + git = list( + repo = normalizePath(dest_dir), + is_git = TRUE, + commit = remote_package[["sha"]], + clean = TRUE, + branch = list( + name = remote_package[["branch"]], + commit = remote_package[["sha"]], + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = TRUE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list(), + tags = list() + ) + ) + expect_identical( + package_info[["remotepkgref"]], + normalizePath(dest_dir) + ) + }, + "^Identifying development packages may not be accurate.$" + ) +}) + +test_that("get_individual_package_info collects information for packages loaded with devtools correctly", { #nolint: line_length_linter + testthat::skip_on_cran() + testthat::skip_if_offline() + testthat::skip_if_not_installed("devtools") + dest_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], + path = dest_dir, + verbose = FALSE + ) + loaded <- devtools::load_all(dest_dir, quiet = TRUE) + withr::defer({ + devtools::unload(package = remote_package[["name"]]) + }) + testthat::expect_warning( + object = { + package_info <- get_individual_package_info(remote_package[["name"]]) + expect_package_info( + package_info, + package_identical = remote_package[["name"]], + version_identical = paste("DEV", remote_package[["version"]]), + loaded_with_pkgload_identical = TRUE, + repository_match = NULL, + remotetype_identical = "pkgload", + remotepkgref_match = paste0("^", dest_dir, "$"), + remoteref_identical = NULL, + remotesha_identical = NULL, + built_null = TRUE, + git = list( + repo = normalizePath(dest_dir), + is_git = TRUE, + commit = remote_package[["sha"]], + clean = TRUE, + branch = list( + name = remote_package[["branch"]], + commit = remote_package[["sha"]], + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = TRUE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list(), + tags = list() + ) + ) + expect_identical( + package_info[["remotepkgref"]], + normalizePath(dest_dir) + ) + }, + "^Identifying development packages may not be accurate.$" + ) +}) + +test_that("get_individual_package_info collects information for altered packages loaded with devtools correctly", { #nolint: line_length_linter + testthat::skip_on_cran() + testthat::skip_if_offline() + testthat::skip_if_not_installed("devtools") + dest_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], + path = dest_dir, + verbose = FALSE + ) + testing_git_config(repo = dest_dir) + test_file <- file.path(dest_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_add(files = basename(test_file), repo = normalizePath(dest_dir)) + commit_sha <- gert::git_commit(repo = dest_dir, message = "Initial commit") + writeLines("Hello, testing!", con = test_file) + loaded <- devtools::load_all(dest_dir, quiet = TRUE) + withr::defer({ + devtools::unload(package = remote_package[["name"]]) + }) + testthat::expect_warning( + object = { + package_info <- get_individual_package_info(remote_package[["name"]]) + expect_package_info( + package_info, + package_identical = remote_package[["name"]], + version_identical = paste("DEV", remote_package[["version"]]), + loaded_with_pkgload_identical = TRUE, + repository_match = NULL, + remotetype_identical = "pkgload", + remotepkgref_match = paste0("^", dest_dir, "$"), + remoteref_identical = NULL, + remotesha_identical = NULL, + built_null = TRUE, + git = list( + repo = normalizePath(dest_dir), + is_git = TRUE, + commit = commit_sha, + clean = FALSE, + branch = list( + name = remote_package[["branch"]], + commit = commit_sha, + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = FALSE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list( + foo.txt = "modified" + ), + tags = list() + ) + ) + expect_identical( + package_info[["remotepkgref"]], + normalizePath(dest_dir) + ) + }, + "^Identifying development packages may not be accurate.$" + ) +}) + +test_that("get_individual_package_info errors for multiple packages", { + expect_error( + get_individual_package_info(c("digest", "jsonlite")) + ) +}) + +test_that("get_individual_package_info errors for package that doesn't exist", { + expect_error( + get_individual_package_info("this_package_does_not_exist") + ) +}) + +test_that("get_individual_package_info errors for empty string", { + expect_error( + get_individual_package_info("") + ) +}) + +test_that("get_individual_package_info errors for no arguments", { + expect_error( + get_individual_package_info(), + "^argument \"packagename\" is missing, with no default$" + ) +}) + +test_that("get_individual_package_info gets correct libpath and version of multiple installs", { #nolint: line_length_linter + testthat::skip_on_cran() + testthat::skip_if_offline() + new_lib <- normalizePath(withr::local_tempdir()) + newer_lib <- normalizePath(withr::local_tempdir()) + expect_warning( + with_local_install(new_lib, remote_package[["gh_repo"]], { + with_local_install(newer_lib, remote_package[["gh_repo_old"]], { + package_info <- get_individual_package_info(remote_package[["name"]]) + expect_package_info( + package_info, + package_identical = remote_package[["name"]], + version_identical = remote_package[["old_version"]], + repository_match = NULL, + remotetype_identical = "github", + remotepkgref_match = paste0( + "^", remote_package[["gh_repo_old"]], "$" + ), + remoteref_identical = "28c716f", + remotesha_identical = remote_package[["old_sha"]] + ) + expect_identical( + package_info[["library"]], + normalizePath(newer_lib, winslash = "/") + ) + expect_identical( + package_info[["library_index"]], + 1L + ) + }) + }) + ) +}) + +test_that("get_individual_package_info gets correct libpath for lower search priority", { #nolint: line_length_linter + testthat::skip_on_cran() + testthat::skip_if_offline() + new_lib <- normalizePath(withr::local_tempdir()) + newer_lib <- normalizePath(withr::local_tempdir()) + with_local_install(new_lib, remote_package[["gh_repo"]], { + with_local_install(newer_lib, "yihui/rmini", { # nolint: nonportable_path_linter + package_info <- get_individual_package_info(remote_package[["name"]]) + expect_package_info( + package_info, + package_identical = remote_package[["name"]], + version_identical = remote_package[["version"]], + repository_match = NULL, + remotetype_identical = "github", + remotepkgref_match = paste0("^", remote_package[["gh_repo"]], "$"), + remoteref_identical = "HEAD", + remotesha_identical = remote_package[["sha"]] + ) + expect_identical( + package_info[["library"]], + normalizePath(new_lib, winslash = "/") + ) + expect_identical( + package_info[["library_index"]], + 2L + ) + }) + }) +}) diff --git a/tests/testthat/test-get_package_info.R b/tests/testthat/test-get_package_info.R new file mode 100644 index 00000000..acf13991 --- /dev/null +++ b/tests/testthat/test-get_package_info.R @@ -0,0 +1,238 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +expect_warning_if_any_pkgload <- function(object, regexp) { + attached_pkgs <- names(utils::sessionInfo()[["otherPkgs"]]) + has_pkgload <- any( + vapply( + X = attached_pkgs, + FUN = pkgload::is_dev_package, + FUN.VALUE = logical(1L) + ) + ) + if (has_pkgload) { + testthat::expect_warning(object = object, regexp = regexp) + } else { + # note not using testthat::expect_no_warning(object = object), since there + # are often warnings on CI systems about multiple installations of the + # tested package + object + } +} + +test_that("get_package_info outputs correct structure for defaults", { + testthat::skip_if(covr::in_covr()) + expect_warning_if_any_pkgload( + object = { + package_info <- get_package_info() + expect_named( + object = package_info, + expected = c("base", "attached", "loaded") + ) + expect_named( + object = package_info[["base"]], + expected = utils::sessionInfo()[["basePkgs"]] + ) + expect_named( + object = package_info[["attached"]], + expected = names(utils::sessionInfo()[["otherPkgs"]]) + ) + expect_named( + object = package_info[["loaded"]], + expected = names(utils::sessionInfo()[["loadedOnly"]]) + ) + # Check that the structure of the package_info is correct + expect_true( + object = all( + vapply( + X = package_info, + FUN = function(x) { + all( + vapply( + X = x, + FUN = function(x) { + all( + names(x) == c( + "package", + "version", + "loaded_with_pkgload", + "library", + "library_index", + "repository", + "platform", + "built", + "remotetype", + "remotepkgref", + "remoteref", + "remotesha", + "git" + ) + ) + }, + FUN.VALUE = logical(1L) + ) + ) + }, + FUN.VALUE = logical(1L) + ) + ) + ) + }, + "^Identifying development packages may not be accurate.$" + ) +}) + +test_that("get_package_info outputs expected value for single package", { + package_info <- get_package_info("digest") + expect_identical( + package_info, + list( + digest = get_individual_package_info("digest") + ) + ) +}) + +test_that("get_package_info outputs expected value for simple vector", { + package_info <- get_package_info(c("digest", "utils")) + expect_identical( + package_info, + list( + digest = get_individual_package_info("digest"), + utils = get_individual_package_info("utils") + ) + ) +}) + +test_that("get_package_info outputs expected value for named vector", { + package_info <- get_package_info(c(foo = "digest", bar = "utils")) + expect_identical( + package_info, + list( + foo = get_individual_package_info("digest"), + bar = get_individual_package_info("utils") + ) + ) +}) + +test_that("get_package_info outputs unamed list for unnamed list input", { + package_info <- get_package_info(list("digest", "utils")) + expect_identical( + package_info, + list( + list(digest = get_individual_package_info("digest")), + list(utils = get_individual_package_info("utils")) + ) + ) +}) + +test_that("get_package_info outputs expected value for simple named list", { + package_info <- get_package_info(list(foo = "digest", bar = "utils")) + expect_identical( + package_info, + list( + foo = list(digest = get_individual_package_info("digest")), + bar = list(utils = get_individual_package_info("utils")) + ) + ) +}) + +test_that("get_package_info outputs expected value for list with mixed nesting", { #nolint: line_length_linter + package_info <- get_package_info( + list( + foo = list(list("digest")), + bar = list("digest"), + baz = "utils" + ) + ) + expect_identical( + package_info, + list( + foo = list(list(list(digest = get_individual_package_info("digest")))), + bar = list(list(digest = get_individual_package_info("digest"))), + baz = list(utils = get_individual_package_info("utils")) + ) + ) +}) + +empty_named_list <- list() +names(empty_named_list) <- character(0L) + +test_that("get_package_info with empty character args returns empty named lists", { #nolint: line_length_linter + expect_identical( + object = get_package_info(list( + base = character(), + attached = character(), + loaded = character() + )), + expected = list( + base = empty_named_list, + attached = empty_named_list, + loaded = empty_named_list + ) + ) +}) + +test_that("get_package_info with empty args returns empty lists", { + expect_identical( + object = get_package_info(list( + base = c(), # nolint: unnecessary_concatenation_linter + attached = c(), # nolint: unnecessary_concatenation_linter + loaded = c() # nolint: unnecessary_concatenation_linter + )), + expected = list( + base = list(), + attached = list(), + loaded = list() + ) + ) +}) + +test_that("get_package_info with NULL args returns empty lists", { + expect_identical( + object = get_package_info(list( + base = NULL, + attached = NULL, + loaded = NULL + )), + expected = list( + base = list(), + attached = list(), + loaded = list() + ) + ) +}) + +test_that("get_package_info respects order", { + digest_info <- get_individual_package_info("digest") + utils_info <- get_individual_package_info("utils") + expect_identical( + object = get_package_info( + list( + base = c("digest", "utils"), + attached = c("utils", "digest") + ) + ), + expected = list( + base = list( + digest = digest_info, + utils = utils_info + ), + attached = list( + utils = utils_info, + digest = digest_info + ) + ) + ) +}) diff --git a/tests/testthat/test-get_single_file_metadata.R b/tests/testthat/test-get_single_file_metadata.R new file mode 100644 index 00000000..df37412d --- /dev/null +++ b/tests/testthat/test-get_single_file_metadata.R @@ -0,0 +1,379 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +test_that("get_single_file_metadata processes CSV tables correctly", { + testfile <- withr::local_tempfile(fileext = ".csv") + write.csv(mtcars, testfile, row.names = FALSE) + test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + Sys.setFileTime(testfile, test_time) + metadata <- get_single_file_metadata(testfile) + expect_identical( + metadata, + list( + file_name = basename(testfile), + file_extension = "csv", + file_path = testfile, + file_size_human = format( + structure(as.integer(file.size(testfile)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(testfile)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(testfile, algo = "md5", file = TRUE), + summary_info = list( + nrow = 32L, + colnames = colnames(mtcars), + class = "data.frame" + ) + ) + ) +}) + +test_that("get_single_file_metadata processes RDS tables correctly", { + testfile <- withr::local_tempfile(fileext = ".rds") + saveRDS(mtcars, testfile) + test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + Sys.setFileTime(testfile, test_time) + metadata <- get_single_file_metadata(testfile) + expect_identical( + metadata, + list( + file_name = basename(testfile), + file_extension = "rds", + file_path = testfile, + file_size_human = format( + structure(as.integer(file.size(testfile)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(testfile)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(testfile, algo = "md5", file = TRUE), + summary_info = list( + nrow = 32L, + colnames = colnames(mtcars), + class = "data.frame" + ) + ) + ) +}) + +test_that("get_single_file_metadata processes RDS non-tables correctly", { + testfile <- withr::local_tempfile(fileext = ".rds") + saveRDS("This is a string", testfile) + test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + Sys.setFileTime(testfile, test_time) + metadata <- get_single_file_metadata(testfile) + expect_identical( + metadata, + list( + file_name = basename(testfile), + file_extension = "rds", + file_path = testfile, + file_size_human = format( + structure(as.integer(file.size(testfile)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(testfile)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(testfile, algo = "md5", file = TRUE), + summary_info = list( + class = "character" + ) + ) + ) +}) + +test_that("get_single_file_metadata processes txt files correctly", { + testfile <- withr::local_tempfile(fileext = ".txt") + writeLines("This is a string", testfile) + test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + Sys.setFileTime(testfile, test_time) + metadata <- get_single_file_metadata(testfile) + expect_identical( + metadata, + list( + file_name = basename(testfile), + file_extension = "txt", + file_path = testfile, + file_size_human = format( + structure(as.integer(file.size(testfile)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(testfile)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(testfile, algo = "md5", file = TRUE) + # No summary info + ) + ) +}) + +test_that("get_single_file_metadata processes lists RDS correctly", { + testfile <- withr::local_tempfile(fileext = ".rds") + test_list <- list( + a = 1L, + b = "two", + c = list( + d = 3.4, + e = "four" + ) + ) + saveRDS(test_list, testfile) + test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + Sys.setFileTime(testfile, test_time) + metadata <- get_single_file_metadata(testfile) + expect_identical( + metadata, + list( + file_name = basename(testfile), + file_extension = "rds", + file_path = testfile, + file_size_human = format( + structure(as.integer(file.size(testfile)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(testfile)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(testfile, algo = "md5", file = TRUE), + summary_info = list( + length = 3L, + names = c("a", "b", "c"), + class = "list" + ) + ) + ) +}) + +test_that("get_single_file_metadata processes named JSON list correctly", { + testfile <- withr::local_tempfile(fileext = ".JSON") + test_list <- list( + a = 1L, + b = "two", + c = list( + d = 3.4, + e = "four" + ) + ) + jsonlite::write_json(test_list, testfile, auto_unbox = TRUE) + test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + Sys.setFileTime(testfile, test_time) + metadata <- get_single_file_metadata(testfile) + expect_identical( + metadata, + list( + file_name = basename(testfile), + file_extension = "JSON", + file_path = testfile, + file_size_human = format( + structure(as.integer(file.size(testfile)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(testfile)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(testfile, algo = "md5", file = TRUE), + summary_info = list( + length = 3L, + names = c("a", "b", "c"), + class = "list" + ) + ) + ) +}) + +test_that("get_single_file_metadata processes unnamed JSON list correctly", { + testfile <- withr::local_tempfile(fileext = ".JSON") + test_list <- list( + 1L, + "two", + list( + d = 3.4, + e = "four" + ) + ) + jsonlite::write_json(test_list, testfile, auto_unbox = TRUE) + test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + Sys.setFileTime(testfile, test_time) + metadata <- get_single_file_metadata(testfile) + expect_identical( + metadata, + list( + file_name = basename(testfile), + file_extension = "JSON", + file_path = testfile, + file_size_human = format( + structure(as.integer(file.size(testfile)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(testfile)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(testfile, algo = "md5", file = TRUE), + summary_info = list( + length = 3L, + names = NULL, + class = "list" + ) + ) + ) +}) + +test_that("get_single_file_metadata processes partially named JSON", { + testfile <- withr::local_tempfile(fileext = ".JSON") + test_list <- list( + 1L, + b = "two", + list( + d = 3.4, + e = "four" + ) + ) + jsonlite::write_json(test_list, testfile, auto_unbox = TRUE) + test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + Sys.setFileTime(testfile, test_time) + metadata <- get_single_file_metadata(testfile) + expect_identical( + metadata, + list( + file_name = basename(testfile), + file_extension = "JSON", + file_path = testfile, + file_size_human = format( + structure(as.integer(file.size(testfile)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(testfile)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(testfile, algo = "md5", file = TRUE), + summary_info = list( + length = 3L, + names = c("1", "b", "3"), + class = "list" + ) + ) + ) +}) + +test_that("get_single_file_metadata processes JSON table correctly", { + testfile <- withr::local_tempfile(fileext = ".JSON") + jsonlite::write_json(mtcars, testfile, auto_unbox = TRUE) + test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + Sys.setFileTime(testfile, test_time) + metadata <- get_single_file_metadata(testfile) + expect_identical( + metadata, + list( + file_name = basename(testfile), + file_extension = "JSON", + file_path = testfile, + file_size_human = format( + structure(as.integer(file.size(testfile)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(testfile)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(testfile, algo = "md5", file = TRUE), + summary_info = list( + nrow = 32L, + colnames = colnames(mtcars), + class = "data.frame" + ) + ) + ) +}) + +test_that("get_single_file_metadata processes empty files correctly", { + testfile <- withr::local_tempfile(fileext = ".gitkeep") + file.create(testfile) + test_time <- as.POSIXct("2020-01-01T12:34:56+00:00") + Sys.setFileTime(testfile, test_time) + metadata <- get_single_file_metadata(testfile) + expect_identical( + metadata, + list( + file_name = basename(testfile), + file_extension = "gitkeep", + file_path = testfile, + file_size_human = format( + structure(as.integer(file.size(testfile)), class = "object_size"), # nolint: undesirable_function_linter + units = "auto", + standard = "SI" + ), + file_size = as.integer(file.size(testfile)), + file_last_modified = format( + as.POSIXlt(test_time, tz = "UTC"), + "%Y-%m-%dT%H:%M:%S+00:00" + ), + file_md5 = digest::digest(testfile, algo = "md5", file = TRUE) + # No summary info + ) + ) +}) + +test_that("missing files raise an error", { + missing_file <- withr::local_tempfile(fileext = ".csv") + expect_error( + object = get_single_file_metadata(missing_file), + regexp = "File does not exist." + ) +}) + +test_that("get_single_file_metadata without argument raises an error", { + expect_error( + object = get_single_file_metadata() + ) +}) + +test_that("get_single_file_metadata with multiple files raises an error", { + first_file <- withr::local_tempfile(fileext = ".csv") + second_file <- withr::local_tempfile(fileext = ".csv") + expect_error( + object = get_single_file_metadata(c(first_file, second_file)), + regexp = "Only one file path can be passed to get_single_file_metadata." + ) +}) diff --git a/tests/testthat/test-is_git_path.R b/tests/testthat/test-is_git_path.R new file mode 100644 index 00000000..eabff57d --- /dev/null +++ b/tests/testthat/test-is_git_path.R @@ -0,0 +1,59 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +# # TESTS BEGIN +test_that("is_git_path processes non-existing directory correctly", { + test_dir <- withr::local_tempdir() + test_dir_child <- file.path(test_dir, "child") + expect_error( + object = is_git_path(path = test_dir_child), + regexp = "^Cannot find git information for path which does not exist.$" + ) +}) + +test_that("is_git_path processes non-existing file correctly", { + test_dir <- withr::local_tempdir() + test_file <- withr::local_tempfile(tmpdir = test_dir, fileext = ".rds") + expect_error( + object = is_git_path(path = test_file), + regexp = "^Cannot find git information for path which does not exist.$" + ) +}) + +test_that("is_git_path processes non-git-repo correctly", { + test_dir <- withr::local_tempdir() + expect_false(is_git_path(path = test_dir)) +}) + +test_that("is_git_path processes file in non-git-repo correctly", { + test_dir <- withr::local_tempdir() + test_file <- withr::local_tempfile(tmpdir = test_dir, fileext = ".rds") + saveRDS(mtcars, test_file) + expect_false(is_git_path(path = test_file)) +}) + +test_that("is_git_path processes git-repo correctly", { + test_dir <- withr::local_tempdir() + gert::git_init(path = test_dir) + expect_true(is_git_path(path = test_dir)) +}) + +test_that("is_git_path processes file in git-repo correctly", { + test_dir <- withr::local_tempdir() + gert::git_init(path = test_dir) + test_file <- withr::local_tempfile(tmpdir = test_dir, fileext = ".rds") + saveRDS(mtcars, test_file) + expect_true(is_git_path(path = test_file)) +})