/
functionArgument_linting.R
179 lines (145 loc) · 5.27 KB
/
functionArgument_linting.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
#' @title Lint a source file's function arguments
#'
#' @description
#' This function parses an R Script file, grouping function calls and the named
#' arguments passed to those functions. Then, based on a set of rules, it is
#' determined if functions of interest have specific named arguments specified.
#'
#' @param filePath Path to a file, given as a length one character vector.
#' @param dirPath Path to a directory, given as a length one character vector.
#' @param rules A named list where the name of each element is a function name,
#' and the value is a character vector of the named argument to check for. All
#' arguments must be specified for a function to "pass".
#' @param fullPath Logical specifying whether to display absolute paths.
#'
#' @return A \code{\link[tibble]{tibble}} detailing the results of the lint.
#'
#' @section Linting Output:
#' The output of the function argument linter is a tibble with the following
#' columns:
#'
#' \describe{
#' \item{file_path}{path to the source file}
#' \item{line_number}{Line of the source file the function is on}
#' \item{column_number}{Column of the source file the function starts at}
#' \item{function_name}{The name of the function}
#' \item{named_args}{A vector of the named arguments passed to the function}
#' \item{includes_required}{True iff the function specifies all of the named
#' arguments required by the given rules}
#' }
#'
#' @section Limitations:
#' This function is only able to test for named arguments passed to a function.
#' For example, it would report that \code{foo(x = bar, "baz")} has specified
#' the named argument \code{x}, but not that \code{bar} was the value of the
#' argument, or that \code{"baz"} had been passed as an unnamed argument.
#'
#' @name lintFunctionArgs
#' @aliases lintFunctionArgs_file lintFunctionArgs_dir
#'
#' @examples
#' \dontrun{
#' library(MazamaCoreUtils)
#'
#' # Example rule list for checking
#' exRules <- list(
#' "fn_one" = "x",
#' "fn_two" = c("foo", "bar")
#' )
#'
#' # Example of using included timezone argument linter
#' lintFunctionArgs_file(
#' "local_test/timezone_lint_test_script.R",
#' MazamaCoreUtils::timezoneLintRules
#' )
#' }
NULL
#' @rdname lintFunctionArgs
#' @export
lintFunctionArgs_file <- function(
filePath = NULL,
rules = NULL,
fullPath = FALSE
) {
# Validate input ------------------------------------------------------------
stopIfNull(filePath)
stopIfNull(rules)
if ( !is.list(rules) || is.null(names(rules)) ) {
stop("rules must be a named list")
}
if ( !is.character(filePath) || length(filePath) != 1 ) {
stop("filePath must be a length 1 character vector")
}
normFilePath <- normalizePath(filePath)
if ( !utils::file_test("-f", normFilePath) ) {
stop("filePath must point to a file, not a directory")
}
# Parse file ----------------------------------------------------------------
parsedData <-
normFilePath %>%
parse(keep.source = TRUE) %>%
utils::getParseData() %>%
tibble::as_tibble()
# Collect functions and arguments -----------------------------------------
# Given IDs as names, this vector outputs the IDs' parent IDs
lookupParent <-
parsedData %>%
dplyr::select(.data$id, .data$parent) %>%
tibble::deframe()
# Group function arguments by which function they belong to
functionArgs <-
parsedData %>%
dplyr::filter(.data$token == "SYMBOL_SUB") %>%
dplyr::group_by(.data$parent) %>%
dplyr::summarise(named_args = list(.data$text)) %>%
dplyr::rename(id = .data$parent)
# Pair function calls with their arguments
functionCalls <-
parsedData %>%
dplyr::mutate(lookup_pid = lookupParent[as.character(.data$parent)]) %>%
dplyr::filter(.data$token == "SYMBOL_FUNCTION_CALL") %>%
dplyr::select(
line_number = .data$line1,
column_number = .data$col1,
function_name = .data$text,
id = .data$lookup_pid
) %>%
dplyr::left_join(functionArgs, by = "id") %>%
dplyr::select(-.data$id)
# Check function arguments ------------------------------------------------
if ( !fullPath ) fileString <- basename(normFilePath)
results <-
functionCalls %>%
dplyr::filter(.data$function_name %in% names(rules)) %>%
dplyr::mutate(
includes_required = purrr::map2_lgl(
.data$named_args, .data$function_name,
~purrr::has_element(.x, rules[[.y]])
),
file = fileString
) %>%
dplyr::select(.data$file, dplyr::everything())
return(results)
}
#' @rdname lintFunctionArgs
#' @export
lintFunctionArgs_dir <- function(
dirPath = "./R",
rules = NULL,
fullPath = FALSE
) {
# Validate input -------------------------------------------------------------
stopIfNull(rules)
if ( !is.list(rules) || is.null(names(rules)) )
stop("rules must be a named list")
if ( !is.character(dirPath) || length(dirPath) != 1 )
stop("dirPath must be a length 1 character vector")
normDirPath <- normalizePath(dirPath)
if ( !utils::file_test("-d", normDirPath) )
stop("filePath must point to a directory, not a file")
# Lint files -----------------------------------------------------------------
results <- normDirPath %>%
list.files(pattern = "\\.R$", full.names = TRUE, recursive = TRUE) %>%
purrr::map_dfr(lintFunctionArgs_file, rules, fullPath)
return(results)
}