R/package_tracking.R

In Capsule: Comprehensive Reproducibility Framework for R and Bioinformatics Analysis

#' Track Package Versions and Dependencies
#'
#' @description
#' Creates a comprehensive snapshot of all installed packages, their versions,
#' dependencies, and sources for reproducibility.
#'
#' @param output_file Character. Path to save package info. If NULL, returns as list.
#' @param include_dependencies Logical. Include dependency tree. Default TRUE.
#' @param only_attached Logical. Only track attached packages. Default FALSE.
#'
#' @return A list containing package information
#'
#' @importFrom utils sessionInfo packageDescription
#' @export
#'
#' @examples
#' \dontrun{
#' # Track all installed packages
#' snapshot_packages("package_manifest.json")
#'
#' # Track only attached packages
#' snapshot_packages("packages.json", only_attached = TRUE)
#' }
snapshot_packages <- function(output_file = NULL, include_dependencies = TRUE,
                              only_attached = FALSE) {
  if (only_attached) {
    # Get only attached packages
    pkg_names <- names(sessionInfo()$otherPkgs)
  } else {
    # Get all available packages from all library paths
    pkg_names <- unique(unlist(lapply(.libPaths(), function(lib) {
      list.files(lib)
    })))
  }

  # Filter to only valid R packages
  pkg_names <- pkg_names[sapply(pkg_names, function(pkg) {
    !is.null(tryCatch(find.package(pkg, quiet = TRUE), error = function(e) NULL))
  })]

  packages_info <- list(
    timestamp = Sys.time(),
    r_version = R.version.string,
    n_packages = length(pkg_names),
    packages = lapply(pkg_names, function(pkg_name) {
      desc <- utils::packageDescription(pkg_name, fields = NULL)

      if (is.list(desc)) {
        info <- list(
          package = pkg_name,
          version = as.character(desc$Version),
          priority = as.character(desc$Priority),
          depends = .parse_deps(desc$Depends),
          imports = .parse_deps(desc$Imports),
          suggests = .parse_deps(desc$Suggests),
          built = as.character(desc$Built),
          repository = as.character(desc$Repository),
          license = as.character(desc$License),
          needs_compilation = as.character(desc$NeedsCompilation),
          lib_path = dirname(attr(desc, "file"))
        )

        # Add source information if available
        if (!is.null(desc$Repository) && !is.na(desc$Repository) && desc$Repository != "") {
          info$source <- list(
            type = "CRAN",
            repository = as.character(desc$Repository)
          )
        }

        info
      } else {
        NULL
      }
    })
  )

  # Remove NULL entries
  packages_info$packages <- Filter(Negate(is.null), packages_info$packages)
  names(packages_info$packages) <- sapply(packages_info$packages, function(x) x$package)

  # Add dependency graph if requested
  if (include_dependencies) {
    packages_info$dependency_graph <- .build_dependency_graph(pkg_names)
  }

  # Save if output file specified
  if (!is.null(output_file)) {
    dir.create(dirname(output_file), recursive = TRUE, showWarnings = FALSE)
    jsonlite::write_json(packages_info, output_file, auto_unbox = TRUE, pretty = TRUE)
    cli::cli_alert_success("Package manifest saved to {.file {output_file}}")
  }

  invisible(packages_info)
}


#' Parse Package Dependencies
#'
#' @description
#' Internal function to parse package dependency strings
#'
#' @param dep_string Character. Dependency string from package description
#'
#' @return Character vector of package names
#' @keywords internal
.parse_deps <- function(dep_string) {
  if (is.null(dep_string) || is.na(dep_string) || dep_string == "") {
    return(character(0))
  }

  # Remove version specifications
  deps <- strsplit(dep_string, ",")[[1]]
  deps <- trimws(deps)
  deps <- gsub("\\s*\\(.*?\\)", "", deps)

  # Remove R itself
  deps <- deps[deps != "R"]

  deps
}


#' Build Dependency Graph
#'
#' @description
#' Internal function to build a dependency graph for packages
#'
#' @param packages Character vector of package names
#'
#' @return List representing dependency relationships
#' @keywords internal
.build_dependency_graph <- function(packages) {
  graph <- list()

  for (pkg in packages) {
    desc <- utils::packageDescription(pkg)
    if (is.list(desc)) {
      deps <- unique(c(
        .parse_deps(desc$Depends),
        .parse_deps(desc$Imports)
      ))
      graph[[pkg]] <- deps
    }
  }

  graph
}


#' Create renv Lockfile
#'
#' @description
#' Generate an renv-compatible lockfile for package reproducibility
#'
#' @param output_file Character. Path to save lockfile (required).
#' @param project_path Character. Path to project. Default is current directory.
#'
#' @return Path to created lockfile
#'
#' @export
#'
#' @examples
#' \dontrun{
#' create_renv_lockfile(output_file = tempfile(fileext = ".lock"))
#' }
create_renv_lockfile <- function(output_file, project_path = ".") {
  if (!requireNamespace("renv", quietly = TRUE)) {
    cli::cli_alert_danger("renv package is required but not installed.")
    cli::cli_alert_info("Please install it with: install.packages('renv')")
    return(invisible(NULL))
  }

  # Initialize renv in temp directory to avoid affecting current project
  old_wd <- getwd()
  on.exit(setwd(old_wd))

  # Create snapshot
  tryCatch(
    {
      renv::snapshot(lockfile = output_file, prompt = FALSE)
      cli::cli_alert_success("renv lockfile created at {.file {output_file}}")
    },
    error = function(e) {
      cli::cli_alert_danger("Failed to create renv lockfile: {e$message}")
    }
  )

  invisible(output_file)
}