11# ' Is a directory the project root?
22# '
3- # ' Objects of the \code{ root_criterion} class decide if a
3+ # ' Objects of the ` root_criterion` class decide if a
44# ' given directory is a project root.
55# '
6- # ' Construct criteria using \code{ root_criterion} in a very general fashion
7- # ' by specifying a function with a \code{ path} argument, and a description.
6+ # ' Construct criteria using ` root_criterion` in a very general fashion
7+ # ' by specifying a function with a ` path` argument, and a description.
88# '
9- # ' @param testfun A function with one parameter that returns \code{ TRUE}
9+ # ' @param testfun A function with one parameter that returns ` TRUE`
1010# ' if the directory specified by this parameter is the project root,
11- # ' and \code{FALSE} otherwise
12- # ' @param desc A textual description of the test criterion
11+ # ' and `FALSE` otherwise. Can also be a list of such functions.
12+ # ' @param desc A textual description of the test criterion, of the same length
13+ # ' as `testfun`
1314# ' @param subdir Subdirectories to start the search in, if found
1415# '
1516# ' @return
16- # ' An S3 object of class \code{ root_criterion} wit the following members:
17+ # ' An S3 object of class ` root_criterion` wit the following members:
1718# '
1819# ' @include rrmake.R
1920# ' @export
2021# '
2122# ' @examples
22- # ' root_criterion(function(path) file.exists(file.path(path, "somefile")), "Has somefile")
23+ # ' root_criterion(function(path) file.exists(file.path(path, "somefile")), "has somefile")
2324# ' has_file("DESCRIPTION")
2425# ' is_r_package
2526# ' is_r_package$find_file
2627# ' \dontrun{
2728# ' is_r_package$make_fix_file(".")
2829# ' }
2930root_criterion <- function (testfun , desc , subdir = NULL ) {
30- if ( ! isTRUE(all.equal(names(formals( testfun )), " path " ))) {
31- stop( " testfun must be a function with one argument 'path' " )
32- }
31+ testfun <- check_testfun( testfun )
32+
33+ stopifnot(length( desc ) == length( testfun ))
3334
3435 full_desc <- paste0(
3536 desc ,
3637 if (! is.null(subdir )) paste0(
3738 " (also look in subdirectories: " ,
38- paste0(" ' " , subdir , " ' " , collapse = " , " ),
39+ paste0(" ` " , subdir , " ` " , collapse = " , " ),
3940 " )"
4041 )
4142 )
@@ -44,27 +45,27 @@ root_criterion <- function(testfun, desc, subdir = NULL) {
4445 list (
4546 # ' @return
4647 # ' \describe{
47- # ' \item{\code{ testfun}} {The \code{ testfun} argument}
48+ # ' \item{` testfun`} {The ` testfun` argument}
4849 testfun = testfun ,
49- # ' \item{\code{ desc}} {The \code{ desc} argument}
50+ # ' \item{` desc`} {The ` desc` argument}
5051 desc = full_desc ,
51- # ' \item{\code{ subdir}} {The \code{ subdir} argument}
52+ # ' \item{` subdir`} {The ` subdir` argument}
5253 subdir = subdir
5354 ),
5455 class = " root_criterion"
5556 )
5657
57- # ' \item{\code{ find_file}} {A function with \code{ ...} argument that returns
58+ # ' \item{` find_file`} {A function with ` ...` argument that returns
5859 # ' for a path relative to the root specified by this criterion.
59- # ' The optional \code{ path} argument specifies the starting directory,
60- # ' which defaults to \code{ "."} .
60+ # ' The optional ` path` argument specifies the starting directory,
61+ # ' which defaults to ` "."` .
6162 # ' }
6263 criterion $ find_file <- make_find_root_file(criterion )
63- # ' \item{\code{ make_fix_file}} {A function with a \code{ path} argument that
64+ # ' \item{` make_fix_file`} {A function with a ` path` argument that
6465 # ' returns a function that finds paths relative to the root. For a
65- # ' criterion \code{cr} , the result of \code{ cr$make_fix_file(".")(...)}
66- # ' is identical to \code{ cr$find_file(...)} . The function created by
67- # ' \code{ make_fix_file} can be saved to a variable to be more independent
66+ # ' criterion `cr` , the result of ` cr$make_fix_file(".")(...)`
67+ # ' is identical to ` cr$find_file(...)` . The function created by
68+ # ' ` make_fix_file` can be saved to a variable to be more independent
6869 # ' of the current working directory.
6970 # ' }
7071 # ' }
@@ -74,6 +75,20 @@ root_criterion <- function(testfun, desc, subdir = NULL) {
7475 criterion
7576}
7677
78+ check_testfun <- function (testfun ) {
79+ if (is.function(testfun )) {
80+ testfun <- list (testfun )
81+ }
82+
83+ for (f in testfun ) {
84+ if (! isTRUE(all.equal(names(formals(f )), " path" ))) {
85+ stop(" All functions in testfun must have exactly one argument 'path'" )
86+ }
87+ }
88+
89+ testfun
90+ }
91+
7792# ' @rdname root_criterion
7893# ' @param x An object
7994# ' @export
@@ -86,9 +101,9 @@ is.root_criterion <- function(x) {
86101as.root_criterion <- function (x ) UseMethod(" as.root_criterion" , x )
87102
88103# ' @details
89- # ' The \code{ as.root_criterion} function accepts objects of class
90- # ' \code{ root_criterion} , and character values; the latter will be
91- # ' converted to criteria using \code{ has_file} .
104+ # ' The ` as.root_criterion` function accepts objects of class
105+ # ' ` root_criterion` , and character values; the latter will be
106+ # ' converted to criteria using ` has_file` .
92107# '
93108# ' @rdname root_criterion
94109# ' @export
@@ -107,20 +122,30 @@ as.root_criterion.default <- function(x) {
107122
108123# ' @export
109124format.root_criterion <- function (x , ... ) {
110- paste(" Root criterion:" , x $ desc )
125+ if (length(x $ desc ) > 1 ) {
126+ c(" Root criterion: one of" , paste0(" - " , x $ desc ))
127+ } else {
128+ paste0(" Root criterion: " , x $ desc )
129+ }
111130}
112131
113132# ' @export
114133print.root_criterion <- function (x , ... ) {
115- cat(paste0(format(x ), " \n " ))
134+ cat(format(x ), sep = " \n " )
135+ invisible (x )
116136}
117137
118138# ' @export
139+ # ' @rdname root_criterion
140+ # ' @details Root criteria can be combined with the `|` operator. The result is a
141+ # ' composite root criterion that requires either of the original criteria to
142+ # ' match.
143+ # ' @param y An object
119144`|.root_criterion` <- function (x , y ) {
120145 stopifnot(is.root_criterion(y ))
121146
122147 root_criterion(
123- function ( path ) x $ testfun( path ) || y $ testfun( path ),
124- paste0 (x $ desc , " , or " , y $ desc )
148+ c( x $ testfun , y $ testfun ),
149+ c (x $ desc , y $ desc )
125150 )
126151}
0 commit comments