From 2a2e017bda662ab8815d6d5605a9b05dfa1c9148 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 25 May 2021 16:55:51 +0200 Subject: [PATCH 01/48] Clean get_repos() - Use inline function endpoint() - Avoid helper variable "page" --- R/get_repo_infos.R | 31 +++++++++++++++---------------- 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index e9feee4..81e58d0 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -31,31 +31,30 @@ get_gitlab_repos <- function(group = "KWB-R", get_github_repos <- function (group = "KWB-R", github_token = Sys.getenv("GITHUB_TOKEN")) { - - get_repos <- function(per_page = 100L) { + + endpoint <- function(group, page, per_page) sprintf( + "GET /orgs/%s/repos?page=%d&per_page=%d", group, page, per_page + ) - n_results <- per_page - page <- 1L repo_list <- list() - while(n_results == per_page) { + + finished <- FALSE + + while(! finished) { - repo_list[[page]] <- gh::gh(endpoint = sprintf("GET /orgs/%s/repos?page=%d&per_page=%d", - group, - page, - per_page), - .token = github_token) - n_results <- length(repo_list[[page]]) - page <- page + 1L + result <- gh::gh(endpoint(group, page, per_page), .token = github_token) + + if ((n_repos <- length(result)) > 0L) { + repo_list[[length(repo_list) + 1L]] <- result + } + + finished <- (n_repos < per_page) } do.call(what = c, args = repo_list) - } - - - for (repo_ind in seq_along(gh_repos)) { sel_repo <- gh_repos[[repo_ind]] From ee7000bb2ad11d4791a96f2a01bcb7d0a8eae0e6 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 25 May 2021 17:07:17 +0200 Subject: [PATCH 02/48] Avoid helper variable "finished" --- R/get_repo_infos.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index 81e58d0..cbcfe5c 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -39,17 +39,17 @@ get_github_repos <- function (group = "KWB-R", repo_list <- list() - finished <- FALSE + n_repos <- 0L - while(! finished) { + while(n_repos < per_page) { result <- gh::gh(endpoint(group, page, per_page), .token = github_token) - if ((n_repos <- length(result)) > 0L) { + n_repos <- length(result) + + if (n_repos > 0L) { repo_list[[length(repo_list) + 1L]] <- result } - - finished <- (n_repos < per_page) } do.call(what = c, args = repo_list) From 20886d7f698e15cdf5c79979284b45706c4ae278 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 25 May 2021 17:19:32 +0200 Subject: [PATCH 03/48] Fix :bug:: actually use "page"! - Use new variable page in while condition - Rename repo_list to all_repos - Rename result to repos - Add comments --- R/get_repo_infos.R | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index e4f160a..6516f99 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -37,22 +37,31 @@ get_github_repos <- function (group = "KWB-R", "GET /orgs/%s/repos?page=%d&per_page=%d", group, page, per_page ) - repo_list <- list() + all_repos <- list() - n_repos <- 0L - - while(n_repos < per_page) { - - result <- gh::gh(endpoint(group, page, per_page), .token = github_token) + # Start with the first page + page <- 1L - n_repos <- length(result) - - if (n_repos > 0L) { - repo_list[[length(repo_list) + 1L]] <- result + # Read next page while page number is given + while(page > 0L) { + + # Read repos from current page + repos <- gh::gh(endpoint(group, page, per_page), .token = github_token) + + # If the page contained at least one repo... + if (length(repos) > 0L) { + + # ... append repos to the list all_repos + all_repos[[length(all_repos) + 1L]] <- repos + + } else { + + # Set page number to zero to finish the while-loop + page <- 0L } } - do.call(what = c, args = repo_list) + do.call(what = c, args = all_repos) } gh_repos <- get_repos() From 539fb0fc8ef089986f7056187538df83245742f4 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 25 May 2021 17:22:58 +0200 Subject: [PATCH 04/48] Avoid endless loop, increment page! --- R/get_repo_infos.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index 6516f99..bf4aa00 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -54,6 +54,8 @@ get_github_repos <- function (group = "KWB-R", # ... append repos to the list all_repos all_repos[[length(all_repos) + 1L]] <- repos + page <- page <- 1L + } else { # Set page number to zero to finish the while-loop From 525918e5582667dcb0229a124362c498ed5c1664 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 25 May 2021 17:25:13 +0200 Subject: [PATCH 05/48] Fix :bug:: actually increment! --- R/get_repo_infos.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index bf4aa00..8ddd6af 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -54,7 +54,7 @@ get_github_repos <- function (group = "KWB-R", # ... append repos to the list all_repos all_repos[[length(all_repos) + 1L]] <- repos - page <- page <- 1L + page <- page + 1L } else { From 2363e4b388cc4e18c2f54f5b97d99470a9c264a4 Mon Sep 17 00:00:00 2001 From: hsonne Date: Mon, 29 Apr 2024 14:58:08 +0200 Subject: [PATCH 06/48] Improve formatting in get_repo_infos.R - add "section lines" for each function - improve indentation and spacing --- R/get_repo_infos.R | 372 +++++++++++++++++++++++++++------------------ 1 file changed, 220 insertions(+), 152 deletions(-) diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index 8ddd6af..7e8a9e6 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -1,4 +1,7 @@ +# get_gitlab_repos ------------------------------------------------------------- + #' get_gitlab_repos +#' #' @param group username or organisation for Gitlab (default: "KWB-R") #' @param gitlab_token gitlab access token (default: Sys.getenv("GITLAB_TOKEN")) #' @return data.frame with for all repositories of the user/organisation defined @@ -6,21 +9,26 @@ #' configured to allow that) #' @importFrom jsonlite fromJSON #' @export -get_gitlab_repos <- function(group = "KWB-R", - gitlab_token = Sys.getenv("GITLAB_TOKEN")) { - endpoint <- sprintf("https://gitlab.com/api/v4/groups/%s?private_token=%s", - group, - gitlab_token) - +get_gitlab_repos <- function( + group = "KWB-R", + gitlab_token = Sys.getenv("GITLAB_TOKEN") +) +{ + endpoint <- sprintf( + "https://gitlab.com/api/v4/groups/%s?private_token=%s", + group, + gitlab_token + ) gitlab_group <- jsonlite::fromJSON(endpoint) - gitlab_group$projects } +# get_github_repos ------------------------------------------------------------- #' get_github_repos +#' #' @param group username or organisation for Github (default: "KWB-R") #' @param github_token github access token (default: Sys.getenv("GITHUB_TOKEN")) #' @return data.frame with for all repositories of the user/organisation defined @@ -28,26 +36,28 @@ get_gitlab_repos <- function(group = "KWB-R", #' configured to allow that) #' @importFrom gh gh #' @export -get_github_repos <- function (group = "KWB-R", - github_token = Sys.getenv("GITHUB_TOKEN")) { - +get_github_repos <- function ( + group = "KWB-R", + github_token = Sys.getenv("GITHUB_TOKEN") +) +{ get_repos <- function(per_page = 100L) { - + endpoint <- function(group, page, per_page) sprintf( "GET /orgs/%s/repos?page=%d&per_page=%d", group, page, per_page ) all_repos <- list() - + # Start with the first page page <- 1L - + # Read next page while page number is given while(page > 0L) { - + # Read repos from current page repos <- gh::gh(endpoint(group, page, per_page), .token = github_token) - + # If the page contained at least one repo... if (length(repos) > 0L) { @@ -72,30 +82,38 @@ get_github_repos <- function (group = "KWB-R", sel_repo <- gh_repos[[repo_ind]] - tmp <- data.frame(name = sel_repo$name, - full_name = sel_repo$full_name, - url = sel_repo$html_url, - created_at = sel_repo$created_at, - pushed_at = sel_repo$pushed_at, - open_issues = sel_repo$open_issues, - license_key = ifelse(is.null(sel_repo$license$key), - NA, sel_repo$license$key), - license_short = ifelse(is.null(sel_repo$license$spdx_id), - NA, sel_repo$license$spdx_id), - license_link = ifelse(is.null(sel_repo$license$spdx_id), - NA, - sprintf("https://github.com/%s/blob/master/LICENSE", - sel_repo$full_name)), - stringsAsFactors = FALSE) - + tmp <- data.frame( + name = sel_repo$name, + full_name = sel_repo$full_name, + url = sel_repo$html_url, + created_at = sel_repo$created_at, + pushed_at = sel_repo$pushed_at, + open_issues = sel_repo$open_issues, + license_key = ifelse( + is.null(sel_repo$license$key), + NA, + sel_repo$license$key + ), + license_short = ifelse( + is.null(sel_repo$license$spdx_id), + NA, + sel_repo$license$spdx_id + ), + license_link = ifelse( + is.null(sel_repo$license$spdx_id), + NA, + sprintf("https://github.com/%s/blob/master/LICENSE", sel_repo$full_name) + ), + stringsAsFactors = FALSE + ) tmp$Repository <- sprintf("[%s](%s)", tmp$name, tmp$url) - tmp$License <- ifelse(is.na(tmp$license_short), - NA, - sprintf("[%s](%s)", - tmp$license_short, - tmp$license_link)) + tmp$License <- ifelse( + is.na(tmp$license_short), + NA, + sprintf("[%s](%s)", tmp$license_short, tmp$license_link) + ) if (repo_ind == 1) { res <- tmp @@ -103,163 +121,204 @@ get_github_repos <- function (group = "KWB-R", res <- rbind(res,tmp) } } + res <- res[order(res$name,decreasing = FALSE), ] + return(res) } - - - -badge_cran <- function(repo_names) { - sprintf("[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/%s)](http://www.r-pkg.org/pkg/%s)", - repo_names, - repo_names) +# badge_cran ------------------------------------------------------------------- +badge_cran <- function(repo_names) +{ + sprintf( + "[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/%s)](http://www.r-pkg.org/pkg/%s)", + repo_names, + repo_names + ) } -badge_codecov <- function(repo_full_names) { - sprintf("[![codecov](https://codecov.io/github/%s/branch/master/graphs/badge.svg)](https://codecov.io/github/%s)", - repo_full_names, - repo_full_names) +# badge_codecov ---------------------------------------------------------------- +badge_codecov <- function(repo_full_names) +{ + sprintf( + "[![codecov](https://codecov.io/github/%s/branch/master/graphs/badge.svg)](https://codecov.io/github/%s)", + repo_full_names, + repo_full_names + ) # sprintf("![codecov](https://img.shields.io/codecov/c/github/%s/master.svg", # repo_full_names) } -badge_license <- function(license_keys, - github_token = Sys.getenv("GITHUB_TOKEN")) { - gh_licenses <- gh::gh(endpoint = "GET /licenses", - .token = github_token) +# badge_license ---------------------------------------------------------------- +badge_license <- function( + license_keys, + github_token = Sys.getenv("GITHUB_TOKEN") +) +{ + gh_licenses <- gh::gh(endpoint = "GET /licenses", .token = github_token) gh_licenses_df <- data.table::rbindlist(gh_licenses, fill=TRUE) - #### License badges from: https://gist.github.com/lukas-h/2a5d00690736b4c3a7ba - license_badges <- data.frame(key = c("agpl-3.0", - "apache-2.0", - "bsd-2-clause", - "bsd-3-clause", - "epl-2.0", - "gpl-2.0", - "gpl-3.0", - "lgpl-2.1", - "lgpl-3.0", - "mit", - "mpl-2.0", - "unlicense"), - badge_url = c("https://img.shields.io/badge/License-AGPL%20v3-blue.svg", - "https://img.shields.io/badge/License-Apache%202.0-blue.svg", - "https://img.shields.io/badge/License-BSD%202--Clause-orange.svg", - "https://img.shields.io/badge/License-BSD%203--Clause-blue.svg", - "", - "https://img.shields.io/badge/License-GPL%20v2-blue.svg", - "https://img.shields.io/badge/License-GPL%20v3-blue.svg", - "", - "https://img.shields.io/badge/License-LGPL%20v3-blue.svg", - "https://img.shields.io/badge/License-MIT-yellow.svg", - "https://img.shields.io/badge/License-MPL%202.0-brightgreen.svg", - "https://img.shields.io/badge/license-Unlicense-blue.svg"), - license_url = c("https://opensource.org/licenses/AGPL-3.0", - "https://opensource.org/licenses/Apache-2.0", - "https://opensource.org/licenses/BSD-2-Clause", - "https://opensource.org/licenses/BSD-3-Clause", - "https://www.eclipse.org/legal/epl-2.0/", - "https://www.gnu.org/licenses/gpl-2.0", - "https://www.gnu.org/licenses/gpl-3.0", - "https://www.gnu.org/licenses/lgpl-2.1", - "https://www.gnu.org/licenses/lgpl-3.0", - "https://opensource.org/licenses/MIT", - "https://opensource.org/licenses/MPL-2.0", - "http://unlicense.org/"), - stringsAsFactors = FALSE) + license_badges <- data.frame(key = c( + "agpl-3.0", + "apache-2.0", + "bsd-2-clause", + "bsd-3-clause", + "epl-2.0", + "gpl-2.0", + "gpl-3.0", + "lgpl-2.1", + "lgpl-3.0", + "mit", + "mpl-2.0", + "unlicense" + ), + badge_url = c( + "https://img.shields.io/badge/License-AGPL%20v3-blue.svg", + "https://img.shields.io/badge/License-Apache%202.0-blue.svg", + "https://img.shields.io/badge/License-BSD%202--Clause-orange.svg", + "https://img.shields.io/badge/License-BSD%203--Clause-blue.svg", + "", + "https://img.shields.io/badge/License-GPL%20v2-blue.svg", + "https://img.shields.io/badge/License-GPL%20v3-blue.svg", + "", + "https://img.shields.io/badge/License-LGPL%20v3-blue.svg", + "https://img.shields.io/badge/License-MIT-yellow.svg", + "https://img.shields.io/badge/License-MPL%202.0-brightgreen.svg", + "https://img.shields.io/badge/license-Unlicense-blue.svg" + ), + license_url = c( + "https://opensource.org/licenses/AGPL-3.0", + "https://opensource.org/licenses/Apache-2.0", + "https://opensource.org/licenses/BSD-2-Clause", + "https://opensource.org/licenses/BSD-3-Clause", + "https://www.eclipse.org/legal/epl-2.0/", + "https://www.gnu.org/licenses/gpl-2.0", + "https://www.gnu.org/licenses/gpl-3.0", + "https://www.gnu.org/licenses/lgpl-2.1", + "https://www.gnu.org/licenses/lgpl-3.0", + "https://opensource.org/licenses/MIT", + "https://opensource.org/licenses/MPL-2.0", + "http://unlicense.org/" + ), + stringsAsFactors = FALSE + ) - gh_licenses_df <- dplyr::left_join(gh_licenses_df, - license_badges) + gh_licenses_df <- dplyr::left_join(gh_licenses_df, license_badges) - gh_licenses_df$Badge_License <- sprintf("[![%s](%s)](%s)", - gh_licenses_df$spdx_id, - gh_licenses_df$badge_url, - gh_licenses_df$license_url) + gh_licenses_df$Badge_License <- sprintf( + "[![%s](%s)](%s)", + gh_licenses_df$spdx_id, + gh_licenses_df$badge_url, + gh_licenses_df$license_url + ) badges <- gh_licenses_df %>% dplyr::select_(~key, ~Badge_License) %>% dplyr::rename_(license_key = ~key) - - res <- dplyr::left_join(x = data.frame(license_key = license_keys, - stringsAsFactors = FALSE), - y = badges) + res <- dplyr::left_join( + x = data.frame( + license_key = license_keys, + stringsAsFactors = FALSE + ), + y = badges + ) return(res$Badge_License) } - -badge_appveyor <- function(repo_full_names) { - sprintf("[![Appveyor](https://ci.appveyor.com/api/projects/status/github/%s?branch=master&svg=true)](https://ci.appveyor.com/project/%s/branch/master)", - repo_full_names, - gsub(".", "-", repo_full_names, fixed = TRUE)) +# badge_appveyor --------------------------------------------------------------- +badge_appveyor <- function(repo_full_names) +{ + sprintf( + "[![Appveyor](https://ci.appveyor.com/api/projects/status/github/%s?branch=master&svg=true)](https://ci.appveyor.com/project/%s/branch/master)", + repo_full_names, + gsub(".", "-", repo_full_names, fixed = TRUE) + ) } -badge_travis <- function(repo_full_names) { - sprintf("[![Travis](https://travis-ci.org/%s.svg?branch=master)](https://travis-ci.org/%s)", - repo_full_names, - repo_full_names) +# badge_travis ----------------------------------------------------------------- +badge_travis <- function(repo_full_names) +{ + sprintf( + "[![Travis](https://travis-ci.org/%s.svg?branch=master)](https://travis-ci.org/%s)", + repo_full_names, + repo_full_names + ) } - - -badge_zenodo <- function(repo_full_names, - zenodo_token = Sys.getenv("ZENODO_TOKEN")) { - +# badge_zenodo ----------------------------------------------------------------- +badge_zenodo <- function( + repo_full_names, + zenodo_token = Sys.getenv("ZENODO_TOKEN") +) +{ zen_data <- zen_collections(access_token = zenodo_token) zen_badge <- rep(NA, length = length(repo_full_names)) for (index in seq_along(repo_full_names)) { - doi_exists <- stringr::str_detect(string = zen_data$metadata.related_identifiers.identifier, - pattern = sprintf("https://github.com/%s", - repo_full_names[index])) + + doi_exists <- stringr::str_detect( + string = zen_data$metadata.related_identifiers.identifier, + pattern = sprintf("https://github.com/%s", repo_full_names[index]) + ) + doi_exists[is.na(doi_exists)] <- FALSE - if(sum(doi_exists) == 1) { + if (sum(doi_exists) == 1) { - zen_badge[index] <- sprintf("[![DOI](%s)](%s)", - zen_data$links.badge[doi_exists], - zen_data$doi_url[doi_exists]) + zen_badge[index] <- sprintf( + "[![DOI](%s)](%s)", + zen_data$links.badge[doi_exists], + zen_data$doi_url[doi_exists] + ) } else if (sum(doi_exists) > 1) { - warn_msg <- sprintf("Multiple entries found for repo '%s':\n%s", - repo_full_names[index], - paste(zen_data$metadata.related_identifiers.identifier[doi_exists], - collapse = "\n")) + warn_msg <- sprintf( + "Multiple entries found for repo '%s':\n%s", + repo_full_names[index], + paste( + zen_data$metadata.related_identifiers.identifier[doi_exists], + collapse = "\n" + ) + ) warning(warn_msg) zen_badge[index] <- "Multiple badges found!" } else { zen_badge[index] <- NA } } + return(zen_badge) } - -get_coverage <- function(repo_full_name, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE) { - - +# get_coverage ----------------------------------------------------------------- +get_coverage <- function( + repo_full_name, + codecov_token = Sys.getenv("CODECOV_TOKEN"), + dbg = TRUE +) +{ url <- sprintf("https://codecov.io/api/gh/%s", repo_full_name) - if(dbg) cat(sprintf("Checking code coverage for %s at %s", - repo_full_name, - url)) + if(dbg) { + cat(sprintf("Checking code coverage for %s at %s", repo_full_name, url)) + } + + req <- sprintf("%s?access_token=%s", url, codecov_token) - req <- sprintf("%s?access_token=%s", - url, - codecov_token) if(httr::status_code(httr::GET(url = req)) == 200L) { codecov_data <- jsonlite::fromJSON(req) if(!is.null(codecov_data$commit$totals$c)) { - codecov_coverage <- round(as.numeric(codecov_data$commit$totals$c),digits = 2) + codecov_coverage <- round( + as.numeric(codecov_data$commit$totals$c), + digits = 2 + ) } else { codecov_coverage <- NA } @@ -268,28 +327,37 @@ get_coverage <- function(repo_full_name, } if(dbg) cat(sprintf("....%3.1f%%\n", codecov_coverage)) + return(codecov_coverage) } -get_coverages <- function (repo_full_names, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE) { - coverage_percent <- rep(NA, - length = length(repo_full_names)) - coverage_url <- rep(NA, - length = length(repo_full_names)) +# get_coverages ---------------------------------------------------------------- +get_coverages <- function ( + repo_full_names, + codecov_token = Sys.getenv("CODECOV_TOKEN"), + dbg = TRUE +) +{ + coverage_percent <- rep(NA, length = length(repo_full_names)) + coverage_url <- rep(NA, length = length(repo_full_names)) for (index in seq_along(repo_full_names)) { - coverage_percent[index] <- get_coverage(repo_full_name = repo_full_names[index], - codecov_token, - dbg) + coverage_percent[index] <- get_coverage( + repo_full_name = repo_full_names[index], + codecov_token, + dbg + ) } - available_indices <- which(!is.na(coverage_percent)) - coverage_url[available_indices] <- sprintf("https://codecov.io/gh/%s", - repo_full_names[available_indices]) - return(data.frame(Coverage = coverage_percent, - Coverage_url = coverage_url)) + coverage_url[available_indices] <- sprintf( + "https://codecov.io/gh/%s", + repo_full_names[available_indices] + ) + + return(data.frame( + Coverage = coverage_percent, + Coverage_url = coverage_url + )) } From 5a9b0606bf00e6fec252eb8a9302cf3af8d5566a Mon Sep 17 00:00:00 2001 From: hsonne Date: Mon, 29 Apr 2024 20:58:57 +0200 Subject: [PATCH 07/48] Clean the package --- DESCRIPTION | 2 +- R/badge_codecov.R | 26 ++-- R/badge_cran.R | 27 ++-- R/badge_dependencies.R | 25 ++-- R/badge_gitlab.R | 27 ++-- R/badge_license.R | 72 +++-------- R/badge_opencpu.R | 27 ++-- R/badge_zenodo.R | 50 +++++--- R/badges_ci.R | 63 +++++++--- R/check_documentation.R | 46 +++---- R/check_gitlab_backup.R | 47 +++---- R/check_opencpu_deploy.R | 26 ++-- R/create_report_rpackages.R | 37 +++--- R/get_coverages.R | 78 +++++++----- R/get_license_badge_info.R | 70 +++++++++++ R/get_non_r_packages.R | 60 +++++++-- R/get_repo_infos.R | 222 +++++++++++++++++---------------- R/prepare_status_rpackages.R | 143 +++++++++++---------- R/url_helpers.R | 49 ++++++++ R/utils.R | 50 ++++++++ R/zen_collections.R | 18 ++- man/badge_gitlab.Rd | 4 +- man/badge_license.Rd | 2 +- man/badge_opencpu.Rd | 3 +- man/check_gitlab_backup.Rd | 4 +- man/create_report_rpackages.Rd | 3 +- man/get_github_repos.Rd | 2 +- man/get_gitlab_repos.Rd | 2 +- 28 files changed, 746 insertions(+), 439 deletions(-) create mode 100644 R/get_license_badge_info.R create mode 100644 R/url_helpers.R create mode 100644 R/utils.R diff --git a/DESCRIPTION b/DESCRIPTION index 59f000e..9e0042d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -38,4 +38,4 @@ ByteCompile: true Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true -RoxygenNote: 7.1.1 +RoxygenNote: 7.3.1 diff --git a/R/badge_codecov.R b/R/badge_codecov.R index 47669d9..7671cf6 100644 --- a/R/badge_codecov.R +++ b/R/badge_codecov.R @@ -1,17 +1,23 @@ #' badge_codecov +#' #' @param repo_full_names vector with combination of username/repo (e.g. #' c("KWB-R/kwb.utils", "KWB-R/kwb.db")) #' @return codecov badges for provided repo_full_names #' @export -badge_codecov <- function(repo_full_names) { - paste0("[![codecov](https://codecov.io/github/", - repo_full_names, - "/branch/master/graphs/badge.svg)](https://codecov.io/github/", - repo_full_names, - ")") - +badge_codecov <- function(repo_full_names) +{ + to_full_url <- function(path_pattern) { + compose_url( + protocol = "https", + domain_name = "codecov.io", + path = sprintf(path_pattern, repo_full_names) + ) + } + + image_link( + image_name = "codecov", + image_url = to_full_url("github/%s/branch/master/graphs/badge.svg"), + link_url = to_full_url("github/%s") + ) } - - - diff --git a/R/badge_cran.R b/R/badge_cran.R index 5bddf0a..a045c19 100644 --- a/R/badge_cran.R +++ b/R/badge_cran.R @@ -1,15 +1,22 @@ #' badge_cran +#' #' @param repo_names vector of repository names (e.g. c("kwb.utils", "kwb.db")) #' @return crank badges for provided repo_names #' @export -badge_cran <- function(repo_names) { - paste0("[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/", - repo_names, - ")](http://www.r-pkg.org/pkg/", - repo_names, - ")") +badge_cran <- function(repo_names) +{ + to_full_url <- function(path) { + compose_url( + protocol = "http", + subdomain = "www", + domain_name = "r-pkg.org", + path = paste0(path, "/", repo_names) + ) + } + + image_link( + image_name = "CRAN_Status_Badge", + image_url = to_full_url("badges/version"), + link_url = to_full_url("pkg") + ) } - - - - diff --git a/R/badge_dependencies.R b/R/badge_dependencies.R index 79dcc68..963ab97 100644 --- a/R/badge_dependencies.R +++ b/R/badge_dependencies.R @@ -1,13 +1,22 @@ #' badge_dependencies +#' #' @param repo_names vector of repository names (e.g. c("kwb.utils", "kwb.db")) #' @return dependency badges for provided repo_names #' @export -badge_dependencies <- function(repo_names) { - paste0("[![Dependencies_badge](https://kwb-githubdeps.netlify.app/badge/", - repo_names, - ")](https://kwb-githubdeps.netlify.app)") +badge_dependencies <- function(repo_names) +{ + to_full_url <- function(path = "") { + compose_url( + protocol = "https", + subdomain = "kwb-githubdeps", + domain_name = "netlify.app", + path = path + ) + } + + image_link( + image_name = "Dependencies_badge", + image_url = to_full_url(paste0("badge/", repo_names)), + link_url = to_full_url() + ) } - - - - diff --git a/R/badge_gitlab.R b/R/badge_gitlab.R index 42060be..4cc26f4 100644 --- a/R/badge_gitlab.R +++ b/R/badge_gitlab.R @@ -1,19 +1,24 @@ #' badge_gitlab +#' #' @param url url to repository on Gitlab #' @param logo_path path to Gitlab logo (default: #' "https://gitlab.com/gitlab-com/gitlab-artwork/raw/master/logo/logo-square.png") #' @param size size of logo in pixels (default: 24) #' @return Gitlab logo in html with path to repository in Gitlab #' @export - -badge_gitlab <- function(url, -logo_path = paste0("https://gitlab.com/gitlab-com/gitlab-artwork/raw/", -"master/logo/logo-square.png"), - size = 24) { +badge_gitlab <- function( + url, + logo_path = compose_url( + protocol = "https", + domain_name = "gitlab.com", + path = "gitlab-com/gitlab-artwork/raw/master/logo/logo-square.png" + ), + size = 24 +) +{ + img_attr <- sprintf(" title='Gitlab' width='%d' height = '%d'", size, size) - sprintf("", - url, - logo_path, - size, - size) -} \ No newline at end of file + logo_path %>% + html_img(img_attr) %>% + html_a(href = url) +} diff --git a/R/badge_license.R b/R/badge_license.R index e972a25..17e54c5 100644 --- a/R/badge_license.R +++ b/R/badge_license.R @@ -9,69 +9,35 @@ #' @importFrom dplyr left_join select_ rename_ #' @return badge for all provided license keys #' @export -badge_license <- function(license_keys, - github_token = Sys.getenv("GITHUB_TOKEN")) { - gh_licenses <- gh::gh(endpoint = "GET /licenses", - .token = github_token) +badge_license <- function(license_keys, github_token = get_github_token()) +{ + gh_licenses <- gh::gh(endpoint = "GET /licenses", .token = github_token) gh_licenses_df <- data.table::rbindlist(gh_licenses, fill=TRUE) - #### License badges from: https://gist.github.com/lukas-h/2a5d00690736b4c3a7ba - license_badges <- data.frame(key = c("agpl-3.0", - "apache-2.0", - "bsd-2-clause", - "bsd-3-clause", - "epl-2.0", - "gpl-2.0", - "gpl-3.0", - "lgpl-2.1", - "lgpl-3.0", - "mit", - "mpl-2.0", - "unlicense"), -badge_url = c("https://img.shields.io/badge/License-AGPL%20v3-blue.svg", -"https://img.shields.io/badge/License-Apache%202.0-blue.svg", -"https://img.shields.io/badge/License-BSD%202--Clause-orange.svg", -"https://img.shields.io/badge/License-BSD%203--Clause-blue.svg", -"", -"https://img.shields.io/badge/License-GPL%20v2-blue.svg", -"https://img.shields.io/badge/License-GPL%20v3-blue.svg", -"", -"https://img.shields.io/badge/License-LGPL%20v3-blue.svg", -"https://img.shields.io/badge/License-MIT-yellow.svg", -"https://img.shields.io/badge/License-MPL%202.0-brightgreen.svg", -"https://img.shields.io/badge/license-Unlicense-blue.svg"), -license_url = c("https://opensource.org/licenses/AGPL-3.0", -"https://opensource.org/licenses/Apache-2.0", -"https://opensource.org/licenses/BSD-2-Clause", -"https://opensource.org/licenses/BSD-3-Clause", -"https://www.eclipse.org/legal/epl-2.0/", -"https://www.gnu.org/licenses/gpl-2.0", -"https://www.gnu.org/licenses/gpl-3.0", -"https://www.gnu.org/licenses/lgpl-2.1", -"https://www.gnu.org/licenses/lgpl-3.0", -"https://opensource.org/licenses/MIT", -"https://opensource.org/licenses/MPL-2.0", -"http://unlicense.org/"), -stringsAsFactors = FALSE) + license_badges <- get_license_badge_info() %>% + kwb.utils::renameColumns(list(image_url = "badge_url")) -gh_licenses_df <- dplyr::left_join(gh_licenses_df, - license_badges) + gh_licenses_df <- dplyr::left_join(gh_licenses_df, license_badges) - gh_licenses_df$Badge_License <- sprintf("[![%s](%s)](%s)", - gh_licenses_df$spdx_id, - gh_licenses_df$badge_url, - gh_licenses_df$license_url) + gh_licenses_df$Badge_License <- image_link( + image_name = gh_licenses_df$spdx_id, + image_url = gh_licenses_df$badge_url, + link_url = gh_licenses_df$license_url + ) badges <- gh_licenses_df %>% dplyr::select_(~key, ~Badge_License) %>% dplyr::rename_(license_key = ~key) + result <- dplyr::left_join( + x = data.frame( + license_key = license_keys, + stringsAsFactors = FALSE + ), + y = badges + ) - res <- dplyr::left_join(x = data.frame(license_key = license_keys, - stringsAsFactors = FALSE), - y = badges) - - return(res$Badge_License) + result$Badge_License } diff --git a/R/badge_opencpu.R b/R/badge_opencpu.R index 189a25e..a2d413c 100644 --- a/R/badge_opencpu.R +++ b/R/badge_opencpu.R @@ -6,13 +6,24 @@ #' @return OpenCpu logo in html with path to R package on OpenCpu #' @export -badge_opencpu <- function(url, -logo_path = "https://avatars2.githubusercontent.com/u/28672890?s=200&v=4", -size = 24) { +badge_opencpu <- function( + url, + logo_path = compose_url( + protocol = "https", + subdomain = "avatars2", + domain_name = "githubusercontent.com", + path = "u/28672890", + parameters = list( + s = 200, + v = 4 + ) + ), + size = 24 +) +{ + img_attr <- sprintf(" title='OpenCpu' width='%d' height = '%d'", size, size) - sprintf("", - url, - logo_path, - size, - size) + logo_path %>% + html_img(img_attr) %>% + html_a(href = url) } diff --git a/R/badge_zenodo.R b/R/badge_zenodo.R index 39a6bcb..44e95fa 100644 --- a/R/badge_zenodo.R +++ b/R/badge_zenodo.R @@ -6,37 +6,55 @@ #' @importFrom stringr str_detect #' @return zenodo badges for provided repo_full_names #' @export -badge_zenodo <- function(repo_full_names, - zenodo_token = Sys.getenv("ZENODO_TOKEN")) { - +badge_zenodo <- function( + repo_full_names, + zenodo_token = Sys.getenv("ZENODO_TOKEN") +) +{ zen_data <- zen_collections(access_token = zenodo_token) - zen_badge <- rep(NA, length = length(repo_full_names)) + zen_badge <- na_along(repo_full_names) for (index in seq_along(repo_full_names)) { + doi_exists <- stringr::str_detect( string = zen_data$metadata.related_identifiers.identifier , - pattern = sprintf("https://github.com/%s", - repo_full_names[index])) + pattern = compose_url( + protocol = "https", + domain_name = "github.com", + path = repo_full_names[index] + ) + ) doi_exists[is.na(doi_exists)] <- FALSE - if(sum(doi_exists) == 1) { + if (sum(doi_exists) == 1L) { + + zen_badge[index] <- image_link( + image_name = "DOI", + image_url = zen_data$links.badge[doi_exists], + link_url = zen_data$doi_url[doi_exists] + ) + + } else if (sum(doi_exists) > 1L) { - zen_badge[index] <- sprintf("[![DOI](%s)](%s)", - zen_data$links.badge[doi_exists], - zen_data$doi_url[doi_exists]) + warn_msg <- sprintf( + "Multiple entries found for repo '%s':\n%s", + repo_full_names[index], + paste( + zen_data$metadata.related_identifiers.identifier[doi_exists], + collapse = "\n" + ) + ) - } else if (sum(doi_exists) > 1) { - warn_msg <- sprintf("Multiple entries found for repo '%s':\n%s", - repo_full_names[index], - paste(zen_data$metadata.related_identifiers.identifier[doi_exists], - collapse = "\n")) warning(warn_msg) zen_badge[index] <- "Multiple badges found!" + } else { + zen_badge[index] <- NA } } - return(zen_badge) + + zen_badge } diff --git a/R/badges_ci.R b/R/badges_ci.R index b9b004b..ad01b3a 100644 --- a/R/badges_ci.R +++ b/R/badges_ci.R @@ -1,26 +1,61 @@ #' badge_appveyor +#' #' @param repo_full_names vector with combination of username/repo (e.g. #' c("KWB-R/kwb.utils", "KWB-R/kwb.db")) #' @return appveyor badges for provided repo_full_names #' @export -badge_appveyor <- function(repo_full_names) { - -paste0("[![Appveyor](https://ci.appveyor.com/api/projects/status/github/", - repo_full_names, - "?branch=master&svg=true)](https://ci.appveyor.com/project/", - gsub(".", "-", repo_full_names, fixed = TRUE), - "/branch/master)") +badge_appveyor <- function(repo_full_names) +{ + to_full_url <- function(path, parameters = list()) { + compose_url( + protocol = "https", + subdomain = "ci", + domain_name = "appveyor.com", + path = path, + parameters = parameters + ) + } + + image_link( + image_name = "Appveyor", + image_url = to_full_url( + path = sprintf("api/projects/status/github/%s", repo_full_names), + parameters = list( + branch = "master", + svg = "true" + ) + ), + link_url = to_full_url( + path = sprintf("project/%s/branch/master", dot_to_dash(repo_full_names)) + ) + ) } #' badge_travis +#' #' @param repo_full_names vector with combination of username/repo (e.g. #' c("KWB-R/kwb.utils", "KWB-R/kwb.db")) #' @return travis badges for provided repo_full_names #' @export -badge_travis <- function(repo_full_names) { - paste0("[![Travis](https://travis-ci.org/", - repo_full_names, -".svg?branch=master)](https://travis-ci.org/", -repo_full_names, -")") -} \ No newline at end of file +badge_travis <- function(repo_full_names) +{ + to_full_url <- function(path, parameters = list()) { + compose_url( + protocol = "https", + domain_name = "travis-ci.org", + path = path, + parameters = parameters + ) + } + + image_link( + image_name = "Travis", + image_url = to_full_url( + path = sprintf("%s.svg", repo_full_names), + parameters = list(branch = "master") + ), + link_url = to_full_url( + path = repo_full_names + ) + ) +} diff --git a/R/check_documentation.R b/R/check_documentation.R index b16fc12..ffe00b1 100644 --- a/R/check_documentation.R +++ b/R/check_documentation.R @@ -1,48 +1,52 @@ #' url_success +#' #' @param url url of documentation website #' @importFrom httr status_code GET #' @return TRUE in case HTTP status code is 200, if not: FALSE -url_success <- function(url) { +url_success <- function(url) +{ identical(httr::status_code(x = httr::GET(url)), 200L) } #' Check documentation: development +#' #' @param repo_names vector of repository names to be checked #' @param url main url for Github pages (default: "http://kwb-r.github.io") #' @return character vector with links in case documentation of development #' version for R packages is available #' @export -check_docu_dev <- function(repo_names, - url = "http://kwb-r.github.io") { - - - sapply(X = repo_names, FUN = function(repo) { - url_docu_dev <- sprintf("%s/%s/dev/index.html", url, repo) - docu_available <- url_success(url = url_docu_dev) - if(docu_available) { - sprintf("[X](%s)", url_docu_dev) - } else { - "" - }}) +check_docu_dev <- function(repo_names, url = "http://kwb-r.github.io") +{ + check_docu_impl(repo_names, url, path_format = "%s/%s/dev/index.html") } #' Check documentation: release +#' #' @param repo_names vector of repository names to be checked #' @param url main url for Github pages (default: "http://kwb-r.github.io") #' @return character vector with links in case documentation of latest release #' for R packages is available #' @export -check_docu_release <- function(repo_names, - url = "http://kwb-r.github.io") { - - +check_docu_release <- function(repo_names, url = "http://kwb-r.github.io") +{ + check_docu_impl(repo_names, url, path_format = "%s/%s/index.html") +} + +# check_docu_impl -------------------------------------------------------------- +check_docu_impl <- function(repo_names, url, path_format) +{ sapply(X = repo_names, FUN = function(repo) { - url_docu_release <- sprintf("%s/%s/index.html", url, repo) - docu_available <- url_success(url = url_docu_release) + + url <- sprintf(path_format, url, repo) + + docu_available <- url_success(url = url) + if(docu_available) { - sprintf("[X](%s)", url_docu_release) + sprintf("[X](%s)", url) } else { "" - }}) + } + + }) } diff --git a/R/check_gitlab_backup.R b/R/check_gitlab_backup.R index 8a6f22a..6826714 100644 --- a/R/check_gitlab_backup.R +++ b/R/check_gitlab_backup.R @@ -9,32 +9,37 @@ #' @importFrom dplyr left_join #' @importFrom lubridate as_datetime #' @export -check_gitlab_backup <- function(group = "KWB-R", - github_token = Sys.getenv("GITHUB_TOKEN"), - gitlab_token = Sys.getenv("GITLAB_TOKEN")) { - - - github_repos <- get_github_repos(group, github_token) - gitlab_repos <- get_gitlab_repos(group,gitlab_token) - - - - names(github_repos) <- paste0("gh_", names(github_repos)) - names(gitlab_repos) <- paste0("gl_", names(gitlab_repos)) +check_gitlab_backup <- function( + group = "KWB-R", + github_token = get_github_token(), + gitlab_token = get_gitlab_token() +) +{ + github_repos <- get_github_repos(group, github_token) %>% + prefix_names("gh_") + + gitlab_repos <- get_gitlab_repos(group,gitlab_token) %>% + prefix_names("gl_") tmp <- github_repos %>% - dplyr::left_join(y = gitlab_repos, by = c("gh_name" = "gl_name")) - - tmp$last_mirrored_hours <- difftime(lubridate::as_datetime(tmp$gh_pushed_at), - lubridate::as_datetime(tmp$gl_last_activity_at), - units = "hours") + dplyr::left_join( + y = gitlab_repos, + by = c("gh_name" = "gl_name") + ) + + tmp$last_mirrored_hours <- difftime( + lubridate::as_datetime(tmp$gh_pushed_at), + lubridate::as_datetime(tmp$gl_last_activity_at), + units = "hours" + ) is_mirrored <- tmp$last_mirrored_hours <= 2 #h mirrored_repos <- tmp[is_mirrored, ] - data.frame(name = mirrored_repos$gh_name, - Backup = badge_gitlab(url = mirrored_repos$gl_web_url), - stringsAsFactors = FALSE) - + data.frame( + name = mirrored_repos$gh_name, + Backup = badge_gitlab(url = mirrored_repos$gl_web_url), + stringsAsFactors = FALSE + ) } diff --git a/R/check_opencpu_deploy.R b/R/check_opencpu_deploy.R index 7b0e4a7..96baf1c 100644 --- a/R/check_opencpu_deploy.R +++ b/R/check_opencpu_deploy.R @@ -8,17 +8,21 @@ #' repositories that are deployed on OpenCpu (default: https://kwb-r.ocpu.io) #' @export -check_opencpu_deploy <- function(group = "KWB-R") { +check_opencpu_deploy <- function(group = "KWB-R") +{ + ocpu_url <- compose_url( + protocol = "https", + subdomain = tolower(group), + domain_name = "ocpu.io" + ) + + repo_names <- readLines(ocpu_url) - ocpu_url <- sprintf("https://%s.ocpu.io", tolower(group)) - con <- url(ocpu_url) - repo_names <- readLines(con) - close(con) ocpu_urls <- sprintf("%s/%s", ocpu_url, repo_names) - rpackages_on_ocpu <- data.frame(name = repo_names, - OpenCpu = badge_opencpu(ocpu_urls), - stringsAsFactors = FALSE) - return(rpackages_on_ocpu) + + data.frame( + name = repo_names, + OpenCpu = badge_opencpu(ocpu_urls), + stringsAsFactors = FALSE + ) } - - diff --git a/R/create_report_rpackages.R b/R/create_report_rpackages.R index 20dbdb8..f680e81 100644 --- a/R/create_report_rpackages.R +++ b/R/create_report_rpackages.R @@ -12,22 +12,27 @@ #' path to the export directory #' @importFrom fs dir_create path_real #' @export -create_report_rpackages <- function (secrets_csv = NULL, -non_r_packages = get_non_r_packages(), - export_dir = ".", - input_rmd = system.file("extdata/reports/status_report.Rmd", - package = "kwb.pkgstatus")) { - - +create_report_rpackages <- function ( + secrets_csv = NULL, + non_r_packages = get_non_r_packages(), + export_dir = ".", + input_rmd = system.file( + "extdata/reports/status_report.Rmd", package = "kwb.pkgstatus" + ) +) +{ fs::dir_create(export_dir) - - rmarkdown::render(input = input_rmd, - output_format = "html_document", - output_file = "index.html", - output_dir = export_dir, - params = list(secrets_csv = secrets_csv, - non_r_packages = non_r_packages)) - + rmarkdown::render( + input = input_rmd, + output_format = "html_document", + output_file = "index.html", + output_dir = export_dir, + params = list( + secrets_csv = secrets_csv, + non_r_packages = non_r_packages + ) + ) + fs::path_real(export_dir) -} \ No newline at end of file +} diff --git a/R/get_coverages.R b/R/get_coverages.R index 1ce0298..3dcd6fe 100644 --- a/R/get_coverages.R +++ b/R/get_coverages.R @@ -5,35 +5,46 @@ #' @param dbg debug if TRUE (default: TRUE) #' @importFrom httr status_code #' @return codecov coverage in percent for provided repo_full_name -get_coverage <- function(repo_full_name, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE) { +get_coverage <- function( + repo_full_name, + codecov_token = Sys.getenv("CODECOV_TOKEN"), + dbg = TRUE +) +{ + url <- compose_url( + protocol = "https", + domain_name = "codecov.io", + path = paste0("api/gh/", repo_full_name) + ) + cat_if(dbg, "Checking code coverage for %s at %s", repo_full_name, url) - url <- sprintf("https://codecov.io/api/gh/%s", repo_full_name) + req <- paste0(url, url_parameter_string(access_token = codecov_token)) - if(dbg) cat(sprintf("Checking code coverage for %s at %s", - repo_full_name, - url)) - - req <- sprintf("%s?access_token=%s", - url, - codecov_token) - if(httr::status_code(httr::GET(url = req)) == 200L) { + if (httr::status_code(httr::GET(url = req)) == 200L) { + codecov_data <- jsonlite::fromJSON(req) if(!is.null(codecov_data$commit$totals$c)) { - codecov_coverage <- round(as.numeric(codecov_data$commit$totals$c), - digits = 2) + + codecov_coverage <- round( + as.numeric(codecov_data$commit$totals$c), + digits = 2 + ) + } else { + codecov_coverage <- NA } + } else { + codecov_coverage <- NA } - if(dbg) cat(sprintf("....%3.1f%%\n", codecov_coverage)) - return(codecov_coverage) + cat_if(dbg, "....%3.1f%%\n", codecov_coverage) + + codecov_coverage } #' get_coverage @@ -45,26 +56,33 @@ get_coverage <- function(repo_full_name, #' @return data.frame with coverage percent and url for all provided #' repo_full_names #' @export -get_coverages <- function (repo_full_names, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE) { - coverage_percent <- rep(NA, - length = length(repo_full_names)) - coverage_url <- rep(NA, - length = length(repo_full_names)) +get_coverages <- function( + repo_full_names, + codecov_token = Sys.getenv("CODECOV_TOKEN"), + dbg = TRUE +) +{ + coverage_percent <- na_along(repo_full_names) + coverage_url <- na_along(repo_full_names) for (index in seq_along(repo_full_names)) { coverage_percent[index] <- get_coverage( repo_full_name = repo_full_names[index], codecov_token, - dbg) + dbg + ) } - available_indices <- which(!is.na(coverage_percent)) - coverage_url[available_indices] <- sprintf("https://codecov.io/gh/%s", - repo_full_names[available_indices]) - return(data.frame(Coverage = coverage_percent, - Coverage_url = coverage_url)) -} \ No newline at end of file + coverage_url[available_indices] <- compose_url( + protocol = "https", + domain_name = "codecov.io", + path = sprintf("gh/%s", repo_full_names[available_indices]) + ) + + data.frame( + Coverage = coverage_percent, + Coverage_url = coverage_url + ) +} diff --git a/R/get_license_badge_info.R b/R/get_license_badge_info.R new file mode 100644 index 0000000..fca7110 --- /dev/null +++ b/R/get_license_badge_info.R @@ -0,0 +1,70 @@ +# get_license_badge_info ------------------------------------------------------- +get_license_badge_info <- function() +{ + compose_badge_url <- function(relative_paths) { + compose_url( + protocol = "https", + subdomain = "img", + domain_name = "shields.io", + path = paste0("badge/", relative_paths) + ) + } + + data.frame( + key = c( + "agpl-3.0", + "apache-2.0", + "bsd-2-clause", + "bsd-3-clause", + "epl-2.0", + "gpl-2.0", + "gpl-3.0", + "lgpl-2.1", + "lgpl-3.0", + "mit", + "mpl-2.0", + "unlicense" + ), + image_url = c( + compose_badge_url(c( + "License-AGPL%20v3-blue.svg", + "License-Apache%202.0-blue.svg", + "License-BSD%202--Clause-orange.svg", + "License-BSD%203--Clause-blue.svg" + )), + "", + compose_badge_url(c( + "License-GPL%20v2-blue.svg", + "License-GPL%20v3-blue.svg" + )), + "", + compose_badge_url(c( + "License-LGPL%20v3-blue.svg", + "License-MIT-yellow.svg", + "License-MPL%202.0-brightgreen.svg", + "license-Unlicense-blue.svg" + )) + ), + license_url = c( + compose_url("https", NULL, "opensource.org", path = c( + "licenses/AGPL-3.0", + "licenses/Apache-2.0", + "licenses/BSD-2-Clause", + "licenses/BSD-3-Clause" + )), + compose_url("https", "www", "eclipse.org", "legal/epl-2.0/"), + compose_url("https", "www", "gnu.org", c( + "licenses/gpl-2.0", + "licenses/gpl-3.0", + "licenses/lgpl-2.1", + "licenses/lgpl-3.0" + )), + compose_url("https", NULL, "opensource.org", path = c( + "licenses/MIT", + "licenses/MPL-2.0" + )), + compose_url("http", NULL, "unlicense.org") + ), + stringsAsFactors = FALSE + ) +} diff --git a/R/get_non_r_packages.R b/R/get_non_r_packages.R index 9ec37fc..94efc30 100644 --- a/R/get_non_r_packages.R +++ b/R/get_non_r_packages.R @@ -7,15 +7,53 @@ #' get_non_r_packages <- function() { - c("abimo", "abimo.scripts", "ad4gd_lakes", "apps", "abluft2", "abluft2.scripts", - "basar.scripts", "dwc.scripts", "kwb-r.github.io", "kwb-r.r-universe.dev", - "fakin", "fakin.blog", "fakin.doc", "fakin.scripts", "FolderRights", - "flusshygiene", "HydroServerLite", "hydrus1d", "GeoSalz", "geosalz.mf", - "geosalz.scripts", "impetus_scripts", "intruder.io", "lasso.scripts", - "Logremoval", "programming", "pathana", "pFromGrADS", "promisces.hhra", - "qmra", "qsimVis", "r-training", "support", "maxflow", "mbr40.scripts", - "misa.scripts", "pubs", "riverPollution", "smart.control", "sema.scripts", - "sema.projects", "swim-ai", "spur.scripts", "status", "ultimate.scripts", - "useR-2019", "wellma.scripts") + c( + "abimo", + "abimo.scripts", + "ad4gd_lakes", + "apps", + "abluft2", + "abluft2.scripts", + "basar.scripts", + "dwc.scripts", + "kwb-r.github.io", + "kwb-r.r-universe.dev", + "fakin", + "fakin.blog", + "fakin.doc", + "fakin.scripts", + "FolderRights", + "flusshygiene", + "HydroServerLite", + "hydrus1d", + "GeoSalz", + "geosalz.mf", + "geosalz.scripts", + "impetus_scripts", + "intruder.io", + "lasso.scripts", + "Logremoval", + "programming", + "pathana", + "pFromGrADS", + "promisces.hhra", + "qmra", + "qsimVis", + "r-training", + "support", + "maxflow", + "mbr40.scripts", + "misa.scripts", + "pubs", + "riverPollution", + "smart.control", + "sema.scripts", + "sema.projects", + "swim-ai", + "spur.scripts", + "status", + "ultimate.scripts", + "useR-2019", + "wellma.scripts" + ) } - diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index 7e8a9e6..42162e4 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -11,15 +11,18 @@ #' @export get_gitlab_repos <- function( group = "KWB-R", - gitlab_token = Sys.getenv("GITLAB_TOKEN") -) + gitlab_token = get_gitlab_token() +) { - endpoint <- sprintf( - "https://gitlab.com/api/v4/groups/%s?private_token=%s", - group, - gitlab_token + endpoint <- compose_url( + protocol = "https", + domain_name = "gitlab.com", + path = paste0( + url_path(paste0("api/v4/groups/", group)), + url_parameter_string(private_token = gitlab_token) + ) ) - + gitlab_group <- jsonlite::fromJSON(endpoint) gitlab_group$projects @@ -36,15 +39,14 @@ get_gitlab_repos <- function( #' configured to allow that) #' @importFrom gh gh #' @export -get_github_repos <- function ( - group = "KWB-R", - github_token = Sys.getenv("GITHUB_TOKEN") -) +get_github_repos <- function(group = "KWB-R", github_token = get_github_token()) { get_repos <- function(per_page = 100L) { - endpoint <- function(group, page, per_page) sprintf( - "GET /orgs/%s/repos?page=%d&per_page=%d", group, page, per_page + endpoint <- function(group, page, per_page) paste0( + "GET ", + url_path(sprintf("orgs/%s/repos", group)), + url_parameter_string(page = page, per_page = per_page) ) all_repos <- list() @@ -56,7 +58,10 @@ get_github_repos <- function ( while(page > 0L) { # Read repos from current page - repos <- gh::gh(endpoint(group, page, per_page), .token = github_token) + repos <- gh::gh( + endpoint = endpoint(group, page, per_page), + .token = github_token + ) # If the page contained at least one repo... if (length(repos) > 0L) { @@ -102,17 +107,21 @@ get_github_repos <- function ( license_link = ifelse( is.null(sel_repo$license$spdx_id), NA, - sprintf("https://github.com/%s/blob/master/LICENSE", sel_repo$full_name) + compose_url( + protocol = "https", + domain_name = "github.com", + path = paste0(sel_repo$full_name, "/blob/master/LICENSE") + ) ), stringsAsFactors = FALSE ) - tmp$Repository <- sprintf("[%s](%s)", tmp$name, tmp$url) + tmp$Repository <- named_link(tmp$name, tmp$url) tmp$License <- ifelse( is.na(tmp$license_short), NA, - sprintf("[%s](%s)", tmp$license_short, tmp$license_link) + named_link(tmp$license_short, tmp$license_link) ) if (repo_ind == 1) { @@ -122,104 +131,71 @@ get_github_repos <- function ( } } - res <- res[order(res$name,decreasing = FALSE), ] - - return(res) + res[order(res$name,decreasing = FALSE), ] } # badge_cran ------------------------------------------------------------------- badge_cran <- function(repo_names) { - sprintf( - "[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/%s)](http://www.r-pkg.org/pkg/%s)", - repo_names, - repo_names + url_formats <- compose_url( + protocol = "http", + subdomain = "www", + domain_name = "r-pkg.org", + path = c( + "/badges/version/%s", + "/pkg/%s" + ) + ) + + image_link( + image_name = "CRAN_Status_Badge", + image_url = sprintf(url_formats[1L], repo_names), + link_url = sprintf(url_formats[2L], repo_names) ) } # badge_codecov ---------------------------------------------------------------- badge_codecov <- function(repo_full_names) { - sprintf( - "[![codecov](https://codecov.io/github/%s/branch/master/graphs/badge.svg)](https://codecov.io/github/%s)", - repo_full_names, - repo_full_names + url_formats <- compose_url( + protocol = "https", + domain_name = "codecov.io", + path = c( + "/github/%s/branch/master/graphs/badge.svg", + "/github/%s" + ) ) - # sprintf("![codecov](https://img.shields.io/codecov/c/github/%s/master.svg", - # repo_full_names) + image_link( + image_name = "codecov", + image_url = sprintf(url_formats[1L], repo_full_names), + link_url = sprintf(url_formats[2L], repo_full_names) + ) } # badge_license ---------------------------------------------------------------- -badge_license <- function( - license_keys, - github_token = Sys.getenv("GITHUB_TOKEN") -) +badge_license <- function(license_keys, github_token = get_github_token()) { gh_licenses <- gh::gh(endpoint = "GET /licenses", .token = github_token) gh_licenses_df <- data.table::rbindlist(gh_licenses, fill=TRUE) #### License badges from: https://gist.github.com/lukas-h/2a5d00690736b4c3a7ba - license_badges <- data.frame(key = c( - "agpl-3.0", - "apache-2.0", - "bsd-2-clause", - "bsd-3-clause", - "epl-2.0", - "gpl-2.0", - "gpl-3.0", - "lgpl-2.1", - "lgpl-3.0", - "mit", - "mpl-2.0", - "unlicense" - ), - badge_url = c( - "https://img.shields.io/badge/License-AGPL%20v3-blue.svg", - "https://img.shields.io/badge/License-Apache%202.0-blue.svg", - "https://img.shields.io/badge/License-BSD%202--Clause-orange.svg", - "https://img.shields.io/badge/License-BSD%203--Clause-blue.svg", - "", - "https://img.shields.io/badge/License-GPL%20v2-blue.svg", - "https://img.shields.io/badge/License-GPL%20v3-blue.svg", - "", - "https://img.shields.io/badge/License-LGPL%20v3-blue.svg", - "https://img.shields.io/badge/License-MIT-yellow.svg", - "https://img.shields.io/badge/License-MPL%202.0-brightgreen.svg", - "https://img.shields.io/badge/license-Unlicense-blue.svg" - ), - license_url = c( - "https://opensource.org/licenses/AGPL-3.0", - "https://opensource.org/licenses/Apache-2.0", - "https://opensource.org/licenses/BSD-2-Clause", - "https://opensource.org/licenses/BSD-3-Clause", - "https://www.eclipse.org/legal/epl-2.0/", - "https://www.gnu.org/licenses/gpl-2.0", - "https://www.gnu.org/licenses/gpl-3.0", - "https://www.gnu.org/licenses/lgpl-2.1", - "https://www.gnu.org/licenses/lgpl-3.0", - "https://opensource.org/licenses/MIT", - "https://opensource.org/licenses/MPL-2.0", - "http://unlicense.org/" - ), - stringsAsFactors = FALSE - ) + license_badges <- get_license_badge_info() gh_licenses_df <- dplyr::left_join(gh_licenses_df, license_badges) - gh_licenses_df$Badge_License <- sprintf( - "[![%s](%s)](%s)", - gh_licenses_df$spdx_id, - gh_licenses_df$badge_url, - gh_licenses_df$license_url + gh_licenses_df$Badge_License <- image_link( + image_name = gh_licenses_df$spdx_id, + image_url = gh_licenses_df$image_url, + link_url = gh_licenses_df$license_url ) badges <- gh_licenses_df %>% dplyr::select_(~key, ~Badge_License) %>% dplyr::rename_(license_key = ~key) - res <- dplyr::left_join( + result <- dplyr::left_join( x = data.frame( license_key = license_keys, stringsAsFactors = FALSE @@ -227,26 +203,45 @@ badge_license <- function( y = badges ) - return(res$Badge_License) + result$Badge_License } # badge_appveyor --------------------------------------------------------------- badge_appveyor <- function(repo_full_names) { - sprintf( - "[![Appveyor](https://ci.appveyor.com/api/projects/status/github/%s?branch=master&svg=true)](https://ci.appveyor.com/project/%s/branch/master)", - repo_full_names, - gsub(".", "-", repo_full_names, fixed = TRUE) + url_formats <- compose_url( + protocol = "https", + subdomain = "ci", + domain_name = "appveyor.com", + path = c( + "api/projects/status/github/%s?branch=master&svg=true", + "project/%s/branch/master" + ) + ) + + image_link( + image_name = "Appveyor", + image_url = sprintf(url_formats[1L], repo_full_names), + link_url = sprintf(url_formats[2L], dot_to_dash(repo_full_names)) ) } # badge_travis ----------------------------------------------------------------- badge_travis <- function(repo_full_names) { - sprintf( - "[![Travis](https://travis-ci.org/%s.svg?branch=master)](https://travis-ci.org/%s)", - repo_full_names, - repo_full_names + url_formats <- compose_url( + protocol = "https", + domain_name = "travis-ci.org", + path = c( + "/%s.svg?branch=master", + "/%s" + ) + ) + + image_link( + image_name = "Travis", + image_url = sprintf(url_formats[1L], repo_full_names), + link_url = sprintf(url_formats[2L], repo_full_names) ) } @@ -258,13 +253,17 @@ badge_zenodo <- function( { zen_data <- zen_collections(access_token = zenodo_token) - zen_badge <- rep(NA, length = length(repo_full_names)) + zen_badge <- na_along(repo_full_names) for (index in seq_along(repo_full_names)) { doi_exists <- stringr::str_detect( string = zen_data$metadata.related_identifiers.identifier, - pattern = sprintf("https://github.com/%s", repo_full_names[index]) + pattern = compose_url( + protocol = "https", + domain_name = "github.com", + path = paste0("/", repo_full_names[index]) + ) ) doi_exists[is.na(doi_exists)] <- FALSE @@ -293,7 +292,7 @@ badge_zenodo <- function( } } - return(zen_badge) + zen_badge } # get_coverage ----------------------------------------------------------------- @@ -303,12 +302,14 @@ get_coverage <- function( dbg = TRUE ) { - url <- sprintf("https://codecov.io/api/gh/%s", repo_full_name) - - if(dbg) { - cat(sprintf("Checking code coverage for %s at %s", repo_full_name, url)) - } + url <- compose_url( + protocol = "https", + domain_name = "codecov.io", + path = paste0("/api/gh/", repo_full_name) + ) + cat_if(dbg, "Checking code coverage for %s at %s", repo_full_name, url) + req <- sprintf("%s?access_token=%s", url, codecov_token) if(httr::status_code(httr::GET(url = req)) == 200L) { @@ -326,9 +327,9 @@ get_coverage <- function( codecov_coverage <- NA } - if(dbg) cat(sprintf("....%3.1f%%\n", codecov_coverage)) + cat_if(dbg, "....%3.1f%%\n", codecov_coverage) - return(codecov_coverage) + codecov_coverage } # get_coverages ---------------------------------------------------------------- @@ -338,8 +339,8 @@ get_coverages <- function ( dbg = TRUE ) { - coverage_percent <- rep(NA, length = length(repo_full_names)) - coverage_url <- rep(NA, length = length(repo_full_names)) + coverage_percent <- na_along(repo_full_names) + coverage_url <- na_along(repo_full_names) for (index in seq_along(repo_full_names)) { coverage_percent[index] <- get_coverage( @@ -351,13 +352,14 @@ get_coverages <- function ( available_indices <- which(!is.na(coverage_percent)) - coverage_url[available_indices] <- sprintf( - "https://codecov.io/gh/%s", - repo_full_names[available_indices] + coverage_url[available_indices] <- compose_url( + protocol = "https", + domain_name = "codecov.io", + path = paste0("gh/", repo_full_names[available_indices]) ) - return(data.frame( + data.frame( Coverage = coverage_percent, Coverage_url = coverage_url - )) + ) } diff --git a/R/prepare_status_rpackages.R b/R/prepare_status_rpackages.R index d05b72e..1a9e132 100644 --- a/R/prepare_status_rpackages.R +++ b/R/prepare_status_rpackages.R @@ -4,28 +4,30 @@ #' @importFrom stringr str_length #' @keywords internal #' -check_all_tokens_set <- function() { - token_names <- c("APPVEYOR_TOKEN", - "CODECOV_TOKEN", - "GITHUB_TOKEN", - "GITLAB_TOKEN", - "ZENODO_TOKEN" - ) +check_all_tokens_set <- function() +{ + token_names <- c( + "APPVEYOR_TOKEN", + "CODECOV_TOKEN", + "GITHUB_TOKEN", + "GITLAB_TOKEN", + "ZENODO_TOKEN" + ) + token_values <- Sys.getenv(token_names) tokens_defined <- stringr::str_length(token_values) > 0 - if(all(tokens_defined)) { - TRUE - } else { - tokens_undefined <- paste(token_names[!tokens_defined], collapse = ", ") - warning(sprintf("The folling tokens were not defined: %s", tokens_undefined)) - FALSE - } + if (all(tokens_defined)) { + return(TRUE) + } + tokens_undefined <- paste(token_names[!tokens_defined], collapse = ", ") + warning(sprintf("The folling tokens were not defined: %s", tokens_undefined)) + + FALSE } - #' prepare_status_rpackages #' @param secrets_csv path to "secrets.csv" file, if "NULL" Sys.env variables #' for the following services are used/need to be defined: APPVEYOR_TOKEN, @@ -39,21 +41,23 @@ check_all_tokens_set <- function() { #' @importFrom utils read.csv #' @return data.frame with R package status information #' @export -prepare_status_rpackages <- function (secrets_csv = NULL, - non_r_packages = get_non_r_packages()) { - - +prepare_status_rpackages <- function( + secrets_csv = NULL, + non_r_packages = get_non_r_packages() +) +{ if(!is.null(secrets_csv)) { - ### Need to check Hadley`s vignette for safely managing access tokens: - ### https://cran.r-project.org/web/packages/httr/vignettes/secrets.html - secrets <- read.csv(secrets_csv, stringsAsFactors = FALSE) - - Sys.setenv(APPVEYOR_TOKEN = secrets$appveyor_token, - CODECOV_TOKEN = secrets$codecov_token, - GITHUB_TOKEN = secrets$github_token, - GITLAB_TOKEN = secrets$gitlab_token, - ZENODO_TOKEN = secrets$zenodo_token - ) + ### Need to check Hadley`s vignette for safely managing access tokens: + ### https://cran.r-project.org/web/packages/httr/vignettes/secrets.html + secrets <- read.csv(secrets_csv, stringsAsFactors = FALSE) + + Sys.setenv( + APPVEYOR_TOKEN = secrets$appveyor_token, + CODECOV_TOKEN = secrets$codecov_token, + GITHUB_TOKEN = secrets$github_token, + GITLAB_TOKEN = secrets$gitlab_token, + ZENODO_TOKEN = secrets$zenodo_token + ) } stopifnot(check_all_tokens_set()) @@ -61,54 +65,47 @@ prepare_status_rpackages <- function (secrets_csv = NULL, repo_infos <- kwb.pkgstatus::get_github_repos() %>% dplyr::filter_("!name %in% non_r_packages") - -build_pkg_release <- as.vector(sapply(repo_infos$name, function(repo) { + build_pkg_release <- as.vector(sapply(repo_infos$name, function(repo) { kwb.pkgbuild::use_badge_ghactions_rcmdcheck(repo) - })) - -build_pkg_dev <- as.vector(sapply(repo_infos$name, function(repo) { - kwb.pkgbuild::use_badge_ghactions_rcmdcheck(repo, branch = "dev") -})) - -build_doc_release <- as.vector(sapply(repo_infos$name, function(repo) { - kwb.pkgbuild::use_badge_ghactions_pkgdown(repo) -})) - -build_doc_dev <- as.vector(sapply(repo_infos$name, function(repo) { - kwb.pkgbuild::use_badge_ghactions_pkgdown(repo, branch = "dev") -})) - -badge_runiverse <- as.vector(sapply(repo_infos$name, function(repo) { - kwb.pkgbuild::use_badge_runiverse(repo) -})) - + })) -meta_info <- data.frame(License_Badge = badge_license(repo_infos$license_key), -Dependencies = badge_dependencies(repo_infos$name), -Tests_Coverage.io = badge_codecov(repo_infos$full_name), -Build_Pkg_Release = build_pkg_release, -Build_Pkg_Dev = build_pkg_dev, -Build_Doc_Release = build_doc_release, -Build_Doc_Dev = build_doc_dev, -`Released_on_R-Universe` = badge_runiverse, -### Avoid issue with CRAN R packages badges -### (no problem if PANDOC version >= 2.2.1) -### https://github.com/rstudio/rmarkdown/issues/228 -Released_on_CRAN = badge_cran(repo_infos$name), -Citation_DigitalObjectIdentifer = badge_zenodo(repo_infos$full_name), -Doc_Rel = check_docu_release(repo_names = repo_infos$name), -Doc_Dev = check_docu_dev(repo_names = repo_infos$name), -stringsAsFactors = FALSE) + build_pkg_dev <- as.vector(sapply(repo_infos$name, function(repo) { + kwb.pkgbuild::use_badge_ghactions_rcmdcheck(repo, branch = "dev") + })) + build_doc_release <- as.vector(sapply(repo_infos$name, function(repo) { + kwb.pkgbuild::use_badge_ghactions_pkgdown(repo) + })) -dat <- cbind(repo_infos, meta_info) + build_doc_dev <- as.vector(sapply(repo_infos$name, function(repo) { + kwb.pkgbuild::use_badge_ghactions_pkgdown(repo, branch = "dev") + })) -check_gitlab <- check_gitlab_backup() -deployed_on_opencpu <- check_opencpu_deploy() + badge_runiverse <- as.vector(sapply(repo_infos$name, function(repo) { + kwb.pkgbuild::use_badge_runiverse(repo) + })) -dat <- dat %>% - dplyr::left_join(y = check_gitlab) %>% - dplyr::left_join(y = deployed_on_opencpu) + meta_info <- data.frame( + License_Badge = badge_license(repo_infos$license_key), + Dependencies = badge_dependencies(repo_infos$name), + Tests_Coverage.io = badge_codecov(repo_infos$full_name), + Build_Pkg_Release = build_pkg_release, + Build_Pkg_Dev = build_pkg_dev, + Build_Doc_Release = build_doc_release, + Build_Doc_Dev = build_doc_dev, + `Released_on_R-Universe` = badge_runiverse, + ### Avoid issue with CRAN R packages badges + ### (no problem if PANDOC version >= 2.2.1) + ### https://github.com/rstudio/rmarkdown/issues/228 + Released_on_CRAN = badge_cran(repo_infos$name), + Citation_DigitalObjectIdentifer = badge_zenodo(repo_infos$full_name), + Doc_Rel = check_docu_release(repo_names = repo_infos$name), + Doc_Dev = check_docu_dev(repo_names = repo_infos$name), + stringsAsFactors = FALSE + ) -return(dat) -} \ No newline at end of file + repo_infos %>% + cbind(meta_info) %>% + dplyr::left_join(y = check_gitlab_backup()) %>% + dplyr::left_join(y = check_opencpu_deploy()) +} diff --git a/R/url_helpers.R b/R/url_helpers.R new file mode 100644 index 0000000..1987708 --- /dev/null +++ b/R/url_helpers.R @@ -0,0 +1,49 @@ +# compose_url ------------------------------------------------------------------ +compose_url <- function( + protocol = "http", + subdomain = NULL, + domain_name, + path = "", + parameters = list() +) +{ + paste0( + protocol, "://", + if (!is.null(subdomain)) { + paste0(subdomain, ".") + }, + domain_name, + url_path(path), + do.call(url_parameter_string, parameters) + ) +} + +# image_link ------------------------------------------------------------------- +image_link <- function(image_name, image_url, link_url) +{ + sprintf("[!%s](%s)", named_link(image_name, image_url),link_url) +} + +# named_link ------------------------------------------------------------------- +named_link <- function(name, url) +{ + sprintf("[%s](%s)", name, url) +} + +# url_parameter_string --------------------------------------------------------- +url_parameter_string <- function(...) +{ + parameters <- list(...) + + if (length(parameters) == 0L) { + return("") + } + + paste0("?", paste0(names(parameters), "=", parameters, collapse = "&")) +} + +# url_path --------------------------------------------------------------------- +url_path <- function(path) +{ + paste0(ifelse(path == "", "", "/"), gsub("^/+", "", path)) +} diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..af45e88 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,50 @@ +# cat_if ----------------------------------------------------------------------- +cat_if <- function(condition, fmt, ...) +{ + if (condition) { + cat(sprintf(fmt, ...)) + } +} + +# dot_to_dash ------------------------------------------------------------------ +dot_to_dash <- function(x) +{ + gsub(".", "-", x, fixed = TRUE) +} + +# get_github_token ------------------------------------------------------------- +get_github_token <- function() +{ + Sys.getenv("GITHUB_TOKEN") +} + +# get_gitlab_token ------------------------------------------------------------- +get_gitlab_token <- function() +{ + Sys.getenv("GITLAB_TOKEN") +} + +# html_a ----------------------------------------------------------------------- +html_a <- function(href, x) +{ + sprintf("%s", href, x) +} + +# html_img --------------------------------------------------------------------- +html_img <- function(src, img_attr) +{ + sprintf("", src, img_attr) +} + +# na_along --------------------------------------------------------------------- +na_along <- function(x) +{ + rep(NA, length = length(x)) +} + +# prefix_names ----------------------------------------------------------------- +prefix_names <- function(x, prefix) +{ + names(x) <- paste0(prefix, names(x)) + x +} diff --git a/R/zen_collections.R b/R/zen_collections.R index 3dcd285..105de80 100644 --- a/R/zen_collections.R +++ b/R/zen_collections.R @@ -18,11 +18,19 @@ process_hitter_response <- function (response) #' @export #' @seealso \url{https://developers.zenodo.org/#depositions} -zen_collections <- function (n = 1000, - access_token = Sys.getenv("ZENODO_TOKEN")) { - dir_path <- "https://zenodo.org/api/deposit/depositions" - args <- as.list(c("size" = n, "access_token" = access_token)) - results <- httr::GET(dir_path, query = args) +zen_collections <- function(n = 1000, access_token = Sys.getenv("ZENODO_TOKEN")) +{ + results <- httr::GET( + url = compose_url( + protocol = "https", + domain_name = "zenodo.org", + path = "api/deposit/depositions" + ), + query = list( + size = n, + access_token = access_token + ) + ) request <- httr::content(results) process_hitter_response(request) } diff --git a/man/badge_gitlab.Rd b/man/badge_gitlab.Rd index bc56fbd..710ef5d 100644 --- a/man/badge_gitlab.Rd +++ b/man/badge_gitlab.Rd @@ -6,8 +6,8 @@ \usage{ badge_gitlab( url, - logo_path = paste0("https://gitlab.com/gitlab-com/gitlab-artwork/raw/", - "master/logo/logo-square.png"), + logo_path = compose_url(protocol = "https", domain_name = "gitlab.com", path = + "gitlab-com/gitlab-artwork/raw/master/logo/logo-square.png"), size = 24 ) } diff --git a/man/badge_license.Rd b/man/badge_license.Rd index cad77b6..a3aa9dc 100644 --- a/man/badge_license.Rd +++ b/man/badge_license.Rd @@ -4,7 +4,7 @@ \alias{badge_license} \title{badge_license} \usage{ -badge_license(license_keys, github_token = Sys.getenv("GITHUB_TOKEN")) +badge_license(license_keys, github_token = get_github_token()) } \arguments{ \item{license_keys}{one or many valid license keys from c("agpl-3.0", diff --git a/man/badge_opencpu.Rd b/man/badge_opencpu.Rd index 977b27b..853f1a1 100644 --- a/man/badge_opencpu.Rd +++ b/man/badge_opencpu.Rd @@ -6,7 +6,8 @@ \usage{ badge_opencpu( url, - logo_path = "https://avatars2.githubusercontent.com/u/28672890?s=200&v=4", + logo_path = compose_url(protocol = "https", subdomain = "avatars2", domain_name = + "githubusercontent.com", path = "u/28672890", parameters = list(s = 200, v = 4)), size = 24 ) } diff --git a/man/check_gitlab_backup.Rd b/man/check_gitlab_backup.Rd index c8542d4..14a393c 100644 --- a/man/check_gitlab_backup.Rd +++ b/man/check_gitlab_backup.Rd @@ -6,8 +6,8 @@ \usage{ check_gitlab_backup( group = "KWB-R", - github_token = Sys.getenv("GITHUB_TOKEN"), - gitlab_token = Sys.getenv("GITLAB_TOKEN") + github_token = get_github_token(), + gitlab_token = get_gitlab_token() ) } \arguments{ diff --git a/man/create_report_rpackages.Rd b/man/create_report_rpackages.Rd index 0bcc775..8a8b44b 100644 --- a/man/create_report_rpackages.Rd +++ b/man/create_report_rpackages.Rd @@ -8,8 +8,7 @@ create_report_rpackages( secrets_csv = NULL, non_r_packages = get_non_r_packages(), export_dir = ".", - input_rmd = system.file("extdata/reports/status_report.Rmd", package = - "kwb.pkgstatus") + input_rmd = system.file("extdata/reports/status_report.Rmd", package = "kwb.pkgstatus") ) } \arguments{ diff --git a/man/get_github_repos.Rd b/man/get_github_repos.Rd index 6a61905..56efeb3 100644 --- a/man/get_github_repos.Rd +++ b/man/get_github_repos.Rd @@ -4,7 +4,7 @@ \alias{get_github_repos} \title{get_github_repos} \usage{ -get_github_repos(group = "KWB-R", github_token = Sys.getenv("GITHUB_TOKEN")) +get_github_repos(group = "KWB-R", github_token = get_github_token()) } \arguments{ \item{group}{username or organisation for Github (default: "KWB-R")} diff --git a/man/get_gitlab_repos.Rd b/man/get_gitlab_repos.Rd index 3f12f93..7dde09a 100644 --- a/man/get_gitlab_repos.Rd +++ b/man/get_gitlab_repos.Rd @@ -4,7 +4,7 @@ \alias{get_gitlab_repos} \title{get_gitlab_repos} \usage{ -get_gitlab_repos(group = "KWB-R", gitlab_token = Sys.getenv("GITLAB_TOKEN")) +get_gitlab_repos(group = "KWB-R", gitlab_token = get_gitlab_token()) } \arguments{ \item{group}{username or organisation for Gitlab (default: "KWB-R")} From f4705ec8fb64cd43452670f6e53541f97b73ce97 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 06:23:54 +0200 Subject: [PATCH 08/48] Simplify (e.g. use shorter names) --- R/badge_codecov.R | 8 ++++---- R/badge_cran.R | 6 +++--- R/badge_dependencies.R | 6 +++--- R/badges_ci.R | 25 ++++++++++++------------- R/check_documentation.R | 10 +++------- 5 files changed, 25 insertions(+), 30 deletions(-) diff --git a/R/badge_codecov.R b/R/badge_codecov.R index 7671cf6..b5521ea 100644 --- a/R/badge_codecov.R +++ b/R/badge_codecov.R @@ -7,17 +7,17 @@ badge_codecov <- function(repo_full_names) { - to_full_url <- function(path_pattern) { + to_url <- function(path) { compose_url( protocol = "https", domain_name = "codecov.io", - path = sprintf(path_pattern, repo_full_names) + path = paste0("github/", repo_full_names, path) ) } image_link( image_name = "codecov", - image_url = to_full_url("github/%s/branch/master/graphs/badge.svg"), - link_url = to_full_url("github/%s") + image_url = to_url("/branch/master/graphs/badge.svg"), + link_url = to_url("") ) } diff --git a/R/badge_cran.R b/R/badge_cran.R index a045c19..a4cf654 100644 --- a/R/badge_cran.R +++ b/R/badge_cran.R @@ -5,7 +5,7 @@ #' @export badge_cran <- function(repo_names) { - to_full_url <- function(path) { + to_url <- function(path) { compose_url( protocol = "http", subdomain = "www", @@ -16,7 +16,7 @@ badge_cran <- function(repo_names) image_link( image_name = "CRAN_Status_Badge", - image_url = to_full_url("badges/version"), - link_url = to_full_url("pkg") + image_url = to_url("badges/version"), + link_url = to_url("pkg") ) } diff --git a/R/badge_dependencies.R b/R/badge_dependencies.R index 963ab97..79abbc8 100644 --- a/R/badge_dependencies.R +++ b/R/badge_dependencies.R @@ -5,7 +5,7 @@ #' @export badge_dependencies <- function(repo_names) { - to_full_url <- function(path = "") { + to_url <- function(path) { compose_url( protocol = "https", subdomain = "kwb-githubdeps", @@ -16,7 +16,7 @@ badge_dependencies <- function(repo_names) image_link( image_name = "Dependencies_badge", - image_url = to_full_url(paste0("badge/", repo_names)), - link_url = to_full_url() + image_url = to_url(paste0("badge/", repo_names)), + link_url = to_url("") ) } diff --git a/R/badges_ci.R b/R/badges_ci.R index ad01b3a..b68cbdc 100644 --- a/R/badges_ci.R +++ b/R/badges_ci.R @@ -6,7 +6,7 @@ #' @export badge_appveyor <- function(repo_full_names) { - to_full_url <- function(path, parameters = list()) { + to_url <- function(path, parameters) { compose_url( protocol = "https", subdomain = "ci", @@ -18,15 +18,13 @@ badge_appveyor <- function(repo_full_names) image_link( image_name = "Appveyor", - image_url = to_full_url( + image_url = to_url( path = sprintf("api/projects/status/github/%s", repo_full_names), - parameters = list( - branch = "master", - svg = "true" - ) + parameters = list(branch = "master", svg = "true") ), - link_url = to_full_url( - path = sprintf("project/%s/branch/master", dot_to_dash(repo_full_names)) + link_url = to_url( + path = sprintf("project/%s/branch/master", dot_to_dash(repo_full_names)), + parameters = list() ) ) } @@ -39,7 +37,7 @@ badge_appveyor <- function(repo_full_names) #' @export badge_travis <- function(repo_full_names) { - to_full_url <- function(path, parameters = list()) { + to_url <- function(path, parameters) { compose_url( protocol = "https", domain_name = "travis-ci.org", @@ -50,12 +48,13 @@ badge_travis <- function(repo_full_names) image_link( image_name = "Travis", - image_url = to_full_url( - path = sprintf("%s.svg", repo_full_names), + image_url = to_url( + path = sprintf("%s.svg", repo_full_names), parameters = list(branch = "master") ), - link_url = to_full_url( - path = repo_full_names + link_url = to_url( + path = repo_full_names, + parameters = list() ) ) } diff --git a/R/check_documentation.R b/R/check_documentation.R index ffe00b1..3604ca6 100644 --- a/R/check_documentation.R +++ b/R/check_documentation.R @@ -3,7 +3,6 @@ #' @param url url of documentation website #' @importFrom httr status_code GET #' @return TRUE in case HTTP status code is 200, if not: FALSE - url_success <- function(url) { identical(httr::status_code(x = httr::GET(url)), 200L) @@ -40,13 +39,10 @@ check_docu_impl <- function(repo_names, url, path_format) url <- sprintf(path_format, url, repo) - docu_available <- url_success(url = url) - - if(docu_available) { - sprintf("[X](%s)", url) - } else { - "" + if (!url_success(url = url)) { + return("") } + named_link("X", url) }) } From 60ab4c5564b0e04ce7e3ca71d4e64871ea2dbc5f Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 06:25:37 +0200 Subject: [PATCH 09/48] Remove function duplicates! The functions were copied to separate files! --- R/get_repo_infos.R | 230 --------------------------------------------- 1 file changed, 230 deletions(-) diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index 42162e4..4aaa6b7 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -133,233 +133,3 @@ get_github_repos <- function(group = "KWB-R", github_token = get_github_token()) res[order(res$name,decreasing = FALSE), ] } - -# badge_cran ------------------------------------------------------------------- -badge_cran <- function(repo_names) -{ - url_formats <- compose_url( - protocol = "http", - subdomain = "www", - domain_name = "r-pkg.org", - path = c( - "/badges/version/%s", - "/pkg/%s" - ) - ) - - image_link( - image_name = "CRAN_Status_Badge", - image_url = sprintf(url_formats[1L], repo_names), - link_url = sprintf(url_formats[2L], repo_names) - ) -} - -# badge_codecov ---------------------------------------------------------------- -badge_codecov <- function(repo_full_names) -{ - url_formats <- compose_url( - protocol = "https", - domain_name = "codecov.io", - path = c( - "/github/%s/branch/master/graphs/badge.svg", - "/github/%s" - ) - ) - - image_link( - image_name = "codecov", - image_url = sprintf(url_formats[1L], repo_full_names), - link_url = sprintf(url_formats[2L], repo_full_names) - ) -} - -# badge_license ---------------------------------------------------------------- -badge_license <- function(license_keys, github_token = get_github_token()) -{ - gh_licenses <- gh::gh(endpoint = "GET /licenses", .token = github_token) - - gh_licenses_df <- data.table::rbindlist(gh_licenses, fill=TRUE) - - #### License badges from: https://gist.github.com/lukas-h/2a5d00690736b4c3a7ba - license_badges <- get_license_badge_info() - - gh_licenses_df <- dplyr::left_join(gh_licenses_df, license_badges) - - gh_licenses_df$Badge_License <- image_link( - image_name = gh_licenses_df$spdx_id, - image_url = gh_licenses_df$image_url, - link_url = gh_licenses_df$license_url - ) - - badges <- gh_licenses_df %>% - dplyr::select_(~key, ~Badge_License) %>% - dplyr::rename_(license_key = ~key) - - result <- dplyr::left_join( - x = data.frame( - license_key = license_keys, - stringsAsFactors = FALSE - ), - y = badges - ) - - result$Badge_License -} - -# badge_appveyor --------------------------------------------------------------- -badge_appveyor <- function(repo_full_names) -{ - url_formats <- compose_url( - protocol = "https", - subdomain = "ci", - domain_name = "appveyor.com", - path = c( - "api/projects/status/github/%s?branch=master&svg=true", - "project/%s/branch/master" - ) - ) - - image_link( - image_name = "Appveyor", - image_url = sprintf(url_formats[1L], repo_full_names), - link_url = sprintf(url_formats[2L], dot_to_dash(repo_full_names)) - ) -} - -# badge_travis ----------------------------------------------------------------- -badge_travis <- function(repo_full_names) -{ - url_formats <- compose_url( - protocol = "https", - domain_name = "travis-ci.org", - path = c( - "/%s.svg?branch=master", - "/%s" - ) - ) - - image_link( - image_name = "Travis", - image_url = sprintf(url_formats[1L], repo_full_names), - link_url = sprintf(url_formats[2L], repo_full_names) - ) -} - -# badge_zenodo ----------------------------------------------------------------- -badge_zenodo <- function( - repo_full_names, - zenodo_token = Sys.getenv("ZENODO_TOKEN") -) -{ - zen_data <- zen_collections(access_token = zenodo_token) - - zen_badge <- na_along(repo_full_names) - - for (index in seq_along(repo_full_names)) { - - doi_exists <- stringr::str_detect( - string = zen_data$metadata.related_identifiers.identifier, - pattern = compose_url( - protocol = "https", - domain_name = "github.com", - path = paste0("/", repo_full_names[index]) - ) - ) - - doi_exists[is.na(doi_exists)] <- FALSE - - if (sum(doi_exists) == 1) { - - zen_badge[index] <- sprintf( - "[![DOI](%s)](%s)", - zen_data$links.badge[doi_exists], - zen_data$doi_url[doi_exists] - ) - - } else if (sum(doi_exists) > 1) { - warn_msg <- sprintf( - "Multiple entries found for repo '%s':\n%s", - repo_full_names[index], - paste( - zen_data$metadata.related_identifiers.identifier[doi_exists], - collapse = "\n" - ) - ) - warning(warn_msg) - zen_badge[index] <- "Multiple badges found!" - } else { - zen_badge[index] <- NA - } - } - - zen_badge -} - -# get_coverage ----------------------------------------------------------------- -get_coverage <- function( - repo_full_name, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE -) -{ - url <- compose_url( - protocol = "https", - domain_name = "codecov.io", - path = paste0("/api/gh/", repo_full_name) - ) - - cat_if(dbg, "Checking code coverage for %s at %s", repo_full_name, url) - - req <- sprintf("%s?access_token=%s", url, codecov_token) - - if(httr::status_code(httr::GET(url = req)) == 200L) { - codecov_data <- jsonlite::fromJSON(req) - - if(!is.null(codecov_data$commit$totals$c)) { - codecov_coverage <- round( - as.numeric(codecov_data$commit$totals$c), - digits = 2 - ) - } else { - codecov_coverage <- NA - } - } else { - codecov_coverage <- NA - } - - cat_if(dbg, "....%3.1f%%\n", codecov_coverage) - - codecov_coverage -} - -# get_coverages ---------------------------------------------------------------- -get_coverages <- function ( - repo_full_names, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE -) -{ - coverage_percent <- na_along(repo_full_names) - coverage_url <- na_along(repo_full_names) - - for (index in seq_along(repo_full_names)) { - coverage_percent[index] <- get_coverage( - repo_full_name = repo_full_names[index], - codecov_token, - dbg - ) - } - - available_indices <- which(!is.na(coverage_percent)) - - coverage_url[available_indices] <- compose_url( - protocol = "https", - domain_name = "codecov.io", - path = paste0("gh/", repo_full_names[available_indices]) - ) - - data.frame( - Coverage = coverage_percent, - Coverage_url = coverage_url - ) -} From b66ad91d62d9ee6ae64aa863e9ce8eec4ead5238 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 06:27:40 +0200 Subject: [PATCH 10/48] Change interface to html_img() --- R/badge_gitlab.R | 4 +--- R/badge_opencpu.R | 4 +--- R/utils.R | 19 +++++++++++++++++-- 3 files changed, 19 insertions(+), 8 deletions(-) diff --git a/R/badge_gitlab.R b/R/badge_gitlab.R index 4cc26f4..1bff33f 100644 --- a/R/badge_gitlab.R +++ b/R/badge_gitlab.R @@ -16,9 +16,7 @@ badge_gitlab <- function( size = 24 ) { - img_attr <- sprintf(" title='Gitlab' width='%d' height = '%d'", size, size) - logo_path %>% - html_img(img_attr) %>% + html_img(title = "Gitlab", width = size, height = size) %>% html_a(href = url) } diff --git a/R/badge_opencpu.R b/R/badge_opencpu.R index a2d413c..dad6ef2 100644 --- a/R/badge_opencpu.R +++ b/R/badge_opencpu.R @@ -21,9 +21,7 @@ badge_opencpu <- function( size = 24 ) { - img_attr <- sprintf(" title='OpenCpu' width='%d' height = '%d'", size, size) - logo_path %>% - html_img(img_attr) %>% + html_img(title = "OpenCpu", width = size, height = size) %>% html_a(href = url) } diff --git a/R/utils.R b/R/utils.R index af45e88..a0d97cc 100644 --- a/R/utils.R +++ b/R/utils.R @@ -30,10 +30,25 @@ html_a <- function(href, x) sprintf("%s", href, x) } +# html_attribute_string -------------------------------------------------------- +html_attribute_string <- function(...) +{ + attributes <- list(...) + + sprintf("%s='%s'", names(attributes), attributes) %>% + paste(collapse = ", ") +} + # html_img --------------------------------------------------------------------- -html_img <- function(src, img_attr) +html_img <- function(src, ...) { - sprintf("", src, img_attr) + attr_string <- html_attribute_string(...) + + sprintf( + "", + src, + ifelse(nzchar(attr_string), paste0(" ", attr_string), "") + ) } # na_along --------------------------------------------------------------------- From 8cd52e6cb87897a8ea7b6d07e39ea8106c86a16d Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 06:31:54 +0200 Subject: [PATCH 11/48] Clean badg_zenodo.R --- R/badge_zenodo.R | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/R/badge_zenodo.R b/R/badge_zenodo.R index 44e95fa..20f67aa 100644 --- a/R/badge_zenodo.R +++ b/R/badge_zenodo.R @@ -1,4 +1,5 @@ #' badge_zenodo +#' #' @param repo_full_names vector with combination of username/repo (e.g. #' c("KWB-R/kwb.utils", "KWB-R/kwb.db")) #' @param zenodo_token zenodo authentication token (default: @@ -13,7 +14,7 @@ badge_zenodo <- function( { zen_data <- zen_collections(access_token = zenodo_token) - zen_badge <- na_along(repo_full_names) + result <- na_along(repo_full_names) for (index in seq_along(repo_full_names)) { @@ -28,33 +29,36 @@ badge_zenodo <- function( doi_exists[is.na(doi_exists)] <- FALSE - if (sum(doi_exists) == 1L) { + n_existing <- sum(doi_exists) + + if (n_existing == 1L) { - zen_badge[index] <- image_link( + result[index] <- image_link( image_name = "DOI", image_url = zen_data$links.badge[doi_exists], link_url = zen_data$doi_url[doi_exists] ) - } else if (sum(doi_exists) > 1L) { + } else if (n_existing > 1L) { - warn_msg <- sprintf( - "Multiple entries found for repo '%s':\n%s", - repo_full_names[index], + warning( + sprintf( + "Multiple entries found for repo '%s':\n", + repo_full_names[index] + ), paste( zen_data$metadata.related_identifiers.identifier[doi_exists], collapse = "\n" ) ) - warning(warn_msg) - zen_badge[index] <- "Multiple badges found!" + result[index] <- "Multiple badges found!" } else { - zen_badge[index] <- NA + result[index] <- NA } } - zen_badge + result } From 73b1415e0531dac8064c1c4b6fca1fd5903abf83 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 06:32:46 +0200 Subject: [PATCH 12/48] Fix documentation --- R/create_report_rpackages.R | 3 ++- man/create_report_rpackages.Rd | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/create_report_rpackages.R b/R/create_report_rpackages.R index f680e81..f8b0c6e 100644 --- a/R/create_report_rpackages.R +++ b/R/create_report_rpackages.R @@ -1,4 +1,5 @@ -#' Create R packages status report#' +#' Create R packages status report +#' #' @param secrets_csv path to "secrets.csv" file, if "NULL" Sys.env variables #' for the following services are used/need to be defined: APPVEYOR_TOKEN, #' GITHUB_TOKEN, GITLAB_TOKEN, CODECOV_TOKEN, ZENODO_TOKEN, diff --git a/man/create_report_rpackages.Rd b/man/create_report_rpackages.Rd index 8a8b44b..662218c 100644 --- a/man/create_report_rpackages.Rd +++ b/man/create_report_rpackages.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/create_report_rpackages.R \name{create_report_rpackages} \alias{create_report_rpackages} -\title{Create R packages status report#'} +\title{Create R packages status report} \usage{ create_report_rpackages( secrets_csv = NULL, @@ -30,5 +30,5 @@ creates html status report for R packages and returns the absolute path to the export directory } \description{ -Create R packages status report#' +Create R packages status report } From 07c13c62bac8f9408518645366ee91fec13bc9fc Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 06:34:20 +0200 Subject: [PATCH 13/48] Reuse url_success(), use paste0(), not sprintf() --- R/get_coverages.R | 10 ++++++---- man/get_coverages.Rd | 4 ++-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/R/get_coverages.R b/R/get_coverages.R index 3dcd6fe..458fc0f 100644 --- a/R/get_coverages.R +++ b/R/get_coverages.R @@ -1,4 +1,5 @@ #' get_coverage +#' #' @param repo_full_name one combination of username/repo (e.g."KWB-R/kwb.db") #' @param codecov_token codecov authentication token (default: #' Sys.getenv("CODECOV_TOKEN")) @@ -21,11 +22,11 @@ get_coverage <- function( req <- paste0(url, url_parameter_string(access_token = codecov_token)) - if (httr::status_code(httr::GET(url = req)) == 200L) { + if (url_success(req)) { codecov_data <- jsonlite::fromJSON(req) - if(!is.null(codecov_data$commit$totals$c)) { + if (!is.null(codecov_data$commit$totals$c)) { codecov_coverage <- round( as.numeric(codecov_data$commit$totals$c), @@ -47,7 +48,8 @@ get_coverage <- function( codecov_coverage } -#' get_coverage +#' get_coverages +#' #' @param repo_full_names vector with combination of username/repo (e.g. #' c("KWB-R/kwb.utils", "KWB-R/kwb.db")) #' @param codecov_token zenodo authentication token (default: @@ -78,7 +80,7 @@ get_coverages <- function( coverage_url[available_indices] <- compose_url( protocol = "https", domain_name = "codecov.io", - path = sprintf("gh/%s", repo_full_names[available_indices]) + path = paste0("gh/", repo_full_names[available_indices]) ) data.frame( diff --git a/man/get_coverages.Rd b/man/get_coverages.Rd index 5d6b8c4..b17d8df 100644 --- a/man/get_coverages.Rd +++ b/man/get_coverages.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/get_coverages.R \name{get_coverages} \alias{get_coverages} -\title{get_coverage} +\title{get_coverages} \usage{ get_coverages( repo_full_names, @@ -24,5 +24,5 @@ data.frame with coverage percent and url for all provided repo_full_names } \description{ -get_coverage +get_coverages } From 06d9595f4b88fb17173cad234b6bc389bfceb442 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 06:35:21 +0200 Subject: [PATCH 14/48] Clean check_opencpu_deploy.R --- R/check_opencpu_deploy.R | 11 +++++------ man/check_opencpu_deploy.Rd | 2 +- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/R/check_opencpu_deploy.R b/R/check_opencpu_deploy.R index 96baf1c..4a4c09a 100644 --- a/R/check_opencpu_deploy.R +++ b/R/check_opencpu_deploy.R @@ -1,4 +1,5 @@ -#' check_opencpu_deploy: get all Github repos that are deployed on OpenCpu +#' Get all Github repos that are deployed on OpenCpu +#' #' @description Direct deployment of R packages (including vignette build) by #' using webhooks as described in OpenCpu blog post #' (https://www.opencpu.org/posts/opencpu-release-1-4-5/) and online help @@ -10,19 +11,17 @@ check_opencpu_deploy <- function(group = "KWB-R") { - ocpu_url <- compose_url( + url <- compose_url( protocol = "https", subdomain = tolower(group), domain_name = "ocpu.io" ) - repo_names <- readLines(ocpu_url) - - ocpu_urls <- sprintf("%s/%s", ocpu_url, repo_names) + repo_names <- readLines(url) data.frame( name = repo_names, - OpenCpu = badge_opencpu(ocpu_urls), + OpenCpu = badge_opencpu(sprintf("%s/%s", url, repo_names)), stringsAsFactors = FALSE ) } diff --git a/man/check_opencpu_deploy.Rd b/man/check_opencpu_deploy.Rd index bfab030..873e2e9 100644 --- a/man/check_opencpu_deploy.Rd +++ b/man/check_opencpu_deploy.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/check_opencpu_deploy.R \name{check_opencpu_deploy} \alias{check_opencpu_deploy} -\title{check_opencpu_deploy: get all Github repos that are deployed on OpenCpu} +\title{Get all Github repos that are deployed on OpenCpu} \usage{ check_opencpu_deploy(group = "KWB-R") } From 80e646abf60870308c52badb389cb68ee0f2d227 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 06:36:03 +0200 Subject: [PATCH 15/48] Add a new line character --- R/get_non_r_packages.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/get_non_r_packages.R b/R/get_non_r_packages.R index 94efc30..b2e6de1 100644 --- a/R/get_non_r_packages.R +++ b/R/get_non_r_packages.R @@ -5,8 +5,8 @@ #' @examples #' get_non_r_packages() #' -get_non_r_packages <- function() { - +get_non_r_packages <- function() +{ c( "abimo", "abimo.scripts", From 5dbf2cc044782ae6d77cc4753fe6aceeb37709df Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 06:39:17 +0200 Subject: [PATCH 16/48] Clean badge_license.R - change order of commands in order to prolong the pipe - remove column renaming without effect (image_url -> badge_url) - rename result variable to "result" --- R/badge_license.R | 32 ++++++++++++++------------------ 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/R/badge_license.R b/R/badge_license.R index 17e54c5..9fe7642 100644 --- a/R/badge_license.R +++ b/R/badge_license.R @@ -11,33 +11,29 @@ #' @export badge_license <- function(license_keys, github_token = get_github_token()) { - gh_licenses <- gh::gh(endpoint = "GET /licenses", .token = github_token) - - gh_licenses_df <- data.table::rbindlist(gh_licenses, fill=TRUE) - #### License badges from: https://gist.github.com/lukas-h/2a5d00690736b4c3a7ba - license_badges <- get_license_badge_info() %>% - kwb.utils::renameColumns(list(image_url = "badge_url")) + license_badges <- get_license_badge_info() - gh_licenses_df <- dplyr::left_join(gh_licenses_df, license_badges) + gh_licenses_df <- "GET /licenses" %>% + gh::gh(.token = github_token) %>% + data.table::rbindlist(fill = TRUE) %>% + dplyr::left_join(license_badges) gh_licenses_df$Badge_License <- image_link( image_name = gh_licenses_df$spdx_id, - image_url = gh_licenses_df$badge_url, + image_url = gh_licenses_df$image_url, link_url = gh_licenses_df$license_url ) badges <- gh_licenses_df %>% dplyr::select_(~key, ~Badge_License) %>% - dplyr::rename_(license_key = ~key) - - result <- dplyr::left_join( - x = data.frame( - license_key = license_keys, - stringsAsFactors = FALSE - ), - y = badges - ) + dplyr::rename_(license_key = ~key) %>% + dplyr::left_join( + x = data.frame( + license_key = license_keys, + stringsAsFactors = FALSE + ) + ) - result$Badge_License + badges$Badge_License } From 554c9958ef3584c72df8be5a2a52375ca441b5a0 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 06:41:44 +0200 Subject: [PATCH 17/48] Clean check_gitlab_backup.R - use inline expressions instead of helper variables - rename "tmp" to "git_repos" --- R/check_gitlab_backup.R | 26 ++++++++++---------------- 1 file changed, 10 insertions(+), 16 deletions(-) diff --git a/R/check_gitlab_backup.R b/R/check_gitlab_backup.R index 6826714..c07a24d 100644 --- a/R/check_gitlab_backup.R +++ b/R/check_gitlab_backup.R @@ -15,27 +15,21 @@ check_gitlab_backup <- function( gitlab_token = get_gitlab_token() ) { - github_repos <- get_github_repos(group, github_token) %>% - prefix_names("gh_") - - gitlab_repos <- get_gitlab_repos(group,gitlab_token) %>% - prefix_names("gl_") - - tmp <- github_repos %>% - dplyr::left_join( - y = gitlab_repos, - by = c("gh_name" = "gl_name") - ) + git_repos <- dplyr::left_join( + x = prefix_names(get_github_repos(group, github_token), "gh_"), + y = prefix_names(get_gitlab_repos(group, gitlab_token), "gl_"), + by = c("gh_name" = "gl_name") + ) - tmp$last_mirrored_hours <- difftime( - lubridate::as_datetime(tmp$gh_pushed_at), - lubridate::as_datetime(tmp$gl_last_activity_at), + git_repos$last_mirrored_hours <- difftime( + lubridate::as_datetime(git_repos$gh_pushed_at), + lubridate::as_datetime(git_repos$gl_last_activity_at), units = "hours" ) - is_mirrored <- tmp$last_mirrored_hours <= 2 #h + is_mirrored <- git_repos$last_mirrored_hours <= 2 #h - mirrored_repos <- tmp[is_mirrored, ] + mirrored_repos <- git_repos[is_mirrored, ] data.frame( name = mirrored_repos$gh_name, From d0359165cbc814967bb0c0b08c9104f6d9d4cf17 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 13:31:40 +0200 Subject: [PATCH 18/48] Add list_files_in_github_repo() --- R/list_files_in_github_repo.R | 48 +++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) create mode 100644 R/list_files_in_github_repo.R diff --git a/R/list_files_in_github_repo.R b/R/list_files_in_github_repo.R new file mode 100644 index 0000000..2e0fbce --- /dev/null +++ b/R/list_files_in_github_repo.R @@ -0,0 +1,48 @@ +# list_files_in_github_repo ---------------------------------------------------- +list_files_in_github_repo <- function( + owner, + repo, + path = "", + full_info = FALSE, + columns = c("isdir", "name", "path", "download_url") +) +{ + #owner="kwb-r";repo="kwb.utils"; + + url <- compose_url( + protocol = "https", + subdomain = "api", + domain_name = "github.com", + path = sprintf("repos/%s/%s/contents/%s", owner, repo, path) + ) + + response <- httr::GET(url, config = list( + Authorization = paste("Bearer", get_github_token())) + ) + + contents <- httr::content(response) + + file_info <- lapply(contents, function(x) { + as.data.frame(x[setdiff(names(x), c("_links", "download_url"))]) + }) %>% + do.call(what = rbind) + + isdir <- file_info[["type"]] == "dir" + + file_info[["download_url"]] <- character(nrow(file_info)) + + file_info[["download_url"]][!isdir] <- sapply( + contents[!isdir], + FUN = `[[`, + elements = "download_url" + ) + + file_info[["isdir"]] <- isdir + + if (full_info) { + return(file_info[columns]) + } + + file_info[["name"]] %>% + paste0(ifelse(isdir, "/", "")) +} From 1b262c4e32888479ca2a0229682ddb5ede7c98ac Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 14:38:00 +0200 Subject: [PATCH 19/48] Look for GITHUB_TOKEN first, GITHUB_PAT second --- R/utils.R | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index a0d97cc..3826622 100644 --- a/R/utils.R +++ b/R/utils.R @@ -15,7 +15,14 @@ dot_to_dash <- function(x) # get_github_token ------------------------------------------------------------- get_github_token <- function() { - Sys.getenv("GITHUB_TOKEN") + for (name in c("GITHUB_TOKEN", "GITHUB_PAT")) { + value <- Sys.getenv(name) + if (nzchar(value)) { + return(value) + } + } + + return("") } # get_gitlab_token ------------------------------------------------------------- From d63662412f25b8a67a36fc5a8b3e455940e3d7cd Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 14:39:25 +0200 Subject: [PATCH 20/48] Clean get_repo_infos() Extract - get_github_repos_impl() - github_endpoint() - github_repo_object_to_data_row() --- R/get_repo_infos.R | 171 ++++++++++++++++++++++++--------------------- R/utils.R | 6 ++ 2 files changed, 96 insertions(+), 81 deletions(-) diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index 4aaa6b7..89876cd 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -22,7 +22,7 @@ get_gitlab_repos <- function( url_parameter_string(private_token = gitlab_token) ) ) - + gitlab_group <- jsonlite::fromJSON(endpoint) gitlab_group$projects @@ -41,95 +41,104 @@ get_gitlab_repos <- function( #' @export get_github_repos <- function(group = "KWB-R", github_token = get_github_token()) { - get_repos <- function(per_page = 100L) { + #kwb.utils::assignPackageObjects("kwb.pkgstatus");group="kwb-r" + result <- group %>% + get_github_repos_impl(github_token = github_token) %>% + lapply(github_repo_object_to_data_row) %>% + do.call(what = rbind) + + result[order(result[["name"]], decreasing = FALSE), ] +} + +# get_github_repos_impl -------------------------------------------------------- +get_github_repos_impl <- function( + group, + github_token = get_github_token() +) +{ + all_repos <- list() + + # Start with the first page + page <- 1L + + # Read next page while page number is given + while (page > 0L) { - endpoint <- function(group, page, per_page) paste0( - "GET ", - url_path(sprintf("orgs/%s/repos", group)), - url_parameter_string(page = page, per_page = per_page) + # Read repos from current page + repos <- gh::gh( + endpoint = github_endpoint(group, page), + .token = github_token ) - all_repos <- list() - - # Start with the first page - page <- 1L - - # Read next page while page number is given - while(page > 0L) { + # If the page contained at least one repo... + if (length(repos) > 0L) { + + # ... append repos to the list all_repos + all_repos[[length(all_repos) + 1L]] <- repos - # Read repos from current page - repos <- gh::gh( - endpoint = endpoint(group, page, per_page), - .token = github_token - ) + page <- page + 1L - # If the page contained at least one repo... - if (length(repos) > 0L) { - - # ... append repos to the list all_repos - all_repos[[length(all_repos) + 1L]] <- repos - - page <- page + 1L - - } else { - - # Set page number to zero to finish the while-loop - page <- 0L - } + } else { + + # Set page number to zero to finish the while-loop + page <- 0L } - - do.call(what = c, args = all_repos) } - gh_repos <- get_repos() + # Combine all repo objects into one list + do.call(c, all_repos) +} + +# github_endpoint -------------------------------------------------------------- +github_endpoint <- function(group, page, per_page = 100L) +{ + sprintf( + "GET /orgs/%s/repos%s", + group, + url_parameter_string(page = page, per_page = per_page) + ) +} + +# github_repo_object_to_data_row ----------------------------------------------- +github_repo_object_to_data_row <- function(repo) +{ + name <- repo[["name"]] + full_name <- repo[["full_name"]] + url <- repo[["html_url"]] - for (repo_ind in seq_along(gh_repos)) { - - sel_repo <- gh_repos[[repo_ind]] - - tmp <- data.frame( - name = sel_repo$name, - full_name = sel_repo$full_name, - url = sel_repo$html_url, - created_at = sel_repo$created_at, - pushed_at = sel_repo$pushed_at, - open_issues = sel_repo$open_issues, - license_key = ifelse( - is.null(sel_repo$license$key), - NA, - sel_repo$license$key - ), - license_short = ifelse( - is.null(sel_repo$license$spdx_id), - NA, - sel_repo$license$spdx_id - ), - license_link = ifelse( - is.null(sel_repo$license$spdx_id), - NA, - compose_url( - protocol = "https", - domain_name = "github.com", - path = paste0(sel_repo$full_name, "/blob/master/LICENSE") - ) - ), - stringsAsFactors = FALSE - ) - - tmp$Repository <- named_link(tmp$name, tmp$url) - - tmp$License <- ifelse( - is.na(tmp$license_short), - NA, - named_link(tmp$license_short, tmp$license_link) + license_key <- na_if_null(repo[["license"]][["key"]]) + license_short <- na_if_null(repo[["license"]][["spdx_id"]]) + + license_link <- if (is.na(license_short)) { + NA + } else { + compose_url( + protocol = "https", + domain_name = "github.com", + path = paste0(full_name, "/blob/master/LICENSE") ) - - if (repo_ind == 1) { - res <- tmp - } else { - res <- rbind(res,tmp) - } - } + } + + result <- data.frame( + name = name, + full_name = full_name, + url = url, + created_at = repo[["created_at"]], + pushed_at = repo[["pushed_at"]], + open_issues = repo[["open_issues"]], + license_key = license_key, + license_short = license_short, + license_link = license_link, + stringsAsFactors = FALSE + ) + + result[["Repository"]] <- named_link(name, url) + + result[["License"]] <- if (is.na(license_short)) { + NA + } else { + named_link(license_short, license_link) + } - res[order(res$name,decreasing = FALSE), ] + result } diff --git a/R/utils.R b/R/utils.R index 3826622..3eb3e40 100644 --- a/R/utils.R +++ b/R/utils.R @@ -64,6 +64,12 @@ na_along <- function(x) rep(NA, length = length(x)) } +# na_if_null ------------------------------------------------------------------- +na_if_null <- function(x) +{ + if (is.null(x)) NA else x +} + # prefix_names ----------------------------------------------------------------- prefix_names <- function(x, prefix) { From 4baf9a7a613c5f11b84fa1886cf434f2468a5f56 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 17:11:22 +0200 Subject: [PATCH 21/48] Check for http request errors --- R/helpers.R | 15 +++++++++++++++ R/zen_collections.R | 2 +- 2 files changed, 16 insertions(+), 1 deletion(-) create mode 100644 R/helpers.R diff --git a/R/helpers.R b/R/helpers.R new file mode 100644 index 0000000..192b13a --- /dev/null +++ b/R/helpers.R @@ -0,0 +1,15 @@ +# http_get_or_stop ------------------------------------------------------------- +http_get_or_stop <- function(url, ...) +{ + response <- httr::GET(url, ...) + + if (httr::status_code(response) != 200L) { + stop( + "Error when trying to GET ", url, ":\n", + jsonlite::fromJSON(httr::content(response, type = "text"))$message, + call. = FALSE + ) + } + + response +} diff --git a/R/zen_collections.R b/R/zen_collections.R index 105de80..62e8358 100644 --- a/R/zen_collections.R +++ b/R/zen_collections.R @@ -20,7 +20,7 @@ process_hitter_response <- function (response) zen_collections <- function(n = 1000, access_token = Sys.getenv("ZENODO_TOKEN")) { - results <- httr::GET( + results <- http_get_or_stop( url = compose_url( protocol = "https", domain_name = "zenodo.org", From f01878c14b04dea195651b24a902980828bf9a3a Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 17:11:52 +0200 Subject: [PATCH 22/48] Authenticate correctly, replace all NULL with NA --- R/list_files_in_github_repo.R | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/R/list_files_in_github_repo.R b/R/list_files_in_github_repo.R index 2e0fbce..968c718 100644 --- a/R/list_files_in_github_repo.R +++ b/R/list_files_in_github_repo.R @@ -7,7 +7,8 @@ list_files_in_github_repo <- function( columns = c("isdir", "name", "path", "download_url") ) { - #owner="kwb-r";repo="kwb.utils"; + #kwb.utils::assignPackageObjects("kwb.pkgstatus") + #owner="kwb-r";repo="kwb.utils";path="" url <- compose_url( protocol = "https", @@ -16,14 +17,21 @@ list_files_in_github_repo <- function( path = sprintf("repos/%s/%s/contents/%s", owner, repo, path) ) - response <- httr::GET(url, config = list( - Authorization = paste("Bearer", get_github_token())) + response <- http_get_or_stop( + url, + config = httr::add_headers( + Authorization = paste("Bearer", get_github_token()) + ) ) contents <- httr::content(response) file_info <- lapply(contents, function(x) { - as.data.frame(x[setdiff(names(x), c("_links", "download_url"))]) + #x <- contents[[1L]] + x_without_links <- x[setdiff(names(x), "_links")] + is_null <- sapply(x_without_links, is.null) + x_without_links[is_null] <- as.list(rep(NA, sum(is_null))) + as.data.frame(x_without_links) }) %>% do.call(what = rbind) From dd642710a6b162c19dfb817e5a3ca9f41f91a029 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 18:19:51 +0200 Subject: [PATCH 23/48] Add get_names_of_r_packages_on_github() --- NAMESPACE | 1 + R/get_names_of_r_packages_on_github.R | 40 ++++++++++++++++++++++++ man/get_names_of_r_packages_on_github.Rd | 29 +++++++++++++++++ vignettes/tutorial.Rmd | 8 +++++ 4 files changed, 78 insertions(+) create mode 100644 R/get_names_of_r_packages_on_github.R create mode 100644 man/get_names_of_r_packages_on_github.Rd diff --git a/NAMESPACE b/NAMESPACE index 8b12ac2..bd8f031 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,7 @@ export(create_report_rpackages) export(get_coverages) export(get_github_repos) export(get_gitlab_repos) +export(get_names_of_r_packages_on_github) export(get_non_r_packages) export(prepare_status_rpackages) export(process_hitter_response) diff --git a/R/get_names_of_r_packages_on_github.R b/R/get_names_of_r_packages_on_github.R new file mode 100644 index 0000000..7c87bda --- /dev/null +++ b/R/get_names_of_r_packages_on_github.R @@ -0,0 +1,40 @@ +# get_names_of_r_packages_on_github -------------------------------------------- + +#' Get Names of R Packages on GitHub +#' +#' @param group name of organisation on GitHub, defaults to "kwb-r" +#' @param public logical indicating whether private repositories are to be +#' considered. Default: \code{TRUE} +#' @param private logical indicating whether public repositories are to be +#' considered. Default: \code{TRUE} +#' @returns vector of character representing the names of the \code{public} +#' and/or \code{private} repositories (as requested), owned by the +#' organisation \code{groupt} on GitHub +#' @export +get_names_of_r_packages_on_github <- function( + group = "kwb-r", public = TRUE, private = TRUE +) +{ + # Names of repositories owned by group + all_repos <- get_github_repos_impl(group = group) + + # Repository type: private or public + is_private <- sapply(all_repos, `[[`, "private") + + # Keep only repositories of requested type + repos <- all_repos[(public & !is_private) | (private & is_private)] + + # Get the names of the selected repositories + repo_names <- sapply(repos, `[[`, "name") + + # Keep only the names of repositories that look like R packages + keep <- sapply(repo_names, github_repo_looks_like_r_package, owner = group) + repo_names[keep] +} + +# github_repo_looks_like_r_package --------------------------------------------- +github_repo_looks_like_r_package <- function(owner = "kwb-r", repo) +{ + file_names <- list_files_in_github_repo(owner, repo) + all(c("R/", "DESCRIPTION") %in% file_names) +} diff --git a/man/get_names_of_r_packages_on_github.Rd b/man/get_names_of_r_packages_on_github.Rd new file mode 100644 index 0000000..40adacb --- /dev/null +++ b/man/get_names_of_r_packages_on_github.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_names_of_r_packages_on_github.R +\name{get_names_of_r_packages_on_github} +\alias{get_names_of_r_packages_on_github} +\title{Get Names of R Packages on GitHub} +\usage{ +get_names_of_r_packages_on_github( + group = "kwb-r", + public = TRUE, + private = TRUE +) +} +\arguments{ +\item{group}{name of organisation on GitHub, defaults to "kwb-r"} + +\item{public}{logical indicating whether private repositories are to be +considered. Default: \code{TRUE}} + +\item{private}{logical indicating whether public repositories are to be +considered. Default: \code{TRUE}} +} +\value{ +vector of character representing the names of the \code{public} + and/or \code{private} repositories (as requested), owned by the + organisation \code{groupt} on GitHub +} +\description{ +Get Names of R Packages on GitHub +} diff --git a/vignettes/tutorial.Rmd b/vignettes/tutorial.Rmd index d7e8461..73f1f3a 100644 --- a/vignettes/tutorial.Rmd +++ b/vignettes/tutorial.Rmd @@ -75,3 +75,11 @@ kwb.pkgstatus::create_report_rpackages(secrets_csv, ``` +# 3 What repositories represent (public) R Packages? + +```{r} +kwb.pkgstatus::get_names_of_r_packages_on_github( + group = "kwb-r", + private = FALSE +) +``` From 6d56172c417c7afe1333b3bf90332f2b9fab8371 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 18:39:11 +0200 Subject: [PATCH 24/48] Handle special case and error --- R/get_names_of_r_packages_on_github.R | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/R/get_names_of_r_packages_on_github.R b/R/get_names_of_r_packages_on_github.R index 7c87bda..36d3ab4 100644 --- a/R/get_names_of_r_packages_on_github.R +++ b/R/get_names_of_r_packages_on_github.R @@ -15,10 +15,10 @@ get_names_of_r_packages_on_github <- function( group = "kwb-r", public = TRUE, private = TRUE ) { - # Names of repositories owned by group + # Get info on all repositories owned by group all_repos <- get_github_repos_impl(group = group) - # Repository type: private or public + # Is a repository private (or public)? is_private <- sapply(all_repos, `[[`, "private") # Keep only repositories of requested type @@ -27,6 +27,11 @@ get_names_of_r_packages_on_github <- function( # Get the names of the selected repositories repo_names <- sapply(repos, `[[`, "name") + # If there are no (remaining) repository names, return an empty vector + if (length(repos) == 0L) { + return(character(0L)) + } + # Keep only the names of repositories that look like R packages keep <- sapply(repo_names, github_repo_looks_like_r_package, owner = group) repo_names[keep] @@ -35,6 +40,15 @@ get_names_of_r_packages_on_github <- function( # github_repo_looks_like_r_package --------------------------------------------- github_repo_looks_like_r_package <- function(owner = "kwb-r", repo) { - file_names <- list_files_in_github_repo(owner, repo) + file_names <- try(list_files_in_github_repo(owner, repo)) + + if (inherits(file_names, "try-error")) { + message( + "Error when trying to list files of repo '", repo, "'.\n", + "Returning FALSE (does not look like an R package)" + ) + return(FALSE) + } + all(c("R/", "DESCRIPTION") %in% file_names) } From 4f5a828407994a0e228516bb6ee0a14f36426f24 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 19:19:52 +0200 Subject: [PATCH 25/48] Add argument "hard_coded" to get_non_r_packages() --- R/get_non_r_packages.R | 120 +++++++++++++++++++++++------------------ 1 file changed, 68 insertions(+), 52 deletions(-) diff --git a/R/get_non_r_packages.R b/R/get_non_r_packages.R index b2e6de1..8d7e003 100644 --- a/R/get_non_r_packages.R +++ b/R/get_non_r_packages.R @@ -1,59 +1,75 @@ -#' Helper function: get_non_r_packages +#' Get Names of Repositories that Do not Represent R Packages #' -#' @return returns vector with KWB-R repos on Github, which are not R packages +#' @param hard_coded logical indicating whether or not to return the hard-coded +#' vector of package names. The default is \code{TRUE}. If \code{hard_coded} +#' is \code{FALSE} the names of repositories that are not assumed to represent +#' R packages are determined by looking into each repository. This may take a +#' while. +#' @return This function returns a (alphabetically sorted) vector of names of +#' KWB-R repositories on Github that do not represent R packages #' @export #' @examples #' get_non_r_packages() #' -get_non_r_packages <- function() +get_non_r_packages <- function(hard_coded = TRUE) { - c( - "abimo", - "abimo.scripts", - "ad4gd_lakes", - "apps", - "abluft2", - "abluft2.scripts", - "basar.scripts", - "dwc.scripts", - "kwb-r.github.io", - "kwb-r.r-universe.dev", - "fakin", - "fakin.blog", - "fakin.doc", - "fakin.scripts", - "FolderRights", - "flusshygiene", - "HydroServerLite", - "hydrus1d", - "GeoSalz", - "geosalz.mf", - "geosalz.scripts", - "impetus_scripts", - "intruder.io", - "lasso.scripts", - "Logremoval", - "programming", - "pathana", - "pFromGrADS", - "promisces.hhra", - "qmra", - "qsimVis", - "r-training", - "support", - "maxflow", - "mbr40.scripts", - "misa.scripts", - "pubs", - "riverPollution", - "smart.control", - "sema.scripts", - "sema.projects", - "swim-ai", - "spur.scripts", - "status", - "ultimate.scripts", - "useR-2019", - "wellma.scripts" - ) + repo_names <- if (hard_coded) { + c( + "abimo", + "abimo.scripts", + "ad4gd_lakes", + "apps", + "abluft2", + "abluft2.scripts", + "basar.scripts", + "dwc.scripts", + "kwb-r.github.io", + "kwb-r.r-universe.dev", + "fakin", + "fakin.blog", + "fakin.doc", + "fakin.scripts", + "FolderRights", + "flusshygiene", + "HydroServerLite", + "hydrus1d", + "GeoSalz", + "geosalz.mf", + "geosalz.scripts", + "impetus_scripts", + "intruder.io", + "lasso.scripts", + "Logremoval", + "programming", + "pathana", + "pFromGrADS", + "promisces.hhra", + "qmra", + "qsimVis", + "r-training", + "support", + "maxflow", + "mbr40.scripts", + "misa.scripts", + "pubs", + "riverPollution", + "smart.control", + "sema.scripts", + "sema.projects", + "swim-ai", + "spur.scripts", + "status", + "ultimate.scripts", + "useR-2019", + "wellma.scripts" + ) + + } else { + + all_repos <- get_github_repos()[["name"]] + package_repos <- get_names_of_r_packages_on_github() + setdiff(all_repos, package_repos) + } + + sort(repo_names) } From 31ce95366aea66f318bbc2c3c3bdda4a2427e71c Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 20:48:25 +0200 Subject: [PATCH 26/48] Update Rd file --- man/get_non_r_packages.Rd | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/man/get_non_r_packages.Rd b/man/get_non_r_packages.Rd index a08980f..a0a8a16 100644 --- a/man/get_non_r_packages.Rd +++ b/man/get_non_r_packages.Rd @@ -2,15 +2,23 @@ % Please edit documentation in R/get_non_r_packages.R \name{get_non_r_packages} \alias{get_non_r_packages} -\title{Helper function: get_non_r_packages} +\title{Get Names of Repositories that Do not Represent R Packages} \usage{ -get_non_r_packages() +get_non_r_packages(hard_coded = TRUE) +} +\arguments{ +\item{hard_coded}{logical indicating whether or not to return the hard-coded +vector of package names. The default is \code{TRUE}. If \code{hard_coded} +is \code{FALSE} the names of repositories that are not assumed to represent +R packages are determined by looking into each repository. This may take a +while.} } \value{ -returns vector with KWB-R repos on Github, which are not R packages +This function returns a (alphabetically sorted) vector of names of + KWB-R repositories on Github that do not represent R packages } \description{ -Helper function: get_non_r_packages +Get Names of Repositories that Do not Represent R Packages } \examples{ get_non_r_packages() From e5619b461bef294cfc0d50d94538cff69b036d63 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 20:48:59 +0200 Subject: [PATCH 27/48] Add arguments "per_page", "dbg" --- R/get_repo_infos.R | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index 89876cd..9d4a565 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -53,7 +53,9 @@ get_github_repos <- function(group = "KWB-R", github_token = get_github_token()) # get_github_repos_impl -------------------------------------------------------- get_github_repos_impl <- function( group, - github_token = get_github_token() + github_token = get_github_token(), + per_page = 100L, + dbg = TRUE ) { all_repos <- list() @@ -64,9 +66,16 @@ get_github_repos_impl <- function( # Read next page while page number is given while (page > 0L) { + cat_if( + dbg, + "Reading page %d of %d GitHub repos per page\n", + page, + per_page + ) + # Read repos from current page repos <- gh::gh( - endpoint = github_endpoint(group, page), + endpoint = github_endpoint(group, page, per_page), .token = github_token ) From ce7d0efe5d2752e9004df6e56c105dd3677b61a1 Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 20:49:30 +0200 Subject: [PATCH 28/48] Add arg "dbg" to get_names_of_r_packages_on_github() --- R/get_names_of_r_packages_on_github.R | 5 +++-- man/get_names_of_r_packages_on_github.Rd | 5 ++++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/R/get_names_of_r_packages_on_github.R b/R/get_names_of_r_packages_on_github.R index 36d3ab4..a319935 100644 --- a/R/get_names_of_r_packages_on_github.R +++ b/R/get_names_of_r_packages_on_github.R @@ -7,16 +7,17 @@ #' considered. Default: \code{TRUE} #' @param private logical indicating whether public repositories are to be #' considered. Default: \code{TRUE} +#' @param dbg logical indicating whether or not to show debug messages #' @returns vector of character representing the names of the \code{public} #' and/or \code{private} repositories (as requested), owned by the #' organisation \code{groupt} on GitHub #' @export get_names_of_r_packages_on_github <- function( - group = "kwb-r", public = TRUE, private = TRUE + group = "kwb-r", public = TRUE, private = TRUE, dbg = TRUE ) { # Get info on all repositories owned by group - all_repos <- get_github_repos_impl(group = group) + all_repos <- get_github_repos_impl(group = group, dbg = dbg) # Is a repository private (or public)? is_private <- sapply(all_repos, `[[`, "private") diff --git a/man/get_names_of_r_packages_on_github.Rd b/man/get_names_of_r_packages_on_github.Rd index 40adacb..0af00f3 100644 --- a/man/get_names_of_r_packages_on_github.Rd +++ b/man/get_names_of_r_packages_on_github.Rd @@ -7,7 +7,8 @@ get_names_of_r_packages_on_github( group = "kwb-r", public = TRUE, - private = TRUE + private = TRUE, + dbg = TRUE ) } \arguments{ @@ -18,6 +19,8 @@ considered. Default: \code{TRUE}} \item{private}{logical indicating whether public repositories are to be considered. Default: \code{TRUE}} + +\item{dbg}{logical indicating whether or not to show debug messages} } \value{ vector of character representing the names of the \code{public} From eb96ec0dd0a38af70538c3b6dc8d695fde491b2f Mon Sep 17 00:00:00 2001 From: hsonne Date: Tue, 30 Apr 2024 20:50:01 +0200 Subject: [PATCH 29/48] Add make_github_package_db() --- NAMESPACE | 1 + R/make_github_package_db.R | 37 +++++++++++++++++++++++++++++++++++ man/make_github_package_db.Rd | 21 ++++++++++++++++++++ vignettes/tutorial.Rmd | 24 +++++++++++++++++++++-- 4 files changed, 81 insertions(+), 2 deletions(-) create mode 100644 R/make_github_package_db.R create mode 100644 man/make_github_package_db.Rd diff --git a/NAMESPACE b/NAMESPACE index bd8f031..f69208f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,6 +20,7 @@ export(get_github_repos) export(get_gitlab_repos) export(get_names_of_r_packages_on_github) export(get_non_r_packages) +export(make_github_package_db) export(prepare_status_rpackages) export(process_hitter_response) export(zen_collections) diff --git a/R/make_github_package_db.R b/R/make_github_package_db.R new file mode 100644 index 0000000..7564493 --- /dev/null +++ b/R/make_github_package_db.R @@ -0,0 +1,37 @@ +# make_github_package_db ------------------------------------------------------- + +#' Make Package Database for Packages on GitHub +#' +#' ready to be used in e.g. \code{\link[tools]{package_dependencies}} +#' +#' @param group Name of GitHub organisation, defaults to "kwb-r" +#' @param dbg logical indicating whether or not to show debug messages. +#' The default is \code{TRUE} +#' @return data frame with each column representing a field in the `DESCRIPTION` +#' file +#' @export +make_github_package_db <- function(group = "kwb-r", dbg = TRUE) +{ + #kwb.utils::assignPackageObjects("kwb.pkgstatus") + public_r_packages <- get_names_of_r_packages_on_github( + group = group, + private = FALSE, + dbg = dbg + ) + + description_urls <- compose_url( + protocol = "https", + subdomain = "raw", + domain_name = "githubusercontent.com", + path = sprintf("%s/%s/master/DESCRIPTION", group, public_r_packages) + ) + + description_matrices <- lapply(description_urls, function(url) { + cat_if(dbg, "Reading %s\n", url) + con <- file(url, encoding = "UTF-8") + on.exit(close(con)) + read.dcf(con) + }) + + dplyr::bind_rows(lapply(description_matrices, as.data.frame)) +} diff --git a/man/make_github_package_db.Rd b/man/make_github_package_db.Rd new file mode 100644 index 0000000..7767cdb --- /dev/null +++ b/man/make_github_package_db.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/make_github_package_db.R +\name{make_github_package_db} +\alias{make_github_package_db} +\title{Make Package Database for Packages on GitHub} +\usage{ +make_github_package_db(group = "kwb-r", dbg = TRUE) +} +\arguments{ +\item{group}{Name of GitHub organisation, defaults to "kwb-r"} + +\item{dbg}{logical indicating whether or not to show debug messages. +The default is \code{TRUE}} +} +\value{ +data frame with each column representing a field in the `DESCRIPTION` + file +} +\description{ +ready to be used in e.g. \code{\link[tools]{package_dependencies}} +} diff --git a/vignettes/tutorial.Rmd b/vignettes/tutorial.Rmd index 73f1f3a..f664673 100644 --- a/vignettes/tutorial.Rmd +++ b/vignettes/tutorial.Rmd @@ -75,11 +75,31 @@ kwb.pkgstatus::create_report_rpackages(secrets_csv, ``` -# 3 What repositories represent (public) R Packages? +# 3 Analyse public R packages on GitHub + +What public repositories on our GitHub account "KWB-R" represent R packages? ```{r} -kwb.pkgstatus::get_names_of_r_packages_on_github( +public_r_packages <- kwb.pkgstatus::get_names_of_r_packages_on_github( group = "kwb-r", private = FALSE ) ``` + +How to read all `DESCRIPTION` files of these R packages? + +```{r} +package_db <- kwb.pkgstatus::make_github_package_db(group = "kwb-r") +``` + +This package database can now be used in `tools::package_dependencies()` to +find out about package dependencies: + +```{r} +named_types <- stats::setNames(nm = c("Depends", "Imports", "Suggests")) + +lapply(named_types, function(which) { + tools::package_dependencies("kwb.utils", db = package_db, which = which)[[1L]] +}) +``` + From f464e45934355dd59c9356cb59ee9af912b25755 Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 08:17:52 +0200 Subject: [PATCH 30/48] Add and use compose_url_codecov() --- R/badge_codecov.R | 6 ++---- R/get_coverages.R | 8 ++------ R/url_helpers.R | 11 +++++++++++ 3 files changed, 15 insertions(+), 10 deletions(-) diff --git a/R/badge_codecov.R b/R/badge_codecov.R index b5521ea..2671347 100644 --- a/R/badge_codecov.R +++ b/R/badge_codecov.R @@ -8,13 +8,11 @@ badge_codecov <- function(repo_full_names) { to_url <- function(path) { - compose_url( - protocol = "https", - domain_name = "codecov.io", + compose_url_codecov( path = paste0("github/", repo_full_names, path) ) } - + image_link( image_name = "codecov", image_url = to_url("/branch/master/graphs/badge.svg"), diff --git a/R/get_coverages.R b/R/get_coverages.R index 458fc0f..391f3d1 100644 --- a/R/get_coverages.R +++ b/R/get_coverages.R @@ -12,9 +12,7 @@ get_coverage <- function( dbg = TRUE ) { - url <- compose_url( - protocol = "https", - domain_name = "codecov.io", + url <- compose_url_codecov( path = paste0("api/gh/", repo_full_name) ) @@ -77,9 +75,7 @@ get_coverages <- function( available_indices <- which(!is.na(coverage_percent)) - coverage_url[available_indices] <- compose_url( - protocol = "https", - domain_name = "codecov.io", + coverage_url[available_indices] <- compose_url_codecov( path = paste0("gh/", repo_full_names[available_indices]) ) diff --git a/R/url_helpers.R b/R/url_helpers.R index 1987708..50807f6 100644 --- a/R/url_helpers.R +++ b/R/url_helpers.R @@ -18,6 +18,17 @@ compose_url <- function( ) } +# compose_url_codecov ---------------------------------------------------------- +compose_url_codecov <- function(path = "", parameters = list()) +{ + compose_url( + protocol = "https", + domain_name = "codecov.io", + path = path, + parameters = parameters + ) +} + # image_link ------------------------------------------------------------------- image_link <- function(image_name, image_url, link_url) { From 738db7ad04ae6d38859bdfd077ff5b81e33d566c Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 08:18:45 +0200 Subject: [PATCH 31/48] Move compose_url() functions to its own file --- R/compose_url.R | 30 ++++++++++++++++++++++++++++++ R/url_helpers.R | 31 ------------------------------- 2 files changed, 30 insertions(+), 31 deletions(-) create mode 100644 R/compose_url.R diff --git a/R/compose_url.R b/R/compose_url.R new file mode 100644 index 0000000..43f929f --- /dev/null +++ b/R/compose_url.R @@ -0,0 +1,30 @@ +# compose_url ------------------------------------------------------------------ +compose_url <- function( + protocol = "http", + subdomain = NULL, + domain_name, + path = "", + parameters = list() +) +{ + paste0( + protocol, "://", + if (!is.null(subdomain)) { + paste0(subdomain, ".") + }, + domain_name, + url_path(path), + do.call(url_parameter_string, parameters) + ) +} + +# compose_url_codecov ---------------------------------------------------------- +compose_url_codecov <- function(path = "", parameters = list()) +{ + compose_url( + protocol = "https", + domain_name = "codecov.io", + path = path, + parameters = parameters + ) +} diff --git a/R/url_helpers.R b/R/url_helpers.R index 50807f6..d41de6b 100644 --- a/R/url_helpers.R +++ b/R/url_helpers.R @@ -1,34 +1,3 @@ -# compose_url ------------------------------------------------------------------ -compose_url <- function( - protocol = "http", - subdomain = NULL, - domain_name, - path = "", - parameters = list() -) -{ - paste0( - protocol, "://", - if (!is.null(subdomain)) { - paste0(subdomain, ".") - }, - domain_name, - url_path(path), - do.call(url_parameter_string, parameters) - ) -} - -# compose_url_codecov ---------------------------------------------------------- -compose_url_codecov <- function(path = "", parameters = list()) -{ - compose_url( - protocol = "https", - domain_name = "codecov.io", - path = path, - parameters = parameters - ) -} - # image_link ------------------------------------------------------------------- image_link <- function(image_name, image_url, link_url) { From c21e5e7ed8262e4da8731543ee0182efa510499a Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 08:25:16 +0200 Subject: [PATCH 32/48] Add and use compose_url_cran() --- R/badge_cran.R | 5 +---- R/compose_url.R | 11 +++++++++++ 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/R/badge_cran.R b/R/badge_cran.R index a4cf654..0171e28 100644 --- a/R/badge_cran.R +++ b/R/badge_cran.R @@ -6,10 +6,7 @@ badge_cran <- function(repo_names) { to_url <- function(path) { - compose_url( - protocol = "http", - subdomain = "www", - domain_name = "r-pkg.org", + compose_url_cran( path = paste0(path, "/", repo_names) ) } diff --git a/R/compose_url.R b/R/compose_url.R index 43f929f..e53daaa 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -28,3 +28,14 @@ compose_url_codecov <- function(path = "", parameters = list()) parameters = parameters ) } + +# compose_url_cran ------------------------------------------------------------- +compose_url_cran <- function(path = "") +{ + compose_url( + protocol = "http", + subdomain = "www", + domain_name = "r-pkg.org", + path = path + ) +} From ace7df2cae26bda5f2d1cb3a176f1b513f998107 Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 08:30:38 +0200 Subject: [PATCH 33/48] Add and use compose_url_netlify() Also remove non used arguments and argument defaults --- R/badge_dependencies.R | 7 +------ R/compose_url.R | 18 ++++++++++++++---- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/R/badge_dependencies.R b/R/badge_dependencies.R index 79abbc8..0c3e04d 100644 --- a/R/badge_dependencies.R +++ b/R/badge_dependencies.R @@ -6,12 +6,7 @@ badge_dependencies <- function(repo_names) { to_url <- function(path) { - compose_url( - protocol = "https", - subdomain = "kwb-githubdeps", - domain_name = "netlify.app", - path = path - ) + compose_url_netlify(path) } image_link( diff --git a/R/compose_url.R b/R/compose_url.R index e53daaa..18fb9cd 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -19,18 +19,17 @@ compose_url <- function( } # compose_url_codecov ---------------------------------------------------------- -compose_url_codecov <- function(path = "", parameters = list()) +compose_url_codecov <- function(path) { compose_url( protocol = "https", domain_name = "codecov.io", - path = path, - parameters = parameters + path = path ) } # compose_url_cran ------------------------------------------------------------- -compose_url_cran <- function(path = "") +compose_url_cran <- function(path) { compose_url( protocol = "http", @@ -39,3 +38,14 @@ compose_url_cran <- function(path = "") path = path ) } + +# compose_url_netlify ---------------------------------------------------------- +compose_url_netlify <- function(path) +{ + compose_url( + protocol = "https", + subdomain = "kwb-githubdeps", + domain_name = "netlify.app", + path = path + ) +} From bc9e916c7d7c4b10fe3d2baf9986c4b0c092ba19 Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 08:48:06 +0200 Subject: [PATCH 34/48] Add and use compose_url_opencpu() --- R/badge_gitlab.R | 4 +--- R/badge_opencpu.R | 15 +-------------- R/compose_url.R | 27 +++++++++++++++++++++++++++ R/get_repo_infos.R | 12 ++++-------- 4 files changed, 33 insertions(+), 25 deletions(-) diff --git a/R/badge_gitlab.R b/R/badge_gitlab.R index 1bff33f..c8f336c 100644 --- a/R/badge_gitlab.R +++ b/R/badge_gitlab.R @@ -8,9 +8,7 @@ #' @export badge_gitlab <- function( url, - logo_path = compose_url( - protocol = "https", - domain_name = "gitlab.com", + logo_path = compose_url_gitlab( path = "gitlab-com/gitlab-artwork/raw/master/logo/logo-square.png" ), size = 24 diff --git a/R/badge_opencpu.R b/R/badge_opencpu.R index dad6ef2..2d053ee 100644 --- a/R/badge_opencpu.R +++ b/R/badge_opencpu.R @@ -6,20 +6,7 @@ #' @return OpenCpu logo in html with path to R package on OpenCpu #' @export -badge_opencpu <- function( - url, - logo_path = compose_url( - protocol = "https", - subdomain = "avatars2", - domain_name = "githubusercontent.com", - path = "u/28672890", - parameters = list( - s = 200, - v = 4 - ) - ), - size = 24 -) +badge_opencpu <- function(url, logo_path = compose_url_opencpu(), size = 24) { logo_path %>% html_img(title = "OpenCpu", width = size, height = size) %>% diff --git a/R/compose_url.R b/R/compose_url.R index 18fb9cd..dce47b6 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -39,6 +39,21 @@ compose_url_cran <- function(path) ) } +# compose_url_gitlab ----------------------------------------------------------- +compose_url_gitlab <- function(path, token = NULL) +{ + compose_url( + protocol = "https", + domain_name = "gitlab.com", + path = path, + parameters = if (is.null(token)) { + list() + } else { + list(private_token = token) + } + ) +} + # compose_url_netlify ---------------------------------------------------------- compose_url_netlify <- function(path) { @@ -49,3 +64,15 @@ compose_url_netlify <- function(path) path = path ) } + +# compose_url_opencpu ---------------------------------------------------------- +compose_url_opencpu <- function() +{ + compose_url( + protocol = "https", + subdomain = "avatars2", + domain_name = "githubusercontent.com", + path = "u/28672890", + parameters = list(s = 200, v = 4) + ) +} diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index 9d4a565..47352cc 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -14,15 +14,11 @@ get_gitlab_repos <- function( gitlab_token = get_gitlab_token() ) { - endpoint <- compose_url( - protocol = "https", - domain_name = "gitlab.com", - path = paste0( - url_path(paste0("api/v4/groups/", group)), - url_parameter_string(private_token = gitlab_token) - ) + endpoint <- compose_url_gitlab( + path = paste0("api/v4/groups/", group), + token = gitlab_token ) - + gitlab_group <- jsonlite::fromJSON(endpoint) gitlab_group$projects From 4a9737947f054be8cb2c7fc50a0efe984e45a53d Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 08:58:32 +0200 Subject: [PATCH 35/48] Add and use compose_url_github() --- R/badge_zenodo.R | 4 +--- R/compose_url.R | 11 +++++++++++ R/get_repo_infos.R | 4 +--- R/list_files_in_github_repo.R | 4 +--- 4 files changed, 14 insertions(+), 9 deletions(-) diff --git a/R/badge_zenodo.R b/R/badge_zenodo.R index 20f67aa..f7273de 100644 --- a/R/badge_zenodo.R +++ b/R/badge_zenodo.R @@ -20,9 +20,7 @@ badge_zenodo <- function( doi_exists <- stringr::str_detect( string = zen_data$metadata.related_identifiers.identifier , - pattern = compose_url( - protocol = "https", - domain_name = "github.com", + pattern = compose_url_github( path = repo_full_names[index] ) ) diff --git a/R/compose_url.R b/R/compose_url.R index dce47b6..013c76b 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -39,6 +39,17 @@ compose_url_cran <- function(path) ) } +# compose_url_github ----------------------------------------------------------- +compose_url_github <- function(path, subdomain = NULL) +{ + compose_url( + protocol = "https", + subdomain = subdomain, + domain_name = "github.com", + path = path + ) +} + # compose_url_gitlab ----------------------------------------------------------- compose_url_gitlab <- function(path, token = NULL) { diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index 47352cc..2fecde8 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -117,9 +117,7 @@ github_repo_object_to_data_row <- function(repo) license_link <- if (is.na(license_short)) { NA } else { - compose_url( - protocol = "https", - domain_name = "github.com", + compose_url_github( path = paste0(full_name, "/blob/master/LICENSE") ) } diff --git a/R/list_files_in_github_repo.R b/R/list_files_in_github_repo.R index 968c718..f559492 100644 --- a/R/list_files_in_github_repo.R +++ b/R/list_files_in_github_repo.R @@ -10,10 +10,8 @@ list_files_in_github_repo <- function( #kwb.utils::assignPackageObjects("kwb.pkgstatus") #owner="kwb-r";repo="kwb.utils";path="" - url <- compose_url( - protocol = "https", + url <- compose_url_github( subdomain = "api", - domain_name = "github.com", path = sprintf("repos/%s/%s/contents/%s", owner, repo, path) ) From aec8d13945e9f597bbf86cfd4da948337ad02444 Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 09:02:38 +0200 Subject: [PATCH 36/48] Add and use compose_url_appveyor() --- R/badges_ci.R | 14 ++------------ R/compose_url.R | 12 ++++++++++++ 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/R/badges_ci.R b/R/badges_ci.R index b68cbdc..ebaf8e9 100644 --- a/R/badges_ci.R +++ b/R/badges_ci.R @@ -6,23 +6,13 @@ #' @export badge_appveyor <- function(repo_full_names) { - to_url <- function(path, parameters) { - compose_url( - protocol = "https", - subdomain = "ci", - domain_name = "appveyor.com", - path = path, - parameters = parameters - ) - } - image_link( image_name = "Appveyor", - image_url = to_url( + image_url = compose_url_appveyor( path = sprintf("api/projects/status/github/%s", repo_full_names), parameters = list(branch = "master", svg = "true") ), - link_url = to_url( + link_url = compose_url_appveyor( path = sprintf("project/%s/branch/master", dot_to_dash(repo_full_names)), parameters = list() ) diff --git a/R/compose_url.R b/R/compose_url.R index 013c76b..644347a 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -18,6 +18,18 @@ compose_url <- function( ) } +# compose_url_appveyor --------------------------------------------------------- +compose_url_appveyor <- function(path, parameters) +{ + compose_url( + protocol = "https", + subdomain = "ci", + domain_name = "appveyor.com", + path = path, + parameters = parameters + ) +} + # compose_url_codecov ---------------------------------------------------------- compose_url_codecov <- function(path) { From ff71397765d066a2aa3807ca6d51c61736aaf03d Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 09:05:06 +0200 Subject: [PATCH 37/48] Add and use compose_url_travis() --- R/badges_ci.R | 13 ++----------- R/compose_url.R | 11 +++++++++++ 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/R/badges_ci.R b/R/badges_ci.R index ebaf8e9..95c4be9 100644 --- a/R/badges_ci.R +++ b/R/badges_ci.R @@ -27,22 +27,13 @@ badge_appveyor <- function(repo_full_names) #' @export badge_travis <- function(repo_full_names) { - to_url <- function(path, parameters) { - compose_url( - protocol = "https", - domain_name = "travis-ci.org", - path = path, - parameters = parameters - ) - } - image_link( image_name = "Travis", - image_url = to_url( + image_url = compose_url_travis( path = sprintf("%s.svg", repo_full_names), parameters = list(branch = "master") ), - link_url = to_url( + link_url = compose_url_travis( path = repo_full_names, parameters = list() ) diff --git a/R/compose_url.R b/R/compose_url.R index 644347a..8cfc46f 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -99,3 +99,14 @@ compose_url_opencpu <- function() parameters = list(s = 200, v = 4) ) } + +# compose_url_travis ----------------------------------------------------------- +compose_url_travis <- function(path, parameters) +{ + compose_url( + protocol = "https", + domain_name = "travis-ci.org", + path = path, + parameters = parameters + ) +} From 83b229eff2064f48520796abb7ba9f00475a669c Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 09:08:42 +0200 Subject: [PATCH 38/48] Add and use compose_url_ocpu() --- R/check_opencpu_deploy.R | 6 +----- R/compose_url.R | 10 ++++++++++ 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/R/check_opencpu_deploy.R b/R/check_opencpu_deploy.R index 4a4c09a..d902da3 100644 --- a/R/check_opencpu_deploy.R +++ b/R/check_opencpu_deploy.R @@ -11,11 +11,7 @@ check_opencpu_deploy <- function(group = "KWB-R") { - url <- compose_url( - protocol = "https", - subdomain = tolower(group), - domain_name = "ocpu.io" - ) + url <- compose_url_ocpu() repo_names <- readLines(url) diff --git a/R/compose_url.R b/R/compose_url.R index 8cfc46f..1f55090 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -88,6 +88,16 @@ compose_url_netlify <- function(path) ) } +# compose_url_ocpu ------------------------------------------------------------- +compose_url_ocpu <- function() +{ + compose_url( + protocol = "https", + subdomain = tolower(group), + domain_name = "ocpu.io" + ) +} + # compose_url_opencpu ---------------------------------------------------------- compose_url_opencpu <- function() { From d32e16b0ff86c15423257428954e79f9578513db Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 09:36:32 +0200 Subject: [PATCH 39/48] Add and use more compose_url_*() functions and remove compose_url_opencpu() in favour of compose_url_githubusercontent() --- R/badge_opencpu.R | 11 ++++-- R/compose_url.R | 74 ++++++++++++++++++++++++++++++++++---- R/get_license_badge_info.R | 27 ++++++-------- R/make_github_package_db.R | 8 ++--- R/zen_collections.R | 4 +-- 5 files changed, 91 insertions(+), 33 deletions(-) diff --git a/R/badge_opencpu.R b/R/badge_opencpu.R index 2d053ee..4b948b6 100644 --- a/R/badge_opencpu.R +++ b/R/badge_opencpu.R @@ -5,8 +5,15 @@ #' @param size size of logo in pixels (default: 24) #' @return OpenCpu logo in html with path to R package on OpenCpu #' @export - -badge_opencpu <- function(url, logo_path = compose_url_opencpu(), size = 24) +badge_opencpu <- function( + url, + logo_path = compose_url_githubusercontent( + subdomain = "avatars2", + path = "u/28672890", + parameters = list(s = 200, v = 4) + ), + size = 24 +) { logo_path %>% html_img(title = "OpenCpu", width = size, height = size) %>% diff --git a/R/compose_url.R b/R/compose_url.R index 1f55090..a535f61 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -30,6 +30,17 @@ compose_url_appveyor <- function(path, parameters) ) } +# compose_url_badge ------------------------------------------------------------ +compose_url_badge <- function(relative_paths) +{ + compose_url( + protocol = "https", + subdomain = "img", + domain_name = "shields.io", + path = paste0("badge/", relative_paths) + ) +} + # compose_url_codecov ---------------------------------------------------------- compose_url_codecov <- function(path) { @@ -51,6 +62,17 @@ compose_url_cran <- function(path) ) } +# compose_url_eclipse ---------------------------------------------------------- +compose_url_eclipse <- function(path) +{ + compose_url( + protocol = "https", + subdomain = "www", + domain_name = "eclipse.org", + path = path + ) +} + # compose_url_github ----------------------------------------------------------- compose_url_github <- function(path, subdomain = NULL) { @@ -62,6 +84,18 @@ compose_url_github <- function(path, subdomain = NULL) ) } +# compose_url_githubusercontent ------------------------------------------------ +compose_url_githubusercontent <- function(subdomain, path, parameters = list()) +{ + compose_url( + protocol = "https", + subdomain = subdomain, + domain_name = "githubusercontent.com", + path = path, + parameters = parameters + ) +} + # compose_url_gitlab ----------------------------------------------------------- compose_url_gitlab <- function(path, token = NULL) { @@ -77,6 +111,17 @@ compose_url_gitlab <- function(path, token = NULL) ) } +# compose_url_gnu -------------------------------------------------------------- +compose_url_gnu <- function(path) +{ + compose_url( + protocol = "https", + subdomain = "www", + domain_name = "gnu.org", + path = path + ) +} + # compose_url_netlify ---------------------------------------------------------- compose_url_netlify <- function(path) { @@ -98,15 +143,13 @@ compose_url_ocpu <- function() ) } -# compose_url_opencpu ---------------------------------------------------------- -compose_url_opencpu <- function() +# compose_url_opensource ------------------------------------------------------- +compose_url_opensource <- function(path) { compose_url( protocol = "https", - subdomain = "avatars2", - domain_name = "githubusercontent.com", - path = "u/28672890", - parameters = list(s = 200, v = 4) + domain_name = "opensource.org", + path = path ) } @@ -120,3 +163,22 @@ compose_url_travis <- function(path, parameters) parameters = parameters ) } + +# compose_url_unlicense -------------------------------------------------------- +compose_url_unlicense <- function() +{ + compose_url( + protocol = "http", + domain_name = "unlicense.org" + ) +} + +# compose_url_zenodo ----------------------------------------------------------- +compose_url_zenodo <- function(path) +{ + compose_url( + protocol = "https", + domain_name = "zenodo.org", + path = path + ) +} diff --git a/R/get_license_badge_info.R b/R/get_license_badge_info.R index fca7110..b7ab671 100644 --- a/R/get_license_badge_info.R +++ b/R/get_license_badge_info.R @@ -1,15 +1,6 @@ # get_license_badge_info ------------------------------------------------------- get_license_badge_info <- function() { - compose_badge_url <- function(relative_paths) { - compose_url( - protocol = "https", - subdomain = "img", - domain_name = "shields.io", - path = paste0("badge/", relative_paths) - ) - } - data.frame( key = c( "agpl-3.0", @@ -26,19 +17,19 @@ get_license_badge_info <- function() "unlicense" ), image_url = c( - compose_badge_url(c( + compose_url_badge(c( "License-AGPL%20v3-blue.svg", "License-Apache%202.0-blue.svg", "License-BSD%202--Clause-orange.svg", "License-BSD%203--Clause-blue.svg" )), "", - compose_badge_url(c( + compose_url_badge(c( "License-GPL%20v2-blue.svg", "License-GPL%20v3-blue.svg" )), "", - compose_badge_url(c( + compose_url_badge(c( "License-LGPL%20v3-blue.svg", "License-MIT-yellow.svg", "License-MPL%202.0-brightgreen.svg", @@ -46,24 +37,26 @@ get_license_badge_info <- function() )) ), license_url = c( - compose_url("https", NULL, "opensource.org", path = c( + compose_url_opensource(path = c( "licenses/AGPL-3.0", "licenses/Apache-2.0", "licenses/BSD-2-Clause", "licenses/BSD-3-Clause" )), - compose_url("https", "www", "eclipse.org", "legal/epl-2.0/"), - compose_url("https", "www", "gnu.org", c( + compose_url_eclipse( + path = "legal/epl-2.0/" + ), + compose_url_gnu(path = c( "licenses/gpl-2.0", "licenses/gpl-3.0", "licenses/lgpl-2.1", "licenses/lgpl-3.0" )), - compose_url("https", NULL, "opensource.org", path = c( + compose_url_opensource(path = c( "licenses/MIT", "licenses/MPL-2.0" )), - compose_url("http", NULL, "unlicense.org") + compose_url_unlicense() ), stringsAsFactors = FALSE ) diff --git a/R/make_github_package_db.R b/R/make_github_package_db.R index 7564493..371a85b 100644 --- a/R/make_github_package_db.R +++ b/R/make_github_package_db.R @@ -18,11 +18,9 @@ make_github_package_db <- function(group = "kwb-r", dbg = TRUE) private = FALSE, dbg = dbg ) - - description_urls <- compose_url( - protocol = "https", - subdomain = "raw", - domain_name = "githubusercontent.com", + + description_urls <- compose_url_githubusercontent( + subdomain = "raw", path = sprintf("%s/%s/master/DESCRIPTION", group, public_r_packages) ) diff --git a/R/zen_collections.R b/R/zen_collections.R index 62e8358..3924701 100644 --- a/R/zen_collections.R +++ b/R/zen_collections.R @@ -21,9 +21,7 @@ process_hitter_response <- function (response) zen_collections <- function(n = 1000, access_token = Sys.getenv("ZENODO_TOKEN")) { results <- http_get_or_stop( - url = compose_url( - protocol = "https", - domain_name = "zenodo.org", + url = compose_url_zenodo( path = "api/deposit/depositions" ), query = list( From 6878544ecbb8cdad9b0b3c0613fdea148bd28de4 Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 09:40:56 +0200 Subject: [PATCH 40/48] Update Rd files --- man/badge_gitlab.Rd | 2 +- man/badge_opencpu.Rd | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/man/badge_gitlab.Rd b/man/badge_gitlab.Rd index 710ef5d..1b33562 100644 --- a/man/badge_gitlab.Rd +++ b/man/badge_gitlab.Rd @@ -6,7 +6,7 @@ \usage{ badge_gitlab( url, - logo_path = compose_url(protocol = "https", domain_name = "gitlab.com", path = + logo_path = compose_url_gitlab(path = "gitlab-com/gitlab-artwork/raw/master/logo/logo-square.png"), size = 24 ) diff --git a/man/badge_opencpu.Rd b/man/badge_opencpu.Rd index 853f1a1..d72fb21 100644 --- a/man/badge_opencpu.Rd +++ b/man/badge_opencpu.Rd @@ -6,8 +6,8 @@ \usage{ badge_opencpu( url, - logo_path = compose_url(protocol = "https", subdomain = "avatars2", domain_name = - "githubusercontent.com", path = "u/28672890", parameters = list(s = 200, v = 4)), + logo_path = compose_url_githubusercontent(subdomain = "avatars2", path = "u/28672890", + parameters = list(s = 200, v = 4)), size = 24 ) } From dc67b9c6bb32a871e2f91bcd5146658a7df90ae7 Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 09:48:42 +0200 Subject: [PATCH 41/48] Use to_full_path() instead of to_url() --- R/badge_codecov.R | 16 +++++++++------- R/badge_cran.R | 14 ++++++++------ R/badge_dependencies.R | 8 ++------ 3 files changed, 19 insertions(+), 19 deletions(-) diff --git a/R/badge_codecov.R b/R/badge_codecov.R index 2671347..df2fe76 100644 --- a/R/badge_codecov.R +++ b/R/badge_codecov.R @@ -7,15 +7,17 @@ badge_codecov <- function(repo_full_names) { - to_url <- function(path) { - compose_url_codecov( - path = paste0("github/", repo_full_names, path) - ) + to_full_path <- function(path) { + paste0("github/", repo_full_names, path) } - + image_link( image_name = "codecov", - image_url = to_url("/branch/master/graphs/badge.svg"), - link_url = to_url("") + image_url = compose_url_codecov( + path = to_full_path("/branch/master/graphs/badge.svg") + ), + link_url = compose_url_codecov( + path = to_full_path("") + ) ) } diff --git a/R/badge_cran.R b/R/badge_cran.R index 0171e28..5caf84c 100644 --- a/R/badge_cran.R +++ b/R/badge_cran.R @@ -5,15 +5,17 @@ #' @export badge_cran <- function(repo_names) { - to_url <- function(path) { - compose_url_cran( - path = paste0(path, "/", repo_names) - ) + to_full_path <- function(path) { + paste0(path, "/", repo_names) } image_link( image_name = "CRAN_Status_Badge", - image_url = to_url("badges/version"), - link_url = to_url("pkg") + image_url = compose_url_cran( + path = to_full_path("badges/version") + ), + link_url = compose_url_cran( + path = to_full_path("pkg") + ) ) } diff --git a/R/badge_dependencies.R b/R/badge_dependencies.R index 0c3e04d..c977244 100644 --- a/R/badge_dependencies.R +++ b/R/badge_dependencies.R @@ -5,13 +5,9 @@ #' @export badge_dependencies <- function(repo_names) { - to_url <- function(path) { - compose_url_netlify(path) - } - image_link( image_name = "Dependencies_badge", - image_url = to_url(paste0("badge/", repo_names)), - link_url = to_url("") + image_url = compose_url_netlify(paste0("badge/", repo_names)), + link_url = compose_url_netlify("") ) } From 33320cf1e6652abaf0c22e946eaaf7abc568e063 Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 09:56:51 +0200 Subject: [PATCH 42/48] Add missing argument "group" --- R/check_opencpu_deploy.R | 2 +- R/compose_url.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/check_opencpu_deploy.R b/R/check_opencpu_deploy.R index d902da3..1810e1b 100644 --- a/R/check_opencpu_deploy.R +++ b/R/check_opencpu_deploy.R @@ -11,7 +11,7 @@ check_opencpu_deploy <- function(group = "KWB-R") { - url <- compose_url_ocpu() + url <- compose_url_ocpu(group) repo_names <- readLines(url) diff --git a/R/compose_url.R b/R/compose_url.R index a535f61..750fbf3 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -134,7 +134,7 @@ compose_url_netlify <- function(path) } # compose_url_ocpu ------------------------------------------------------------- -compose_url_ocpu <- function() +compose_url_ocpu <- function(group) { compose_url( protocol = "https", From 9740e69775507873bbe7e9ab536e7825d9bcd8ca Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 10:08:19 +0200 Subject: [PATCH 43/48] Move result[index] out of if-clause --- R/badge_zenodo.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/badge_zenodo.R b/R/badge_zenodo.R index f7273de..dbfa333 100644 --- a/R/badge_zenodo.R +++ b/R/badge_zenodo.R @@ -29,9 +29,9 @@ badge_zenodo <- function( n_existing <- sum(doi_exists) - if (n_existing == 1L) { + result[index] <- if (n_existing == 1L) { - result[index] <- image_link( + image_link( image_name = "DOI", image_url = zen_data$links.badge[doi_exists], link_url = zen_data$doi_url[doi_exists] @@ -50,11 +50,11 @@ badge_zenodo <- function( ) ) - result[index] <- "Multiple badges found!" + "Multiple badges found!" } else { - result[index] <- NA + NA } } From a81258d008499c710059bff2cb8564d343c3b99e Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 10:11:08 +0200 Subject: [PATCH 44/48] Move url_success() to helpers.R --- R/check_documentation.R | 10 ---------- R/helpers.R | 10 ++++++++++ man/url_success.Rd | 2 +- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/R/check_documentation.R b/R/check_documentation.R index 3604ca6..c39fde6 100644 --- a/R/check_documentation.R +++ b/R/check_documentation.R @@ -1,13 +1,3 @@ -#' url_success -#' -#' @param url url of documentation website -#' @importFrom httr status_code GET -#' @return TRUE in case HTTP status code is 200, if not: FALSE -url_success <- function(url) -{ - identical(httr::status_code(x = httr::GET(url)), 200L) -} - #' Check documentation: development #' #' @param repo_names vector of repository names to be checked diff --git a/R/helpers.R b/R/helpers.R index 192b13a..556c447 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -13,3 +13,13 @@ http_get_or_stop <- function(url, ...) response } + +#' url_success +#' +#' @param url url of documentation website +#' @importFrom httr status_code GET +#' @return TRUE in case HTTP status code is 200, if not: FALSE +url_success <- function(url) +{ + identical(httr::status_code(x = httr::GET(url)), 200L) +} diff --git a/man/url_success.Rd b/man/url_success.Rd index 6c5a0cb..9444b78 100644 --- a/man/url_success.Rd +++ b/man/url_success.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/check_documentation.R +% Please edit documentation in R/helpers.R \name{url_success} \alias{url_success} \title{url_success} From 3d30af7e6067a3d7897a508230c9d2d63b48e8b3 Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 10:40:25 +0200 Subject: [PATCH 45/48] Use get_*token() to get any token and use the "unset" argument of Sys.getenv() --- R/badge_license.R | 3 ++- R/badge_zenodo.R | 6 +++--- R/check_gitlab_backup.R | 6 ++++-- R/get_coverages.R | 16 ++++++++-------- R/get_repo_infos.R | 6 ++++-- R/utils.R | 15 +++++++-------- R/zen_collections.R | 5 +++-- man/badge_license.Rd | 3 ++- man/badge_zenodo.Rd | 6 +++--- man/check_gitlab_backup.Rd | 6 ++++-- man/get_coverage.Rd | 10 +++------- man/get_coverages.Rd | 10 +++++----- man/get_github_repos.Rd | 3 ++- man/get_gitlab_repos.Rd | 3 ++- man/zen_collections.Rd | 5 +++-- 15 files changed, 55 insertions(+), 48 deletions(-) diff --git a/R/badge_license.R b/R/badge_license.R index 9fe7642..af797d2 100644 --- a/R/badge_license.R +++ b/R/badge_license.R @@ -3,7 +3,8 @@ #' @param license_keys one or many valid license keys from c("agpl-3.0", #' "apache-2.0", "bsd-2-clause", "bsd-3-clause", "epl-2.0", "gpl-2.0", "gpl-3.0", #' "lgpl-2.1", "lgpl-3.0", "mit", "mpl-2.0", "unlicense") -#' @param github_token github access token (default: Sys.getenv("GITHUB_TOKEN")) +#' @param github_token github access token. Default: +#' kwb.pkgstatus:::get_github_token() #' @importFrom gh gh #' @importFrom data.table rbindlist #' @importFrom dplyr left_join select_ rename_ diff --git a/R/badge_zenodo.R b/R/badge_zenodo.R index dbfa333..a148e53 100644 --- a/R/badge_zenodo.R +++ b/R/badge_zenodo.R @@ -2,14 +2,14 @@ #' #' @param repo_full_names vector with combination of username/repo (e.g. #' c("KWB-R/kwb.utils", "KWB-R/kwb.db")) -#' @param zenodo_token zenodo authentication token (default: -#' Sys.getenv("ZENODO_TOKEN")) +#' @param zenodo_token zenodo authentication token. +#' Default: kwb.pkgstatus:::get_token("ZENODO") #' @importFrom stringr str_detect #' @return zenodo badges for provided repo_full_names #' @export badge_zenodo <- function( repo_full_names, - zenodo_token = Sys.getenv("ZENODO_TOKEN") + zenodo_token = get_token("ZENODO") ) { zen_data <- zen_collections(access_token = zenodo_token) diff --git a/R/check_gitlab_backup.R b/R/check_gitlab_backup.R index c07a24d..e0d3c80 100644 --- a/R/check_gitlab_backup.R +++ b/R/check_gitlab_backup.R @@ -1,8 +1,10 @@ #' check_gitlab_backup #' #' @param group username or organisation for Github/Gitlab (default: "KWB-R") -#' @param github_token github access token (default: Sys.getenv("GITHUB_TOKEN")) -#' @param gitlab_token gitlab access token (default: Sys.getenv("GITLAB_TOKEN"))) +#' @param github_token github access token. +#' Default: kwb.pkgstatus:::get_github_token() +#' @param gitlab_token gitlab access token. +#' Default: kwb.pkgstatus:::get_gitlab_token() #' @return data.frame containing all Github repositoriers that are mirrored in #' Gitlab (i.e. were at least syncronised within the last 2 hours) #' @importFrom magrittr "%>%" diff --git a/R/get_coverages.R b/R/get_coverages.R index 391f3d1..ed12039 100644 --- a/R/get_coverages.R +++ b/R/get_coverages.R @@ -1,14 +1,14 @@ #' get_coverage #' #' @param repo_full_name one combination of username/repo (e.g."KWB-R/kwb.db") -#' @param codecov_token codecov authentication token (default: -#' Sys.getenv("CODECOV_TOKEN")) +#' @param codecov_token codecov authentication token. +#' Default: kwb.pkgstatus:::get_token("CODECOV") #' @param dbg debug if TRUE (default: TRUE) #' @importFrom httr status_code #' @return codecov coverage in percent for provided repo_full_name get_coverage <- function( repo_full_name, - codecov_token = Sys.getenv("CODECOV_TOKEN"), + codecov_token = get_token("CODECOV"), dbg = TRUE ) { @@ -48,17 +48,17 @@ get_coverage <- function( #' get_coverages #' -#' @param repo_full_names vector with combination of username/repo (e.g. -#' c("KWB-R/kwb.utils", "KWB-R/kwb.db")) -#' @param codecov_token zenodo authentication token (default: -#' Sys.getenv("CODECOV_TOKEN") +#' @param repo_full_names vector with combination of username/repo +#' (e.g. c("KWB-R/kwb.utils", "KWB-R/kwb.db")) +#' @param codecov_token codecov authentication token. +#' Default: kwb.pkgstatus:::get_token("CODECOV") #' @param dbg debug if TRUE (default: TRUE) #' @return data.frame with coverage percent and url for all provided #' repo_full_names #' @export get_coverages <- function( repo_full_names, - codecov_token = Sys.getenv("CODECOV_TOKEN"), + codecov_token = get_token("CODECOV"), dbg = TRUE ) { diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index 2fecde8..e6cd332 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -3,7 +3,8 @@ #' get_gitlab_repos #' #' @param group username or organisation for Gitlab (default: "KWB-R") -#' @param gitlab_token gitlab access token (default: Sys.getenv("GITLAB_TOKEN")) +#' @param gitlab_token gitlab access token. +#' Default: kwb.pkgstatus:::get_gitlab_token() #' @return data.frame with for all repositories of the user/organisation defined #' in parameter group (private repos will only be accessible if the token is #' configured to allow that) @@ -29,7 +30,8 @@ get_gitlab_repos <- function( #' get_github_repos #' #' @param group username or organisation for Github (default: "KWB-R") -#' @param github_token github access token (default: Sys.getenv("GITHUB_TOKEN")) +#' @param github_token github access token. +#' Default: kwb.pkgstatus:::get_github_token() #' @return data.frame with for all repositories of the user/organisation defined #' in parameter group (private repos will only be accessible if the token is #' configured to allow that) diff --git a/R/utils.R b/R/utils.R index 3eb3e40..3d13840 100644 --- a/R/utils.R +++ b/R/utils.R @@ -15,14 +15,7 @@ dot_to_dash <- function(x) # get_github_token ------------------------------------------------------------- get_github_token <- function() { - for (name in c("GITHUB_TOKEN", "GITHUB_PAT")) { - value <- Sys.getenv(name) - if (nzchar(value)) { - return(value) - } - } - - return("") + Sys.getenv("GITHUB_TOKEN", Sys.getenv("GITHUB_PAT")) } # get_gitlab_token ------------------------------------------------------------- @@ -31,6 +24,12 @@ get_gitlab_token <- function() Sys.getenv("GITLAB_TOKEN") } +# get_token -------------------------------------------------------------- +get_token <- function(prefix) +{ + Sys.getenv(paste0(toupper(prefix), "_TOKEN")) +} + # html_a ----------------------------------------------------------------------- html_a <- function(href, x) { diff --git a/R/zen_collections.R b/R/zen_collections.R index 3924701..8a834e6 100644 --- a/R/zen_collections.R +++ b/R/zen_collections.R @@ -12,13 +12,14 @@ process_hitter_response <- function (response) #' Zenodo: get available collections #' @param n number of zenodo entries ("size") to return per API call (default: 1000) -#' @param access_token Zenodo access token (default: Sys.getenv("ZENODO_TOKEN")) +#' @param access_token Zenodo access token. +#' Default: kwb.pkgstatus:::get_token("ZENODO") #' @importFrom httr content GET #' @return a tibble of available Zenodo data #' @export #' @seealso \url{https://developers.zenodo.org/#depositions} -zen_collections <- function(n = 1000, access_token = Sys.getenv("ZENODO_TOKEN")) +zen_collections <- function(n = 1000, access_token = get_token("ZENODO")) { results <- http_get_or_stop( url = compose_url_zenodo( diff --git a/man/badge_license.Rd b/man/badge_license.Rd index a3aa9dc..a201a12 100644 --- a/man/badge_license.Rd +++ b/man/badge_license.Rd @@ -11,7 +11,8 @@ badge_license(license_keys, github_token = get_github_token()) "apache-2.0", "bsd-2-clause", "bsd-3-clause", "epl-2.0", "gpl-2.0", "gpl-3.0", "lgpl-2.1", "lgpl-3.0", "mit", "mpl-2.0", "unlicense")} -\item{github_token}{github access token (default: Sys.getenv("GITHUB_TOKEN"))} +\item{github_token}{github access token. Default: +kwb.pkgstatus:::get_github_token()} } \value{ badge for all provided license keys diff --git a/man/badge_zenodo.Rd b/man/badge_zenodo.Rd index 25cbba9..5943db1 100644 --- a/man/badge_zenodo.Rd +++ b/man/badge_zenodo.Rd @@ -4,14 +4,14 @@ \alias{badge_zenodo} \title{badge_zenodo} \usage{ -badge_zenodo(repo_full_names, zenodo_token = Sys.getenv("ZENODO_TOKEN")) +badge_zenodo(repo_full_names, zenodo_token = get_token("ZENODO")) } \arguments{ \item{repo_full_names}{vector with combination of username/repo (e.g. c("KWB-R/kwb.utils", "KWB-R/kwb.db"))} -\item{zenodo_token}{zenodo authentication token (default: -Sys.getenv("ZENODO_TOKEN"))} +\item{zenodo_token}{zenodo authentication token. +Default: kwb.pkgstatus:::get_token("ZENODO")} } \value{ zenodo badges for provided repo_full_names diff --git a/man/check_gitlab_backup.Rd b/man/check_gitlab_backup.Rd index 14a393c..a44cea2 100644 --- a/man/check_gitlab_backup.Rd +++ b/man/check_gitlab_backup.Rd @@ -13,9 +13,11 @@ check_gitlab_backup( \arguments{ \item{group}{username or organisation for Github/Gitlab (default: "KWB-R")} -\item{github_token}{github access token (default: Sys.getenv("GITHUB_TOKEN"))} +\item{github_token}{github access token. +Default: kwb.pkgstatus:::get_github_token()} -\item{gitlab_token}{gitlab access token (default: Sys.getenv("GITLAB_TOKEN")))} +\item{gitlab_token}{gitlab access token. +Default: kwb.pkgstatus:::get_gitlab_token()} } \value{ data.frame containing all Github repositoriers that are mirrored in diff --git a/man/get_coverage.Rd b/man/get_coverage.Rd index 72ff808..7c429c5 100644 --- a/man/get_coverage.Rd +++ b/man/get_coverage.Rd @@ -4,17 +4,13 @@ \alias{get_coverage} \title{get_coverage} \usage{ -get_coverage( - repo_full_name, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE -) +get_coverage(repo_full_name, codecov_token = get_token("CODECOV"), dbg = TRUE) } \arguments{ \item{repo_full_name}{one combination of username/repo (e.g."KWB-R/kwb.db")} -\item{codecov_token}{codecov authentication token (default: -Sys.getenv("CODECOV_TOKEN"))} +\item{codecov_token}{codecov authentication token. +Default: kwb.pkgstatus:::get_token("CODECOV")} \item{dbg}{debug if TRUE (default: TRUE)} } diff --git a/man/get_coverages.Rd b/man/get_coverages.Rd index b17d8df..051b66c 100644 --- a/man/get_coverages.Rd +++ b/man/get_coverages.Rd @@ -6,16 +6,16 @@ \usage{ get_coverages( repo_full_names, - codecov_token = Sys.getenv("CODECOV_TOKEN"), + codecov_token = get_token("CODECOV"), dbg = TRUE ) } \arguments{ -\item{repo_full_names}{vector with combination of username/repo (e.g. -c("KWB-R/kwb.utils", "KWB-R/kwb.db"))} +\item{repo_full_names}{vector with combination of username/repo +(e.g. c("KWB-R/kwb.utils", "KWB-R/kwb.db"))} -\item{codecov_token}{zenodo authentication token (default: -Sys.getenv("CODECOV_TOKEN")} +\item{codecov_token}{codecov authentication token. +Default: kwb.pkgstatus:::get_token("CODECOV")} \item{dbg}{debug if TRUE (default: TRUE)} } diff --git a/man/get_github_repos.Rd b/man/get_github_repos.Rd index 56efeb3..906114c 100644 --- a/man/get_github_repos.Rd +++ b/man/get_github_repos.Rd @@ -9,7 +9,8 @@ get_github_repos(group = "KWB-R", github_token = get_github_token()) \arguments{ \item{group}{username or organisation for Github (default: "KWB-R")} -\item{github_token}{github access token (default: Sys.getenv("GITHUB_TOKEN"))} +\item{github_token}{github access token. +Default: kwb.pkgstatus:::get_github_token()} } \value{ data.frame with for all repositories of the user/organisation defined diff --git a/man/get_gitlab_repos.Rd b/man/get_gitlab_repos.Rd index 7dde09a..133cd13 100644 --- a/man/get_gitlab_repos.Rd +++ b/man/get_gitlab_repos.Rd @@ -9,7 +9,8 @@ get_gitlab_repos(group = "KWB-R", gitlab_token = get_gitlab_token()) \arguments{ \item{group}{username or organisation for Gitlab (default: "KWB-R")} -\item{gitlab_token}{gitlab access token (default: Sys.getenv("GITLAB_TOKEN"))} +\item{gitlab_token}{gitlab access token. +Default: kwb.pkgstatus:::get_gitlab_token()} } \value{ data.frame with for all repositories of the user/organisation defined diff --git a/man/zen_collections.Rd b/man/zen_collections.Rd index 0fd0872..32de387 100644 --- a/man/zen_collections.Rd +++ b/man/zen_collections.Rd @@ -4,12 +4,13 @@ \alias{zen_collections} \title{Zenodo: get available collections} \usage{ -zen_collections(n = 1000, access_token = Sys.getenv("ZENODO_TOKEN")) +zen_collections(n = 1000, access_token = get_token("ZENODO")) } \arguments{ \item{n}{number of zenodo entries ("size") to return per API call (default: 1000)} -\item{access_token}{Zenodo access token (default: Sys.getenv("ZENODO_TOKEN"))} +\item{access_token}{Zenodo access token. +Default: kwb.pkgstatus:::get_token("ZENODO")} } \value{ a tibble of available Zenodo data From 2ff13601a8ad993006b7ad9cee0bf4d24af1e240 Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 10:41:08 +0200 Subject: [PATCH 46/48] Omit helper variable "tokens_undefined" --- R/prepare_status_rpackages.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/prepare_status_rpackages.R b/R/prepare_status_rpackages.R index 1a9e132..c46f360 100644 --- a/R/prepare_status_rpackages.R +++ b/R/prepare_status_rpackages.R @@ -22,8 +22,10 @@ check_all_tokens_set <- function() return(TRUE) } - tokens_undefined <- paste(token_names[!tokens_defined], collapse = ", ") - warning(sprintf("The folling tokens were not defined: %s", tokens_undefined)) + warning(sprintf( + "The following tokens were not defined: %s", + paste(token_names[!tokens_defined], collapse = ", ") + )) FALSE } From 318f64c2c7472c828b220d4cac466daba49bd29e Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 10:52:04 +0200 Subject: [PATCH 47/48] Move functions and delete url_helpers.R --- R/compose_url.R | 6 ++++++ R/helpers.R | 24 ++++++++++++++++++++++++ R/url_helpers.R | 29 ----------------------------- 3 files changed, 30 insertions(+), 29 deletions(-) delete mode 100644 R/url_helpers.R diff --git a/R/compose_url.R b/R/compose_url.R index 750fbf3..8f751b3 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -18,6 +18,12 @@ compose_url <- function( ) } +# url_path --------------------------------------------------------------------- +url_path <- function(path) +{ + paste0(ifelse(path == "", "", "/"), gsub("^/+", "", path)) +} + # compose_url_appveyor --------------------------------------------------------- compose_url_appveyor <- function(path, parameters) { diff --git a/R/helpers.R b/R/helpers.R index 556c447..a4472e2 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -1,3 +1,9 @@ +# image_link ------------------------------------------------------------------- +image_link <- function(image_name, image_url, link_url) +{ + sprintf("[!%s](%s)", named_link(image_name, image_url),link_url) +} + # http_get_or_stop ------------------------------------------------------------- http_get_or_stop <- function(url, ...) { @@ -14,6 +20,24 @@ http_get_or_stop <- function(url, ...) response } +# named_link ------------------------------------------------------------------- +named_link <- function(name, url) +{ + sprintf("[%s](%s)", name, url) +} + +# url_parameter_string --------------------------------------------------------- +url_parameter_string <- function(...) +{ + parameters <- list(...) + + if (length(parameters) == 0L) { + return("") + } + + paste0("?", paste0(names(parameters), "=", parameters, collapse = "&")) +} + #' url_success #' #' @param url url of documentation website diff --git a/R/url_helpers.R b/R/url_helpers.R deleted file mode 100644 index d41de6b..0000000 --- a/R/url_helpers.R +++ /dev/null @@ -1,29 +0,0 @@ -# image_link ------------------------------------------------------------------- -image_link <- function(image_name, image_url, link_url) -{ - sprintf("[!%s](%s)", named_link(image_name, image_url),link_url) -} - -# named_link ------------------------------------------------------------------- -named_link <- function(name, url) -{ - sprintf("[%s](%s)", name, url) -} - -# url_parameter_string --------------------------------------------------------- -url_parameter_string <- function(...) -{ - parameters <- list(...) - - if (length(parameters) == 0L) { - return("") - } - - paste0("?", paste0(names(parameters), "=", parameters, collapse = "&")) -} - -# url_path --------------------------------------------------------------------- -url_path <- function(path) -{ - paste0(ifelse(path == "", "", "/"), gsub("^/+", "", path)) -} From 000331a9d7f43c23bf1d58023001e8b974f025e8 Mon Sep 17 00:00:00 2001 From: hsonne Date: Wed, 1 May 2024 10:56:36 +0200 Subject: [PATCH 48/48] Get rid of url_path() (was only used once) --- R/compose_url.R | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/R/compose_url.R b/R/compose_url.R index 8f751b3..a07b058 100644 --- a/R/compose_url.R +++ b/R/compose_url.R @@ -13,17 +13,11 @@ compose_url <- function( paste0(subdomain, ".") }, domain_name, - url_path(path), + ifelse(path == "", "", paste0("/", gsub("^/+", "", path))), do.call(url_parameter_string, parameters) ) } -# url_path --------------------------------------------------------------------- -url_path <- function(path) -{ - paste0(ifelse(path == "", "", "/"), gsub("^/+", "", path)) -} - # compose_url_appveyor --------------------------------------------------------- compose_url_appveyor <- function(path, parameters) {