diff --git a/DESCRIPTION b/DESCRIPTION index e58ad19..baf9e28 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: githist Title: Code analyses traced along the 'git' history of a package -Version: 0.1.0.038 +Version: 0.1.0.044 Authors@R: person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-2172-5265")) @@ -15,10 +15,13 @@ Imports: dplyr, fs, gert, + httr2, + memoise, pbapply, pkgstats Suggests: brio, + httptest2, lubridate, quarto, testthat (>= 3.0.0), diff --git a/NAMESPACE b/NAMESPACE index 582de9e..54dd7bd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,3 +2,4 @@ export(ghist_dashboard) export(githist) +importFrom(memoise,memoise) diff --git a/R/chaoss-metrics-external.R b/R/chaoss-metrics-external.R new file mode 100644 index 0000000..b6da335 --- /dev/null +++ b/R/chaoss-metrics-external.R @@ -0,0 +1,27 @@ +#' Extract total CRAN downloads for nominated package over period defined by +#' `options("githist_period")`. +#' +#' @param pkg_name Name of package. For packages not on CRAN, the 'cranlogs' +#' API returns download counts of 0. +#' @param end_date The date up to which download counts are to be aggregated. +#' @return A single integer counting the number of downloads. +#' @noRd +cran_downloads <- function (pkg_name, end_date = Sys.Date ()) { + + checkmate::assert_character (pkg_name, len = 1L) + checkmate::assert_date (end_date) + period <- get_githist_period () + start_date <- as.Date (end_date - period) + interval <- paste (start_date, sep = ":", end_date) + + base_url <- "http://cranlogs.r-pkg.org/" + daily_url <- paste0 (base_url, "downloads/total/") + req_url <- paste0 (daily_url, interval, "/", pkg_name) + + req <- httr2::request (req_url) + resp <- httr2::req_perform (req) + httr2::resp_check_status (resp) + + body <- httr2::resp_body_json (resp) + return (body [[1]]$downloads) +} diff --git a/R/chaoss-metrics-internal.R b/R/chaoss-metrics-internal.R new file mode 100644 index 0000000..2d62087 --- /dev/null +++ b/R/chaoss-metrics-internal.R @@ -0,0 +1,64 @@ +chaoss_internal_num_commits <- function (path, end_date = Sys.Date ()) { + + log <- git_log_in_period (path, end_date, get_githist_period ()) + + return (nrow (log)) +} + +chaoss_internal_num_contributors <- function (path, end_date = Sys.Date ()) { + + log <- git_log_in_period (path, end_date, get_githist_period ()) + + auths_un <- unique (log$author) + + # separate handles from emails: + emails <- regmatches (auths_un, gregexpr ("<.*>", auths_un)) + emails <- vapply (emails, function (i) { + ifelse (length (i) == 0L, "", gsub ("<|>", "", i)) + }, character (1L)) + handles <- gsub ("<.*$", "", auths_un) + + # Remove any duplicates of either, but excluding non-entries: + rm_dup_rows <- function (x) { + x <- gsub ("\\s+", "", x) + index <- seq_along (x) + index_out <- which (duplicated (x) & nzchar (x)) + if (length (index_out) > 0) { + index <- index [-(index_out)] + } + return (index) + } + index1 <- rm_dup_rows (handles) + index2 <- rm_dup_rows (emails) + + # Then extract only instances where neither handles nor emails are + # duplicated: + index_table <- table (c (index1, index2)) + index <- as.integer (names (index_table) [which (index_table == 2L)]) + + auths_un <- auths_un [index] + + return (length (auths_un)) +} + +git_log_in_period_internal <- function (path, end_date = Sys.Date (), period = 90) { + checkmate::assert_character (path, len = 1L) + checkmate::assert_directory (path) + checkmate::assert_date (end_date) + + h <- gert::git_log (repo = path, max = 1e6) + if (nrow (h) == 0) { + return (h) + } + dates <- as.Date (h$time) + today_minus_period <- as.Date (end_date - period) + index <- which (dates >= today_minus_period) + h <- h [index, ] + + if (dates [1] > end_date) { + h <- h [which (dates <= end_date), ] + } + + return (h) +} +git_log_in_period <- memoise::memoise (git_log_in_period_internal) diff --git a/R/githist-package.R b/R/githist-package.R index 424de2b..4a1e80a 100755 --- a/R/githist-package.R +++ b/R/githist-package.R @@ -1,4 +1,5 @@ #' @keywords internal +#' @importFrom memoise memoise #' @aliases githist-package "_PACKAGE" diff --git a/R/utils.R b/R/utils.R index 55293da..bc79413 100644 --- a/R/utils.R +++ b/R/utils.R @@ -28,6 +28,13 @@ set_num_cores <- function (num_cores) { return (num_cores) } +pkg_name_from_path <- function (path) { + desc <- fs::dir_ls (path, type = "file", regexp = "DESCRIPTION$") + checkmate::assert_file_exists (desc) + + unname (read.dcf (desc) [, "Package"]) +} + filter_git_hist <- function (h, n, step_days) { if (!is.null (n)) { h <- h [seq_len (n), ] diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 0000000..943c495 --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,22 @@ +# nocov start +.onLoad <- function (libname, pkgname) { # nolint + + op <- options () + + op.githist <- list ( + githist_period = 90 + ) + + toset <- !(names (op.githist) %in% names (op)) + if (any (toset)) { + options (op.githist [toset]) + } + invisible () +} +# nocov end + +get_githist_period <- function () { + period <- getOption ("githist_period") + checkmate::assert_int (period, lower = 1L) + return (period) +} diff --git a/codemeta.json b/codemeta.json index bd40416..9fa5a9c 100644 --- a/codemeta.json +++ b/codemeta.json @@ -8,7 +8,7 @@ "codeRepository": "https://github.com/ropensci-review-tools/githist", "issueTracker": "https://github.com/ropensci-review-tools/githist/issues", "license": "https://spdx.org/licenses/GPL-3.0", - "version": "0.1.0.038", + "version": "0.1.0.044", "programmingLanguage": { "@type": "ComputerLanguage", "name": "R", @@ -46,6 +46,30 @@ }, "sameAs": "https://CRAN.R-project.org/package=brio" }, + { + "@type": "SoftwareApplication", + "identifier": "httptest2", + "name": "httptest2", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=httptest2" + }, + { + "@type": "SoftwareApplication", + "identifier": "lubridate", + "name": "lubridate", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=lubridate" + }, { "@type": "SoftwareApplication", "identifier": "quarto", @@ -71,6 +95,18 @@ }, "sameAs": "https://CRAN.R-project.org/package=testthat" }, + { + "@type": "SoftwareApplication", + "identifier": "tidyr", + "name": "tidyr", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=tidyr" + }, { "@type": "SoftwareApplication", "identifier": "withr", @@ -146,6 +182,30 @@ "sameAs": "https://CRAN.R-project.org/package=gert" }, "6": { + "@type": "SoftwareApplication", + "identifier": "httr2", + "name": "httr2", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=httr2" + }, + "7": { + "@type": "SoftwareApplication", + "identifier": "memoise", + "name": "memoise", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=memoise" + }, + "8": { "@type": "SoftwareApplication", "identifier": "pbapply", "name": "pbapply", @@ -157,7 +217,7 @@ }, "sameAs": "https://CRAN.R-project.org/package=pbapply" }, - "7": { + "9": { "@type": "SoftwareApplication", "identifier": "pkgstats", "name": "pkgstats", @@ -165,5 +225,11 @@ }, "SystemRequirements": {} }, - "fileSize": "55.256KB" + "fileSize": "90.739KB", + "readme": "https://github.com/ropensci-review-tools/githist/blob/main/README.md", + "contIntegration": [ + "https://github.com/ropensci-review-tools/githist/actions?query=workflow%3AR-CMD-check", + "https://app.codecov.io/gh/ropensci-review-tools/githist" + ], + "developmentStatus": "https://www.repostatus.org/#active" } diff --git a/inst/httptest2/redact.R b/inst/httptest2/redact.R new file mode 100644 index 0000000..b83552b --- /dev/null +++ b/inst/httptest2/redact.R @@ -0,0 +1,20 @@ +function (resp) { + + resp <- httptest2::gsub_response ( + resp, + "http://cranlogs.r-pkg.org/downloads/total/", + "cranlogs/", + fixed = TRUE + ) + + # Timestamp pattern, where replacing with "" removes sub-dir: + ptn <- "[0-9]{4}\\-[0-9]{2}\\-[0-9]{2}" + resp <- httptest2::gsub_response ( + resp, + paste0 (ptn, "\\:", ptn), + "", + fixed = FALSE + ) + + return (resp) +} diff --git a/tests/testthat.R b/tests/testthat.R index 1e86f56..5beee00 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -7,6 +7,7 @@ # * https://testthat.r-lib.org/articles/special-files.html library (testthat) +library (httptest2) library (githist) test_check ("githist") diff --git a/tests/testthat/cran_dl/cranlogs/goodpractice.json b/tests/testthat/cran_dl/cranlogs/goodpractice.json new file mode 100644 index 0000000..5879939 --- /dev/null +++ b/tests/testthat/cran_dl/cranlogs/goodpractice.json @@ -0,0 +1,8 @@ +[ + { + "start": "2023-10-03", + "end": "2024-01-01", + "downloads": 2308, + "package": "goodpractice" + } +] diff --git a/tests/testthat/test-chaoss-metrics-external.R b/tests/testthat/test-chaoss-metrics-external.R new file mode 100644 index 0000000..5d59dbc --- /dev/null +++ b/tests/testthat/test-chaoss-metrics-external.R @@ -0,0 +1,22 @@ +test_that ("chaoss external util fns", { + pkg <- system.file ("extdata", "testpkg.zip", package = "githist") + flist <- unzip (pkg, exdir = fs::path_temp ()) + path <- fs::path_dir (flist [1]) + + pkg_name <- pkg_name_from_path (path) + expect_equal (pkg_name, "testpkg") + + fs::dir_delete (path) +}) + +test_that ("chaoss external cran_downloads", { + + pkg_name <- "goodpractice" + end_date <- as.Date ("2024-01-01") + dl <- with_mock_dir ("cran_dl", { + cran_downloads (pkg_name = pkg_name, end_date = end_date) + }) + expect_type (dl, "integer") + expect_length (dl, 1L) + expect_equal (dl, 2308) +}) diff --git a/tests/testthat/test-chaoss-metrics-internal.R b/tests/testthat/test-chaoss-metrics-internal.R new file mode 100644 index 0000000..2709319 --- /dev/null +++ b/tests/testthat/test-chaoss-metrics-internal.R @@ -0,0 +1,13 @@ +test_that ("chaoss internal num_commits", { + pkg <- system.file ("extdata", "testpkg.zip", package = "githist") + flist <- unzip (pkg, exdir = fs::path_temp ()) + path <- fs::path_dir (flist [1]) + + n <- chaoss_internal_num_commits (path, end_date = as.Date ("2024-08-01")) + expect_equal (n, 4L) + + n <- chaoss_internal_num_contributors (path, end_date = as.Date ("2024-08-01")) + expect_equal (n, 1L) + + fs::dir_delete (path) +}) diff --git a/tests/testthat/test-testpkg.R b/tests/testthat/test-testpkg.R index 47cc89c..2ab34d7 100644 --- a/tests/testthat/test-testpkg.R +++ b/tests/testthat/test-testpkg.R @@ -47,4 +47,13 @@ test_that ("githist parameters", { length (res2$desc_dat$date), length (unique (res2$desc_data$date)) ) + + # Finally, test step_days > 1, which has no effect anyway, as all commits + # are on same day + flist <- unzip (pkg, exdir = fs::path_temp ()) + res3 <- githist (path, n = 2L, step_days = 2L, num_cores = 1L) + fs::dir_delete (path) + + n3 <- vapply (res3, nrow, integer (1L)) + expect_equal (n2, n3) })