diff --git a/DESCRIPTION b/DESCRIPTION index bea1d7f3..065628f3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: GitStats Title: Get Statistics from GitHub and GitLab -Version: 1.0.1.9000 +Version: 1.0.0.9005 Authors@R: c( person(given = "Maciej", family = "Banas", email = "banasmaciek@gmail.com", role = c("aut", "cre")), person(given = "Kamil", family = "Koziej", email = "koziej.k@gmail.com", role = "aut"), diff --git a/NAMESPACE b/NAMESPACE index d02bdd11..82df53a7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ S3method(gitstats_plot,commits_stats) S3method(gitstats_plot,repos_stats) export("%>%") export(create_gitstats) +export(get_R_package_usage) export(get_commits) export(get_commits_stats) export(get_files) @@ -12,6 +13,7 @@ export(get_repos) export(get_repos_stats) export(get_users) export(gitstats_plot) +export(pull_R_package_usage) export(pull_commits) export(pull_files) export(pull_repos) diff --git a/NEWS.md b/NEWS.md index 26b07aa8..2179e1fa 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,8 @@ -# GitStats 1.0.1.9000 +# GitStats 1.0.0.9005 ## Features: +- added `pull_R_package_usage()` function to pull repositories where package name is found in DESCRIPTION or NAMESPACE files or code blobs with phrases related to using an R package (`library(package)`, `package::`) ([#326](https://github.com/r-world-devs/GitStats/issues/326)), - added `pull_files()` with `get_files()` to pull content of text files ([#200](https://github.com/r-world-devs/GitStats/issues/200)), - added a `default_branch` column to repositories output as a consequence of [#200](https://github.com/r-world-devs/GitStats/issues/200). @@ -9,6 +10,10 @@ - fixed pulling responses when GitLab groups have private or empty content ([#314](https://github.com/r-world-devs/GitStats/issues/314). +## Minor changes: + +- rename column names for repository output - `id` to `repo_id` and `name` to `repo_name`. + # GitStats 1.0.0 ## Breaking changes: diff --git a/R/EngineGraphQL.R b/R/EngineGraphQL.R index d6dc0df8..a9107eff 100644 --- a/R/EngineGraphQL.R +++ b/R/EngineGraphQL.R @@ -29,11 +29,12 @@ EngineGraphQL <- R6::R6Class("EngineGraphQL", #' @param vars A list of named variables. #' @return A list. gql_response = function(gql_query, vars = "null") { - httr2::request(paste0(self$gql_api_url, "?")) %>% - httr2::req_headers("Authorization" = paste0("Bearer ", private$token)) %>% - httr2::req_body_json(list(query = gql_query, variables = vars)) %>% - httr2::req_perform() %>% - httr2::resp_body_json() + response <- private$perform_request( + gql_query = gql_query, + vars = vars + ) + response_list <- httr2::resp_body_json(response) + return(response_list) }, #' @description Get information on users in the form of table @@ -51,14 +52,17 @@ EngineGraphQL <- R6::R6Class("EngineGraphQL", #' an organization in a table format. #' @param org An organization. #' @param file_path A file path. + #' @param pulled_repos Optional parameter to pass repository output object. + #' @param settings A list of `GitStats` settings. #' @return A table. - pull_files = function(org, file_path) { + pull_files = function(org, file_path, pulled_repos = NULL) { if (!private$scan_all) { cli::cli_alert_info("[Engine:{cli::col_yellow('GraphQL')}][org:{org}] Pulling {file_path} files...") } files_table <- private$pull_file_from_org( org = org, - file_path = file_path + file_path = file_path, + pulled_repos = pulled_repos ) %>% private$prepare_files_table( org = org, @@ -75,6 +79,18 @@ EngineGraphQL <- R6::R6Class("EngineGraphQL", # @field A boolean. scan_all = FALSE, + perform_request = function(gql_query, vars) { + response <- httr2::request(paste0(self$gql_api_url, "?")) %>% + httr2::req_headers("Authorization" = paste0("Bearer ", private$token)) %>% + httr2::req_body_json(list(query = gql_query, variables = vars)) %>% + httr2::req_retry( + is_transient = ~ httr2::resp_status(.x) == "400|502", + max_seconds = 60 + ) %>% + httr2::req_perform() + return(response) + }, + # @description A method to pull information on user. # @param username A login. # @return A user response. diff --git a/R/EngineGraphQLGitHub.R b/R/EngineGraphQLGitHub.R index 186ab1af..7fa00676 100644 --- a/R/EngineGraphQLGitHub.R +++ b/R/EngineGraphQLGitHub.R @@ -51,7 +51,7 @@ EngineGraphQLGitHub <- R6::R6Class("EngineGraphQLGitHub", #' @param settings A list of `GitStats` settings. #' @return A table. pull_repos = function(org, - settings) { + settings) { if (settings$search_param %in% c("org", "team")) { if (settings$search_param == "org") { if (!private$scan_all) { @@ -89,7 +89,7 @@ EngineGraphQLGitHub <- R6::R6Class("EngineGraphQLGitHub", #' @param settings A list of `GitStats` settings. #' @return Nothing. pull_repos_supportive = function(org, - settings) { + settings) { NULL }, @@ -101,14 +101,14 @@ EngineGraphQLGitHub <- R6::R6Class("EngineGraphQLGitHub", #' @param settings A list of `GitStats` settings. #' @return A table of commits. pull_commits = function(org, - date_from, - date_until, - settings) { + date_from, + date_until, + settings) { repos_table <- self$pull_repos( org = org, settings = list(search_param = "org") ) - repos_names <- repos_table$name + repos_names <- repos_table$repo_name if (settings$search_param == "org") { if (!private$scan_all) { @@ -252,7 +252,11 @@ EngineGraphQLGitHub <- R6::R6Class("EngineGraphQLGitHub", prepare_repos_table = function(repos_list) { if (length(repos_list) > 0) { repos_table <- purrr::map_dfr(repos_list, function(repo) { - repo$default_branch <- repo$default_branch$name + repo$default_branch <- if(!is.null(repo$default_branch)) { + repo$default_branch$name + } else { + "" + } repo$languages <- purrr::map_chr(repo$languages$nodes, ~ .$name) %>% paste0(collapse = ", ") repo$created_at <- gts_to_posixt(repo$created_at) @@ -263,7 +267,7 @@ EngineGraphQLGitHub <- R6::R6Class("EngineGraphQLGitHub", repo <- data.frame(repo) %>% dplyr::relocate( default_branch, - .after = name + .after = repo_name ) }) } else { @@ -458,31 +462,43 @@ EngineGraphQLGitHub <- R6::R6Class("EngineGraphQLGitHub", return(user_table) }, - # @description Pull all given files from all repositories of an organization. + # @description Pull all given files from all repositories of an + # organization. # @param org An organization. # @param file_path Path to a file. + # @param pulled_repos Optional, if not empty, function will make use of the + # argument to iterate over it when pulling files. # @return A response in a list form. - pull_file_from_org = function(org, file_path) { - repos_list <- private$pull_repos_from_org( - from = "org", - org = org - ) - repositories <- purrr::map(repos_list, ~ .$name) - def_branches <- purrr::map(repos_list, ~ .$default_branch$name) - files_list <- purrr::map2(repositories, def_branches, function(repository, def_branch) { - files_query <- self$gql_query$files_by_repo() - files_response <- self$gql_response( - gql_query = files_query, - vars = list( - "org" = org, - "repo" = repository, - "file_path" = paste0(def_branch, ":", file_path) - ) + pull_file_from_org = function(org, file_path, pulled_repos = NULL) { + if (is.null(pulled_repos)) { + repos_list <- private$pull_repos_from_org( + from = "org", + org = org ) - }) %>% - purrr::map(~ .$data$repository) - names(files_list) <- repositories - files_list <- purrr::discard(files_list, ~ length(.$object) == 0) + repositories <- purrr::map(repos_list, ~ .$repo_name) + def_branches <- purrr::map(repos_list, ~ .$default_branch$name) + } else { + repositories <- pulled_repos$repo_name + def_branches <- pulled_repos$default_branch + } + files_list <- purrr::map(file_path, function(file_path) { + files_list <- purrr::map2(repositories, def_branches, function(repository, def_branch) { + files_query <- self$gql_query$files_by_repo() + files_response <- self$gql_response( + gql_query = files_query, + vars = list( + "org" = org, + "repo" = repository, + "file_path" = paste0(def_branch, ":", file_path) + ) + ) + }) %>% + purrr::map(~ .$data$repository) + names(files_list) <- repositories + files_list <- purrr::discard(files_list, ~ length(.$object) == 0) + return(files_list) + }) + names(files_list) <- file_path return(files_list) }, @@ -492,16 +508,20 @@ EngineGraphQLGitHub <- R6::R6Class("EngineGraphQLGitHub", # @return A table with information on files. prepare_files_table = function(files_response, org, file_path) { if (!is.null(files_response)) { - files_table <- purrr::imap(files_response, function(repository, name) { - data.frame( - "repository_name" = repository$name, - "repository_id" = repository$id, - "organization" = org, - "file_path" = file_path, - "file_content" = repository$object$text, - "file_size" = repository$object$byteSize, - "api_url" = self$gql_api_url - ) + files_table <- purrr::map(file_path, function(file) { + purrr::imap(files_response[[file]], function(repository, name) { + data.frame( + "repo_name" = repository$name, + "repo_id" = repository$id, + "organization" = org, + "file_path" = file, + "file_content" = repository$object$text, + "file_size" = repository$object$byteSize, + "repo_url" = repository$url, + "api_url" = self$gql_api_url + ) + }) %>% + purrr::list_rbind() }) %>% purrr::list_rbind() } else { diff --git a/R/EngineGraphQLGitLab.R b/R/EngineGraphQLGitLab.R index 006ee62e..f94301aa 100644 --- a/R/EngineGraphQLGitLab.R +++ b/R/EngineGraphQLGitLab.R @@ -54,7 +54,7 @@ EngineGraphQLGitLab <- R6::R6Class("EngineGraphQLGitLab", #' @param settings A list of `GitStats` settings. #' @return A table. pull_repos = function(org, - settings) { + settings) { org <- gsub("%2f", "/", org) if (settings$search_param == "org") { if (!private$scan_all) { @@ -76,7 +76,7 @@ EngineGraphQLGitLab <- R6::R6Class("EngineGraphQLGitLab", #' @param settings A list of `GitStats` settings. #' @return Nothing. pull_repos_supportive = function(org, - settings) { + settings) { NULL }, @@ -90,9 +90,9 @@ EngineGraphQLGitLab <- R6::R6Class("EngineGraphQLGitLab", #' @param settings A list of `GitStats` settings. #' @return A table of commits. pull_commits = function(org, - date_from, - date_until = Sys.date(), - settings) { + date_from, + date_until = Sys.date(), + settings) { NULL } @@ -191,7 +191,7 @@ EngineGraphQLGitLab <- R6::R6Class("EngineGraphQLGitLab", ) %>% dplyr::relocate( default_branch, - .after = name + .after = repo_name ) } else { repos_table <- NULL @@ -226,45 +226,75 @@ EngineGraphQLGitLab <- R6::R6Class("EngineGraphQLGitLab", # @description Pull all given files from all repositories of a group. # @param org An organization. # @param file_path Path to a file. + # @param pulled_repos Optional, if not empty, function will make use of the + # argument to iterate over it when pulling files. # @return A response in a list form. - pull_file_from_org = function(org, file_path) { - full_files_list <- list() - next_page <- TRUE - end_cursor <- "" - while (next_page) { - files_query <- self$gql_query$files_by_org( - end_cursor = end_cursor - ) + pull_file_from_org = function(org, file_path, pulled_repos = NULL) { + if (!is.null(pulled_repos)) { + full_files_list <- private$pull_file_from_repos( + file_path = file_path, + repos_table = pulled_repos + ) + } else { + full_files_list <- list() + next_page <- TRUE + end_cursor <- "" + while (next_page) { + files_query <- self$gql_query$files_by_org( + end_cursor = end_cursor + ) + files_response <- self$gql_response( + gql_query = files_query, + vars = list( + "org" = org, + "file_paths" = file_path + ) + ) + if (length(files_response$data$group) == 0) { + cli::cli_alert_danger("Empty") + } + projects <- files_response$data$group$projects + files_list <- purrr::map(projects$edges, function(edge) { + edge$node + }) %>% + purrr::discard(~ length(.$repository$blobs$nodes) == 0) + if (is.null(files_list)) files_list <- list() + if (length(files_list) > 0) { + next_page <- files_response$pageInfo$hasNextPage + } else { + next_page <- FALSE + } + if (is.null(next_page)) next_page <- FALSE + if (next_page) { + end_cursor <- files_response$pageInfo$endCursor + } else { + end_cursor <- "" + } + full_files_list <- append(full_files_list, files_list) + } + } + return(full_files_list) + }, + + # @description Pull all given files from given repositories. + # @param file_path Path to a file. + # @param repos_table Repositories table. + # @return A response in a list form. + pull_file_from_repos = function(file_path, repos_table) { + files_list <- purrr::map(repos_table$repo_url, function(repo_url) { + files_query <- self$gql_query$files_from_repo() files_response <- self$gql_response( gql_query = files_query, vars = list( - "org" = org, - "file_paths" = file_path + "file_paths" = file_path, + "project_path" = stringr::str_replace(repo_url, ".*(?<=.com/)", "") ) ) - if (length(files_response$data$group) == 0) { - cli::cli_abort("Empty") - } - projects <- files_response$data$group$projects - files_list <- purrr::map(projects$edges, function(edge) { - edge$node - }) %>% - purrr::discard(~ length(.$repository$blobs$nodes) == 0) - if (is.null(files_list)) files_list <- list() - if (length(files_list) > 0) { - next_page <- files_response$pageInfo$hasNextPage - } else { - next_page <- FALSE - } - if (is.null(next_page)) next_page <- FALSE - if (next_page) { - end_cursor <- files_response$pageInfo$endCursor - } else { - end_cursor <- "" - } - full_files_list <- append(full_files_list, files_list) - } - return(full_files_list) + return(files_response) + }) %>% + purrr::discard(~ length(.$data$project$repository$blobs$nodes) == 0) %>% + purrr::map(~ .$data$project) + return(files_list) }, # @description Prepare files table. @@ -275,12 +305,13 @@ EngineGraphQLGitLab <- R6::R6Class("EngineGraphQLGitLab", if (!is.null(files_response)) { files_table <- purrr::map(files_response, function(project) { data.frame( - "repository_name" = project$name, - "repository_id" = project$id, + "repo_name" = project$name, + "repo_id" = project$id, "organization" = org, "file_path" = project$repository$blobs$nodes[[1]]$name, "file_content" = project$repository$blobs$nodes[[1]]$rawBlob, "file_size" = as.integer(project$repository$blobs$nodes[[1]]$size), + "repo_url" = project$webUrl, "api_url" = self$gql_api_url ) }) %>% diff --git a/R/EngineRest.R b/R/EngineRest.R index bedaadf9..b3b9a7a9 100644 --- a/R/EngineRest.R +++ b/R/EngineRest.R @@ -107,7 +107,7 @@ EngineRest <- R6::R6Class("EngineRest", if (length(repos_dt) > 0) { repos_dt <- dplyr::mutate(repos_dt, - id = as.character(id), + repo_id = as.character(repo_id), created_at = as.POSIXct(created_at), last_activity_at = as.POSIXct(last_activity_at), forks = as.integer(forks), @@ -123,71 +123,41 @@ EngineRest <- R6::R6Class("EngineRest", # @param token An API token. # @returns A request. perform_request = function(endpoint, token) { - tryCatch( - { - resp <- private$build_request(endpoint, token) %>% + resp <- NULL + tryCatch({ + resp <- httr2::request(endpoint) %>% + httr2::req_headers("Authorization" = paste0("Bearer ", token)) %>% + httr2::req_error(is_error = function(resp) FALSE) %>% httr2::req_perform() + if (!private$scan_all) { + if (resp$status == 401) { + message("HTTP 401 Unauthorized.") + } + if (resp$status == 404) { + message("HTTP 404 No such address") + } + } + if (resp$status %in% c(400, 403)) { + resp <- httr2::request(endpoint) %>% + httr2::req_headers("Authorization" = paste0("Bearer ", token)) %>% + httr2::req_retry( + is_transient = ~ httr2::resp_status(.x) %in% c(400, 403), + max_seconds = 60 + ) %>% + httr2::req_perform() + } }, error = function(e) { - if (!is.null(e$status)) { - if (!private$scan_all) { - if (e$status == 400) { - message("HTTP 400 Bad Request.") - } else if (e$status == 401) { - message("HTTP 401 Unauthorized.") - } else if (e$status == 403) { - message("HTTP 403 API limit reached.") - } else if (e$status == 404) { - message("HTTP 404 No such address") - } - } - } else if (grepl("Could not resolve host", e)) { + cli::cli_alert_danger(e$message) + if (!is.null(e$parent$message)) { cli::cli_abort(c( - "Could not resolve host {endpoint}", + e$parent$message, "x" = "'GitStats' object will not be created." )) } - resp <<- NULL } ) return(resp) - }, - - # @description A wrapper for httr2 functions to prepare get request to REST API endpoint. - # @param endpoint An API endpoint. - # @param token An API token. - # @returns A request. - build_request = function(endpoint, token) { - httr2::request(endpoint) %>% - httr2::req_headers("Authorization" = paste0("Bearer ", token)) %>% - httr2::req_error(body = private$resp_error_body) %>% - httr2::req_retry( - is_transient = private$resp_is_transient, - after = private$req_after - ) - }, - - # @description Handler for rate-limit error (403 on GitHub). - resp_is_transient = function(resp) { - httr2::resp_status(resp) == 403 && - httr2::resp_header(resp, "X-RateLimit-Remaining") == "0" - }, - - # @description Handler for rate-limit error (403 on GitHub). - req_after = function(resp) { - time <- as.numeric(httr2::resp_header(resp, "X-RateLimit-Reset")) - time - unclass(Sys.time()) - }, - - # @description Handler for rate-limit error (403 on GitHub). - resp_error_body = function(resp) { - body <- httr2::resp_body_json(resp) - - message <- body$message - if (!is.null(body$documentation_url)) { - message <- c(message, paste0("See docs at <", body$documentation_url, ">")) - } - message } ) ) diff --git a/R/EngineRestGitHub.R b/R/EngineRestGitHub.R index 74fff3fe..cdb3a656 100644 --- a/R/EngineRestGitHub.R +++ b/R/EngineRestGitHub.R @@ -10,7 +10,7 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", #' @param settings A list of `GitStats` settings. #' @return Table of repositories. pull_repos = function(org, - settings) { + settings) { if (settings$search_param == "phrase") { if (!private$scan_all) { cli::cli_alert_info("[GitHub][Engine:{cli::col_green('REST')}][phrase:{settings$phrase}][org:{org}] Searching repositories...") @@ -35,7 +35,7 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", #' @param settings A list of `GitStats` settings. #' @return A table of repositories. pull_repos_supportive = function(org, - settings) { + settings) { repos_table <- NULL if (settings$search_param %in% c("org")) { if (!private$scan_all) { @@ -61,9 +61,9 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", #' @param settings A list of `GitStats` settings. #' @return A table of commits. pull_commits = function(org, - date_from, - date_until = Sys.date(), - settings) { + date_from, + date_until = Sys.date(), + settings) { NULL }, @@ -74,9 +74,9 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", #' @param settings A list of `GitStats` settings. #' @return A table of commits. pull_commits_supportive = function(org, - date_from, - date_until = Sys.date(), - settings) { + date_from, + date_until = Sys.date(), + settings) { repos_table <- self$pull_repos_supportive( org = org, settings = list(search_param = "org") @@ -116,7 +116,7 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", if (!private$scan_all) { cli::cli_alert_info("[GitHub][Engine:{cli::col_green('REST')}][org:{unique(repos_table$organization)}] Pulling contributors...") } - repo_iterator <- paste0(repos_table$organization, "/", repos_table$name) + repo_iterator <- paste0(repos_table$organization, "/", repos_table$repo_name) user_name <- rlang::expr(.$login) repos_table$contributors <- purrr::map_chr(repo_iterator, function(repos_id) { contributors_endpoint <- paste0(self$rest_api_url, "/repos/", repos_id, "/contributors") @@ -195,19 +195,17 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", org, language, byte_max = "384000") { - org_url <- if (!private$scan_all) { - paste0("'+user:", org) + user_query <- if (!private$scan_all) { + paste0('+user:', org) } else { - "" + '' } - search_endpoint <- if (language != "All") { - paste0(self$rest_api_url, "/search/code?q='", phrase, org_url, "+language:", language) - } else { - paste0(self$rest_api_url, "/search/code?q='", phrase, org_url) + query <- paste0('"', phrase, '"', user_query) + if (language != "All") { + query <- paste0(query, '+language:', language) } - + search_endpoint <- paste0(self$rest_api_url, '/search/code?q=', query) total_n <- self$response(search_endpoint)[["total_count"]] - if (length(total_n) > 0) { repos_list <- private$search_response( search_endpoint = search_endpoint, @@ -218,7 +216,6 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", } else { repos_list <- list() } - return(repos_list) }, @@ -232,28 +229,25 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", byte_max) { if (total_n >= 0 & total_n < 1e3) { resp_list <- list() - for (page in 1:(total_n %/% 100)) { resp_list <- self$response( paste0(search_endpoint, "+size:0..", byte_max, "&page=", page, "&per_page=100") )[["items"]] %>% append(resp_list, .) } - resp_list } else if (total_n >= 1e3) { resp_list <- list() index <- c(0, 50) - spinner <- cli::make_spinner( - template = cli::col_grey("GitHub search limit (1000 results) exceeded. Results will be divided. {spin}") + which = "timeTravel", + template = cli::col_grey( + "GitHub search limit (1000 results) exceeded. Results will be divided. {spin}" + ) ) - while (index[2] < as.numeric(byte_max)) { size_formula <- paste0("+size:", as.character(index[1]), "..", as.character(index[2])) - spinner$spin() - n_count <- tryCatch( { self$response(paste0(search_endpoint, size_formula))[["total_count"]] @@ -262,7 +256,6 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", NULL } ) - if (is.null(n_count)) { NULL } else if ((n_count - 1) %/% 100 > 0) { @@ -273,9 +266,7 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", resp_list <- self$response(paste0(search_endpoint, size_formula, "&page=1&per_page=100"))[["items"]] %>% append(resp_list, .) } - index[1] <- index[2] - if (index[2] < 1e3) { index[2] <- index[2] + 50 } @@ -300,8 +291,8 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", tailor_repos_info = function(repos_list) { repos_list <- purrr::map(repos_list, function(repo) { list( - "id" = repo$id, - "name" = repo$name, + "repo_id" = repo$id, + "repo_name" = repo$name, "default_branch" = repo$default_branch, "stars" = repo$stargazers_count, "forks" = repo$forks_count, @@ -322,7 +313,7 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", # @return A table of repositories with added information on issues. pull_repos_issues = function(repos_table) { if (nrow(repos_table) > 0) { - repos_iterator <- paste0(repos_table$organization, "/", repos_table$name) + repos_iterator <- paste0(repos_table$organization, "/", repos_table$repo_name) issues <- purrr::map_dfr(repos_iterator, function(repo_path) { issues_endpoint <- paste0(self$rest_api_url, "/repos/", repo_path, "/issues") @@ -363,8 +354,8 @@ EngineRestGitHub <- R6::R6Class("EngineRestGitHub", pull_commits_from_org = function(repos_table, date_from, date_until) { - repos_names <- repos_table$name - repo_fullnames <- paste0(repos_table$organization, "/", repos_table$name) + repos_names <- repos_table$repo_name + repo_fullnames <- paste0(repos_table$organization, "/", repos_table$repo_name) repos_list_with_commits <- purrr::map(repo_fullnames, function(repo_fullname) { commits_from_repo <- private$pull_commits_from_repo( diff --git a/R/EngineRestGitLab.R b/R/EngineRestGitLab.R index ef8baf7f..1306336d 100644 --- a/R/EngineRestGitLab.R +++ b/R/EngineRestGitLab.R @@ -11,7 +11,7 @@ EngineRestGitLab <- R6::R6Class("EngineRestGitLab", #' @param settings A list of `GitStats` settings. #' @return A table. pull_repos = function(org, - settings) { + settings) { if (settings$search_param == "phrase") { if (!private$scan_all) { cli::cli_alert_info("[GitLab][Engine:{cli::col_green('REST')}][phrase:{settings$phrase}][org:{gsub('%2f', '/', org)}] Searching repositories...") @@ -50,7 +50,7 @@ EngineRestGitLab <- R6::R6Class("EngineRestGitLab", #' @param settings A list of `GitStats` settings. #' @return Nothing. pull_repos_supportive = function(org, - settings) { + settings) { repos_table <- NULL if (settings$search_param == "org") { if (!private$scan_all) { @@ -73,7 +73,7 @@ EngineRestGitLab <- R6::R6Class("EngineRestGitLab", if (!private$scan_all) { cli::cli_alert_info("[GitLab][Engine:{cli::col_green('REST')}][org:{unique(repos_table$organization)}] Pulling contributors...") } - repo_iterator <- repos_table$id + repo_iterator <- repos_table$repo_id user_name <- rlang::expr(.$name) repos_table$contributors <- purrr::map_chr(repo_iterator, function(repos_id) { id <- gsub("gid://gitlab/Project/", "", repos_id) @@ -103,9 +103,9 @@ EngineRestGitLab <- R6::R6Class("EngineRestGitLab", #' @param settings A list of `GitStats` settings. #' @return A table of commits. pull_commits = function(org, - date_from, - date_until = Sys.date(), - settings) { + date_from, + date_until = Sys.date(), + settings) { repos_table <- self$pull_repos_supportive( org = org, settings = list(search_param = "org") @@ -194,21 +194,21 @@ EngineRestGitLab <- R6::R6Class("EngineRestGitLab", # @return A list of repositories. search_repos_by_phrase = function(phrase, org, - language, + language = "All", page_max = 1e6) { page <- 1 still_more_hits <- TRUE resp_list <- list() groups_url <- if (!private$scan_all) { - paste0("/groups/", private$get_group_id(org)) + paste0('/groups/', private$get_group_id(org)) } else { - "" + '' } while (still_more_hits | page < page_max) { resp <- self$response( paste0( self$rest_api_url, groups_url, - "/search?scope=blobs&search=", phrase, "&per_page=100&page=", page + '/search?scope=blobs&search="', phrase, '"&per_page=100&page=', page ) ) @@ -220,11 +220,9 @@ EngineRestGitLab <- R6::R6Class("EngineRestGitLab", page <- page + 1 } } - repos_list <- resp_list %>% private$find_repos_by_id() %>% private$pull_repos_languages() - return(repos_list) }, @@ -261,8 +259,8 @@ EngineRestGitLab <- R6::R6Class("EngineRestGitLab", tailor_repos_info = function(projects_list) { projects_list <- purrr::map(projects_list, function(project) { list( - "id" = project$id, - "name" = project$name, + "repo_id" = project$id, + "repo_name" = project$name, "default_branch" = project$default_branch, "stars" = project$star_count, "forks" = project$fork_count, @@ -283,7 +281,7 @@ EngineRestGitLab <- R6::R6Class("EngineRestGitLab", # @return A table of repositories with added information on issues. pull_repos_issues = function(repos_table) { if (nrow(repos_table) > 0) { - issues <- purrr::map(repos_table$id, function(repos_id) { + issues <- purrr::map(repos_table$repo_id, function(repos_id) { id <- gsub("gid://gitlab/Project/", "", repos_id) issues_endpoint <- paste0(self$rest_api_url, "/projects/", id, "/issues_statistics") @@ -326,8 +324,8 @@ EngineRestGitLab <- R6::R6Class("EngineRestGitLab", pull_commits_from_org = function(repos_table, date_from, date_until) { - repos_names <- repos_table$name - projects_ids <- gsub("gid://gitlab/Project/", "", repos_table$id) + repos_names <- repos_table$repo_name + projects_ids <- gsub("gid://gitlab/Project/", "", repos_table$repo_id) repos_list_with_commits <- purrr::map(projects_ids, function(project_id) { commits_from_repo <- private$pull_commits_from_repo( diff --git a/R/GQLQueryGitHub.R b/R/GQLQueryGitHub.R index a5ec1fb5..28931f1a 100644 --- a/R/GQLQueryGitHub.R +++ b/R/GQLQueryGitHub.R @@ -170,6 +170,7 @@ GQLQueryGitHub <- R6::R6Class("GQLQueryGitHub", repository(owner: $org, name: $repo) { id name + url object(expression: $file_path) { ... on Blob { text @@ -203,8 +204,8 @@ GQLQueryGitHub <- R6::R6Class("GQLQueryGitHub", hasNextPage } nodes { - id - name + repo_id: id + repo_name: name default_branch: defaultBranchRef { name } diff --git a/R/GQLQueryGitLab.R b/R/GQLQueryGitLab.R index e3e8bfa9..21dfeaa4 100644 --- a/R/GQLQueryGitLab.R +++ b/R/GQLQueryGitLab.R @@ -42,8 +42,8 @@ GQLQueryGitLab <- R6::R6Class("GQLQueryGitLab", } edges { node { - id - name + repo_id: id + repo_name: name ... on Project { repository { rootRef @@ -124,6 +124,7 @@ GQLQueryGitLab <- R6::R6Class("GQLQueryGitLab", node { name id + webUrl repository { blobs(paths: $file_paths) { nodes { @@ -139,6 +140,28 @@ GQLQueryGitLab <- R6::R6Class("GQLQueryGitLab", } }' ) + }, + + #' @description Prepare query to get files in a standard filepath from + #' GitLab repositories. + #' @return A query. + files_from_repo = function(){ + 'query GetFilesFromRepo($file_paths: [String!]!, $project_path: ID!) { + project(fullPath: $project_path) { + name + id + webUrl + repository { + blobs(paths: $file_paths) { + nodes { + name + rawBlob + size + } + } + } + } + }' } ) ) diff --git a/R/GitHost.R b/R/GitHost.R index 72b01b28..84ca39b6 100644 --- a/R/GitHost.R +++ b/R/GitHost.R @@ -170,15 +170,18 @@ GitHost <- R6::R6Class("GitHost", #' @description A method to retrieve given files from all repositories for #' a host in a table format. #' @param file_path A file path. + #' @param pulled_repos Optional parameter to pass repository output object. #' @return A table. - pull_files = function(file_path) { + pull_files = function(file_path, pulled_repos = NULL) { files_table <- purrr::map(private$orgs, function(org) { repos_table <- purrr::map(private$engines, function(engine) { if (inherits(engine, "EngineGraphQL")) { - engine$pull_files( + files_table <- engine$pull_files( org = org, - file_path = file_path + file_path = file_path, + pulled_repos = pulled_repos ) + return(files_table) } else { NULL } @@ -330,9 +333,10 @@ GitHost <- R6::R6Class("GitHost", pull_repos_from_orgs = function(settings) { orgs <- private$orgs if (private$scan_all) { - cli::cli_alert_info("[Host:{private$host}] {cli::col_yellow('Pulling repositories from all organizations...')}") if (settings$search_param == "phrase") { orgs <- "no_orgs" + } else { + cli::cli_alert_info("[Host:{private$host}] {cli::col_yellow('Pulling repositories from all organizations...')}") } } repos_table <- purrr::map(orgs, function(org) { @@ -381,23 +385,16 @@ GitHost <- R6::R6Class("GitHost", # @description Add `api_url` column to table. add_repo_api_url = function(repos_table){ - if ("file_content" %in% colnames(repos_table)) { - repo_name <- rlang::expr("repository_name") - repo_id <- rlang::expr("repository_id") - } else { - repo_name <- rlang::expr("name") - repo_id <- rlang::expr("id") - } if (!is.null(repos_table) && nrow(repos_table) > 0) { repos_table <- if (private$host == "GitHub") { dplyr::mutate( repos_table, - api_url = paste0(private$api_url, "/repos/", organization, "/", eval(parse(text = repo_name))), + api_url = paste0(private$api_url, "/repos/", organization, "/", repo_name), ) } else if (private$host == "GitLab") { dplyr::mutate( repos_table, - api_url = paste0(private$api_url, "/projects/", gsub("gid://gitlab/Project/", "", eval(parse(text = repo_id)))) + api_url = paste0(private$api_url, "/projects/", stringr::str_match(repo_id, "[0-9].*")) ) } } diff --git a/R/GitStats.R b/R/GitStats.R index 3d38ce5e..731d065c 100644 --- a/R/GitStats.R +++ b/R/GitStats.R @@ -21,10 +21,10 @@ GitStats <- R6::R6Class("GitStats", #' pulling. #' @return Nothing. set_params = function(search_param, - team_name, - phrase, - language, - print_out) { + team_name = NULL, + phrase = NULL, + language = "All", + print_out = TRUE) { search_param <- match.arg( search_param, c("org", "team", "phrase") @@ -116,11 +116,43 @@ GitStats <- R6::R6Class("GitStats", cli::cli_alert_success("{member_name} successfully added to team.") }, + #' @description Wrapper over pulling repositories by phrase. + #' @param package_name A character, name of the package. + #' @param only_loading A boolean, if `TRUE` function will check only if package + #' is loaded in repositories, not used as dependencies. This is much faster + #' approach as searching usage only with loading (i.e. library(package)) is + #' based on Search APIs (one endpoint), whereas searching usage as a + #' dependency pulls text files from all repositories (many endpoints). This is + #' a good option to choose when you want to check package usage but guess that + #' it may be used mainly by loading in data scripts and not used as a + #' dependency of other packages. + pull_R_package_usage = function(package_name, only_loading = FALSE) { + repos_using_package <- private$check_R_package_loading(package_name) + repos_with_package_as_dependency <- if (!only_loading) { + private$check_R_package_as_dependency(package_name) + } else { + NULL + } + package_usage_table <- purrr::list_rbind( + list( + repos_with_package_as_dependency, + repos_using_package + ) + ) + duplicated_repos <- package_usage_table$api_url[duplicated(package_usage_table$api_url)] + package_usage_table <- package_usage_table[!duplicated(package_usage_table$api_url),] + package_usage_table <- package_usage_table %>% + dplyr::mutate( + package_usage = ifelse(api_url %in% duplicated_repos, "import, library", package_usage) + ) + private$R_package_usage <- package_usage_table + return(invisible(self)) + }, + #' @description A method to list all repositories for an organization, #' a team or by a keyword. #' @param add_contributors A boolean to decide whether to add contributors #' information to repositories. - #' @return A data.frame of repositories. pull_repos = function(add_contributors = FALSE) { if (private$settings$search_param == "team") { if (length(private$settings$team) == 0) { @@ -131,7 +163,6 @@ GitStats <- R6::R6Class("GitStats", cli::cli_abort("You have to provide a phrase to look for.") } } - repos_table <- purrr::map(private$hosts, ~ .$pull_repos( settings = private$settings, add_contributors = add_contributors @@ -162,19 +193,16 @@ GitStats <- R6::R6Class("GitStats", #' @description A method to get information on commits. #' @param date_from A starting date for commits. #' @param date_until An end date for commits. - #' @return A data.frame of commits. pull_commits = function(date_from, date_until) { if (is.null(date_from)) { stop("You need to define `date_from`.", call. = FALSE) } - if (private$settings$search_param == "team") { if (length(private$settings$team) == 0) { cli::cli_abort("You have to specify a team first with 'set_team_member()'.") } } - commits_table <- purrr::map(private$hosts, function(host) { commits_table_host <- host$pull_commits( date_from = date_from, @@ -215,12 +243,20 @@ GitStats <- R6::R6Class("GitStats", }, #' @description Pull text content of a file from all repositories. - #' @param file_path A file path. - #' @return A data.frame of files. - pull_files = function(file_path) { + #' @param file_path A file path, may be a character vector. + #' @param .use_pulled_repos A boolean if TRUE `GitStats` will pull files only + #' from stored in the output repositories. + pull_files = function(file_path, .use_pulled_repos = FALSE) { private$check_for_host() files_table <- purrr::map(private$hosts, function(host) { - host$pull_files(file_path) + host$pull_files( + file_path = file_path, + pulled_repos = if (.use_pulled_repos) { + self$get_repos() + } else { + NULL + } + ) }) %>% purrr::list_rbind() private$files <- files_table @@ -256,6 +292,11 @@ GitStats <- R6::R6Class("GitStats", private$files }, + #' @description Return R_package_usage table from GitStats. + get_R_package_usage = function() { + private$R_package_usage + }, + #' @description A print method for a GitStats object. print = function() { cat(paste0("A object for ", length(private$hosts), " hosts:"), sep = "\n") @@ -304,6 +345,57 @@ GitStats <- R6::R6Class("GitStats", # @field files An output table of files. files = NULL, + # @field R_package_usage. + R_package_usage = NULL, + + # @description Search repositories with `library(package_name)` in code blobs. + # @param package_name Name of a package. + check_R_package_loading = function(package_name) { + cli::cli_alert_info("Checking where [{package_name}] is loaded from library...") + package_usage_phrases <- c( + paste0("library(", package_name, ")"), + paste0(package_name, "::") + ) + repos_using_package <- purrr::map(package_usage_phrases, ~ { + suppressMessages( + self$set_params( + search_param = "phrase", + phrase = ., + print_out = FALSE + ) + ) + self$pull_repos() + repos_using_package <- self$get_repos() + if (!is.null(repos_using_package)) { + repos_using_package$package_usage <- "library" + repos_using_package <- repos_using_package %>% + dplyr::select(repo_name, repo_url, api_url, package_usage) + } + return(repos_using_package) + }) %>% + purrr::list_rbind() %>% + unique() + return(repos_using_package) + }, + + # @description Search repositories with `package_name` in DESCRIPTION and NAMESPACE files. + # @param package_name Name of a package. + check_R_package_as_dependency = function(package_name) { + cli::cli_alert_info("Checking where [{package_name}] is used as a dependency...") + self$pull_files( + file_path = c("DESCRIPTION", "NAMESPACE") + ) + desc_table <- self$get_files() + repos_with_package <- desc_table[grepl(package_name, desc_table$file_content), ] + if (nrow(repos_with_package) > 0) { + repos_with_package <- repos_with_package[!duplicated(repos_with_package$api_url),] + repos_with_package$package_usage <- "import" + } + repos_with_package <- repos_with_package %>% + dplyr::select(repo_name, repo_url, api_url, package_usage) + return(repos_with_package) + }, + # @description Check whether the urls do not repeat in input. # @param host An object of GitPlatform class. # @return A GitPlatform object. diff --git a/R/get_stats.R b/R/get_stats.R index dff13fa2..0e2a7cb1 100644 --- a/R/get_stats.R +++ b/R/get_stats.R @@ -8,7 +8,7 @@ get_repos_stats <- function(gitstats_obj){ repos_data <- data.table::copy(get_repos(gitstats_obj)) repos_stats <- repos_data %>% dplyr::mutate( - fullname = paste0(organization, "/", name) + fullname = paste0(organization, "/", repo_name) ) %>% dplyr::mutate( last_activity = difftime( diff --git a/R/gitstats_functions.R b/R/gitstats_functions.R index 6fa9dea8..7d5b72a5 100644 --- a/R/gitstats_functions.R +++ b/R/gitstats_functions.R @@ -236,7 +236,8 @@ pull_users <- function(gitstats_obj, #' @name pull_files #' @description Pull files content from Git Hosts. #' @param gitstats_obj A GitStats object. -#' @param file_path A standardized path to file in repositories. +#' @param file_path A standardized path to file(s) in repositories. May be a +#' character vector if multiple files are to be pulled. #' @examples #' \dontrun{ #' my_gitstats <- create_gitstats() %>% @@ -348,3 +349,51 @@ get_users <- function(gitstats_obj){ get_files <- function(gitstats_obj){ return(gitstats_obj$get_files()) } + +#' @title Check package usage across repositories +#' @name pull_R_package_usage +#' @description Wrapper over searching repositories by code blobs related to +#' using package (`library(package)`, `require(package)` and `package::`). +#' @param gitstats_obj A GitStats object. +#' @param package_name A character, name of the package. +#' @param only_loading A boolean, if `TRUE` function will check only if package +#' is loaded in repositories, not used as dependencies. This is much faster +#' approach as searching usage only with loading (i.e. library(package)) is +#' based on Search APIs (one endpoint), whereas searching usage as a +#' dependency pulls text files from all repositories (many endpoints). This is +#' a good option to choose when you want to check package usage but guess that +#' it may be used mainly by loading in data scripts and not used as a +#' dependency of other packages. +#' @return A table of repositories content. +#' @examples +#' \dontrun{ +#' my_gitstats <- create_gitstats() %>% +#' set_host( +#' api_url = "https://api.github.com", +#' token = Sys.getenv("GITHUB_PAT"), +#' orgs = c("r-world-devs", "openpharma") +#' ) %>% +#' pull_R_package_usage("Shiny") +#' } +#' @export +pull_R_package_usage <- function( + gitstats_obj, + package_name, + only_loading = FALSE + ) { + gitstats_obj$pull_R_package_usage( + package_name = package_name, + only_loading = only_loading + ) + return(invisible(gitstats_obj)) +} + +#' @title Get R package usage +#' @name get_files +#' @description Retrieves list of repositories that make use of a package. +#' @param gitstats_obj A GitStats object. +#' @return A table with repo urls. +#' @export +get_R_package_usage <- function(gitstats_obj) { + return(gitstats_obj$get_R_package_usage()) +} diff --git a/R/global.R b/R/global.R index 74e0e1e6..6e7e9df7 100644 --- a/R/global.R +++ b/R/global.R @@ -1,7 +1,7 @@ # This is a solution for warnings in r-cmd checks of global variables globalVariables(c( ".", "fullname", "platform", "organization", "repo_url", - "name", "created_at", "last_activity_at", "last_activity", "stats_date", + "repo_name", "created_at", "last_activity_at", "last_activity", "stats_date", "committed_date", "commits_n", "api_url", "row_no", ".N", ".data", "repository", "stars", "forks", "languages", "issues_open", "issues_closed", "contributors_n" diff --git a/man/get_files.Rd b/man/get_files.Rd index 1cf7c306..2c04c762 100644 --- a/man/get_files.Rd +++ b/man/get_files.Rd @@ -2,16 +2,23 @@ % Please edit documentation in R/gitstats_functions.R \name{get_files} \alias{get_files} +\alias{get_R_package_usage} \title{Get files} \usage{ get_files(gitstats_obj) + +get_R_package_usage(gitstats_obj) } \arguments{ \item{gitstats_obj}{A GitStats object.} } \value{ A table of files content. + +A table with repo urls. } \description{ Retrieves files table pulled by \code{GitStats}. + +Retrieves list of repositories that make use of a package. } diff --git a/man/pull_R_package_usage.Rd b/man/pull_R_package_usage.Rd new file mode 100644 index 00000000..123293c0 --- /dev/null +++ b/man/pull_R_package_usage.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gitstats_functions.R +\name{pull_R_package_usage} +\alias{pull_R_package_usage} +\title{Check package usage across repositories} +\usage{ +pull_R_package_usage(gitstats_obj, package_name, only_loading = FALSE) +} +\arguments{ +\item{gitstats_obj}{A GitStats object.} + +\item{package_name}{A character, name of the package.} + +\item{only_loading}{A boolean, if \code{TRUE} function will check only if package +is loaded in repositories, not used as dependencies. This is much faster +approach as searching usage only with loading (i.e. library(package)) is +based on Search APIs (one endpoint), whereas searching usage as a +dependency pulls text files from all repositories (many endpoints). This is +a good option to choose when you want to check package usage but guess that +it may be used mainly by loading in data scripts and not used as a +dependency of other packages.} +} +\value{ +A table of repositories content. +} +\description{ +Wrapper over searching repositories by code blobs related to +using package (\code{library(package)}, \code{require(package)} and \verb{package::}). +} +\examples{ +\dontrun{ + my_gitstats <- create_gitstats() \%>\% + set_host( + api_url = "https://api.github.com", + token = Sys.getenv("GITHUB_PAT"), + orgs = c("r-world-devs", "openpharma") + ) \%>\% + pull_R_package_usage("Shiny") +} +} diff --git a/man/pull_files.Rd b/man/pull_files.Rd index dd009a33..6e67b417 100644 --- a/man/pull_files.Rd +++ b/man/pull_files.Rd @@ -9,7 +9,8 @@ pull_files(gitstats_obj, file_path) \arguments{ \item{gitstats_obj}{A GitStats object.} -\item{file_path}{A standardized path to file in repositories.} +\item{file_path}{A standardized path to file(s) in repositories. May be a +character vector if multiple files are to be pulled.} } \value{ A \code{GitStats} object with table of files. diff --git a/renv.lock b/renv.lock index 83d270f3..e6675a2e 100644 --- a/renv.lock +++ b/renv.lock @@ -69,6 +69,14 @@ "Hash": "543776ae6848fde2f48ff3816d0628bc", "Requirements": [] }, + "brew": { + "Package": "brew", + "Version": "1.0-7", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "38875ea52350ff4b4c03849fc69736c8", + "Requirements": [] + }, "brio": { "Package": "brio", "Version": "1.1.3", @@ -91,12 +99,23 @@ "sass" ] }, + "cachem": { + "Package": "cachem", + "Version": "1.0.6", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "648c5b3d71e6a37e3043617489a0a0e9", + "Requirements": [ + "fastmap", + "rlang" + ] + }, "callr": { "Package": "callr", - "Version": "3.7.0", + "Version": "3.7.3", "Source": "Repository", "Repository": "RSPM", - "Hash": "461aa75a11ce2400245190ef5d3995df", + "Hash": "9b2191ede20fa29828139b9900922e51", "Requirements": [ "R6", "processx" @@ -104,10 +123,18 @@ }, "cli": { "Package": "cli", - "Version": "3.6.0", + "Version": "3.6.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "89e6d8219950eac806ae0c489052048a", + "Requirements": [] + }, + "clipr": { + "Package": "clipr", + "Version": "0.8.0", "Source": "Repository", "Repository": "RSPM", - "Hash": "3177a5a16c243adc199ba33117bd9657", + "Hash": "3f038e5ac7f41d4ac41ce658c85e3042", "Requirements": [] }, "colorspace": { @@ -158,6 +185,20 @@ "Hash": "8dc45fd8a1ee067a92b85ef274e66d6a", "Requirements": [] }, + "credentials": { + "Package": "credentials", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "93762d0a34d78e6a025efdbfb5c6bb41", + "Requirements": [ + "askpass", + "curl", + "jsonlite", + "openssl", + "sys" + ] + }, "crosstalk": { "Package": "crosstalk", "Version": "1.2.0", @@ -173,10 +214,10 @@ }, "curl": { "Package": "curl", - "Version": "4.3.2", + "Version": "5.1.0", "Source": "Repository", "Repository": "RSPM", - "Hash": "022c42d49c28e95d69ca60446dbabf88", + "Hash": "9123f3ef96a2c1a93927d828b2fe7d4c", "Requirements": [] }, "data.table": { @@ -189,16 +230,45 @@ }, "desc": { "Package": "desc", - "Version": "1.4.1", + "Version": "1.4.2", "Source": "Repository", "Repository": "RSPM", - "Hash": "eebd27ee58fcc58714eedb7aa07d8ad1", + "Hash": "6b9602c7ebbe87101a9c8edb6e8b6d21", "Requirements": [ "R6", "cli", "rprojroot" ] }, + "devtools": { + "Package": "devtools", + "Version": "2.4.3", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "fc35e13bb582e5fe6f63f3d647a4cbe5", + "Requirements": [ + "callr", + "cli", + "desc", + "ellipsis", + "fs", + "httr", + "lifecycle", + "memoise", + "pkgbuild", + "pkgload", + "rcmdcheck", + "remotes", + "rlang", + "roxygen2", + "rstudioapi", + "rversions", + "sessioninfo", + "testthat", + "usethis", + "withr" + ] + }, "diffobj": { "Package": "diffobj", "Version": "0.3.5", @@ -211,12 +281,31 @@ }, "digest": { "Package": "digest", - "Version": "0.6.29", + "Version": "0.6.33", "Source": "Repository", - "Repository": "RSPM", - "Hash": "cf6b206a045a684728c3267ef7596190", + "Repository": "CRAN", + "Hash": "b18a9cf3c003977b0cc49d5e76ebe48d", "Requirements": [] }, + "downlit": { + "Package": "downlit", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "79bf3f66590752ffbba20f8d2da94c7c", + "Requirements": [ + "brio", + "desc", + "digest", + "evaluate", + "fansi", + "memoise", + "rlang", + "vctrs", + "withr", + "yaml" + ] + }, "dplyr": { "Package": "dplyr", "Version": "1.0.8", @@ -248,10 +337,10 @@ }, "evaluate": { "Package": "evaluate", - "Version": "0.15", + "Version": "0.23", "Source": "Repository", "Repository": "RSPM", - "Hash": "699a7a93d08c962d9f8950b2d7a227f1", + "Hash": "daf4a1246be12c1fa8c7705a0935c1a0", "Requirements": [] }, "fansi": { @@ -294,6 +383,21 @@ "Hash": "177475892cf4a55865868527654a7741", "Requirements": [] }, + "gert": { + "Package": "gert", + "Version": "1.6.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "98c014c4c933f23ea5a0321a4d0b588b", + "Requirements": [ + "askpass", + "credentials", + "openssl", + "rstudioapi", + "sys", + "zip" + ] + }, "ggplot2": { "Package": "ggplot2", "Version": "3.3.5", @@ -313,6 +417,28 @@ "withr" ] }, + "gh": { + "Package": "gh", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "38c2580abbda249bd6afeec00d14f531", + "Requirements": [ + "cli", + "gitcreds", + "httr", + "ini", + "jsonlite" + ] + }, + "gitcreds": { + "Package": "gitcreds", + "Version": "0.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "f3aefccc1cc50de6338146b62f115de8", + "Requirements": [] + }, "glue": { "Package": "glue", "Version": "1.6.2", @@ -380,19 +506,21 @@ }, "httr2": { "Package": "httr2", - "Version": "0.1.1", + "Version": "1.0.0", "Source": "Repository", "Repository": "RSPM", - "Hash": "a34ecedb1ec10651b77e89863edb9fae", + "Hash": "e2b30f1fc039a0bab047dd52bb20ef71", "Requirements": [ "R6", "cli", "curl", "glue", + "lifecycle", "magrittr", "openssl", "rappdirs", "rlang", + "vctrs", "withr" ] }, @@ -407,6 +535,14 @@ "digest" ] }, + "ini": { + "Package": "ini", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "6154ec2223172bce8162d4153cda21f7", + "Requirements": [] + }, "isoband": { "Package": "isoband", "Version": "0.2.5", @@ -427,10 +563,10 @@ }, "jsonlite": { "Package": "jsonlite", - "Version": "1.8.0", + "Version": "1.8.7", "Source": "Repository", "Repository": "RSPM", - "Hash": "d07e729b27b372429d42d24d503613a0", + "Hash": "266a20443ca13c65688b2116d5220f76", "Requirements": [] }, "knitr": { @@ -513,6 +649,17 @@ "Hash": "7ce2733a9826b3aeb1775d56fd305472", "Requirements": [] }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c", + "Requirements": [ + "cachem", + "rlang" + ] + }, "mgcv": { "Package": "mgcv", "Version": "1.8-40", @@ -590,6 +737,23 @@ "vctrs" ] }, + "pkgbuild": { + "Package": "pkgbuild", + "Version": "1.3.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "66d2adfed274daf81ccfe77d974c3b9b", + "Requirements": [ + "R6", + "callr", + "cli", + "crayon", + "desc", + "prettyunits", + "rprojroot", + "withr" + ] + }, "pkgconfig": { "Package": "pkgconfig", "Version": "2.0.3", @@ -598,19 +762,50 @@ "Hash": "01f28d4278f15c76cddbea05899c5d6f", "Requirements": [] }, + "pkgdown": { + "Package": "pkgdown", + "Version": "2.0.7", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "16fa15449c930bf3a7761d3c68f8abf9", + "Requirements": [ + "bslib", + "callr", + "cli", + "desc", + "digest", + "downlit", + "fs", + "httr", + "jsonlite", + "magrittr", + "memoise", + "purrr", + "ragg", + "rlang", + "rmarkdown", + "tibble", + "whisker", + "withr", + "xml2", + "yaml" + ] + }, "pkgload": { "Package": "pkgload", - "Version": "1.2.4", + "Version": "1.3.3", "Source": "Repository", "Repository": "RSPM", - "Hash": "7533cd805940821bf23eaf3c8d4c1735", + "Hash": "903d68319ae9923fb2e2ee7fa8230b91", "Requirements": [ "cli", "crayon", "desc", + "fs", + "glue", + "pkgbuild", "rlang", "rprojroot", - "rstudioapi", "withr" ] }, @@ -652,12 +847,20 @@ "Hash": "a555924add98c99d2f411e37e7d25e9f", "Requirements": [] }, + "prettyunits": { + "Package": "prettyunits", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "95ef9167b75dde9d2ccc3c7528393e7e", + "Requirements": [] + }, "processx": { "Package": "processx", - "Version": "3.5.3", + "Version": "3.8.2", "Source": "Repository", "Repository": "RSPM", - "Hash": "8bbae1a548d0d3fdf6647bdd9d35bf6d", + "Hash": "3efbd8ac1be0296a46c55387aeace0f3", "Requirements": [ "R6", "ps" @@ -679,10 +882,10 @@ }, "ps": { "Package": "ps", - "Version": "1.7.0", + "Version": "1.7.5", "Source": "Repository", - "Repository": "RSPM", - "Hash": "eef74b13f32cae6bb0d495e53317c44c", + "Repository": "CRAN", + "Hash": "709d852d33178db54b17c722e5b1e594", "Requirements": [] }, "purrr": { @@ -699,6 +902,17 @@ "vctrs" ] }, + "ragg": { + "Package": "ragg", + "Version": "1.2.5", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "690bc058ea2b1b8a407d3cfe3dce3ef9", + "Requirements": [ + "systemfonts", + "textshaping" + ] + }, "rappdirs": { "Package": "rappdirs", "Version": "0.3.3", @@ -707,6 +921,27 @@ "Hash": "5e3c5dc0b071b21fa128676560dbe94d", "Requirements": [] }, + "rcmdcheck": { + "Package": "rcmdcheck", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "8f25ebe2ec38b1f2aef3b0d2ef76f6c4", + "Requirements": [ + "R6", + "callr", + "cli", + "curl", + "desc", + "digest", + "pkgbuild", + "prettyunits", + "rprojroot", + "sessioninfo", + "withr", + "xopen" + ] + }, "rematch2": { "Package": "rematch2", "Version": "2.1.2", @@ -717,6 +952,14 @@ "tibble" ] }, + "remotes": { + "Package": "remotes", + "Version": "2.4.2", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "227045be9aee47e6dda9bb38ac870d67", + "Requirements": [] + }, "renv": { "Package": "renv", "Version": "0.15.4", @@ -762,6 +1005,28 @@ "yaml" ] }, + "roxygen2": { + "Package": "roxygen2", + "Version": "7.1.2", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "eb9849556c4250305106e82edae35b72", + "Requirements": [ + "R6", + "brew", + "commonmark", + "cpp11", + "desc", + "digest", + "knitr", + "pkgload", + "purrr", + "rlang", + "stringi", + "stringr", + "xml2" + ] + }, "rprojroot": { "Package": "rprojroot", "Version": "2.0.3", @@ -778,6 +1043,17 @@ "Hash": "5564500e25cffad9e22244ced1379887", "Requirements": [] }, + "rversions": { + "Package": "rversions", + "Version": "2.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "f88fab00907b312f8b23ec13e2d437cb", + "Requirements": [ + "curl", + "xml2" + ] + }, "sass": { "Package": "sass", "Version": "0.4.1", @@ -809,6 +1085,16 @@ "viridisLite" ] }, + "sessioninfo": { + "Package": "sessioninfo", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "3f9796a8d0a0e8c6eb49a4b029359d1f", + "Requirements": [ + "cli" + ] + }, "spelling": { "Package": "spelling", "Version": "2.2.1", @@ -850,21 +1136,29 @@ "Hash": "b227d13e29222b4574486cfcbde077fa", "Requirements": [] }, + "systemfonts": { + "Package": "systemfonts", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "90b28393209827327de889f49935140a", + "Requirements": [ + "cpp11" + ] + }, "testthat": { "Package": "testthat", - "Version": "3.1.4", + "Version": "3.2.1", "Source": "Repository", - "Repository": "RSPM", - "Hash": "f76c2a02d0fdc24aa7a47ea34261a6e3", + "Repository": "CRAN", + "Hash": "4767a686ebe986e6cb01d075b3f09729", "Requirements": [ "R6", "brio", "callr", "cli", - "crayon", "desc", "digest", - "ellipsis", "evaluate", "jsonlite", "lifecycle", @@ -878,6 +1172,17 @@ "withr" ] }, + "textshaping": { + "Package": "textshaping", + "Version": "0.3.6", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "1ab6223d3670fac7143202cb6a2d43d5", + "Requirements": [ + "cpp11", + "systemfonts" + ] + }, "tibble": { "Package": "tibble", "Version": "3.1.6", @@ -949,6 +1254,34 @@ "xfun" ] }, + "usethis": { + "Package": "usethis", + "Version": "2.1.5", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "c499f488e6dd7718accffaee5bc5a79b", + "Requirements": [ + "cli", + "clipr", + "crayon", + "curl", + "desc", + "fs", + "gert", + "gh", + "glue", + "jsonlite", + "lifecycle", + "purrr", + "rappdirs", + "rlang", + "rprojroot", + "rstudioapi", + "whisker", + "withr", + "yaml" + ] + }, "utf8": { "Package": "utf8", "Version": "1.2.2", @@ -959,10 +1292,10 @@ }, "vctrs": { "Package": "vctrs", - "Version": "0.5.0", + "Version": "0.6.4", "Source": "Repository", "Repository": "RSPM", - "Hash": "001fd6a5ebfff8316baf9fb2b5516dc9", + "Hash": "266c1ca411266ba8f365fcc726444b87", "Requirements": [ "cli", "glue", @@ -980,10 +1313,10 @@ }, "waldo": { "Package": "waldo", - "Version": "0.4.0", + "Version": "0.5.2", "Source": "Repository", "Repository": "RSPM", - "Hash": "035fba89d0c86e2113120f93301b98ad", + "Hash": "c7d3fd6d29ab077cbac8f0e2751449e6", "Requirements": [ "cli", "diffobj", @@ -994,6 +1327,14 @@ "tibble" ] }, + "whisker": { + "Package": "whisker", + "Version": "0.4", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "ca970b96d894e90397ed20637a0c1bbe", + "Requirements": [] + }, "withr": { "Package": "withr", "Version": "2.5.0", @@ -1018,6 +1359,16 @@ "Hash": "40682ed6a969ea5abfd351eb67833adc", "Requirements": [] }, + "xopen": { + "Package": "xopen", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "6c85f015dee9cc7710ddd20f86881f58", + "Requirements": [ + "processx" + ] + }, "yaml": { "Package": "yaml", "Version": "2.3.5", @@ -1025,6 +1376,14 @@ "Repository": "RSPM", "Hash": "458bb38374d73bf83b1bb85e353da200", "Requirements": [] + }, + "zip": { + "Package": "zip", + "Version": "2.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "c7eef2996ac270a18c2715c997a727c5", + "Requirements": [] } } } diff --git a/tests/testthat/_snaps/01-GQLQueryGitHub.md b/tests/testthat/_snaps/01-GQLQueryGitHub.md index 51ae1606..98701020 100644 --- a/tests/testthat/_snaps/01-GQLQueryGitHub.md +++ b/tests/testthat/_snaps/01-GQLQueryGitHub.md @@ -10,14 +10,14 @@ Code gh_repos_by_org_query Output - [1] "\n query GetReposByOrg($org: String!) {\n repositoryOwner(login: $org) {\n ... on Organization {\n repositories(first: 100 ) {\n totalCount\n pageInfo {\n endCursor\n hasNextPage\n }\n nodes {\n id\n name\n default_branch: defaultBranchRef {\n name\n }\n stars: stargazerCount\n forks: forkCount\n created_at: createdAt\n last_activity_at: pushedAt\n languages (first: 5) { nodes {name} }\n issues_open: issues (first: 100 states: [OPEN]) {\n totalCount\n }\n issues_closed: issues (first: 100 states: [CLOSED]) {\n totalCount\n }\n organization: owner {\n login\n }\n repo_url: url\n }\n }\n }\n }\n }" + [1] "\n query GetReposByOrg($org: String!) {\n repositoryOwner(login: $org) {\n ... on Organization {\n repositories(first: 100 ) {\n totalCount\n pageInfo {\n endCursor\n hasNextPage\n }\n nodes {\n repo_id: id\n repo_name: name\n default_branch: defaultBranchRef {\n name\n }\n stars: stargazerCount\n forks: forkCount\n created_at: createdAt\n last_activity_at: pushedAt\n languages (first: 5) { nodes {name} }\n issues_open: issues (first: 100 states: [OPEN]) {\n totalCount\n }\n issues_closed: issues (first: 100 states: [CLOSED]) {\n totalCount\n }\n organization: owner {\n login\n }\n repo_url: url\n }\n }\n }\n }\n }" # repos_by_user query is built properly Code gh_repos_by_user_query Output - [1] "\n query GetReposByUser($user: String!) {\n user(login: $user) {\n repositories(\n first: 100\n ownerAffiliations: COLLABORATOR\n ) {\n totalCount\n pageInfo {\n endCursor\n hasNextPage\n }\n nodes {\n id\n name\n default_branch: defaultBranchRef {\n name\n }\n stars: stargazerCount\n forks: forkCount\n created_at: createdAt\n last_activity_at: pushedAt\n languages (first: 5) { nodes {name} }\n issues_open: issues (first: 100 states: [OPEN]) {\n totalCount\n }\n issues_closed: issues (first: 100 states: [CLOSED]) {\n totalCount\n }\n organization: owner {\n login\n }\n repo_url: url\n }\n }\n }\n }" + [1] "\n query GetReposByUser($user: String!) {\n user(login: $user) {\n repositories(\n first: 100\n ownerAffiliations: COLLABORATOR\n ) {\n totalCount\n pageInfo {\n endCursor\n hasNextPage\n }\n nodes {\n repo_id: id\n repo_name: name\n default_branch: defaultBranchRef {\n name\n }\n stars: stargazerCount\n forks: forkCount\n created_at: createdAt\n last_activity_at: pushedAt\n languages (first: 5) { nodes {name} }\n issues_open: issues (first: 100 states: [OPEN]) {\n totalCount\n }\n issues_closed: issues (first: 100 states: [CLOSED]) {\n totalCount\n }\n organization: owner {\n login\n }\n repo_url: url\n }\n }\n }\n }" # user query is built properly @@ -31,5 +31,5 @@ Code gh_files_query Output - [1] "query GetFilesByRepo($org: String!, $repo: String!, $file_path: String!) {\n repository(owner: $org, name: $repo) {\n id\n name\n object(expression: $file_path) {\n ... on Blob {\n text\n byteSize\n }\n }\n }\n }" + [1] "query GetFilesByRepo($org: String!, $repo: String!, $file_path: String!) {\n repository(owner: $org, name: $repo) {\n id\n name\n url\n object(expression: $file_path) {\n ... on Blob {\n text\n byteSize\n }\n }\n }\n }" diff --git a/tests/testthat/_snaps/01-GQLQueryGitLab.md b/tests/testthat/_snaps/01-GQLQueryGitLab.md index aec93264..aa33b806 100644 --- a/tests/testthat/_snaps/01-GQLQueryGitLab.md +++ b/tests/testthat/_snaps/01-GQLQueryGitLab.md @@ -3,7 +3,7 @@ Code gl_repos_by_org_query Output - [1] "query GetReposByOrg($org: ID!) {\n group(fullPath: $org) {\n projects(first: 100 ) {\n count\n pageInfo {\n hasNextPage\n endCursor\n }\n edges {\n node {\n id\n name\n ... on Project {\n repository {\n rootRef\n }\n }\n stars: starCount\n forks: forksCount\n created_at: createdAt\n last_activity_at: lastActivityAt\n languages {\n name\n }\n issues: issueStatusCounts {\n all\n closed\n opened\n }\n group {\n name\n }\n repo_url: webUrl\n }\n }\n }\n }\n }" + [1] "query GetReposByOrg($org: ID!) {\n group(fullPath: $org) {\n projects(first: 100 ) {\n count\n pageInfo {\n hasNextPage\n endCursor\n }\n edges {\n node {\n repo_id: id\n repo_name: name\n ... on Project {\n repository {\n rootRef\n }\n }\n stars: starCount\n forks: forksCount\n created_at: createdAt\n last_activity_at: lastActivityAt\n languages {\n name\n }\n issues: issueStatusCounts {\n all\n closed\n opened\n }\n group {\n name\n }\n repo_url: webUrl\n }\n }\n }\n }\n }" # user query is built properly @@ -12,10 +12,17 @@ Output [1] "\n query GetUser($user: String!) {\n user(username: $user) {\n id\n name\n login: username\n email: publicEmail\n location\n starred_repos: starredProjects {\n count\n }\n pull_requests: authoredMergeRequests {\n count\n }\n reviews: reviewRequestedMergeRequests {\n count\n }\n avatar_url: avatarUrl\n web_url: webUrl\n }\n }\n " -# file query is built properly +# file queries are built properly Code gl_files_query Output - [1] "query GetFilesByOrg($org: ID!, $file_paths: [String!]!) {\n group(fullPath: $org) {\n projects(first: 100) {\n count\n pageInfo {\n hasNextPage\n endCursor\n }\n edges {\n node {\n name\n id\n repository {\n blobs(paths: $file_paths) {\n nodes {\n name\n rawBlob\n size\n }\n }\n }\n }\n }\n }\n }\n }" + [1] "query GetFilesByOrg($org: ID!, $file_paths: [String!]!) {\n group(fullPath: $org) {\n projects(first: 100) {\n count\n pageInfo {\n hasNextPage\n endCursor\n }\n edges {\n node {\n name\n id\n webUrl\n repository {\n blobs(paths: $file_paths) {\n nodes {\n name\n rawBlob\n size\n }\n }\n }\n }\n }\n }\n }\n }" + +--- + + Code + gl_repo_files_query + Output + [1] "query GetFilesFromRepo($file_paths: [String!]!, $project_path: ID!) {\n project(fullPath: $project_path) {\n name\n id\n webUrl\n repository {\n blobs(paths: $file_paths) {\n nodes {\n name\n rawBlob\n size\n }\n }\n }\n }\n }" diff --git a/tests/testthat/_snaps/03-EngineGraphQLGitHub.md b/tests/testthat/_snaps/03-EngineGraphQLGitHub.md index c83cb0af..8f65dceb 100644 --- a/tests/testthat/_snaps/03-EngineGraphQLGitHub.md +++ b/tests/testthat/_snaps/03-EngineGraphQLGitHub.md @@ -4229,14 +4229,14 @@ # `pull_repos()` works as expected Code - gh_repos_org <- test_gql_gh$pull_repos(org = "r-world-devs", settings = settings) + gh_repos_org <- test_gql_gh$pull_repos(org = "r-world-devs", settings = test_settings) Message i [GitHub][Engine:GraphQL][org:r-world-devs] Pulling repositories... --- Code - gh_repos_team <- test_gql_gh$pull_repos(org = "r-world-devs", settings = settings) + gh_repos_team <- test_gql_gh$pull_repos(org = "r-world-devs", settings = test_settings) Message i [GitHub][Engine:GraphQL][org:r-world-devs][team:] Pulling repositories... @@ -4244,7 +4244,7 @@ Code commits_table <- test_gql_gh$pull_commits(org = "r-world-devs", date_from = "2023-01-01", - date_until = "2023-02-28", settings = settings) + date_until = "2023-02-28", settings = test_settings) Message i [GitHub][Engine:GraphQL][org:r-world-devs] Pulling commits... diff --git a/tests/testthat/_snaps/03-EngineGraphQLGitLab.md b/tests/testthat/_snaps/03-EngineGraphQLGitLab.md index 2fa9b724..b3f1ac38 100644 --- a/tests/testthat/_snaps/03-EngineGraphQLGitLab.md +++ b/tests/testthat/_snaps/03-EngineGraphQLGitLab.md @@ -1,7 +1,7 @@ # `pull_repos()` works as expected Code - gl_repos_org <- test_gql_gl$pull_repos(org = "mbtests", settings = settings) + gl_repos_org <- test_gql_gl$pull_repos(org = "mbtests", settings = test_settings) Message i [GitLab][Engine:GraphQL][org:mbtests] Pulling repositories... diff --git a/tests/testthat/_snaps/03-EngineRestGitHub.md b/tests/testthat/_snaps/03-EngineRestGitHub.md index 38d55307..537b7693 100644 --- a/tests/testthat/_snaps/03-EngineRestGitHub.md +++ b/tests/testthat/_snaps/03-EngineRestGitHub.md @@ -21,7 +21,7 @@ # `pull_repos()` works Code - result <- test_rest$pull_repos(org = "r-world-devs", settings = settings) + result <- test_rest$pull_repos(org = "r-world-devs", settings = test_settings) Message i [GitHub][Engine:REST][phrase:shiny][org:r-world-devs] Searching repositories... diff --git a/tests/testthat/_snaps/03-EngineRestGitLab.md b/tests/testthat/_snaps/03-EngineRestGitLab.md index 7ff161a4..ddd5e869 100644 --- a/tests/testthat/_snaps/03-EngineRestGitLab.md +++ b/tests/testthat/_snaps/03-EngineRestGitLab.md @@ -13,15 +13,15 @@ # `pull_repos_by_phrase()` works Code - result <- test_rest$pull_repos(org = "erasmusmc-public-health", settings = settings) + result <- test_rest$pull_repos(org = "gitlab-org", settings = test_settings) Message - i [GitLab][Engine:REST][phrase:covid][org:erasmusmc-public-health] Searching repositories... + i [GitLab][Engine:REST][phrase:covid][org:gitlab-org] Searching repositories... # `pull_commits()` works as expected Code result <- test_rest$pull_commits(org = "mbtests", date_from = "2023-01-01", - date_until = "2023-04-20", settings = settings) + date_until = "2023-04-20", settings = test_settings) Message i [GitLab][Engine:REST][org:mbtests] Pulling repositories... i [GitLab][Engine:REST][org:mbtests] Pulling commits... diff --git a/tests/testthat/_snaps/05-GitHost.md b/tests/testthat/_snaps/05-GitHost.md index 5de15ae2..361681e2 100644 --- a/tests/testthat/_snaps/05-GitHost.md +++ b/tests/testthat/_snaps/05-GitHost.md @@ -17,7 +17,7 @@ # GitHost pulls repos from orgs Code - gh_repos_table <- test_host$pull_repos_from_orgs(settings) + gh_repos_table <- test_host$pull_repos_from_orgs(test_settings) Message i [GitHub][Engine:GraphQL][org:r-world-devs] Pulling repositories... @@ -56,18 +56,10 @@ Message i Filtering by language. -# GitHost filters GitLab repositories' (pulled by phrase) table by languages - - Code - result <- test_host$filter_repos_by_language(gl_repos_table, language = "C") - Message - i Filtering by language. - # pull_repos returns table of repositories Code - repos_table <- test_host$pull_repos(settings = list(search_param = "org", - language = "All")) + repos_table <- test_host$pull_repos(settings = test_settings) Message i [GitHub][Engine:GraphQL][org:openpharma] Pulling repositories... i [GitHub][Engine:GraphQL][org:r-world-devs] Pulling repositories... diff --git a/tests/testthat/_snaps/06-GitStats.md b/tests/testthat/_snaps/06-GitStats.md index 2e1e40cf..36b638f1 100644 --- a/tests/testthat/_snaps/06-GitStats.md +++ b/tests/testthat/_snaps/06-GitStats.md @@ -43,7 +43,7 @@ Repositories output: Commits output: -# check_for_host works +# check_for_host returns error when no hosts are passed Add first your hosts with `set_host()`. diff --git a/tests/testthat/helper-expect-responses.R b/tests/testthat/helper-expect-responses.R new file mode 100644 index 00000000..09bacb28 --- /dev/null +++ b/tests/testthat/helper-expect-responses.R @@ -0,0 +1,185 @@ +expect_gl_search_response <- function(object) { + expect_list_contains( + object, + c("basename", "data", "path", "filename", "id", "ref", "startline", "project_id") + ) +} + +expect_gh_search_response <- function(object) { + expect_list_contains( + object, + c("name", "path", "sha", "url", "git_url", "html_url", "repository", "score") + ) +} + +expect_gl_repos_rest_response <- function(object) { + expect_type( + object, + "list" + ) + expect_list_contains( + object[[1]], + c( + "id", "description", "name", "name_with_namespace", "path" + ) + ) +} + +expect_gl_repos_gql_response <- function(object) { + expect_type( + object, + "list" + ) + expect_list_contains( + object$data$group$projects$edges[[1]]$node, + c( + "id", "name", "repository", "stars", "forks", "created_at", "last_activity_at" + ) + ) +} + +expect_gh_repos_gql_response <- function(object) { + expect_type( + object, + "list" + ) + expect_list_contains( + object, + "data" + ) + expect_list_contains( + object$data$repositoryOwner$repositories$nodes[[1]], + c( + "id", "name", "stars", "forks", "created_at", + "last_activity_at", "languages", "issues_open", "issues_closed", + "repo_url" + ) + ) +} + +expect_gh_user_repos_gql_response <- function(object) { + expect_type( + object, + "list" + ) + expect_list_contains( + object, + "data" + ) + expect_list_contains( + object$data$user$repositories$nodes[[1]], + c( + "id", "name", "stars", "forks", "created_at", + "last_activity_at", "languages", "issues_open", "issues_closed", + "repo_url" + ) + ) +} + +expect_gl_commit_rest_response <- function(object) { + expect_type( + object, + "list" + ) + expect_list_contains( + object[[1]], + c( + "id", "short_id", "created_at", "parent_ids", "title", "message", + "author_name", "author_email", "authored_date", "committer_name", + "committer_email" + ) + ) +} + +expect_gh_commit_rest_response <- function(object) { + expect_type( + object, + "list" + ) + expect_gt( + length(object), + 0 + ) + expect_list_contains(object[[1]], + c("sha", "node_id", "commit", "url", + "html_url", "comments_url", "author", + "committer", "parents")) +} + +expect_gh_commit_gql_response <- function(object) { + expect_type( + object, + "list" + ) + expect_list_contains( + object, + "data" + ) + expect_list_contains( + object$data$repository$defaultBranchRef$target$history$edges[[1]]$node, + c("id", "committed_date", "author", "additions", "deletions") + ) +} + +expect_user_gql_response <- function(object) { + expect_list_contains( + object, + "data" + ) + expect_list_contains( + object$data, + "user" + ) + expect_list_contains( + object$data$user, + c("id", "name", "email", "location", "starred_repos", "avatar_url", "web_url") + ) +} + +expect_github_files_response <- function(object) { + expect_type( + object, + "list" + ) + expect_gt( + length(object[[1]]), + 0 + ) + purrr::walk(object, function(file_path) { + purrr::walk(file_path, function(repository) { + expect_list_contains( + repository, + c("name", "id", "object") + ) + expect_list_contains( + repository$object, + c("text", "byteSize") + ) + }) + }) +} + +expect_gitlab_files_response <- function(object) { + expect_type( + object, + "list" + ) + expect_gt( + length(object), + 0 + ) + purrr::walk(object, function(project) { + expect_list_contains( + project, + c( + "name", "id", "repository" + ) + ) + expect_list_contains( + project$repository$blobs$nodes[[1]], + c( + "name", "rawBlob", "size" + ) + ) + }) +} diff --git a/tests/testthat/helper-expect-tables.R b/tests/testthat/helper-expect-tables.R new file mode 100644 index 00000000..8a12585d --- /dev/null +++ b/tests/testthat/helper-expect-tables.R @@ -0,0 +1,70 @@ +repo_table_colnames <- c( + "repo_id", "repo_name", "default_branch", "stars", "forks", "created_at", + "last_activity_at", "languages", "issues_open", "issues_closed", + "organization", "repo_url" +) + +expect_package_usage_table <- function(object, add_col = NULL) { + expect_s3_class(object, "data.frame") + expect_named(object, c("repo_name", "repo_url", "api_url", "package_usage")) + expect_gt(nrow(object), 0) +} + +expect_repos_table <- function(pull_repos_object, add_col = NULL) { + repo_cols <- c( + repo_table_colnames, add_col + ) + expect_s3_class(pull_repos_object, "data.frame") + expect_named(pull_repos_object, repo_cols) + expect_gt(nrow(pull_repos_object), 0) +} + +expect_commits_table <- function(pull_commits_object, with_stats = TRUE) { + commit_cols <- c( + "id", "committed_date", "author", "additions", "deletions", + "repository", "organization", "api_url" + ) + expect_s3_class(pull_commits_object, "data.frame") + expect_named(pull_commits_object, commit_cols) + expect_gt(nrow(pull_commits_object), 0) + expect_s3_class(pull_commits_object$committed_date, "POSIXt") + if (with_stats) { + expect_type(pull_commits_object$additions, "integer") + expect_type(pull_commits_object$deletions, "integer") + } +} + +expect_users_table <- function(get_user_object, one_user = FALSE) { + user_cols <- c( + "id", "name", "login", "email", "location", "starred_repos", + "commits", "issues", "pull_requests", "reviews", + "avatar_url", "web_url" + ) + expect_named(get_user_object, user_cols) + if (one_user) { + expect_equal(nrow(get_user_object), 1) + } else { + expect_gt(nrow(get_user_object), 1) + } +} + +expect_files_table <- function(files_object) { + expect_s3_class(files_object, "data.frame") + expect_named( + files_object, + c("repo_name", "repo_id", "organization", + "file_path", "file_content", "file_size", + "repo_url", "api_url") + ) + expect_type(files_object$file_size, "integer") + expect_type(files_object$api_url, "character") + expect_true( + all(purrr::map_lgl(files_object$api_url, ~ grepl("api", .))) + ) + expect_gt(nrow(files_object), 0) +} + +expect_empty_table <- function(object) { + expect_s3_class(object, "data.frame") + expect_equal(nrow(object), 0) +} diff --git a/tests/testthat/helper-fixtures.R b/tests/testthat/helper-fixtures.R index 769a3baa..865c3275 100644 --- a/tests/testthat/helper-fixtures.R +++ b/tests/testthat/helper-fixtures.R @@ -29,3 +29,7 @@ test_fixtures$half_empty_gql_response <- list( ) ) ) + +test_fixtures$gl_search_response <- list( + +) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index d7df7375..01c0015f 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -51,144 +51,6 @@ expect_tailored_commits_list <- function(object) { ) } -expect_gl_repos <- function(object) { - expect_type( - object, - "list" - ) - expect_list_contains( - object[[1]], - c( - "id", "description", "name", "name_with_namespace", "path" - ) - ) -} - -expect_gl_repos_gql_response <- function(object) { - expect_type( - object, - "list" - ) - expect_list_contains( - object$data$group$projects$edges[[1]]$node, - c( - "id", "name", "repository", "stars", "forks", "created_at", "last_activity_at" - ) - ) -} - -expect_gh_repos <- function(object) { - expect_type( - object, - "list" - ) - expect_list_contains( - object, - "data" - ) - expect_list_contains( - object$data$repositoryOwner$repositories$nodes[[1]], - c( - "id", "name", "stars", "forks", "created_at", - "last_activity_at", "languages", "issues_open", "issues_closed", - "repo_url" - ) - ) -} - -expect_gh_user_repos <- function(object) { - expect_type( - object, - "list" - ) - expect_list_contains( - object, - "data" - ) - expect_list_contains( - object$data$user$repositories$nodes[[1]], - c( - "id", "name", "stars", "forks", "created_at", - "last_activity_at", "languages", "issues_open", "issues_closed", - "repo_url" - ) - ) -} - -expect_gl_commit_rest <- function(object) { - expect_type( - object, - "list" - ) - expect_list_contains( - object[[1]], - c( - "id", "short_id", "created_at", "parent_ids", "title", "message", - "author_name", "author_email", "authored_date", "committer_name", - "committer_email" - ) - ) -} - -expect_gh_commit_rest <- function(object) { - expect_type( - object, - "list" - ) - expect_gt( - length(object), - 0 - ) - expect_list_contains(object[[1]], - c("sha", "node_id", "commit", "url", - "html_url", "comments_url", "author", - "committer", "parents")) -} - -expect_gh_commit_gql <- function(object) { - expect_type( - object, - "list" - ) - expect_list_contains( - object, - "data" - ) - expect_list_contains( - object$data$repository$defaultBranchRef$target$history$edges[[1]]$node, - c("id", "committed_date", "author", "additions", "deletions") - ) -} - -expect_user_gql_response <- function(object) { - expect_list_contains( - object, - "data" - ) - expect_list_contains( - object$data, - "user" - ) - expect_list_contains( - object$data$user, - c("id", "name", "email", "location", "starred_repos", "avatar_url", "web_url") - ) -} - -expect_gl_search_response <- function(object) { - expect_list_contains( - object, - c("basename", "data", "path", "filename", "id", "ref", "startline", "project_id") - ) -} - -expect_gh_search_response <- function(object) { - expect_list_contains( - object, - c("name", "path", "sha", "url", "git_url", "html_url", "repository", "score") - ) -} - expect_list_contains <- function(object, elements) { act <- quasi_label(rlang::enquo(object), arg = "object") act$check <- any(elements %in% names(act$val)) @@ -210,130 +72,3 @@ expect_list_contains_only <- function(object, elements) { invisible(act$val) } - -expect_user_table <- function(get_user_object) { - user_cols <- c( - "id", "name", "login", "email", "location", "starred_repos", - "commits", "issues", "pull_requests", "reviews", - "avatar_url", "web_url" - ) - expect_named(get_user_object, user_cols) - expect_equal(nrow(get_user_object), 1) -} - -expect_users_table <- function(get_user_object) { - user_cols <- c( - "id", "name", "login", "email", "location", "starred_repos", - "commits", "issues", "pull_requests", "reviews", - "avatar_url", "web_url" - ) - expect_named(get_user_object, user_cols) - expect_gt(nrow(get_user_object), 1) -} - -repo_table_colnames <- c( - "id", "name", "default_branch", "stars", "forks", "created_at", - "last_activity_at", "languages", "issues_open", "issues_closed", - "organization", "repo_url" -) - -expect_repos_table_with_contributors <- function(pull_repos_object) { - repo_cols <- c( - repo_table_colnames, "contributors" - ) - expect_s3_class(pull_repos_object, "data.frame") - expect_named(pull_repos_object, repo_cols) - expect_gt(nrow(pull_repos_object), 0) -} - -expect_repos_table_with_api_url <- function(pull_repos_object) { - repo_cols <- c( - repo_table_colnames, "api_url" - ) - expect_s3_class(pull_repos_object, "data.frame") - expect_named(pull_repos_object, repo_cols) - expect_gt(nrow(pull_repos_object), 0) -} - -expect_repos_table <- function(pull_repos_object) { - expect_s3_class(pull_repos_object, "data.frame") - expect_named(pull_repos_object, repo_table_colnames) - expect_gt(nrow(pull_repos_object), 0) -} - -expect_commits_table <- function(pull_commits_object, with_stats = TRUE) { - commit_cols <- c( - "id", "committed_date", "author", "additions", "deletions", - "repository", "organization", "api_url" - ) - expect_s3_class(pull_commits_object, "data.frame") - expect_named(pull_commits_object, commit_cols) - expect_gt(nrow(pull_commits_object), 0) - expect_s3_class(pull_commits_object$committed_date, "POSIXt") - if (with_stats) { - expect_type(pull_commits_object$additions, "integer") - expect_type(pull_commits_object$deletions, "integer") - } -} - -expect_empty_table <- function(object) { - expect_s3_class(object, "data.frame") - expect_equal(nrow(object), 0) -} - -expect_github_files_response <- function(object) { - expect_type( - object, - "list" - ) - expect_gt( - length(object), - 0 - ) - purrr::walk(object, function(repository) { - expect_list_contains( - repository, - c("name", "id", "object") - ) - expect_list_contains( - repository$object, - c("text", "byteSize") - ) - }) -} - -expect_gitlab_files_response <- function(object) { - expect_type( - object, - "list" - ) - expect_gt( - length(object), - 0 - ) - purrr::walk(object, function(project) { - expect_list_contains( - project, - c( - "name", "id", "repository" - ) - ) - expect_list_contains( - project$repository$blobs$nodes[[1]], - c( - "name", "rawBlob", "size" - ) - ) - }) -} - -expect_files_table <- function(files_object) { - expect_s3_class(files_object, "data.frame") - expect_named(files_object, c("repository_name", "repository_id", "organization", "file_path", "file_content", "file_size", "api_url")) - expect_type(files_object$file_size, "integer") - expect_type(files_object$api_url, "character") - expect_true( - all(purrr::map_lgl(files_object$api_url, ~ grepl("api", .))) - ) - expect_gt(nrow(files_object), 0) -} diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index aecbe8fc..cd9ebdd0 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -12,6 +12,15 @@ test_team <- list( ) ) +test_settings <- list( + search_param = "org", + phrase = NULL, + team_name = NULL, + team = list(), + language = "All", + print_out = TRUE +) + if (nchar(Sys.getenv("GITHUB_PAT")) == 0) { cli::cli_abort(c( "x" = "You did not set up your GITHUB_PAT environment variable.", diff --git a/tests/testthat/test-01-GQLQueryGitLab.R b/tests/testthat/test-01-GQLQueryGitLab.R index d7b213d3..ac7374c6 100644 --- a/tests/testthat/test-01-GQLQueryGitLab.R +++ b/tests/testthat/test-01-GQLQueryGitLab.R @@ -18,10 +18,15 @@ test_that("user query is built properly", { test_mocker$cache(gl_user_query) }) -test_that("file query is built properly", { +test_that("file queries are built properly", { gl_files_query <- test_gqlquery_gl$files_by_org() expect_snapshot( gl_files_query ) + gl_repo_files_query <- + test_gqlquery_gl$files_from_repo() + expect_snapshot( + gl_repo_files_query + ) }) diff --git a/tests/testthat/test-02-EngineGraphQL.R b/tests/testthat/test-02-EngineGraphQL.R index c2c18db4..6a724bfe 100644 --- a/tests/testthat/test-02-EngineGraphQL.R +++ b/tests/testthat/test-02-EngineGraphQL.R @@ -11,7 +11,7 @@ test_that("`gql_response()` work as expected for GitHub", { gh_commits_by_repo_gql_response <- test_gql$gql_response( test_mocker$use("gh_commits_by_repo_query") ) - expect_gh_commit_gql( + expect_gh_commit_gql_response( gh_commits_by_repo_gql_response ) test_mocker$cache(gh_commits_by_repo_gql_response) @@ -20,7 +20,7 @@ test_that("`gql_response()` work as expected for GitHub", { test_mocker$use("gh_repos_by_org_query"), vars = list(org = "r-world-devs") ) - expect_gh_repos( + expect_gh_repos_gql_response( gh_repos_by_org_gql_response ) test_mocker$cache(gh_repos_by_org_gql_response) @@ -29,7 +29,7 @@ test_that("`gql_response()` work as expected for GitHub", { test_mocker$use("gh_repos_by_user_query"), vars = list(user = "maciekbanas") ) - expect_gh_user_repos( + expect_gh_user_repos_gql_response( gh_repos_by_user_gql_response ) test_mocker$cache(gh_repos_by_user_gql_response) diff --git a/tests/testthat/test-02-EngineRest.R b/tests/testthat/test-02-EngineRest.R index 0917dad3..7f706ab0 100644 --- a/tests/testthat/test-02-EngineRest.R +++ b/tests/testthat/test-02-EngineRest.R @@ -16,7 +16,6 @@ test_that("When token is empty throw error", { test_that("`perform_request()` returns proper status when token is empty or invalid", { wrong_tokens <- c("", "bad_token") - purrr::walk( wrong_tokens, ~ expect_message( @@ -31,11 +30,12 @@ test_that("`perform_request()` returns proper status when token is empty or inva test_that("`perform_request()` throws error on bad host", { bad_host <- "https://github.bad_host.com" - expect_error( - test_rest_priv$perform_request( - endpoint = paste0(bad_host, "/orgs/good_org"), - token = Sys.getenv("GITHUB_PAT") + suppressMessages( + test_rest_priv$perform_request( + endpoint = paste0(bad_host), + token = Sys.getenv("GITHUB_PAT") + ) ), "Could not resolve host" ) @@ -43,7 +43,6 @@ test_that("`perform_request()` throws error on bad host", { test_that("`perform_request()` returns proper status", { bad_endpoint <- "https://api.github.com/orgs/everybody_loves_somebody" - expect_message( test_rest_priv$perform_request( endpoint = bad_endpoint, @@ -56,10 +55,9 @@ test_that("`perform_request()` returns proper status", { # public methods test_that("`response()` returns search response from GitHub's REST API", { - search_endpoint <- "https://api.github.com/search/code?q='shiny'+user:openpharma" + search_endpoint <- "https://api.github.com/search/code?q=shiny+user:openpharma" test_mocker$cache(search_endpoint) gh_search_response <- test_rest$response(search_endpoint) - expect_gh_search_response( gh_search_response$items[[1]] ) @@ -73,7 +71,7 @@ test_rest <- create_testrest( test_that("`response()` returns commits response from GitLab's REST API", { gl_search_response <- test_rest$response( - "https://gitlab.com/api/v4/groups/9970/search?scope=blobs&search=covid" + "https://gitlab.com/api/v4/groups/9970/search?scope=blobs&search=git" ) expect_gl_search_response(gl_search_response[[1]]) test_mocker$cache(gl_search_response) @@ -81,7 +79,7 @@ test_that("`response()` returns commits response from GitLab's REST API", { gl_commits_rest_response_repo_1 <- test_rest$response( "https://gitlab.com/api/v4/projects/44293594/repository/commits?since='2023-01-01T00:00:00'&until='2023-04-20T00:00:00'&with_stats=true" ) - expect_gl_commit_rest( + expect_gl_commit_rest_response( gl_commits_rest_response_repo_1 ) test_mocker$cache(gl_commits_rest_response_repo_1) @@ -89,7 +87,7 @@ test_that("`response()` returns commits response from GitLab's REST API", { gl_commits_rest_response_repo_2 <- test_rest$response( "https://gitlab.com/api/v4/projects/44346961/repository/commits?since='2023-01-01T00:00:00'&until='2023-04-20T00:00:00'&with_stats=true" ) - expect_gl_commit_rest( + expect_gl_commit_rest_response( gl_commits_rest_response_repo_2 ) test_mocker$cache(gl_commits_rest_response_repo_2) diff --git a/tests/testthat/test-03-EngineGraphQLGitHub.R b/tests/testthat/test-03-EngineGraphQLGitHub.R index 364a6d43..19384def 100644 --- a/tests/testthat/test-03-EngineGraphQLGitHub.R +++ b/tests/testthat/test-03-EngineGraphQLGitHub.R @@ -25,7 +25,7 @@ test_that("`pull_commits_page_from_repo()` pulls commits page from repository", date_from = "2023-01-01", date_until = "2023-02-28" ) - expect_gh_commit_gql( + expect_gh_commit_gql_response( commits_page ) test_mocker$cache(commits_page) @@ -41,7 +41,7 @@ test_that("`pull_repos_page_from_org()` pulls repos page from GitHub organizatio from = "org", org = "r-world-devs" ) - expect_gh_repos( + expect_gh_repos_gql_response( gh_repos_page ) test_mocker$cache(gh_repos_page) @@ -78,7 +78,7 @@ test_that("`pull_repos_page()` pulls repos page from GitHub user", { from = "user", user = "maciekbanas" ) - expect_gh_user_repos( + expect_gh_user_repos_gql_response( gh_repos_user_page ) test_mocker$cache(gh_repos_user_page) @@ -200,8 +200,9 @@ test_that("GitHub prepares user table", { gh_user_table <- test_gql_gh$prepare_user_table( user_response = test_mocker$use("gh_user_response") ) - expect_user_table( - gh_user_table + expect_users_table( + gh_user_table, + one_user = TRUE ) test_mocker$cache(gh_user_table) }) @@ -239,11 +240,10 @@ test_that("`pull_repos()` works as expected", { "private$pull_repos", test_mocker$use("gh_repos_from_org") ) - settings <- list(search_param = "org") expect_snapshot( gh_repos_org <- test_gql_gh$pull_repos( org = "r-world-devs", - settings = settings + settings = test_settings ) ) expect_repos_table( @@ -255,14 +255,13 @@ test_that("`pull_repos()` works as expected", { "private$pull_repos_from_team", test_mocker$use("gh_repos_from_team") ) - settings <- list( - search_param = "team", - team = test_team - ) + test_settings[["search_param"]] <- "team" + test_settings[["team"]] <- test_team + expect_snapshot( gh_repos_team <- test_gql_gh$pull_repos( org = "r-world-devs", - settings = settings + settings = test_settings ) ) expect_repos_table( @@ -284,7 +283,7 @@ test_that("`pull_commits()` retrieves commits in the table format", { ) repos_table <- test_mocker$use("gh_repos_table") %>% - dplyr::filter(name == "GitStats") + dplyr::filter(repo_name == "GitStats") mockery::stub( test_gql_gh$pull_commits, @@ -292,14 +291,12 @@ test_that("`pull_commits()` retrieves commits in the table format", { repos_table ) - settings <- list(search_param = "org") - expect_snapshot( commits_table <- test_gql_gh$pull_commits( org = "r-world-devs", date_from = "2023-01-01", date_until = "2023-02-28", - settings = settings + settings = test_settings ) ) diff --git a/tests/testthat/test-03-EngineGraphQLGitLab.R b/tests/testthat/test-03-EngineGraphQLGitLab.R index 1eb914b0..da0127e8 100644 --- a/tests/testthat/test-03-EngineGraphQLGitLab.R +++ b/tests/testthat/test-03-EngineGraphQLGitLab.R @@ -95,8 +95,9 @@ test_that("GitLab prepares user table", { gl_user_table <- test_gql_gl$prepare_user_table( user_response = test_mocker$use("gl_user_response") ) - expect_user_table( - gl_user_table + expect_users_table( + gl_user_table, + one_user = TRUE ) test_mocker$cache(gl_user_table) }) @@ -110,6 +111,14 @@ test_that("GitLab GraphQL Engine pulls files from a group", { test_mocker$cache(gitlab_files_response) }) +test_that("GitLab GraphQL Engine pulls files from a repository", { + gitlab_files_response <- test_gql_gl$pull_file_from_repos( + file_path = "meta_data.yaml", + repos_table = test_mocker$use("gl_repos_table") + ) + expect_gitlab_files_response(gitlab_files_response) +}) + test_that("GitLab GraphQL Engine prepares table from files response", { files_table <- test_gql_gl$prepare_files_table( files_response = test_mocker$use("gitlab_files_response"), @@ -132,11 +141,10 @@ test_that("`pull_repos()` works as expected", { "private$pull_repos", test_mocker$use("gl_repos_from_org") ) - settings <- list(search_param = "org") expect_snapshot( gl_repos_org <- test_gql_gl$pull_repos( org = "mbtests", - settings = settings + settings = test_settings ) ) expect_repos_table( diff --git a/tests/testthat/test-03-EngineRestGitHub.R b/tests/testthat/test-03-EngineRestGitHub.R index 3caa6fd0..ebe70a8f 100644 --- a/tests/testthat/test-03-EngineRestGitHub.R +++ b/tests/testthat/test-03-EngineRestGitHub.R @@ -81,7 +81,7 @@ test_that("`tailor_repos_info()` tailors precisely `repos_list`", { expect_list_contains_only( gh_repos_by_phrase_tailored[[1]], c( - "id", "name", "created_at", "last_activity_at", + "repo_id", "repo_name", "created_at", "last_activity_at", "forks", "stars", "issues_open", "issues_closed", "organization" ) @@ -128,7 +128,7 @@ test_that("`pull_commits_from_repo()` pulls all commits from repository", { date_from = "2023-01-01", date_until = "2023-06-01" ) - expect_gh_commit_rest( + expect_gh_commit_rest_response( commits_from_repo ) }) @@ -141,7 +141,7 @@ test_that("`pull_commits_from_org()` pulls all commits from organization", { date_until = "2023-06-01" ) }) - expect_gh_commit_rest( + expect_gh_commit_rest_response( gh_rest_commits_from_org[[1]] ) test_mocker$cache(gh_rest_commits_from_org) @@ -152,7 +152,7 @@ test_that("`filter_commits_by_team()` filters properly commits by team members", repos_list_with_commits = test_mocker$use("gh_rest_commits_from_org"), team = test_team ) - expect_gh_commit_rest( + expect_gh_commit_rest_response( gh_rest_team_commits[[1]] ) expect_true( @@ -212,8 +212,9 @@ test_that("`pull_repos_contributors()` adds contributors to repos table", { test_mocker$use("gh_repos_by_phrase_table") ) ) - expect_repos_table_with_contributors( - gh_repos_by_phrase_table + expect_repos_table( + gh_repos_by_phrase_table, + add_col = "contributors" ) expect_gt( length(gh_repos_by_phrase_table$contributors), @@ -229,15 +230,13 @@ test_that("`pull_repos()` works", { test_mocker$use("gh_repos_by_phrase") ) - settings <- list( - search_param = "phrase", - phrase = "shiny" - ) + test_settings[["search_param"]] <- "phrase" + test_settings[["phrase"]] <- "shiny" expect_snapshot( result <- test_rest$pull_repos( org = "r-world-devs", - settings = settings + settings = test_settings ) ) @@ -260,9 +259,6 @@ test_that("supportive method for getting commits works", { "private$pull_commits_stats", test_mocker$use("gh_rest_commits_table_with_stats") ) - test_settings <- list( - search_param = "org" - ) expect_snapshot( gh_rest_commits_table <- test_rest$pull_commits_supportive( org = "r-world-devs", diff --git a/tests/testthat/test-03-EngineRestGitLab.R b/tests/testthat/test-03-EngineRestGitLab.R index a3d305cb..466c8638 100644 --- a/tests/testthat/test-03-EngineRestGitLab.R +++ b/tests/testthat/test-03-EngineRestGitLab.R @@ -24,7 +24,7 @@ test_that("`find_repos_by_id()` works", { gl_search_repos_by_phrase <- test_rest_priv$find_repos_by_id( gl_search_response ) - expect_gl_repos( + expect_gl_repos_rest_response( gl_search_repos_by_phrase ) test_mocker$cache(gl_search_repos_by_phrase) @@ -42,20 +42,8 @@ test_that("`pull_repos_languages` works", { ) }) -test_that("`search_repos_by_phrase()` works", { - gl_repos_by_phrase <- test_rest_priv$search_repos_by_phrase( - phrase = "covid", - org = "gitlab-org" - ) - expect_list_contains( - gl_repos_by_phrase[[1]], - c("id", "description", "name", "created_at", "languages") - ) - test_mocker$cache(gl_repos_by_phrase) -}) - test_that("`tailor_repos_info()` tailors precisely `repos_list`", { - gl_repos_by_phrase <- test_mocker$use("gl_repos_by_phrase") + gl_repos_by_phrase <- test_mocker$use("gl_search_repos_by_phrase") gl_repos_by_phrase_tailored <- test_rest_priv$tailor_repos_info(gl_repos_by_phrase) @@ -67,17 +55,15 @@ test_that("`tailor_repos_info()` tailors precisely `repos_list`", { expect_list_contains_only( gl_repos_by_phrase_tailored[[1]], c( - "id", "name", "created_at", "last_activity_at", + "repo_id", "repo_name", "created_at", "last_activity_at", "forks", "stars", "languages", "issues_open", "issues_closed", "organization" ) ) - expect_lt( length(gl_repos_by_phrase_tailored[[1]]), length(gl_repos_by_phrase[[1]]) ) - test_mocker$cache(gl_repos_by_phrase_tailored) }) @@ -106,7 +92,7 @@ test_that("`pull_commits_from_org()` pulls commits from repo", { date_from = "2023-01-01", date_until = "2023-04-20" ) - expect_gl_commit_rest( + expect_gl_commit_rest_response( gl_commits_org[[1]] ) test_mocker$cache(gl_commits_org) @@ -124,7 +110,7 @@ test_that("`filter_commits_by_team()` filters commits by team", { repos_list_with_commits = gl_commits_org, team = team ) - expect_gl_commit_rest( + expect_gl_commit_rest_response( gl_commits_team[[1]] ) test_mocker$cache(gl_commits_team) @@ -199,8 +185,9 @@ test_that("`pull_repos_contributors()` adds contributors to repos table", { test_mocker$use("gl_repos_table") ) ) - expect_repos_table_with_contributors( - gl_repos_table_with_contributors + expect_repos_table( + gl_repos_table_with_contributors, + add_col = "contributors" ) expect_gt( length(gl_repos_table_with_contributors$contributors), @@ -213,17 +200,14 @@ test_that("`pull_repos_by_phrase()` works", { mockery::stub( test_rest$pull_repos, "private$search_repos_by_phrase", - test_mocker$use("gl_repos_by_phrase") - ) - - settings <- list( - search_param = "phrase", - phrase = "covid" + test_mocker$use("gl_search_repos_by_phrase") ) + test_settings[["search_param"]] <- "phrase" + test_settings[["phrase"]] <- "covid" expect_snapshot( result <- test_rest$pull_repos( - org = "erasmusmc-public-health", - settings = settings + org = "gitlab-org", + settings = test_settings ) ) expect_repos_table(result) @@ -235,15 +219,12 @@ test_that("`pull_commits()` works as expected", { "private$pull_commits_from_org", test_mocker$use("gl_commits_org") ) - settings <- list( - search_param = "org" - ) expect_snapshot( result <- test_rest$pull_commits( org = "mbtests", date_from = "2023-01-01", date_until = "2023-04-20", - settings = settings + settings = test_settings ) ) expect_commits_table(result) @@ -253,7 +234,6 @@ test_that("`pull_commits()` works as expected", { test_that("Engine filters GitLab repositories' table by team members", { gl_repos_table <- test_mocker$use("gl_repos_table_with_contributors") - gl_repos_table_team <- test_rest_priv$filter_repos_by_team( gl_repos_table, team = list( diff --git a/tests/testthat/test-05-GitHost.R b/tests/testthat/test-05-GitHost.R index b1a52ace..a9e11253 100644 --- a/tests/testthat/test-05-GitHost.R +++ b/tests/testthat/test-05-GitHost.R @@ -149,9 +149,8 @@ test_that("`set_gql_url()` correctly sets gql api url - for public GitLab", { }) test_that("GitHost pulls repos from orgs", { - settings <- list(search_param = "org") expect_snapshot( - gh_repos_table <- test_host$pull_repos_from_orgs(settings) + gh_repos_table <- test_host$pull_repos_from_orgs(test_settings) ) expect_repos_table( gh_repos_table @@ -286,27 +285,6 @@ test_that("GitHost filters GitLab repositories' (pulled by team) table by langua ) }) -test_that("GitHost filters GitLab repositories' (pulled by phrase) table by languages", { - gl_repos_table <- test_mocker$use("gl_repos_by_phrase_table") - expect_snapshot( - result <- test_host$filter_repos_by_language( - gl_repos_table, - language = "C" - ) - ) - expect_length( - result, - length(gl_repos_table) - ) - expect_gt( - nrow(result), - 0 - ) - expect_true( - all(grepl("C", result$languages)) - ) -}) - # public methods test_host <- create_testhost( @@ -323,12 +301,12 @@ test_that("pull_repos returns table of repositories", { ) expect_snapshot( repos_table <- test_host$pull_repos( - settings = list(search_param = "org", - language = "All") + settings = test_settings ) ) - expect_repos_table_with_api_url( - repos_table + expect_repos_table( + repos_table, + add_col = "api_url" ) }) @@ -363,11 +341,12 @@ test_that("pull_repos_contributors returns table with contributors for GitLab", }) test_that("pull_commits throws error when search param is set to `phrase`", { + test_settings[["search_param"]] <- "phrase" expect_snapshot_error( test_gl_host$pull_commits( date_from = "2023-03-01", date_until = "2023-04-01", - settings = list(search_param = "phrase") + settings = test_settings ) ) }) @@ -377,7 +356,7 @@ test_that("pull_commits for GitLab works", { gl_commits_table <- test_gl_host$pull_commits( date_from = "2023-03-01", date_until = "2023-04-01", - settings = list(search_param = "org") + settings = test_settings ) ) expect_commits_table( @@ -390,7 +369,7 @@ test_that("pull_commits for GitHub works", { gh_commits_table <- test_host$pull_commits( date_from = "2023-03-01", date_until = "2023-04-01", - settings = list(search_param = "org") + settings = test_settings ) ) expect_commits_table( diff --git a/tests/testthat/test-06-GitStats.R b/tests/testthat/test-06-GitStats.R index 0c3cb255..02966fd3 100644 --- a/tests/testthat/test-06-GitStats.R +++ b/tests/testthat/test-06-GitStats.R @@ -29,7 +29,7 @@ test_that("GitStats prints team name when team is added.", { }) # private methods -test_gitstats_priv <- create_test_gitstats(priv_mode = TRUE) +test_gitstats_priv <- create_test_gitstats(hosts = 0, priv_mode = TRUE) test_that("Language handler works properly", { expect_equal(test_gitstats_priv$language_handler("r"), "R") @@ -37,12 +37,30 @@ test_that("Language handler works properly", { expect_equal(test_gitstats_priv$language_handler("javascript"), "Javascript") }) -test_that("check_for_host works", { +test_that("check_for_host returns error when no hosts are passed", { expect_snapshot_error( test_gitstats_priv$check_for_host() ) }) +test_gitstats_priv <- create_test_gitstats(hosts = 1, priv_mode = TRUE) + +test_that("check_R_package_loading", { + suppressMessages( + R_package_loading <- test_gitstats_priv$check_R_package_loading("purrr") + ) + expect_package_usage_table(R_package_loading) + test_mocker$cache(R_package_loading) +}) + +test_that("check_R_package_as_dependency", { + suppressMessages( + R_package_as_dependency <- test_gitstats_priv$check_R_package_as_dependency("purrr") + ) + expect_package_usage_table(R_package_as_dependency) + test_mocker$cache(R_package_as_dependency) +}) + # public methods test_that("GitStats get users info", { @@ -63,8 +81,9 @@ test_that("pull_repos works properly", { suppressMessages( test_gitstats$pull_repos() ) - expect_repos_table_with_api_url( - test_gitstats$get_repos() + expect_repos_table( + test_gitstats$get_repos(), + add_col = "api_url" ) }) @@ -152,3 +171,25 @@ test_that("subgroups are cleanly printed in GitStats", { test_gitstats ) }) + +test_that("pull_R_package_usage works as expected", { + test_gitstats <- create_test_gitstats(hosts = 1) + mockery::stub( + test_gitstats$pull_R_package_usage, + "private$check_R_package_as_dependency", + test_mocker$use("R_package_as_dependency") + ) + mockery::stub( + test_gitstats$pull_R_package_usage, + "private$check_R_package_loading", + test_mocker$use("R_package_loading") + ) + suppressMessages( + test_gitstats$pull_R_package_usage( + "purrr" + ) + ) + expect_package_usage_table( + test_gitstats$.__enclos_env__$private$R_package_usage + ) +}) diff --git a/tests/testthat/test-07-pull.R b/tests/testthat/test-07-pull.R index c9cb07c6..0cb64309 100644 --- a/tests/testthat/test-07-pull.R +++ b/tests/testthat/test-07-pull.R @@ -4,7 +4,7 @@ test_that("pull_repos pulls repos in the table format", { pull_repos(test_gitstats) ) repos_table <- test_gitstats$get_repos() - expect_repos_table_with_api_url(repos_table) + expect_repos_table(repos_table, add_col = "api_url") }) test_that("pull_repos_contributors adds contributors column to repos table", {