Add ability to register a plumb block method

[schloerke]

plumber/R/plumb-block.R

Lines 16 to 243 in 5d20700

	plumbBlock <- function(lineNum, file, envir = parent.frame()){
	paths <- NULL
	preempt <- NULL
	filter <- NULL
	serializer <- NULL
	parsers <- NULL
	assets <- NULL
	params <- NULL
	comments <- NULL
	responses <- NULL
	tags <- NULL
	routerModifier <- NULL
	while (lineNum > 0 && (stri_detect_regex(file[lineNum], pattern="^#['\\*]?|^\\s*$") || stri_trim_both(file[lineNum]) == "")){
	line <- file[lineNum]
	# If the line does not start with a plumber tag `#*` or `#'`, continue to next line
	if (!stri_detect_regex(line, pattern="^#['\\*]")) {
	lineNum <- lineNum - 1
	next
	}
	epMat <- stri_match(line, regex="^#['\\*]\\s*@(get|put|post|use|delete|head|options|patch)(\\s+(.*)$)?")
	if (!is.na(epMat[1,2])){
	p <- stri_trim_both(epMat[1,4])
	if (is.na(p) || p == ""){
	stopOnLine(lineNum, line, "No path specified.")
	}
	if (is.null(paths)){
	paths <- list()
	}
	paths[[length(paths)+1]] <- list(verb = enumerateVerbs(epMat[1,2]), path = p)
	}
	filterMat <- stri_match(line, regex="^#['\\*]\\s*@filter(\\s+(.*)$)?")
	if (!is.na(filterMat[1,1])){
	f <- stri_trim_both(filterMat[1,3])
	if (is.na(f) || f == ""){
	stopOnLine(lineNum, line, "No @filter name specified.")
	}
	if (!is.null(filter)){
	# Must have already assigned.
	stopOnLine(lineNum, line, "Multiple @filters specified for one function.")
	}
	filter <- f
	}
	preemptMat <- stri_match(line, regex="^#['\\*]\\s*@preempt(\\s+(.*)\\s*$)?")
	if (!is.na(preemptMat[1,1])){
	p <- stri_trim_both(preemptMat[1,3])
	if (is.na(p) || p == ""){
	stopOnLine(lineNum, line, "No @preempt specified")
	}
	if (!is.null(preempt)){
	# Must have already assigned.
	stopOnLine(lineNum, line, "Multiple @preempts specified for one function.")
	}
	preempt <- p
	}
	assetsMat <- stri_match(line, regex="^#['\\*]\\s*@assets(\\s+(\\S*)(\\s+(\\S+))?\\s*)?$")
	if (!is.na(assetsMat[1,1])){
	dir <- stri_trim_both(assetsMat[1,3])
	if (is.na(dir) || dir == ""){
	stopOnLine(lineNum, line, "No directory specified for @assets")
	}
	prefixPath <- stri_trim_both(assetsMat[1,5])
	if (is.na(prefixPath) || prefixPath == ""){
	prefixPath <- "/public"
	}
	if (!is.null(assets)){
	# Must have already assigned.
	stopOnLine(lineNum, line, "Multiple @assets specified for one entity.")
	}
	assets <- list(dir=dir, path=prefixPath)
	}
	serMat <- stri_match(line, regex="^#['\\*]\\s*@serializer(\\s+([^\\s]+)\\s*(.*)\\s*$)?")
	if (!is.na(serMat[1,1])){
	s <- stri_trim_both(serMat[1,3])
	if (is.na(s) || s == ""){
	stopOnLine(lineNum, line, "No @serializer specified")
	}
	if (!is.null(serializer)){
	# Must have already assigned.
	stopOnLine(lineNum, line, "Multiple @serializers specified for one function.")
	}
	if (!(s %in% registered_serializers())){
	stopOnLine(lineNum, line, paste0("No such @serializer registered: ", s))
	}
	ser <- get_registered_serializer(s)
	if (!is.na(serMat[1, 4]) && serMat[1,4] != ""){
	# We have an arg to pass in to the serializer
	argList <- tryCatch({
	eval(parse(text=serMat[1,4]), envir)
	}, error = function(e) {
	stopOnLine(lineNum, line, e)
	})
	} else {
	argList <- list()
	}
	tryCatch({
	serializer <- do.call(ser, argList)
	}, error = function(e) {
	stopOnLine(lineNum, line, paste0("Error creating serializer: ", s, "\n", e))
	})
	}
	shortSerMat <- stri_match(line, regex="^#['\\*]\\s*@(json|html|jpeg|png|svg)(.*)$")
	if (!is.na(shortSerMat[1,2])) {
	s <- stri_trim_both(shortSerMat[1,2])
	.Deprecated(msg = paste0(
	"Plumber tag `#* @", s, "` is deprecated.\n",
	"Use `#* @serializer ", s, "` instead."
	))
	if (!is.null(serializer)){
	# Must have already assigned.
	stopOnLine(lineNum, line, "Multiple @serializers specified for one function (shorthand serializers like @json count, too).")
	}
	if (!is.na(s) && !(s %in% registered_serializers())){
	stopOnLine(lineNum, line, paste0("No such @serializer registered: ", s))
	}
	shortSerAttr <- trimws(shortSerMat[1,3])
	if(!identical(shortSerAttr, "") && !grepl("^\\(.*\\)$", shortSerAttr)){
	stopOnLine(lineNum, line, paste0("Supplemental arguments to the serializer must be surrounded by parentheses, as in `#' @", s, "(na='null')`"))
	}
	if (shortSerAttr != "") {
	# We have an arg to pass in to the serializer
	argList <- tryCatch({
	eval(parse(text=paste0("list", shortSerAttr)), envir)
	}, error = function(e) {
	stopOnLine(lineNum, line, e)
	})
	} else {
	argList <- list()
	}
	tryCatch({
	serializer <- do.call(get_registered_serializer(s), argList)
	}, error = function(e) {
	stopOnLine(lineNum, line, paste0("Error creating serializer: ", s, "\n", e))
	})
	}
	parsersMat <- stri_match(line, regex="^#['\\*]\\s*@parser(\\s+([^\\s]+)\\s*(.*)\\s*$)?")
	if (!is.na(parsersMat[1,1])){
	parser_alias <- stri_trim_both(parsersMat[1,3])
	if (is.na(parser_alias) || parser_alias == ""){
	stopOnLine(lineNum, line, "No @parser specified")
	}
	if (!parser_alias %in% registered_parsers()){
	stopOnLine(lineNum, line, paste0("No such @parser registered: ", parser_alias))
	}
	if (!is.na(parsersMat[1, 4]) && parsersMat[1,4] != ""){
	# We have an arg to pass in to the parser
	arg_list <- tryCatch({
	eval(parse(text=parsersMat[1,4]), envir)
	}, error = function(e) {
	stopOnLine(lineNum, line, e)
	})
	} else {
	arg_list <- list()
	}
	if (is.null(parsers)) {
	parsers <- list()
	}
	parsers[[parser_alias]] <- arg_list
	}
	responseMat <- stri_match(line, regex="^#['\\*]\\s*@response\\s+(\\w+)\\s+(\\S.*)\\s*$")
	if (!is.na(responseMat[1,1])){
	resp <- list()
	resp[[responseMat[1,2]]] <- list(description=responseMat[1,3])
	responses <- c(responses, resp)
	}
	paramMat <- stri_match(line, regex="^#['\\*]\\s*@param(\\s+([^\\s:]+):?([^\\s*]+)?(\\*)?(?:\\s+(.*))?\\s*$)?")
	if (!is.na(paramMat[1,2])){
	name <- paramMat[1,3]
	if (is.na(name)){
	stopOnLine(lineNum, line, "No parameter specified.")
	}
	plumberType <- stri_replace_all(paramMat[1,4], "$1", regex = "^\\[([^\\]]*)\\]$")
	apiType <- plumberToApiType(plumberType)
	isArray <- stri_detect_regex(paramMat[1,4], "^\\[[^\\]]*\\]$")
	isArray[is.na(isArray)] <- defaultIsArray
	required <- identical(paramMat[1,5], "*")
	params[[name]] <- list(desc=paramMat[1,6], type=apiType, required=required, isArray=isArray)
	}
	tagMat <- stri_match(line, regex="^#['\\*]\\s*@tag\\s+(\"[^\"]+\"|'[^']+'|\\S+)\\s*")
	if (!is.na(tagMat[1,1])){
	t <- stri_trim_both(tagMat[1,2], pattern = "[[\\P{Wspace}]-[\"']]")
	if (is.na(t) || t == ""){
	stopOnLine(lineNum, line, "No tag specified.")
	}
	if (t %in% tags){
	stopOnLine(lineNum, line, "Duplicate tag specified.")
	}
	tags <- c(tags, t)
	}
	commentMat <- stri_match(line, regex="^#['\\*]\\s*([^@\\s].*$)")
	if (!is.na(commentMat[1,2])){
	comments <- c(comments, trimws(commentMat[1,2]))
	}
	routerModifierMat <- stri_match(line, regex="^#['\\*]\\s*@plumber")
	if (!is.na(routerModifierMat[1,1])) {
	routerModifier <- TRUE
	}
	lineNum <- lineNum - 1
	}

☝️ has a lot of repetitive behaviors and is closed off to other developers.

It would be great if plumber (and others) could register the functions (similar to parsers and serializers) and allow them to parse a block independently.

Example:

#* @mycustomplumbertag key value value2

Thoughts:

• Only a single line should be attempt at one time. (This is current behavior)
• Once a block parser is a hit, the remaining block parsers should not attempted.
• Don't know what should be supplied or be returned from the block parsers. There is a lot of global state that is currently being altered in the function above. This state should be continued throughout the block's parsing.
• Should we be allowed to overwrite? Maybe a verbose argument? (like the parsers and serializers)
• "block parser" or "plumb block" is a confusing name. Need a better one.