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 JSONDocument <- getAPIDocument()
16 generateArvadosClasses(JSONDocument)
17 generateArvadosAPIClass(JSONDocument)
20 generateArvadosAPIClass <- function(discoveryDocument)
22 classMetaData <- discoveryDocument$schemas
23 functionResources <- discoveryDocument$resources
24 resourceNames <- names(functionResources)
26 arvadosAPIHeader <- generateAPIClassHeader()
27 arvadosAPIFooter <- generateAPIClassFooter()
29 arvadosMethods <- Map(function(resource, resourceName)
31 methodNames <- names(resource$methods)
33 functions <- Map(function(methodMetaData, methodName)
35 methodName <- paste0(resourceName, ".", methodName)
36 createFunction(methodName, methodMetaData, classMetaData)
38 }, resource$methods, methodNames)
40 unlist(unname(functions))
42 }, functionResources, resourceNames)
44 arvadosClass <- c(arvadosAPIHeader, arvadosMethods, arvadosAPIFooter)
46 #TODO: Save to a file or load in memory?
47 fileConn <- file("ArvadosAPI.R", "w")
48 writeLines(unlist(arvadosClass), fileConn)
53 getFunctionName <- function(functionMetaData)
55 stringr::str_replace(functionMetaData$id, "arvados.", "")
58 #TODO: Make sure that arguments that are required always go first.
59 # This is not the case if request$required is false.
60 getFunctionArguments <- function(functionMetaData)
62 request <- functionMetaData$request
63 requestArgument <- NULL
67 requestArgument <- names(request$properties)[1]
69 requestArgument <- paste(names(request$properties)[1], "=", "NULL")
71 argNames <- names(functionMetaData$parameters)
73 args <- sapply(argNames, function(argName)
75 arg <- functionMetaData$parameters[[argName]]
79 if(!is.null(arg$default))
80 return(paste0(argName, " = ", "\"", arg$default, "\""))
82 return(paste(argName, "=", "NULL"))
88 paste0(c(requestArgument, args), collapse = ", ")
91 getFunctionBody <- function(functionMetaData, classMetaData)
93 url <- getRequestURL(functionMetaData)
94 headers <- getRequestHeaders()
95 requestQueryList <- getRequestQueryList(functionMetaData)
96 requestQueryList <- getRequestQueryList(functionMetaData)
97 requestBody <- getRequestBody(functionMetaData)
98 request <- getRequest(functionMetaData)
99 response <- getResponse(functionMetaData)
100 returnObject <- getReturnObject(functionMetaData, classMetaData)
102 body <- c(url, headers, requestQueryList, requestBody, request, response, returnObject)
103 paste0("\t\t\t", body)
106 getRequestBody <- function(functionMetaData)
108 request <- functionMetaData$request
110 if(is.null(request) || !request$required)
111 return("body <- NULL")
113 requestParameterName <- names(request$properties)[1]
114 paste0("body <- ", requestParameterName, "$toJSON()")
117 getRequestHeaders <- function()
119 paste0("headers <- list(Authorization = paste(\"OAuth2\", private$token),",
120 "\"Content-Type\" = \"application/json\")")
123 getReturnObject <- function(functionMetaData, classMetaData)
125 returnClass <- functionMetaData$response[["$ref"]]
126 classArguments <- getReturnClassArguments(returnClass, classMetaData)
128 c(paste0(returnClass, "$new(", classArguments, ")"))
131 getReturnClassArguments <- function(className, classMetaData)
133 classArguments <- unique(names(classMetaData[[className]]$properties))
135 arguments <- sapply(classArguments, function(arg)
137 paste0(arg, " = resource$", arg)
140 paste0(arguments, collapse = ", ")
143 getRequest <- function(functionMetaData)
145 method <- functionMetaData$httpMethod
146 paste0("response <- private$http$exec(\"", method, "\", url, headers, body, queryArgs)")
149 getResponse <- function(functionMetaData)
151 "resource <- private$httpParser$parseJSONResponse(response)"
154 getRequestURL <- function(functionMetaData)
156 endPoint <- functionMetaData$path
157 endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
158 url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
159 paste0("url <- paste0(private$host, endPoint)"))
163 getRequestQueryList <- function(functionMetaData)
165 argNames <- names(functionMetaData$parameters)
167 if(length(argNames) == 0)
168 return("queryArgs <- NULL")
170 queryListContent <- sapply(argNames, function(arg) paste0(arg, " = ", arg))
172 paste0("queryArgs <- list(", paste0(queryListContent, collapse = ', ') , ")")
175 createFunction <- function(functionName, functionMetaData, classMetaData)
177 args <- getFunctionArguments(functionMetaData)
179 body <- getFunctionBody(functionMetaData, classMetaData)
181 functionString <- c(paste0("\t\t", functionName, " = function(", args, ")"),
189 generateAPIClassHeader <- function()
192 "ArvadosAPI <- R6::R6Class(",
198 "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
200 "\t\t\tif(!is.null(hostName))",
201 "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
203 "\t\t\tif(!is.null(authToken))",
204 "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
206 "\t\t\tprivate$rawHost <- Sys.getenv(\"ARVADOS_API_HOST\")",
207 "\t\t\tprivate$host <- paste0(\"https://\", private$rawHost, \"/arvados/v1/\")",
208 "\t\t\tprivate$token <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
209 "\t\t\tprivate$numRetries <- numRetries",
210 "\t\t\tprivate$http <- ArvadosR:::HttpRequest$new()",
211 "\t\t\tprivate$httpParser <- ArvadosR:::HttpParser$new()",
213 "\t\t\tif(private$rawHost == \"\" | private$token == \"\")",
214 "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
215 "\t\t\t\t\t\t \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
216 "\t\t\t\t\t\t \"environment variables.\"))",
220 generateAPIClassFooter <- function()
222 c("\t\tgetHostName = function() private$host,",
223 "\t\tgetToken = function() private$token",
229 "\t\trawHost = NULL,",
232 "\t\thttpParser = NULL,",
233 "\t\tnumRetries = NULL",
236 "\tcloneable = FALSE",
240 generateArvadosClasses <- function(resources)
242 classes <- sapply(resources$schemas, function(classSchema)
244 getArvadosClass(classSchema)
248 unlist(unname(classes))
250 fileConn <- file("ArvadosClasses.R", "w")
251 writeLines(unlist(classes), fileConn)
256 getArvadosClass <- function(classSchema)
258 name <- classSchema$id
259 fields <- unique(names(classSchema$properties))
260 fieldsList <- paste0("c(", paste0("\"", fields, "\"", collapse = ", "), ")")
261 constructorArgs <- paste0(fields, " = NULL", collapse = ", ")
263 classString <- c(paste0(name, " <- R6::R6Class("),
265 paste0("\t\"", name, "\","),
268 paste0("\t\t", fields, " = NULL,"),
270 paste0("\t\tinitialize = function(", constructorArgs, ") {"),
271 paste0("\t\t\tself$", fields, " <- ", fields),
273 paste0("\t\t\tprivate$classFields <- ", fieldsList),
276 "\t\ttoJSON = function() {",
277 "\t\t\tfields <- sapply(private$classFields, function(field)",
279 "\t\t\t\tself[[field]]",
280 "\t\t\t}, USE.NAMES = TRUE)",
282 paste0("\t\t\tjsonlite::toJSON(list(\"", tolower(name), "\" = Filter(Negate(is.null), fields)), auto_unbox = TRUE)"),
287 "\t\tclassFields = NULL",
290 "\tcloneable = FALSE",