From 5a9b0606bf00e6fec252eb8a9302cf3af8d5566a Mon Sep 17 00:00:00 2001 From: hsonne Date: Mon, 29 Apr 2024 20:58:57 +0200 Subject: [PATCH] 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")}