Fix get_description_repos

Author: bschilder

NEWS.md

@@ -8,6 +8,8 @@
 * Revamp `get_hex` and `get_description` 
   - Use lists more consistently
   - More robust in general
+* `get_description`
+  - Actually use `use_repos` arg.
 
 # rworkflows 0.99.11
 

R/get_description_check.R renamed to R/check_refs_names.R

@@ -1,12 +1,14 @@
-get_description_check <- function(dl,
-                                  verbose=TRUE){
+check_refs_names <- function(dl){
   ### Make sure it gets a name ####
   if(is.null(unlist(dl))) return(NULL)
   for(i in seq(length(dl))){
     nm <- names(dl[i])
-    if((is.null(nm) || nm=="NULL") && 
-       methods::is(dl[[i]],"description") ){
-      names(dl)[i] <- dl[[i]]$get_field("Package")
+    if(is.null(nm) || nm=="NULL"){
+      if(methods::is(dl[[i]],"description")){
+        names(dl)[i] <- dl[[i]]$get_field("Package")  
+      } else if(is.character(dl[[i]])){
+        names(dl)[i] <- dl[[i]]
+      } 
     } 
     # else if(!is.null(names(dl[i])) && !is.null(dl[[i]]) &&
     #           basename(names(dl[i]))!=dl[[i]]$get_field("Package")){
@@ -17,4 +19,4 @@ get_description_check <- function(dl,
     # }
   } 
   return(dl)
-}
+}

R/dt_to_desc.R

@@ -14,26 +14,28 @@
 #' @importFrom  data.table as.data.table 
 #' @import desc
 #' @examples 
-#'  db <-   BiocPkgTools::biocPkgList()
+#'  db <- BiocPkgTools::biocPkgList()
 #'  dl <- dt_to_desc(db=db, refs="GenomicRanges")
 dt_to_desc <- function(db,
                        refs=NULL,
                        verbose=TRUE){
 
   Package <- NULL;
 
+  refs <- check_refs_names(refs)
   db <- data.table::as.data.table(db)
   if(is.null(refs)){
     refs <- db$Package
   }else{
-    refs <- refs[basename(refs) %in% db$Package]
+    refs <- refs[basename(names(refs)) %in% db$Package]
   }
   messager("Constructing DESCRIPTION files for",
-           formatC(length(refs),big.mark = ","),"R packages.",v=verbose)
-  valid_fields <-desc::cran_valid_fields
-  lapply(stats::setNames(basename(refs),
+           formatC(length(refs),big.mark = ","),"R package(s).",v=verbose)
+  valid_fields <- desc::cran_valid_fields
+  lapply(stats::setNames(names(refs),
                          refs),
          function(p){
+           p <- basename(p)
            messager("Constructing DESCRIPTION for:",p,v=verbose)
            db_sub <- db[Package==p,][1,]
            d <- desc::description$new("!new")
@@ -50,4 +52,4 @@ dt_to_desc <- function(db,
            }
            d
          })
-}
+}

R/get_description.R

@@ -37,7 +37,7 @@ get_description <- function(refs=NULL,
                                                         which = "cache"),
                             force_new=FALSE,
                             use_wd=TRUE,
-                            use_repos=TRUE,
+                            use_repos=FALSE,
                             verbose=TRUE){
   # devoptera::args2vars(get_description)
 
@@ -47,45 +47,36 @@ get_description <- function(refs=NULL,
   refs <- refs_to_list(refs = refs)
   paths <- refs_to_list(refs = paths) 
   if(methods::is(refs[[1]],"description")) {
-    refs <- get_description_check(dl = refs,
-                                  verbose = verbose) 
+    refs <- check_refs_names(dl = refs) 
     return(refs)
   }
   if(methods::is(paths[[1]],"description")) {
-    paths <- get_description_check(dl = paths,
-                                   verbose = verbose) 
+    paths <- check_refs_names(dl = paths) 
     return(paths) 
   }
   if(all(is.na(refs))) refs <- NULL
-  
   #### Method 1 ####
-  dl1 <- get_description_manual(refs=refs,
-                                paths=paths,
-                                cache_dir=cache_dir,
-                                force_new=force_new,
-                                use_wd=use_wd,
-                                verbose=verbose)
-  dl1 <- get_description_check(dl = dl1,
-                               verbose=verbose) 
-  refs <- names(dl1)
-  if(!is.null(unlist(dl1))){
-    if(all(basename(unlist(refs)) %in% basename(names(dl1)))) {
-      return(dl1)
-    } 
-  }
   if(isFALSE(use_repos) || 
      is.null(refs)){
-    return(dl1)
-  } else {
-    #### Method 2 ####
-    missing_refs <- names(dl1)[unlist(lapply(dl1,is.null))]
-    for(ref in missing_refs){
-      dl2 <- get_description_repo(refs=refs,  
+    dl1 <- get_description_manual(refs=refs,
+                                  paths=paths,
+                                  cache_dir=cache_dir,
+                                  force_new=force_new,
+                                  use_wd=use_wd,
                                   verbose=verbose)
-      dl2 <- get_description_check(dl = dl2)
-      dl1[[ref]] <- dl2[[ref]]
-    } 
+    dl1 <- check_refs_names(dl = dl1) 
     return(dl1)
-  }
-  
+    refs <- names(dl1)
+    # if(!is.null(unlist(dl1))){
+    #   if(all(basename(unlist(refs)) %in% basename(names(dl1)))) {
+    #     return(dl1)
+    #   } 
+    # }
+  } else {
+  #### Method 2 #### 
+    dl2 <- get_description_repo(refs = refs,  
+                                verbose = verbose)
+    dl2 <- check_refs_names(dl = dl2) 
+    return(dl2)
+  } 
 }

R/get_description_repo.R

@@ -39,15 +39,18 @@ get_description_repo <- function(refs = NULL,
       saveRDS(db_i, tmp)
     }
     return(db_i)
-  }) |> data.table::rbindlist(fill = TRUE, use.names = TRUE, idcol = "r_repo")  
-  if(!is.null(refs)) db <- db[Package %in% basename(refs),]
+  }) |> data.table::rbindlist(fill = TRUE, use.names = TRUE, idcol = "r_repo")
+  
+  refs <- check_refs_names(dl = refs)
+  if(!is.null(refs)) db <- db[Package %in% basename(names(refs)),]
   if(nrow(db)==0) {
     messager("0 DESCRIPTION files found in CRAN/Bioc.",
              "Returning NULL.",v=verbose)
     return(NULL)
   }
   #### Parse GitHub URL #####
-  db <- get_github_url_db(db = db, return_dt = TRUE) 
+  db <- get_github_url_db(db = db, 
+                          return_dt = TRUE) 
   #### Split GitHub URL ####
   db <- cbind(db,BiocPkgTools::githubURLParts(urls = db$url_github))
   data.table::setnames(db,c("user_repo","user"),c("owner_repo","owner"),
@@ -73,4 +76,4 @@ get_description_repo <- function(refs = NULL,
   # deepdep::deepdep(package = "rworkflows",depth = 2,bioc = TRUE)
   # d <- deepdep::get_description(package = "rworkflows") 
   # deepdep::plot_downloads("htmltools")
-}
+}

man/get_description.Rd

@@ -61,4 +61,13 @@ test_that("get_description works", {
     testthat::expect_null(d7[[1]])
   }
 
+  #### Search CRAN/Bioc repos ####
+  d13 <- get_description(refs="neurogenomics/rworkflows", 
+                         use_repos = TRUE) 
+  testthat::expect_equal(d13[[1]],
+                         d1[[1]])
+  #### Search GitHub repos ####
+  d14 <- get_description(refs="neurogenomics/orthogene",
+                         use_wd = FALSE) 
+  testthat::expect_true(methods::is(d14[[1]],"description"))
 })

tests/testthat/test-get_description.R

@@ -73,7 +73,7 @@ This function creates a banner containing badges,
 a hex sticker (if one is available), and author names.
 
 ```{r, results='asis'}
-badges <- rworkflows::use_badges()
+badges <- rworkflows:: use_badges()
 ```