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/NAMESPACE b/NAMESPACE index 8b12ac2..f69208f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,7 +18,9 @@ export(create_report_rpackages) export(get_coverages) export(get_github_repos) export(get_gitlab_repos) +export(get_names_of_r_packages_on_github) export(get_non_r_packages) +export(make_github_package_db) export(prepare_status_rpackages) export(process_hitter_response) export(zen_collections) diff --git a/R/badge_codecov.R b/R/badge_codecov.R index 47669d9..df2fe76 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_path <- function(path) { + paste0("github/", repo_full_names, path) + } + + image_link( + image_name = "codecov", + image_url = compose_url_codecov( + path = to_full_path("/branch/master/graphs/badge.svg") + ), + link_url = compose_url_codecov( + path = to_full_path("") + ) + ) } - - - diff --git a/R/badge_cran.R b/R/badge_cran.R index 5bddf0a..5caf84c 100644 --- a/R/badge_cran.R +++ b/R/badge_cran.R @@ -1,15 +1,21 @@ #' 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_path <- function(path) { + paste0(path, "/", repo_names) + } + + image_link( + image_name = "CRAN_Status_Badge", + image_url = compose_url_cran( + path = to_full_path("badges/version") + ), + link_url = compose_url_cran( + path = to_full_path("pkg") + ) + ) } - - - - diff --git a/R/badge_dependencies.R b/R/badge_dependencies.R index 79dcc68..c977244 100644 --- a/R/badge_dependencies.R +++ b/R/badge_dependencies.R @@ -1,13 +1,13 @@ #' 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) +{ + image_link( + image_name = "Dependencies_badge", + image_url = compose_url_netlify(paste0("badge/", repo_names)), + link_url = compose_url_netlify("") + ) } - - - - diff --git a/R/badge_gitlab.R b/R/badge_gitlab.R index 42060be..c8f336c 100644 --- a/R/badge_gitlab.R +++ b/R/badge_gitlab.R @@ -1,19 +1,20 @@ #' 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) { - - sprintf("", - url, - logo_path, - size, - size) -} \ No newline at end of file +badge_gitlab <- function( + url, + logo_path = compose_url_gitlab( + path = "gitlab-com/gitlab-artwork/raw/master/logo/logo-square.png" + ), + size = 24 +) +{ + logo_path %>% + html_img(title = "Gitlab", width = size, height = size) %>% + html_a(href = url) +} diff --git a/R/badge_license.R b/R/badge_license.R index e972a25..af797d2 100644 --- a/R/badge_license.R +++ b/R/badge_license.R @@ -3,75 +3,38 @@ #' @param license_keys one or many valid license keys from c("agpl-3.0", #' "apache-2.0", "bsd-2-clause", "bsd-3-clause", "epl-2.0", "gpl-2.0", "gpl-3.0", #' "lgpl-2.1", "lgpl-3.0", "mit", "mpl-2.0", "unlicense") -#' @param github_token github access token (default: Sys.getenv("GITHUB_TOKEN")) +#' @param github_token github access token. Default: +#' kwb.pkgstatus:::get_github_token() #' @importFrom gh gh #' @importFrom data.table rbindlist #' @importFrom dplyr left_join select_ rename_ #' @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) - - gh_licenses_df <- data.table::rbindlist(gh_licenses, fill=TRUE) - - +badge_license <- function(license_keys, github_token = get_github_token()) +{ #### 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 <- "GET /licenses" %>% + gh::gh(.token = github_token) %>% + data.table::rbindlist(fill = TRUE) %>% + dplyr::left_join(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(x = data.frame(license_key = license_keys, - stringsAsFactors = FALSE), - y = badges) - - return(res$Badge_License) + dplyr::rename_(license_key = ~key) %>% + dplyr::left_join( + x = data.frame( + license_key = license_keys, + stringsAsFactors = FALSE + ) + ) + + badges$Badge_License } diff --git a/R/badge_opencpu.R b/R/badge_opencpu.R index 189a25e..4b948b6 100644 --- a/R/badge_opencpu.R +++ b/R/badge_opencpu.R @@ -5,14 +5,17 @@ #' @param size size of logo in pixels (default: 24) #' @return OpenCpu logo in html with path to R package on OpenCpu #' @export - -badge_opencpu <- function(url, -logo_path = "https://avatars2.githubusercontent.com/u/28672890?s=200&v=4", -size = 24) { - - sprintf("", - url, - logo_path, - size, - size) +badge_opencpu <- function( + url, + logo_path = compose_url_githubusercontent( + subdomain = "avatars2", + path = "u/28672890", + parameters = list(s = 200, v = 4) + ), + size = 24 +) +{ + logo_path %>% + html_img(title = "OpenCpu", width = size, height = size) %>% + html_a(href = url) } diff --git a/R/badge_zenodo.R b/R/badge_zenodo.R index 39a6bcb..a148e53 100644 --- a/R/badge_zenodo.R +++ b/R/badge_zenodo.R @@ -1,42 +1,62 @@ #' badge_zenodo +#' #' @param repo_full_names vector with combination of username/repo (e.g. #' c("KWB-R/kwb.utils", "KWB-R/kwb.db")) -#' @param zenodo_token zenodo authentication token (default: -#' Sys.getenv("ZENODO_TOKEN")) +#' @param zenodo_token zenodo authentication token. +#' Default: kwb.pkgstatus:::get_token("ZENODO") #' @importFrom stringr str_detect #' @return zenodo badges for provided repo_full_names #' @export -badge_zenodo <- function(repo_full_names, - zenodo_token = Sys.getenv("ZENODO_TOKEN")) { - +badge_zenodo <- function( + repo_full_names, + zenodo_token = get_token("ZENODO") +) +{ zen_data <- zen_collections(access_token = zenodo_token) - zen_badge <- rep(NA, length = length(repo_full_names)) + result <- 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_github( + path = repo_full_names[index] + ) + ) doi_exists[is.na(doi_exists)] <- FALSE - if(sum(doi_exists) == 1) { + n_existing <- sum(doi_exists) + + result[index] <- if (n_existing == 1L) { + + image_link( + image_name = "DOI", + image_url = zen_data$links.badge[doi_exists], + link_url = zen_data$doi_url[doi_exists] + ) - zen_badge[index] <- sprintf("[![DOI](%s)](%s)", - zen_data$links.badge[doi_exists], - zen_data$doi_url[doi_exists]) + } else if (n_existing > 1L) { + + warning( + sprintf( + "Multiple entries found for repo '%s':\n", + repo_full_names[index] + ), + paste( + zen_data$metadata.related_identifiers.identifier[doi_exists], + collapse = "\n" + ) + ) + + "Multiple badges found!" - } 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 + + NA } } - return(zen_badge) + + result } diff --git a/R/badges_ci.R b/R/badges_ci.R index b9b004b..95c4be9 100644 --- a/R/badges_ci.R +++ b/R/badges_ci.R @@ -1,26 +1,41 @@ #' 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) +{ + image_link( + image_name = "Appveyor", + image_url = compose_url_appveyor( + path = sprintf("api/projects/status/github/%s", repo_full_names), + parameters = list(branch = "master", svg = "true") + ), + link_url = compose_url_appveyor( + path = sprintf("project/%s/branch/master", dot_to_dash(repo_full_names)), + parameters = list() + ) + ) } #' 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) +{ + image_link( + image_name = "Travis", + image_url = compose_url_travis( + path = sprintf("%s.svg", repo_full_names), + parameters = list(branch = "master") + ), + link_url = compose_url_travis( + path = repo_full_names, + parameters = list() + ) + ) +} diff --git a/R/check_documentation.R b/R/check_documentation.R index b16fc12..c39fde6 100644 --- a/R/check_documentation.R +++ b/R/check_documentation.R @@ -1,48 +1,38 @@ -#' url_success -#' @param url url of documentation website -#' @importFrom httr status_code GET -#' @return TRUE in case HTTP status code is 200, if not: FALSE - -url_success <- function(url) { - identical(httr::status_code(x = httr::GET(url)), 200L) -} - #' Check documentation: development +#' #' @param repo_names vector of repository names to be checked #' @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) - if(docu_available) { - sprintf("[X](%s)", url_docu_release) - } else { - "" - }}) + + url <- sprintf(path_format, url, repo) + + if (!url_success(url = url)) { + return("") + } + + named_link("X", url) + }) } diff --git a/R/check_gitlab_backup.R b/R/check_gitlab_backup.R index 8a6f22a..e0d3c80 100644 --- a/R/check_gitlab_backup.R +++ b/R/check_gitlab_backup.R @@ -1,40 +1,41 @@ #' check_gitlab_backup #' #' @param group username or organisation for Github/Gitlab (default: "KWB-R") -#' @param github_token github access token (default: Sys.getenv("GITHUB_TOKEN")) -#' @param gitlab_token gitlab access token (default: Sys.getenv("GITLAB_TOKEN"))) +#' @param github_token github access token. +#' Default: kwb.pkgstatus:::get_github_token() +#' @param gitlab_token gitlab access token. +#' Default: kwb.pkgstatus:::get_gitlab_token() #' @return data.frame containing all Github repositoriers that are mirrored in #' Gitlab (i.e. were at least syncronised within the last 2 hours) #' @importFrom magrittr "%>%" #' @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)) - - 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") - - 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) - +check_gitlab_backup <- function( + group = "KWB-R", + github_token = get_github_token(), + gitlab_token = get_gitlab_token() +) +{ + git_repos <- dplyr::left_join( + x = prefix_names(get_github_repos(group, github_token), "gh_"), + y = prefix_names(get_gitlab_repos(group, gitlab_token), "gl_"), + by = c("gh_name" = "gl_name") + ) + + git_repos$last_mirrored_hours <- difftime( + lubridate::as_datetime(git_repos$gh_pushed_at), + lubridate::as_datetime(git_repos$gl_last_activity_at), + units = "hours" + ) + + is_mirrored <- git_repos$last_mirrored_hours <= 2 #h + + mirrored_repos <- git_repos[is_mirrored, ] + + 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..1810e1b 100644 --- a/R/check_opencpu_deploy.R +++ b/R/check_opencpu_deploy.R @@ -1,4 +1,5 @@ -#' check_opencpu_deploy: get all Github repos that are deployed on OpenCpu +#' Get all Github repos that are deployed on OpenCpu +#' #' @description Direct deployment of R packages (including vignette build) by #' using webhooks as described in OpenCpu blog post #' (https://www.opencpu.org/posts/opencpu-release-1-4-5/) and online help @@ -8,17 +9,15 @@ #' 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") +{ + url <- compose_url_ocpu(group) - 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) + repo_names <- readLines(url) + + data.frame( + name = repo_names, + OpenCpu = badge_opencpu(sprintf("%s/%s", url, repo_names)), + stringsAsFactors = FALSE + ) } - - diff --git a/R/compose_url.R b/R/compose_url.R new file mode 100644 index 0000000..a07b058 --- /dev/null +++ b/R/compose_url.R @@ -0,0 +1,184 @@ +# compose_url ------------------------------------------------------------------ +compose_url <- function( + protocol = "http", + subdomain = NULL, + domain_name, + path = "", + parameters = list() +) +{ + paste0( + protocol, "://", + if (!is.null(subdomain)) { + paste0(subdomain, ".") + }, + domain_name, + ifelse(path == "", "", paste0("/", gsub("^/+", "", path))), + do.call(url_parameter_string, parameters) + ) +} + +# compose_url_appveyor --------------------------------------------------------- +compose_url_appveyor <- function(path, parameters) +{ + compose_url( + protocol = "https", + subdomain = "ci", + domain_name = "appveyor.com", + path = path, + parameters = parameters + ) +} + +# compose_url_badge ------------------------------------------------------------ +compose_url_badge <- function(relative_paths) +{ + compose_url( + protocol = "https", + subdomain = "img", + domain_name = "shields.io", + path = paste0("badge/", relative_paths) + ) +} + +# compose_url_codecov ---------------------------------------------------------- +compose_url_codecov <- function(path) +{ + compose_url( + protocol = "https", + domain_name = "codecov.io", + path = path + ) +} + +# compose_url_cran ------------------------------------------------------------- +compose_url_cran <- function(path) +{ + compose_url( + protocol = "http", + subdomain = "www", + domain_name = "r-pkg.org", + path = path + ) +} + +# compose_url_eclipse ---------------------------------------------------------- +compose_url_eclipse <- function(path) +{ + compose_url( + protocol = "https", + subdomain = "www", + domain_name = "eclipse.org", + path = path + ) +} + +# compose_url_github ----------------------------------------------------------- +compose_url_github <- function(path, subdomain = NULL) +{ + compose_url( + protocol = "https", + subdomain = subdomain, + domain_name = "github.com", + path = path + ) +} + +# compose_url_githubusercontent ------------------------------------------------ +compose_url_githubusercontent <- function(subdomain, path, parameters = list()) +{ + compose_url( + protocol = "https", + subdomain = subdomain, + domain_name = "githubusercontent.com", + path = path, + parameters = parameters + ) +} + +# compose_url_gitlab ----------------------------------------------------------- +compose_url_gitlab <- function(path, token = NULL) +{ + compose_url( + protocol = "https", + domain_name = "gitlab.com", + path = path, + parameters = if (is.null(token)) { + list() + } else { + list(private_token = token) + } + ) +} + +# compose_url_gnu -------------------------------------------------------------- +compose_url_gnu <- function(path) +{ + compose_url( + protocol = "https", + subdomain = "www", + domain_name = "gnu.org", + path = path + ) +} + +# compose_url_netlify ---------------------------------------------------------- +compose_url_netlify <- function(path) +{ + compose_url( + protocol = "https", + subdomain = "kwb-githubdeps", + domain_name = "netlify.app", + path = path + ) +} + +# compose_url_ocpu ------------------------------------------------------------- +compose_url_ocpu <- function(group) +{ + compose_url( + protocol = "https", + subdomain = tolower(group), + domain_name = "ocpu.io" + ) +} + +# compose_url_opensource ------------------------------------------------------- +compose_url_opensource <- function(path) +{ + compose_url( + protocol = "https", + domain_name = "opensource.org", + path = path + ) +} + +# compose_url_travis ----------------------------------------------------------- +compose_url_travis <- function(path, parameters) +{ + compose_url( + protocol = "https", + domain_name = "travis-ci.org", + path = path, + parameters = parameters + ) +} + +# compose_url_unlicense -------------------------------------------------------- +compose_url_unlicense <- function() +{ + compose_url( + protocol = "http", + domain_name = "unlicense.org" + ) +} + +# compose_url_zenodo ----------------------------------------------------------- +compose_url_zenodo <- function(path) +{ + compose_url( + protocol = "https", + domain_name = "zenodo.org", + path = path + ) +} diff --git a/R/create_report_rpackages.R b/R/create_report_rpackages.R index 20dbdb8..f8b0c6e 100644 --- a/R/create_report_rpackages.R +++ b/R/create_report_rpackages.R @@ -1,4 +1,5 @@ -#' Create R packages status report#' +#' Create R packages status report +#' #' @param secrets_csv path to "secrets.csv" file, if "NULL" Sys.env variables #' for the following services are used/need to be defined: APPVEYOR_TOKEN, #' GITHUB_TOKEN, GITLAB_TOKEN, CODECOV_TOKEN, ZENODO_TOKEN, @@ -12,22 +13,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..ed12039 100644 --- a/R/get_coverages.R +++ b/R/get_coverages.R @@ -1,70 +1,86 @@ #' get_coverage +#' #' @param repo_full_name one combination of username/repo (e.g."KWB-R/kwb.db") -#' @param codecov_token codecov authentication token (default: -#' Sys.getenv("CODECOV_TOKEN")) +#' @param codecov_token codecov authentication token. +#' Default: kwb.pkgstatus:::get_token("CODECOV") #' @param dbg debug if TRUE (default: TRUE) #' @importFrom httr status_code #' @return codecov coverage in percent for provided repo_full_name -get_coverage <- function(repo_full_name, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE) { +get_coverage <- function( + repo_full_name, + codecov_token = get_token("CODECOV"), + dbg = TRUE +) +{ + url <- compose_url_codecov( + 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 (url_success(req)) { + 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) + if (!is.null(codecov_data$commit$totals$c)) { + + codecov_coverage <- round( + as.numeric(codecov_data$commit$totals$c), + digits = 2 + ) + } else { + codecov_coverage <- NA } + } else { + codecov_coverage <- NA } - if(dbg) cat(sprintf("....%3.1f%%\n", codecov_coverage)) - return(codecov_coverage) + cat_if(dbg, "....%3.1f%%\n", codecov_coverage) + + codecov_coverage } -#' get_coverage -#' @param repo_full_names vector with combination of username/repo (e.g. -#' c("KWB-R/kwb.utils", "KWB-R/kwb.db")) -#' @param codecov_token zenodo authentication token (default: -#' Sys.getenv("CODECOV_TOKEN") +#' get_coverages +#' +#' @param repo_full_names vector with combination of username/repo +#' (e.g. c("KWB-R/kwb.utils", "KWB-R/kwb.db")) +#' @param codecov_token codecov authentication token. +#' Default: kwb.pkgstatus:::get_token("CODECOV") #' @param dbg debug if TRUE (default: TRUE) #' @return data.frame with coverage percent and url for all provided #' repo_full_names #' @export -get_coverages <- function (repo_full_names, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - 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 = get_token("CODECOV"), + 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_codecov( + path = paste0("gh/", 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..b7ab671 --- /dev/null +++ b/R/get_license_badge_info.R @@ -0,0 +1,63 @@ +# get_license_badge_info ------------------------------------------------------- +get_license_badge_info <- function() +{ + 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_url_badge(c( + "License-AGPL%20v3-blue.svg", + "License-Apache%202.0-blue.svg", + "License-BSD%202--Clause-orange.svg", + "License-BSD%203--Clause-blue.svg" + )), + "", + compose_url_badge(c( + "License-GPL%20v2-blue.svg", + "License-GPL%20v3-blue.svg" + )), + "", + compose_url_badge(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_opensource(path = c( + "licenses/AGPL-3.0", + "licenses/Apache-2.0", + "licenses/BSD-2-Clause", + "licenses/BSD-3-Clause" + )), + compose_url_eclipse( + path = "legal/epl-2.0/" + ), + compose_url_gnu(path = c( + "licenses/gpl-2.0", + "licenses/gpl-3.0", + "licenses/lgpl-2.1", + "licenses/lgpl-3.0" + )), + compose_url_opensource(path = c( + "licenses/MIT", + "licenses/MPL-2.0" + )), + compose_url_unlicense() + ), + stringsAsFactors = FALSE + ) +} diff --git a/R/get_names_of_r_packages_on_github.R b/R/get_names_of_r_packages_on_github.R new file mode 100644 index 0000000..a319935 --- /dev/null +++ b/R/get_names_of_r_packages_on_github.R @@ -0,0 +1,55 @@ +# get_names_of_r_packages_on_github -------------------------------------------- + +#' Get Names of R Packages on GitHub +#' +#' @param group name of organisation on GitHub, defaults to "kwb-r" +#' @param public logical indicating whether private repositories are to be +#' considered. Default: \code{TRUE} +#' @param private logical indicating whether public repositories are to be +#' considered. Default: \code{TRUE} +#' @param dbg logical indicating whether or not to show debug messages +#' @returns vector of character representing the names of the \code{public} +#' and/or \code{private} repositories (as requested), owned by the +#' organisation \code{groupt} on GitHub +#' @export +get_names_of_r_packages_on_github <- function( + group = "kwb-r", public = TRUE, private = TRUE, dbg = TRUE +) +{ + # Get info on all repositories owned by group + all_repos <- get_github_repos_impl(group = group, dbg = dbg) + + # Is a repository private (or public)? + is_private <- sapply(all_repos, `[[`, "private") + + # Keep only repositories of requested type + repos <- all_repos[(public & !is_private) | (private & is_private)] + + # Get the names of the selected repositories + repo_names <- sapply(repos, `[[`, "name") + + # If there are no (remaining) repository names, return an empty vector + if (length(repos) == 0L) { + return(character(0L)) + } + + # Keep only the names of repositories that look like R packages + keep <- sapply(repo_names, github_repo_looks_like_r_package, owner = group) + repo_names[keep] +} + +# github_repo_looks_like_r_package --------------------------------------------- +github_repo_looks_like_r_package <- function(owner = "kwb-r", repo) +{ + file_names <- try(list_files_in_github_repo(owner, repo)) + + if (inherits(file_names, "try-error")) { + message( + "Error when trying to list files of repo '", repo, "'.\n", + "Returning FALSE (does not look like an R package)" + ) + return(FALSE) + } + + all(c("R/", "DESCRIPTION") %in% file_names) +} diff --git a/R/get_non_r_packages.R b/R/get_non_r_packages.R index 9ec37fc..8d7e003 100644 --- a/R/get_non_r_packages.R +++ b/R/get_non_r_packages.R @@ -1,21 +1,75 @@ -#' Helper function: get_non_r_packages +#' Get Names of Repositories that Do not Represent R Packages #' -#' @return returns vector with KWB-R repos on Github, which are not R packages +#' @param hard_coded logical indicating whether or not to return the hard-coded +#' vector of package names. The default is \code{TRUE}. If \code{hard_coded} +#' is \code{FALSE} the names of repositories that are not assumed to represent +#' R packages are determined by looking into each repository. This may take a +#' while. +#' @return This function returns a (alphabetically sorted) vector of names of +#' KWB-R repositories on Github that do not represent R packages #' @export #' @examples #' get_non_r_packages() #' -get_non_r_packages <- function() { +get_non_r_packages <- function(hard_coded = TRUE) +{ + repo_names <- if (hard_coded) { + c( + "abimo", + "abimo.scripts", + "ad4gd_lakes", + "apps", + "abluft2", + "abluft2.scripts", + "basar.scripts", + "dwc.scripts", + "kwb-r.github.io", + "kwb-r.r-universe.dev", + "fakin", + "fakin.blog", + "fakin.doc", + "fakin.scripts", + "FolderRights", + "flusshygiene", + "HydroServerLite", + "hydrus1d", + "GeoSalz", + "geosalz.mf", + "geosalz.scripts", + "impetus_scripts", + "intruder.io", + "lasso.scripts", + "Logremoval", + "programming", + "pathana", + "pFromGrADS", + "promisces.hhra", + "qmra", + "qsimVis", + "r-training", + "support", + "maxflow", + "mbr40.scripts", + "misa.scripts", + "pubs", + "riverPollution", + "smart.control", + "sema.scripts", + "sema.projects", + "swim-ai", + "spur.scripts", + "status", + "ultimate.scripts", + "useR-2019", + "wellma.scripts" + ) + + } else { + + all_repos <- get_github_repos()[["name"]] + package_repos <- get_names_of_r_packages_on_github() + setdiff(all_repos, package_repos) + } - 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") + sort(repo_names) } - diff --git a/R/get_repo_infos.R b/R/get_repo_infos.R index d485f33..e6cd332 100644 --- a/R/get_repo_infos.R +++ b/R/get_repo_infos.R @@ -1,283 +1,149 @@ +# get_gitlab_repos ------------------------------------------------------------- + #' get_gitlab_repos +#' #' @param group username or organisation for Gitlab (default: "KWB-R") -#' @param gitlab_token gitlab access token (default: Sys.getenv("GITLAB_TOKEN")) +#' @param gitlab_token gitlab access token. +#' Default: kwb.pkgstatus:::get_gitlab_token() #' @return data.frame with for all repositories of the user/organisation defined #' in parameter group (private repos will only be accessible if the token is #' configured to allow that) #' @importFrom jsonlite fromJSON #' @export -get_gitlab_repos <- function(group = "KWB-R", - gitlab_token = Sys.getenv("GITLAB_TOKEN")) { - endpoint <- sprintf("https://gitlab.com/api/v4/groups/%s?private_token=%s", - group, - gitlab_token) - - +get_gitlab_repos <- function( + group = "KWB-R", + gitlab_token = get_gitlab_token() +) +{ + endpoint <- compose_url_gitlab( + path = paste0("api/v4/groups/", group), + token = gitlab_token + ) + gitlab_group <- jsonlite::fromJSON(endpoint) - gitlab_group$projects } +# get_github_repos ------------------------------------------------------------- #' get_github_repos +#' #' @param group username or organisation for Github (default: "KWB-R") -#' @param github_token github access token (default: Sys.getenv("GITHUB_TOKEN")) +#' @param github_token github access token. +#' Default: kwb.pkgstatus:::get_github_token() #' @return data.frame with for all repositories of the user/organisation defined #' in parameter group (private repos will only be accessible if the token is #' configured to allow that) #' @importFrom gh gh #' @export -get_github_repos <- function (group = "KWB-R", - github_token = Sys.getenv("GITHUB_TOKEN")) { - - - - get_repos <- function(per_page = 100L) { - - n_results <- per_page - page <- 1L - repo_list <- list() - while(n_results == per_page) { - - repo_list[[page]] <- gh::gh(endpoint = sprintf("GET /orgs/%s/repos?page=%d&per_page=%d", - group, - page, - per_page), - .token = github_token) - n_results <- length(repo_list[[page]]) - page <- page + 1L - } - - do.call(what = c, args = repo_list) +get_github_repos <- function(group = "KWB-R", github_token = get_github_token()) +{ + #kwb.utils::assignPackageObjects("kwb.pkgstatus");group="kwb-r" + result <- group %>% + get_github_repos_impl(github_token = github_token) %>% + lapply(github_repo_object_to_data_row) %>% + do.call(what = rbind) + + result[order(result[["name"]], decreasing = FALSE), ] +} - } - - gh_repos <- get_repos() - - - for (repo_ind in seq_along(gh_repos)) { - - sel_repo <- gh_repos[[repo_ind]] +# get_github_repos_impl -------------------------------------------------------- +get_github_repos_impl <- function( + group, + github_token = get_github_token(), + per_page = 100L, + dbg = TRUE +) +{ + all_repos <- list() + + # Start with the first page + page <- 1L + + # Read next page while page number is given + while (page > 0L) { - tmp <- data.frame(name = sel_repo$name, - full_name = sel_repo$full_name, - url = sel_repo$html_url, - created_at = sel_repo$created_at, - pushed_at = sel_repo$pushed_at, - open_issues = sel_repo$open_issues, - license_key = ifelse(is.null(sel_repo$license$key), - NA, sel_repo$license$key), - license_short = ifelse(is.null(sel_repo$license$spdx_id), - NA, sel_repo$license$spdx_id), - license_link = ifelse(is.null(sel_repo$license$spdx_id), - NA, - sprintf("https://github.com/%s/blob/master/LICENSE", - sel_repo$full_name)), - stringsAsFactors = FALSE) + cat_if( + dbg, + "Reading page %d of %d GitHub repos per page\n", + page, + per_page + ) + # Read repos from current page + repos <- gh::gh( + endpoint = github_endpoint(group, page, per_page), + .token = github_token + ) - tmp$Repository <- sprintf("[%s](%s)", tmp$name, tmp$url) - - tmp$License <- ifelse(is.na(tmp$license_short), - NA, - sprintf("[%s](%s)", - tmp$license_short, - tmp$license_link)) - - if (repo_ind == 1) { - res <- tmp - } else { - res <- rbind(res,tmp) - } - } - res <- res[order(res$name,decreasing = FALSE), ] - return(res) -} - - - - -badge_cran <- function(repo_names) { - sprintf("[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/%s)](http://www.r-pkg.org/pkg/%s)", - repo_names, - repo_names) -} - -badge_codecov <- function(repo_full_names) { - sprintf("[![codecov](https://codecov.io/github/%s/branch/master/graphs/badge.svg)](https://codecov.io/github/%s)", - repo_full_names, - repo_full_names) - - # sprintf("![codecov](https://img.shields.io/codecov/c/github/%s/master.svg", - # repo_full_names) -} - -badge_license <- function(license_keys, - github_token = Sys.getenv("GITHUB_TOKEN")) { - gh_licenses <- gh::gh(endpoint = "GET /licenses", - .token = github_token) - - 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) - - 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) - - badges <- gh_licenses_df %>% - dplyr::select_(~key, ~Badge_License) %>% - dplyr::rename_(license_key = ~key) - - - res <- dplyr::left_join(x = data.frame(license_key = license_keys, - stringsAsFactors = FALSE), - y = badges) - - return(res$Badge_License) -} - - -badge_appveyor <- function(repo_full_names) { - sprintf("[![Appveyor](https://ci.appveyor.com/api/projects/status/github/%s?branch=master&svg=true)](https://ci.appveyor.com/project/%s/branch/master)", - repo_full_names, - gsub(".", "-", repo_full_names, fixed = TRUE)) -} - -badge_travis <- function(repo_full_names) { - sprintf("[![Travis](https://travis-ci.org/%s.svg?branch=master)](https://travis-ci.org/%s)", - repo_full_names, - repo_full_names) -} - - - -badge_zenodo <- function(repo_full_names, - zenodo_token = Sys.getenv("ZENODO_TOKEN")) { - - zen_data <- zen_collections(access_token = zenodo_token) - - zen_badge <- rep(NA, length = length(repo_full_names)) - - for (index in seq_along(repo_full_names)) { - doi_exists <- stringr::str_detect(string = zen_data$metadata.related_identifiers.identifier, - pattern = sprintf("https://github.com/%s", - repo_full_names[index])) - doi_exists[is.na(doi_exists)] <- FALSE - - if(sum(doi_exists) == 1) { + # If the page contained at least one repo... + if (length(repos) > 0L) { + + # ... append repos to the list all_repos + all_repos[[length(all_repos) + 1L]] <- repos - zen_badge[index] <- sprintf("[![DOI](%s)](%s)", - zen_data$links.badge[doi_exists], - zen_data$doi_url[doi_exists]) + page <- page + 1L - } 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 + + # Set page number to zero to finish the while-loop + page <- 0L } } - return(zen_badge) + + # Combine all repo objects into one list + do.call(c, all_repos) } +# github_endpoint -------------------------------------------------------------- +github_endpoint <- function(group, page, per_page = 100L) +{ + sprintf( + "GET /orgs/%s/repos%s", + group, + url_parameter_string(page = page, per_page = per_page) + ) +} -get_coverage <- function(repo_full_name, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE) { - +# github_repo_object_to_data_row ----------------------------------------------- +github_repo_object_to_data_row <- function(repo) +{ + name <- repo[["name"]] + full_name <- repo[["full_name"]] + url <- repo[["html_url"]] - url <- sprintf("https://codecov.io/api/gh/%s", repo_full_name) + license_key <- na_if_null(repo[["license"]][["key"]]) + license_short <- na_if_null(repo[["license"]][["spdx_id"]]) - 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) { - codecov_data <- jsonlite::fromJSON(req) - - if(!is.null(codecov_data$commit$totals$c)) { - codecov_coverage <- round(as.numeric(codecov_data$commit$totals$c),digits = 2) - } else { - codecov_coverage <- NA - } + license_link <- if (is.na(license_short)) { + NA } else { - codecov_coverage <- NA + compose_url_github( + path = paste0(full_name, "/blob/master/LICENSE") + ) } - if(dbg) cat(sprintf("....%3.1f%%\n", codecov_coverage)) - return(codecov_coverage) -} - -get_coverages <- function (repo_full_names, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE) { - coverage_percent <- rep(NA, - length = length(repo_full_names)) - coverage_url <- rep(NA, - length = length(repo_full_names)) - - for (index in seq_along(repo_full_names)) { - coverage_percent[index] <- get_coverage(repo_full_name = repo_full_names[index], - codecov_token, - dbg) + result <- data.frame( + name = name, + full_name = full_name, + url = url, + created_at = repo[["created_at"]], + pushed_at = repo[["pushed_at"]], + open_issues = repo[["open_issues"]], + license_key = license_key, + license_short = license_short, + license_link = license_link, + stringsAsFactors = FALSE + ) + + result[["Repository"]] <- named_link(name, url) + + result[["License"]] <- if (is.na(license_short)) { + NA + } else { + named_link(license_short, license_link) } - - 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)) + result } diff --git a/R/helpers.R b/R/helpers.R new file mode 100644 index 0000000..a4472e2 --- /dev/null +++ b/R/helpers.R @@ -0,0 +1,49 @@ +# image_link ------------------------------------------------------------------- +image_link <- function(image_name, image_url, link_url) +{ + sprintf("[!%s](%s)", named_link(image_name, image_url),link_url) +} + +# http_get_or_stop ------------------------------------------------------------- +http_get_or_stop <- function(url, ...) +{ + response <- httr::GET(url, ...) + + if (httr::status_code(response) != 200L) { + stop( + "Error when trying to GET ", url, ":\n", + jsonlite::fromJSON(httr::content(response, type = "text"))$message, + call. = FALSE + ) + } + + response +} + +# named_link ------------------------------------------------------------------- +named_link <- function(name, url) +{ + sprintf("[%s](%s)", name, url) +} + +# url_parameter_string --------------------------------------------------------- +url_parameter_string <- function(...) +{ + parameters <- list(...) + + if (length(parameters) == 0L) { + return("") + } + + paste0("?", paste0(names(parameters), "=", parameters, collapse = "&")) +} + +#' url_success +#' +#' @param url url of documentation website +#' @importFrom httr status_code GET +#' @return TRUE in case HTTP status code is 200, if not: FALSE +url_success <- function(url) +{ + identical(httr::status_code(x = httr::GET(url)), 200L) +} diff --git a/R/list_files_in_github_repo.R b/R/list_files_in_github_repo.R new file mode 100644 index 0000000..f559492 --- /dev/null +++ b/R/list_files_in_github_repo.R @@ -0,0 +1,54 @@ +# list_files_in_github_repo ---------------------------------------------------- +list_files_in_github_repo <- function( + owner, + repo, + path = "", + full_info = FALSE, + columns = c("isdir", "name", "path", "download_url") +) +{ + #kwb.utils::assignPackageObjects("kwb.pkgstatus") + #owner="kwb-r";repo="kwb.utils";path="" + + url <- compose_url_github( + subdomain = "api", + path = sprintf("repos/%s/%s/contents/%s", owner, repo, path) + ) + + response <- http_get_or_stop( + url, + config = httr::add_headers( + Authorization = paste("Bearer", get_github_token()) + ) + ) + + contents <- httr::content(response) + + file_info <- lapply(contents, function(x) { + #x <- contents[[1L]] + x_without_links <- x[setdiff(names(x), "_links")] + is_null <- sapply(x_without_links, is.null) + x_without_links[is_null] <- as.list(rep(NA, sum(is_null))) + as.data.frame(x_without_links) + }) %>% + do.call(what = rbind) + + isdir <- file_info[["type"]] == "dir" + + file_info[["download_url"]] <- character(nrow(file_info)) + + file_info[["download_url"]][!isdir] <- sapply( + contents[!isdir], + FUN = `[[`, + elements = "download_url" + ) + + file_info[["isdir"]] <- isdir + + if (full_info) { + return(file_info[columns]) + } + + file_info[["name"]] %>% + paste0(ifelse(isdir, "/", "")) +} diff --git a/R/make_github_package_db.R b/R/make_github_package_db.R new file mode 100644 index 0000000..371a85b --- /dev/null +++ b/R/make_github_package_db.R @@ -0,0 +1,35 @@ +# make_github_package_db ------------------------------------------------------- + +#' Make Package Database for Packages on GitHub +#' +#' ready to be used in e.g. \code{\link[tools]{package_dependencies}} +#' +#' @param group Name of GitHub organisation, defaults to "kwb-r" +#' @param dbg logical indicating whether or not to show debug messages. +#' The default is \code{TRUE} +#' @return data frame with each column representing a field in the `DESCRIPTION` +#' file +#' @export +make_github_package_db <- function(group = "kwb-r", dbg = TRUE) +{ + #kwb.utils::assignPackageObjects("kwb.pkgstatus") + public_r_packages <- get_names_of_r_packages_on_github( + group = group, + private = FALSE, + dbg = dbg + ) + + description_urls <- compose_url_githubusercontent( + subdomain = "raw", + path = sprintf("%s/%s/master/DESCRIPTION", group, public_r_packages) + ) + + description_matrices <- lapply(description_urls, function(url) { + cat_if(dbg, "Reading %s\n", url) + con <- file(url, encoding = "UTF-8") + on.exit(close(con)) + read.dcf(con) + }) + + dplyr::bind_rows(lapply(description_matrices, as.data.frame)) +} diff --git a/R/prepare_status_rpackages.R b/R/prepare_status_rpackages.R index d05b72e..c46f360 100644 --- a/R/prepare_status_rpackages.R +++ b/R/prepare_status_rpackages.R @@ -4,28 +4,32 @@ #' @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) + } + warning(sprintf( + "The following tokens were not defined: %s", + paste(token_names[!tokens_defined], collapse = ", ") + )) + + 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 +43,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 +67,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/utils.R b/R/utils.R new file mode 100644 index 0000000..3d13840 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,77 @@ +# 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", Sys.getenv("GITHUB_PAT")) +} + +# get_gitlab_token ------------------------------------------------------------- +get_gitlab_token <- function() +{ + Sys.getenv("GITLAB_TOKEN") +} + +# get_token -------------------------------------------------------------- +get_token <- function(prefix) +{ + Sys.getenv(paste0(toupper(prefix), "_TOKEN")) +} + +# html_a ----------------------------------------------------------------------- +html_a <- function(href, x) +{ + sprintf("%s", href, x) +} + +# html_attribute_string -------------------------------------------------------- +html_attribute_string <- function(...) +{ + attributes <- list(...) + + sprintf("%s='%s'", names(attributes), attributes) %>% + paste(collapse = ", ") +} + +# html_img --------------------------------------------------------------------- +html_img <- function(src, ...) +{ + attr_string <- html_attribute_string(...) + + sprintf( + "", + src, + ifelse(nzchar(attr_string), paste0(" ", attr_string), "") + ) +} + +# na_along --------------------------------------------------------------------- +na_along <- function(x) +{ + rep(NA, length = length(x)) +} + +# na_if_null ------------------------------------------------------------------- +na_if_null <- function(x) +{ + if (is.null(x)) NA else x +} + +# prefix_names ----------------------------------------------------------------- +prefix_names <- function(x, prefix) +{ + names(x) <- paste0(prefix, names(x)) + x +} diff --git a/R/zen_collections.R b/R/zen_collections.R index 3dcd285..8a834e6 100644 --- a/R/zen_collections.R +++ b/R/zen_collections.R @@ -12,17 +12,24 @@ process_hitter_response <- function (response) #' Zenodo: get available collections #' @param n number of zenodo entries ("size") to return per API call (default: 1000) -#' @param access_token Zenodo access token (default: Sys.getenv("ZENODO_TOKEN")) +#' @param access_token Zenodo access token. +#' Default: kwb.pkgstatus:::get_token("ZENODO") #' @importFrom httr content GET #' @return a tibble of available Zenodo data #' @export #' @seealso \url{https://developers.zenodo.org/#depositions} -zen_collections <- function (n = 1000, - access_token = Sys.getenv("ZENODO_TOKEN")) { - 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 = get_token("ZENODO")) +{ + results <- http_get_or_stop( + url = compose_url_zenodo( + 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..1b33562 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_gitlab(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..a201a12 100644 --- a/man/badge_license.Rd +++ b/man/badge_license.Rd @@ -4,14 +4,15 @@ \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", "apache-2.0", "bsd-2-clause", "bsd-3-clause", "epl-2.0", "gpl-2.0", "gpl-3.0", "lgpl-2.1", "lgpl-3.0", "mit", "mpl-2.0", "unlicense")} -\item{github_token}{github access token (default: Sys.getenv("GITHUB_TOKEN"))} +\item{github_token}{github access token. Default: +kwb.pkgstatus:::get_github_token()} } \value{ badge for all provided license keys diff --git a/man/badge_opencpu.Rd b/man/badge_opencpu.Rd index 977b27b..d72fb21 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_githubusercontent(subdomain = "avatars2", path = "u/28672890", + parameters = list(s = 200, v = 4)), size = 24 ) } diff --git a/man/badge_zenodo.Rd b/man/badge_zenodo.Rd index 25cbba9..5943db1 100644 --- a/man/badge_zenodo.Rd +++ b/man/badge_zenodo.Rd @@ -4,14 +4,14 @@ \alias{badge_zenodo} \title{badge_zenodo} \usage{ -badge_zenodo(repo_full_names, zenodo_token = Sys.getenv("ZENODO_TOKEN")) +badge_zenodo(repo_full_names, zenodo_token = get_token("ZENODO")) } \arguments{ \item{repo_full_names}{vector with combination of username/repo (e.g. c("KWB-R/kwb.utils", "KWB-R/kwb.db"))} -\item{zenodo_token}{zenodo authentication token (default: -Sys.getenv("ZENODO_TOKEN"))} +\item{zenodo_token}{zenodo authentication token. +Default: kwb.pkgstatus:::get_token("ZENODO")} } \value{ zenodo badges for provided repo_full_names diff --git a/man/check_gitlab_backup.Rd b/man/check_gitlab_backup.Rd index c8542d4..a44cea2 100644 --- a/man/check_gitlab_backup.Rd +++ b/man/check_gitlab_backup.Rd @@ -6,16 +6,18 @@ \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{ \item{group}{username or organisation for Github/Gitlab (default: "KWB-R")} -\item{github_token}{github access token (default: Sys.getenv("GITHUB_TOKEN"))} +\item{github_token}{github access token. +Default: kwb.pkgstatus:::get_github_token()} -\item{gitlab_token}{gitlab access token (default: Sys.getenv("GITLAB_TOKEN")))} +\item{gitlab_token}{gitlab access token. +Default: kwb.pkgstatus:::get_gitlab_token()} } \value{ data.frame containing all Github repositoriers that are mirrored in diff --git a/man/check_opencpu_deploy.Rd b/man/check_opencpu_deploy.Rd index bfab030..873e2e9 100644 --- a/man/check_opencpu_deploy.Rd +++ b/man/check_opencpu_deploy.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/check_opencpu_deploy.R \name{check_opencpu_deploy} \alias{check_opencpu_deploy} -\title{check_opencpu_deploy: get all Github repos that are deployed on OpenCpu} +\title{Get all Github repos that are deployed on OpenCpu} \usage{ check_opencpu_deploy(group = "KWB-R") } diff --git a/man/create_report_rpackages.Rd b/man/create_report_rpackages.Rd index 0bcc775..662218c 100644 --- a/man/create_report_rpackages.Rd +++ b/man/create_report_rpackages.Rd @@ -2,14 +2,13 @@ % Please edit documentation in R/create_report_rpackages.R \name{create_report_rpackages} \alias{create_report_rpackages} -\title{Create R packages status report#'} +\title{Create R packages status report} \usage{ create_report_rpackages( secrets_csv = NULL, 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{ @@ -31,5 +30,5 @@ creates html status report for R packages and returns the absolute path to the export directory } \description{ -Create R packages status report#' +Create R packages status report } diff --git a/man/get_coverage.Rd b/man/get_coverage.Rd index 72ff808..7c429c5 100644 --- a/man/get_coverage.Rd +++ b/man/get_coverage.Rd @@ -4,17 +4,13 @@ \alias{get_coverage} \title{get_coverage} \usage{ -get_coverage( - repo_full_name, - codecov_token = Sys.getenv("CODECOV_TOKEN"), - dbg = TRUE -) +get_coverage(repo_full_name, codecov_token = get_token("CODECOV"), dbg = TRUE) } \arguments{ \item{repo_full_name}{one combination of username/repo (e.g."KWB-R/kwb.db")} -\item{codecov_token}{codecov authentication token (default: -Sys.getenv("CODECOV_TOKEN"))} +\item{codecov_token}{codecov authentication token. +Default: kwb.pkgstatus:::get_token("CODECOV")} \item{dbg}{debug if TRUE (default: TRUE)} } diff --git a/man/get_coverages.Rd b/man/get_coverages.Rd index 5d6b8c4..051b66c 100644 --- a/man/get_coverages.Rd +++ b/man/get_coverages.Rd @@ -2,20 +2,20 @@ % Please edit documentation in R/get_coverages.R \name{get_coverages} \alias{get_coverages} -\title{get_coverage} +\title{get_coverages} \usage{ get_coverages( repo_full_names, - codecov_token = Sys.getenv("CODECOV_TOKEN"), + codecov_token = get_token("CODECOV"), dbg = TRUE ) } \arguments{ -\item{repo_full_names}{vector with combination of username/repo (e.g. -c("KWB-R/kwb.utils", "KWB-R/kwb.db"))} +\item{repo_full_names}{vector with combination of username/repo +(e.g. c("KWB-R/kwb.utils", "KWB-R/kwb.db"))} -\item{codecov_token}{zenodo authentication token (default: -Sys.getenv("CODECOV_TOKEN")} +\item{codecov_token}{codecov authentication token. +Default: kwb.pkgstatus:::get_token("CODECOV")} \item{dbg}{debug if TRUE (default: TRUE)} } @@ -24,5 +24,5 @@ data.frame with coverage percent and url for all provided repo_full_names } \description{ -get_coverage +get_coverages } diff --git a/man/get_github_repos.Rd b/man/get_github_repos.Rd index 6a61905..906114c 100644 --- a/man/get_github_repos.Rd +++ b/man/get_github_repos.Rd @@ -4,12 +4,13 @@ \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")} -\item{github_token}{github access token (default: Sys.getenv("GITHUB_TOKEN"))} +\item{github_token}{github access token. +Default: kwb.pkgstatus:::get_github_token()} } \value{ data.frame with for all repositories of the user/organisation defined diff --git a/man/get_gitlab_repos.Rd b/man/get_gitlab_repos.Rd index 3f12f93..133cd13 100644 --- a/man/get_gitlab_repos.Rd +++ b/man/get_gitlab_repos.Rd @@ -4,12 +4,13 @@ \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")} -\item{gitlab_token}{gitlab access token (default: Sys.getenv("GITLAB_TOKEN"))} +\item{gitlab_token}{gitlab access token. +Default: kwb.pkgstatus:::get_gitlab_token()} } \value{ data.frame with for all repositories of the user/organisation defined diff --git a/man/get_names_of_r_packages_on_github.Rd b/man/get_names_of_r_packages_on_github.Rd new file mode 100644 index 0000000..0af00f3 --- /dev/null +++ b/man/get_names_of_r_packages_on_github.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_names_of_r_packages_on_github.R +\name{get_names_of_r_packages_on_github} +\alias{get_names_of_r_packages_on_github} +\title{Get Names of R Packages on GitHub} +\usage{ +get_names_of_r_packages_on_github( + group = "kwb-r", + public = TRUE, + private = TRUE, + dbg = TRUE +) +} +\arguments{ +\item{group}{name of organisation on GitHub, defaults to "kwb-r"} + +\item{public}{logical indicating whether private repositories are to be +considered. Default: \code{TRUE}} + +\item{private}{logical indicating whether public repositories are to be +considered. Default: \code{TRUE}} + +\item{dbg}{logical indicating whether or not to show debug messages} +} +\value{ +vector of character representing the names of the \code{public} + and/or \code{private} repositories (as requested), owned by the + organisation \code{groupt} on GitHub +} +\description{ +Get Names of R Packages on GitHub +} diff --git a/man/get_non_r_packages.Rd b/man/get_non_r_packages.Rd index a08980f..a0a8a16 100644 --- a/man/get_non_r_packages.Rd +++ b/man/get_non_r_packages.Rd @@ -2,15 +2,23 @@ % Please edit documentation in R/get_non_r_packages.R \name{get_non_r_packages} \alias{get_non_r_packages} -\title{Helper function: get_non_r_packages} +\title{Get Names of Repositories that Do not Represent R Packages} \usage{ -get_non_r_packages() +get_non_r_packages(hard_coded = TRUE) +} +\arguments{ +\item{hard_coded}{logical indicating whether or not to return the hard-coded +vector of package names. The default is \code{TRUE}. If \code{hard_coded} +is \code{FALSE} the names of repositories that are not assumed to represent +R packages are determined by looking into each repository. This may take a +while.} } \value{ -returns vector with KWB-R repos on Github, which are not R packages +This function returns a (alphabetically sorted) vector of names of + KWB-R repositories on Github that do not represent R packages } \description{ -Helper function: get_non_r_packages +Get Names of Repositories that Do not Represent R Packages } \examples{ get_non_r_packages() diff --git a/man/make_github_package_db.Rd b/man/make_github_package_db.Rd new file mode 100644 index 0000000..7767cdb --- /dev/null +++ b/man/make_github_package_db.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/make_github_package_db.R +\name{make_github_package_db} +\alias{make_github_package_db} +\title{Make Package Database for Packages on GitHub} +\usage{ +make_github_package_db(group = "kwb-r", dbg = TRUE) +} +\arguments{ +\item{group}{Name of GitHub organisation, defaults to "kwb-r"} + +\item{dbg}{logical indicating whether or not to show debug messages. +The default is \code{TRUE}} +} +\value{ +data frame with each column representing a field in the `DESCRIPTION` + file +} +\description{ +ready to be used in e.g. \code{\link[tools]{package_dependencies}} +} diff --git a/man/url_success.Rd b/man/url_success.Rd index 6c5a0cb..9444b78 100644 --- a/man/url_success.Rd +++ b/man/url_success.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/check_documentation.R +% Please edit documentation in R/helpers.R \name{url_success} \alias{url_success} \title{url_success} diff --git a/man/zen_collections.Rd b/man/zen_collections.Rd index 0fd0872..32de387 100644 --- a/man/zen_collections.Rd +++ b/man/zen_collections.Rd @@ -4,12 +4,13 @@ \alias{zen_collections} \title{Zenodo: get available collections} \usage{ -zen_collections(n = 1000, access_token = Sys.getenv("ZENODO_TOKEN")) +zen_collections(n = 1000, access_token = get_token("ZENODO")) } \arguments{ \item{n}{number of zenodo entries ("size") to return per API call (default: 1000)} -\item{access_token}{Zenodo access token (default: Sys.getenv("ZENODO_TOKEN"))} +\item{access_token}{Zenodo access token. +Default: kwb.pkgstatus:::get_token("ZENODO")} } \value{ a tibble of available Zenodo data diff --git a/vignettes/tutorial.Rmd b/vignettes/tutorial.Rmd index d7e8461..f664673 100644 --- a/vignettes/tutorial.Rmd +++ b/vignettes/tutorial.Rmd @@ -75,3 +75,31 @@ kwb.pkgstatus::create_report_rpackages(secrets_csv, ``` +# 3 Analyse public R packages on GitHub + +What public repositories on our GitHub account "KWB-R" represent R packages? + +```{r} +public_r_packages <- kwb.pkgstatus::get_names_of_r_packages_on_github( + group = "kwb-r", + private = FALSE +) +``` + +How to read all `DESCRIPTION` files of these R packages? + +```{r} +package_db <- kwb.pkgstatus::make_github_package_db(group = "kwb-r") +``` + +This package database can now be used in `tools::package_dependencies()` to +find out about package dependencies: + +```{r} +named_types <- stats::setNames(nm = c("Depends", "Imports", "Suggests")) + +lapply(named_types, function(which) { + tools::package_dependencies("kwb.utils", db = package_db, which = which)[[1L]] +}) +``` +