R/internal-json.R

Defines functions .noPrune .isAppSupported .importAppJson .getAppDeps

#' Get application dependencies
#'
#' @note Updated 2023-10-17.
#' @noRd
.getAppDeps <-
    function(name,
             json,
             sysDict,
             keys = c("build_dependencies", "dependencies")) {
        lst <- list()
        for (key in keys) {
            keyJson <- json[[key]]
            if (is.null(names(keyJson))) {
                deps <- keyJson
            } else {
                if (sysDict[["osId"]] %in% names(keyJson)) {
                    deps <- keyJson[[sysDict[["osId"]]]]
                } else {
                    deps <- keyJson[["noarch"]]
                }
            }
            deps <- unlist(deps, recursive = FALSE, use.names = FALSE)
            lst[[key]] <- deps
        }
        out <- unlist(x = lst, recursive = TRUE, use.names = FALSE)
        out <- unique(out)
        out
    }



#' Import app.json file
#'
#' @note Updated 2023-05-09.
#' @noRd
.importAppJson <- function() {
    assert(requireNamespaces("pipette"))
    json <- pipette::import(
        con = file.path(koopaPrefix(), "etc", "koopa", "app.json"),
        quiet = TRUE
    )
    json
}



#' Is a shared app supported on the current system?
#'
#' @note Updated 2023-10-17.
#' @noRd
.isAppSupported <- function(name, json, sysDict) {
    if (dir.exists(file.path(sysDict[["optPrefix"]], name))) {
        return(TRUE)
    }
    if (isTRUE(json[["removed"]])) {
        return(FALSE)
    }
    if (
        is.list(json[["supported"]]) &&
            sysDict[["osId"]] %in% names(json[["supported"]]) &&
            isFALSE(json[["supported"]][[sysDict[["osId"]]]])
    ) {
        return(FALSE)
    }
    if (isFALSE(json[["default"]])) {
        return(FALSE)
    }
    if (isTRUE(json[["private"]])) {
        return(FALSE)
    }
    if (isTRUE(json[["system"]])) {
        return(FALSE)
    }
    if (isTRUE(json[["user"]])) {
        return(FALSE)
    }
    TRUE
}



#' Application names that don't support pruning
#'
#' @note Updated 2023-10-16.
#' @noRd
#'
#' @return `character`.
.noPrune <- function() {
    json <- .importAppJson()
    lgl <- vapply(
        X = json,
        FUN = function(x) {
            isFALSE(x[["prune"]])
        },
        FUN.VALUE = logical(1L)
    )
    assert(any(lgl))
    out <- names(lgl)[lgl]
    out
}
acidgenomics/r-koopa documentation built on Oct. 31, 2023, 9:21 a.m.