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)",
- 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("[](%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(
- "[](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(
- "[](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)",
- 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(
- "[](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(
- "[](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")}