1#' Blocks
2#'
3#' @description
4#' A `roxy_block` represents a single roxygen2 block.
5#'
6#' The `block_*` functions provide a few helpers for common operations:
7#' * `block_has_tag(blocks, tags)`: does `block` contain any of these `tags`?
8#' * `block_get_tags(block, tags)`: get all instances of `tags`
9#' * `block_get_tag(block, tag)`: get single tag. Returns `NULL` if 0,
10#'    throws warning if more than 1.
11#' * `block_get_tag_value(block, tag)`: gets `val` field from single tag.
12#'
13#' @param tags A list of [roxy_tag]s.
14#' @param file,line Location of the `call` (i.e. the line after the last
15#'   line of the block).
16#' @param call Expression associated with block.
17#' @param object Optionally, the object associated with the block, found
18#'   by inspecting/evaluating `call`.
19#' @param block A `roxy_block` to manipulate.
20#' @param tag,tags Either a single tag name, or a character vector of tag names.
21#' @export
22#' @keywords internal
23#' @examples
24#' # The easiest way to see the structure of a roxy_block is to create one
25#' # using parse_text:
26#' text <- "
27#'   #' This is a title
28#'   #'
29#'   #' @param x,y A number
30#'   #' @export
31#'   f <- function(x, y) x + y
32#' "
33#'
34#' # parse_text() returns a list of blocks, so I extract the first
35#' block <- parse_text(text)[[1]]
36#' block
37roxy_block <- function(tags,
38                       file,
39                       line,
40                       call,
41                       object = NULL) {
42  stopifnot(is.list(tags))
43  stopifnot(is.character(file), length(file) == 1)
44  stopifnot(is.integer(line), length(line) == 1)
45
46  structure(
47    list(
48      tags = tags,
49      file = file,
50      line = line,
51      call = call,
52      object = object
53    ),
54    class = "roxy_block"
55  )
56}
57
58is_roxy_block <- function(x) inherits(x, "roxy_block")
59
60#' @export
61print.roxy_block <- function(x, ...) {
62  call <- deparse(x$call, nlines = 2)
63  if (length(call) == 2) {
64    call <- paste0(call[[1]], " ...")
65  }
66  obj <- format(x$object)
67
68  cat_line("<roxy_block> [", basename(x$file), ":", x$line, "]")
69  cat_line("  $tag")
70  cat_line("    ", map_chr(x$tags, format, file = x$file))
71  cat_line("  $call   ", call)
72  cat_line("  $object ", obj[[1]])
73  cat_line("  ", obj[-1])
74}
75
76block_create <- function(tokens, call, srcref) {
77
78  pkgenv <- roxy_meta_get("env")
79  # This should only happen in our test cases
80  if (is.null(pkgenv)) pkgenv <- baseenv()
81  evalenv <- new.env(parent = pkgenv)
82  roxy_meta_set("evalenv", evalenv)
83  on.exit(roxy_meta_set("evalenv", NULL), add = TRUE)
84
85  tags <- parse_tags(tokens)
86  if (length(tags) == 0) return()
87
88  roxy_block(tags,
89    file = attr(srcref, "srcfile")$filename,
90    line = as.vector(srcref)[[1]],
91    call = call
92  )
93}
94
95block_set_env <- function(block, env) {
96  block <- block_evaluate(block, env)
97  block <- block_find_object(block, env)
98  block
99}
100
101block_evaluate <- function(block, env) {
102
103  tags <- block_get_tags(block, "eval")
104  if (length(tags) == 0) {
105    return(block)
106  }
107
108  # Evaluate
109  results <- lapply(tags, roxy_tag_eval, env = env)
110  results <- lapply(results, function(x) {
111    if (is.null(x)) {
112      character()
113    } else {
114      paste0("#' ", x)
115    }
116  })
117
118  # Tokenise and parse
119  tokens <- lapply(results, tokenise_block,
120    file = block$file,
121    offset = block$line
122  )
123  tags <- lapply(tokens, parse_tags)
124
125  # Interpolate results back into original locations
126  block_replace_tags(block, "eval", tags)
127}
128
129block_find_object <- function(block, env) {
130  stopifnot(is_roxy_block(block))
131
132  object <- object_from_call(
133    call = block$call,
134    env = env,
135    block = block,
136    file = block$file
137  )
138  block$object <- object
139
140  class(block) <- unique(c(
141    paste0("roxy_block_", class(object)),
142    class(block)
143  ))
144
145  # Add in defaults generated from the object
146  defaults <- object_defaults(object)
147  defaults <- c(defaults, list(roxy_tag("backref", block$file, block$file)))
148
149  default_tags <- map_chr(defaults, "tag")
150  defaults <- defaults[!default_tags %in% block_tags(block)]
151
152  block$tags <- c(block$tags, defaults)
153  block
154}
155
156# block accessors ---------------------------------------------------------
157
158block_tags <- function(block) {
159  map_chr(block$tags, "tag")
160}
161
162#' @export
163#' @rdname roxy_block
164block_has_tags <- function(block, tags) {
165  any(block_tags(block) %in% tags)
166}
167
168#' @export
169#' @rdname roxy_block
170block_get_tags <- function(block, tags) {
171  block$tags[block_tags(block) %in% tags]
172}
173
174#' @export
175#' @rdname roxy_block
176block_get_tag <- function(block, tag) {
177  matches <- which(block_tags(block) %in% tag)
178  n <- length(matches)
179  if (n == 0) {
180    NULL
181  } else if (n == 1) {
182    block$tags[[matches]]
183  } else {
184    roxy_tag_warning(block$tags[[matches[[2]]]], "May only use one @", tag, " per block")
185    block$tags[[matches[[1]]]]
186  }
187}
188
189#' @export
190#' @rdname roxy_block
191block_get_tag_value <- function(block, tag) {
192  block_get_tag(block, tag)$val
193}
194
195block_replace_tags <- function(block, tags, values) {
196  indx <- which(block_tags(block) %in% tags)
197  stopifnot(length(indx) == length(values))
198
199  tags <- lapply(block$tags, list)
200  tags[indx] <- values
201
202  block$tags <- compact(unlist(tags, recursive = FALSE))
203  block
204}
205
206# parsing -----------------------------------------------------------------
207
208parse_tags <- function(tokens) {
209  markdown_activate(tokens)
210
211  tokens <- parse_description(tokens)
212  compact(lapply(tokens, roxy_tag_parse))
213}
214
215#' @export
216roxy_tag_parse.roxy_tag_eval <- function(x) {
217  tag_code(x)
218}
219
220#' @export
221roxy_tag_parse.roxy_tag_include <- function(x) {
222  tag_value(x)
223}
224
225parse_description <- function(tags) {
226  if (length(tags) == 0) {
227    return(tags)
228  }
229
230  tag_names <- vapply(tags, `[[`, "tag", FUN.VALUE = character(1))
231  if (tag_names[1] != "") {
232    return(tags)
233  }
234
235  intro <- tags[[1]]
236  intro$val <- str_trim(intro$raw)
237  if (intro$val == "") {
238    return(tags[-1])
239  }
240
241  tags <- tags[-1]
242  tag_names <- tag_names[-1]
243
244  paragraphs <- str_split(intro$val, fixed('\n\n'))[[1]]
245  lines <- str_count(paragraphs, "\n") + rep(2, length(paragraphs))
246  offsets <- c(0, cumsum(lines))
247
248  # 1st paragraph = title (unless has @title)
249  if ("title" %in% tag_names) {
250    title <- NULL
251  } else if (length(paragraphs) > 0) {
252    title <- roxy_tag("title", paragraphs[1], NULL, intro$file, intro$line + offsets[[1]])
253    paragraphs <- paragraphs[-1]
254    offsets <- offsets[-1]
255  } else {
256    title <- roxy_tag("title", "", NULL, intro$file, intro$line)
257  }
258
259  # 2nd paragraph = description (unless has @description)
260  if ("description" %in% tag_names || length(paragraphs) == 0) {
261    description <- NULL
262  } else if (length(paragraphs) > 0) {
263    description <- roxy_tag("description", paragraphs[1], NULL, intro$file, intro$line + offsets[[1]])
264    paragraphs <- paragraphs[-1]
265    offsets <- offsets[-1]
266  }
267
268  # Every thing else = details, combined with @details
269  if (length(paragraphs) > 0) {
270    details_para <- paste(paragraphs, collapse = "\n\n")
271
272    # Find explicit @details tags
273    didx <- which(tag_names == "details")
274    if (length(didx) > 0) {
275      explicit_details <- map_chr(tags[didx], "raw")
276      tags <- tags[-didx]
277      details_para <- paste(c(details_para, explicit_details), collapse = "\n\n")
278    }
279
280    details <- roxy_tag("details", details_para, NULL, intro$file, intro$line + offsets[[1]])
281  } else {
282    details <- NULL
283  }
284
285  c(compact(list(title, description, details)), tags)
286}
287