R/VC_library_writing.R

Defines functions lib.dependsOnMe lib.installed_packages lib.packs_vec2str lib.dependencies detachAll lib.convert lib.install_tarball with_build_tools lib.install_if_not_compatible lib.install

Documented in detachAll lib.convert lib.dependencies lib.dependsOnMe lib.install lib.installed_packages lib.install_if_not_compatible lib.install_tarball lib.packs_vec2str

# =================================================================
#     multiversion, multi-version package library management tool
#     Copyright (C) 2019 S.C. Frouws, The Hague, The Netherlands
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
# =================================================================


# ============== MAIN FUNCTIONALITY ==============

# -------------- install.packages --------------
#' Install packages and tarballs into R_MV_library
#'
#' @description
#'
#' This family of functions can help with installing packages without
#' the risk of installing every minor package improvement as soon as it is released.
#'
#' \enumerate{
#'   \item{\code{lib.install_tarball} can install a tarball based on the
#'   tarball location and it's dependencies (like \code{c(dplyr = '> 5.0')}).}
#'   \item{\code{lib.install_if_not_compatible} can install CRAN package
#'   depending on a condition. This is especially useful
#'   (and used on the background) for installing the dependencies for the
#'   tarball installation.}
#'   \item{\code{lib.install} can install CRAN packages into the R_MV_library,
#'   which in return is used by \code{lib.install_if_not_compatible}.}
#' }
#'
#' @param tarball The complete path to the tarball file that you would like to install.
#' @param package_conditions Provide a vector of package
#' name/'version condition' specifications. See section
#' 'limitations for \code{package_conditions}'.
#' @param package_names Provide a vector of package names.
#' A version cannot be supplied.
#' @param dependencies Provide the dependencies like a package version
#' combination: \code{c(dplyr = '>= 0.5', data.table = '', R6 = '0.1.1')}.
#' Note that all dependencies must refer to packages on CRAN. Otherwise install
#' the dependency manually somewhere and use \code{lib.convert} to include it.
#'
#' @param quiet Will affect \code{install.packages(..., quiet = quiet)}.
#' @param lib_location The folder where this package can be installed.
#' The package will first be installed in a temporary install folder
#' \code{<multiversion lib>/TEMP_install_location}
#' indicated by the \code{\link{lib.location_install_dir}()} function.
#' If \code{install_temporarily} is set to FALSE (the default),
#' the installed package(s) is moved to the lib_location automatically.
#' @param install_temporarily If FALSE, the installed packages are moved
#' to the R_MV_library, specified by the \code{lib_location} argument, automatically.
#' Otherwise it is necessary to run \code{\link{lib.convert}()} manually after
#' the installation into the temporary folder finished. When multiple tarballs
#' are provided, this is set to \code{FALSE} with no warning.
#' @param cran_url Will be passed trough to the install.packages command.
#' @param allow_overwrite_on_convert Can be used if you are experimenting and
#' you would like to overwrite the installed (tarball) package.
#' Only makes sense with \code{install_temporarily} on \code{FALSE}. See details below.
#'
#' @note To clean up the installation directory, run \code{lib.clean_install_dir()}.
#'
#' @section limitations for \code{package_conditions}:
#' All version specifications are allowed except for the exact version indication
#' (e.g. don't provide \code{c(dplyr = '1.2.3')}). It is allowed to provide no
#' specification, which will match any installed version of that package.
#' \bold{If the condition is met, the package is skipped}, which is the desired
#' behavior for dependencies. For an empty condition (e.g. \code{c(dplyr = '')}),
#' it will only install the package when no version is installed at all.
#'
#' @section Allow overwrite on convert:
#' When an installed package is converted to the R_MV_library, it would normally
#' show that it failed to copy the packages of which that version was already present.
#' This means that these packages were already converted from the temporary library
#' to the R_MV_library structure before, and no \code{lib.clean_install_dir()} was performed yet.
#' In case you are experimenting with a self made tarball package, and you are
#' developing the package within the same package version,
#' it is some times desired to overwrite the already present installed package with a new installation.
#' For CRAN packages, this options doesn't make sense.\cr\cr
#' Only for \code{lib.install_tarball}, the options \code{TRUE}, \code{FALSE}, and additionally
#' \code{"tarball"} \code{"dependencies"} are allowed. 'dependencies' will affect
#' all packages that are in the temporary installation location except for the tarball package.
#' 'tarball' will only overwrite the tarball package.
#'
#' @section Installing temporarily:
#' Installing a package temporarily gives you the opportunity to test the package
#' before adding it to the multiversion library structure. Loading packages, including those in the
#' temporary library (\code{\link{lib.location_install_dir}()}) can be done using:
#' \code{\link{lib.load}(..., also_load_from_temp_lib = TRUE)}.
#'
#' @name lib.install
NULL

#' @rdname lib.install
#' @importFrom utils install.packages
#' @export
#'
lib.install <- function(package_names = NULL, lib_location = lib.location(), install_temporarily = FALSE,
                        allow_overwrite_on_convert = FALSE, quiet = TRUE, cran_url = "http://cran.us.r-project.org") {

    if (!is.null(names(package_names))) {
        stop('Please provide a vector of names, not a vector like c(name = "1.0.0").')
    }
    if (length(package_names) == 0) {
        return(invisible())
    }

    # If executing using Rscript, this block is run and calls an R script which will run all except this block.
    # if (execute_with_Rscript) {
    #     temp_install_dir <- lib.location_install_dir()
    #     curr_packs <- list.dirs(temp_install_dir, full.names = F, recursive = F)
    #
    #     Rscript_dir <- normPath(system('where Rscript', intern = T)[1])
    #
    #     if (grepl('Could not find files for the given pattern(s)', Rscript_dir)) {
    #         stop('Please make sure `where Rscript` results in one or more valid paths. First one is used.')
    #     }
    #
    #     multiversion_location <- lib.my_location()
    #     script_location <- normPath(paste0(multiversion_location, '/exec/lib.install_script.R'))
    #
    #     status <- system(sprintf('"%s" --vanilla "%s" "%s" "%s" "%s" "%s" "%s"', Rscript_dir, script_location, lib_location, paste(collapse = ',', package_names), multiversion_location, as.character(allow_overwrite_on_convert), as.character(verbose)))
    #
    #     new_packs <- list.dirs(temp_install_dir, full.names = F, recursive = F)
    #     added_packages <- setdiff(new_packs, curr_packs)
    #
    #     message(sprintf('>> Installation attempt finished with status %s, added were: %s <<\n', as.character(status), paste(collapse = ', ', added_packages)))
    #     if (!install_temporarily & status == 0) {
    #         lib.convert(lib_location        = lib_location,
    #                     force_overwrite     = allow_overwrite_on_convert,
    #                     packages_to_convert = added_packages)
    #     }
    #     return(invisible())
    # }

    install.location <- normPath(lib.location_install_dir(lib_location))

    # loaded packages
    # nms <- names(sessionInfo()$otherPkgs)
    # currentlyLoaded <- detachAll(packageList = nms[!nms %in% c('RVClibrary', 'multiversion')])

    # The following should only be executed once.
    # if (sum(grepl('^lib.install', sapply(sys.calls(), function(x) {x[[1]]}))) <= 1) {
    #     if (!nzchar(Sys.which('make'))) {
    #         stop(paste('Please make sure the `make.exe` application of `Rtools` can be',
    #                    '\nfound so that packages can be compiled from source if necessary!',
    #                    '\nAdd e.g. `C:/Rtools/bin` to the PATH env var if you have the program already installed',
    #                    '\nor download Rtools (and check `Add paths` during install, and restart R) from "https://cran.r-project.org/bin/windows/Rtools/".'))
    #     }
    #     # Just took some
    #     if (any(!nzchar(Sys.which(c('aspell', 'basename', 'cat', 'cp'))))) {
    #         stop(sprintf(paste('%sAdd e.g. `C:/Rtools/bin` to the PATH env var if you have Rtools already installed',
    #                            '\nor download Rtools (and check `Add paths` during install, and restart R) from "https://cran.r-project.org/bin/windows/Rtools/".'),
    #                      ifelse(nzchar(Sys.getenv('MAKE')), '',
    #                             'The MAKE variable is specified, but this is not sufficient for an Rscript instance to compile from source properly. ')))
    #     }
    #     if (!grepl('\\$\\(WIN\\)', Sys.getenv('BINPREF'))) {
    #         stop(sprintf(paste0('Please make sure you also have the BINPREF environment variable set properly.',
    #                             '\nCurrent value: "%s", expected value should be like: "C:/Rtools/mingw_$(WIN)/bin/",',
    #                             '\nwhere "$(WIN)" is set by R to either "32" or "64" depending on the target.',
    #                             '\nIf your PATH and BINPREF variables are set correctly, we should be ready',
    #                             '\nfor compiling from source (being able to install the latest pacakges).'), Sys.getenv('BINPREF')))
    #     }
    #
    #     if (interactive()) {
    #         on.exit({
    #             message('\nResetting your loaded packages.')
    #             invisible(lib.load(loadPackages = currentlyLoaded, lib_location = lib_location, quietly = TRUE))
    #         }, add = TRUE)
    #     }
    #     prev_setting <- getOption("install.packages.compile.from.source")
    #     options(install.packages.compile.from.source = "always")
    #
    #     # library paths
    #     currentLibs <- .libPaths()
    #     .libPaths(.Library)
    #
    #     on.exit({
    #         options(install.packages.compile.from.source = prev_setting)
    #         .libPaths(currentLibs)
    #     }, add = TRUE)
    # }

    currentLibs <- lib.set_libPaths('all', lib_location, additional_lib_paths = install.location)
    on.exit(.libPaths(currentLibs), add = TRUE, after = FALSE)


    # loop through packages to install
    for (iPackage in package_names) {

        # dependsOn <- lib.dependencies_online(iPackage, cran_url = cran_url)
        #
        # # try loading dependencies, so that they're skipped during installation.
        # successfulLoads <- lib.testload(dependsOn, lib_location, pick.last = TRUE, msg_str = paste0('"', iPackage, '" his dependencies'), verbose = verbose)
        #
        # failedLoads <- !names(dependsOn) %in% names(successfulLoads) & !lib.is_basepackage(names(dependsOn))
        # failedLoads <- names(dependsOn)[failedLoads]
        #
        # if (length(failedLoads) > 0) {
        #     message(sprintf('\n - We will install for package "%s" the missing dependencies: %s.\n',
        #                     iPackage, paste0(collapse = ',', '"', failedLoads, '"')))
        #
        #     lib.install(package_names = failedLoads, lib_location = lib_location, install_temporarily = TRUE, execute_with_Rscript = execute_with_Rscript, verbose = verbose)
        #
        #     # When dependencies have been installed, try loading them again to create a more complete list of available
        #     successfulLoads <- lib.testload(dependsOn, lib_location, pick.last = TRUE, verbose = verbose)
        # }
        #
        #
        # # If all dependencies were already there, check if the package is already installed.
        # # When overwriting this package (or installing the latest version) we are not interested in knowing if the package already exists.
        # if (!allow_overwrite_on_convert && all(names(dependsOn) %in% names(successfulLoads) | lib.is_basepackage(names(dependsOn)))) {
        #     finalPackSucces <- lib.testload(stats::setNames('', iPackage), lib_location, pick.last = TRUE, verbose = verbose, msg_str = '')
        #
        #     if (iPackage %in% names(finalPackSucces)) {
        #         message(sprintf('\n - The "%s" package seems to be already installed...\n', iPackage))
        #         next
        #     }
        # }
        #
        # # add the successfully loaded packages to the .libPaths, so the installer knows that they are there.
        # lib.set_libPaths(successfulLoads, lib_location, additional_lib_paths = install.location)
        #
        message('INSTALLING: ', iPackage)
        # because the dependencies are on the libPath, only the not present dependencies will be installed.
        # keeping them loaded would raise a popup of Rstudio.

        with_build_tools(utils::install.packages(iPackage, lib = install.location, quiet = quiet, repos = cran_url))
        message('INSTALLING DONE.')

    }
    if (!install_temporarily) {
        lib.convert(install.location, lib_location, force_overwrite = allow_overwrite_on_convert)
    }
}


#' @rdname lib.install
#' @export
#'
lib.install_if_not_compatible <- function(package_conditions, lib_location = lib.location(), install_temporarily = FALSE,
                                          allow_overwrite_on_convert = FALSE, quiet = TRUE, cran_url = "http://cran.us.r-project.org") {

    if (length(package_conditions) == 0) {
        return(invisible())
    }
    if (is.null(names(package_conditions))) {
        stop('Please provide a vector of named version specifications, like `c(name = "> 1.0.0")`.',
             'When the condition cannot be met, the package will be installed.\n',
             'Note that specific versions are not allowed because we cannot install a specific version.')
    }
    if (any(grepl('^[-0-9. ]+$', package_conditions) & nchar(package_conditions) != 0)) {
        stop("It is not possible to provide exact versions like c(package.a = '1.0.0'). ",
             "This is because this is the only version specification for which installing ",
             "the latest version from CRAN will likely not solve the dependency.")
    }

    # loop through packages to install
    for (iPackage in seq_along(package_conditions)) {
        packVer <- package_conditions[iPackage]
        packName <- names(packVer)

        av_ver <- lib.available_versions(packName, lib_location = lib_location)

        if (length(av_ver) != 0 && any(lib.check_compatibility(packVer, av_ver))) {
            message(sprintf('\nPASS - The version condition "%s" for package "%s" can be matched just fine.\nAvailable versions are: %s',
                            packVer, packName, paste0(collapse = ', ', '"', av_ver, '"')))
            next
        }
        message(sprintf('\nINSTALL - For "%s" the version condition "%s" for the package can not be met.\n(Available versions are: %s)',
                        packName, packVer, paste0(collapse = ', ', '"', av_ver, '"')))

        lib.install(packName, lib_location = lib_location, install_temporarily = TRUE,
                    allow_overwrite_on_convert = allow_overwrite_on_convert, quiet = quiet, cran_url = cran_url)

    }
    if (!install_temporarily) {
        lib.convert(lib.location_install_dir(lib_location), lib_location, force_overwrite = allow_overwrite_on_convert)
    }
}


# Borrowed from: https://github.com/rstudio/packrat/blob/master/R/install.R
with_build_tools <- function(code) {
    check <- getOption("buildtools.check", NULL)
    if (!is.null(check)) {
        if (check("Installing R packages from source")) {
            with <- getOption("buildtools.with", NULL)
            if (!is.null(with))
                with(code)
            else
                force(code)
        }
    }
    else {
        force(code)
    }
}


# -------------- install.packages [TARBALL] --------------

#' @rdname lib.install
#' @importFrom utils install.packages
#' @export
#'
lib.install_tarball <- function(tarball, dependencies = c(), lib_location = lib.location(),
                                install_temporarily = FALSE, allow_overwrite_on_convert = c('tarball', 'dependencies'),
                                cran_url = "http://cran.us.r-project.org") {

    if (missing(allow_overwrite_on_convert)) {
        allow_overwrite_on_convert <- 'tarball'
    }
    if (length(tarball) == 0) {
        return(invisible())
    }
    stopifnot(is.logical(allow_overwrite_on_convert) || is.character(allow_overwrite_on_convert))

    overwrite <- if (is.character(allow_overwrite_on_convert)) {
        val <- match.arg(tolower(allow_overwrite_on_convert),
                         c('tarball', 'dependencies', 'true', 'false'))
        data.frame(tarball = val %in% c('tarball',      'true'),
                   dep     = val %in% c('dependencies', 'true'))
    } else {
        # In case of 'TRUE' or 'FALSE'.
        data.frame(tarball = allow_overwrite_on_convert,
                   dep     = allow_overwrite_on_convert)
    }

    # Install multiple tarballs in one go
    if (length(tarball) > 1) {
        message('Multiple tarball files are provided simultaniously, ',
                'please make sure if tarball A depends on B, B is installed first.',
                '\nSince you might install different versions of a tarball at once, ',
                'I am forced to perform a `lib.clean_install_dir` after every installation.',
                '\nThe provided (CRAN) dependencies will be installed once.\n')

        # Install the first one incl. dependencies.
        lib.install_tarball(tarball[1], dependencies, lib_location,
                            install_temporarily = FALSE, cran_url = cran_url)

        lib.clean_install_dir(lib_location)
        tarballs <- tarball[2 : length(tarball)]

        # Install all other tarballs.
        sapply(tarballs, function(x, ...) {
            lib.install_tarball(x, dependencies = c(), lib_location = lib_location,
                                install_temporarily = FALSE,
                                allow_overwrite_on_convert = allow_overwrite_on_convert,
                                cran_url = cran_url)
            lib.clean_install_dir(lib_location)
        })
        return(invisible())
    }

    stopifnot(file.exists(tarball))
    # if (execute_with_Rscript) {
    #     Rscript_dir <- normPath(system('where Rscript', intern = T)[1])
    #     if (grepl('Could not find files for the given pattern(s)', Rscript_dir)) {
    #         stop('Please make sure `where Rscript` results in one or more valid paths. First one is used.')
    #     }
    #     script_location <- system.file(package = 'multiversion', 'lib.install_tarball_script.R')
    #
    #     status <- system(sprintf('"%s" --vanilla "%s" "%s" "%s" "%s" "%s"', Rscript_dir, script_location,
    #                              lib_location, packagePath, lib.packs_vec2str(dependencies, do_return = TRUE),
    #                              dirname(dirname(script_location))))
    #
    #     if (!install_temporarily & status == 0) {
    #         lib.convert(source_lib = lib_location, force_overwrite = allow_overwrite_on_convert)
    #     }
    #     return(invisible())
    # }

    install.location <- lib.location_install_dir(lib_location)

    if (!missing(dependencies) && length(dependencies) > 0) {
        message('First start with installing the provided dependencies (temporarily): ',
                paste0(collapse = ', ' , paste0(names(dependencies), ': "', dependencies, '"'), '...'))

        lib.install_if_not_compatible(dependencies,
                                      lib_location = lib_location,
                                      install_temporarily = TRUE,
                                      cran_url = cran_url)
        message('Finished installing the dependencies!\n\nINSTALLING the tarball...\n"', tarball, '"')

    }

    currentLibs <- lib.set_libPaths('all', lib_location, additional_lib_paths = install.location)
    on.exit(.libPaths(currentLibs), add = TRUE, after = FALSE)

    # successfulLoads <- lib.testload(dependencies, lib_location, msg_str = paste0('"', basename(packagePath), '" his dependencies'))
    # missingdependencies <- names(dependencies)[!(names(dependencies) %in% names(successfulLoads))]

    # Install all not yet existing dependencies:
    # if (length(missingdependencies) > 0) {
    #     message('\nI will install missing dependencies and try again...\n')
    #     lib.install(missingdependencies, lib_location = lib_location, install_temporarily = install_temporarily)
    #     successfulLoads <- lib.testload(dependencies, lib_location, msg_str = paste0('"', basename(packagePath), '" his dependencies (second try)'))
    #
    #     if (all(names(dependencies) %in% names(successfulLoads))) {
    #         message('\nNow we succeeded, continuing... \n')
    #     }
    # }

    # Check again if all wend well, if not all dependencies are there, reset and abort.
    # isSuccesfull <- names(dependencies) %in% names(successfulLoads)

    # if (!all(isSuccesfull | lib.is_basepackage(names(dependencies)))) {
    #     stop(paste0('\nThe following dependencies were missing and failed installation:', paste(paste0('\n- "', names(dependencies)[!isSuccesfull], '"'), collapse = ''), '\n\n'))
    # }

    # nms <- names(sessionInfo()$otherPkgs)
    # currentlyLoaded <- detachAll(packageList = nms[!nms %in% c('RVClibrary', 'multiversion')])

    # message('') # (applying a newline)

    # if (interactive() && length(sys.calls()) == 1) {
    #     on.exit({
    #         message('\nResetting your loaded packages...\n');
    #         lib.load(loadPackages = currentlyLoaded, lib_location = lib_location, quietly = TRUE)
    #     }, add = TRUE, after = FALSE)
    # }

    # If all dependencies could be found/installed: add all recursive dependency libraries to the search path.
    # lib.set_libPaths(successfulLoads, lib_location, additional_lib_paths = install.location)

    # Install the tarball!
    utils::install.packages(tarball, lib = install.location, type = "source", repos = NULL)

    if (!install_temporarily) {
        # tarball
        tarball_package_name <- gsub('_[0-9.-]+\\.tar\\.gz', '', basename(tarball))
        lib.convert(install.location, lib_location, force_overwrite = overwrite$tarball,
                    packages_to_convert = tarball_package_name)

        # dependencies
        deps <- list.dirs(install.location, FALSE, FALSE)
        lib.convert(install.location, lib_location, force_overwrite = overwrite$dep,
                    packages_to_convert = deps[deps != tarball_package_name])
    }

    return(invisible())
}


# -------- convert ordinary  (temp_)library  to  R_MV_library ---------

#' Move normally installed packages to R_MV_library structure.
#'
#' After this conversion is completed and you configure (temporarily by using \code{lib.location(...)}
#' or for eternity by setting the equally named environment variable)
#' the R_MV_LIBRARY_LOCATION env var, you are good to go! You can directly use \code{lib.load}
#' for loading packages. Thanks for using \code{multiversion}!! \cr
#' \cr
#' This function creates the R_MV_library structure by moving normally
#' installed packages to a parallel library structure.
#' \code{<lib1>/BH/DESCRIPTION} becomes\code{<lib2>/BH/1.60.0-2/BH/DESCRIPTION}
#' so that also \code{1.60.0-3} etc. can be installed.
#' \cr
#' This functionality is also used (with it's default values) for converting
#' installed packages from the temporary installation directory to the final R_MV_library.
#' The TEMP installation directory is in a standard flat library structure.\cr
#' \cr
#' Note that it is really no problem to perform a conversion again, it will
#' only move new versions of already present packages and will never overwrite.
#' To continue with a clean Temp folder, run \code{lib.clean_install_dir()} which will remove the folder.
#'
#' @param source_lib The temporary library where a package is temporarily
#' installed (having a normal library structure).
#' By default, the path is generated using \code{lib.location_install_dir()}
#' on the \code{destination_mv_lib} that is provided which appends \code{/TEMP_install_location}.
#' @param destination_mv_lib The folder containing a structure where all packages
#' in the temp folder must be moved to. By default, it checks the environment
#' variable \code{R_MV_LIBRARY_LOCATION} for this directory.
#' @param force_overwrite If you are experimenting and you would like to overwrite
#' the newly installed package. Normally only desired when the package you are
#' experimenting with is a self maintained package and you are sure you
#' increased the version to a new one.
#' @param packages_to_convert A character vector with the names of the packages
#' that need to be converted to the R_MV_library. If missing or empty, all will be converted.
#'
#' @examples
#' # As an experiment (or when getting started) you could run this with
#' # your complete standard library (not your base library).
#'
#' #> lib.convert(source_lib = Sys.getenv("R_LIBS_USER"),
#' #>             destination_mv_lib  = "./REMOVE_ME_example_library")
#'
#' # Running the same operation a second time will result
#' # in a notification that all files were already copied.
#'
#' # Just running it will use the R_MV_library defined by the environment
#' # variable and look inside for the Temp folder to use.
#'
#' #> lib.convert()
#'
#' # It is sufficient to only provide the destination_mv_lib,
#' # it will look for the "/TEMP_install_location" folder as the 'source_lib' by default.
#'
#' #> lib.convert(destination_mv_lib = "./R_MV_library")
#'
#'
#' @importFrom utils packageDescription
#' @export
#'
lib.convert <- function(source_lib          = lib.location_install_dir(destination_mv_lib),
                        destination_mv_lib  = lib.location(),
                        force_overwrite     = FALSE,
                        packages_to_convert) {

    source_lib   <- normPath(source_lib)
    lib_location <- normPath(destination_mv_lib)

    stopifnot(dir.exists(source_lib))
    all_present_packages <- list.dirs(source_lib, FALSE, FALSE)
    if (missing(packages_to_convert)) {
        packages_to_convert <- all_present_packages
    } else {
        if (length(packages_to_convert) == 0) {
            return(invisible())
        }
        # Crash if non existing.
        if (!all(tmp <- packages_to_convert %in% all_present_packages)) {
            stop('The following packages in the list of packages to convert are',
                 ' not present in the installation library!\nNot present: ',
                 paste0(collapse = ', ' , '"', packages_to_convert[!tmp], '"'))
        }
    }

    libContent   <- list.files(paste0(source_lib, '/', packages_to_convert), all.files = T, recursive = T, no.. = T, full.names = T)
    packageNames <- gsub(paste0(source_lib, '/([^/]+)/.*'), '\\1', libContent)

    # Generally the same as 'packages_to_convert'
    uniquePackages <- unique(packageNames)

    packageVersions <- c()
    for (iPackage in uniquePackages) {
        packageVersions[packageNames == iPackage] <- as.character(
            numeric_version(utils::packageDescription(iPackage, lib.loc = source_lib)$Version))
    }

    newLocation <- paste(lib_location, packageNames, packageVersions,
                         gsub(libContent, pattern = paste0(source_lib, '/'), replacement = '', fixed = TRUE), sep = '/')

    lapply(unique(dirname(newLocation)), dir.create, recursive = TRUE, showWarnings = FALSE)
    succes <- file.copy(libContent, newLocation, overwrite = force_overwrite)

    show_n_files <- function(nms) {
        msg <- c()
        for (x in unique(nms)) {
            msg <- c(msg, paste0(x, ': ', sum(nms == x)))
        }
        msg <- paste0(collapse = ', ', msg)
        ifelse(msg == '', 'None', msg)
    }
    message('\nSuccesfully copied files:')
    message(show_n_files(packageNames[ succes]))
    if (length(packageNames[!succes]) > 0) {
        message('\nFailed to copy:')
        message(show_n_files(packageNames[!succes]))
        message('(might be already installed, i.e. `TEMP_install_location`',
                ' was not cleaned up. This can be done by running `lib.clean_install_dir()`)')
    }
    message('')
}


# ============== DETACH/ATTACH NAMESPACE ==============

#' Detach all loaded packages and namespaces.
#'
#' Tries to detach all loaded packages and namespaces. Not always stable (within Rstudio).
#' A restart of Rstudio might be required since it will often hold on to certain namespaces.
#' A proper reset of all libraries is not possible, this is the best we can do. \cr
#' \cr
#' In general, it is possible to create a complete clean environment by clearing your work space,
#' running \code{detachAll} and then restarting Rstudio. If problems with package loading still persists,
#' then follow the final alternative solution described in the details section of the documentation of \code{lib.load}.
#'
#' @param reload_multiversion If multiversion needs to be loaded again after
#'  everything (or all mentioned in \code{packageList}) is unloaded.
#' @param packageList A character vector with the packages to detach/unload.
#' Defaults to all packages (\code{names(sessionInfo()$otherPkgs}).
#' When package X depends on package Y, make sure you first specify X then Y.
#' @param dryRun If TRUE, lists all packages that will be cleaned up.
#'
#' @importFrom utils sessionInfo
#' @export
#'
detachAll <- function(reload_multiversion = FALSE, packageList = 'all', dryRun = FALSE) {
    do_all <- FALSE
    if (!missing(packageList) && length(packageList) == 0) {
        return()
    }
    if (missing(packageList) || any(packageList == 'all')) {
        packageList <- names(utils::sessionInfo()$otherPkgs)
        do_all <- TRUE
    }
    currentPackageAndVersions <- lib.package_version_loaded(packageList)

    if (missing(packageList) && is.null(packageList)) {
        message('No packages are loaded, nothing to detach.')

    } else if (!dryRun) {
        in_search <- paste0('package:', packageList) %in% search()
        lapply(sprintf('package:%s', packageList[in_search]), detach, character.only = TRUE, unload = TRUE)
    }

    # also unload all namespaces (not always stable!)
    if (!dryRun) {

        if (do_all) {
            loadedNS <- rev(names(utils::sessionInfo()$loadedOnly))
            allLoadedPackages <- unique(c(packageList, loadedNS))

            cnt <- 1
            while(length(loadedNS) && cnt < 1000) {
                sapply(loadedNS, function(x) {
                    result <- tryCatch(unloadNamespace(getNamespace(x)), error = function(e) NULL)
                })
                loadedNS <- rev(names(utils::sessionInfo()$loadedOnly))

                cnt <- cnt + 1
            }

            # if while loop never naturally completed
            if(cnt == 1000)
                warning("Unable to unload all namespaces")
        } else {
            for (itter in 1:10) {
                sapply(packageList, function(x) {
                    tryCatch(unloadNamespace(getNamespace(x)), error = function(e) NULL)
                })
            }
            allLoadedPackages <- packageList
        }


        # deal with all DLLs now that the rest is done.
        suppressWarnings(sapply(allLoadedPackages, function(x) {
            dll <- getLoadedDLLs()[[x]]

            if(!is.null(dll))
                tryCatch(library.dynam.unload(x, dirname(dirname(dll[["path"]]))), error = function(e) NULL)
        }))
    }

    if (reload_multiversion) {
        library(multiversion, lib.loc = Sys.getenv("R_LIBS_USER"))
    }

    if (!'package:multiversion' %in% search()) {
        message('Note that the package "multiversion" is also detached:',
                '\n>  library(multiversion, lib.loc = Sys.getenv("R_LIBS_USER"))')}

    return(if(dryRun) {currentPackageAndVersions} else {invisible(currentPackageAndVersions)})
}


# ------------- [install.packages] helper functions --------------

# # Test load package list.
# #
# # Internally used for 'test loading' a list of dependencies when installing a package.
# # Returns a list of successful load operations.
# #
# # @param packages A named character vector of package/version names. None are really loaded, `lib.load` is used with the `dry.run` turned on.
# # @param lib_location The folder containing a structure where we will try to find our required packages in.
# # By default, it checks the environment variable \code{R_MV_LIBRARY_LOCATION} for this directory.
# # @param pick.last Changes the way a decision is made. In the scenario where a dependency of \code{>} or \code{>=} is defined, multiple versions may be available to choose from. By default, the lowest compliant version is chosen. Setting this to TRUE will choose the highest version.
# # @param verbose If TRUE, the default, will show all \code{lib.load} messages.
# # @param msg_str Can be either logical FALSE, or a character string which will be (the %s) part of the printed string ' - Trying to load %s: ...'.
# # Defaults to 'packages', making the sentence: ' - Trying to load packages: lattice, RColorBrewer, grid'
# #
# lib.testload <- function(packages, lib_location = lib.location(), pick.last = FALSE, verbose = TRUE, msg_str = 'packages') {
#     # tries to load packages and returns a vector with all successful load attempts ('yet to be installed' packages)
#
#     # Handle 'verbose' options
#     execute <- if (is.logical(verbose) && verbose) {
#         function(x) {x}
#     } else {
#         verbose <- FALSE  # Any value is allowed to get here, so I force a FALSE for further code to work.
#         function(x) {invisible(capture.output(x)); return(x)}
#     }
#
#     basePacks <- lib.is_basepackage(packages)
#     loadedPackages <- packages[basePacks]
#     packages       <- packages[!basePacks]
#
#     # Return directly when no 'dependencies' or packages are requested to load.
#     if (length(packages) == 0) {return(loadedPackages)}
#
#     if ((!verbose && missing(msg_str)) || is.character(msg_str) && length(msg_str) == 1) {
#         message(sprintf('\n - Trying to load %s: %s', msg_str, lib.packs_vec2str(packages, do_return = TRUE)))
#     }
#
#     for (iDependency in seq_along(packages)) {
#         iDependency <- packages[iDependency]
#
#         # TryCatch returns empty when error is caught.
#         newlyLoaded <-  tryCatch({
#             suppressWarnings(execute(lib.load(loadPackages = iDependency, lib_location = lib_location, dry.run = TRUE, also_load_from_temp_lib = TRUE,
#                                               skipDependencies = names(loadedPackages), pick.last = pick.last, quietly = !verbose)))
#         }, error = function(e) {
#             if (verbose) {
#                 # `message` appends a linefeed itself.
#                 message(sprintf('When loading package "%s": %s', names(iDependency), gsub('\n$', '', gsub('Error ', '', e))))
#             }
#         })
#
#         loadedPackages <- append(loadedPackages, newlyLoaded)
#     }
#
#     return(loadedPackages)
# }


# ---------------- additional functions -----------------

#' List the dependencies of a package.
#'
#' Provide a package name (can be without quotes) to show its dependencies.
#' To list all dependencies of the complete library, use the inverse function
#' "\code{lib.dependsOnMe(all)}" with the value 'all'.
#' That function also does not require quotes when calling it.
#' So \code{lib.dependencies(package.a)} will work.
#'
#' @param packageName The (unquoted) package name for which you would like to
#' print the dependencies.
#' @param do_print If true (default), prints the dependencies. In both cases,
#' the dependencies are returned invisibly.
#' @param character.only If TRUE, (FALSE by default), the package names can be
#' provided as character vector. Otherwise, direct unquoted package names are supported.
#' @param lib_location The folder containing the R_MV_library structure where
#' this function observes the dependencies. By default, it checks the environment
#' variable \code{R_MV_LIBRARY_LOCATION} for this directory.
#'
#' @examples
#' \dontrun{
#'     lib.dependencies(dplyr)
#'     lib.dependencies('devtools', character.only = T)
#'     devtools_deps <- lib.dependencies(devtools, do_print = F)
#' }
#'
#' @importFrom utils packageDescription
#' @export
#'
lib.dependencies <- function(packageName, do_print = TRUE, character.only = FALSE, lib_location = lib.location()) {

    # Featuring direct call like: `lib.dependencies(dplyr)`
    if (!character.only) {
        packageName = as.character(substitute(packageName))
        if (packageName[1] == 'c') {
            stop('Please only provide the name of the package. All versions will be shown.')
        }
    }

    if (!is.null(names(packageName))) {
        stop('Please only provide the name of the package. All versions will be shown.')
    }
    if (!nzchar(packageName)) {
        return(invisible())
    }
    stopifnot(length(packageName) == 1, !is.na(packageName))

    packVersionList <- list.dirs(paste(lib_location, packageName, sep = '/'), recursive = FALSE, full.names = FALSE)

    listed_dependencies <- list()
    for (packVersion in packVersionList) {

        package.location <- paste(lib_location, packageName, packVersion, sep = '/')

        overrideFile <- paste(package.location, c('vc_override_dependencies.txt'), sep = '/')
        if (file.exists(overrideFile)) {
            dependingPackages <- lib.packs_str2vec(readChar(overrideFile, file.info(overrideFile)$size))
        } else {
            packDesc <- utils::packageDescription(packageName, lib.loc = package.location)
            dependingPackages <- lib.packs_str2vec(gsub(paste(packDesc$Depends, packDesc$Imports, sep = ','), pattern = ',,', replacement = ','))
        }
        listed_dependencies[[packVersion]] <- dependingPackages

        if (do_print) {
            message(sprintf('%23s : %-8s ', packageName, packVersion), appendLF = F)
            message(ifelse(file.exists(overrideFile), '(shadowed)| ', '          | '), appendLF = F)
            lib.packs_vec2str(dependingPackages[1:3])
            if (length(dependingPackages) > 3) {
                for (index in 2: ceiling(length(dependingPackages)/3)) {
                    message(strrep(' ', 43), '... ', appendLF = F); lib.packs_vec2str(dependingPackages[(((index-1)*3):(index*3-1))+1])
                }
            }
        }
    }
    return(invisible(listed_dependencies))
}


#   ------------------- lib.dependsOnMe -------------------

#' Convert package name/version vector to single string.
#'
#' Used to print a set of package names and their version criteria in a way that
#'  \code{lib.packs_str2vec()} can parse it again to a package vector.
#' This way we can list the dependencies of a function easily and support better commandline interaction.
#'
#' @param x A named character vector with package names/versions.
#' \code{c(dplyr = '>= 1.5.0', data.table = '')}
#' @param do_return If FALSE (the default) the package sting is printed, if TRUE,
#'  it is returned as a character string and not printed.
#'
#' @export
#'
lib.packs_vec2str <- function(x, do_return = FALSE) {
    if (!is.null(x)) {x <- x[!is.na(x)]} else if (do_return) {return('')} else {message('')}
    str <- gsub(pattern = '\\s\\(\\)', replacement = '',paste(paste(names(x), paste0("(", x, ")")), collapse = '   '))
    if (do_return) {return(gsub('   ', ', ', str))} else {message(str)}
}


#' Show the complete library content.
#'
#' Use to print all available packages in the R_MV_library with all their versions
#' including their dependencies. Simply performs a call to \code{lib.dependsOnMe(all)}.
#'
#' @param lib_location The R_MV_library location.
#' @param dont_print When true, will not print anything, but will expect you to
#' make use of the invisibly returned package character vector.
#'
#' @return
#' It returns a special character array with package:version names for every
#' package and package version in the library.
#'
#' @export
#'
lib.installed_packages <- function(lib_location = lib.location(), dont_print = FALSE) {
    lib.dependsOnMe(all, lib_location = lib_location, dont_print = dont_print)
}


#' Shows the dependencies of (all or) a certain function(s).
#'
#' Can be called without using quotes like \code{lib.dependsOnMe(dplyr)}.
#' It supports the special feature \code{lib.dependsOnMe(all)},
#' which will print a list of all packages available with their dependencies. \cr
#' \cr
#' A simple wrapper "\code{lib.installed_packages}", will do precisely that.
#'
#' @param ... All packages and their versions you would like to check e.g.
#' \code{lib.dependsOnMe(DBI = '0.5', assertthat, R6 = '0.6', quietly = TRUE)}.
#' @param checkMyDeps Supports providing a named character vector of packages
#' and their versions instead of the direct input.
#' Use it like this when calling it via another function.
#' @param lib_location The folder containing a structure where this function
#' observe the dependencies from. By default, it checks the environment
#' variable \code{R_MV_LIBRARY_LOCATION} for this directory.
#' @param dont_print When true, will not print anything, but will expect you
#' to make use of the invisibly returned package character vector.
#'
#' @return
#' It returns a special character array with package:version names for every
#' package that has a dependency on the provided \code{checkMyDeps} or
#' \code{...} condition.
#'
#' @importFrom stats setNames
#' @importFrom utils packageDescription
#'
#' @export
#'
lib.dependsOnMe <- function(..., checkMyDeps = NULL, lib_location = lib.location(), dont_print = FALSE) {

    if (is.null(checkMyDeps)) {
        checkMyDeps <- raw_input_parser(as.list(match.call()), varnames_to_exclude = c('lib_location', 'checkMyDeps', 'dont_print'))
    }

    stopifnot(length(checkMyDeps) > 0)

    if (length(checkMyDeps) > 1 && 'all' %in% checkMyDeps) {
        stop('When requesting `all` dependencies (equal to `lib.installed_packages()`),',
             ' no other package names can be requested in the same call to `lib.dependsOnMe`.')
    }
    if (length(checkMyDeps) > 1) {
        # a loop makes sure that the name of the checkMyDeps value is also passed through.
        return_array <- c()
        for (icheck in seq_along(checkMyDeps)) {
            return_array <- c(return_array, lib.dependsOnMe(checkMyDeps = checkMyDeps[icheck], lib_location = lib_location))
        }
        return(invisible(return_array))
    }
    msg <- function(...) {if (!dont_print) {message(...)}}

    if (is.null(names(checkMyDeps))) {
        av_ver <- lib.available_versions(checkMyDeps)
        checkMyDeps <- stats::setNames('999999.99.99', checkMyDeps)
        msg('Showing all that depends on `', names(checkMyDeps), '`, (available are: ', paste0(collapse = ', ', '"', av_ver, '"'), '):')
    }

    # check if input package is realistic.
    # if no version is selected (no name value pair is provided) all packages that depend on any version of 'checkMyDeps' will be shown.
    if (!names(checkMyDeps) == 'all' && !checkMyDeps == '999999.99.99') {
        av_ver <- lib.available_versions(names(checkMyDeps))
        av_ver_apply <- sapply(av_ver, FUN = function(x) {lib.check_compatibility(checkMyDeps, x)})
        if (any(av_ver_apply)) {
            checkMyDeps <- stats::setNames(av_ver[max(which(av_ver_apply))], names(checkMyDeps))
            msg('Showing all that depends on `',
                names(checkMyDeps), '`, version "', checkMyDeps, '":')
        } else if (length(av_ver_apply) == 0) {
            msg('Cannot match dependency... it appears that this package is not installed.')
        } else {
            # show all for this version
            msg('Cannot match dependency...\nShowing all that depends on `',
                names(checkMyDeps), '`, (available are: ', paste0(collapse = ', ', '"', av_ver, '"'), '):')
            checkMyDeps <- stats::setNames('999999.99.99', names(checkMyDeps))
        }
    }

    packageList <- list.dirs(lib_location, recursive = FALSE, full.names = FALSE)
    packageList <- packageList[!packageList %in% c('.git', 'TEMP_install_location')]

    return_array <- c()
    for (packageName in packageList) {
        packVersionList <- list.dirs(paste(lib_location, packageName, sep = '/'), recursive = FALSE, full.names = FALSE)

        for (packVersion in packVersionList) {

            package.location <- paste(lib_location, packageName, packVersion, sep = '/')

            overrideFile <- paste(package.location, c('vc_override_dependencies.txt'), sep = '/')
            if (file.exists(overrideFile)) {
                dependingPackages <- lib.packs_str2vec(readChar(overrideFile, file.info(overrideFile)$size))
            } else {
                packDesc <- utils::packageDescription(packageName, lib.loc = package.location)
                dependingPackages <- lib.packs_str2vec(gsub(paste(packDesc$Depends, packDesc$Imports, sep = ','), pattern = ',,', replacement = ','))
            }

            dependingPackages <- dependingPackages[!lib.is_basepackage(names(dependingPackages))]

            if (!names(checkMyDeps) == 'all') {
                depThatMatters <- dependingPackages[names(dependingPackages) == names(checkMyDeps)]
                if (length(depThatMatters) == 0) {next}
                valid <- lib.check_compatibility(depThatMatters, checkMyDeps)

            } else { # in case 'all' is requested.
                valid = TRUE
            }

            if (valid) {
                return_array <- c(return_array, paste0(packageName, ':', packVersion))
                msg(sprintf('%23s : %-8s ', packageName, packVersion), appendLF = F)
                msg(ifelse(file.exists(overrideFile), '(shadowed)| ', '          | '), appendLF = F)
                lib.packs_vec2str(dependingPackages[1:3], do_return = dont_print)
                if (length(dependingPackages) > 3) {
                    for (index in 2: ceiling(length(dependingPackages)/3)) {
                        msg(strrep(' ', 45), '... ', appendLF = F)
                        lib.packs_vec2str(dependingPackages[(((index-1)*3):(index*3-1))+1], do_return = dont_print)
                    }
                }
            }
        }
    }
    return(invisible(return_array))
}
Siete-F/multiversion documentation built on March 27, 2022, 1:04 p.m.