1 getAPIDocument <- function(){
2 url <- "https://4xphq.arvadosapi.com/discovery/v1/apis/arvados/v1/rest"
3 serverResponse <- httr::RETRY("GET", url = url)
5 httr::content(serverResponse, as = "parsed", type = "application/json")
9 generateAPI <- function()
11 #TODO: Consider passing discovery document URL as parameter.
12 #TODO: Consider passing location where to create new files.
13 discoveryDocument <- getAPIDocument()
15 methodResources <- discoveryDocument$resources
16 resourceNames <- names(methodResources)
18 doc <- generateMethodsDocumentation(methodResources, resourceNames)
19 arvadosAPIHeader <- generateAPIClassHeader()
20 arvadosProjectMethods <- generateProjectMethods()
21 arvadosClassMethods <- generateClassContent(methodResources, resourceNames)
22 arvadosAPIFooter <- generateAPIClassFooter()
24 arvadosClass <- c(doc,
26 arvadosProjectMethods,
30 fileConn <- file("./R/Arvados.R", "w")
31 writeLines(unlist(arvadosClass), fileConn)
36 generateAPIClassHeader <- function()
39 "Arvados <- R6::R6Class(",
45 "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
47 "\t\t\tif(!is.null(hostName))",
48 "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
50 "\t\t\tif(!is.null(authToken))",
51 "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
53 "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
54 "\t\t\ttoken <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
56 "\t\t\tif(hostName == \"\" | token == \"\")",
57 "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
58 "\t\t\t\t\t\t \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
59 "\t\t\t\t\t\t \"environment variables.\"))",
61 "\t\t\tprivate$token <- token",
62 "\t\t\tprivate$host <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
63 "\t\t\tprivate$numRetries <- numRetries",
64 "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
65 "\t\t\t HttpRequest$new(), HttpParser$new(),",
71 generateProjectMethods <- function()
73 c("\t\tprojects.get = function(uuid)",
75 "\t\t\tself$groups.get(uuid)",
78 "\t\tprojects.create = function(group, ensure_unique_name = \"false\")",
80 "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
81 "\t\t\tself$groups.create(group, ensure_unique_name)",
84 "\t\tprojects.update = function(group, uuid)",
86 "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
87 "\t\t\tself$groups.update(group, uuid)",
90 "\t\tprojects.list = function(filters = NULL, where = NULL,",
91 "\t\t\torder = NULL, select = NULL, distinct = NULL,",
92 "\t\t\tlimit = \"100\", offset = \"0\", count = \"exact\",",
93 "\t\t\tinclude_trash = NULL)",
95 "\t\t\tfilters[[length(filters) + 1]] <- list(\"group_class\", \"=\", \"project\")",
96 "\t\t\tself$groups.list(filters, where, order, select, distinct,",
97 "\t\t\t limit, offset, count, include_trash)",
100 "\t\tprojects.delete = function(uuid)",
102 "\t\t\tself$groups.delete(uuid)",
107 generateClassContent <- function(methodResources, resourceNames)
109 arvadosMethods <- Map(function(resource, resourceName)
111 methodNames <- names(resource$methods)
113 functions <- Map(function(methodMetaData, methodName)
115 #NOTE: Index, show and destroy are aliases for the preferred names
116 # "list", "get" and "delete". Until they are removed from discovery
117 # document we will filter them here.
118 if(methodName %in% c("index", "show", "destroy"))
121 methodName <- paste0(resourceName, ".", methodName)
122 createMethod(methodName, methodMetaData)
124 }, resource$methods, methodNames)
126 unlist(unname(functions))
128 }, methodResources, resourceNames)
133 generateAPIClassFooter <- function()
135 c("\t\tgetHostName = function() private$host,",
136 "\t\tgetToken = function() private$token,",
137 "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
138 "\t\tgetRESTService = function() private$REST",
146 "\t\tnumRetries = NULL",
149 "\tcloneable = FALSE",
153 createMethod <- function(name, methodMetaData)
155 args <- getMethodArguments(methodMetaData)
156 signature <- getMethodSignature(name, args)
157 body <- getMethodBody(methodMetaData)
165 getMethodArguments <- function(methodMetaData)
167 request <- methodMetaData$request
170 if(!is.null(request))
172 resourceName <- tolower(request$properties[[1]][[1]])
175 requestArgs <- resourceName
177 requestArgs <- paste(resourceName, "=", "NULL")
180 argNames <- names(methodMetaData$parameters)
182 args <- sapply(argNames, function(argName)
184 arg <- methodMetaData$parameters[[argName]]
188 if(!is.null(arg$default))
189 return(paste0(argName, " = ", "\"", arg$default, "\""))
191 return(paste(argName, "=", "NULL"))
200 getMethodSignature <- function(methodName, args)
202 collapsedArgs <- paste0(args, collapse = ", ")
203 lineLengthLimit <- 40
205 if(nchar(collapsedArgs) > lineLengthLimit)
207 return(paste0("\t\t",
208 formatArgs(paste(methodName, "= function("),
209 "\t", args, ")", lineLengthLimit)))
213 return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
217 getMethodBody <- function(methodMetaData)
219 url <- getRequestURL(methodMetaData)
220 headers <- getRequestHeaders()
221 requestQueryList <- getRequestQueryList(methodMetaData)
222 requestBody <- getRequestBody(methodMetaData)
223 request <- getRequest(methodMetaData)
224 response <- getResponse(methodMetaData)
225 errorCheck <- getErrorCheckingCode()
226 returnStatement <- getReturnObject()
230 requestQueryList, "",
232 request, response, "",
236 paste0("\t\t\t", body)
239 getRequestURL <- function(methodMetaData)
241 endPoint <- methodMetaData$path
242 endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
243 url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
244 paste0("url <- paste0(private$host, endPoint)"))
248 getRequestHeaders <- function()
250 c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
251 " \"Content-Type\" = \"application/json\")")
254 getRequestQueryList <- function(methodMetaData)
256 queryArgs <- names(Filter(function(arg) arg$location == "query",
257 methodMetaData$parameters))
259 if(length(queryArgs) == 0)
260 return("queryArgs <- NULL")
262 queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
263 collapsedArgs <- paste0(queryArgs, collapse = ", ")
265 lineLengthLimit <- 40
267 if(nchar(collapsedArgs) > lineLengthLimit)
268 return(formatArgs("queryArgs <- list(", "\t\t\t\t ", queryArgs, ")",
271 return(paste0("queryArgs <- list(", collapsedArgs, ")"))
274 getRequestBody <- function(methodMetaData)
276 request <- methodMetaData$request
278 if(is.null(request) || !request$required)
279 return("body <- NULL")
281 resourceName <- tolower(request$properties[[1]][[1]])
283 requestParameterName <- names(request$properties)[1]
285 c(paste0("if(length(", resourceName, ") > 0)"),
286 paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
287 "\t auto_unbox = TRUE)",
292 getRequest <- function(methodMetaData)
294 method <- methodMetaData$httpMethod
295 c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
296 " queryArgs, private$numRetries)")
299 getResponse <- function(methodMetaData)
301 "resource <- private$REST$httpParser$parseJSONResponse(response)"
304 getErrorCheckingCode <- function()
306 c("if(!is.null(resource$errors))",
307 "\tstop(resource$errors)")
310 getReturnObject <- function()
315 #NOTE: Arvados class documentation:
317 generateMethodsDocumentation <- function(methodResources, resourceNames)
319 methodsDoc <- unlist(unname(Map(function(resource, resourceName)
321 methodNames <- names(resource$methods)
323 methodDoc <- Map(function(methodMetaData, methodName)
325 #NOTE: Index, show and destroy are aliases for the preferred names
326 # "list", "get" and "delete". Until they are removed from discovery
327 # document we will filter them here.
328 if(methodName %in% c("index", "show", "destroy"))
331 methodName <- paste0(resourceName, ".", methodName)
332 getMethodDocumentation(methodName, methodMetaData)
334 }, resource$methods, methodNames)
336 unlist(unname(methodDoc))
338 }, methodResources, resourceNames)))
343 getMethodDocumentation <- function(methodName, methodMetaData)
345 name <- paste("#' @name", methodName)
346 usage <- getMethodUsage(methodName, methodMetaData)
347 description <- paste("#'", methodName, "is a method defined in Arvados class.")
348 params <- getMethodDescription(methodMetaData)
349 returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
361 getMethodUsage <- function(methodName, methodMetaData)
363 lineLengthLimit <- 40
364 args <- getMethodArguments(methodMetaData)
365 c(formatArgs(paste0("#' @usage arv$", methodName,
366 "("), "#' \t", args, ")", lineLengthLimit))
369 getMethodDescription <- function(methodMetaData)
371 request <- methodMetaData$request
374 if(!is.null(request))
376 requestDoc <- unname(unlist(sapply(request$properties, function(prop)
378 className <- sapply(prop, function(ref) ref)
379 objectName <- paste0(tolower(substr(className, 1, 1)),
380 substr(className, 2, nchar(className)))
381 paste("#' @param", objectName, className, "object.")
385 argNames <- names(methodMetaData$parameters)
387 argsDoc <- unname(unlist(sapply(argNames, function(argName)
389 arg <- methodMetaData$parameters[[argName]]
390 argDescription <- arg$description
391 paste("#' @param", argName, argDescription)
394 c(requestDoc, argsDoc)
397 #NOTE: Utility functions:
399 # This function is used to split very long lines of code into smaller chunks.
400 # This is usually the case when we pass a lot of named argumets to a function.
401 formatArgs <- function(prependAtStart, prependToEachSplit,
402 args, appendAtEnd, lineLength)
406 args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
409 args[1] <- paste0(prependAtStart, args[1])
410 args[length(args)] <- paste0(args[length(args)], appendAtEnd)
412 argsLength <- length(args)
416 while(index <= argsLength)
421 while(nchar(line) < lineLength && index <= argsLength)
423 line <- paste(line, args[index])
427 argLines <- c(argLines, line)
430 argLines <- unlist(argLines)
431 argLinesLen <- length(argLines)
434 argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])