Merge pull request #38 from ropensci-review-tools/forks

add cm-metric-num-forks for #11

Author: mpadge

DESCRIPTION

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

R/cm-data-gh-forks.R

@@ -0,0 +1,67 @@
+gh_forks_qry <- function (org = "ropensci-review-tools",
+                          repo = "repometrics",
+                          n_per_page = 100L,
+                          end_cursor = NULL) {
+
+    checkmate::assert_integerish (n_per_page)
+
+    after_txt <- ""
+    if (!is.null (end_cursor)) {
+        after_txt <- paste0 (", after:\"", end_cursor, "\"")
+    }
+
+    q <- paste0 ("{
+        repository(owner:\"", org, "\", name:\"", repo, "\") {
+            forks (first: ", n_per_page, after_txt, ") {
+                pageInfo {
+                    hasNextPage
+                    endCursor
+                }
+                nodes {
+                    createdAt
+                    nameWithOwner
+                    url
+                }
+            }
+        }
+    }")
+
+    return (q)
+}
+
+cm_data_repo_forks <- function (path, n_per_page = 100L) {
+
+    is_test_env <- Sys.getenv ("REPOMETRICS_TESTS") == "true"
+    n_per_page <- n_per_page_in_tests (n_per_page)
+
+    or <- org_repo_from_path (path)
+    end_cursor <- fork_data <- NULL
+    has_next_page <- TRUE
+
+    while (has_next_page) {
+
+        q <- gh_forks_qry (
+            org = or [1],
+            repo = or [2],
+            end_cursor = end_cursor,
+            n_per_page = n_per_page
+        )
+        dat <- gh::gh_gql (query = q)
+
+        fork_data <- c (fork_data, dat$data$repository$forks$nodes)
+
+        has_next_page <- dat$data$repository$forks$pageInfo$hasNextPage
+        end_cursor <- dat$data$repository$forks$pageInfo$endCursor
+        if (is_test_env) {
+            has_next_page <- FALSE
+        }
+    }
+
+    org_repo <- vapply (fork_data, function (i) i$nameWithOwner, character (1L))
+    created <- vapply (fork_data, function (i) i$createdAt, character (1L))
+
+    data.frame (
+        org_repo = org_repo,
+        created = as.Date (created)
+    )
+}

R/cm-metric-num-forks.R

@@ -0,0 +1,9 @@
+cm_metric_num_forks <- function (path, end_date = Sys.Date ()) {
+
+    forks <- cm_data_repo_forks (path)
+
+    start_date <- end_date - get_repometrics_period ()
+    index <- which (forks$created >= start_date & forks$created <= end_date)
+
+    return (c (num_in_period = length (index), num_total = nrow (forks)))
+}

codemeta.json

@@ -8,7 +8,7 @@
   "codeRepository": "https://github.com/ropensci-review-tools/repometrics",
   "issueTracker": "https://github.com/ropensci-review-tools/repometrics/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.1.1.110",
+  "version": "0.1.1.114",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",

tests/testthat/gh_api_forks/api.github.com/graphql-c66722-POST.json

@@ -0,0 +1,24 @@
+{
+    "data": {
+        "repository": {
+            "forks": {
+                "pageInfo": {
+                    "hasNextPage": true,
+                    "endCursor": "Y3Vyc29yOnYyOpHOBDjiGQ=="
+                },
+                "nodes": [
+                    {
+                        "createdAt": "2016-08-17T17:52:57Z",
+                        "nameWithOwner": "richelbilderbeek/goodpractice",
+                        "url": "https://github.com/richelbilderbeek/goodpractice"
+                    },
+                    {
+                        "createdAt": "2016-10-13T18:37:09Z",
+                        "nameWithOwner": "jlehtoma/goodpractice",
+                        "url": "https://github.com/jlehtoma/goodpractice"
+                    }
+                ]
+            }
+        }
+    }
+}

tests/testthat/helper-cm-data.R

@@ -14,6 +14,9 @@ mock_cm_data <- function () {
     repo <- httptest2::with_mock_dir ("gh_api_repo", {
         cm_data_repo_from_gh_api (path)
     })
+    forks <- httptest2::with_mock_dir ("gh_api_forks", {
+        cm_data_repo_forks (path)
+    })
     issues <- httptest2::with_mock_dir ("gh_api_issues", {
         cm_data_issues_from_gh_api (path)
     })

tests/testthat/test-cm-data.R

@@ -9,12 +9,12 @@ test_that ("cm data full", {
     fs::dir_delete (path)
 
     expect_type (dat, "list")
-    expect_length (dat, 11L)
+    expect_length (dat, 12L)
     nms <- c (
         "contribs_from_gh_api", "contribs_from_log", "dependencies",
         "gh_repo_workflow", "gitlog", "issue_comments_from_gh_api",
         "issues_from_gh_api", "libyears", "prs_from_gh_api",
-        "releases_from_gh_api", "repo_from_gh_api"
+        "releases_from_gh_api", "repo_forks", "repo_from_gh_api"
     )
     expect_equal (names (dat), nms)
 

tests/testthat/test-cm-metrics.R

@@ -130,3 +130,18 @@ test_that ("cm metrics pr-reviews", {
     )
     expect_equal (names (revs), nms)
 })
+
+test_that ("cm metrics num forks", {
+
+    Sys.setenv ("REPOMETRICS_TESTS" = "true")
+    mock_cm_data ()
+    path <- generate_test_pkg ()
+    forks <- cm_metric_num_forks (path, end_date = end_date)
+    fs::dir_delete (path)
+
+    expect_type (forks, "integer")
+    expect_length (forks, 2L)
+    expect_named (forks)
+    expect_equal (names (forks), c ("num_in_period", "num_total"))
+    expect_true (forks [["num_total"]] > 0)
+})