sdk/R/R/autoGenAPI.R

   1 getAPIDocument <- function(){
   2     url <- "https://4xphq.arvadosapi.com/discovery/v1/apis/arvados/v1/rest"
   3     serverResponse <- httr::RETRY("GET", url = url)
   4
   5     httr::content(serverResponse, as = "parsed", type = "application/json")
   6 }
   7
   8 #' @export
   9 generateAPI <- function()
  10 {
  11     #TODO: Consider passing discovery document URL as parameter.
  12     #TODO: Consider passing location where to create new files.
  13     discoveryDocument <- getAPIDocument()
  14
  15     methodResources <- discoveryDocument$resources
  16     resourceNames   <- names(methodResources)
  17
  18     doc <- generateMethodsDocumentation(methodResources, resourceNames)
  19     arvadosAPIHeader <- generateAPIClassHeader()
  20     arvadosProjectMethods <- generateProjectMethods()
  21     arvadosClassMethods <- generateClassContent(methodResources, resourceNames)
  22     arvadosAPIFooter <- generateAPIClassFooter()
  23
  24     arvadosClass <- c(doc,
  25                       arvadosAPIHeader,
  26                       arvadosProjectMethods,
  27                       arvadosClassMethods,
  28                       arvadosAPIFooter)
  29
  30     fileConn <- file("./R/Arvados.R", "w")
  31     writeLines(unlist(arvadosClass), fileConn)
  32     close(fileConn)
  33     NULL
  34 }
  35
  36 generateAPIClassHeader <- function()
  37 {
  38     c("#' @export",
  39       "Arvados <- R6::R6Class(",
  40       "",
  41       "\t\"Arvados\",",
  42       "",
  43       "\tpublic = list(",
  44       "",
  45       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
  46       "\t\t{",
  47       "\t\t\tif(!is.null(hostName))",
  48       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
  49       "",
  50       "\t\t\tif(!is.null(authToken))",
  51       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
  52       "",
  53       "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
  54       "\t\t\ttoken    <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
  55       "",
  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.\"))",
  60       "",
  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(),",
  66       "\t\t\t                                numRetries)",
  67       "",
  68       "\t\t},\n")
  69 }
  70
  71 generateProjectMethods <- function()
  72 {
  73     c("\t\tproject.get = function(uuid)",
  74       "\t\t{",
  75       "\t\t\tself$groups.get(uuid)",
  76       "\t\t},",
  77       "",
  78       "\t\tproject.create = function(group, ensure_unique_name = \"false\")",
  79       "\t\t{",
  80       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
  81       "\t\t\tself$groups.create(group, ensure_unique_name)",
  82       "\t\t},",
  83       "",
  84       "\t\tproject.update = function(group, uuid)",
  85       "\t\t{",
  86       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
  87       "\t\t\tself$groups.update(group, uuid)",
  88       "\t\t},",
  89       "",
  90       "\t\tproject.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)",
  94       "\t\t{",
  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)",
  98       "\t\t},",
  99       "",
 100       "\t\tproject.delete = function(uuid)",
 101       "\t\t{",
 102       "\t\t\tself$groups.delete(uuid)",
 103       "\t\t},",
 104       "")
 105 }
 106
 107 generateClassContent <- function(methodResources, resourceNames)
 108 {
 109     arvadosMethods <- Map(function(resource, resourceName)
 110     {
 111         methodNames <- names(resource$methods)
 112
 113         functions <- Map(function(methodMetaData, methodName)
 114         {
 115             methodName <- paste0(resourceName, ".", methodName)
 116             createMethod(methodName, methodMetaData)
 117
 118         }, resource$methods, methodNames)
 119
 120         unlist(unname(functions))
 121
 122     }, methodResources, resourceNames)
 123
 124     arvadosMethods
 125 }
 126
 127 generateAPIClassFooter <- function()
 128 {
 129     c("\t\tgetHostName = function() private$host,",
 130       "\t\tgetToken = function() private$token,",
 131       "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
 132       "\t\tgetRESTService = function() private$REST",
 133       "\t),",
 134       "",
 135       "\tprivate = list(",
 136       "",
 137       "\t\ttoken = NULL,",
 138       "\t\thost = NULL,",
 139       "\t\tREST = NULL,",
 140       "\t\tnumRetries = NULL",
 141       "\t),",
 142       "",
 143       "\tcloneable = FALSE",
 144       ")")
 145 }
 146
 147 createMethod <- function(name, methodMetaData)
 148 {
 149     args      <- getMethodArguments(methodMetaData)
 150     signature <- getMethodSignature(name, args)
 151     body      <- getMethodBody(methodMetaData)
 152
 153     c(signature,
 154       "\t\t{",
 155           body,
 156       "\t\t},\n")
 157 }
 158
 159 getMethodArguments <- function(methodMetaData)
 160 {
 161     request <- methodMetaData$request
 162     requestArgs <- NULL
 163
 164     if(!is.null(request))
 165     {
 166         resourceName <- tolower(request$properties[[1]][[1]])
 167
 168         if(request$required)
 169             requestArgs <- resourceName
 170         else
 171             requestArgs <- paste(resourceName, "=", "NULL")
 172     }
 173
 174     argNames <- names(methodMetaData$parameters)
 175
 176     args <- sapply(argNames, function(argName)
 177     {
 178         arg <- methodMetaData$parameters[[argName]]
 179
 180         if(!arg$required)
 181         {
 182             if(!is.null(arg$default))
 183                 return(paste0(argName, " = ", "\"", arg$default, "\""))
 184             else
 185                 return(paste(argName, "=", "NULL"))
 186         }
 187
 188         argName
 189     })
 190
 191     c(requestArgs, args)
 192 }
 193
 194 getMethodSignature <- function(methodName, args)
 195 {
 196     collapsedArgs <- paste0(args, collapse = ", ")
 197     lineLengthLimit <- 40
 198
 199     if(nchar(collapsedArgs) > lineLengthLimit)
 200     {
 201         return(paste0("\t\t",
 202                       formatArgs(paste(methodName, "= function("),
 203                                  "\t", args, ")", lineLengthLimit)))
 204     }
 205     else
 206     {
 207         return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
 208     }
 209 }
 210
 211 getMethodBody <- function(methodMetaData)
 212 {
 213     url              <- getRequestURL(methodMetaData)
 214     headers          <- getRequestHeaders()
 215     requestQueryList <- getRequestQueryList(methodMetaData)
 216     requestBody      <- getRequestBody(methodMetaData)
 217     request          <- getRequest(methodMetaData)
 218     response         <- getResponse(methodMetaData)
 219     errorCheck       <- getErrorCheckingCode()
 220     returnStatement  <- getReturnObject()
 221
 222     body <- c(url,
 223               headers,
 224               requestQueryList, "",
 225               requestBody, "",
 226               request, response, "",
 227               errorCheck, "",
 228               returnStatement)
 229
 230     paste0("\t\t\t", body)
 231 }
 232
 233 getRequestURL <- function(methodMetaData)
 234 {
 235     endPoint <- methodMetaData$path
 236     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 237     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 238              paste0("url <- paste0(private$host, endPoint)"))
 239     url
 240 }
 241
 242 getRequestHeaders <- function()
 243 {
 244     c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
 245       "                \"Content-Type\" = \"application/json\")")
 246 }
 247
 248 getRequestQueryList <- function(methodMetaData)
 249 {
 250     queryArgs <- names(Filter(function(arg) arg$location == "query",
 251                         methodMetaData$parameters))
 252
 253     if(length(queryArgs) == 0)
 254         return("queryArgs <- NULL")
 255
 256     queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
 257     collapsedArgs <- paste0(queryArgs, collapse = ", ")
 258
 259     lineLengthLimit <- 40
 260
 261     if(nchar(collapsedArgs) > lineLengthLimit)
 262         return(formatArgs("queryArgs <- list(", "\t\t\t\t  ", queryArgs, ")",
 263                           lineLengthLimit))
 264     else
 265         return(paste0("queryArgs <- list(", collapsedArgs, ")"))
 266 }
 267
 268 getRequestBody <- function(methodMetaData)
 269 {
 270     request <- methodMetaData$request
 271
 272     if(is.null(request) || !request$required)
 273         return("body <- NULL")
 274
 275     resourceName <- tolower(request$properties[[1]][[1]])
 276
 277     requestParameterName <- names(request$properties)[1]
 278
 279     c(paste0("if(length(", resourceName, ") > 0)"),
 280       paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
 281              "\t                         auto_unbox = TRUE)",
 282       "else",
 283       "\tbody <- NULL")
 284 }
 285
 286 getRequest <- function(methodMetaData)
 287 {
 288     method <- methodMetaData$httpMethod
 289     c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
 290       "                                   queryArgs, private$numRetries)")
 291 }
 292
 293 getResponse <- function(methodMetaData)
 294 {
 295     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 296 }
 297
 298 getErrorCheckingCode <- function()
 299 {
 300     c("if(!is.null(resource$errors))",
 301       "\tstop(resource$errors)")
 302 }
 303
 304 getReturnObject <- function()
 305 {
 306     "resource"
 307 }
 308
 309 #NOTE: Arvados class documentation:
 310
 311 generateMethodsDocumentation <- function(methodResources, resourceNames)
 312 {
 313     methodsDoc <- unlist(unname(Map(function(resource, resourceName)
 314     {
 315         methodNames <- names(resource$methods)
 316
 317         methodDoc <- Map(function(methodMetaData, methodName)
 318         {
 319             methodName <- paste0(resourceName, ".", methodName)
 320             getMethodDocumentation(methodName, methodMetaData)
 321
 322         }, resource$methods, methodNames)
 323
 324         unlist(unname(methodDoc))
 325
 326     }, methodResources, resourceNames)))
 327
 328     methodsDoc
 329 }
 330
 331 getMethodDocumentation <- function(methodName, methodMetaData)
 332 {
 333     name        <- paste("#' @name", methodName)
 334     usage       <- getMethodUsage(methodName, methodMetaData)
 335     description <- paste("#'", methodName, "is a method defined in Arvados class.")
 336     params      <- getMethodDescription(methodMetaData)
 337     returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
 338
 339     c(description,
 340       "#' ",
 341       usage,
 342       params,
 343       returnValue,
 344       name,
 345       "NULL",
 346       "")
 347 }
 348
 349 getMethodUsage <- function(methodName, methodMetaData)
 350 {
 351     lineLengthLimit <- 40
 352     args <- getMethodArguments(methodMetaData)
 353     c(formatArgs(paste0("#' @usage arv$", methodName,
 354                         "("), "#' \t", args, ")", lineLengthLimit))
 355 }
 356
 357 getMethodDescription <- function(methodMetaData)
 358 {
 359     request <- methodMetaData$request
 360     requestDoc <- NULL
 361
 362     if(!is.null(request))
 363     {
 364         requestDoc <- unname(unlist(sapply(request$properties, function(prop)
 365                              {
 366                                  className <- sapply(prop, function(ref) ref)
 367                                  objectName <- paste0(tolower(substr(className, 1, 1)),
 368                                                       substr(className, 2, nchar(className)))
 369                                  paste("#' @param", objectName, className, "object.")
 370                              })))
 371     }
 372
 373     argNames <- names(methodMetaData$parameters)
 374
 375     argsDoc <- unname(unlist(sapply(argNames, function(argName)
 376     {
 377         arg <- methodMetaData$parameters[[argName]]
 378         argDescription <- arg$description
 379         paste("#' @param", argName, argDescription)
 380     })))
 381
 382     c(requestDoc, argsDoc)
 383 }
 384
 385 #NOTE: Utility functions:
 386
 387 # This function is used to split very long lines of code into smaller chunks.
 388 # This is usually the case when we pass a lot of named argumets to a function.
 389 formatArgs <- function(prependAtStart, prependToEachSplit,
 390                        args, appendAtEnd, lineLength)
 391 {
 392     if(length(args) > 1)
 393     {
 394         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 395     }
 396
 397     args[1] <- paste0(prependAtStart, args[1])
 398     args[length(args)] <- paste0(args[length(args)], appendAtEnd)
 399
 400     argsLength <- length(args)
 401     argLines <- list()
 402     index <- 1
 403
 404     while(index <= argsLength)
 405     {
 406         line <- args[index]
 407         index <- index + 1
 408
 409         while(nchar(line) < lineLength && index <= argsLength)
 410         {
 411             line <- paste(line, args[index])
 412             index <- index + 1
 413         }
 414
 415         argLines <- c(argLines, line)
 416     }
 417
 418     argLines <- unlist(argLines)
 419     argLinesLen <- length(argLines)
 420
 421     if(argLinesLen > 1)
 422         argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
 423
 424     argLines
 425 }