New1 (#63)

* add Dockerfile parser (#55) * add Dockerfile parser * add parsing test * add flag to dock_from_renv function (#60) * add keep_renv_version flag to dock_from_renv function and associated test * fixed typo * Update dock_from_renv.R * improve dock_from_renv * flat_ file correction * it's always a typo --------- Co-authored-by: Josiah Parry <[email protected]> Co-authored-by: Adam J Campbell <[email protected]>
ThinkR-open · Oct 29, 2023 · 2984727 · 2984727
1 parent 9008908
commit 2984727
Show file tree

Hide file tree

Showing 16 changed files with 679 additions and 69 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: dockerfiler
 Title: Easy Dockerfile Creation from R
-Version: 0.2.1.9002
+Version: 0.2.1.9003
 Authors@R: c(
     person("Colin", "Fay", , "[email protected]", role = c("cre", "aut"),
            comment = c(ORCID = "0000-0001-7343-1846")),
@@ -36,8 +36,9 @@ Suggests:
     rmarkdown (>= 2.6),
     testthat (>= 3.0.0),
     withr
-VignetteBuilder:
+VignetteBuilder: 
     knitr
+Config/fusen/version: 0.5.2.9000
 Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true

diff --git a/NAMESPACE b/NAMESPACE
@@ -6,6 +6,7 @@ export(dock_from_desc)
 export(dock_from_renv)
 export(docker_ignore_add)
 export(get_sysreqs)
+export(parse_dockerfile)
 export(r)
 importFrom(R6,R6Class)
 importFrom(attempt,map_try_catch)

diff --git a/NEWS.md b/NEWS.md
@@ -4,6 +4,10 @@
 
 - feat: Added `dock_from_renv()`, to create a Dockerfile from a renv.lock file (@JosiahParry, @statnmap)
 
+- feat: Added `parse_dockerfile()`, to Create a Dockerfile object from a Dockerfile (@JosiahParry)
+
+- feat: Added `fix_renv_version` boolean parameter to `dock_from_renv` to be able to fix the renv version to use during `renv::restore()`
+
 - fix: the dedicated `compact_sysreqs` function allow to deal with 'complex' sysreqs, such as chromimum installation
 
 - feat: add jammy ubuntu distro in available distro

diff --git a/R/dock_from_renv.R b/R/dock_from_renv.R
@@ -1,3 +1,5 @@
+# WARNING - Generated by {fusen} from dev/flat_dock_from_renv.Rmd: do not edit by hand
+
 # ignoring opensuse for the time being
 available_distros <- c(
   "xenial",
@@ -22,6 +24,8 @@ available_distros <- c(
 #' @param repos character. The URL(s) of the repositories to use for `options("repos")`.
 #' @param extra_sysreqs character vector. Extra debian system requirements.
 #'    Will be installed with apt-get install.
+#' @param fix_renv_version boolean. If `TRUE` the version of renv in the lockfile
+#'    will be used for the `renv::restore()` command
 #' @importFrom utils getFromNamespace
 #' @return A R6 object of class `Dockerfile`.
 #' @details
@@ -38,12 +42,13 @@ available_distros <- c(
 #' @importFrom attempt map_try_catch
 #' @importFrom glue glue
 #' @importFrom pak pkg_system_requirements
+
+#' @export
 #' @examples
 #' \dontrun{
 #' dock <- dock_from_renv("renv.lock", distro = "xenial")
 #' dock$write("Dockerfile")
 #' }
-#' @export
 dock_from_renv <- function(
   lockfile = "renv.lock",
   distro = "focal",
@@ -52,7 +57,8 @@ dock_from_renv <- function(
   sysreqs = TRUE,
   repos = c(CRAN = "https://cran.rstudio.com/"),
   expand = FALSE,
-  extra_sysreqs = NULL
+  extra_sysreqs = NULL,
+  fix_renv_version = FALSE
 ) {
   distro <- match.arg(distro, available_distros)
 
@@ -72,6 +78,9 @@ dock_from_renv <- function(
     AS = AS
   )
 
+  # get renv version
+  renv_version <- lock$data()$Packages$renv$Version
+
   distro_args <- switch(
     distro,
     centos7 = list(
@@ -235,30 +244,23 @@ dock_from_renv <- function(
     )
   )
 
-  dock$RUN("R -e 'install.packages(c(\"renv\",\"remotes\"))'")
+  # check if fix_renv_version is true
+  if (fix_renv_version){
+    dock$RUN("R -e 'install.packages(\"remotes\")'")
+      install_renv_string <- paste0(
+        "R -e 'remotes::install_version(\"renv\", version = ",
+        renv_version,
+        ")'"
+      )
+      dock$RUN(install_renv_string)
+
+  } else {
+    dock$RUN("R -e 'install.packages(c(\"renv\",\"remotes\"))'")
+  }
 
   dock$COPY(basename(lockfile), "renv.lock")
   dock$RUN(r(renv::restore()))
 
   dock
 }
 
-
-#' Generate base image name
-#'
-#' Creates the base image name from the provided distro name and the R version found in the `renv.lock` file.
-#'
-#' @keywords internal
-gen_base_image <- function(
-  distro = "bionic",
-  r_version = "4.0",
-  FROM = "rstudio/r-base"
-) {
-  distro <- match.arg(distro, available_distros)
-
-  if (FROM == "rstudio/r-base") {
-    glue::glue("{FROM}:{r_version}-{distro}")
-  } else {
-    glue::glue("{FROM}:{r_version}")
-  }
-}
diff --git a/R/dockerignore.R b/R/dockerignore.R
@@ -10,7 +10,7 @@
 #' @export
 #'
 #' @examples
-#' if (interactive()) {
+#' \dontrun{
 #'   docker_ignore_add()
 #' }
 docker_ignore_add <- function(path) {
@@ -48,8 +48,8 @@ docker_ignore_add <- function(path) {
       path_ri
     )) {
       write(
-        "^\\.dockerignore$", 
-        path_ri, 
+        "^\\.dockerignore$",
+        path_ri,
         append = TRUE)
       cat_bullet(
         ".dockerignore added to the .Rbuildignore file.",
@@ -66,4 +66,4 @@ docker_ignore_add <- function(path) {
   }
 
   return(invisible(path_di))
-}
+}
diff --git a/R/gen_base_image.R b/R/gen_base_image.R
@@ -0,0 +1,21 @@
+# WARNING - Generated by {fusen} from dev/flat_dock_from_renv.Rmd: do not edit by hand
+
+#' Generate base image name
+#'
+#' Creates the base image name from the provided distro name and the R version found in the `renv.lock` file.
+#'
+#' @keywords internal
+#' @noRd
+gen_base_image <- function(
+  distro = "bionic",
+  r_version = "4.0",
+  FROM = "rstudio/r-base"
+) {
+  distro <- match.arg(distro, available_distros)
+
+  if (FROM == "rstudio/r-base") {
+    glue::glue("{FROM}:{r_version}-{distro}")
+  } else {
+    glue::glue("{FROM}:{r_version}")
+  }
+}
diff --git a/R/parse-dockerfile.R b/R/parse-dockerfile.R
@@ -0,0 +1,48 @@
+
+#' Parse a Dockerfile
+#'
+#' Create a Dockerfile object from a Dockerfile.
+#'
+#' @param path path to the Dockerfile
+#' @returns A Dockerfile object
+#' @export
+#' @examples
+#' parse_dockerfile(system.file("Dockerfile", package = "dockerfiler"))
+#'
+parse_dockerfile <- function(path) {
+
+  # note that MAINTAINER is deprecated but there
+  # for backwards compatability
+  DOCKER_INSTRUCTIONS <- c(
+    "#", # for detecting comments
+    # "^$", # to capture empty lines
+    "FROM", "RUN", "CMD", "EXPOSE", "LABEL", "MAINTAINER", "EXPOSE", "ENV", "ADD", "COPY", "ENTRYPOINT", "VOLUME", "USER", "WORKDIR", "ARG", "ONBUILD", "STOPSIGNAL", "HEALTHCHECK", "SHELL")
+
+  instruction_regex <- paste0(DOCKER_INSTRUCTIONS, collapse = "|")
+
+  # read the dockerfile
+  dock_raw <- readLines(path)
+  # capture instructions
+  m <- gregexpr(paste0("^", instruction_regex), dock_raw)
+  # extract the instruction
+  instructions <- unlist(lapply(regmatches(dock_raw, m), `[`, 1))
+  # find positions
+  instr_pos <- which(!is.na(instructions))
+  # find how many lines between instructions and last line
+  n_lines_between <- diff(c(instr_pos, length(dock_raw))) - 1
+  # the last one needs to add 1
+  n_lines_between[length(n_lines_between)] <- n_lines_between[length(n_lines_between)] + 1
+
+  dock_lines <- find_line_positions(dock_raw, instr_pos, instr_pos + n_lines_between)
+
+  res <- Dockerfile$new()
+  res$Dockerfile <- dock_lines
+  res
+}
+
+# helper function to craft commands
+find_line_positions <- function(x, start, end) {
+  indexes <- Map(seq.int, start, end, by = 1)
+  cmnds <- lapply(indexes, function(.x) x[.x])
+  vapply(cmnds, paste0, character(1), collapse = "\n")
+}
diff --git a/dev/config_fusen.yaml b/dev/config_fusen.yaml
@@ -0,0 +1,15 @@
+flat_dock_from_renv.Rmd:
+  path: dev/flat_dock_from_renv.Rmd
+  state: active
+  R:
+  - R/dock_from_renv.R
+  - R/gen_base_image.R
+  tests: tests/testthat/test-dock_from_renv.R
+  vignettes: vignettes/dockerfile-from-renv-lock.Rmd
+  inflate:
+    flat_file: dev/flat_dock_from_renv.Rmd
+    vignette_name: Dockerfile from renv.lock
+    open_vignette: false
+    check: false
+    document: true
+    overwrite: 'yes'