Merge pull request #26 from joelnitta/jnfeat

Add run_auto_mount()

DESCRIPTION

@@ -23,14 +23,17 @@ Depends:
 Imports:
     crayon,
     dplyr,
+    fs,
     dynutils,
     processx (>= 3.5.0),
     purrr,
-    utils
+    utils,
+    digest,
+    glue
 Suggests: 
     covr,
     testthat (>= 3.0.0)
 SystemRequirements: Docker and/or Singularity (>=3.0)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2

NAMESPACE

@@ -9,6 +9,7 @@ export(list_docker_images)
 export(pull_container)
 export(read_file)
 export(run)
+export(run_auto_mount)
 export(set_default_config)
 export(test_docker_installation)
 export(test_singularity_installation)

NEWS.md

@@ -1,3 +1,7 @@
+# babelwhale 1.1.0
+
+* NEW FUNCTIONALITY `run_auto_mount()`: Added helper function for letting `babelwhale` figure out which directories to mount automatically.
+
 # babelwhale 1.0.3
 
 * BUG FIX `detect_backend()`: Print helpful message when neither docker or singularity are installed (Thanks @KforKuma).

R/run_auto_mount.R

@@ -0,0 +1,98 @@
+#' Run a containerised command with automatic mounting of files
+#'
+#' Similar to [run()], but automatically mounts files (and directories) so the
+#' user doesn't have to keep track of volumes.
+#'
+#' The main difference to [run()] is that the use of names for the `args`; any
+#' file (or directory) that should be mounted inside the container must be named
+#' `file`. The other elements (arguments) don't need to be named. Note that it
+#' is fine to have multiple elements with the same name (`file`).
+#'
+#' This should generally work as long as the command accepts absolute paths
+#' for file input. If that is not the case, use [run()] instead and specify
+#' paths and mounting manually.
+#'
+#' @inheritParams run
+#' @param args Character vector, arguments to the command. Any files or
+#'   directories that should be mounted must be named "file" (see example).
+#' @param wd Local working directory to run command. If specified, the working
+#'   directory will be mounted to the docker container.
+#' @param wd_in_container Working directory to run command in
+#'   the container. Defaults to the working directory mounted to the container
+#'   (`wd`).
+#'
+#' @return List, formatted as output from [processx::run()]
+#' @examples
+#' if (test_docker_installation()) {
+#'
+#' # Count the number of lines in the DESCRIPTION and LICENSE
+#' # files of this package
+#' run_auto_mount(
+#'   container_id = "alpine",
+#'   command = "wc",
+#'   args = c("-l",
+#'     file = system.file("DESCRIPTION", package = "babelwhale"),
+#'     file = system.file("LICENSE", package = "babelwhale")
+#'   )
+#' )
+#'
+#' }
+#' @export
+run_auto_mount <- function(
+  container_id,
+  command,
+  args = NULL,
+  wd = NULL,
+  wd_in_container = NULL,
+  environment_variables = NULL,
+  debug = FALSE,
+  verbose = FALSE,
+  stdout = "|",
+  stderr = "|") {
+
+  # Convert paths of file arguments to absolute for docker
+  file_args <- args[names(args) == "file"]
+  in_path <- fs::path_abs(file_args)
+  in_file <- fs::path_file(in_path)
+  in_dir <- fs::path_dir(in_path)
+
+  # Make (most likely) unique prefix for folder name that
+  # won't conflict with an existing folder in the container
+  # based on the hash of the container id and command
+  prefix <- paste0("/babelwhale/", digest::digest(c(container_id, command)))
+
+  # Specify volume mounting for working directory
+  wd_volume <- NULL
+  if (!is.null(wd)) {
+    wd_path <- fs::path_abs(wd)
+    if (is.null(wd_in_container)) wd_in_container <- glue::glue("{prefix}_wd")
+    wd_volume <- glue::glue("{wd_path}:{wd_in_container}")
+  }
+
+  # Specify all volumes: one per file, plus working directory
+  dirs_to_mount <- unique(in_dir)
+  mount_path <- glue::glue("{prefix}{dirs_to_mount}")
+  volumes <- c(
+    glue::glue("{dirs_to_mount}:{mount_path}"),
+    wd_volume
+  )
+
+  # Replace file arg paths with location in container
+  out_dir <- purrr::set_names(mount_path, dirs_to_mount)[in_dir]
+  files_in_container <- glue::glue("{out_dir}/{in_file}")
+  args[names(args) == "file"] <- files_in_container
+
+  # Run docker via babelwhale
+  run(
+    container_id = container_id,
+    command = command,
+    args = args,
+    volumes = volumes,
+    workspace = wd_in_container,
+    environment_variables = environment_variables,
+    debug = debug,
+    verbose = verbose,
+    stdout = stdout,
+    stderr = stderr
+  )
+}

tests/testthat/test-run_auto_mount.R

@@ -0,0 +1,63 @@
+configs <- list(
+  docker = create_docker_config(),
+  singularity = create_singularity_config(cache_dir = tempdir())
+)
+
+config <- configs[[1]]
+
+for (config in configs) {
+  context(paste0("Testing ", config$backend))
+
+  set_default_config(config, permanent = FALSE)
+
+  skip_on_cran()
+  skip_on_github_actions()
+
+  test_that(paste0("run_auto_mount can mount files on ", config$backend), {
+    # warm up
+    output <- run("alpine", "echo", "hello")
+
+    output <-
+      run_auto_mount(
+        container_id = "alpine",
+        command = "cat",
+        args = c(file = system.file("DESCRIPTION", package = "babelwhale")
+        )
+      )
+    expect_equal(
+      strsplit(output$stdout, "\n", fixed = TRUE)[[1]][[1]],
+      "Package: babelwhale" # first line of DESCRIPTION
+    )
+    expect_equal(output$status, 0)
+
+  })
+
+  test_that(paste0("run_auto_mount wd arg works on ", config$backend), {
+    output <-
+      run_auto_mount(
+        container_id = "alpine",
+        command = "ls",
+        wd = system.file(package = "babelwhale")
+      )
+    expect_match(
+      output$stdout,
+      "DESCRIPTION" # should be a DESCRIPTION file in babelwhale package dir
+    )
+    expect_equal(output$status, 0)
+  })
+
+  test_that(paste0("run_auto_mount wd_in_container arg works on ", config$backend), {
+    output <-
+      run_auto_mount(
+        container_id = "alpine",
+        command = "pwd",
+        wd_in_container = "/bin"
+      )
+    expect_equal(
+      output$stdout,
+      "/bin\n"
+    )
+    expect_equal(output$status, 0)
+  })
+
+}