Depends on rworkflows functions. Fix bug in r_repos_data

Author: bschilder

.github/workflows/rworkflows.yml

@@ -29,12 +29,6 @@ jobs:
           r: latest
           bioc: release
     steps:
-    - if: ${{ env.ACT }}
-      name: Hack container for local development
-      run: |
-        curl -fsSL https://deb.nodesource.com/setup_18.x | sudo -E bash -
-        sudo apt-get install -y nodejs
-      shell: bash {0}
     - uses: neurogenomics/rworkflows@master
       with:
         run_bioccheck: ${{ false }}

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: echogithub
 Type: Package
 Title: echoverse module: Extract data and metadata from GitHub
-Version: 0.99.1
+Version: 0.99.2
 Authors@R: 
     c(person(given = "Brian",
            family = "Schilder",
@@ -33,20 +33,18 @@ Imports:
     gh,
     data.table,
     stringr,
-    testthat (>= 3.0.0),
     RCurl,
     rvest,
-    parallel
+    parallel,
+    rworkflows
 Suggests:
     markdown,
-    rmarkdown,
-    magick,
+    rmarkdown, 
+    testthat (>= 3.0.0),
     remotes,
     knitr,
     BiocStyle,
     covr,
-    badger,
-    hexSticker,
     httr, 
     BiocManager,
     githubinstall,

NAMESPACE

@@ -1,14 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
 export(description_extract)
-export(description_find)
 export(github_branches)
 export(github_commits)
 export(github_dependencies)
 export(github_dependents)
 export(github_files)
 export(github_files_download)
-export(github_hex)
 export(github_metadata)
 export(github_pages)
 export(github_pages_files)
@@ -20,7 +18,6 @@ export(r_repos)
 export(r_repos_data)
 export(r_repos_downloads)
 export(r_repos_opts)
-export(readme_header)
 importFrom(RCurl,url.exists)
 importFrom(data.table,":=")
 importFrom(data.table,.SD)
@@ -36,12 +33,11 @@ importFrom(gh,gh)
 importFrom(gh,gh_token)
 importFrom(methods,is)
 importFrom(parallel,mclapply)
+importFrom(rworkflows,get_description)
 importFrom(stats,setNames)
 importFrom(stringr,str_split)
 importFrom(stringr,str_to_sentence)
-importFrom(testthat,is_testing)
 importFrom(utils,available.packages)
 importFrom(utils,capture.output)
 importFrom(utils,download.file)
 importFrom(utils,installed.packages)
-importFrom(utils,packageDescription)

NEWS.md

@@ -1,3 +1,24 @@
+# echogithub 0.99.2
+
+## New features
+
+* Replace functions that have since been offloaded and improved in `rworkflows`
+    - `echogithub::description_find` --> `rworkflows::get_description`
+    - `echogithub::github_hex` --> `rworkflows::get_hex`
+    - `echogithub::readme_header` --> `rworkflows::use_badges`
+
+## Bug fixes
+
+* `github_dependents`
+    - Gather deps from all pages (not just the first one).
+* `description_authors`
+    - Fix to handle more complex situations 
+    without explicit naming of each field.
+* `r_repos_data`
+    - Add a check for find R packages that are on GitHub but just not available 
+    via `githubinstall` (which is a lot, since it became outdated years ago).
+    
+
 # echogithub 0.99.1
 
 ## New features

R/author_fields.R

@@ -0,0 +1,3 @@
+author_fields <- function(){
+    c("Authors@R","authors","Authors","author","Author")
+}

R/description_authors.R

@@ -1,9 +1,42 @@
+#' Description authors
+#' 
+#' Parse authors from the \emph{DESCRIPTION} file of an R package.
+#' @param names_only Only return author names (and not other subfields).
+#' For example:
+#' "Jim Hester \<james.f.hester\@gmail.com\> \[aut\]" would become
+#' "Jim Hester".
+#' @inheritParams description_extract
+#' @returns Authors as an HTML character string.
+#' 
+#' @keywords internal
 description_authors <- function(desc_file,
-                                add_html=TRUE){ 
+                                names_only=TRUE,
+                                add_html=FALSE,
+                                verbose=TRUE){  
+    # desc_file <- desc::desc(package = "desc")
+    # devoptera::args2vars(description_authors)
 
-    auths <- eval(parse(text = gsub('person','c',desc_file$`Authors@R`)));
-    authors <- paste(auths[names(auths)=='given'],
-                     auths[names(auths)=='family'], collapse = ', ')
+    afields <- author_fields()
+    afields <- afields[afields %in% desc_file$fields()][1]
+    if(length(afields)>0){
+        if(grepl("authors",afields,ignore.case = TRUE)){
+            authors <- desc_file$get_authors()
+        } else {
+            authors <- desc_file$get_author()
+            if(is.null(authors)){
+                authors <- desc_file$get_field(afields)
+            }
+        } 
+    } else {
+        message("No author fields detected. Returning NULL.",v=verbose)
+        return(NULL)
+    } 
+    if(isTRUE(names_only)){
+        authors <- gsub("(\\([^()]*\\)|\\[[^\\[\\]*\\]|<[^<>]*>)", "",
+                        authors) |>trimws()
+    } 
+    #### collapse ####
+    authors <- paste(authors,collapse = ", ")
     if(isTRUE(add_html)){
         return(paste0("<h4>Authors: <i>",authors,"</i></h4>"))
     } else {

R/description_extract.R

@@ -4,33 +4,37 @@
 #' @param fields Fields to extract.
 #' @param add_html Add HTML styling to certain fields (e.g "authors").
 #' @param as_datatable Convert the results into a \link[data.table]{data.table}.
-#' @inheritParams description_find
+#' @param desc_file When \code{owner} or \code{repo} are NULL, 
+#' these arguments are inferred from the \emph{DESCRIPTION} file.
+#' @inheritParams rworkflows::get_description
 #' @inheritParams github_files
+#' @inheritParams description_authors
 #' @returns A named list or \link[data.table]{data.table}.
 #' 
 #' @export
+#' @importFrom rworkflows get_description
 #' @importFrom data.table as.data.table
 #' @examples  
-#'\dontrun{
-#' res <- description_extract(repo="echolocatoR")
-#'}
+#' res <- description_extract(ref="RajLabMSSM/echolocatoR")
 description_extract <- function(desc_file = NULL,
-                                repo = NULL,
+                                ref = NULL,
                                 fields = c("owner",
                                            "repo",
                                            "authors"),
+                                names_only = TRUE,
                                 add_html = FALSE,
                                 as_datatable = FALSE, 
                                 verbose = TRUE){ 
+    
+    # devoptera::args2vars(description_extract)
     #### Find or read DESCRIPTION file ####
     if(is.null(desc_file)){
-        desc_file <- description_find(repo = repo,
-                                      desc_file = desc_file,
-                                      verbose = verbose)
+        desc_file <- rworkflows::get_description(ref = ref,
+                                                 path = desc_file)
     }
     force(desc_file)
     all_fields <- unique(c("owner","repo","authors","github_url",
-                           names(desc_file)))
+                           desc_file$fields()))
     if(is.null(desc_file)) {
         stopper("desc_file is required for description_extract")
     }
@@ -39,19 +43,28 @@ description_extract <- function(desc_file = NULL,
     } 
     fields <- unique(fields)
     fields <- fields[fields %in% all_fields]
+    #### Check package name ####
+    if(!desc_file$has_fields("Package")){
+        messager("WARNING:","Package field is missing from DECRIPTION.")
+    } else {
+        pkg <- desc_file$get_field("Package")
+    }
+     
     #### Extract info ####
-    messager("Extracting",length(fields),"field(s).",v=verbose)
+    messager("Extracting",length(fields),"DESCRIPTION field(s)",
+             "for the package:",pkg,v=verbose)
     res <- lapply(stats::setNames(fields,
                                   fields), 
                   function(f){
         # messager("Inferring",f,"from DESCRIPTION file.",v=verbose)
         #### Check fields ####
-        if(f %in% c("authors","Authors@R","Author")) {
+        if(f %in% author_fields()) {
             authors <- description_authors(desc_file = desc_file,
-                                           add_html = add_html) 
+                                           add_html = add_html, 
+                                           names_only = names_only) 
             return(authors)
-        } else if(f %in% names(desc_file)){
-            return(desc_file[[f]])
+        } else if(desc_file$has_fields(f)){
+            return(desc_file$get_field(f))
         } else if(f=="github_url"){
             gh_url <- get_github_url(desc_file = desc_file)
             return(gh_url)
@@ -60,14 +73,18 @@ description_extract <- function(desc_file = NULL,
             if(is.null(gh_url)) {
                 return(NULL)
             } else {
-                return(rev(strsplit(gh_url,"/")[[1]])[2])
+                return(
+                    strsplit(gsub("https://github.com/","",gh_url),"/")[[1]][1]
+                )
             }  
         } else if(f=="repo"){
             gh_url <- get_github_url(desc_file = desc_file)
             if(is.null(gh_url)) {
                 return(NULL)
             } else {
-                return(rev(strsplit(gh_url,"/")[[1]])[1])
+                return(
+                    strsplit(gsub("https://github.com/","",gh_url),"/")[[1]][2]
+                )
             }  
         } 
     })

R/description_extract_multi.R

@@ -1,26 +1,30 @@
 description_extract_multi <- function(pkgs,
                                       nThread=1,
+                                      fields=NULL,
                                       verbose=TRUE){
     requireNamespace("parallel")
+    repo <- package <- NULL;
 
     pkgs <- check_pkgs(pkgs = pkgs)    
-    meta_desc <- parallel::mclapply(pkgs$package, 
+    if(length(pkgs$package)==0){
+        messager("pkgs is an empty data.table. Returning NULL.",v=verbose)
+    }
+    meta_desc <- parallel::mclapply(stats::setNames(pkgs$package,
+                                                    pkgs$package), 
                         function(p){
                             tryCatch({
-                                description_extract(repo = p,
-                                                    fields = NULL,
+                                description_extract(ref = p,
+                                                    fields = fields,
                                                     as_datatable = TRUE,
                                                     verbose = FALSE)
                             }, error=function(e){messager(e,v=verbose);NULL})
                         }, mc.cores = nThread) |> 
-        data.table::rbindlist(fill = TRUE) |>
-        data.table::setnames("Package","package",
-                             skip_absent = TRUE) 
+        data.table::rbindlist(fill = TRUE, use.names = TRUE, idcol = "package")   
     if(nrow(meta_desc)==0){
         messager("WARNING: No metadata retrieved from any DESCRIPTION files.",
                  v=verbose)
     } else {
-        data.table::setkeyv(meta_desc,"package")
-    }
+        if("repo" %in% names(meta_desc)) data.table::setkeyv(meta_desc,"repo")
+    } 
     return(meta_desc)
 }