sdk/R/R/autoGenAPI.R

   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.
   3
   4 getAPIDocument <- function(){
   5     url <- "https://4xphq.arvadosapi.com/discovery/v1/apis/arvados/v1/rest"
   6     serverResponse <- httr::RETRY("GET", url = url)
   7
   8     httr::content(serverResponse, as = "parsed", type = "application/json")
   9 }
  10
  11 #' @export
  12 generateAPI <- function()
  13 {
  14     JSONDocument <- getAPIDocument()
  15
  16     generateArvadosClasses(JSONDocument)
  17     generateArvadosAPIClass(JSONDocument)
  18 }
  19
  20 generateArvadosAPIClass <- function(discoveryDocument)
  21 {
  22     classMetaData     <- discoveryDocument$schemas
  23     functionResources <- discoveryDocument$resources
  24     resourceNames     <- names(functionResources)
  25
  26     arvadosAPIHeader <- generateAPIClassHeader()
  27     arvadosAPIFooter <- generateAPIClassFooter()
  28
  29     arvadosMethods <- Map(function(resource, resourceName)
  30     {
  31         methodNames <- names(resource$methods)
  32
  33         functions <- Map(function(methodMetaData, methodName)
  34         {
  35             methodName <- paste0(resourceName, ".", methodName)
  36             createFunction(methodName, methodMetaData, classMetaData)
  37
  38         }, resource$methods, methodNames)
  39
  40         unlist(unname(functions))
  41
  42     }, functionResources, resourceNames)
  43
  44     arvadosClass <- c(arvadosAPIHeader, arvadosMethods, arvadosAPIFooter)
  45
  46     #TODO: Save to a file or load in memory?
  47     fileConn <- file("./R/Arvados.R", "w")
  48     writeLines(unlist(arvadosClass), fileConn)
  49     close(fileConn)
  50     NULL
  51 }
  52
  53 getFunctionName <- function(functionMetaData)
  54 {
  55     stringr::str_replace(functionMetaData$id, "arvados.", "")
  56 }
  57
  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)
  61 {
  62     request <- functionMetaData$request
  63     requestArgument <- NULL
  64
  65     if(!is.null(request))
  66         if(request$required)
  67             requestArgument <- names(request$properties)
  68         else
  69             requestArgument <- paste(names(request$properties), "=", "NULL")
  70
  71     argNames <- names(functionMetaData$parameters)
  72
  73     args <- sapply(argNames, function(argName)
  74     {
  75         arg <- functionMetaData$parameters[[argName]]
  76
  77         if(!arg$required)
  78         {
  79             if(!is.null(arg$default))
  80                 return(paste0(argName, " = ", "\"", arg$default, "\""))
  81             else
  82                 return(paste(argName, "=", "NULL"))
  83         }
  84
  85         argName
  86     })
  87
  88     paste0(c(requestArgument, args))
  89 }
  90
  91 getFunctionBody <- function(functionMetaData, classMetaData)
  92 {
  93     url  <- getRequestURL(functionMetaData)
  94     headers <- getRequestHeaders()
  95     requestQueryList <- getRequestQueryList(functionMetaData)
  96     requestBody <- getRequestBody(functionMetaData)
  97     request <- getRequest(functionMetaData)
  98     response <- getResponse(functionMetaData)
  99     errorCheck <- getErrorCheckingCode()
 100     returnObject <- getReturnObject(functionMetaData, classMetaData)
 101
 102     body <- c(url,
 103               headers,
 104               requestQueryList,
 105               requestBody, "",
 106               request, response, "",
 107               errorCheck, "",
 108               returnObject)
 109
 110     paste0("\t\t\t", body)
 111 }
 112
 113 getErrorCheckingCode <- function()
 114 {
 115     c("if(!is.null(resource$errors))", "\tstop(resource$errors)")
 116 }
 117
 118 getRequestBody <- function(functionMetaData)
 119 {
 120     request <- functionMetaData$request
 121
 122     if(is.null(request) || !request$required)
 123         return("body <- NULL")
 124
 125     requestParameterName <- names(request$properties)[1]
 126     paste0("body <- ", requestParameterName, "$toJSON()")
 127 }
 128
 129 getRequestHeaders <- function()
 130 {
 131     c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
 132       "                \"Content-Type\" = \"application/json\")")
 133 }
 134
 135 getReturnObject <- function(functionMetaData, classMetaData)
 136 {
 137     returnClass <- functionMetaData$response[["$ref"]]
 138     classArguments <- getReturnClassArguments(returnClass, classMetaData)
 139
 140
 141     if(returnClass == "Collection")
 142         return(c("collection <- Collection$new(",
 143                  paste0("\t", splitArgs(classArguments, 40, ")")),
 144                  "",
 145                  "collection$setRESTService(private$REST)",
 146                  "collection"))
 147
 148     c(paste0(returnClass, "$new("),
 149       paste0("\t", splitArgs(classArguments, 40, ")")))
 150 }
 151
 152 getReturnClassArguments <- function(className, classMetaData)
 153 {
 154     classArguments <- unique(names(classMetaData[[className]]$properties))
 155
 156     arguments <- sapply(classArguments, function(arg)
 157     {
 158         paste0(arg, " = resource$", arg)
 159     })
 160
 161     arguments
 162 }
 163
 164 getRequest <- function(functionMetaData)
 165 {
 166     method <- functionMetaData$httpMethod
 167     c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
 168       "                                   queryArgs, private$numRetries)")
 169 }
 170
 171 getResponse <- function(functionMetaData)
 172 {
 173     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 174 }
 175
 176 getRequestURL <- function(functionMetaData)
 177 {
 178     endPoint <- functionMetaData$path
 179     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 180     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 181              paste0("url <- paste0(private$host, endPoint)"))
 182     url
 183 }
 184
 185 getRequestQueryList <- function(functionMetaData)
 186 {
 187     args <- names(functionMetaData$parameters)
 188
 189     if(length(args) == 0)
 190         return("queryArgs <- NULL")
 191
 192     args <- sapply(args, function(arg) paste0(arg, " = ", arg))
 193     collapsedArgs <- paste0(args, collapse = ", ")
 194
 195     if(nchar(collapsedArgs) > 40)
 196     {
 197         formatedArgs <- splitArgs(args, 40, ")")
 198         return(c(paste0("queryArgs <- list("),
 199                  paste0("\t\t", formatedArgs)))
 200     }
 201     else
 202     {
 203         return(paste0("queryArgs <- list(", collapsedArgs, ")"))
 204     }
 205 }
 206
 207 createFunction <- function(functionName, functionMetaData, classMetaData)
 208 {
 209     args <- getFunctionArguments(functionMetaData)
 210     body <- getFunctionBody(functionMetaData, classMetaData)
 211     funSignature <- getFunSignature(functionName, args)
 212
 213     functionString <- c(funSignature,
 214                         "\t\t{",
 215                             body,
 216                         "\t\t},\n")
 217
 218     functionString
 219 }
 220
 221 getFunSignature <- function(funName, args)
 222 {
 223     collapsedArgs <- paste0(args, collapse = ", ")
 224
 225     if(nchar(collapsedArgs) > 40)
 226     {
 227         formatedArgs <- splitArgs(args, 40, ")")
 228         return(c(paste0("\t\t", funName, " = function("),
 229                  paste0("\t\t\t\t", formatedArgs)))
 230     }
 231     else
 232     {
 233         return(paste0("\t\t", funName, " = function(", collapsedArgs, ")"))
 234     }
 235 }
 236
 237 generateAPIClassHeader <- function()
 238 {
 239     c("#' @export",
 240       "Arvados <- R6::R6Class(",
 241       "",
 242       "\t\"Arvados\",",
 243       "",
 244       "\tpublic = list(",
 245       "",
 246       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
 247       "\t\t{",
 248       "\t\t\tif(!is.null(hostName))",
 249       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
 250       "",
 251       "\t\t\tif(!is.null(authToken))",
 252       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
 253       "",
 254       "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
 255       "\t\t\ttoken    <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
 256       "",
 257       "\t\t\tif(hostName == \"\" | token == \"\")",
 258       "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
 259       "\t\t\t\t\t\t   \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
 260       "\t\t\t\t\t\t   \"environment variables.\"))",
 261       "",
 262       "\t\t\tprivate$token <- token",
 263       "\t\t\tprivate$host  <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
 264       "\t\t\tprivate$numRetries <- numRetries",
 265       "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
 266       "\t\t\t                                HttpRequest$new(), HttpParser$new(),",
 267       "\t\t\t                                numRetries)",
 268       "",
 269       "\t\t},\n")
 270 }
 271
 272 generateAPIClassFooter <- function()
 273 {
 274     c("\t\tgetHostName = function() private$host,",
 275       "\t\tgetToken = function() private$token,",
 276       "\t\tsetRESTService = function(newREST) private$REST <- newREST",
 277       "\t),",
 278       "",
 279       "\tprivate = list(",
 280       "",
 281       "\t\ttoken = NULL,",
 282       "\t\thost = NULL,",
 283       "\t\tREST = NULL,",
 284       "\t\tnumRetries = NULL",
 285       "\t),",
 286       "",
 287       "\tcloneable = FALSE",
 288       ")")
 289 }
 290
 291 generateArvadosClasses <- function(resources)
 292 {
 293     classes <- sapply(resources$schemas, function(classSchema)
 294     {
 295         #NOTE: Collection is implemented manually.
 296         if(classSchema$id != "Collection")
 297             getArvadosClass(classSchema)
 298
 299     }, USE.NAMES = TRUE)
 300
 301     unlist(unname(classes))
 302
 303     fileConn <- file("./R/ArvadosClasses.R", "w")
 304     writeLines(unlist(classes), fileConn)
 305     close(fileConn)
 306     NULL
 307 }
 308
 309 getArvadosClass <- function(classSchema)
 310 {
 311     name   <- classSchema$id
 312     fields <- unique(names(classSchema$properties))
 313     #fieldsList <- paste0("c(", paste0("\"", fields, "\"", collapse = ", "), ")")
 314     constructorArgs <- paste(fields, "= NULL")
 315
 316     classString <- c("#' @export",
 317               paste0(name, " <- R6::R6Class("),
 318                      "",
 319               paste0("\t\"", name, "\","),
 320                      "",
 321                      "\tpublic = list(",
 322               paste0("\t\t", fields, " = NULL,"),
 323                      "",
 324                      "\t\tinitialize = function(",
 325                      paste0("\t\t\t\t", splitArgs(constructorArgs, 40, ")")),
 326                      "\t\t{",
 327               paste0("\t\t\tself$", fields, " <- ", fields),
 328                      "\t\t\t",
 329                      "\t\t\tprivate$classFields <- c(",
 330               paste0("\t\t\t\t", splitArgs(fields, 40)),
 331                      "\t\t\t)",
 332                      "\t\t},",
 333                      "",
 334                      "\t\ttoJSON = function() {",
 335                      "\t\t\tfields <- sapply(private$classFields, function(field)",
 336                      "\t\t\t{",
 337                      "\t\t\t\tself[[field]]",
 338                      "\t\t\t}, USE.NAMES = TRUE)",
 339                      "\t\t\t",
 340               paste0("\t\t\tjsonlite::toJSON(list(\"", tolower(name), "\" =
 341                      Filter(Negate(is.null), fields)), auto_unbox = TRUE)"),
 342                      "\t\t}",
 343                      "\t),",
 344                      "",
 345                      "\tprivate = list(",
 346                      "\t\tclassFields = NULL",
 347                      "\t),",
 348                      "",
 349                      "\tcloneable = FALSE",
 350                      ")",
 351                      "")
 352 }
 353
 354 splitArgs <- function(args, lineLength, appendAtEnd = "")
 355 {
 356
 357     if(length(args) > 1)
 358         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 359
 360     args[length(args)] <- paste0(args[length(args)], appendAtEnd)
 361
 362     argsLength <- length(args)
 363     argLines <- list()
 364     index <- 1
 365
 366     while(index <= argsLength)
 367     {
 368         line <- args[index]
 369         index <- index + 1
 370
 371         while(nchar(line) < lineLength && index <= argsLength)
 372         {
 373             line <- paste(line, args[index])
 374             index <- index + 1
 375         }
 376
 377         argLines <- c(argLines, line)
 378     }
 379
 380     unlist(argLines)
 381 }