Merge pull request #33 from ropensci-review-tools/metrics

cm_metrics_num_contribs for #23

Author: mpadge

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: repometrics
 Title: Metrics for Your Code Repository
-Version: 0.1.1.077
+Version: 0.1.1.088
 Authors@R: 
     person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265"))

R/chaoss-external.R

@@ -132,6 +132,11 @@ cm_data_prs_from_gh_api_internal <- function (path, n_per_page = 30L) {
         }
     }
 
+    num_commits <- vapply (
+        pr_data,
+        function (i) length (i$commits$nodes),
+        integer (1L)
+    )
     commit_oids <- vapply (pr_data, function (i) {
         oids <- vapply (i$commits$nodes, function (j) {
             j$commit$oid
@@ -181,6 +186,7 @@ cm_data_prs_from_gh_api_internal <- function (path, n_per_page = 30L) {
         created_at = vapply (pr_data, function (i) i$createdAt, character (1L)),
         closed_at = vapply (pr_data, function (i) null2na_char (i$closedAt), character (1L)),
         updated_at = vapply (pr_data, function (i) i$updatedAt, character (1L)),
+        num_commits = num_commits,
         additions = vapply (pr_data, function (i) i$additions, integer (1L)),
         deletions = vapply (pr_data, function (i) i$deletions, integer (1L)),
         changed_files = vapply (pr_data, function (i) i$changedFiles, integer (1L)),

R/chaoss-hybrid.R

@@ -0,0 +1,51 @@
+#' Retrieve latest GitHub workflow results from Rest API
+#'
+#' This uses default of 30 most recent results.
+#' @noRd
+#'
+#'
+cm_data_gh_repo_workflow_internal <- function (path, n = 30L) {
+
+    or <- org_repo_from_path (path)
+
+    checkmate::assert_integer (n, lower = 1L)
+    u_wf <- gh_rest_api_endpoint (orgrepo = or, endpoint = "actions/runs")
+
+    req <- httr2::request (u_wf) |>
+        add_gh_token_to_req () |>
+        httr2::req_url_query (per_page = n)
+
+    resp <- httr2::req_perform (req)
+    httr2::resp_check_status (resp)
+
+    body <- httr2::resp_body_json (resp)
+    workflows <- body$workflow_runs
+
+    ids <- vapply (workflows, function (i) i$id, numeric (1L))
+    names <- vapply (workflows, function (i) i$name, character (1L))
+    shas <- vapply (workflows, function (i) i$head_sha, character (1L))
+    titles <- vapply (
+        workflows,
+        function (i) null2na_char (i$display_title),
+        character (1L)
+    )
+    status <- vapply (
+        workflows,
+        function (i) null2na_char (i$status),
+        character (1L)
+    )
+    conclusion <- vapply (workflows, function (i) null2na_char (i$conclusion), character (1L))
+    created <- vapply (workflows, function (i) i$created_at, character (1L))
+    created <- to_posix (created)
+
+    data.frame (
+        name = names,
+        id = ids,
+        sha = shas,
+        title = titles,
+        status = status,
+        conclusion = conclusion,
+        created = created
+    )
+}
+cm_data_gh_repo_workflow <- memoise::memoise (cm_data_gh_repo_workflow_internal)

R/chaoss-internal-ci.R

@@ -0,0 +1,27 @@
+#' Extract total CRAN downloads for nominated package over period defined by
+#' `options("repometrics_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
+cm_metric_cran_downloads <- function (pkg_name, end_date = Sys.Date ()) {
+
+    checkmate::assert_character (pkg_name, len = 1L)
+    checkmate::assert_date (end_date)
+    period <- get_repometrics_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/cm-data-gh-prs.R

@@ -0,0 +1,46 @@
+#' Return names of CI services from corresponding configuration files contained
+#' in local repo.
+#' @noRd
+repo_has_ci_files <- function (path) {
+
+    flist <- fs::dir_ls (path, type = "file", all = TRUE, recurse = TRUE)
+    ptns <- c (
+        "\\.appveyor\\.yml",
+        "\\.github\\/workflows",
+        "\\.gitlab\\-ci\\.yml",
+        "\\.circleci\\/config\\.yml",
+        "codefresh\\.yml",
+        "drone\\.yml",
+        "\\.travis\\.yml"
+    )
+    has_it <- vapply (ptns, function (i) any (grepl (i, flist)), logical (1L))
+    nms <- gsub ("\\\\.|\\\\.y.*$|\\\\/.*$|\\\\-.*$", "", ptns)
+
+    return (nms [which (has_it)])
+}
+
+has_gh_ci_tests <- function (path) {
+
+    ci_data <- cm_data_repo_from_gh_api (path)
+    h <- gert::git_log (repo = path, max = 1e6)
+    any (ci_data$sha %in% h$commit)
+}
+
+cm_metric_has_ci <- function (path) {
+
+    is_test_env <- Sys.getenv ("REPOMETRICS_TESTS") == "true"
+    has_ci <- ifelse (is_test_env, FALSE, has_gh_ci_tests (path))
+
+    if (!has_ci) {
+        ci_files <- repo_has_ci_files (path)
+        has_ci <- length (ci_files) > 0L
+        if (has_ci) {
+            cli::cli_alert_info (paste0 (
+                "Unable to determine whether runs are ",
+                "recent for CI service [{ci_files}]."
+            ))
+        }
+    }
+
+    return (has_ci)
+}

R/cm-data-gh-workflow.R

@@ -1,4 +1,4 @@
-cm_metrics_num_commits <- function (path, end_date = Sys.Date ()) {
+cm_metric_num_commits <- function (path, end_date = Sys.Date ()) {
 
     log <- git_log_in_period (path, end_date, get_repometrics_period ())
 

R/cm-metric-cran-downloads.R

@@ -1,4 +1,4 @@
-chaoss_internal_num_contributors <- function (path, end_date = Sys.Date ()) {
+cm_metric_num_contributors <- function (path, end_date = Sys.Date ()) {
 
     log <- git_log_in_period (path, end_date, get_repometrics_period ())
 

R/cm-metric-has-ci.R

@@ -12,21 +12,21 @@
 #' @return NA if no commits made in given period, otherwise the proportion of
 #' commits which came from merged branches.
 #' @noRd
-chaoss_internal_change_req <- function (path, end_date = Sys.Date ()) {
+cm_metric_change_req <- function (path, end_date = Sys.Date ()) {
 
     log <- git_log_in_period (path, end_date, get_repometrics_period ())
+    if (nrow (log) == 0) {
+        return (0)
+    }
+
     prs <- cm_data_prs_from_gh_api (path)
     prs <- prs [which (prs$merged), ]
     closed_dates <- as.Date (prs$closed_at)
     start_date <- end_date - get_repometrics_period ()
     index <- which (closed_dates >= start_date & closed_dates <= end_date)
     prs <- prs [index, ]
 
-    num_commits <- vapply (prs$commit_oids, function (i) {
-        length (strsplit (i, ",") [[1]])
-    }, integer (1L), USE.NAMES = FALSE)
-
-    res <- sum (num_commits) / nrow (log)
+    res <- sum (prs$num_commits) / nrow (log)
 
     return (res)
 }