diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..fa96bd9 --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,25 @@ +Package: PaRe +Type: Package +Title: A Way to Perform Code Review or QA on Other Packages +Version: 0.1.6 +Language: en-US +Authors@R: + person("Maarten", "van Kessel", email = "m.l.vankessel@erasmusmc.nl", + role = c("aut", "cre")) +Description: Reviews other packages during code review by looking at their + dependencies, code style, code complexity, and how internally defined + functions interact with one another. +License: Apache License (>= 2) +Encoding: UTF-8 +RoxygenNote: 7.2.3 +Imports: cli, cyclocomp, desc, DiagrammeR, DiagrammeRsvg, dplyr, glue, + lintr, magrittr, pak, rmarkdown, rsvg, stringr, igraph, utils, + R6, git2r, checkmate +Suggests: ggplot2, plotly, ggraph, DT, magick, withr, cowplot, knitr +VignetteBuilder: knitr +NeedsCompilation: no +Packaged: 2023-06-01 12:52:15 UTC; mvankessel +Author: Maarten van Kessel [aut, cre] +Maintainer: Maarten van Kessel +Repository: CRAN +Date/Publication: 2023-06-02 14:20:02 UTC diff --git a/MD5 b/MD5 new file mode 100644 index 0000000..f5b78ec --- /dev/null +++ b/MD5 @@ -0,0 +1,72 @@ +1519f8c68904fd60ab2bf7cb5d98ebe7 *DESCRIPTION +1f8872827c5944a4083e3a67e01f02d0 *NAMESPACE +aad2cad56d82c4b5e9ee1ec417d26814 *NEWS.md +5c8bca3dc5926d17a2a309d1dbc4c7bf *R/PaRe-package.R +690883c60013852f5e1e67c9e1e20c61 *R/R6-Code.R +9f0aa369b24fc227f2ed394b6a74331e *R/R6-File.R +d25793e59157161699a9e85b28d038c3 *R/R6-Function.R +c3d6fd02375b2a402a2fa2278561d38f *R/R6-Repository.R +759240826d491eb327652b7ad6de4c1e *R/callInvestigators.R +fbc031d8397fe8efb4d64f6cdc05c7c3 *R/checkDependencies.R +52ccf7d4a66821ba4cc94aa1db884cc7 *R/countPackageLines.R +37cbb3dc068ad015a9c72a647c7ca331 *R/getDefaultPermittedPackages.R +e95fbb0329c0e82edd8ffd93e3bc909e *R/getDefinedFunctions.R +69852b6bfc046756a05a93a2e2d3a023 *R/getFunctionDiagram.R +4d443a770d57ac467518f85be4908f08 *R/getFunctionUse.R +c08fe9be2825ff23a9e8e6373c72dbf2 *R/getGraphData.R +104933a17bab0332671d5df4c421eaaf *R/lint.R +fed35bb6ac121b590457b12920738143 *R/makeReport.R +22cf21bc6d779cfaf99249dfb069aefc *R/pkgDiagram.R +cf794928715019cf81bd51d467156178 *R/utils-pipe.R +b2680f14304ba0e862d85ce606ebffa2 *README.md +743e77e9164f0eabaeade4b1262a0267 *build/vignette.rds +b29edef0eaedf18b9a00f64e65c4647c *inst/WORDLIST +9c8d99b624a6acc9e819124ef5d0fa37 *inst/doc/Documentation.R +3e92daaaab2b0928ef8d0d4d75b2217f *inst/doc/Documentation.Rmd +f5e2df68ae4391463d9649a9f12930a8 *inst/doc/Documentation.html +d62b3c4c1af50d76ef77784a8cb26bd1 *inst/img/logo.png +a48bb48401b7f3d9405b85111c0a6262 *inst/rmd/ReportInjectable.Rmd +70fbd9c5231bc16201c45c9c271d8f2b *inst/rmd/report.Rmd +40a1c71111751992f944d14f4c839718 *inst/testScript.R +1c6f840fc50c6d11fd8c53b2cedbdb65 *inst/whiteList.csv +4fe9810cdec58eda3bfd93e477573bf0 *man/Code.Rd +fb1c213c6b9774076e61f655dbb9afc5 *man/File.Rd +e05e6a2583a3a1d45895a14c200d8487 *man/Function.Rd +0b662bfc2940703b4776f7eca130e4d9 *man/PaRe-package.Rd +2a106d209f264abd4bb8eba10424d299 *man/Repository.Rd +9efdbb8f255557ca0e1aed582a822e4a *man/checkDependencies.Rd +191038bb66a3ca92eb08629a684471fa *man/checkInstalled.Rd +5d24f00a3b1c79f76e517767facab5d9 *man/countPackageLines.Rd +a750171ab37365cf4e08891f31dfdef7 *man/exportDiagram.Rd +d62b3c4c1af50d76ef77784a8cb26bd1 *man/figures/logo.png +62e4e2187dfa893177dee47f2fc7d064 *man/functionUseGraph.Rd +d9d02cef6ba33a7b26f8af5d96a43d8d *man/funsUsedInFile.Rd +6c54a9011ed177bbc0b223d0d15ff0e4 *man/funsUsedInLine.Rd +f8ed967e0f6c6a5b2fa9b6cb484881d2 *man/getApplyCall.Rd +9b56d8b89ccfab34cbbd51ff0ae46455 *man/getApplyFromLines.Rd +9449067e6d546c8e59e6263344857a4e *man/getDefaultPermittedPackages.Rd +0887d0268048f11b856276cd43dbf7fc *man/getDefinedFunctions.Rd +bd79616a02aeb7b24252589b8e791e44 *man/getDlplyCall.Rd +db99b8a1b7df318559684f9059d18afb *man/getDlplyCallFromLines.Rd +90b311a7a4cf0ac0b8e02c9aee9c3c6b *man/getDoCall.Rd +25c52bd7287adcf8e95cb75210714962 *man/getDoCallFromLines.Rd +3c8631da7d854f8689114201685f074d *man/getExportedFunctions.Rd +999d509f746457ee6992f6a206ebb253 *man/getFunCall.Rd +ad9da8b01b43dd94c4f1b6530fb61698 *man/getFunctionDiagram.Rd +81bb8a731d079ef3650b8c8ba3889530 *man/getFunctionUse.Rd +1704f69ebd707789588385e0e18caf77 *man/getFunsPerDefFun.Rd +d14143c9b0a631d6ee07e9da956d9867 *man/getGraphData.Rd +6a06c7ec69c0448aebb99477a73c2448 *man/getMultiLineFun.Rd +712130e4b2595aa06645060ecf99b684 *man/getVersionDf.Rd +96a5525f819d289864457554355638ee *man/graphToDot.Rd +3317219e33b132612ef58ffe716c6122 *man/lintRepo.Rd +1661e131088af5b3b005be41f40886f5 *man/lintScore.Rd +9d46ba40fef91083f85bad7ab179f083 *man/makeGraph.Rd +7a9c2b84f2d796a47a21cd5f5ed6ae21 *man/makeReport.Rd +29ee7383caa7fc8c14f52bd035509064 *man/pipe.Rd +5ef87067fec0edf62a0670b70e14c467 *man/pkgDiagram.Rd +e0db61bd097f0f30c129ec957562e993 *man/printMessage.Rd +d33e53f5d0121239eb85c6150e326189 *man/whiteList.Rd +3e92daaaab2b0928ef8d0d4d75b2217f *vignettes/Documentation.Rmd +08d9d6b171b970059f24dabd6c576712 *vignettes/img/glueDiagram.svg +78c2ea0c0cc50c7ba60892bc9e42e460 *vignettes/img/glueGraph.png diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..f92d5fb --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,64 @@ +# Generated by roxygen2: do not edit by hand + +export("%>%") +export(File) +export(Function) +export(Repository) +export(checkDependencies) +export(countPackageLines) +export(exportDiagram) +export(getDefaultPermittedPackages) +export(getDefinedFunctions) +export(getFunctionDiagram) +export(getFunctionUse) +export(getGraphData) +export(lintRepo) +export(lintScore) +export(makeReport) +export(pkgDiagram) +export(whiteList) +import(DiagrammeR) +import(DiagrammeRsvg) +import(R6) +import(checkmate) +import(glue) +import(lintr) +import(pak) +import(rmarkdown) +import(rsvg) +import(stringr) +import(utils) +importFrom(cli,cli_alert) +importFrom(cli,cli_alert_danger) +importFrom(cli,cli_alert_info) +importFrom(cli,cli_alert_warning) +importFrom(cli,col_blue) +importFrom(cli,col_green) +importFrom(cli,col_magenta) +importFrom(cli,col_red) +importFrom(cli,col_yellow) +importFrom(cli,style_bold) +importFrom(cyclocomp,cyclocomp) +importFrom(desc,description) +importFrom(dplyr,arrange) +importFrom(dplyr,bind_rows) +importFrom(dplyr,filter) +importFrom(dplyr,group_by) +importFrom(dplyr,mutate) +importFrom(dplyr,relocate) +importFrom(dplyr,rename) +importFrom(dplyr,select) +importFrom(dplyr,summarise) +importFrom(dplyr,tally) +importFrom(dplyr,tibble) +importFrom(git2r,blame) +importFrom(git2r,hash) +importFrom(git2r,is_empty) +importFrom(git2r,pull) +importFrom(git2r,tree) +importFrom(igraph,V) +importFrom(igraph,all_simple_paths) +importFrom(igraph,graph_from_data_frame) +importFrom(igraph,induced_subgraph) +importFrom(igraph,write_graph) +importFrom(magrittr,"%>%") diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..663a89e --- /dev/null +++ b/NEWS.md @@ -0,0 +1,19 @@ +PaRe 0.1.6 +========== + +1. Started tracking changes in NEWS.md +2. Added significant changes to documentation. +3. Optimizations using R6 representations. +4. Added functionality to subset package diagram +5. Added git blame functionality + +PaRe 0.1.5 +========== + +1. Added R6 code representations. + +PaRe 0.1.0 +========== + +1. Initial transfer from DependencyReviewer to Package Reviewer. + diff --git a/R/PaRe-package.R b/R/PaRe-package.R new file mode 100644 index 0000000..96bb040 --- /dev/null +++ b/R/PaRe-package.R @@ -0,0 +1,67 @@ +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +#' @import utils +#' @import pak +#' @import glue +#' @import stringr +#' @import lintr +#' @import rmarkdown +#' @import DiagrammeR +#' @import DiagrammeRsvg +#' @import rsvg +#' @import R6 +#' @import checkmate +#' @importFrom igraph graph_from_data_frame V write_graph all_simple_paths induced_subgraph graph_from_data_frame +#' @importFrom cli style_bold col_yellow col_red col_magenta col_green col_blue cli_alert_warning cli_alert_info cli_alert_danger cli_alert +#' @importFrom dplyr filter tibble arrange select bind_rows select tally summarise rename relocate mutate group_by +#' @importFrom git2r pull tree hash is_empty blame +#' @importFrom desc description +#' @importFrom magrittr %>% +#' @importFrom cyclocomp cyclocomp +## usethis namespace: end +NULL + +#' whiteList +#' +#' data.frame containing links to csv-files which should be used to fetch +#' white-listed dependencies. +#' +#' By default three csv's are listed: +#' 1. darwin +#' 2. hades +#' 3. tidyverse +#' +#' The data.frame is locally fetched under: +#' `system.file(package = "PaRe", "whiteList.csv")` +#' +#' Manual insertions into this data.frame can be made, or the data.frame can +#' be overwritten entirely. +#' +#' The data.frame itself has the following structure: +#' +#' | column | data type | description | +#' | ------- | ---------------------- | ----------- | +#' | source | \link[base]{character} | name of the source | +#' | link | \link[base]{character} | link or path to the csv-file | +#' | package | \link[base]{character} | columnname of the package name column in the csv-file being linked to | +#' | version | \link[base]{character} | columnname of the version column in the csv-file being linked to | +#' +#' The csv-files that are being pointed to should have the following structure: +#' +#' @export +#' @examples +#' if (interactive()) { +#' # Dropping tidyverse +#' whiteList <- whiteList %>% +#' dplyr::filter(source != "tidyverse") +#' +#' # getDefaultPermittedPackages will now only use darwin and hades +#' getDefaultPermittedPackages() +#' } +whiteList <- dplyr::tibble(read.csv( + system.file(package = "PaRe", "whiteList.csv") +)) + +utils::globalVariables(".data") diff --git a/R/R6-Code.R b/R/R6-Code.R new file mode 100644 index 0000000..e0ef333 --- /dev/null +++ b/R/R6-Code.R @@ -0,0 +1,83 @@ +#' @title +#' R6 Code class +#' +#' @description +#' Class representing a piece of code. +#' +#' @family +#' Representations +Code <- R6::R6Class( + classname = "Code", + # Public ---- + public = list( + #' @description + #' Initializer method + #' + #' @param name (\link[base]{character})\cr + #' Name of Code object. + #' @param lines (\link[base]{character})\cr + #' Vector of lines Code object. + #' + #' @return `invisible(self)` + initialize = function(name, lines) { + private$name <- name + private$lines <- lines + private$nLines <- length(lines) + return(invisible(self)) + }, + + #' @description + #' Overload generic print, to print Code object. + #' + #' @param ... + #' further arguments passed to or from other methods. See \link[base]{print}. + #' + #' @return ([base]{character}) + print = function(...) { + classTypes <- class(self) + classTypes <- paste0(glue::glue("<{classTypes}>"), collapse = " ") + + cat( + glue::glue( + "{classTypes} + Name: {private$name} + # Lines: {private$nLines} + " + ) + ) + }, + + #' @description + #' Get method for lines. + #' + #' @return (\link[base]{character})\cr + #' Vector of lines in the Code object. + getLines = function() { + return(private$lines) + }, + + #' @description + #' Get method for number of lines. + #' + #' @return (\link[base]{numeric}) + #' Number of lines in the Code object. + getNLines = function() { + return(private$nLines) + }, + + #' @description + #' Get method for Name. + #' + #' @return (\link[base]{character})\cr + #' Name of the Code object. + getName = function() { + return(private$name) + } + ), + # Private ---- + private = list( + name = "", + lines = c(), + nLines = 0 + ) +) diff --git a/R/R6-File.R b/R/R6-File.R new file mode 100644 index 0000000..44dbdb6 --- /dev/null +++ b/R/R6-File.R @@ -0,0 +1,267 @@ +#' @title +#' R6 File class +#' +#' @description +#' Class representing a file containing code. +#' +#' @export +#' +#' @include +#' R6-Code.R +#' +#' @family +#' Representations +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' files <- repo$getRFiles() +#' files[[1]] +#' } +File <- R6::R6Class( + classname = "File", + inherit = Code, + # Public ---- + public = list( + #' @description + #' Initializer method + #' + #' @param repoPath (\link[base]{character})\cr + #' Path to repository. + #' @param filePath (\link[base]{character})\cr + #' Relative path to file + #' + #' @return `invisible(self)` + initialize = function(repoPath, filePath) { + private$repoPath <- repoPath + private$filePath <- filePath + private$name <- basename(filePath) + private$type <- stringr::str_split_i(string = private$name, pattern = "\\.", i = 2) + private$comment <- private$commentSwitch() + private$lines <- readLines(file.path(repoPath, filePath)) + + super$initialize(private$name, private$lines) + + if (private$type == "R") { + private$fetchDefinedFunctions() + } + + private$gitBlame() + return(invisible(self)) + }, + + #' @description + #' Get method to get a list of Function objects + #' + #' @return (\link[base]{list})\cr + #' List of \link[PaRe]{Function} objects. + getFunctions = function() { + return(private$functions) + }, + + #' @description + #' Get method to retrieve the function table. + #' + #' @return (\link[base]{data.frame}) + #' | column | data type | + #' | --------- | ---------------------- | + #' | name | \link[base]{character} | + #' | lineStart | \link[base]{integer} | + #' | lineEnd | \link[base]{numeric} | + #' | nArgs | \link[base]{integer} | + #' | cycloComp | \link[base]{integer} | + getFunctionTable = function() { + return(private$functionTable) + }, + + #' @description + #' Gets type of file + #' + #' @return (\link[base]{character}) + getType = function() { + return(private$type) + }, + + #' @description + #' Gets relative file path + #' + #' @return (\link[base]{character}) + getFilePath = function() { + return(private$filePath) + }, + + #' @description + #' Gets table of git blame + #' + #' @return (\link[dplyr]{tibble}) + getBlameTable = function() { + return(private$blameTable) + } + ), + # Private ---- + private = list( + repoPath = "", + filePath = "", + type = "", + functions = NULL, + comment = "", + fileFunctions = NULL, + functionTable = NULL, + blameTable = NULL, + validate = function() { + path <- normalizePath(file.path(private$repoPath, private$filePath)) + + errorMessages <- checkmate::makeAssertCollection() + checkmate::assertFileExists(path) + checkmate::reportAssertions(collection = errorMessages) + return(invisible(self)) + }, + gitBlame = function() { + b <- git2r::blame(repo = private$repoPath, path = private$filePath) + private$blameTable <- lapply(b$hunks, function(hunk) { + data.frame( + repository = basename(private$repoPath), + author = hunk$orig_signature$name, + file = basename(hunk$orig_path), + date = as.character(hunk$orig_signature$when), + lines = hunk$lines_in_hunk + ) + }) %>% + dplyr::bind_rows() %>% + dplyr::tibble() + return(invisible(self)) + }, + fetchDefinedFunctions = function() { + funStart <- grep( + pattern = "\\w+[ ]?<\\-[ ]?function\\(", + x = private$lines + ) + + funConstructor <- private$lines[funStart] + funNames <- stringr::str_extract(string = funConstructor, pattern = "[\\w\\d\\.]+") + + private$functions <- lapply(X = seq_len(length(funStart)), FUN = function(i) { + fun <- private$getBodyIndices(line = funStart[i]) + + # Create Function object + funObj <- Function$new( + name = funNames[i], + lineStart = fun$constructorStart, + lineEnd = fun$bodyEnd, + lines = private$lines[fun$constructorStart:fun$bodyEnd] + ) + + # Update functionTable + private$functionTable <- dplyr::bind_rows( + private$functionTable, + funObj$getFunction() + ) + + return(funObj) + }) + return(invisible(self)) + }, + getBetween = function(line, patOpen, patClosed) { + stop <- FALSE + lineEnd <- line + + cntOpen <- 0 + cntClosed <- 0 + + while (!stop) { + cntOpen <- cntOpen + stringr::str_count(string = private$lines[lineEnd], patOpen) + cntClosed <- cntClosed + stringr::str_count(string = private$lines[lineEnd], patClosed) + + if (cntOpen == cntClosed & length(cntOpen) > 0 | is.na(private$lines[lineEnd])) { + stop <- TRUE + } else { + lineEnd <- lineEnd + 1 + } + } + return(data.frame( + start = line, + end = lineEnd + )) + }, + getBodyIndices = function(line) { + # Parameters + switchOff <- TRUE + # Get start of body + constructor <- private$getBetween( + line = line, + patOpen = "\\(", + patClosed = "\\)" + ) + + body <- private$getBetween( + line = constructor$end, + patOpen = "\\{", + patClosed = "\\}" + ) + + return(data.frame( + constructorStart = constructor$start, + constructorEnd = constructor$end, + bodyStart = body$start, + bodyEnd = body$end + )) + }, + goToBody = function(line) { + startFun <- FALSE + bodyLine <- line + + bracOpen <- 0 + bracClosed <- 0 + + while (!startFun) { + bracOpen <- bracOpen + stringr::str_count(string = private$lines[bodyLine], "\\(") + bracClosed <- bracClosed + stringr::str_count(string = private$lines[bodyLine], "\\)") + + if (bracOpen == bracClosed & bracOpen > 0) { + startFun <- TRUE + } else { + bodyLine <- bodyLine + 1 + } + } + return(bodyLine) + }, + commentSwitch = function() { + return( + switch( + EXPR = private$type, + R = c("#"), + cpp = c("//"), + java = c("//"), + sql = c("#") + ) + ) + } + ) +) diff --git a/R/R6-Function.R b/R/R6-Function.R new file mode 100644 index 0000000..100c142 --- /dev/null +++ b/R/R6-Function.R @@ -0,0 +1,131 @@ +#' @title +#' R6 Function class. +#' +#' @description +#' Class representing a function. +#' +#' @export +#' +#' @include +#' R6-Code.R +#' +#' @family +#' Representations +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' files <- repo$getRFiles() +#' file <- files[[1]] +#' funs <- file$getFunctions() +#' funs[[1]] +#' } +Function <- R6::R6Class( + classname = "Function", + inherit = Code, + # Public ---- + public = list( + #' @description + #' Initializer for Function object. + #' + #' @param name (\link[base]{character})\cr + #' Name of Function. + #' @param lineStart (\link[base]{numeric})\cr + #' Line number where function starts in File. + #' @param lineEnd (\link[base]{numeric})\cr + #' Line number where function ends in File. + #' @param lines (\link[base]{c})\cr + #' Vector of type \link[base]{character} Lines of just the function in File. + #' + #' @return `invisible(self)` + initialize = function(name, lineStart, lineEnd, lines) { + super$initialize(name, lines) + private$lineStart <- lineStart + private$lineEnd <- lineEnd + private$nLines <- lineEnd - lineStart + 1 + private$nArgs <- private$getNArgs() + private$cycloComp <- private$computeCycloComp() + return(invisible(self)) + }, + + + #' @description + #' Get method to get defined functions in a File object. + #' + #' @return (\link[base]{data.frame}) + #' | column | data type | + #' | --------- | ------------------------ | + #' | name | (\link[base]{character}) | + #' | lineStart | (\link[base]{integer}) | + #' | lineEnd | (\link[base]{numeric}) | + #' | nArgs | (\link[base]{integer}) | + #' | cycloComp | (\link[base]{integer}) | + getFunction = function() { + return(data.frame( + name = private$name, + lineStart = private$lineStart, + lineEnd = private$lineEnd, + nArgs = private$nArgs, + cycloComp = private$cycloComp + )) + } + ), + # Private ---- + private = list( + lineStart = 0, + lineEnd = 0, + nArgs = 0, + cycloComp = 0, + validate = function() { + return(invisible(self)) + }, + getNArgs = function() { + nArgs <- private$lines[1] %>% + stringr::str_remove_all(pattern = "\\s") %>% + stringr::str_split_i(pattern = "function\\(", i = 2) %>% + stringr::str_split_i(pattern = "\\)\\{", i = 1) %>% + stringr::str_remove_all(pattern = "\\w+\\(.+\\)") %>% + stringr::str_split(pattern = ",") %>% + unlist() %>% + length() + }, + computeCycloComp = function() { + complexity <- NA + tryCatch( + { + cyclocomp::cyclocomp(eval(parse(text = private$lines))) + }, + error = function(cond) { + complexity <- NA + } + ) + } + ) +) diff --git a/R/R6-Repository.R b/R/R6-Repository.R new file mode 100644 index 0000000..a893fa2 --- /dev/null +++ b/R/R6-Repository.R @@ -0,0 +1,269 @@ +#' @title +#' R6 Repository class. +#' +#' @description +#' Class representing the Repository +#' +#' @export +#' +#' @family +#' Representations +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' repo +#' } +Repository <- R6::R6Class( + classname = "Repository", + # Public ---- + public = list( + #' @description + #' Initializer for Repository class + #' + #' @param path (\link[base]{character})\cr + #' Path to R package project + #' + #' @return `invisible(self)` + initialize = function(path) { + private$path <- normalizePath(path) + private$name <- basename(private$path) + private$git <- git2r::in_repository(private$path) + private$description <- desc::description$new(private$path) + private$functionUse <- NULL + private$validate() + + private$fetchRFiles() + private$fetchCppFiles() + private$fetchJavaFiles() + private$fetchSqlFiles() + return(invisible(self)) + }, + + #' @description + #' Get method for name. + #' + #' @return (\link[base]{character})\cr + #' Repository name + getName = function() { + return(private$name) + }, + + #' @description + #' Get method fro path + #' + #' @return (\link[base]{character})\cr + #' Path to Repository folder + getPath = function() { + return(private$path) + }, + + #' @description + #' Get method to get a list of \link[PaRe]{File} objects. + #' + #' @return (\link[base]{list})\cr + #' List of \link[PaRe]{File} objects. + getFiles = function() { + files <- list( + R = private$rFiles, + cpp = private$cppFiles, + o = private$oFiles, + h = private$hFiles, + java = private$javaFiles, + sql = private$sqlFiles + ) + return(files) + }, + + #' @description + #' Get method to get only R-files. + #' + #' @return (\link[base]{list})\cr + #' List of \link[PaRe]{File} objects. + getRFiles = function() { + return(private$rFiles) + }, + + #' @description + #' Get method to get the description of the package. See: \link[desc]{description}. + #' + #' @return (\link[desc]{description})\cr + #' Description object. + getDescription = function() { + return(private$description) + }, + + #' @description + #' Get method for functionUse, will check if functionUse has already been + #' fetched or not. + #' + #' @return (\link[base]{data.frame})\cr + #' See \link[PaRe]{getFunctionUse}. + getFunctionUse = function() { + if (is.null(private$functionUse)) { + private$functionUse <- getFunctionUse(self, verbose = TRUE) + } + return(private$functionUse) + }, + + #' @description + #' Method to run 'git checkout ' + #' + #' @param branch (\link[base]{character})\cr + #' Name of branch or a hash referencing a specific commit. + #' @param ... + #' Further parameters for \link[git2r]{checkout}. + #' + #' @return `invisible(self)` + gitCheckout = function(branch, ...) { + tryCatch( + { + git2r::checkout(object = private$path, branch = branch, ...) + message(glue::glue("Switched to: {branch}")) + message("Re-initializing") + self$initialize(path = private$path) + }, + error = function(e) { + message(glue::glue("Availible branches: {paste(names(git2r::branches(private$path)), collapse = ', ')}")) + stop(glue::glue("Branches: '{branch}' not found")) + } + ) + return(invisible(self)) + }, + + #' @description + #' Method to run 'git pull' + #' + #' @param ... + #' Further parameters for \link[git2r]{pull}. + #' + #' @return `invisible(self)` + gitPull = function(...) { + message("Pulling latest") + git2r::pull(repo = private$path, ...) + message("Re-initializing") + self$initialize(path = private$path) + return(invisible(self)) + }, + + #' @description + #' Method to fetch data generated by 'git blame'. + #' + #' @return (\link[dplyr]{tibble}) + #' | column | data type | + #' | ---------- | ---------------------- | + #' | repository | \link[base]{character} | + #' | author | \link[base]{character} | + #' | file | \link[base]{character} | + #' | date | \link[base]{character} | + #' | lines | \link[base]{integer} | + gitBlame = function() { + files <- unlist(self$getFiles()) + + dplyr::bind_rows(lapply(files, function(file) { + file$getBlameTable() + })) + } + ), + # Private ---- + private = list( + name = "name", + path = "", + rFiles = NULL, + cppFiles = NULL, + oFiles = NULL, + hFiles = NULL, + sqlFiles = NULL, + javaFiles = NULL, + git = NULL, + description = NULL, + functionUse = NULL, + validate = function() { + errorMessages <- checkmate::makeAssertCollection() + # .rproj file + rproj <- list.files(file.path(private$path), pattern = "*.Rproj", full.names = TRUE) + if (length(rproj) == 0) { + rproj <- ".Rproj" + } + checkmate::assertFileExists(rproj, add = errorMessages) + checkmate::reportAssertions(collection = errorMessages) + + status <- git2r::status(repo = private$path) + if (length(status$staged) > 0) { + warning(glue::glue("Staged chagned not committed, unexpected behaviour expected.")) + } + return(invisible(self)) + }, + fetchRFiles = function() { + paths <- list.files(file.path(private$path, "R"), full.names = FALSE, recursive = TRUE) + + private$rFiles <- unlist(lapply(paths, function(path) { + File$new(repoPath = private$path, filePath = file.path("R", path)) + })) + return(invisible(self)) + }, + fetchCppFiles = function() { + paths <- list.files(file.path(private$path, "src"), full.names = TRUE, recursive = TRUE) + + cpp <- paths[endsWith(paths, ".cpp")] + o <- paths[endsWith(paths, ".o")] + h <- paths[endsWith(paths, ".h")] + + private$cppFiles <- lapply(cpp, function(path) { + File$new(path = path) + }) + + private$oFiles <- lapply(o, function(path) { + File$new(path = path) + }) + + private$hFiles <- lapply(h, function(path) { + File$new(path = path) + }) + }, + fetchJavaFiles = function() { + paths <- list.files(file.path(private$path, "java"), full.names = TRUE, recursive = TRUE) + paths <- paths[endsWith(paths, ".java")] + + private$javaFiles <- lapply(paths, function(path) { + File$new(path = path) + }) + }, + fetchSqlFiles = function() { + paths <- list.files(file.path(private$path, "sql"), full.names = TRUE, recursive = TRUE) + paths <- append(paths, list.files(file.path(private$path, "inst", "sql"), full.names = TRUE, recursive = TRUE)) + paths <- paths[endsWith(paths, ".sql")] + + private$sqlFiles <- lapply(paths, function(path) { + File$new(path = path) + }) + } + ) +) diff --git a/R/callInvestigators.R b/R/callInvestigators.R new file mode 100644 index 0000000..d6037b3 --- /dev/null +++ b/R/callInvestigators.R @@ -0,0 +1,202 @@ +#' getMultiLineFun +#' +#' @param line (\link[base]{numeric})\cr +#' Current line number. +#' @param lines (\link[base]{c})\cr +#' Vector of (\link[base]{character}) lines. +#' +#' @return (\link[base]{character}) +getMultiLineFun <- function(line, lines) { + nLine <- line + + # Init + doCallVec <- c() + bracOpen <- 0 + bracClose <- 0 + + while (bracOpen != bracClose || bracOpen < 1 && bracClose < 1) { + if (!is.na(lines[nLine])) { + bracOpen <- bracOpen + stringr::str_count(string = lines[nLine], pattern = "\\(") + bracClose <- bracClose + stringr::str_count(string = lines[nLine], pattern = "\\)") + + doCallVec <- append(doCallVec, lines[nLine]) + } + nLine <- nLine + 1 + + if (nLine > length(lines)) { + break + } + } + return(doCallVec) +} + + +#' getDlplyCallFromLines +#' +#' @param lines (\link[base]{c})\cr +#' Vector of (\link[base]{character}). +#' +#' @return (\link[base]{character}) +getDlplyCallFromLines <- function(lines) { + indices <- grep(pattern = "[plyr::]?dlply", lines) + lapply(indices, function(index) { + funCall <- paste0(getMultiLineFun(index, lines), collapse = " ") + funCall %>% + stringr::str_remove_all("\\s") %>% + stringr::str_split_i(pattern = "dlply\\(", i = 2) %>% + stringr::str_split_i(pattern = ",", i = 4) %>% + stringr::str_extract(pattern = "\\=\\w+") %>% + stringr::str_extract(pattern = "\\w+") + }) +} + + +#' getDlplyCall +#' +#' @param fun (\link[PaRe]{Function})\cr +#' Function object. +#' @param defFuns (\link[base]{data.frame})\cr +#' See \link[PaRe]{getDefinedFunctions} +#' +#' @return (\link[base]{data.frame}) +getDlplyCall <- function(fun, defFuns) { + dlplyFuns <- getDlplyCallFromLines(fun$getLines()) + if (length(dlplyFuns) > 0) { + lapply(dlplyFuns, function(dcFun) { + if (dcFun %in% defFuns$name) { + data.frame( + from = fun$getName(), + to = dcFun + ) + } + }) + } +} + +#' getApplyFromLines +#' +#' @param lines (\link[base]{c})\cr +#' Vector of (\link[base]{character}). See \link[PaRe]{getDefinedFunctions} +#' +#' @return (\link[base]{character}) +getApplyFromLines <- function(lines) { + pattern <- "[\\w+]?[Aa]pply\\(" + indices <- grep(pattern, lines) + unlist(lapply(indices, function(index) { + funCall <- paste0(getMultiLineFun(index, lines), collapse = " ") + if (!stringr::str_detect(string = funCall, pattern = "function[ ]?\\(")) { + funCall <- funCall %>% + stringr::str_remove_all(pattern = "(\\s)") + + if (grepl(pattern = "cluster", x = funCall)) { + pat <- ",(?=[FUN=]?\\w+?\\w+\\))" + } else { + pat <- ",(?=[FUN=]?\\w+?\\w+)" + } + + funCall <- funCall %>% + stringr::str_split_i(pattern = pat, i = 2) + + if (grepl(pattern = "=", x = funCall)) { + funCall <- funCall %>% + stringr::str_split_i(pattern = "=", i = 2) + } + + funCall <- funCall %>% + stringr::str_remove_all(pattern = "[\\%\\(\\)\\\\>\\<]") + return(funCall) + } + })) +} + +#' getApplyCall +#' +#' @param fun (\link[PaRe]{Function})\cr +#' Function object. +#' @param defFuns (\link[base]{data.frame})\cr +#' See \link[PaRe]{getDefinedFunctions} +#' +#' @return (\link[base]{data.frame}) +getApplyCall <- function(fun, defFuns) { + applyFuns <- getApplyFromLines(fun$getLines()) + if (length(applyFuns) > 0) { + lapply(applyFuns, function(dcFun) { + if (dcFun %in% defFuns$name) { + data.frame( + from = fun$getName(), + to = dcFun + ) + } + }) + } +} + +#' getDoCallFromLines +#' +#' @param lines (\link[base]{c})\cr +#' Vector of (\link[base]{character}). See \link[PaRe]{getDefinedFunctions} +#' +#' @return (\link[base]{character}) +getDoCallFromLines <- function(lines) { + pattern <- "do\\.call\\(" + indices <- grep(pattern, lines) + + unlist(lapply(indices, function(index) { + funCall <- paste0(getMultiLineFun(index, lines), collapse = " ") + + funCall <- funCall %>% + stringr::str_remove_all(pattern = "\\s") %>% + stringr::str_split_i(pattern = pattern, i = 2) %>% + stringr::str_split_i(pattern = ",", i = 1) %>% + stringr::str_remove_all(pattern = "[\"\'\\\\]") + + if (grepl("=", funCall)) { + funCall <- funCall %>% + stringr::str_split_i(pattern = "=", i = 2) + } + return(funCall) + })) +} + +#' getDoCall +#' +#' @param fun (\link[PaRe]{Function})\cr +#' Function object. +#' @param defFuns (\link[base]{data.frame})\cr +#' See \link[PaRe]{getDefinedFunctions} +#' +#' @return (\link[base]{data.frame}) +getDoCall <- function(fun, defFuns) { + dcFuns <- getDoCallFromLines(fun$getLines()) + if (length(dcFuns) > 0) { + lapply(dcFuns, function(dcFun) { + if (dcFun %in% defFuns$name) { + data.frame( + from = fun$getName(), + to = dcFun + ) + } + }) + } +} + +#' getFunCall +#' +#' @param fun (\link[PaRe]{Function})\cr +#' Function object. +#' @param defFuns (\link[base]{data.frame})\cr +#' See \link[PaRe]{getDefinedFunctions}. +#' +#' @return (\link[base]{data.frame}) +getFunCall <- function(fun, defFuns) { + lapply(defFuns$name, function(name) { + indices <- grep(paste0("[^a-zA-Z\\.\\d]", name, "\\("), fun$getLines()) + if (length(indices) > 0) { + df <- data.frame( + from = fun$getName(), + to = name + ) + return(df) + } + }) +} diff --git a/R/checkDependencies.R b/R/checkDependencies.R new file mode 100644 index 0000000..e60947e --- /dev/null +++ b/R/checkDependencies.R @@ -0,0 +1,177 @@ +#' printMessage +#' +#' Prints messages dependening of the nrow of the number of rows of the +#' notPermitted and versionCheck data.frames +#' +#' @param notPermitted ([base]{data.frame}) +#' @param versionCheck ([base]{data.frame}) +#' +#' @return (\link[base]{data.frame}) +#' | column | data type | +#' | ------- | ---------------------- | +#' | package | \link[base]{character} | +#' | version | \link[base]{character} | +printMessage <- function(notPermitted, versionCheck) { + if (nrow(notPermitted) > 0) { + message( + glue::glue( + "The following are not permitted: {cli::style_bold(paste0(notPermitted$package, collapse = ', '))}\n", + "Please open an issue here: {cli::style_bold('https://github.com/mvankessel-EMC/DependencyReviewerWhitelists/issues')}" + ) + ) + return(notPermitted) + } else if (nrow(versionCheck) > 0) { + message(glue::glue( + "The following versions are not of the right version: {cli::col_yellow(paste0(versionCheck$package, collapse = ', '))}\n", + "Please open an issue here: {cli::style_bold('https://github.com/mvankessel-EMC/DependencyReviewerWhitelists/issues')}" + )) + return(versionCheck) + } else { + message("All dependencies are approved.") + return(NULL) + } +} + +#' getVersionDf +#' +#' Function to compare different versions. +#' +#' @param dependencies (\link[base]{data.frame}) +#' | column | data type | +#' | ------- | ---------------------- | +#' | package | \link[base]{character} | +#' | version | \link[base]{character} | +#' @param permittedPackages (\link[base]{data.frame}) +#' | column | data type | +#' | ------- | ---------------------- | +#' | package | \link[base]{character} | +#' | version | \link[base]{character} | +#' +#' @return (\link[base]{data.frame}) +#' | column | data type | +#' | ------- | ---------------------- | +#' | package | \link[base]{character} | +#' | version | \link[base]{character} | +getVersionDf <- function(dependencies, permittedPackages) { + permitted <- dependencies %>% + dplyr::filter(.data$package %in% permittedPackages$package) + + permitted$version[permitted$version == "*"] <- "0.0.0" + + permitted <- permitted %>% + dplyr::arrange(.data$package) + + permittedPackages <- permittedPackages[ + permittedPackages$package %in% permitted$package, + ] %>% + dplyr::arrange(.data$package) + + df <- cbind( + permittedPackages, + allowed = permitted$version + ) + + return(df[ + !as.numeric_version(df$version) >= as.numeric_version(df$allowed), + ]) +} + +#' checkDependencies +#' +#' Check package dependencies +#' +#' @export +#' +#' @param repo (\link[PaRe]{Repository})\cr +#' Repository object. +#' @param dependencyType (\link[base]{character})\cr +#' Types of dependencies to be included +#' @param verbose (\link[base]{logical}: TRUE) +#' TRUE or FALSE. If TRUE, progress will be reported. +#' +#' @return (\link[base]{data.frame})\cr +#' Data frame with all the packages that are now permitted. + +#' | column | data type | +#' | ------- | ---------------------- | +#' | package | \link[base]{character} | +#' | version | \link[base]{character} | +#' +#' @examples +#' # Set cahce, usually not required. +#' withr::local_envvar( +#' R_USER_CACHE_DIR = tempfile() +#' ) +#' +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' # Use checkDependencies on the Repository object. +#' checkDependencies(repo) +#' checkDependencies(repo, dependencyType = c("Imports", "Suggests")) +#' } +checkDependencies <- function( + repo, + dependencyType = c("Imports", "Depends"), + verbose = TRUE) { + description <- repo$getDescription() + + dependencies <- description$get_deps() %>% + dplyr::filter(.data$type %in% dependencyType) %>% + dplyr::select("package", "version") + + dependencies <- dependencies %>% + dplyr::filter(.data$package != "R") + + dependencies$version <- stringr::str_remove( + string = dependencies$version, + pattern = "[\\s>=<]+" + ) + + if (isTRUE(verbose)) { + permittedPackages <- getDefaultPermittedPackages() + } else { + suppressMessages( + permittedPackages <- getDefaultPermittedPackages() + ) + } + + notPermitted <- dependencies %>% + dplyr::filter(!.data$package %in% permittedPackages$package) + + permitted <- dependencies %>% + dplyr::filter(.data$package %in% permittedPackages$package) + + permitted$version[permitted$version == "*"] <- "0.0.0" + + return(printMessage( + notPermitted, + getVersionDf(dependencies, permittedPackages) + )) +} diff --git a/R/countPackageLines.R b/R/countPackageLines.R new file mode 100644 index 0000000..fdb3359 --- /dev/null +++ b/R/countPackageLines.R @@ -0,0 +1,56 @@ +#' countPackageLines +#' +#' Counts the package lines of a \link[PaRe]{Repository} object. +#' +#' @export +#' +#' @param repo (\link[PaRe]{Repository})\cr +#' Repository object. +#' +#' @return (\link[dplyr]{tibble}\cr) +#' Tibble containing the amount of lines per file in the Repository object. +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' # Run countPackageLines on the Repository object. +#' countPackageLines(repo = repo) +#' } +countPackageLines <- function(repo) { + files <- repo$getFiles() + files <- Filter(Negate(is.null), files) + + data.frame(lapply(files, function(fileType) { + sum(unlist(lapply(fileType, function(file) { + file$getNLines() + }))) + })) %>% + dplyr::tibble() +} diff --git a/R/getDefaultPermittedPackages.R b/R/getDefaultPermittedPackages.R new file mode 100644 index 0000000..4f6e1a6 --- /dev/null +++ b/R/getDefaultPermittedPackages.R @@ -0,0 +1,90 @@ +#' getDefaultPermittedPackages +#' +#' Gets permitted packages. An internet connection is required. +#' +#' @export +#' +#' @param base (\link[base]{logical}: TRUE) +#' \describe{ +#' \item{TRUE}{Base packages will be included.} +#' \item{FALSE}{Base packages will be ignored.} +#' } +#' +#' @return (\link[dplyr]{tibble}) +#' | column | data type | +#' | ------- | ---------------------- | +#' | package | \link[base]{character} | +#' | version | \link[base]{character} | +#' +#' @examples +#' # Set cache +#' withr::local_envvar( +#' R_USER_CACHE_DIR = tempfile() +#' ) +#' +#' if (interactive()) { +#' getDefaultPermittedPackages() +#' } +getDefaultPermittedPackages <- function(base = TRUE) { + # Custom list + tryCatch( + { + customWhiteList <- dplyr::bind_rows(lapply(seq_len(nrow(whiteList)), function(i) { + pkgs <- utils::read.table( + file = unlist(whiteList[i, ]["link"]), + sep = ",", + header = TRUE + ) %>% + select(unlist(whiteList[i, ]["package"]), unlist(whiteList[i, ]["version"])) + })) + + basePackages <- NULL + if (base) { + # Get base packages + basePackages <- dplyr::bind_rows(lapply(list.files(.Library), function(pkg) { + df <- packageDescription(pkg = pkg, fields = c("Package", "Version")) %>% + unlist() + + dplyr::tibble( + package = df[1], + version = df[2], + row.names = NULL + ) + })) %>% + dplyr::filter(.data$package != "translations") + } + + sourcePackages <- dplyr::bind_rows( + customWhiteList, + basePackages + ) + + depList <- pak::pkg_deps(sourcePackages$package) + + permittedPackages <- dplyr::bind_rows( + basePackages, + depList + ) %>% + dplyr::select("package", version) + + permittedPackages <- permittedPackages %>% + group_by(.data$package) %>% + summarise(version = min(as.numeric_version(version))) + + return(permittedPackages) + }, + error = function(e) { + print(e) + message( + "Could not connect to the internet, online hosted whitelists will be ignored." + ) + return(NULL) + }, + warning = function(w) { + message( + "Could not connect to the internet, online hosted whitelists will be ignored." + ) + return(NULL) + } + ) +} diff --git a/R/getDefinedFunctions.R b/R/getDefinedFunctions.R new file mode 100644 index 0000000..0d033d3 --- /dev/null +++ b/R/getDefinedFunctions.R @@ -0,0 +1,65 @@ +#' getDefinedFunctions +#' +#' Gets all the defined functions from a \link[PaRe]{Repository} object. +#' +#' @export +#' +#' @param repo (\link[PaRe]{Repository})\cr +#' Repository object. +#' +#' @return (\link[base]{data.frame}) +#' | column | data type | +#' | --------- | ---------------------- | +#' | name | \link[base]{character} | +#' | lineStart | \link[base]{integer} | +#' | lineEnd | \link[base]{numeric} | +#' | nArgs | \link[base]{integer} | +#' | cycloComp | \link[base]{integer} | +#' | fileName | \link[base]{character} | +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' repo <- PaRe::Repository$new(pathToRepo) +#' +#' getDefinedFunctions(repo) +#' } +getDefinedFunctions <- function(repo) { + files <- repo$getRFiles() + + dplyr::bind_rows(lapply(files, function(file) { + df <- file$getFunctionTable() + + if (!is.null(df)) { + df %>% + dplyr::mutate(fileName = file$getName()) + } + })) +} diff --git a/R/getFunctionDiagram.R b/R/getFunctionDiagram.R new file mode 100644 index 0000000..f86e702 --- /dev/null +++ b/R/getFunctionDiagram.R @@ -0,0 +1,105 @@ +#' functionUseGraph +#' +#' @param repo (\link[PaRe]{Repository}) +#' +#' @return (\link[igraph]{graph}) +functionUseGraph <- function(repo) { + defFuns <- PaRe::getDefinedFunctions(repo) + rFiles <- repo$getRFiles() + funsPerDefFun <- getFunsPerDefFun(rFiles, defFuns) + return(igraph::graph_from_data_frame(funsPerDefFun, directed = TRUE)) +} + +#' graphToDot +#' +#' @param graph (\link[igraph]{graph}) +#' +#' @return `htmlwidgets`\cr +#' See \link[DiagrammeR]{grViz}. +graphToDot <- function(graph) { + # Set label because DiagrammeR expects label to be there + igraph::V(graph)$label <- igraph::V(graph)$name + + tmpFile <- tempfile() + igraph::write_graph(graph = graph, file = tmpFile, format = "dot") + + dotLines <- readLines(tmpFile) + dotLines <- stringr::str_replace_all(string = dotLines, pattern = "\\.", "_") + # Inject Left to Right + dotLines <- c( + dotLines[1:2], + "graph [layout = dot, rankdir = LR]", + dotLines[-c(1:2)] + ) + return(DiagrammeR::grViz(dotLines)) +} + +#' subsetGraph +#' +#' Create a subset of the package diagram containing all in comming and out +#' going paths from a specified function. +#' +#' @export +#' +#' @param repo (\link[PaRe]{Repository}) +#' Repository object. +#' @param functionName (\link[base]{character}) +#' Name of the function to get all paths from. +#' +#' @return (`htmlwidgets`)\cr +#' Subsetted diagram. See \link[DiagrammeR]{grViz} +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' # Run getFunctionDiagram on the Repository object. +#' getFunctionDiagram(repo = repo, functionName = "glue") +#' } +getFunctionDiagram <- function(repo, functionName) { + graph <- functionUseGraph(repo = repo) + + pathsIn <- igraph::all_simple_paths( + graph = graph, + from = functionName, + mode = "in" + ) + + pathsOut <- igraph::all_simple_paths( + graph = graph, + from = functionName, + mode = "out" + ) + + paths <- append(pathsIn, pathsOut) + + graphSub <- lapply(paths, igraph::induced_subgraph, graph = graph) + graphUnion <- do.call(igraph::union, graphSub) + graphToDot(graphUnion) +} diff --git a/R/getFunctionUse.R b/R/getFunctionUse.R new file mode 100644 index 0000000..31fa303 --- /dev/null +++ b/R/getFunctionUse.R @@ -0,0 +1,189 @@ +#' funsUsedInLine +#' +#' Support function for funsUsedInFile. +#' +#' @param lines (\link[base]{c}) of (\link[base]{character}) +#' @param name (\link[base]{character}) +#' @param i (\link[base]{numeric}) +#' @param verbose (\link[base]{logical}: FALSE) +#' +#' @return (\link[base]{data.frame}) +#' | column | data type | +#' | ------ | ---------------------- | +#' | pkg | \link[base]{character} | +#' | fun | \link[base]{character} | +#' | line | \link[base]{numeric} | +funsUsedInLine <- function(lines, name, i, verbose = FALSE) { + line <- lines[i] + + if (!startsWith(line, "#") && !is.na(line) && length(line) >= 0 && line != "NA") { + line <- paste( + stringr::str_split( + string = line, + pattern = "\\w+\\$", + simplify = TRUE + ), + collapse = "" + ) + + # Remove strings + line <- stringr::str_replace_all(line, "[\"\'\`].+[\"\'\`]+", "") + + funVec <- unlist(stringr::str_extract_all( + string = line, + pattern = "[\\w\\.]+(::)?[\\w\\.]+\\(" + )) + + funVec <- stringr::str_remove_all( + string = funVec, + pattern = "\\(" + ) + + if ("do.call" %in% funVec) { + funVec <- append(funVec, getDoCallFromLines(lines)) + } + + if (any(stringr::str_detect(string = funVec, pattern = "[\\w]+?[Aa]pply"))) { + funVec <- append(funVec, getApplyFromLines(lines)) + } + + if ("plyr::dlply" %in% funVec) { + funVec <- append(funVec, getDlplyCallFromLines(lines)) + } + + funVec <- stringr::str_split( + string = funVec, + pattern = "::" + ) + + if (length(funVec) > 0) { + funVec <- lapply( + X = funVec, + FUN = function(x) { + if (length(x) == 1) { + x <- list("unknown", x) + } else { + list(x) + } + } + ) + + df <- data.frame(t(sapply(funVec, unlist))) + names(df) <- c("pkg", "fun") + + df <- df %>% + dplyr::mutate( + file = name, + line = i + ) %>% + dplyr::tibble() + + return(df) + } else { + if (verbose == TRUE) { + message(paste0("No functions found for line: ", i)) + } + } + } +} + + +#' funsUsedInFile +#' +#' Support function +#' +#' @param files (\link[base]{list}) of (\link[PaRe]{File}) +#' @param verbose (\link[base]{logical}) +#' +#' @return (\link[base]{list}) +funsUsedInFile <- function(files, verbose = FALSE) { + lapply(X = files, FUN = function(file) { + if (verbose) { + message(paste0("Started on file: ", file$getName())) + } + + lines <- file$getLines() + + out <- lapply( + X = seq_len(length(lines)), + FUN = function(i) { + funsUsedInLine(lines = file$getLines(), name = file$getName(), i = i) + } + ) + }) +} + +#' summariseFunctionUse +#' +#' Summarise functions used in R package. +#' +#' @export +#' +#' @param repo (\link[PaRe]{Repository})\cr +#' Repository object. +#' @param verbose (\link[base]{logical}: FALSE)\cr +#' Prints message to console which file is currently being worked on. +#' +#' @return (\link[dplyr]{tibble}) +#' | column | data type | +#' | ------ | ---------------------- | +#' | file | \link[base]{character} | +#' | line | \link[base]{numeric} | +#' | pkg | \link[base]{character} | +#' | fun | \link[base]{character} | +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' # Run getFunctionUse on the Repository object. +#' getFunctionUse(repo = repo, verbose = TRUE) +#' } +getFunctionUse <- function(repo, verbose = FALSE) { + files <- repo$getRFiles() + + funUse <- funsUsedInFile(files, verbose) + + if (length(funUse) == 0) { + warning("No functions found, output will be empty") + funUse <- dplyr::tibble( + file = character(0), + line = numeric(0), + pkg = character(0), + fun = character(0) + ) + } + + funUse <- dplyr::bind_rows(funUse) %>% + dplyr::relocate("file", "line", "pkg", "fun") %>% + dplyr::arrange(.data$file, .data$line, .data$pkg, .data$fun) + + funUse$pkg[funUse$fun %in% ls("package:base")] <- "base" + return(funUse) +} diff --git a/R/getGraphData.R b/R/getGraphData.R new file mode 100644 index 0000000..c3f6cab --- /dev/null +++ b/R/getGraphData.R @@ -0,0 +1,93 @@ +#' getGraphData +#' +#' Get the dependency interactions as a graph representation. +#' +#' @export +#' +#' @param repo (\link[PaRe]{Repository})\cr +#' Repository object. +#' @param packageTypes (\link[base]{c}: `c("Imports")`) of (\link[base]{character}) +#' Any of the following options may be included in a vector: \itemize{ +#' \item "imports" +#' \item "depends" +#' \item "suggests" +#' \item "enhances" +#' \item "linkingto" +#' } +#' +#' @return (\link[tidygraph]{as_tbl_graph}) +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' # Run getGraphData on the Repository object. +#' if (interactive()) { +#' getGraphData(repo = repo, packageTypes = c("Imports")) +#' } +#' } +getGraphData <- function(repo, packageTypes = c("Imports")) { + deps <- repo$getDescription()$get_deps() %>% + dplyr::filter(tolower(.data$type) %in% tolower(packageTypes)) %>% + dplyr::pull(.data$package) + + remoteRef <- repo$getDescription()$get_remotes() + deps[deps %in% basename(remoteRef)] <- remoteRef[basename(remoteRef) %in% deps] + + # Get all dependencies using pak + data <- pak::pkg_deps(deps) + + # Add current package + data <- data %>% + dplyr::add_row( + ref = repo$getName(), + package = repo$getName(), + deps = list(dplyr::tibble(ref = deps, type = "Imports", package = deps)), + .before = TRUE + ) + + # Reformat dependencies to long format + pkgDeps <- dplyr::bind_rows(lapply(X = 1:nrow(data), FUN = function(row) { + deps <- data[["deps"]][[row]][["package"]] + pkg <- unlist(rep(data[row, ]["package"], length(deps))) + type <- tolower(data[["deps"]][[row]][["type"]]) + dplyr::tibble(pkg = pkg, deps = deps, type = type, op = "", version = "") + })) + + pkgDeps <- pkgDeps %>% + dplyr::filter(tolower(.data$type) %in% tolower(packageTypes)) %>% + dplyr::select("pkg", "deps") + + # Convert tibble to graph + netData <- igraph::graph_from_data_frame( + d = pkgDeps, + directed = TRUE + ) + return(netData) +} diff --git a/R/lint.R b/R/lint.R new file mode 100644 index 0000000..af47392 --- /dev/null +++ b/R/lint.R @@ -0,0 +1,145 @@ +#' lintRepo +#' +#' Get all the lintr messages of the \link[PaRe]{Repository} object. +#' +#' @export +#' +#' @param repo (\link[PaRe]{Repository}) +#' +#' @return (\link[base]{data.frame}) +#' | column | data type | description | +#' | ------------- | ---------------------- | ------------------------------------------- | +#' | filename | \link[base]{character} | Name of the file | +#' | line_number | \link[base]{double} | Line in which the message was found | +#' | column_number | \link[base]{double} | Column in which the message was found | +#' | type | \link[base]{character} | Type of message | +#' | message | \link[base]{character} | Style, warning, or error message | +#' | line | \link[base]{character} | Line of code in which the message was found | +#' | linter | \link[base]{character} | Linter used | +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' # Run lintRepo on the Repository object. +#' messages <- lintRepo(repo = repo) +#' } +lintRepo <- function(repo) { + tempDir <- tempdir() + tempFile <- tempfile() + + files <- repo$getRFiles() + + messages <- dplyr::bind_rows(lapply(files, function(file) { + tempFile <- tempfile(pattern = file$getName(), tmpdir = tempDir) + writeLines(text = file$getLines(), con = tempFile) + + data.frame(lintr::lint( + filename = tempFile, + linters = lintr::linters_with_defaults( + lintr::object_name_linter(styles = "camelCase") + ) + )) %>% + dplyr::mutate(filename = file$getName()) + })) + return(messages) +} + + +#' lintScore +#' +#' Function that scores the lintr output as a percentage per message type +#' (style, warning, error). Lintr messages / lines assessed * 100 +#' +#' @export +#' +#' @param repo (\link[PaRe]{Repository})\cr +#' Repository object. +#' @param messages (\link[base]{data.frame})\cr +#' Data frame containing lintr messages. See \link[PaRe]{lintRepo}. +#' +#' @return (\link[dplyr]{tibble}) +#' \describe{ +#' \item{type}{(\link[base]{character}) Type of message.} +#' \item{pct}{(\link[base]{double}) Score.} +#' } +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' messages <- lintRepo(repo = repo) +#' +#' # Run lintScore on the Repository object. +#' lintScore(repo = repo, messages = messages) +#' } +lintScore <- function(repo, messages) { + files <- repo$getRFiles() + + nLines <- sum(unlist(lapply(files, function(file) { + file$getNLines() + }))) + + pct <- messages %>% + dplyr::group_by(.data$type) %>% + dplyr::tally() %>% + dplyr::summarise(.data$type, pct = round(.data$n / nLines * 100, 2)) + + if (nrow(pct) == 0) { + message(glue::glue("{nrow(pct)} Lintr messages found")) + return(NULL) + } + return(pct) +} diff --git a/R/makeReport.R b/R/makeReport.R new file mode 100644 index 0000000..97e931f --- /dev/null +++ b/R/makeReport.R @@ -0,0 +1,91 @@ +#' makeReport +#' +#' Uses rmarkdown's render function to render a html-report of the given package. +#' +#' @export +#' +#' @param repo (\link[PaRe]{Repository})\cr +#' Repository object. +#' @param outputFile (\link[base]{character})\cr +#' Path to html-file. +#' @param showCode (\link[base]{logical}: FALSE)\cr +#' Logical to show code or not in the report. +#' +#' @return (`NULL`) +#' +#' @examples +#' \donttest{ +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/darwin-eu/IncidencePrevalence.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' # Run makeReport on the Repository object. +#' makeReport(repo = repo, outputFile = tempfile()) +#' } +#' } +makeReport <- function(repo, outputFile, showCode = FALSE) { + if (checkInstalled()) { + outputFile <- normalizePath(outputFile, mustWork = FALSE) + writeLines("", con = outputFile) + + desc <- repo$getDescription() + pkgName <- glue::glue("{desc$get_field('Package')} [{desc$get_version()}]") + + # Render report.Rmd + rmarkdown::render( + input = system.file(package = "PaRe", "rmd", "report.Rmd"), + output_file = outputFile, + params = list(pkgName = pkgName, repo = repo, showCode = showCode) + ) + } +} + +#' checkInstalled +#' +#' Checks if suggested packages are installed. +#' +#' @return \link[base]{logical}\cr +#' Logical depending if suggested packages are installed. +checkInstalled <- function() { + desc <- desc::description$new(package = "PaRe") + + reqs <- desc$get_deps() %>% + dplyr::filter(.data$type == "Suggests") %>% + dplyr::select("package") %>% + unlist() + + installed <- unlist(lapply(reqs, FUN = require, character.only = TRUE, quietly = TRUE)) + + if (any(!installed)) { + cli::cli_alert_warning(glue::glue( + "The following packages are required but not installed: {cli::style_bold(paste0(reqs[!installed], collapse = ', '))}." + )) + return(FALSE) + } + return(TRUE) +} diff --git a/R/pkgDiagram.R b/R/pkgDiagram.R new file mode 100644 index 0000000..d70dc15 --- /dev/null +++ b/R/pkgDiagram.R @@ -0,0 +1,213 @@ +#' makeGraph +#' +#' Makes the graph +#' +#' @param funsPerDefFun (\link[base]{data.frame})\cr +#' Functions per defined function data.frame. +#' @param pkgName (\link[base]{character})\cr +#' Name of package. +#' @param expFuns (\link[base]{data.frame})\cr +#' Exported functinos data.frame. +#' @param ... +#' Optional other parameters for \link[DiagrammeR]{grViz}. +#' +#' @return (`htmlwidget`)\cr +#' Diagram of the package. See \link[DiagrammeR]{grViz}. +makeGraph <- function(funsPerDefFun, pkgName, expFuns, ...) { + syntax <- glue::glue("\'{funsPerDefFun$from}\' -> \'{funsPerDefFun$to}\'") + + DiagrammeR::grViz( + diagram = paste0( + "digraph { + graph [layout = dot, rankdir = LR]", + "subgraph cluster0 {node [style = filled fillcolor = lightgrey] label = <Legend> Exported -> Non_exported}", + "subgraph cluster1 {node [style = filled fillcolor = lightgrey] Exported [fillcolor = white] label = <", pkgName, "> ", + paste0(paste0(expFuns, " [fillcolor = white]"), collapse = "\n"), + paste0(syntax, collapse = "\n"), "}", + "}", + collapse = "\n" + ), + ... + ) +} + +#' getFunsPerDefFun +#' +#' @param files (\link[base]{list})\cr +#' List of \link[PaRe]{File} objects. +#' @param defFuns (\link[base]{data.frame})\cr +#' See \link[PaRe]{getDefinedFunctions}. +#' +#' @return \link[base]{data.frame} +#' | column | data type | +#' | ------ | ---------------------- | +#' | from | \link[base]{character} | +#' | to | \link[base]{character} | +getFunsPerDefFun <- function(files, defFuns) { + dplyr::bind_rows(lapply(files, function(file) { + funs <- file$getFunctions() + dplyr::bind_rows(lapply(funs, function(fun) { + funCall <- getFunCall(fun = fun, defFuns = defFuns) + doCall <- getDoCall(fun = fun, defFuns = defFuns) + applyCall <- getApplyCall(fun = fun, defFuns = defFuns) + dlplyCall <- getDlplyCall(fun = fun, defFuns = defFuns) + return(dplyr::bind_rows( + funCall, + doCall, + applyCall, + dlplyCall + )) + })) + })) +} + +#' getExportedFunctions +#' +#' Gets all the exported functions of a package, from NAMESPACE. +#' +#' @param path (\link[base]{character})\cr +#' Path to package +#' +#' @return (\link[base]{c}) +#' Vector of \link[base]{character} exported functions. +getExportedFunctions <- function(path) { + expFuns <- readLines(glue::glue("{path}/NAMESPACE")) + + expFuns <- unlist(stringr::str_extract_all( + string = expFuns, + pattern = "export\\(.+\\)" + )) + + expFuns <- unlist(stringr::str_extract_all( + string = expFuns, + pattern = "\\(\\w+\\)" + )) + + expFuns <- unlist(stringr::str_extract_all( + string = expFuns, + pattern = "\\w+" + )) + + return(expFuns) +} + +#' pkgDiagram +#' +#' Creates a diagram of all defined functions in a package. +#' +#' @export +#' +#' @param repo (\link[PaRe]{Repository})\cr +#' Repository object. +#' @param verbose (\link[base]{logical})\cr +#' Turn verbose messages on or off. +#' @param ... +#' Optional other parameters for \link[DiagrammeR]{grViz}. +#' +#' @return (`htmlwidget`)\cr +#' Diagram `htmlwidget` object. See \link[htmlwidgets]{createWidget} +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' # Run pkgDiagram on the Repository object. +#' pkgDiagram(repo = repo) +#' } +pkgDiagram <- function(repo, verbose = FALSE, ...) { + path <- repo$getPath() + + rPath <- file.path(path, "R") + + files <- repo$getRFiles() + + expFuns <- getExportedFunctions(path) + + defFuns <- getDefinedFunctions(repo) + + funsPerDefFun <- getFunsPerDefFun(files = files, defFuns = defFuns) + # print(funsPerDefFun, n = 300) + makeGraph(funsPerDefFun, basename(path), expFuns, ...) +} + + +#' exportDiagram +#' +#' Exports the diagram from `pkgDiagram` to a PDF-file. +#' +#' @export +#' +#' @param diagram (\link[DiagrammeR]{grViz})\cr +#' Graph object from \link[PaRe]{pkgDiagram}. +#' @param fileName (\link[base]{character})\cr +#' Path to save the diagram to, as PDF. +#' +#' @return (`NULL`) +#' +#' @examples +#' fetchedRepo <- tryCatch( +#' { +#' # Set dir to clone repository to. +#' tempDir <- tempdir() +#' pathToRepo <- file.path(tempDir, "glue") +#' +#' # Clone repo +#' git2r::clone( +#' url = "https://github.com/tidyverse/glue.git", +#' local_path = pathToRepo +#' ) +#' +#' # Create instance of Repository object. +#' repo <- PaRe::Repository$new(path = pathToRepo) +#' +#' # Set fetchedRepo to TRUE if all goes well. +#' TRUE +#' }, +#' error = function(e) { +#' # Set fetchedRepo to FALSE if an error is encountered. +#' FALSE +#' }, +#' warning = function(w) { +#' # Set fetchedRepo to FALSE if a warning is encountered. +#' FALSE +#' } +#' ) +#' +#' if (fetchedRepo) { +#' # Run pkgDiagram on the Repository object. +#' pkgDiagram(repo = repo) %>% +#' # Export the diagram to a temp file. +#' exportDiagram(fileName = tempfile()) +#' } +exportDiagram <- function(diagram, fileName) { + diagram %>% + DiagrammeRsvg::export_svg() %>% + charToRaw() %>% + rsvg::rsvg_pdf(fileName) +} diff --git a/R/utils-pipe.R b/R/utils-pipe.R new file mode 100644 index 0000000..2b2fcb6 --- /dev/null +++ b/R/utils-pipe.R @@ -0,0 +1,14 @@ +#' Pipe operator +#' +#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +#' +#' @name %>% +#' @rdname pipe +#' @keywords internal +#' @export +#' @importFrom magrittr %>% +#' @usage lhs \%>\% rhs +#' @param lhs A value or the magrittr placeholder. +#' @param rhs A function call using the magrittr semantics. +#' @return The result of calling `rhs(lhs)`. +NULL diff --git a/README.md b/README.md new file mode 100644 index 0000000..c716952 --- /dev/null +++ b/README.md @@ -0,0 +1,42 @@ + + + +# PaRe + + + +[![R-CMD-check](https://github.com/darwin-eu-dev/PaRe/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/darwin-eu-dev/PaRe/actions/workflows/R-CMD-check.yaml) + + +PaRe (**Pa**ckage **Re**viewer) is the successor of the +DependencyReviewer package. PaRe reviews other packages during code +review and has the following features: + +1. What dependencies are used, and what functions are used of that + dependency. +2. The quality of the code style using lintr. +3. Code complexity, using the *cyclomatic complexity* scores. +4. How internally defined functions interact with one another, and + visualizing this in a diagram. +5. Fetching locations of defined functions in R-files. +6. Checking dependencies against user a defined white list. +7. Count lines of code for different languages by default: R, C++, SQL, + and Java. +8. Make a standardized HTML-report exploring the before mentioned + features. + +## Installation + +You can install the development version of DependencyReviewer like so: + +``` r +install.packages("remotes") +remotes::install_github("darwin-eu/PaRe") +``` + +## Latest changes: + +1. Using R6 objects +2. Generalized function input to use R6 objects +3. Minor efficiency changes +4. Major vignette updates diff --git a/build/vignette.rds b/build/vignette.rds new file mode 100644 index 0000000..e985735 Binary files /dev/null and b/build/vignette.rds differ diff --git a/inst/WORDLIST b/inst/WORDLIST new file mode 100644 index 0000000..90e8efb --- /dev/null +++ b/inst/WORDLIST @@ -0,0 +1,89 @@ +CMD +ComPaRing +Cyclomatic +DependencyReviewer +Initializer +Kessel +Linter +Lintr +McCabe +Summarise +Tibble +Tidyverse +Untestable +checkDependencies +checkInstalled +ckage +cloneable +columnname +comming +countEdges +countPackageLines +countVertices +covr +csv +csv's +cycloComp +cyclomatic +cyclometic +darwin +dependencyType +dependening +exportDiagram +fileName +functinos +functionUse +functionUseGraph +funsUsedInFile +funsUsedInLine +getApplyCall +getApplyFromLines +getDefaultPermittedPackages +getDefinedFunctions +getDlplyCall +getDlplyCallFromLines +getDoCall +getDoCallFromLines +getExportedFunctions +getFunCall +getFunctionUse +getFunsPerDefFun +getGraphData +getMultiLineFun +getVersionDf +grViz +graphToDot +hades +lineEnd +lineStart +linkingto +lintRepo +lintScore +linter +lintr +magrittr +makeGraph +makeReport +md +meanDegree +meanDistance +microbenchmark +nArgs +notPermitted +nrow +pacakge +pkgDiagram +pkgPath +printMessage +rmarkdown's +rprintf +styleguide +subsetGraph +summariseFunctionUse +tbl +testthat +tibble +tidyverse +versionCheck +whiteList +PaRe diff --git a/inst/doc/Documentation.R b/inst/doc/Documentation.R new file mode 100644 index 0000000..6052abc --- /dev/null +++ b/inst/doc/Documentation.R @@ -0,0 +1,188 @@ +## ----knitrOptions, include=FALSE---------------------------------------------- +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) + +## ----localCache, echo=FALSE--------------------------------------------------- +withr::local_envvar( + R_USER_CACHE_DIR = tempfile() +) + +## ----setup-------------------------------------------------------------------- +library(PaRe) + +## ----whiteList---------------------------------------------------------------- +PaRe::whiteList + +## ----whiteListSession--------------------------------------------------------- +sessionWhiteList <- rbind( + whiteList, + list( + source = "dummySession", + link = "some/file.csv", + package = "package", + version = "version" + ) +) + +sessionWhiteList + +## ----setupWhiteList----------------------------------------------------------- +fileWhiteList <- rbind( + read.csv( + system.file( + package = "PaRe", + "whiteList.csv" + ) + ), + list( + source = "dummyFile", + link = "some/file.csv", + package = "package", + version = "version" + ) +) + +fileWhiteList + +## ----writeWhiteList, eval=FALSE----------------------------------------------- +# write.csv( +# fileWhiteList, +# system.file( +# package = "PaRe", +# "whiteList.csv" +# ) +# ) + +## ----permittedPackages, message=FALSE, warning=FALSE-------------------------- +PaRe::getDefaultPermittedPackages(base = TRUE) + +## ----cloneRepoShow, eval=FALSE------------------------------------------------ +# # Temp dir to clone repo to +# tempDir <- tempdir() +# pathToRepo <- file.path(tempDir, "glue") +# +# # Clone IncidencePrevalence to temp dir +# git2r::clone( +# url = "https://github.com/tidyverse/glue.git", +# local_path = pathToRepo +# ) +# +# repo <- PaRe::Repository$new(path = pathToRepo) + +## ----cloneRepo, echo=FALSE---------------------------------------------------- +fetchedRepo <- tryCatch( + { + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + repo <- PaRe::Repository$new(path = pathToRepo) + TRUE + }, + error = function(e) { + FALSE + }, + warning = function(w) { + FALSE + } +) + +## ----checkDependenciesShow, eval=FALSE---------------------------------------- +# PaRe::checkDependencies(repo = repo) + +## ----setupGraphShow, eval=FALSE----------------------------------------------- +# graphData <- PaRe::getGraphData( +# repo = repo, +# packageTypes = c("imports", "suggests") +# ) + +## ----setupGraph, echo=FALSE, warning=FALSE, message=FALSE--------------------- +if (fetchedRepo) { + graphData <- PaRe::getGraphData( + repo = repo, + packageTypes = c("imports", "suggests") + ) +} + +## ----graphCharacteristicsShow, eval=FALSE------------------------------------- +# data.frame( +# countVertices = length(igraph::V(graphData)), +# countEdges = length(igraph::E(graphData)), +# meanDegree = round(mean(igraph::degree(graphData)), 2), +# meanDistance = round(mean(igraph::distances(graphData)), 2) +# ) + +## ----plotGraphShow, eval=FALSE------------------------------------------------ +# plot(graphData) + +## ----plotGraph, echo=FALSE---------------------------------------------------- +if (fetchedRepo) { + plot(graphData) +} + +## ----summariseFunctionUseShow, eval=FALSE------------------------------------- +# funsUsed <- PaRe::getFunctionUse(repo = repo) +# funsUsed + +## ----summariseFunctionUse, echo=FALSE, message=FALSE, warning=FALSE----------- +if (fetchedRepo) { + funsUsed <- PaRe::getFunctionUse(repo = repo) + funsUsed +} + +## ----definedFunctionsShow, eval=FALSE----------------------------------------- +# defFuns <- PaRe::getDefinedFunctions(repo = repo) +# head(defFuns) + +## ----definedFunctions, echo=FALSE--------------------------------------------- +if (fetchedRepo) { + defFuns <- PaRe::getDefinedFunctions(repo = repo) + head(defFuns) +} + +## ----pkgDiagramShow, eval=FALSE----------------------------------------------- +# PaRe::pkgDiagram(repo = repo) %>% +# DiagrammeRsvg::export_svg() %>% +# charToRaw() %>% +# magick::image_read() + +## ----pkgDiagram, echo=FALSE--------------------------------------------------- +if (fetchedRepo) { + PaRe::pkgDiagram(repo = repo) %>% + DiagrammeRsvg::export_svg() %>% + charToRaw() %>% + magick::image_read() +} + +## ----linesOfCodeShow, eval=FALSE---------------------------------------------- +# PaRe::countPackageLines(repo = repo) + +## ----linesOfCode, echo=FALSE-------------------------------------------------- +if (fetchedRepo) { + PaRe::countPackageLines(repo = repo) +} + +## ----lintScoreShow, eval=FALSE------------------------------------------------ +# messages <- PaRe::lintRepo(repo = repo) +# PaRe::lintScore(repo = repo, messages = messages) + +## ----lintScore, echo=FALSE---------------------------------------------------- +if (fetchedRepo) { + messages <- PaRe::lintRepo(repo = repo) + PaRe::lintScore(repo = repo, messages = messages) +} + +## ----lintMessagesShow, eval=FALSE--------------------------------------------- +# head(messages) + +## ----lintMessages, echo=FALSE------------------------------------------------- +if (fetchedRepo) { + head(messages) +} + diff --git a/inst/doc/Documentation.Rmd b/inst/doc/Documentation.Rmd new file mode 100644 index 0000000..f3b6b2b --- /dev/null +++ b/inst/doc/Documentation.Rmd @@ -0,0 +1,290 @@ +--- +title: "Documentation" +author: "Maarten van Kessel" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Documentation} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r knitrOptions, include=FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r localCache, echo=FALSE} +withr::local_envvar( + R_USER_CACHE_DIR = tempfile() +) +``` + +```{r setup} +library(PaRe) +``` + +For the examples in this vignette `glue` will be used as an example. `glue` version *1.6.2.9000* is included in the system files of `PaRe` and is thus accessible even if these examples are ran offline. + +`PaRe` does fetch some online resources through the package `pak`. And by default online stored csv-files in the `PaRe::whiteList` data.frame. If no connection can be made, functions using these methods to reference these online resources will return `NULL`. + +## Whitelist Data Frame +`PaRe` includes a data frame which contains links to csv-files to be used in the `PaRe::checkDependencies` and `PaRe::getDefaultPermittedPackages` functions. + +By default the data frame contains the following information. +```{r whiteList} +PaRe::whiteList +``` + +The data frame contains 4 columns: + +1. *source*: Source name. +2. *link*: Link or path to the csv-file. +3. *package*: Column name in the referenced csv-file that contains the package names. +4. *version*: Column name in the referenced csv-file that contains the package versions. + +If you wish to alter the sources in just your R-session, you can either add, remove, or replace individual rows in the whiteList data frame. +```{r whiteListSession} +sessionWhiteList <- rbind( + whiteList, + list( + source = "dummySession", + link = "some/file.csv", + package = "package", + version = "version" + ) +) + +sessionWhiteList +``` + +If you wish to make more permanent alterations to the `whiteList` data frame, you can edit the whiteList.csv file in the PaRe system files. +```{r setupWhiteList} +fileWhiteList <- rbind( + read.csv( + system.file( + package = "PaRe", + "whiteList.csv" + ) + ), + list( + source = "dummyFile", + link = "some/file.csv", + package = "package", + version = "version" + ) +) + +fileWhiteList +``` + +```{r writeWhiteList, eval=FALSE} +write.csv( + fileWhiteList, + system.file( + package = "PaRe", + "whiteList.csv" + ) +) +``` + +## Dependency Review +Before we start diving into the dependency usage of `glue` we should first establish what our dependency white list even looks like. We can retrieve our full list of whitelisted dependencies buy calling the `getDefaultPermittedPackages` function. + +### getDefaultPermittedPackages +```{r permittedPackages, message=FALSE, warning=FALSE} +PaRe::getDefaultPermittedPackages(base = TRUE) +``` + +`getDefaultPermittedPackages` takes one parameter: + +1. **base** which is set to `TRUE` by default. Packages that listed as *base* packages will be included in the white list. + +### Setting up a Repository object +```{r cloneRepoShow, eval=FALSE} +# Temp dir to clone repo to +tempDir <- tempdir() +pathToRepo <- file.path(tempDir, "glue") + +# Clone IncidencePrevalence to temp dir +git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo +) + +repo <- PaRe::Repository$new(path = pathToRepo) +``` + +```{r cloneRepo, echo=FALSE} +fetchedRepo <- tryCatch( + { + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + repo <- PaRe::Repository$new(path = pathToRepo) + TRUE + }, + error = function(e) { + FALSE + }, + warning = function(w) { + FALSE + } +) +``` + +### checkDependencies +Now that we know what is included in the white list, we can make our first step into reviewing `glue`, which is to ensure the (suggested) dependencies `glue` uses are in our white list. +```{r checkDependenciesShow, eval=FALSE} +PaRe::checkDependencies(repo = repo) +``` +``` +→ The following are not permitted: covr, microbenchmark, R.utils, rprintf, testthat +→ Please open an issue here: https://github.com/mvankessel-EMC/DependencyReviewerWhitelists/issues +``` +| package | version | +| -------------- | ------- | +| covr | * | +| microbenchmark | * | +| R.utils| * | +| rprintf| * | +| testthat | 3.0.0 | + +Not all suggested dependencies are approved. The function prints a message and returns a data frame, containing all packages that are not listed in our white list. + +`checkDependecies` takes two parameters: + +1. **pkgPath** which specifies the path to the pacakge. +2. **dependencyType** a vector of character items which specify kinds of imports to look at. + +### getGraphData +glue depends on (suggested) dependencies. These dependencies in turn import other dependencies, and so on. We can investigate how these recursive dependencies depend on one another, by investigating it as a graph. +```{r setupGraphShow, eval=FALSE} +graphData <- PaRe::getGraphData( + repo = repo, + packageTypes = c("imports", "suggests") +) +``` + +```{r setupGraph, echo=FALSE, warning=FALSE, message=FALSE} +if (fetchedRepo) { + graphData <- PaRe::getGraphData( + repo = repo, + packageTypes = c("imports", "suggests") + ) +} +``` + +We can compute several statistics about our dependency graph +```{r graphCharacteristicsShow, eval=FALSE} +data.frame( + countVertices = length(igraph::V(graphData)), + countEdges = length(igraph::E(graphData)), + meanDegree = round(mean(igraph::degree(graphData)), 2), + meanDistance = round(mean(igraph::distances(graphData)), 2) +) +``` +- **countVertices** resembles the amount of recursive dependencies `glue` depends on. +- **countEdges**: are the total amount of imports of all dependencies. +- **meanDegree**: is the average amount of imports per dependency. +- **meanDistance**: is the average amount of dependencies between `glue` and all other recursive dependencies. + +We can then plot the graph. +```{r plotGraphShow, eval=FALSE} +plot(graphData) +``` + +```{r plotGraph, echo=FALSE} +if (fetchedRepo) { + plot(graphData) +} +``` + +## Package wide function use +`PaRe` allows you to get insight in the function usage in a package. + +### summariseFunctionUse +```{r summariseFunctionUseShow, eval=FALSE} +funsUsed <- PaRe::getFunctionUse(repo = repo) +funsUsed +``` + +```{r summariseFunctionUse, echo=FALSE, message=FALSE, warning=FALSE} +if (fetchedRepo) { + funsUsed <- PaRe::getFunctionUse(repo = repo) + funsUsed +} +``` + +### getDefinedFunctions +```{r definedFunctionsShow, eval=FALSE} +defFuns <- PaRe::getDefinedFunctions(repo = repo) +head(defFuns) +``` + +```{r definedFunctions, echo=FALSE} +if (fetchedRepo) { + defFuns <- PaRe::getDefinedFunctions(repo = repo) + head(defFuns) +} +``` +Besides the location of each function being displayed, the number of arguments for each function, and the cyclometic complexity is also included in the result. + +```{r pkgDiagramShow, eval=FALSE} +PaRe::pkgDiagram(repo = repo) %>% + DiagrammeRsvg::export_svg() %>% + charToRaw() %>% + magick::image_read() +``` + +```{r pkgDiagram, echo=FALSE} +if (fetchedRepo) { + PaRe::pkgDiagram(repo = repo) %>% + DiagrammeRsvg::export_svg() %>% + charToRaw() %>% + magick::image_read() +} +``` + +## Lines of code +```{r linesOfCodeShow, eval=FALSE} +PaRe::countPackageLines(repo = repo) +``` + +```{r linesOfCode, echo=FALSE} +if (fetchedRepo) { + PaRe::countPackageLines(repo = repo) +} +``` +`glue` contains 1056 lines of R-code. + +## Linting +```{r lintScoreShow, eval=FALSE} +messages <- PaRe::lintRepo(repo = repo) +PaRe::lintScore(repo = repo, messages = messages) +``` + +```{r lintScore, echo=FALSE} +if (fetchedRepo) { + messages <- PaRe::lintRepo(repo = repo) + PaRe::lintScore(repo = repo, messages = messages) +} +``` + +```{r lintMessagesShow, eval=FALSE} +head(messages) +``` + +```{r lintMessages, echo=FALSE} +if (fetchedRepo) { + head(messages) +} +``` + diff --git a/inst/doc/Documentation.html b/inst/doc/Documentation.html new file mode 100644 index 0000000..1ae74ce --- /dev/null +++ b/inst/doc/Documentation.html @@ -0,0 +1,696 @@ + + + + + + + + + + + + + + + + +Documentation + + + + + + + + + + + + + + + + + + + + + + + + + + +

Documentation

+

Maarten van Kessel

+

2023-06-01

+ + + +
library(PaRe)
+

For the examples in this vignette glue will be used as +an example. glue version 1.6.2.9000 is included in +the system files of PaRe and is thus accessible even if +these examples are ran offline.

+

PaRe does fetch some online resources through the +package pak. And by default online stored csv-files in the +PaRe::whiteList data.frame. If no connection can be made, +functions using these methods to reference these online resources will +return NULL.

+
+

Whitelist Data Frame

+

PaRe includes a data frame which contains links to +csv-files to be used in the PaRe::checkDependencies and +PaRe::getDefaultPermittedPackages functions.

+

By default the data frame contains the following information.

+
PaRe::whiteList
+#> # A tibble: 3 × 4
+#>   source    link                                                 package version
+#>   <chr>     <chr>                                                <chr>   <chr>  
+#> 1 darwin    https://raw.githubusercontent.com/mvankessel-EMC/De… package version
+#> 2 hades     https://raw.githubusercontent.com/mvankessel-EMC/De… package version
+#> 3 tidyverse https://raw.githubusercontent.com/mvankessel-EMC/De… package version
+

The data frame contains 4 columns:

+
    +
  1. source: Source name.
    2. +
  2. link: Link or path to the csv-file.
    3. +
  3. package: Column name in the referenced csv-file that +contains the package names.
    4. +
  4. version: Column name in the referenced csv-file that +contains the package versions.
    5. +
+

If you wish to alter the sources in just your R-session, you can +either add, remove, or replace individual rows in the whiteList data +frame.

+
sessionWhiteList <- rbind(
+  whiteList,
+  list(
+    source = "dummySession",
+    link = "some/file.csv",
+    package = "package",
+    version = "version"
+  )
+)
+
+sessionWhiteList
+#> # A tibble: 4 × 4
+#>   source       link                                              package version
+#>   <chr>        <chr>                                             <chr>   <chr>  
+#> 1 darwin       https://raw.githubusercontent.com/mvankessel-EMC… package version
+#> 2 hades        https://raw.githubusercontent.com/mvankessel-EMC… package version
+#> 3 tidyverse    https://raw.githubusercontent.com/mvankessel-EMC… package version
+#> 4 dummySession some/file.csv                                     package version
+

If you wish to make more permanent alterations to the +whiteList data frame, you can edit the whiteList.csv file +in the PaRe system files.

+
fileWhiteList <- rbind(
+  read.csv(
+    system.file(
+      package = "PaRe",
+      "whiteList.csv"
+    )
+  ),
+  list(
+    source = "dummyFile",
+    link = "some/file.csv",
+    package = "package",
+    version = "version"
+  )
+)
+
+fileWhiteList
+#>      source
+#> 1    darwin
+#> 2     hades
+#> 3 tidyverse
+#> 4 dummyFile
+#>                                                                                               link
+#> 1    https://raw.githubusercontent.com/mvankessel-EMC/DependencyReviewerWhitelists/main/darwin.csv
+#> 2     https://raw.githubusercontent.com/mvankessel-EMC/DependencyReviewerWhitelists/main/hades.csv
+#> 3 https://raw.githubusercontent.com/mvankessel-EMC/DependencyReviewerWhitelists/main/tidyverse.csv
+#> 4                                                                                    some/file.csv
+#>   package version
+#> 1 package version
+#> 2 package version
+#> 3 package version
+#> 4 package version
+
write.csv(
+  fileWhiteList,
+  system.file(
+    package = "PaRe",
+    "whiteList.csv"
+  )
+)
+
+
+

Dependency Review

+

Before we start diving into the dependency usage of glue +we should first establish what our dependency white list even looks +like. We can retrieve our full list of whitelisted dependencies buy +calling the getDefaultPermittedPackages function.

+
+

getDefaultPermittedPackages

+
PaRe::getDefaultPermittedPackages(base = TRUE)
+#> # A tibble: 240 × 2
+#>    package           version   
+#>    <chr>             <nmrc_vrs>
+#>  1 Andromeda         0.6.3     
+#>  2 BH                1.81.0.1  
+#>  3 BeastJar          1.10.6    
+#>  4 BigKnn            1.0.2     
+#>  5 CDMConnector      0.6.0     
+#>  6 Capr              2.0.3     
+#>  7 Characterization  0.1.1     
+#>  8 CirceR            1.3.0     
+#>  9 CohortDiagnostics 3.2.2     
+#> 10 CohortExplorer    0.0.14    
+#> # … with 230 more rows
+

getDefaultPermittedPackages takes one parameter:

+
    +
  1. base which is set to TRUE by default. +Packages that listed as base packages will be included in the +white list.
    2. +
+
+
+

Setting up a Repository object

+
# Temp dir to clone repo to
+tempDir <- tempdir()
+pathToRepo <- file.path(tempDir, "glue")
+
+# Clone IncidencePrevalence to temp dir
+git2r::clone(
+  url = "https://github.com/tidyverse/glue.git",
+  local_path = pathToRepo
+)
+
+repo <- PaRe::Repository$new(path = pathToRepo)
+
#> cloning into 'C:\Users\MVANKE~1\AppData\Local\Temp\RtmpuuTmyT/glue'...
+#> Receiving objects:   1% (50/4925),   63 kb
+#> Receiving objects:  11% (542/4925),  464 kb
+#> Receiving objects:  21% (1035/4925), 2057 kb
+#> Receiving objects:  31% (1527/4925), 2337 kb
+#> Receiving objects:  41% (2020/4925), 2785 kb
+#> Receiving objects:  51% (2512/4925), 2841 kb
+#> Receiving objects:  61% (3005/4925), 3233 kb
+#> Receiving objects:  71% (3497/4925), 3738 kb
+#> Receiving objects:  81% (3990/4925), 3850 kb
+#> Receiving objects:  91% (4482/4925), 4018 kb
+#> Receiving objects: 100% (4925/4925), 4886 kb, done.
+
+
+

checkDependencies

+

Now that we know what is included in the white list, we can make our +first step into reviewing glue, which is to ensure the +(suggested) dependencies glue uses are in our white +list.

+
PaRe::checkDependencies(repo = repo)
+
→ The following are not permitted: covr, microbenchmark, R.utils, rprintf, testthat                  
+→ Please open an issue here: https://github.com/mvankessel-EMC/DependencyReviewerWhitelists/issues
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
packageversion
covr*
microbenchmark*
R.utils*
rprintf*
testthat3.0.0
+

Not all suggested dependencies are approved. The function prints a +message and returns a data frame, containing all packages that are not +listed in our white list.

+

checkDependecies takes two parameters:

+
    +
  1. pkgPath which specifies the path to the +pacakge.
    2. +
  2. dependencyType a vector of character items which +specify kinds of imports to look at.
    3. +
+
+
+

getGraphData

+

glue depends on (suggested) dependencies. These dependencies in turn +import other dependencies, and so on. We can investigate how these +recursive dependencies depend on one another, by investigating it as a +graph.

+
graphData <- PaRe::getGraphData(
+  repo = repo,
+  packageTypes = c("imports", "suggests")
+)
+

We can compute several statistics about our dependency graph

+
data.frame(
+  countVertices = length(igraph::V(graphData)),
+  countEdges = length(igraph::E(graphData)),
+  meanDegree = round(mean(igraph::degree(graphData)), 2),
+  meanDistance = round(mean(igraph::distances(graphData)), 2)
+)
+
    +
  • countVertices resembles the amount of recursive +dependencies glue depends on.
    • +
  • countEdges: are the total amount of imports of all +dependencies.
    • +
  • meanDegree: is the average amount of imports per +dependency.
    • +
  • meanDistance: is the average amount of dependencies +between glue and all other recursive dependencies.
    • +
+

We can then plot the graph.

+
plot(graphData)
+

+
+
+
+

Package wide function use

+

PaRe allows you to get insight in the function usage in +a package.

+
+

summariseFunctionUse

+
funsUsed <- PaRe::getFunctionUse(repo = repo)
+funsUsed
+
#> # A tibble: 426 × 4
+#>    file     line pkg     fun         
+#>    <chr>   <int> <chr>   <chr>       
+#>  1 color.R    59 base    function    
+#>  2 color.R    59 base    parent.frame
+#>  3 color.R    60 unknown glue        
+#>  4 color.R    65 base    function    
+#>  5 color.R    65 base    parent.frame
+#>  6 color.R    66 unknown glue_data   
+#>  7 color.R    69 base    function    
+#>  8 color.R    70 base    function    
+#>  9 color.R    70 base    parse       
+#> 10 color.R    70 base    tryCatch    
+#> # … with 416 more rows
+
+
+

getDefinedFunctions

+
defFuns <- PaRe::getDefinedFunctions(repo = repo)
+head(defFuns)
+
#>                name lineStart lineEnd nArgs cycloComp             fileName
+#> 1          glue_col        59      61     4         1              color.R
+#> 2     glue_data_col        65      67     5         1              color.R
+#> 3 color_transformer        69      99     2         8              color.R
+#> 4           .onLoad        47      50     1         1 compat-s3-register.R
+#> 5       s3_register        53     122     3         8 compat-s3-register.R
+#> 6    get_method_env        64      71     1         2 compat-s3-register.R
+

Besides the location of each function being displayed, the number of +arguments for each function, and the cyclometic complexity is also +included in the result.

+
PaRe::pkgDiagram(repo = repo) %>%
+  DiagrammeRsvg::export_svg() %>%
+  charToRaw() %>%
+  magick::image_read()
+

+
+
+
+

Lines of code

+
PaRe::countPackageLines(repo = repo)
+
#> # A tibble: 1 × 6
+#>       R   cpp     o     h  java   sql
+#>   <int> <int> <int> <int> <int> <int>
+#> 1  1118     0     0     0     0     0
+

glue contains 1056 lines of R-code.

+
+
+

Linting

+
messages <- PaRe::lintRepo(repo = repo)
+PaRe::lintScore(repo = repo, messages = messages)
+
#> Warning: Returning more (or less) than 1 row per `summarise()` group was deprecated in
+#> dplyr 1.1.0.
+#> ℹ Please use `reframe()` instead.
+#> ℹ When switching from `summarise()` to `reframe()`, remember that `reframe()`
+#>   always returns an ungrouped data frame and adjust accordingly.
+#> ℹ The deprecated feature was likely used in the PaRe package.
+#>   Please report the issue to the authors.
+#> # A tibble: 2 × 2
+#>   type      pct
+#>   <chr>   <dbl>
+#> 1 style   10.2 
+#> 2 warning  3.94
+
head(messages)
+
#>   filename line_number column_number    type
+#> 1  color.R           8            81   style
+#> 2  color.R          14            81   style
+#> 3  color.R          59             1   style
+#> 4  color.R          59            81   style
+#> 5  color.R          60             3 warning
+#> 6  color.R          60            81   style
+#>                                                 message
+#> 1          Lines should not be more than 80 characters.
+#> 2          Lines should not be more than 80 characters.
+#> 3 Variable and function name style should be camelCase.
+#> 4          Lines should not be more than 80 characters.
+#> 5      no visible global function definition for 'glue'
+#> 6          Lines should not be more than 80 characters.
+#>                                                                                             line
+#> 1  #' Using the following syntax will apply the function [crayon::blue()] to the text 'foo bar'.
+#> 2              #' If you want an expression to be evaluated, simply place that in a normal brace
+#> 3             glue_col <- function(..., .envir = parent.frame(), .na = "NA", .literal = FALSE) {
+#> 4             glue_col <- function(..., .envir = parent.frame(), .na = "NA", .literal = FALSE) {
+#> 5   glue(..., .envir = .envir, .na = .na, .literal = .literal, .transformer = color_transformer)
+#> 6   glue(..., .envir = .envir, .na = .na, .literal = .literal, .transformer = color_transformer)
+#>                linter
+#> 1  line_length_linter
+#> 2  line_length_linter
+#> 3  object_name_linter
+#> 4  line_length_linter
+#> 5 object_usage_linter
+#> 6  line_length_linter
+
+ + + + + + + + + + + diff --git a/inst/img/logo.png b/inst/img/logo.png new file mode 100644 index 0000000..c181903 Binary files /dev/null and b/inst/img/logo.png differ diff --git a/inst/rmd/ReportInjectable.Rmd b/inst/rmd/ReportInjectable.Rmd new file mode 100644 index 0000000..7df6983 --- /dev/null +++ b/inst/rmd/ReportInjectable.Rmd @@ -0,0 +1,253 @@ +--- +title: "#!P_TITLE" +author: "`r paste('PaRe', packageVersion('PaRe'))`" +date: "`r Sys.Date()`" +output: + html_document: + toc: true + toc_float: true + theme: cosmo +vignette: > + %\VignetteIndexEntry{#!P_TITLE} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +```{r echo=FALSE, message=FALSE} +library(PaRe) +library(dplyr) +``` + +```{r, echo=FALSE} +repo <- PaRe::Repository$new("../") +``` + +## Package overview +```{r packageDiagram, out.width="100%", warning=FALSE} +repo %>% + PaRe::pkgDiagram() %>% + DiagrammeRsvg::export_svg() %>% + charToRaw() %>% + magick::image_read() +``` + +## Summary of package functions +```{r getDefinedFunctionsPkg, message=FALSE, warning=FALSE} +defFuns <- PaRe::getDefinedFunctions(repo) + +defFuns <- defFuns %>% + dplyr::mutate(size = lineEnd - lineStart + 1) +``` + +```{r summaryDefFunStats} +DT::datatable(data.frame( + min = c(min(defFuns$nArgs, na.rm = TRUE), + min(defFuns$size, na.rm = TRUE), + min(defFuns$cycloComp, na.rm = TRUE)), + median = c(median(defFuns$nArgs, na.rm = TRUE), + median(defFuns$size, na.rm = TRUE), + median(defFuns$cycloComp, na.rm = TRUE)), + max = c(max(defFuns$nArgs, na.rm = TRUE), + max(defFuns$size, na.rm = TRUE), + max(defFuns$cycloComp, na.rm = TRUE)), + row.names = c("Number of arguments", + "Lines of code", + "Cyclomatic complexity")), + options = list(dom = 't')) +``` + +```{r} +gg_nArgs <- defFuns %>% + ggplot2::ggplot()+ + ggplot2::geom_histogram(ggplot2::aes(nArgs), binwidth = 1, + colour = "black", + fill = "grey")+ + ggplot2::theme_minimal()+ + ggplot2::xlab("Number of arguments") + +gg_size <- defFuns %>% + ggplot2::ggplot()+ + ggplot2::geom_histogram(ggplot2::aes(size), binwidth = 1, + colour = "black", + fill = "grey")+ + ggplot2::theme_minimal()+ + ggplot2::xlab("Lines of code") + +gg_cycloComp <- defFuns %>% + ggplot2::ggplot()+ + ggplot2::geom_histogram(ggplot2::aes(cycloComp), binwidth = 1, + colour = "black", + fill = "grey")+ + ggplot2::theme_minimal()+ + ggplot2::xlab("Cyclomatic complexity") + +cowplot::plot_grid(gg_nArgs, gg_size, gg_cycloComp, nrow = 3) +``` + +```{r, warning=FALSE, message=FALSE} +p <- defFuns %>% + ggplot2::ggplot(ggplot2::aes(group = name))+ + ggplot2::geom_point(ggplot2::aes(size, cycloComp, + colour = nArgs), + size = 3)+ + ggplot2::scale_colour_gradient(name = "Number of\nargruments", + low = "blue", high = "red") + + ggplot2::theme_minimal() + + ggplot2::xlab("Lines of code") + + ggplot2::ylab("Cyclomatic complexity") + + ggplot2::theme(legend.position = "top") + + plotly::ggplotly(p, + tooltip = c("group", "colour", + "x", "y")) +``` + +## Function details +```{r definedFunctions} +colours <- c("", "#DFDF00", "#AA3F40") +argBreaks <- c(5, 7) +complexBreaks <- c(15, 30) +lineBreaks <- c(100, 200) + +DT::datatable( + defFuns %>% + dplyr::mutate(file_start = paste0(.data$fileName, " (from line: ", lineStart, ")")) %>% + dplyr::select("name", "nArgs", "size","cycloComp", "file_start") %>% + dplyr::rename( + "Function" = "name", + "Number of arguments" = "nArgs", + "Lines of code" = "size", + "Cyclomatic complexity" = "cycloComp", + "Location" = "file_start"), + rownames = FALSE) %>% + DT::formatStyle("Number of arguments", backgroundColor = DT::styleInterval(argBreaks, colours)) %>% + DT::formatStyle("Cyclomatic complexity", backgroundColor = DT::styleInterval(complexBreaks, colours)) %>% + DT::formatStyle("Lines of code", backgroundColor = DT::styleInterval(lineBreaks, colours)) +``` + +## Use of other programming languages +```{r countLines} +DT::datatable( + PaRe::countPackageLines(repo), + rownames = "# lines of code") +``` + +## Style adherence, syntax errors and possible semantic issues +### Summary +```{r lintScores, message=FALSE, warning=FALSE} +lintMsgs <- PaRe::lintRepo(repo) + +DT::datatable(PaRe::lintScore(repo, lintMsgs) %>% + dplyr::rename("Percentage of lines assessed" = "pct"), + rownames = FALSE) +``` + +### Warnings +```{r lintMessages warnings, message=FALSE, warning=FALSE} +DT::datatable( + lintMsgs %>% + dplyr::filter(type == "warning") %>% + dplyr::group_by(message) %>% + dplyr::tally(sort = TRUE), + rownames= FALSE +) +``` + +### Style +```{r lintMessages style, message=FALSE, warning=FALSE} +DT::datatable( + lintMsgs %>% + dplyr::filter(type == "style") %>% + dplyr::group_by(message) %>% + dplyr::tally(sort = TRUE), + rownames= FALSE +) +``` + +## Dependency review +### Check dependencies against whitelist +```{r checkDependencies, warning=FALSE} +DT::datatable(PaRe::checkDependencies(repo = repo, verbose = FALSE)) +``` + +### Dependency characteristics +- **countVertices**: The amount of recursive dependencies `r repo$getName()` depends on. +- **countEdges**: The total amount of imports of all dependencies. +- **meanDegree**: The average amount of imports per dependency. +- **meanDistance**: The average dependency layers between `r repo$getName()` and all other recursive dependencies. +```{r dependencyGraphStats, message=FALSE, warning=FALSE} +graphData <- PaRe::getGraphData(repo = repo) + +DT::datatable(data.frame( + countVertices = length(igraph::V(graphData)), + countEdges = length(igraph::E(graphData)), + meanDegree = round(mean(igraph::degree(graphData)), 2), + meanDistance = round(mean(igraph::distances(graphData)), 2) + ), + rownames= FALSE) +``` + +### Function use per dependency +```{r summariseFunctionUse, message=FALSE, warning=FALSE} +funsUsed <- PaRe::getFunctionUse(repo = repo) + +DT::datatable( + funsUsed, + rownames = FALSE) +``` + +```{r plotFunctionUse, dpi=100, fig.height=25, out.width="100%", message=FALSE, warning=FALSE} +function_sub <- funsUsed %>% + dplyr::filter(!pkg %in% c("base")) + +fun_counts <- function_sub %>% + dplyr::group_by(fun, pkg, name = "n") %>% + dplyr::tally() + +# Filter functions that are defined in the package +nonPkgFuns <- fun_counts[!fun_counts$fun %in% defFuns$fun, ] + +ggplot2::ggplot( + data = nonPkgFuns, + mapping = ggplot2::aes(x = .data$fun, y = .data$n, fill = .data$pkg)) + + ggplot2::geom_col() + + ggplot2::facet_wrap( + dplyr::vars(.data$pkg), + scales = "free_x", + ncol = 2) + + ggplot2::theme_bw() + + ggplot2::theme( + legend.position = "none", + axis.text.x = (ggplot2::element_text(angle = 45, hjust = 1, vjust = 1))) +``` + + + + + +## Further reading +### Style Guide +The styling is based on the following style guide: + +- [Tidyverse styleguide](https://style.tidyverse.org/syntax.html) +- [HADES styleguide](https://ohdsi.github.io/Hades/codeStyle.html) + +### Cyclomatic Complexity +>[Cyclomatic Complexity](https://en.wikipedia.org/wiki/Cyclomatic_complexity) is a software metric used to indicate the complexity of a program. It is a quantitative measure of the number of linearly independent paths through a program's source code. It was developed by Thomas J. McCabe, Sr. in 1976. + +And is calculated as follows: $M = E - N + 2P$ + +The complexity score is interpreted as follows: + +> +> - 1-10 Simple procedure, little risk +> - 11-20 More complex, moderate risk +> - 21-50 Complex, high risk +> - \>50 Untestable code, very high risk +> + +[link, 2023-02-10](https://en.wikipedia.org/wiki/Cyclomatic_complexity#Interpretation) diff --git a/inst/rmd/report.Rmd b/inst/rmd/report.Rmd new file mode 100644 index 0000000..0f1a18a --- /dev/null +++ b/inst/rmd/report.Rmd @@ -0,0 +1,244 @@ +--- +title: "`r paste('PaRe Report:', params$pkgName)`" +author: "`r paste('PaRe', packageVersion('PaRe'))`" +date: "`r Sys.Date()`" +output: + html_document: + toc: true + toc_float: true + theme: cosmo +params: + pkgName: pkgName + repo: repo + showCode: showCode +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +## Package overview +```{r packageDiagram, out.width="100%", echo=params$showCode, warning=FALSE} +repo %>% + PaRe::pkgDiagram() %>% + DiagrammeRsvg::export_svg() %>% + charToRaw() %>% + magick::image_read() +``` + +## Summary of package functions +```{r getDefinedFunctionsPkg, echo=params$showCode, message=FALSE, warning=FALSE} +defFuns <- PaRe::getDefinedFunctions(repo) + +defFuns <- defFuns %>% + dplyr::mutate(size = lineEnd - lineStart + 1) +``` + +```{r summaryDefFunStats, echo=params$showCode} +DT::datatable(data.frame( + min = c(min(defFuns$nArgs, na.rm = TRUE), + min(defFuns$size, na.rm = TRUE), + min(defFuns$cycloComp, na.rm = TRUE)), + median = c(median(defFuns$nArgs, na.rm = TRUE), + median(defFuns$size, na.rm = TRUE), + median(defFuns$cycloComp, na.rm = TRUE)), + max = c(max(defFuns$nArgs, na.rm = TRUE), + max(defFuns$size, na.rm = TRUE), + max(defFuns$cycloComp, na.rm = TRUE)), + row.names = c("Number of arguments", + "Lines of code", + "Cyclomatic complexity")), + options = list(dom = 't')) +``` + +```{r, echo=params$showCode} +gg_nArgs <- defFuns %>% + ggplot2::ggplot()+ + ggplot2::geom_histogram(aes(nArgs), binwidth = 1, + colour = "black", + fill = "grey")+ + ggplot2::theme_minimal()+ + ggplot2::xlab("Number of arguments") + +gg_size <- defFuns %>% + ggplot2::ggplot()+ + ggplot2::geom_histogram(aes(size), binwidth = 1, + colour = "black", + fill = "grey")+ + ggplot2::theme_minimal()+ + ggplot2::xlab("Lines of code") + +gg_cycloComp <- defFuns %>% + ggplot2::ggplot()+ + ggplot2::geom_histogram(aes(cycloComp), binwidth = 1, + colour = "black", + fill = "grey")+ + ggplot2::theme_minimal()+ + ggplot2::xlab("Cyclomatic complexity") + +cowplot::plot_grid(gg_nArgs, gg_size, gg_cycloComp, nrow = 3) +``` + +```{r, echo=params$showCode, warning=FALSE, message=FALSE} +p <- defFuns %>% + ggplot2::ggplot(aes(group = name))+ + ggplot2::geom_point(aes(size, cycloComp, + colour = nArgs), + size = 3)+ + ggplot2::scale_colour_gradient(name = "Number of\nargruments", + low = "blue", high = "red") + + ggplot2::theme_minimal() + + ggplot2::xlab("Lines of code") + + ggplot2::ylab("Cyclomatic complexity") + + ggplot2::theme(legend.position = "top") + + plotly::ggplotly(p, + tooltip = c("group", "colour", + "x", "y")) +``` + +## Function details +```{r definedFunctions, echo=params$showCode} +colours <- c("", "#DFDF00", "#AA3F40") +argBreaks <- c(5, 7) +complexBreaks <- c(15, 30) +lineBreaks <- c(100, 200) + +DT::datatable( + defFuns %>% + dplyr::mutate(file_start = paste0(.data$fileName, " (from line: ", lineStart, ")")) %>% + dplyr::select("name", "nArgs", "size","cycloComp", "file_start") %>% + dplyr::rename( + "Function" = "name", + "Number of arguments" = "nArgs", + "Lines of code" = "size", + "Cyclomatic complexity" = "cycloComp", + "Location" = "file_start"), + rownames = FALSE) %>% + DT::formatStyle("Number of arguments", backgroundColor = styleInterval(argBreaks, colours)) %>% + DT::formatStyle("Cyclomatic complexity", backgroundColor = styleInterval(complexBreaks, colours)) %>% + DT::formatStyle("Lines of code", backgroundColor = styleInterval(lineBreaks, colours)) +``` + +## Use of other programming languages +```{r countLines, echo=params$showCode} +DT::datatable( + PaRe::countPackageLines(repo), + rownames = "# lines of code") +``` + +## Style adherence, syntax errors and possible semantic issues +### Summary +```{r lintScores, echo=params$showCode, message=FALSE, warning=FALSE} +lintMsgs <- PaRe::lintRepo(repo) + +DT::datatable(PaRe::lintScore(repo, lintMsgs) %>% + dplyr::rename("Percentage of lines assessed" = "pct"), + rownames= FALSE) +``` + +### Warnings +```{r lintMessages warnings, echo=params$showCode, message=FALSE, warning=FALSE} +DT::datatable( + lintMsgs %>% + dplyr::filter(type == "warning") %>% + dplyr::group_by(message) %>% + dplyr::tally(sort = TRUE), + rownames= FALSE +) +``` + +### Style +```{r lintMessages style, echo=params$showCode, message=FALSE, warning=FALSE} +DT::datatable( + lintMsgs %>% + dplyr::filter(type == "style") %>% + dplyr::group_by(message) %>% + dplyr::tally(sort = TRUE), + rownames= FALSE +) +``` + +## Dependency review +### Check dependencies against whitelist +```{r checkDependencies, echo=params$showCode, warning=FALSE} +DT::datatable(PaRe::checkDependencies(repo = repo, verbose = FALSE)) +``` + +### Dependency characteristics +- **countVertices**: The amount of recursive dependencies `r repo$getName()` depends on. +- **countEdges**: The total amount of imports of all dependencies. +- **meanDegree**: The average amount of imports per dependency. +- **meanDistance**: The average dependency layers between `r repo$getName()` and all other recursive dependencies. +```{r dependencyGraphStats, echo=params$showCode, message=FALSE, warning=FALSE} +graphData <- PaRe::getGraphData(repo = repo) + +DT::datatable(data.frame( + countVertices = length(igraph::V(graphData)), + countEdges = length(igraph::E(graphData)), + meanDegree = round(mean(igraph::degree(graphData)), 2), + meanDistance = round(mean(igraph::distances(graphData)), 2) + ), + rownames = FALSE) +``` + +### Function use per dependency +```{r summariseFunctionUse, echo=params$showCode, message=FALSE, warning=FALSE} +funsUsed <- PaRe::getFunctionUse(repo = repo) + +DT::datatable( + funsUsed, + rownames = FALSE) +``` + +```{r plotFunctionUse, dpi=100, fig.height=25, out.width="100%", echo=params$showCode, message=FALSE, warning=FALSE} +function_sub <- funsUsed %>% + dplyr::filter(!pkg %in% c("base")) + +fun_counts <- function_sub %>% + dplyr::group_by(fun, pkg, name = "n") %>% + dplyr::tally() + +# Filter functions that are defined in the package +nonPkgFuns <- fun_counts[!fun_counts$fun %in% defFuns$fun, ] + +ggplot2::ggplot( + data = nonPkgFuns, + mapping = ggplot2::aes(x = .data$fun, y = .data$n, fill = .data$pkg)) + + ggplot2::geom_col() + + ggplot2::facet_wrap( + dplyr::vars(.data$pkg), + scales = "free_x", + ncol = 2) + + ggplot2::theme_bw() + + ggplot2::theme( + legend.position = "none", + axis.text.x = (ggplot2::element_text(angle = 45, hjust = 1, vjust = 1))) +``` + + + + + +## Further reading +### Style Guide +The styling is based on the following style guide: + +- [Tidyverse styleguide](https://style.tidyverse.org/syntax.html) +- [HADES styleguide](https://ohdsi.github.io/Hades/codeStyle.html) + +### Cyclomatic Complexity +>[Cyclomatic Complexity](https://en.wikipedia.org/wiki/Cyclomatic_complexity) is a software metric used to indicate the complexity of a program. It is a quantitative measure of the number of linearly independent paths through a program's source code. It was developed by Thomas J. McCabe, Sr. in 1976. + +And is calculated as follows: $M = E - N + 2P$ + +The complexity score is interpreted as follows: + +> +> - 1-10 Simple procedure, little risk +> - 11-20 More complex, moderate risk +> - 21-50 Complex, high risk +> - \>50 Untestable code, very high risk +> + +[link, 2023-02-10](https://en.wikipedia.org/wiki/Cyclomatic_complexity#Interpretation) diff --git a/inst/testScript.R b/inst/testScript.R new file mode 100644 index 0000000..755cb7d --- /dev/null +++ b/inst/testScript.R @@ -0,0 +1,98 @@ +# Copyright 2023 DARWIN EU® +# +# This file is part of IncidencePrevalence +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +#' getDefaultPermittedpackages +#' +#' Gets permitted packages +#' +#' @return tibble of two columns (package, version) with all 'allowed' +#' packages. +#' +#' @import readr +#' @import tidyverse +#' +#' @export +getDefaultPermittedPackages <- function() { + tmpFile <- list.files( + path = tempdir(), + pattern = "tmpPkgs*", + full.names = TRUE) + + if (length(tmpFile) > 0) { + message("Get from temp file") + return(dplyr::tibble(read.csv(tmpFile))) + } else { + # Create tmp file + tmpFile <- tempfile( + pattern = "tmpPkgs", + tmpdir = tempdir(), + fileext = ".csv") + + permittedDependencies <- read.table( + file = "https://raw.githubusercontent.com/mvankessel-EMC/DependencyReviewerWhitelists/main/dependencies.csv", + sep = ",", + header = TRUE) %>% + tibble() + + # Get base packages + basePackages <- data.frame(installed.packages(priority = "high")) %>% + dplyr::select(Package, Built) %>% + dplyr::rename(package = Package, version = Built) %>% + dplyr::tibble() + + # Get Tidyverse packages + tidyversePackages <- sapply( + X = tidyverse::tidyverse_packages(include_self = TRUE), + FUN = function(pkg) { + as.character(packageVersion(pkg)) + } + ) + + tidyversePackages <- tibble( + package = names(tidyversePackages), + version = tidyversePackages) + + # Get HADES packages + hadesPackages <- read.table( + file = "https://raw.githubusercontent.com/OHDSI/Hades/main/extras/packages.csv", + sep = ",", + header = TRUE) %>% select(name) %>% + mutate(version = rep("*", length(names))) %>% + rename(package = name) %>% + tibble() + + hadesPackages$package <- paste0("OHDSI/", hadesPackages$package) + + sourcePackages <- dplyr::bind_rows( + tidyversePackages, + hadesPackages, + permittedDependencies + ) + + depList <- pak::pkg_deps(sourcePackages$package) + + permittedPackages <- dplyr::bind_rows( + basePackages, + depList %>% + select(package, version)) + + message("Writing temp file") + write.csv( + x = permittedPackages, + file = tmpFile) + return(permittedPackages) + } +} diff --git a/inst/whiteList.csv b/inst/whiteList.csv new file mode 100644 index 0000000..e05d765 --- /dev/null +++ b/inst/whiteList.csv @@ -0,0 +1,4 @@ +"source","link","package","version" +"darwin","https://raw.githubusercontent.com/mvankessel-EMC/DependencyReviewerWhitelists/main/darwin.csv","package","version" +"hades","https://raw.githubusercontent.com/mvankessel-EMC/DependencyReviewerWhitelists/main/hades.csv","package","version" +"tidyverse","https://raw.githubusercontent.com/mvankessel-EMC/DependencyReviewerWhitelists/main/tidyverse.csv","package","version" diff --git a/man/Code.Rd b/man/Code.Rd new file mode 100644 index 0000000..827315f --- /dev/null +++ b/man/Code.Rd @@ -0,0 +1,130 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/R6-Code.R +\name{Code} +\alias{Code} +\title{R6 Code class} +\description{ +Class representing a piece of code. +} +\seealso{ +Other Representations: +\code{\link{File}}, +\code{\link{Function}}, +\code{\link{Repository}} +} +\concept{Representations} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-Code-new}{\code{Code$new()}} +\item \href{#method-Code-print}{\code{Code$print()}} +\item \href{#method-Code-getLines}{\code{Code$getLines()}} +\item \href{#method-Code-getNLines}{\code{Code$getNLines()}} +\item \href{#method-Code-getName}{\code{Code$getName()}} +\item \href{#method-Code-clone}{\code{Code$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Code-new}{}}} +\subsection{Method \code{new()}}{ +Initializer method +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Code$new(name, lines)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{name}}{(\link[base]{character})\cr +Name of Code object.} + +\item{\code{lines}}{(\link[base]{character})\cr +Vector of lines Code object.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +\code{invisible(self)} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Code-print}{}}} +\subsection{Method \code{print()}}{ +Overload generic print, to print Code object. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Code$print(...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{...}}{further arguments passed to or from other methods. See \link[base]{print}.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +([base]{character}) +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Code-getLines}{}}} +\subsection{Method \code{getLines()}}{ +Get method for lines. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Code$getLines()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{character})\cr +Vector of lines in the Code object. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Code-getNLines}{}}} +\subsection{Method \code{getNLines()}}{ +Get method for number of lines. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Code$getNLines()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{numeric}) +Number of lines in the Code object. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Code-getName}{}}} +\subsection{Method \code{getName()}}{ +Get method for Name. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Code$getName()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{character})\cr +Name of the Code object. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Code-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Code$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/File.Rd b/man/File.Rd new file mode 100644 index 0000000..cc08728 --- /dev/null +++ b/man/File.Rd @@ -0,0 +1,189 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/R6-File.R +\name{File} +\alias{File} +\title{R6 File class} +\description{ +Class representing a file containing code. +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + files <- repo$getRFiles() + files[[1]] +} +} +\seealso{ +Other Representations: +\code{\link{Code}}, +\code{\link{Function}}, +\code{\link{Repository}} +} +\concept{Representations} +\section{Super class}{ +\code{\link[PaRe:Code]{PaRe::Code}} -> \code{File} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-File-new}{\code{File$new()}} +\item \href{#method-File-getFunctions}{\code{File$getFunctions()}} +\item \href{#method-File-getFunctionTable}{\code{File$getFunctionTable()}} +\item \href{#method-File-getType}{\code{File$getType()}} +\item \href{#method-File-getFilePath}{\code{File$getFilePath()}} +\item \href{#method-File-getBlameTable}{\code{File$getBlameTable()}} +\item \href{#method-File-clone}{\code{File$clone()}} +} +} +\if{html}{\out{ +
Inherited methods + +
+}} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-File-new}{}}} +\subsection{Method \code{new()}}{ +Initializer method +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{File$new(repoPath, filePath)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{repoPath}}{(\link[base]{character})\cr +Path to repository.} + +\item{\code{filePath}}{(\link[base]{character})\cr +Relative path to file} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +\code{invisible(self)} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-File-getFunctions}{}}} +\subsection{Method \code{getFunctions()}}{ +Get method to get a list of Function objects +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{File$getFunctions()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{list})\cr +List of \link[PaRe]{Function} objects. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-File-getFunctionTable}{}}} +\subsection{Method \code{getFunctionTable()}}{ +Get method to retrieve the function table. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{File$getFunctionTable()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{data.frame})\tabular{ll}{ + column \tab data type \cr + name \tab \link[base]{character} \cr + lineStart \tab \link[base]{integer} \cr + lineEnd \tab \link[base]{numeric} \cr + nArgs \tab \link[base]{integer} \cr + cycloComp \tab \link[base]{integer} \cr +} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-File-getType}{}}} +\subsection{Method \code{getType()}}{ +Gets type of file +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{File$getType()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{character}) +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-File-getFilePath}{}}} +\subsection{Method \code{getFilePath()}}{ +Gets relative file path +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{File$getFilePath()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{character}) +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-File-getBlameTable}{}}} +\subsection{Method \code{getBlameTable()}}{ +Gets table of git blame +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{File$getBlameTable()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[dplyr]{tibble}) +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-File-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{File$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/Function.Rd b/man/Function.Rd new file mode 100644 index 0000000..abaabd6 --- /dev/null +++ b/man/Function.Rd @@ -0,0 +1,140 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/R6-Function.R +\name{Function} +\alias{Function} +\title{R6 Function class.} +\description{ +Class representing a function. +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + files <- repo$getRFiles() + file <- files[[1]] + funs <- file$getFunctions() + funs[[1]] +} +} +\seealso{ +Other Representations: +\code{\link{Code}}, +\code{\link{File}}, +\code{\link{Repository}} +} +\concept{Representations} +\section{Super class}{ +\code{\link[PaRe:Code]{PaRe::Code}} -> \code{Function} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-Function-new}{\code{Function$new()}} +\item \href{#method-Function-getFunction}{\code{Function$getFunction()}} +\item \href{#method-Function-clone}{\code{Function$clone()}} +} +} +\if{html}{\out{ +
Inherited methods + +
+}} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Function-new}{}}} +\subsection{Method \code{new()}}{ +Initializer for Function object. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Function$new(name, lineStart, lineEnd, lines)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{name}}{(\link[base]{character})\cr +Name of Function.} + +\item{\code{lineStart}}{(\link[base]{numeric})\cr +Line number where function starts in File.} + +\item{\code{lineEnd}}{(\link[base]{numeric})\cr +Line number where function ends in File.} + +\item{\code{lines}}{(\link[base]{c})\cr +Vector of type \link[base]{character} Lines of just the function in File.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +\code{invisible(self)} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Function-getFunction}{}}} +\subsection{Method \code{getFunction()}}{ +Get method to get defined functions in a File object. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Function$getFunction()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{data.frame})\tabular{ll}{ + column \tab data type \cr + name \tab (\link[base]{character}) \cr + lineStart \tab (\link[base]{integer}) \cr + lineEnd \tab (\link[base]{numeric}) \cr + nArgs \tab (\link[base]{integer}) \cr + cycloComp \tab (\link[base]{integer}) \cr +} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Function-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Function$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/PaRe-package.Rd b/man/PaRe-package.Rd new file mode 100644 index 0000000..9f937eb --- /dev/null +++ b/man/PaRe-package.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PaRe-package.R +\docType{package} +\name{PaRe-package} +\alias{PaRe} +\alias{PaRe-package} +\title{PaRe: A Way to Perform Code Review or QA on Other Packages} +\description{ +\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} + +Reviews other packages during code review by looking at their dependencies, code style, code complexity, and how internally defined functions interact with one another. +} +\author{ +\strong{Maintainer}: Maarten van Kessel \email{m.l.vankessel@erasmusmc.nl} + +} +\keyword{internal} diff --git a/man/Repository.Rd b/man/Repository.Rd new file mode 100644 index 0000000..22edee9 --- /dev/null +++ b/man/Repository.Rd @@ -0,0 +1,251 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/R6-Repository.R +\name{Repository} +\alias{Repository} +\title{R6 Repository class.} +\description{ +Class representing the Repository +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + repo +} +} +\seealso{ +Other Representations: +\code{\link{Code}}, +\code{\link{File}}, +\code{\link{Function}} +} +\concept{Representations} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-Repository-new}{\code{Repository$new()}} +\item \href{#method-Repository-getName}{\code{Repository$getName()}} +\item \href{#method-Repository-getPath}{\code{Repository$getPath()}} +\item \href{#method-Repository-getFiles}{\code{Repository$getFiles()}} +\item \href{#method-Repository-getRFiles}{\code{Repository$getRFiles()}} +\item \href{#method-Repository-getDescription}{\code{Repository$getDescription()}} +\item \href{#method-Repository-getFunctionUse}{\code{Repository$getFunctionUse()}} +\item \href{#method-Repository-gitCheckout}{\code{Repository$gitCheckout()}} +\item \href{#method-Repository-gitPull}{\code{Repository$gitPull()}} +\item \href{#method-Repository-gitBlame}{\code{Repository$gitBlame()}} +\item \href{#method-Repository-clone}{\code{Repository$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-new}{}}} +\subsection{Method \code{new()}}{ +Initializer for Repository class +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$new(path)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{path}}{(\link[base]{character})\cr +Path to R package project} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +\code{invisible(self)} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-getName}{}}} +\subsection{Method \code{getName()}}{ +Get method for name. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$getName()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{character})\cr +Repository name +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-getPath}{}}} +\subsection{Method \code{getPath()}}{ +Get method fro path +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$getPath()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{character})\cr +Path to Repository folder +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-getFiles}{}}} +\subsection{Method \code{getFiles()}}{ +Get method to get a list of \link[PaRe]{File} objects. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$getFiles()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{list})\cr +List of \link[PaRe]{File} objects. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-getRFiles}{}}} +\subsection{Method \code{getRFiles()}}{ +Get method to get only R-files. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$getRFiles()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{list})\cr +List of \link[PaRe]{File} objects. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-getDescription}{}}} +\subsection{Method \code{getDescription()}}{ +Get method to get the description of the package. See: \link[desc]{description}. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$getDescription()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[desc]{description})\cr +Description object. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-getFunctionUse}{}}} +\subsection{Method \code{getFunctionUse()}}{ +Get method for functionUse, will check if functionUse has already been +fetched or not. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$getFunctionUse()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[base]{data.frame})\cr +See \link[PaRe]{getFunctionUse}. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-gitCheckout}{}}} +\subsection{Method \code{gitCheckout()}}{ +Method to run 'git checkout ' +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$gitCheckout(branch, ...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{branch}}{(\link[base]{character})\cr +Name of branch or a hash referencing a specific commit.} + +\item{\code{...}}{Further parameters for \link[git2r]{checkout}.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +\code{invisible(self)} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-gitPull}{}}} +\subsection{Method \code{gitPull()}}{ +Method to run 'git pull' +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$gitPull(...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{...}}{Further parameters for \link[git2r]{pull}.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +\code{invisible(self)} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-gitBlame}{}}} +\subsection{Method \code{gitBlame()}}{ +Method to fetch data generated by 'git blame'. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$gitBlame()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\link[dplyr]{tibble})\tabular{ll}{ + column \tab data type \cr + repository \tab \link[base]{character} \cr + author \tab \link[base]{character} \cr + file \tab \link[base]{character} \cr + date \tab \link[base]{character} \cr + lines \tab \link[base]{integer} \cr +} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Repository-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Repository$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/checkDependencies.Rd b/man/checkDependencies.Rd new file mode 100644 index 0000000..b0776dd --- /dev/null +++ b/man/checkDependencies.Rd @@ -0,0 +1,73 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/checkDependencies.R +\name{checkDependencies} +\alias{checkDependencies} +\title{checkDependencies} +\usage{ +checkDependencies( + repo, + dependencyType = c("Imports", "Depends"), + verbose = TRUE +) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository})\cr +Repository object.} + +\item{dependencyType}{(\link[base]{character})\cr +Types of dependencies to be included} + +\item{verbose}{(\link[base]{logical}: TRUE) +TRUE or FALSE. If TRUE, progress will be reported.} +} +\value{ +(\link[base]{data.frame})\cr +Data frame with all the packages that are now permitted.\tabular{ll}{ + column \tab data type \cr + package \tab \link[base]{character} \cr + version \tab \link[base]{character} \cr +} +} +\description{ +Check package dependencies +} +\examples{ +# Set cahce, usually not required. +withr::local_envvar( + R_USER_CACHE_DIR = tempfile() +) + +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + # Use checkDependencies on the Repository object. + checkDependencies(repo) + checkDependencies(repo, dependencyType = c("Imports", "Suggests")) +} +} diff --git a/man/checkInstalled.Rd b/man/checkInstalled.Rd new file mode 100644 index 0000000..45aaa36 --- /dev/null +++ b/man/checkInstalled.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/makeReport.R +\name{checkInstalled} +\alias{checkInstalled} +\title{checkInstalled} +\usage{ +checkInstalled() +} +\value{ +\link[base]{logical}\cr +Logical depending if suggested packages are installed. +} +\description{ +Checks if suggested packages are installed. +} diff --git a/man/countPackageLines.Rd b/man/countPackageLines.Rd new file mode 100644 index 0000000..13c4e25 --- /dev/null +++ b/man/countPackageLines.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/countPackageLines.R +\name{countPackageLines} +\alias{countPackageLines} +\title{countPackageLines} +\usage{ +countPackageLines(repo) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository})\cr +Repository object.} +} +\value{ +(\link[dplyr]{tibble}\cr) +Tibble containing the amount of lines per file in the Repository object. +} +\description{ +Counts the package lines of a \link[PaRe]{Repository} object. +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + # Run countPackageLines on the Repository object. + countPackageLines(repo = repo) +} +} diff --git a/man/exportDiagram.Rd b/man/exportDiagram.Rd new file mode 100644 index 0000000..3af8ab1 --- /dev/null +++ b/man/exportDiagram.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pkgDiagram.R +\name{exportDiagram} +\alias{exportDiagram} +\title{exportDiagram} +\usage{ +exportDiagram(diagram, fileName) +} +\arguments{ +\item{diagram}{(\link[DiagrammeR]{grViz})\cr +Graph object from \link[PaRe]{pkgDiagram}.} + +\item{fileName}{(\link[base]{character})\cr +Path to save the diagram to, as PDF.} +} +\value{ +(\code{NULL}) +} +\description{ +Exports the diagram from \code{pkgDiagram} to a PDF-file. +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + # Run pkgDiagram on the Repository object. + pkgDiagram(repo = repo) \%>\% + # Export the diagram to a temp file. + exportDiagram(fileName = tempfile()) +} +} diff --git a/man/figures/logo.png b/man/figures/logo.png new file mode 100644 index 0000000..c181903 Binary files /dev/null and b/man/figures/logo.png differ diff --git a/man/functionUseGraph.Rd b/man/functionUseGraph.Rd new file mode 100644 index 0000000..ad1017e --- /dev/null +++ b/man/functionUseGraph.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getFunctionDiagram.R +\name{functionUseGraph} +\alias{functionUseGraph} +\title{functionUseGraph} +\usage{ +functionUseGraph(repo) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository})} +} +\value{ +(\link[igraph]{graph}) +} +\description{ +functionUseGraph +} diff --git a/man/funsUsedInFile.Rd b/man/funsUsedInFile.Rd new file mode 100644 index 0000000..50fca5f --- /dev/null +++ b/man/funsUsedInFile.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getFunctionUse.R +\name{funsUsedInFile} +\alias{funsUsedInFile} +\title{funsUsedInFile} +\usage{ +funsUsedInFile(files, verbose = FALSE) +} +\arguments{ +\item{files}{(\link[base]{list}) of (\link[PaRe]{File})} + +\item{verbose}{(\link[base]{logical})} +} +\value{ +(\link[base]{list}) +} +\description{ +Support function +} diff --git a/man/funsUsedInLine.Rd b/man/funsUsedInLine.Rd new file mode 100644 index 0000000..d19bc32 --- /dev/null +++ b/man/funsUsedInLine.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getFunctionUse.R +\name{funsUsedInLine} +\alias{funsUsedInLine} +\title{funsUsedInLine} +\usage{ +funsUsedInLine(lines, name, i, verbose = FALSE) +} +\arguments{ +\item{lines}{(\link[base]{c}) of (\link[base]{character})} + +\item{name}{(\link[base]{character})} + +\item{i}{(\link[base]{numeric})} + +\item{verbose}{(\link[base]{logical}: FALSE)} +} +\value{ +(\link[base]{data.frame})\tabular{ll}{ + column \tab data type \cr + pkg \tab \link[base]{character} \cr + fun \tab \link[base]{character} \cr + line \tab \link[base]{numeric} \cr +} +} +\description{ +Support function for funsUsedInFile. +} diff --git a/man/getApplyCall.Rd b/man/getApplyCall.Rd new file mode 100644 index 0000000..c000533 --- /dev/null +++ b/man/getApplyCall.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callInvestigators.R +\name{getApplyCall} +\alias{getApplyCall} +\title{getApplyCall} +\usage{ +getApplyCall(fun, defFuns) +} +\arguments{ +\item{fun}{(\link[PaRe]{Function})\cr +Function object.} + +\item{defFuns}{(\link[base]{data.frame})\cr +See \link[PaRe]{getDefinedFunctions}} +} +\value{ +(\link[base]{data.frame}) +} +\description{ +getApplyCall +} diff --git a/man/getApplyFromLines.Rd b/man/getApplyFromLines.Rd new file mode 100644 index 0000000..eb0a148 --- /dev/null +++ b/man/getApplyFromLines.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callInvestigators.R +\name{getApplyFromLines} +\alias{getApplyFromLines} +\title{getApplyFromLines} +\usage{ +getApplyFromLines(lines) +} +\arguments{ +\item{lines}{(\link[base]{c})\cr +Vector of (\link[base]{character}). See \link[PaRe]{getDefinedFunctions}} +} +\value{ +(\link[base]{character}) +} +\description{ +getApplyFromLines +} diff --git a/man/getDefaultPermittedPackages.Rd b/man/getDefaultPermittedPackages.Rd new file mode 100644 index 0000000..2459ffc --- /dev/null +++ b/man/getDefaultPermittedPackages.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getDefaultPermittedPackages.R +\name{getDefaultPermittedPackages} +\alias{getDefaultPermittedPackages} +\title{getDefaultPermittedPackages} +\usage{ +getDefaultPermittedPackages(base = TRUE) +} +\arguments{ +\item{base}{(\link[base]{logical}: TRUE) +\describe{ +\item{TRUE}{Base packages will be included.} +\item{FALSE}{Base packages will be ignored.} +}} +} +\value{ +(\link[dplyr]{tibble})\tabular{ll}{ + column \tab data type \cr + package \tab \link[base]{character} \cr + version \tab \link[base]{character} \cr +} +} +\description{ +Gets permitted packages. An internet connection is required. +} +\examples{ +# Set cache +withr::local_envvar( + R_USER_CACHE_DIR = tempfile() +) + +if (interactive()) { + getDefaultPermittedPackages() +} +} diff --git a/man/getDefinedFunctions.Rd b/man/getDefinedFunctions.Rd new file mode 100644 index 0000000..019fd43 --- /dev/null +++ b/man/getDefinedFunctions.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getDefinedFunctions.R +\name{getDefinedFunctions} +\alias{getDefinedFunctions} +\title{getDefinedFunctions} +\usage{ +getDefinedFunctions(repo) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository})\cr +Repository object.} +} +\value{ +(\link[base]{data.frame})\tabular{ll}{ + column \tab data type \cr + name \tab \link[base]{character} \cr + lineStart \tab \link[base]{integer} \cr + lineEnd \tab \link[base]{numeric} \cr + nArgs \tab \link[base]{integer} \cr + cycloComp \tab \link[base]{integer} \cr + fileName \tab \link[base]{character} \cr +} +} +\description{ +Gets all the defined functions from a \link[PaRe]{Repository} object. +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + repo <- PaRe::Repository$new(pathToRepo) + + getDefinedFunctions(repo) +} +} diff --git a/man/getDlplyCall.Rd b/man/getDlplyCall.Rd new file mode 100644 index 0000000..6bb392d --- /dev/null +++ b/man/getDlplyCall.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callInvestigators.R +\name{getDlplyCall} +\alias{getDlplyCall} +\title{getDlplyCall} +\usage{ +getDlplyCall(fun, defFuns) +} +\arguments{ +\item{fun}{(\link[PaRe]{Function})\cr +Function object.} + +\item{defFuns}{(\link[base]{data.frame})\cr +See \link[PaRe]{getDefinedFunctions}} +} +\value{ +(\link[base]{data.frame}) +} +\description{ +getDlplyCall +} diff --git a/man/getDlplyCallFromLines.Rd b/man/getDlplyCallFromLines.Rd new file mode 100644 index 0000000..16a1a76 --- /dev/null +++ b/man/getDlplyCallFromLines.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callInvestigators.R +\name{getDlplyCallFromLines} +\alias{getDlplyCallFromLines} +\title{getDlplyCallFromLines} +\usage{ +getDlplyCallFromLines(lines) +} +\arguments{ +\item{lines}{(\link[base]{c})\cr +Vector of (\link[base]{character}).} +} +\value{ +(\link[base]{character}) +} +\description{ +getDlplyCallFromLines +} diff --git a/man/getDoCall.Rd b/man/getDoCall.Rd new file mode 100644 index 0000000..3d9b2a2 --- /dev/null +++ b/man/getDoCall.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callInvestigators.R +\name{getDoCall} +\alias{getDoCall} +\title{getDoCall} +\usage{ +getDoCall(fun, defFuns) +} +\arguments{ +\item{fun}{(\link[PaRe]{Function})\cr +Function object.} + +\item{defFuns}{(\link[base]{data.frame})\cr +See \link[PaRe]{getDefinedFunctions}} +} +\value{ +(\link[base]{data.frame}) +} +\description{ +getDoCall +} diff --git a/man/getDoCallFromLines.Rd b/man/getDoCallFromLines.Rd new file mode 100644 index 0000000..1db7883 --- /dev/null +++ b/man/getDoCallFromLines.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callInvestigators.R +\name{getDoCallFromLines} +\alias{getDoCallFromLines} +\title{getDoCallFromLines} +\usage{ +getDoCallFromLines(lines) +} +\arguments{ +\item{lines}{(\link[base]{c})\cr +Vector of (\link[base]{character}). See \link[PaRe]{getDefinedFunctions}} +} +\value{ +(\link[base]{character}) +} +\description{ +getDoCallFromLines +} diff --git a/man/getExportedFunctions.Rd b/man/getExportedFunctions.Rd new file mode 100644 index 0000000..b828dfd --- /dev/null +++ b/man/getExportedFunctions.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pkgDiagram.R +\name{getExportedFunctions} +\alias{getExportedFunctions} +\title{getExportedFunctions} +\usage{ +getExportedFunctions(path) +} +\arguments{ +\item{path}{(\link[base]{character})\cr +Path to package} +} +\value{ +(\link[base]{c}) +Vector of \link[base]{character} exported functions. +} +\description{ +Gets all the exported functions of a package, from NAMESPACE. +} diff --git a/man/getFunCall.Rd b/man/getFunCall.Rd new file mode 100644 index 0000000..f59986b --- /dev/null +++ b/man/getFunCall.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callInvestigators.R +\name{getFunCall} +\alias{getFunCall} +\title{getFunCall} +\usage{ +getFunCall(fun, defFuns) +} +\arguments{ +\item{fun}{(\link[PaRe]{Function})\cr +Function object.} + +\item{defFuns}{(\link[base]{data.frame})\cr +See \link[PaRe]{getDefinedFunctions}.} +} +\value{ +(\link[base]{data.frame}) +} +\description{ +getFunCall +} diff --git a/man/getFunctionDiagram.Rd b/man/getFunctionDiagram.Rd new file mode 100644 index 0000000..a25c6f4 --- /dev/null +++ b/man/getFunctionDiagram.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getFunctionDiagram.R +\name{getFunctionDiagram} +\alias{getFunctionDiagram} +\title{subsetGraph} +\usage{ +getFunctionDiagram(repo, functionName) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository}) +Repository object.} + +\item{functionName}{(\link[base]{character}) +Name of the function to get all paths from.} +} +\value{ +(\code{htmlwidgets})\cr +Subsetted diagram. See \link[DiagrammeR]{grViz} +} +\description{ +Create a subset of the package diagram containing all in comming and out +going paths from a specified function. +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + # Run getFunctionDiagram on the Repository object. + getFunctionDiagram(repo = repo, functionName = "glue") +} +} diff --git a/man/getFunctionUse.Rd b/man/getFunctionUse.Rd new file mode 100644 index 0000000..d871e7a --- /dev/null +++ b/man/getFunctionUse.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getFunctionUse.R +\name{getFunctionUse} +\alias{getFunctionUse} +\title{summariseFunctionUse} +\usage{ +getFunctionUse(repo, verbose = FALSE) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository})\cr +Repository object.} + +\item{verbose}{(\link[base]{logical}: FALSE)\cr +Prints message to console which file is currently being worked on.} +} +\value{ +(\link[dplyr]{tibble})\tabular{ll}{ + column \tab data type \cr + file \tab \link[base]{character} \cr + line \tab \link[base]{numeric} \cr + pkg \tab \link[base]{character} \cr + fun \tab \link[base]{character} \cr +} +} +\description{ +Summarise functions used in R package. +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + # Run getFunctionUse on the Repository object. + getFunctionUse(repo = repo, verbose = TRUE) +} +} diff --git a/man/getFunsPerDefFun.Rd b/man/getFunsPerDefFun.Rd new file mode 100644 index 0000000..fde938e --- /dev/null +++ b/man/getFunsPerDefFun.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pkgDiagram.R +\name{getFunsPerDefFun} +\alias{getFunsPerDefFun} +\title{getFunsPerDefFun} +\usage{ +getFunsPerDefFun(files, defFuns) +} +\arguments{ +\item{files}{(\link[base]{list})\cr +List of \link[PaRe]{File} objects.} + +\item{defFuns}{(\link[base]{data.frame})\cr +See \link[PaRe]{getDefinedFunctions}.} +} +\value{ +\link[base]{data.frame}\tabular{ll}{ + column \tab data type \cr + from \tab \link[base]{character} \cr + to \tab \link[base]{character} \cr +} +} +\description{ +getFunsPerDefFun +} diff --git a/man/getGraphData.Rd b/man/getGraphData.Rd new file mode 100644 index 0000000..d9256f2 --- /dev/null +++ b/man/getGraphData.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getGraphData.R +\name{getGraphData} +\alias{getGraphData} +\title{getGraphData} +\usage{ +getGraphData(repo, packageTypes = c("Imports")) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository})\cr +Repository object.} + +\item{packageTypes}{(\link[base]{c}: \code{c("Imports")}) of (\link[base]{character}) +Any of the following options may be included in a vector: \itemize{ +\item "imports" +\item "depends" +\item "suggests" +\item "enhances" +\item "linkingto" +}} +} +\value{ +(\link[tidygraph]{as_tbl_graph}) +} +\description{ +Get the dependency interactions as a graph representation. +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + # Run getGraphData on the Repository object. + if (interactive()) { + getGraphData(repo = repo, packageTypes = c("Imports")) + } +} +} diff --git a/man/getMultiLineFun.Rd b/man/getMultiLineFun.Rd new file mode 100644 index 0000000..9457ba9 --- /dev/null +++ b/man/getMultiLineFun.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callInvestigators.R +\name{getMultiLineFun} +\alias{getMultiLineFun} +\title{getMultiLineFun} +\usage{ +getMultiLineFun(line, lines) +} +\arguments{ +\item{line}{(\link[base]{numeric})\cr +Current line number.} + +\item{lines}{(\link[base]{c})\cr +Vector of (\link[base]{character}) lines.} +} +\value{ +(\link[base]{character}) +} +\description{ +getMultiLineFun +} diff --git a/man/getVersionDf.Rd b/man/getVersionDf.Rd new file mode 100644 index 0000000..c5bd707 --- /dev/null +++ b/man/getVersionDf.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/checkDependencies.R +\name{getVersionDf} +\alias{getVersionDf} +\title{getVersionDf} +\usage{ +getVersionDf(dependencies, permittedPackages) +} +\arguments{ +\item{dependencies}{(\link[base]{data.frame})\tabular{ll}{ + column \tab data type \cr + package \tab \link[base]{character} \cr + version \tab \link[base]{character} \cr +}} + +\item{permittedPackages}{(\link[base]{data.frame})\tabular{ll}{ + column \tab data type \cr + package \tab \link[base]{character} \cr + version \tab \link[base]{character} \cr +}} +} +\value{ +(\link[base]{data.frame})\tabular{ll}{ + column \tab data type \cr + package \tab \link[base]{character} \cr + version \tab \link[base]{character} \cr +} +} +\description{ +Function to compare different versions. +} diff --git a/man/graphToDot.Rd b/man/graphToDot.Rd new file mode 100644 index 0000000..6d6a167 --- /dev/null +++ b/man/graphToDot.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getFunctionDiagram.R +\name{graphToDot} +\alias{graphToDot} +\title{graphToDot} +\usage{ +graphToDot(graph) +} +\arguments{ +\item{graph}{(\link[igraph]{graph})} +} +\value{ +\code{htmlwidgets}\cr +See \link[DiagrammeR]{grViz}. +} +\description{ +graphToDot +} diff --git a/man/lintRepo.Rd b/man/lintRepo.Rd new file mode 100644 index 0000000..433b0cf --- /dev/null +++ b/man/lintRepo.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lint.R +\name{lintRepo} +\alias{lintRepo} +\title{lintRepo} +\usage{ +lintRepo(repo) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository})} +} +\value{ +(\link[base]{data.frame})\tabular{lll}{ + column \tab data type \tab description \cr + filename \tab \link[base]{character} \tab Name of the file \cr + line_number \tab \link[base]{double} \tab Line in which the message was found \cr + column_number \tab \link[base]{double} \tab Column in which the message was found \cr + type \tab \link[base]{character} \tab Type of message \cr + message \tab \link[base]{character} \tab Style, warning, or error message \cr + line \tab \link[base]{character} \tab Line of code in which the message was found \cr + linter \tab \link[base]{character} \tab Linter used \cr +} +} +\description{ +Get all the lintr messages of the \link[PaRe]{Repository} object. +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + # Run lintRepo on the Repository object. + messages <- lintRepo(repo = repo) +} +} diff --git a/man/lintScore.Rd b/man/lintScore.Rd new file mode 100644 index 0000000..e03c439 --- /dev/null +++ b/man/lintScore.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lint.R +\name{lintScore} +\alias{lintScore} +\title{lintScore} +\usage{ +lintScore(repo, messages) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository})\cr +Repository object.} + +\item{messages}{(\link[base]{data.frame})\cr +Data frame containing lintr messages. See \link[PaRe]{lintRepo}.} +} +\value{ +(\link[dplyr]{tibble}) +\describe{ +\item{type}{(\link[base]{character}) Type of message.} +\item{pct}{(\link[base]{double}) Score.} +} +} +\description{ +Function that scores the lintr output as a percentage per message type +(style, warning, error). Lintr messages / lines assessed * 100 +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + messages <- lintRepo(repo = repo) + + # Run lintScore on the Repository object. + lintScore(repo = repo, messages = messages) +} +} diff --git a/man/makeGraph.Rd b/man/makeGraph.Rd new file mode 100644 index 0000000..18f6b4a --- /dev/null +++ b/man/makeGraph.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pkgDiagram.R +\name{makeGraph} +\alias{makeGraph} +\title{makeGraph} +\usage{ +makeGraph(funsPerDefFun, pkgName, expFuns, ...) +} +\arguments{ +\item{funsPerDefFun}{(\link[base]{data.frame})\cr +Functions per defined function data.frame.} + +\item{pkgName}{(\link[base]{character})\cr +Name of package.} + +\item{expFuns}{(\link[base]{data.frame})\cr +Exported functinos data.frame.} + +\item{...}{Optional other parameters for \link[DiagrammeR]{grViz}.} +} +\value{ +(\code{htmlwidget})\cr +Diagram of the package. See \link[DiagrammeR]{grViz}. +} +\description{ +Makes the graph +} diff --git a/man/makeReport.Rd b/man/makeReport.Rd new file mode 100644 index 0000000..2510d20 --- /dev/null +++ b/man/makeReport.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/makeReport.R +\name{makeReport} +\alias{makeReport} +\title{makeReport} +\usage{ +makeReport(repo, outputFile, showCode = FALSE) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository})\cr +Repository object.} + +\item{outputFile}{(\link[base]{character})\cr +Path to html-file.} + +\item{showCode}{(\link[base]{logical}: FALSE)\cr +Logical to show code or not in the report.} +} +\value{ +(\code{NULL}) +} +\description{ +Uses rmarkdown's render function to render a html-report of the given package. +} +\examples{ +\donttest{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/darwin-eu/IncidencePrevalence.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + # Run makeReport on the Repository object. + makeReport(repo = repo, outputFile = tempfile()) +} +} +} diff --git a/man/pipe.Rd b/man/pipe.Rd new file mode 100644 index 0000000..36a5738 --- /dev/null +++ b/man/pipe.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-pipe.R +\name{\%>\%} +\alias{\%>\%} +\title{Pipe operator} +\usage{ +lhs \%>\% rhs +} +\arguments{ +\item{lhs}{A value or the magrittr placeholder.} + +\item{rhs}{A function call using the magrittr semantics.} +} +\value{ +The result of calling \code{rhs(lhs)}. +} +\description{ +See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +} +\keyword{internal} diff --git a/man/pkgDiagram.Rd b/man/pkgDiagram.Rd new file mode 100644 index 0000000..c90255a --- /dev/null +++ b/man/pkgDiagram.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pkgDiagram.R +\name{pkgDiagram} +\alias{pkgDiagram} +\title{pkgDiagram} +\usage{ +pkgDiagram(repo, verbose = FALSE, ...) +} +\arguments{ +\item{repo}{(\link[PaRe]{Repository})\cr +Repository object.} + +\item{verbose}{(\link[base]{logical})\cr +Turn verbose messages on or off.} + +\item{...}{Optional other parameters for \link[DiagrammeR]{grViz}.} +} +\value{ +(\code{htmlwidget})\cr +Diagram \code{htmlwidget} object. See \link[htmlwidgets]{createWidget} +} +\description{ +Creates a diagram of all defined functions in a package. +} +\examples{ +fetchedRepo <- tryCatch( + { + # Set dir to clone repository to. + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + # Clone repo + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + # Create instance of Repository object. + repo <- PaRe::Repository$new(path = pathToRepo) + + # Set fetchedRepo to TRUE if all goes well. + TRUE + }, + error = function(e) { + # Set fetchedRepo to FALSE if an error is encountered. + FALSE + }, + warning = function(w) { + # Set fetchedRepo to FALSE if a warning is encountered. + FALSE + } +) + +if (fetchedRepo) { + # Run pkgDiagram on the Repository object. + pkgDiagram(repo = repo) +} +} diff --git a/man/printMessage.Rd b/man/printMessage.Rd new file mode 100644 index 0000000..ee380a5 --- /dev/null +++ b/man/printMessage.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/checkDependencies.R +\name{printMessage} +\alias{printMessage} +\title{printMessage} +\usage{ +printMessage(notPermitted, versionCheck) +} +\arguments{ +\item{notPermitted}{([base]{data.frame})} + +\item{versionCheck}{([base]{data.frame})} +} +\value{ +(\link[base]{data.frame})\tabular{ll}{ + column \tab data type \cr + package \tab \link[base]{character} \cr + version \tab \link[base]{character} \cr +} +} +\description{ +Prints messages dependening of the nrow of the number of rows of the +notPermitted and versionCheck data.frames +} diff --git a/man/whiteList.Rd b/man/whiteList.Rd new file mode 100644 index 0000000..08cfcba --- /dev/null +++ b/man/whiteList.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PaRe-package.R +\docType{data} +\name{whiteList} +\alias{whiteList} +\title{whiteList} +\format{ +An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 3 rows and 4 columns. +} +\usage{ +whiteList +} +\description{ +data.frame containing links to csv-files which should be used to fetch +white-listed dependencies. +} +\details{ +By default three csv's are listed: +\enumerate{ +\item darwin +\item hades +\item tidyverse +} + +The data.frame is locally fetched under: +\code{system.file(package = "PaRe", "whiteList.csv")} + +Manual insertions into this data.frame can be made, or the data.frame can +be overwritten entirely. + +The data.frame itself has the following structure:\tabular{lll}{ + column \tab data type \tab description \cr + source \tab \link[base]{character} \tab name of the source \cr + link \tab \link[base]{character} \tab link or path to the csv-file \cr + package \tab \link[base]{character} \tab columnname of the package name column in the csv-file being linked to \cr + version \tab \link[base]{character} \tab columnname of the version column in the csv-file being linked to \cr +} + + +The csv-files that are being pointed to should have the following structure: +} +\examples{ +if (interactive()) { + # Dropping tidyverse + whiteList <- whiteList \%>\% + dplyr::filter(source != "tidyverse") + + # getDefaultPermittedPackages will now only use darwin and hades + getDefaultPermittedPackages() +} +} +\keyword{datasets} diff --git a/vignettes/Documentation.Rmd b/vignettes/Documentation.Rmd new file mode 100644 index 0000000..f3b6b2b --- /dev/null +++ b/vignettes/Documentation.Rmd @@ -0,0 +1,290 @@ +--- +title: "Documentation" +author: "Maarten van Kessel" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Documentation} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r knitrOptions, include=FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r localCache, echo=FALSE} +withr::local_envvar( + R_USER_CACHE_DIR = tempfile() +) +``` + +```{r setup} +library(PaRe) +``` + +For the examples in this vignette `glue` will be used as an example. `glue` version *1.6.2.9000* is included in the system files of `PaRe` and is thus accessible even if these examples are ran offline. + +`PaRe` does fetch some online resources through the package `pak`. And by default online stored csv-files in the `PaRe::whiteList` data.frame. If no connection can be made, functions using these methods to reference these online resources will return `NULL`. + +## Whitelist Data Frame +`PaRe` includes a data frame which contains links to csv-files to be used in the `PaRe::checkDependencies` and `PaRe::getDefaultPermittedPackages` functions. + +By default the data frame contains the following information. +```{r whiteList} +PaRe::whiteList +``` + +The data frame contains 4 columns: + +1. *source*: Source name. +2. *link*: Link or path to the csv-file. +3. *package*: Column name in the referenced csv-file that contains the package names. +4. *version*: Column name in the referenced csv-file that contains the package versions. + +If you wish to alter the sources in just your R-session, you can either add, remove, or replace individual rows in the whiteList data frame. +```{r whiteListSession} +sessionWhiteList <- rbind( + whiteList, + list( + source = "dummySession", + link = "some/file.csv", + package = "package", + version = "version" + ) +) + +sessionWhiteList +``` + +If you wish to make more permanent alterations to the `whiteList` data frame, you can edit the whiteList.csv file in the PaRe system files. +```{r setupWhiteList} +fileWhiteList <- rbind( + read.csv( + system.file( + package = "PaRe", + "whiteList.csv" + ) + ), + list( + source = "dummyFile", + link = "some/file.csv", + package = "package", + version = "version" + ) +) + +fileWhiteList +``` + +```{r writeWhiteList, eval=FALSE} +write.csv( + fileWhiteList, + system.file( + package = "PaRe", + "whiteList.csv" + ) +) +``` + +## Dependency Review +Before we start diving into the dependency usage of `glue` we should first establish what our dependency white list even looks like. We can retrieve our full list of whitelisted dependencies buy calling the `getDefaultPermittedPackages` function. + +### getDefaultPermittedPackages +```{r permittedPackages, message=FALSE, warning=FALSE} +PaRe::getDefaultPermittedPackages(base = TRUE) +``` + +`getDefaultPermittedPackages` takes one parameter: + +1. **base** which is set to `TRUE` by default. Packages that listed as *base* packages will be included in the white list. + +### Setting up a Repository object +```{r cloneRepoShow, eval=FALSE} +# Temp dir to clone repo to +tempDir <- tempdir() +pathToRepo <- file.path(tempDir, "glue") + +# Clone IncidencePrevalence to temp dir +git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo +) + +repo <- PaRe::Repository$new(path = pathToRepo) +``` + +```{r cloneRepo, echo=FALSE} +fetchedRepo <- tryCatch( + { + tempDir <- tempdir() + pathToRepo <- file.path(tempDir, "glue") + + git2r::clone( + url = "https://github.com/tidyverse/glue.git", + local_path = pathToRepo + ) + + repo <- PaRe::Repository$new(path = pathToRepo) + TRUE + }, + error = function(e) { + FALSE + }, + warning = function(w) { + FALSE + } +) +``` + +### checkDependencies +Now that we know what is included in the white list, we can make our first step into reviewing `glue`, which is to ensure the (suggested) dependencies `glue` uses are in our white list. +```{r checkDependenciesShow, eval=FALSE} +PaRe::checkDependencies(repo = repo) +``` +``` +→ The following are not permitted: covr, microbenchmark, R.utils, rprintf, testthat +→ Please open an issue here: https://github.com/mvankessel-EMC/DependencyReviewerWhitelists/issues +``` +| package | version | +| -------------- | ------- | +| covr | * | +| microbenchmark | * | +| R.utils| * | +| rprintf| * | +| testthat | 3.0.0 | + +Not all suggested dependencies are approved. The function prints a message and returns a data frame, containing all packages that are not listed in our white list. + +`checkDependecies` takes two parameters: + +1. **pkgPath** which specifies the path to the pacakge. +2. **dependencyType** a vector of character items which specify kinds of imports to look at. + +### getGraphData +glue depends on (suggested) dependencies. These dependencies in turn import other dependencies, and so on. We can investigate how these recursive dependencies depend on one another, by investigating it as a graph. +```{r setupGraphShow, eval=FALSE} +graphData <- PaRe::getGraphData( + repo = repo, + packageTypes = c("imports", "suggests") +) +``` + +```{r setupGraph, echo=FALSE, warning=FALSE, message=FALSE} +if (fetchedRepo) { + graphData <- PaRe::getGraphData( + repo = repo, + packageTypes = c("imports", "suggests") + ) +} +``` + +We can compute several statistics about our dependency graph +```{r graphCharacteristicsShow, eval=FALSE} +data.frame( + countVertices = length(igraph::V(graphData)), + countEdges = length(igraph::E(graphData)), + meanDegree = round(mean(igraph::degree(graphData)), 2), + meanDistance = round(mean(igraph::distances(graphData)), 2) +) +``` +- **countVertices** resembles the amount of recursive dependencies `glue` depends on. +- **countEdges**: are the total amount of imports of all dependencies. +- **meanDegree**: is the average amount of imports per dependency. +- **meanDistance**: is the average amount of dependencies between `glue` and all other recursive dependencies. + +We can then plot the graph. +```{r plotGraphShow, eval=FALSE} +plot(graphData) +``` + +```{r plotGraph, echo=FALSE} +if (fetchedRepo) { + plot(graphData) +} +``` + +## Package wide function use +`PaRe` allows you to get insight in the function usage in a package. + +### summariseFunctionUse +```{r summariseFunctionUseShow, eval=FALSE} +funsUsed <- PaRe::getFunctionUse(repo = repo) +funsUsed +``` + +```{r summariseFunctionUse, echo=FALSE, message=FALSE, warning=FALSE} +if (fetchedRepo) { + funsUsed <- PaRe::getFunctionUse(repo = repo) + funsUsed +} +``` + +### getDefinedFunctions +```{r definedFunctionsShow, eval=FALSE} +defFuns <- PaRe::getDefinedFunctions(repo = repo) +head(defFuns) +``` + +```{r definedFunctions, echo=FALSE} +if (fetchedRepo) { + defFuns <- PaRe::getDefinedFunctions(repo = repo) + head(defFuns) +} +``` +Besides the location of each function being displayed, the number of arguments for each function, and the cyclometic complexity is also included in the result. + +```{r pkgDiagramShow, eval=FALSE} +PaRe::pkgDiagram(repo = repo) %>% + DiagrammeRsvg::export_svg() %>% + charToRaw() %>% + magick::image_read() +``` + +```{r pkgDiagram, echo=FALSE} +if (fetchedRepo) { + PaRe::pkgDiagram(repo = repo) %>% + DiagrammeRsvg::export_svg() %>% + charToRaw() %>% + magick::image_read() +} +``` + +## Lines of code +```{r linesOfCodeShow, eval=FALSE} +PaRe::countPackageLines(repo = repo) +``` + +```{r linesOfCode, echo=FALSE} +if (fetchedRepo) { + PaRe::countPackageLines(repo = repo) +} +``` +`glue` contains 1056 lines of R-code. + +## Linting +```{r lintScoreShow, eval=FALSE} +messages <- PaRe::lintRepo(repo = repo) +PaRe::lintScore(repo = repo, messages = messages) +``` + +```{r lintScore, echo=FALSE} +if (fetchedRepo) { + messages <- PaRe::lintRepo(repo = repo) + PaRe::lintScore(repo = repo, messages = messages) +} +``` + +```{r lintMessagesShow, eval=FALSE} +head(messages) +``` + +```{r lintMessages, echo=FALSE} +if (fetchedRepo) { + head(messages) +} +``` + diff --git a/vignettes/img/glueDiagram.svg b/vignettes/img/glueDiagram.svg new file mode 100644 index 0000000..cd1d934 --- /dev/null +++ b/vignettes/img/glueDiagram.svg @@ -0,0 +1,5647 @@ + + + + diff --git a/vignettes/img/glueGraph.png b/vignettes/img/glueGraph.png new file mode 100644 index 0000000..2c2b119 Binary files /dev/null and b/vignettes/img/glueGraph.png differ