Merge pull request #55 from ropensci-review-tools/user

mpadge · web-flow · commit 5380fbc5fdb0 · 2024-12-10T12:19:31.000+01:00
rearrange rm user fns to all accept same params
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: repometrics
 Title: Metrics for Your Code Repository
-Version: 0.1.2.059
+Version: 0.1.3.003
 Authors@R: 
     person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265"))
diff --git a/R/data-gh-user.R b/R/data-gh-user.R
@@ -1,3 +1,6 @@
+# All functions accept same parameters, even through not all parameters are
+# used in all functions.
+
 gh_user_general_qry <- function (login = "") {
 
     q <- paste0 ("{
@@ -36,7 +39,11 @@ gh_user_general_qry <- function (login = "") {
     return (q)
 }
 
-gh_user_general_internal <- function (login = "") {
+# Only uses `login` param:
+gh_user_general_internal <- function (login = "",
+                                      ended_at = Sys.time (),
+                                      nyears = 1,
+                                      n_per_page = 100L) {
 
     q <- gh_user_general_qry (login = login)
     dat <- gh::gh_gql (query = q)
@@ -90,6 +97,7 @@ gh_user_general_internal <- function (login = "") {
 gh_user_general <- memoise::memoise (gh_user_general_internal)
 
 #' Query for both followers and following
+#'
 #' @noRd
 gh_user_follow_qry <- function (login = "",
                                 followers = TRUE,
@@ -124,7 +132,12 @@ gh_user_follow_qry <- function (login = "",
     return (q)
 }
 
-gh_user_follow_internal <- function (login, followers = TRUE, n_per_page = 100L) {
+# Uses all parameters except `ended_at` at `nyears`.
+gh_user_follow_internal <- function (login,
+                                     ended_at = Sys.time (),
+                                     nyears = 1,
+                                     n_per_page = 100L,
+                                     followers = TRUE) {
 
     is_test_env <- Sys.getenv ("REPOMETRICS_TESTS") == "true"
     n_per_page <- n_per_page_in_tests (n_per_page)
@@ -197,7 +210,11 @@ gh_user_commit_cmt_qry <- function (login = "",
     return (q)
 }
 
-gh_user_commit_cmt_internal <- function (login, n_per_page = 100L) {
+# Uses all params except `ended_at` and `nyears`:
+gh_user_commit_cmt_internal <- function (login,
+                                         ended_at = Sys.time (),
+                                         nyears = 1,
+                                         n_per_page = 100L) {
 
     is_test_env <- Sys.getenv ("REPOMETRICS_TESTS") == "true"
     n_per_page <- n_per_page_in_tests (n_per_page)
@@ -251,6 +268,8 @@ gh_user_commit_cmt <- memoise::memoise (gh_user_commit_cmt_internal)
 
 # These are aggregated per repository, so no page cursors needed. Only
 # restriction is maxRepositories, but that also does not allow further paging.
+#
+# Uses all parameters
 gh_user_commits_qry <- function (login = "",
                                  ended_at = Sys.time (),
                                  nyears = 1,
@@ -326,6 +345,7 @@ gh_user_commits_internal <- function (login,
 }
 gh_user_commits <- memoise::memoise (gh_user_commits_internal)
 
+# Uses all parameters
 gh_user_issues_qry <- function (login = "",
                                 ended_at = Sys.time (),
                                 nyears = 1,
@@ -390,6 +410,7 @@ gh_user_issues_qry <- function (login = "",
     return (q)
 }
 
+# Uses all parameters
 gh_user_issues_internal <- function (login,
                                      ended_at = Sys.time (),
                                      nyears = 1,
@@ -545,7 +566,9 @@ gh_user_issue_cmts_qry <- function (login = "",
     return (q)
 }
 
+# Uses all parameters except `ended_at`
 gh_user_issue_cmts_internal <- function (login,
+                                         ended_at = Sys.time (),
                                          nyears = 1,
                                          n_per_page = 100L) {
 
diff --git a/R/data-user.R b/R/data-user.R
@@ -1,6 +1,12 @@
 #' Extract and combine all user data
 #'
 #' @param login GitHub login of user
+#' @param ended_at Parameter used in some aspects of resultant data to limit
+#' the end date of data collection. Defaults to `Sys.time()`.
+#' @param nyears Parameter <= 1 determining fraction of a year over which data
+#' up until `end_date` are collected.
+#' @param n_per_page Number of items per page to pass to GitHub GraphQL API
+#' requests. This should never need to be changed.
 #' @return A list of the following `data.frame` objects:
 #' \enumerate{
 #' \item `commit_cmt` with details of commits made on commits
@@ -12,23 +18,37 @@
 #' \item `issues` with information on all issues opened by user
 #' }
 #' @export
-rm_data_user <- function (login) {
+rm_data_user <- function (login,
+                          ended_at = Sys.time (),
+                          nyears = 1,
+                          n_per_page = 100) {
 
     checkmate::assert_character (login, len = 1L)
 
     data_fns <- get_rm_gh_user_fns ()
+    pars <- list (
+        login = login,
+        n_per_page = n_per_page,
+        ended_at = ended_at,
+        nyears = nyears
+    )
 
-    if (all_gh_user_fns_memoised (data_fns, login)) {
+    if (all_gh_user_fns_memoised (data_fns, pars)) {
         res <- lapply (data_fns, function (i) {
-            do.call (i, list (login = login))
+            do.call (i, pars)
         })
     } else {
         res <- pbapply::pblapply (data_fns, function (i) {
             do.call (i, list (login = login))
         })
     }
     names (res) <- gsub ("^gh\\_user\\_", "", data_fns)
-    gsub ("^gh\\_user\\_", "", data_fns)
+
+    names (res) <- gsub ("follow", "followers", names (res))
+    res$following <- do.call (gh_user_follow, c (pars, followers = FALSE))
+
+    i <- grep ("general", names (res))
+    res <- c (res [i], res [-i] [order (names (res) [-i])])
 
     return (res)
 }
@@ -42,10 +62,15 @@ get_rm_gh_user_fns <- function () {
     return (data_fns)
 }
 
-all_gh_user_fns_memoised <- function (data_fns, login) {
+all_gh_user_fns_memoised <- function (data_fns, pars) {
     is_memoised <- vapply (data_fns, function (i) {
         tryCatch (
-            memoise::has_cache (get (i)) (login),
+            memoise::has_cache (get (i)) (
+                login = pars$login,
+                n_per_page = pars$n_per_page,
+                ended_at = pars$ended_at,
+                nyears = pars$nyears
+            ),
             error = function (e) FALSE
         )
     }, logical (1L))
diff --git a/codemeta.json b/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.2.059",
+  "version": "0.1.3.003",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
@@ -237,7 +237,7 @@
     },
     "SystemRequirements": {}
   },
-  "fileSize": "834.886KB",
+  "fileSize": "1502.07KB",
   "readme": "https://github.com/ropensci-review-tools/repometrics/blob/main/README.md",
   "contIntegration": [
     "https://github.com/ropensci-review-tools/repometrics/actions?query=workflow%3AR-CMD-check",
diff --git a/man/rm_data_user.Rd b/man/rm_data_user.Rd
diff --git a/tests/testthat/gh_user_commit_cmt/api.github.com/graphql-93c966-POST.json b/tests/testthat/gh_user_commit_cmt/api.github.com/graphql-93c966-POST.json
@@ -16,7 +16,7 @@
                         "createdAt": "2016-07-31T20:32:28Z",
                         "repository": {
                             "url": "https://github.com/ropensci/osmplotr",
-                            "stargazerCount": 135
+                            "stargazerCount": 136
                         },
                         "url": "https://github.com/ropensci/osmplotr/commit/d6d8ea8281a24526926a15b5938ad600c339af18#commitcomment-18464847"
                     },
diff --git a/tests/testthat/helper-rm-data.R b/tests/testthat/helper-rm-data.R
@@ -42,26 +42,32 @@ mock_rm_data <- function (repo = TRUE) {
     # rm-data-user:
     login <- "mpadge"
     ended_at <- as.POSIXct ("2024-01-01T00:00:00")
+    pars <- list (
+        login = login,
+        n_per_page = 1,
+        ended_at = ended_at,
+        nyears = 1
+    )
     general <- httptest2::with_mock_dir ("gh_user_general", {
-        gh_user_general (login)
+        do.call (gh_user_general, pars)
     })
     followers <- httptest2::with_mock_dir ("gh_user_followers", {
-        gh_user_follow (login, followers = TRUE, n_per_page = 1)
+        do.call (gh_user_follow, c (pars, followers = TRUE))
     })
     following <- httptest2::with_mock_dir ("gh_user_following", {
-        gh_user_follow (login, followers = FALSE, n_per_page = 1)
+        do.call (gh_user_follow, c (pars, followers = FALSE))
     })
     user_commit_cmt <- httptest2::with_mock_dir ("gh_user_commit_cmt", {
-        gh_user_commit_cmt (login, n_per_page = 1)
+        do.call (gh_user_commit_cmt, pars)
     })
     user_commits <- httptest2::with_mock_dir ("gh_user_commits", {
-        gh_user_commits (login, n_per_page = 1, ended_at = ended_at)
+        do.call (gh_user_commits, pars)
     })
     user_issues <- httptest2::with_mock_dir ("gh_user_issues", {
-        gh_user_issues (login, n_per_page = 1, ended_at = ended_at)
+        do.call (gh_user_issues, pars)
     })
     user_issue_cmts <- httptest2::with_mock_dir ("gh_user_issue_cmts", {
-        gh_user_issue_cmts (login, n_per_page = 1)
+        do.call (gh_user_issue_cmts, pars)
     })
 
     # cran_downloads fn needs modified DESC:
@@ -86,26 +92,24 @@ mock_rm_data <- function (repo = TRUE) {
             res$contribs_from_gh_api
         )
     } else {
-        data_fns <- get_rm_gh_user_fns () # length = 6
+        data_fns <- get_rm_gh_user_fns ()
         pars <- list (
-            gh_user_general = list (login = login),
-            gh_user_followers =
-                list (login = login, followers = TRUE, n_per_page = 1),
-            gh_user_following =
-                list (login = login, followers = FALSE, n_per_page = 1),
-            gh_user_commit_cmt = list (login = login, n_per_page = 1),
-            gh_user_commits =
-                list (login = login, n_per_page = 1, ended_at = ended_at),
-            gh_user_issues =
-                list (login = login, n_per_page = 1, ended_at = ended_at),
-            gh_user_issue_cmts = list (login = login, n_per_page = 1)
-        ) # length = 7
+            login = login,
+            n_per_page = 1,
+            ended_at = ended_at,
+            nyears = 1
+        )
 
-        res <- lapply (seq_along (pars), function (i) {
-            fn_i <- gsub ("follow.*$", "follow", names (pars) [i])
-            do.call (fn_i, pars [[i]])
+        res <- lapply (data_fns, function (i) {
+            do.call (i, pars)
         })
-        names (res) <- gsub ("^gh\\_user\\_", "", names (pars))
+        names (res) <- gsub ("^gh\\_user\\_", "", data_fns)
+
+        names (res) <- gsub ("follow", "followers", names (res))
+        res$following <- do.call (gh_user_follow, c (pars, followers = FALSE))
+
+        i <- grep ("general", names (res))
+        res <- c (res [i], res [-i] [order (names (res) [-i])])
     }
 
     fs::dir_delete (path)
diff --git a/tests/testthat/test-rm-data-gh-user.R b/tests/testthat/test-rm-data-gh-user.R
@@ -1,13 +1,16 @@
 # Extends from 'cm-data-github.R' to test the user-specific data
 
-test_that ("cm data gh general", {
+test_that ("rm user data internal structures", {
 
     Sys.setenv ("REPOMETRICS_TESTS" = "true")
     dat <- mock_rm_data (repo = FALSE)
 
     expect_type (dat, "list")
     expect_length (dat, 7L)
-    nms <- c ("general", "followers", "following", "commit_cmt", "commits", "issues", "issue_cmts")
+    nms <- c (
+        "general", "commit_cmt", "commits", "followers", "following",
+        "issue_cmts", "issues"
+    )
     expect_named (dat, nms)
 
     expect_type (dat$general, "list")
@@ -65,3 +68,20 @@ test_that ("cm data gh general", {
     nms <- c ("org_repo", "issue_num", "created_at", "num_comments", "num_participants")
     expect_named (dat$issue_cmts, nms)
 })
+
+test_that ("rm_data_user fn", {
+
+    Sys.setenv ("REPOMETRICS_TESTS" = "true")
+    dat_mocked <- mock_rm_data (repo = FALSE)
+
+    login <- "mpadge"
+    ended_at <- as.POSIXct ("2024-01-01T00:00:00")
+
+    dat <- rm_data_user (
+        login = login,
+        n_per_page = 1,
+        ended_at = ended_at,
+        nyears = 1
+    )
+    expect_identical (dat, dat_mocked)
+})
diff --git a/tests/testthat/test-rm-data-git.R b/tests/testthat/test-rm-data-git.R
@@ -1,4 +1,4 @@
-test_that ("cm data git", {
+test_that ("rm data git", {
 
     path <- generate_test_pkg ()
 
@@ -33,7 +33,7 @@ skip_on_cran ()
 # triggered with `rm_data_libyears()`?
 skip_on_os ("mac")
 
-test_that ("cm data libyears", {
+test_that ("rm data libyears", {
 
     dat <- mock_rm_data ()
 
diff --git a/tests/testthat/test-rm-data-github.R b/tests/testthat/test-rm-data-github.R
diff --git a/tests/testthat/test-rm-data.R b/tests/testthat/test-rm-data.R
