Merge pull request #17 from ropensci-review-tools/chaoss

chaoss metrics for #11

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", , "[email protected]", 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),

NAMESPACE

@@ -2,3 +2,4 @@
 
 export(ghist_dashboard)
 export(githist)
+importFrom(memoise,memoise)

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)
+}

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)

R/githist-package.R

@@ -1,4 +1,5 @@
 #' @keywords internal
+#' @importFrom memoise memoise
 #' @aliases githist-package
 "_PACKAGE"
 

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), ]

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)
+}

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,13 +217,19 @@
       },
       "sameAs": "https://CRAN.R-project.org/package=pbapply"
     },
-    "7": {
+    "9": {
       "@type": "SoftwareApplication",
       "identifier": "pkgstats",
       "name": "pkgstats",
       "sameAs": "https://github.com/ropensci-review-tools/pkgstats"
     },
     "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"
 }

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)
+}

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")

tests/testthat/cran_dl/cranlogs/goodpractice.json

@@ -0,0 +1,8 @@
+[
+    {
+        "start": "2023-10-03",
+        "end": "2024-01-01",
+        "downloads": 2308,
+        "package": "goodpractice"
+    }
+]

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)
+})

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)
+})

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)
 })