R/dev-pkg.R

Defines functions dev_pkg_config dev_pkg_inst dev_pkg_version dev_pkg_objects dev_pkg_name

Documented in dev_pkg_config dev_pkg_inst dev_pkg_name dev_pkg_objects dev_pkg_version

#' @title
#' Package Introspection
#'
#' @description
#' Introspecting into the package in which these utilities are called
#'
#' @name dev_pkg
NULL

#' @describeIn dev_pkg
#' Gets the package name of where this is called
#' @importFrom rlang %||%
#' @export
dev_pkg_name <- function(envir = parent.frame()) {
    if (file.exists(here("DESCRIPTION")) &&
        packageName(env = envir) %||% "" != "tjutils") {
        read.dcf(here("DESCRIPTION"), fields = "Package")[, 1]
    } else {
        packageName(env = envir)
    }
}

#' @describeIn dev_pkg
#' Gets the objects in a package that conform to a regex, or all
#'
#' @param filter_in  filter in only objects matching this pattern
#' @param filter_out filter out these objects after filter_in is applied
#' @param envir      package environment
#'
#' @importFrom stringr str_detect
#' @importFrom purrr set_names
#' @export
dev_pkg_objects <- function(filter_in  = NULL, filter_out = NULL,
                            envir = parent.frame()) {
    e <- getNamespace(dev_pkg_name(envir = envir))
    objects <- ls(envir = e)
    if (!is.null(filter_in))
        objects <- objects[str_detect(objects, filter_in)]
    if (!is.null(filter_out))
        objects <- objects[!str_detect(objects, filter_out)]
    map(objects, ~get(., envir = e)) %>%
        set_names(objects)
}

#' @describeIn dev_pkg Package Version from the DESCRIPTION file
#' @export
dev_pkg_version <- function(envir = parent.frame()) {
    read.dcf(dev_pkg_inst("DESCRIPTION", envir = envir))[, c("Version")]
}

#' @describeIn dev_pkg
#' Gets installed files in the package
#'
#' @export
dev_pkg_inst <- function(..., envir = parent.frame()) {
    inst_file <- system.file(..., package = dev_pkg_name(envir = envir))
    if (inst_file == "") {
        inst_file <- here::here("inst", ...)
    }
    return(inst_file)
}

#' @describeIn dev_pkg
#' Gets configuration
#'
#' @param value,config,file,use_parent see [`config::get()`]
#'
#' @export
dev_pkg_config <- function(
    value,
    config = Sys.getenv("R_CONFIG_ACTIVE", "default"),
    file = "config.yml",
    use_parent = FALSE
) {
    config::get(
        value = value,
        config = config,
        file = dev_pkg_inst(file),
        use_parent = use_parent
    )
}
tjpalanca/tjutils documentation built on Jan. 20, 2021, 2:01 p.m.