increase code coverage

NAMESPACE

@@ -12,6 +12,7 @@ export(get_description)
 export(get_hex)
 export(infer_biocviews)
 export(infer_deps)
+export(infer_docker_org)
 export(is_gha)
 export(use_badges)
 export(use_codespace)

R/check_registry.R

@@ -6,8 +6,9 @@
 #' 
 #' @keywords internal
 check_registry <- function(registry){
-  registry <- registry[1]
+
   if(!is.null(registry)){
+    registry <- registry[1]
     if(!grepl("/$",registry)){
       registry <- paste0(registry,"/")
     }

R/conda_installed.R

@@ -1,18 +1,18 @@
 conda_installed <- function(verbose = FALSE){
-  if(is_gha()){
-    if(Sys.getenv("CONDA")!=""){
-      messager("Using CONDA=",Sys.getenv("CONDA"), v=verbose)
-      return(TRUE)
-    } else if(Sys.getenv("CONDA_EXE")!=""){
-      messager("Using CONDA_EXE=",Sys.getenv("CONDA_EXE"), v=verbose)
-      return(TRUE)
-    } else {
-      messager("CONDA not found.", v=verbose)
-      return(FALSE)
-    }
-    # reticulate::use_miniconda(conda=Sys.getenv("CONDA_EXE"))
-  } else {
+  # if(is_gha()){
+  #   if(Sys.getenv("CONDA")!=""){
+  #     messager("Using CONDA=",Sys.getenv("CONDA"), v=verbose)
+  #     return(TRUE)
+  #   } else if(Sys.getenv("CONDA_EXE")!=""){
+  #     messager("Using CONDA_EXE=",Sys.getenv("CONDA_EXE"), v=verbose)
+  #     return(TRUE)
+  #   } else {
+  #     messager("CONDA not found.", v=verbose)
+  #     return(FALSE)
+  #   }
+  #   # reticulate::use_miniconda(conda=Sys.getenv("CONDA_EXE"))
+  # } else {
     requireNamespace("reticulate")
     utils::getFromNamespace("conda_installed","reticulate")()
-  }
+  # }
 }

R/infer_deps.R

@@ -21,7 +21,7 @@
 #' @importFrom renv dependencies
 #' @examples 
 #' #### Get example DESCRIPTION file ####
-#' url <- "https://github.com/neurogenomics/templateR/raw/master/DESCRIPTION" 
+#' url <- "https://github.com/neurogenomics/templateR/raw/master/DESCRIPTION"
 #' path <- tempfile(fileext = "DESCRIPTION")
 #' utils::download.file(url,path)
 #' 

R/infer_docker_org.R

@@ -1,12 +1,25 @@
-infer_docker_org <- function(docker_org,
+#' Infer Docker registry organisation name
+#' 
+#' Infer Docker registry organisation name from DESCRIPTION file.
+#' @inheritParams use_vignette_docker
+#' @inheritParams use_workflow
+#' @inheritDotParams get_description
+#' @returns Docker registry organisation name.
+#' 
+#' @export
+#' @examples
+#' infer_docker_org(docker_org="myorg", docker_registry="ghcr.io")
+infer_docker_org <- function(docker_org=NULL,
                              docker_registry,
-                             verbose=TRUE){
+                             verbose=TRUE,
+                             ...){
   if(!is.null(docker_org)){
     return(docker_org)
   } else if(is.null(docker_org) && 
      grepl("ghcr.io",docker_registry)){
     ## Infer docker_org from DESCRIPTION
-    desc_file <- get_description(verbose = verbose)
+    desc_file <- get_description(verbose = verbose,
+                                 ...)
     gh_url <- get_github_url_desc(desc_file = desc_file[[1]])
     if(!is.null(gh_url)){
       docker_org <- rev(strsplit(gh_url,"/")[[1]])[2]

tests/testthat/test-construct_cont.R

@@ -18,9 +18,16 @@ test_that("construct_cont works", {
   testthat::expect_null(cont3[[2]])
   testthat::expect_null(cont3[[3]])
 
-  cont4 <- construct_cont(default_tag = "release", 
+  cont4 <- construct_cont(default_tag = "release",
+                          default_registry = "ghcr.io",
                           run_check_cont = TRUE) 
   testthat::expect_equal(cont4[[1]], paste0(default_registry,"bioconductor/bioconductor_docker:latest"))
   testthat::expect_null(cont4[[2]])
   testthat::expect_null(cont4[[3]])
+
+
+  cont5 <- construct_cont(default_registry = NULL) 
+  testthat::expect_equal(cont5[[1]],"bioconductor/bioconductor_docker:devel")
+  testthat::expect_null(cont5[[2]])
+  testthat::expect_null(cont5[[3]])
 })

tests/testthat/test-infer_docker_org.R

@@ -1,12 +1,22 @@
 test_that("infer_docker_org works", {
 
- testthat::expect_error(
-   infer_docker_org(docker_org = NULL, 
-                    docker_registry = "docker.io")
- )
-
+  ## User-given
   docker_org <- "neurogenomicslab"
   out <- infer_docker_org(docker_org = docker_org, 
                           docker_registry = "docker.io")
   testthat::expect_equal(out,docker_org)
+
+  ## Infer from GH info in DESCRIPTION
+  d <- desc::desc(package = "yaml")
+  out <- infer_docker_org(docker_org = NULL, 
+                          docker_registry = "ghcr.io",
+                          paths=d)
+  testthat::expect_equal(out,"vubiostat")
+
+  ## Unable to infer for DockerHub
+  testthat::expect_error(
+    infer_docker_org(docker_org = NULL, 
+                     docker_registry = "docker.io")
+  )
+
 })

tests/testthat/test-use_codespace.R

@@ -1,10 +1,18 @@
 test_that("use_codespace works", {
 
-  path <- use_codespace(save_dir=tempdir())
-  testthat::expect_true(file.exists(path))
+  run_tests <- function(path){
+    testthat::expect_true(file.exists(path))
+    jsn <- jsonlite::read_json(path)
+    testthat::expect_true(
+      all(c("image","features","customizations") %in% names(jsn))
+    )
+  }
+  save_dir <- tempdir()
+  ## First time
+  path <- use_codespace(save_dir=save_dir)
+  run_tests(path)
 
-  jsn <- jsonlite::read_json(path)
-  testthat::expect_true(
-    all(c("image","features","customizations") %in% names(jsn))
-  )
+  ## Second time
+  path2 <- use_codespace(save_dir=save_dir, show=TRUE)
+  run_tests(path2)
 })