From 1664418edfe1bb867fb02cbb60882ff694f2f2a5 Mon Sep 17 00:00:00 2001 From: Kirill Sevastyanenko Date: Wed, 11 Jan 2017 12:22:03 -0500 Subject: [PATCH 1/4] Use github_pat if available --- DESCRIPTION | 2 +- R/engine.R | 38 +++++++++++++++++++++----------------- R/utils.R | 24 ++++++++++++++++++++---- 3 files changed, 42 insertions(+), 22 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 34d4034..8a190e0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: syberia Type: Package Title: Syberia -Version: 0.6.1.9008 +Version: 0.6.1.9009 Description: Syberia is a meta-framework for R that allows for on-the-fly creation of concrete frameworks for constructing arbitrary software. In its current formulation, the modeling engine provides an opiniated diff --git a/R/engine.R b/R/engine.R index 42fed1a..5e20a35 100644 --- a/R/engine.R +++ b/R/engine.R @@ -37,14 +37,14 @@ ## especially helpful for machine learning projects, where the task and solution ## can take widely varying shapes depending on whether the problem is supervised, ## unsupervised, NLP, deep learning, etc. -## +## ## The above 2-step approach is recursive. For example, the [modeling engine](https://github.com/syberia/modeling.sy), ## the default engine for most projects, is built off the [base engine](https://github.com/syberia/base.sy), ## which dictates that each project should have a `config/routes.R` file which -## links the `lib/controllers` directory to the rest of the project and tells +## links the `lib/controllers` directory to the rest of the project and tells ## you how R scripts in the project are to be parsed according to which ## directory they reside in. This is similar to object-oriented programming, -## except that it is strictly more general since it does not force you +## except that it is strictly more general since it does not force you ## to treat every single thing in the world as an object. ## ## Thus, the core structural unit is an **engine**. In order to bootstrap @@ -106,7 +106,7 @@ #' project from which the engine will be used. #' #' @param filepath character. The root directory of the engine. -#' If this directory does not define a (relative) \code{"config/application.R"} +#' If this directory does not define a (relative) \code{"config/application.R"} #' file, the parent directories of \code{filepath} will be traversed #' until such a file is found, or the function will error. #' By default, the current directory. @@ -154,13 +154,13 @@ syberia_engine_.character <- function(filepath, ...) { syberia_engine_character <- function(filepath, cache = TRUE) { ## If a user gives `~/foo/bar/baz` as the path and the project's - ## root is in fact `~/foo` (in other words, if they give a file or subdirectory + ## root is in fact `~/foo` (in other words, if they give a file or subdirectory ## in the project), this should be inferrable. We traverse ## the parent directories until we hit the root of the file system ## to see if we are in a syberia engine traverse_parent_directories(normalizePath(filepath, mustWork = FALSE), function(filepath) { ## If we are caching the precomputed `syberia_engine` object, simply fetch - ## it from the `.syberia_env` helper environment. + ## it from the `.syberia_env` helper environment. if (isTRUE(cache) && has_application_file(filepath)) { ## If it is not cached, call `build_engine` on the directory. .syberia_env[[filepath]] <- .syberia_env[[filepath]] %||% build_engine(filepath) @@ -203,7 +203,7 @@ build_engine.pre_engine <- function(buildable) { #' @export build_engine.character <- function(buildable) { - ## To build an engine, we bootstrap an otherwise bare + ## To build an engine, we bootstrap an otherwise bare ## `syberia_engine` R6 object. Bootstrapping an engine ## is explained below. bootstrap_engine(syberia_engine_class$new(buildable)) @@ -232,7 +232,7 @@ engine_location_path <- function() { getOption("syberia.engine_location", "~/.R/.syberia/engines") } -## To build an engine, we bootstrap an otherwise bare +## To build an engine, we bootstrap an otherwise bare ## `syberia_engine` R6 object. Bootstrapping an engine ## consists of ## @@ -254,7 +254,7 @@ engine_location_path <- function() { ## do additional stuff *after* preprocessing and sourcing that file. For example, ## in `config/engines` we need to actually build and mount the engines referred ## to in the fil with the `engine` helper function. -## +## ## In order to avoid the [diamond problem](https://en.wikipedia.org/wiki/Multiple_inheritance), ## Syberia ensures that engines do not share resources *unless* they come from ## a common base engine. This is a technical issue that will eventually be @@ -274,7 +274,7 @@ bootstrap_engine <- function(engine) { engine$register_preprocessor("config/boot", boot_preprocessor) engine$register_preprocessor("config/engines", engine_preprocessor) engine$register_parser ("config/engines", engine_parser) - + exists <- function(...) engine$exists(..., parent. = FALSE, children. = FALSE) if (exists("config/engines")) engine$resource("config/engines") if (exists("config/boot")) engine$resource("config/boot") @@ -308,7 +308,7 @@ engine_preprocessor <- function(source, source_env, preprocessor_output, directo ## Now that we have collected the engines to be mounted into the `preprocessor_output` ## helper (which also came from [director](https://github.com/syberia/director)), -# +# engine_parser <- function(director, preprocessor_output) { if (isTRUE(director$cache_get("bootstrapped"))) return() @@ -335,11 +335,11 @@ engine_parser <- function(director, preprocessor_output) { call. = FALSE) } - ## We use `list2env` to "inject" the `director` local variable into the + ## We use `list2env` to "inject" the `director` local variable into the ## scope of the `onAttach` hook. environment(onAttach) <- list2env( list(director = director), - parent = environment(onAttach) %||% baseenv() + parent = environment(onAttach) %||% baseenv() ) director$cache_set(".onAttach", onAttach) } @@ -347,7 +347,7 @@ engine_parser <- function(director, preprocessor_output) { } ## Registering an engine means making the parent aware of its child -## and the child aware of its parent. Mounting the engine means +## and the child aware of its parent. Mounting the engine means ## we will be treating a collection of engines, each in potentially ## very different directories on the file system, as *one giant project*. ## This allows us to pull out a subset of Syberia resources and @@ -391,7 +391,7 @@ parse_engine <- function(engine_parameters) { ## When we use `devtools::load_all` on director, it loads a symbol called ## `exists`; we use explicit base namespacing to prevent conflicts during development. if (!base::exists(parser, envir = getNamespace("syberia"), inherits = FALSE)) { - stop(sprintf("Cannot load an engine of type %s", + stop(sprintf("Cannot load an engine of type %s", sQuote(crayon::red(engine_parameters$type)))) } syberia_engine(get(parser, envir = getNamespace("syberia"))(engine_parameters), @@ -412,11 +412,16 @@ parse_engine.github <- function(engine_parameters) { repo <- engine_parameters$repo %||% engine_parameters$repository # TODO: (RK) Checking for updates? version <- engine_parameters$version %||% "master" + base_url <- if (nzchar(PAT <- github_pat())) { + sprintf("https://%s@github.com/%s.git", PAT, repo) + } else { + sprintf("https://github.com/%s.git", repo) + } stopifnot(is.simple_string(repo)) pre_engine(prefix = file.path("github", repo, version), builder = function(filepath) { - status <- system2("git", c("clone", sprintf("https://github.com/%s.git", repo), filepath)) + status <- system2("git", c("clone", base_url, filepath, "--branch", version, "--depth", "1")) stopifnot(status == 0) }) } @@ -456,4 +461,3 @@ should_exclude.syberia_engine <- function(...) { identical(...) } should_exclude.character <- function(condition, engine) { identical(condition, engine$root()) } - diff --git a/R/utils.R b/R/utils.R index c811b6c..88ec112 100644 --- a/R/utils.R +++ b/R/utils.R @@ -7,11 +7,28 @@ `%||%` <- function(x, y) if (is.null(x)) y else x `%|||%` <- function(x, y) if (is.falsy(x)) y else x + is.falsy <- function(x) { identical(x, NULL) || identical(x, FALSE) || identical(x, "") || length(x) == 0 || identical(x, 0) } +#' Retrieve Github personal access token. +#' +#' Borrowed from https://github.com/r-pkgs/remotes/blob/master/R/github.R#L23 +#' A github personal access token +#' Looks in env var \code{GITHUB_PAT} +#' +#' @keywords internal +#' @noRd +github_pat <- function() { + pat <- Sys.getenv('GITHUB_PAT') + if (identical(pat, "")) { return(NULL) } + + message("Using github PAT from envvar GITHUB_PAT") + pat +} + #' Fetch the current Syberia version. #' @export #' @return The version of the syberia package as \code{\link{package_version}} @@ -61,9 +78,9 @@ as.list.environment <- function(env) { #' #' If any global variables are removed or created, it will #' give a descriptive error. -#' +#' #' @param expr expression. The R expression to evaluate -#' @param desc character. A string to add to "you modified global +#' @param desc character. A string to add to "you modified global #' @param check_options logical. Whether to check if any global options were changed. #' variables while [\code{desc} goes here]". #' @return the output of the \code{expr}. @@ -103,7 +120,7 @@ ensure_no_global_variable_pollution <- function(expr, desc, check_options = FALS } #' Perform an action repeatedly on parent directories until success or error. -#' +#' #' Given a \code{fn}, we may wish to run it on a \code{filepath}, determine #' its success, and try again with the parent directory of \code{filepath}, #' until we obtain result that is not \code{NULL}. If this does not occur for @@ -158,4 +175,3 @@ any_is_substring_of <- function(string, set_of_strings) { any(vapply(set_of_strings, function(x) substring(string, 1, nchar(x)) == x, logical(1))) } - From 0c7b6e53e6b8acadc6bd90357738a803233f39a1 Mon Sep 17 00:00:00 2001 From: Kirill Sevastyanenko Date: Wed, 11 Jan 2017 12:25:25 -0500 Subject: [PATCH 2/4] quiet cloning --- R/engine.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/engine.R b/R/engine.R index 5e20a35..fa6149c 100644 --- a/R/engine.R +++ b/R/engine.R @@ -421,7 +421,9 @@ parse_engine.github <- function(engine_parameters) { pre_engine(prefix = file.path("github", repo, version), builder = function(filepath) { - status <- system2("git", c("clone", base_url, filepath, "--branch", version, "--depth", "1")) + status <- system2("git", + c("clone", base_url, filepath, + "--branch", version, "--depth", "1", "--quiet")) stopifnot(status == 0) }) } From 85d4cc8223eef6fe0274e5736a81006729e4d9f3 Mon Sep 17 00:00:00 2001 From: Kirill Sevastyanenko Date: Wed, 11 Jan 2017 13:48:49 -0500 Subject: [PATCH 3/4] review comments addressed --- R/engine.R | 7 ++++--- R/utils.R | 2 +- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/R/engine.R b/R/engine.R index fa6149c..91944bd 100644 --- a/R/engine.R +++ b/R/engine.R @@ -412,10 +412,11 @@ parse_engine.github <- function(engine_parameters) { repo <- engine_parameters$repo %||% engine_parameters$repository # TODO: (RK) Checking for updates? version <- engine_parameters$version %||% "master" - base_url <- if (nzchar(PAT <- github_pat())) { - sprintf("https://%s@github.com/%s.git", PAT, repo) + PAT <- github_pat() + if (!is.null(PAT)) { + base_url <- sprintf("https://%s@github.com/%s.git", PAT, repo) } else { - sprintf("https://github.com/%s.git", repo) + base_url <- sprintf("https://github.com/%s.git", repo) } stopifnot(is.simple_string(repo)) diff --git a/R/utils.R b/R/utils.R index 88ec112..7ce531c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -23,7 +23,7 @@ is.falsy <- function(x) { #' @noRd github_pat <- function() { pat <- Sys.getenv('GITHUB_PAT') - if (identical(pat, "")) { return(NULL) } + if (!nzchar(pat)) { return(NULL) } message("Using github PAT from envvar GITHUB_PAT") pat From e54de13e06eefa20d06e15a89c46f3f93df12ea2 Mon Sep 17 00:00:00 2001 From: Kirill Sevastyanenko Date: Wed, 11 Jan 2017 13:49:48 -0500 Subject: [PATCH 4/4] documented --- R/utils.R | 2 +- man/syberia_engine.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index 7ce531c..3be7ab0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -15,7 +15,7 @@ is.falsy <- function(x) { #' Retrieve Github personal access token. #' -#' Borrowed from https://github.com/r-pkgs/remotes/blob/master/R/github.R#L23 +#' Borrowed from \url{https://github.com/r-pkgs/remotes/blob/master/R/github.R#L23} #' A github personal access token #' Looks in env var \code{GITHUB_PAT} #' diff --git a/man/syberia_engine.Rd b/man/syberia_engine.Rd index a0331d2..f685604 100644 --- a/man/syberia_engine.Rd +++ b/man/syberia_engine.Rd @@ -11,7 +11,7 @@ syberia_project(filepath = getwd(), ..., root. = TRUE) } \arguments{ \item{filepath}{character. The root directory of the engine. -If this directory does not define a (relative) \code{"config/application.R"} +If this directory does not define a (relative) \code{"config/application.R"} file, the parent directories of \code{filepath} will be traversed until such a file is found, or the function will error. By default, the current directory.}