1 #TODO: Some methods do the same thing like collecion.index and collection.list.
2 # Make one implementation of the method and make other reference to it.
4 getAPIDocument <- function(){
5 url <- "https://4xphq.arvadosapi.com/discovery/v1/apis/arvados/v1/rest"
6 serverResponse <- httr::RETRY("GET", url = url)
8 httr::content(serverResponse, as = "parsed", type = "application/json")
12 generateAPI <- function()
14 #TODO: Consider passing discovery document URL as parameter
15 #TODO: Consider passing location where to create new files.
16 JSONDocument <- getAPIDocument()
18 generateArvadosClasses(JSONDocument)
19 generateArvadosAPIClass(JSONDocument)
22 generateArvadosAPIClass <- function(discoveryDocument)
24 classMetaData <- discoveryDocument$schemas
25 functionResources <- discoveryDocument$resources
26 resourceNames <- names(functionResources)
28 doc <- generateMethodsDocumentation(functionResources, resourceNames)
29 arvadosAPIHeader <- generateAPIClassHeader()
30 arvadosClassMethods <- generateClassContent(functionResources,
31 resourceNames, classMetaData)
32 arvadosAPIFooter <- generateAPIClassFooter()
34 arvadosClass <- c(doc, arvadosAPIHeader, arvadosClassMethods, arvadosAPIFooter)
36 #TODO: Save to a file or load in memory?
37 fileConn <- file("./R/Arvados.R", "w")
38 writeLines(unlist(arvadosClass), fileConn)
43 generateClassContent <- function(functionResources, resourceNames, classMetaData)
45 arvadosMethods <- Map(function(resource, resourceName)
47 methodNames <- names(resource$methods)
49 functions <- Map(function(methodMetaData, methodName)
51 methodName <- paste0(resourceName, ".", methodName)
52 createFunction(methodName, methodMetaData, classMetaData)
54 }, resource$methods, methodNames)
56 unlist(unname(functions))
58 }, functionResources, resourceNames)
63 generateMethodsDocumentation <- function(functionResources, resourceNames)
65 arvadosMethods <- unlist(unname(Map(function(resource, resourceName)
67 methodNames <- names(resource$methods)
69 functions <- Map(function(methodMetaData, methodName)
71 methodName <- paste0(resourceName, ".", methodName)
72 getMethodDocumentation(methodName, methodMetaData)
74 }, resource$methods, methodNames)
76 unlist(unname(functions))
78 }, functionResources, resourceNames)))
83 getMethodDocumentation <- function(methodName, methodMetaData)
85 name <- paste("#' @name", methodName)
86 usage <- getMethodUsage(methodName, methodMetaData)
87 description <- paste("#'", methodName, "is a method defined in Arvados class.")
88 params <- getMethodDescription(methodMetaData)
89 returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
101 getMethodUsage <- function(methodName, methodMetaData)
103 args <- getFunctionArguments(methodMetaData)
104 c(formatArgs(paste0("#' @usage arv$", methodName, "("), "#' \t", args, ")", 40))
107 getMethodDescription <- function(methodMetaData)
109 request <- methodMetaData$request
112 if(!is.null(request))
114 requestDoc <- unname(unlist(sapply(request$properties, function(prop)
116 className <- sapply(prop, function(ref) ref)
117 objectName <- paste0(tolower(substr(className, 1, 1)),
118 substr(className, 2, nchar(className)))
119 paste("#' @param", objectName, className, "object.")
123 argNames <- names(methodMetaData$parameters)
125 argsDoc <- unname(unlist(sapply(argNames, function(argName)
127 arg <- methodMetaData$parameters[[argName]]
128 argDescription <- arg$description
129 paste("#' @param", argName, argDescription)
132 c(requestDoc, argsDoc)
135 getFunctionName <- function(functionMetaData)
137 stringr::str_replace(functionMetaData$id, "arvados.", "")
140 #TODO: Make sure that arguments that are required always go first.
141 # This is not the case if request$required is false.
142 getFunctionArguments <- function(functionMetaData)
144 request <- functionMetaData$request
147 if(!is.null(request))
150 requestArgs <- names(request$properties)
152 requestArgs <- paste(names(request$properties), "=", "NULL")
155 argNames <- names(functionMetaData$parameters)
157 args <- sapply(argNames, function(argName)
159 arg <- functionMetaData$parameters[[argName]]
163 if(!is.null(arg$default))
164 return(paste0(argName, " = ", "\"", arg$default, "\""))
166 return(paste(argName, "=", "NULL"))
175 getFunctionBody <- function(functionMetaData, classMetaData)
177 url <- getRequestURL(functionMetaData)
178 headers <- getRequestHeaders()
179 requestQueryList <- getRequestQueryList(functionMetaData)
180 requestBody <- getRequestBody(functionMetaData)
181 request <- getRequest(functionMetaData)
182 response <- getResponse(functionMetaData)
183 errorCheck <- getErrorCheckingCode()
184 returnObject <- getReturnObject(functionMetaData, classMetaData)
185 returnStatement <- getReturnObjectValidationCode()
191 request, response, "",
196 paste0("\t\t\t", body)
199 getReturnObjectValidationCode <- function()
201 c("if(result$isEmpty())",
207 getErrorCheckingCode <- function()
209 c("if(!is.null(resource$errors))", "\tstop(resource$errors)")
212 getRequestBody <- function(functionMetaData)
214 request <- functionMetaData$request
216 if(is.null(request) || !request$required)
217 return("body <- NULL")
219 requestParameterName <- names(request$properties)[1]
220 paste0("body <- ", requestParameterName, "$toJSON()")
223 getRequestHeaders <- function()
225 c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
226 " \"Content-Type\" = \"application/json\")")
229 getReturnObject <- function(functionMetaData, classMetaData)
231 returnClass <- functionMetaData$response[["$ref"]]
232 classArguments <- getReturnClassArguments(returnClass, classMetaData)
234 if(returnClass == "Collection")
235 return(c(formatArgs("result <- Collection$new(", "\t",
236 classArguments, ")", 40),
238 "result$setRESTService(private$REST)"))
240 formatArgs(paste0("result <- ", returnClass, "$new("),
241 "\t", classArguments, ")", 40)
244 getReturnClassArguments <- function(className, classMetaData)
246 classArguments <- unique(names(classMetaData[[className]]$properties))
248 arguments <- sapply(classArguments, function(arg)
250 paste0(arg, " = resource$", arg)
256 getRequest <- function(functionMetaData)
258 method <- functionMetaData$httpMethod
259 c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
260 " queryArgs, private$numRetries)")
263 getResponse <- function(functionMetaData)
265 "resource <- private$REST$httpParser$parseJSONResponse(response)"
268 getRequestURL <- function(functionMetaData)
270 endPoint <- functionMetaData$path
271 endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
272 url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
273 paste0("url <- paste0(private$host, endPoint)"))
277 getRequestQueryList <- function(functionMetaData)
279 args <- names(functionMetaData$parameters)
281 if(length(args) == 0)
282 return("queryArgs <- NULL")
284 args <- sapply(args, function(arg) paste0(arg, " = ", arg))
285 collapsedArgs <- paste0(args, collapse = ", ")
287 if(nchar(collapsedArgs) > 40)
288 return(formatArgs("queryArgs <- list(", "\t", args, ")", 40))
290 return(paste0("queryArgs <- list(", collapsedArgs, ")"))
293 createFunction <- function(functionName, functionMetaData, classMetaData)
295 args <- getFunctionArguments(functionMetaData)
296 body <- getFunctionBody(functionMetaData, classMetaData)
297 funSignature <- getFunSignature(functionName, args)
305 getFunSignature <- function(funName, args)
307 collapsedArgs <- paste0(args, collapse = ", ")
309 if(nchar(collapsedArgs) > 40)
311 return(paste0("\t\t",
312 formatArgs(paste(funName, "= function("),
313 "\t", args, ")", 40)))
317 return(paste0("\t\t", funName, " = function(", collapsedArgs, ")"))
321 generateAPIClassHeader <- function()
324 "Arvados <- R6::R6Class(",
330 "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
332 "\t\t\tif(!is.null(hostName))",
333 "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
335 "\t\t\tif(!is.null(authToken))",
336 "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
338 "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
339 "\t\t\ttoken <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
341 "\t\t\tif(hostName == \"\" | token == \"\")",
342 "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
343 "\t\t\t\t\t\t \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
344 "\t\t\t\t\t\t \"environment variables.\"))",
346 "\t\t\tprivate$token <- token",
347 "\t\t\tprivate$host <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
348 "\t\t\tprivate$numRetries <- numRetries",
349 "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
350 "\t\t\t HttpRequest$new(), HttpParser$new(),",
351 "\t\t\t numRetries)",
356 generateAPIClassFooter <- function()
358 c("\t\tgetHostName = function() private$host,",
359 "\t\tgetToken = function() private$token,",
360 "\t\tsetRESTService = function(newREST) private$REST <- newREST",
368 "\t\tnumRetries = NULL",
371 "\tcloneable = FALSE",
375 generateArvadosClasses <- function(resources)
377 classes <- sapply(resources$schemas, function(classSchema)
379 #NOTE: Collection is implemented manually.
380 if(classSchema$id != "Collection")
381 getArvadosClass(classSchema)
385 unlist(unname(classes))
387 fileConn <- file("./R/ArvadosClasses.R", "w")
388 writeLines(unlist(classes), fileConn)
393 getArvadosClass <- function(classSchema)
395 name <- classSchema$id
396 fields <- unique(names(classSchema$properties))
397 constructorArgs <- paste(fields, "= NULL")
398 documentation <- getClassDocumentation(classSchema, constructorArgs)
400 classString <- c(documentation,
401 paste0(name, " <- R6::R6Class("),
403 paste0("\t\"", name, "\","),
406 paste0("\t\t", fields, " = NULL,"),
408 paste0("\t\t", formatArgs("initialize = function(", "\t\t",
409 constructorArgs, ")", 40)),
411 paste0("\t\t\tself$", fields, " <- ", fields),
413 paste0("\t\t\t", formatArgs("private$classFields <- c(", "\t",
414 paste0("\"", fields, "\""), ")", 40)),
417 "\t\ttoJSON = function() {",
418 "\t\t\tfields <- sapply(private$classFields, function(field)",
420 "\t\t\t\tself[[field]]",
421 "\t\t\t}, USE.NAMES = TRUE)",
423 paste0("\t\t\tjsonlite::toJSON(list(\"", tolower(name), "\" =
424 Filter(Negate(is.null), fields)), auto_unbox = TRUE)"),
427 "\t\tisEmpty = function() {",
428 "\t\t\tfields <- sapply(private$classFields,",
429 "\t\t\t function(field) self[[field]])",
431 paste0("\t\t\tif(any(sapply(fields, function(field) !is.null(field)",
432 " && field != \"\")))"),
440 "\t\tclassFields = NULL",
443 "\tcloneable = FALSE",
448 getClassDocumentation <- function(classSchema, constructorArgs)
450 name <- classSchema$id
451 description <- classSchema$description
452 nameLowercaseFirstLetter <- paste0(tolower(substr(name, 1, 1)),
453 substr(name, 2, nchar(name)))
454 c(paste0("#' ", name),
456 paste0("#' ", description),
458 "#' @section Usage:",
459 formatArgs(paste0("#' \\preformatted{",
460 nameLowercaseFirstLetter, " -> ", name, "$new("),
461 "#' \t", constructorArgs, ")", 50),
465 paste0("#' @section Arguments:"),
467 paste0("#' ", getClassArgumentDescription(classSchema)),
470 paste0("#' @name ", name),
476 getClassArgumentDescription <- function(classSchema)
478 argDoc <- sapply(classSchema$properties, function(arg)
480 paste0("{", arg$description, "}")
483 paste0("\\item{", names(classSchema$properties), "}", argDoc)
486 formatArgs <- function(prependAtStart, prependToEachSplit,
487 args, appendAtEnd, lineLength)
491 args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
494 args[1] <- paste0(prependAtStart, args[1])
495 args[length(args)] <- paste0(args[length(args)], appendAtEnd)
497 argsLength <- length(args)
501 while(index <= argsLength)
506 while(nchar(line) < lineLength && index <= argsLength)
508 line <- paste(line, args[index])
512 argLines <- c(argLines, line)
515 argLines <- unlist(argLines)
516 argLinesLen <- length(argLines)
519 argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])