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     methodDoc <- genMethodsDoc(methodResources, resourceNames)
  19     classDoc <- genAPIClassDoc(methodResources, resourceNames)
  20     arvadosAPIHeader <- genAPIClassHeader()
  21     arvadosProjectMethods <- genProjectMethods()
  22     arvadosClassMethods <- genClassContent(methodResources, resourceNames)
  23     arvadosAPIFooter <- genAPIClassFooter()
  24
  25     arvadosClass <- c(methodDoc,
  26                       classDoc,
  27                       arvadosAPIHeader,
  28                       arvadosProjectMethods,
  29                       arvadosClassMethods,
  30                       arvadosAPIFooter)
  31
  32     fileConn <- file("./R/Arvados.R", "w")
  33     writeLines(unlist(arvadosClass), fileConn)
  34     close(fileConn)
  35     NULL
  36 }
  37
  38 genAPIClassHeader <- function()
  39 {
  40     c("Arvados <- R6::R6Class(",
  41       "",
  42       "\t\"Arvados\",",
  43       "",
  44       "\tpublic = list(",
  45       "",
  46       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
  47       "\t\t{",
  48       "\t\t\tif(!is.null(hostName))",
  49       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
  50       "",
  51       "\t\t\tif(!is.null(authToken))",
  52       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
  53       "",
  54       "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
  55       "\t\t\ttoken    <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
  56       "",
  57       "\t\t\tif(hostName == \"\" | token == \"\")",
  58       "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
  59       "\t\t\t\t\t\t   \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
  60       "\t\t\t\t\t\t   \"environment variables.\"))",
  61       "",
  62       "\t\t\tprivate$token <- token",
  63       "\t\t\tprivate$host  <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
  64       "\t\t\tprivate$numRetries <- numRetries",
  65       "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
  66       "\t\t\t                                HttpRequest$new(), HttpParser$new(),",
  67       "\t\t\t                                numRetries)",
  68       "",
  69       "\t\t},\n")
  70 }
  71
  72 genProjectMethods <- function()
  73 {
  74     c("\t\tprojects.get = function(uuid)",
  75       "\t\t{",
  76       "\t\t\tself$groups.get(uuid)",
  77       "\t\t},",
  78       "",
  79       "\t\tprojects.create = function(group, ensure_unique_name = \"false\")",
  80       "\t\t{",
  81       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
  82       "\t\t\tself$groups.create(group, ensure_unique_name)",
  83       "\t\t},",
  84       "",
  85       "\t\tprojects.update = function(group, uuid)",
  86       "\t\t{",
  87       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
  88       "\t\t\tself$groups.update(group, uuid)",
  89       "\t\t},",
  90       "",
  91       "\t\tprojects.list = function(filters = NULL, where = NULL,",
  92       "\t\t\torder = NULL, select = NULL, distinct = NULL,",
  93       "\t\t\tlimit = \"100\", offset = \"0\", count = \"exact\",",
  94       "\t\t\tinclude_trash = NULL)",
  95       "\t\t{",
  96       "\t\t\tfilters[[length(filters) + 1]] <- list(\"group_class\", \"=\", \"project\")",
  97       "\t\t\tself$groups.list(filters, where, order, select, distinct,",
  98       "\t\t\t                 limit, offset, count, include_trash)",
  99       "\t\t},",
 100       "",
 101       "\t\tprojects.delete = function(uuid)",
 102       "\t\t{",
 103       "\t\t\tself$groups.delete(uuid)",
 104       "\t\t},",
 105       "")
 106 }
 107
 108 genClassContent <- function(methodResources, resourceNames)
 109 {
 110     arvadosMethods <- Map(function(resource, resourceName)
 111     {
 112         methodNames <- names(resource$methods)
 113
 114         functions <- Map(function(methodMetaData, methodName)
 115         {
 116             #NOTE: Index, show and destroy are aliases for the preferred names
 117             # "list", "get" and "delete". Until they are removed from discovery
 118             # document we will filter them here.
 119             if(methodName %in% c("index", "show", "destroy"))
 120                return(NULL)
 121
 122             methodName <- paste0(resourceName, ".", methodName)
 123             createMethod(methodName, methodMetaData)
 124
 125         }, resource$methods, methodNames)
 126
 127         unlist(unname(functions))
 128
 129     }, methodResources, resourceNames)
 130
 131     arvadosMethods
 132 }
 133
 134 genAPIClassFooter <- function()
 135 {
 136     c("\t\tgetHostName = function() private$host,",
 137       "\t\tgetToken = function() private$token,",
 138       "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
 139       "\t\tgetRESTService = function() private$REST",
 140       "\t),",
 141       "",
 142       "\tprivate = list(",
 143       "",
 144       "\t\ttoken = NULL,",
 145       "\t\thost = NULL,",
 146       "\t\tREST = NULL,",
 147       "\t\tnumRetries = NULL",
 148       "\t),",
 149       "",
 150       "\tcloneable = FALSE",
 151       ")")
 152 }
 153
 154 createMethod <- function(name, methodMetaData)
 155 {
 156     args      <- getMethodArguments(methodMetaData)
 157     signature <- getMethodSignature(name, args)
 158     body      <- getMethodBody(methodMetaData)
 159
 160     c(signature,
 161       "\t\t{",
 162           body,
 163       "\t\t},\n")
 164 }
 165
 166 getMethodArguments <- function(methodMetaData)
 167 {
 168     request <- methodMetaData$request
 169     requestArgs <- NULL
 170
 171     if(!is.null(request))
 172     {
 173         resourceName <- tolower(request$properties[[1]][[1]])
 174
 175         if(request$required)
 176             requestArgs <- resourceName
 177         else
 178             requestArgs <- paste(resourceName, "=", "NULL")
 179     }
 180
 181     argNames <- names(methodMetaData$parameters)
 182
 183     args <- sapply(argNames, function(argName)
 184     {
 185         arg <- methodMetaData$parameters[[argName]]
 186
 187         if(!arg$required)
 188         {
 189             if(!is.null(arg$default))
 190                 return(paste0(argName, " = ", "\"", arg$default, "\""))
 191             else
 192                 return(paste(argName, "=", "NULL"))
 193         }
 194
 195         argName
 196     })
 197
 198     c(requestArgs, args)
 199 }
 200
 201 getMethodSignature <- function(methodName, args)
 202 {
 203     collapsedArgs <- paste0(args, collapse = ", ")
 204     lineLengthLimit <- 40
 205
 206     if(nchar(collapsedArgs) > lineLengthLimit)
 207     {
 208         return(paste0("\t\t",
 209                       formatArgs(paste(methodName, "= function("),
 210                                  "\t", args, ")", lineLengthLimit)))
 211     }
 212     else
 213     {
 214         return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
 215     }
 216 }
 217
 218 getMethodBody <- function(methodMetaData)
 219 {
 220     url              <- getRequestURL(methodMetaData)
 221     headers          <- getRequestHeaders()
 222     requestQueryList <- getRequestQueryList(methodMetaData)
 223     requestBody      <- getRequestBody(methodMetaData)
 224     request          <- getRequest(methodMetaData)
 225     response         <- getResponse(methodMetaData)
 226     errorCheck       <- getErrorCheckingCode()
 227     returnStatement  <- getReturnObject()
 228
 229     body <- c(url,
 230               headers,
 231               requestQueryList, "",
 232               requestBody, "",
 233               request, response, "",
 234               errorCheck, "",
 235               returnStatement)
 236
 237     paste0("\t\t\t", body)
 238 }
 239
 240 getRequestURL <- function(methodMetaData)
 241 {
 242     endPoint <- methodMetaData$path
 243     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 244     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 245              paste0("url <- paste0(private$host, endPoint)"))
 246     url
 247 }
 248
 249 getRequestHeaders <- function()
 250 {
 251     c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
 252       "                \"Content-Type\" = \"application/json\")")
 253 }
 254
 255 getRequestQueryList <- function(methodMetaData)
 256 {
 257     queryArgs <- names(Filter(function(arg) arg$location == "query",
 258                         methodMetaData$parameters))
 259
 260     if(length(queryArgs) == 0)
 261         return("queryArgs <- NULL")
 262
 263     queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
 264     collapsedArgs <- paste0(queryArgs, collapse = ", ")
 265
 266     lineLengthLimit <- 40
 267
 268     if(nchar(collapsedArgs) > lineLengthLimit)
 269         return(formatArgs("queryArgs <- list(", "\t\t\t\t  ", queryArgs, ")",
 270                           lineLengthLimit))
 271     else
 272         return(paste0("queryArgs <- list(", collapsedArgs, ")"))
 273 }
 274
 275 getRequestBody <- function(methodMetaData)
 276 {
 277     request <- methodMetaData$request
 278
 279     if(is.null(request) || !request$required)
 280         return("body <- NULL")
 281
 282     resourceName <- tolower(request$properties[[1]][[1]])
 283
 284     requestParameterName <- names(request$properties)[1]
 285
 286     c(paste0("if(length(", resourceName, ") > 0)"),
 287       paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
 288              "\t                         auto_unbox = TRUE)",
 289       "else",
 290       "\tbody <- NULL")
 291 }
 292
 293 getRequest <- function(methodMetaData)
 294 {
 295     method <- methodMetaData$httpMethod
 296     c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
 297       "                                   queryArgs, private$numRetries)")
 298 }
 299
 300 getResponse <- function(methodMetaData)
 301 {
 302     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 303 }
 304
 305 getErrorCheckingCode <- function()
 306 {
 307     c("if(!is.null(resource$errors))",
 308       "\tstop(resource$errors)")
 309 }
 310
 311 getReturnObject <- function()
 312 {
 313     "resource"
 314 }
 315
 316 #NOTE: Arvados class documentation:
 317
 318 genMethodsDoc <- function(methodResources, resourceNames)
 319 {
 320     methodsDoc <- unlist(unname(Map(function(resource, resourceName)
 321     {
 322         methodNames <- names(resource$methods)
 323
 324         methodDoc <- Map(function(methodMetaData, methodName)
 325         {
 326             #NOTE: Index, show and destroy are aliases for the preferred names
 327             # "list", "get" and "delete". Until they are removed from discovery
 328             # document we will filter them here.
 329             if(methodName %in% c("index", "show", "destroy"))
 330                return(NULL)
 331
 332             methodName <- paste0(resourceName, ".", methodName)
 333             getMethodDoc(methodName, methodMetaData)
 334
 335         }, resource$methods, methodNames)
 336
 337         unlist(unname(methodDoc))
 338
 339     }, methodResources, resourceNames)))
 340
 341     projectDoc <- genProjectMethodsDoc()
 342
 343     c(methodsDoc, projectDoc)
 344 }
 345
 346 genAPIClassDoc <- function(methodResources, resourceNames)
 347 {
 348     c("#' Arvados",
 349       "#'",
 350       "#' Arvados class gives users ability to access Arvados REST API.",
 351       "#'" ,
 352       "#' @section Usage:",
 353       "#' \\preformatted{arv = Arvados$new(authToken = NULL, hostName = NULL, numRetries = 0)}",
 354       "#'",
 355       "#' @section Arguments:",
 356       "#' \\describe{",
 357       "#' \t\\item{authToken}{Authentification token. If not specified ARVADOS_API_TOKEN environment variable will be used.}",
 358       "#' \t\\item{hostName}{Host name. If not specified ARVADOS_API_HOST environment variable will be used.}",
 359       "#' \t\\item{numRetries}{Number which specifies how many times to retry failed service requests.}",
 360       "#' }",
 361       "#'",
 362       "#' @section Methods:",
 363       "#' \\describe{",
 364       getAPIClassMethodList(methodResources, resourceNames),
 365       "#' }",
 366       "#'",
 367       "#' @name Arvados",
 368       "#' @examples",
 369       "#' \\dontrun{",
 370       "#' arv <- Arvados$new(\"your Arvados token\", \"example.arvadosapi.com\")",
 371       "#'",
 372       "#' collection <- arv$collections.get(\"uuid\")",
 373       "#'",
 374       "#' collectionList <- arv$collections.list(list(list(\"name\", \"like\", \"Test%\")))",
 375       "#' collectionList <- listAll(arv$collections.list, list(list(\"name\", \"like\", \"Test%\")))",
 376       "#'",
 377       "#' deletedCollection <- arv$collections.delete(\"uuid\")",
 378       "#'",
 379       "#' updatedCollection <- arv$collections.update(list(name = \"New name\", description = \"New description\"),",
 380       "#'                                             \"uuid\")",
 381       "#'",
 382       "#' createdCollection <- arv$collections.create(list(name = \"Example\",",
 383       "#'                                                  description = \"This is a test collection\"))",
 384       "#' }",
 385       "NULL",
 386       "",
 387       "#' @export")
 388 }
 389
 390 getAPIClassMethodList <- function(methodResources, resourceNames)
 391 {
 392     methodList <- unlist(unname(Map(function(resource, resourceName)
 393     {
 394         methodNames <- names(resource$methods)
 395         paste0(resourceName,
 396                ".",
 397                methodNames[!(methodNames %in% c("index", "show", "destroy"))])
 398
 399     }, methodResources, resourceNames)))
 400
 401     hardcodedMethods <- c("projects.create", "projects.get",
 402                           "projects.list", "projects.update", "projects.delete")
 403     paste0("#' \t\\item{}{\\code{\\link{", sort(c(methodList, hardcodedMethods)), "}}}")
 404 }
 405
 406 getMethodDoc <- function(methodName, methodMetaData)
 407 {
 408     name        <- paste("#' @name", methodName)
 409     usage       <- getMethodUsage(methodName, methodMetaData)
 410     description <- paste("#'", methodName, "is a method defined in Arvados class.")
 411     params      <- getMethodDescription(methodMetaData)
 412     returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
 413
 414     c(paste("#'", methodName),
 415       "#' ",
 416       description,
 417       "#' ",
 418       usage,
 419       params,
 420       returnValue,
 421       name,
 422       "NULL",
 423       "")
 424 }
 425
 426 getMethodUsage <- function(methodName, methodMetaData)
 427 {
 428     lineLengthLimit <- 40
 429     args <- getMethodArguments(methodMetaData)
 430     c(formatArgs(paste0("#' @usage arv$", methodName,
 431                         "("), "#' \t", args, ")", lineLengthLimit))
 432 }
 433
 434 getMethodDescription <- function(methodMetaData)
 435 {
 436     request <- methodMetaData$request
 437     requestDoc <- NULL
 438
 439     if(!is.null(request))
 440     {
 441         requestDoc <- unname(unlist(sapply(request$properties, function(prop)
 442                              {
 443                                  className <- sapply(prop, function(ref) ref)
 444                                  objectName <- paste0(tolower(substr(className, 1, 1)),
 445                                                       substr(className, 2, nchar(className)))
 446                                  paste("#' @param", objectName, className, "object.")
 447                              })))
 448     }
 449
 450     argNames <- names(methodMetaData$parameters)
 451
 452     argsDoc <- unname(unlist(sapply(argNames, function(argName)
 453     {
 454         arg <- methodMetaData$parameters[[argName]]
 455         argDescription <- arg$description
 456         paste("#' @param", argName, argDescription)
 457     })))
 458
 459     c(requestDoc, argsDoc)
 460 }
 461
 462 genProjectMethodsDoc <- function()
 463 {
 464     #TODO: Manually update this documentation to reflect changes in discovery document.
 465     c("#' project.get",
 466     "#' ",
 467     "#' projects.get is equivalent to groups.get method.",
 468     "#' ",
 469     "#' @usage arv$projects.get(uuid)",
 470     "#' @param uuid The UUID of the Group in question.",
 471     "#' @return Group object.",
 472     "#' @name projects.get",
 473     "NULL",
 474     "",
 475     "#' project.create",
 476     "#' ",
 477     "#' projects.create wrapps groups.create method by setting group_class attribute to \"project\".",
 478     "#' ",
 479     "#' @usage arv$projects.create(group, ensure_unique_name = \"false\")",
 480     "#' @param group Group object.",
 481     "#' @param ensure_unique_name Adjust name to ensure uniqueness instead of returning an error on (owner_uuid, name) collision.",
 482     "#' @return Group object.",
 483     "#' @name projects.create",
 484     "NULL",
 485     "",
 486     "#' project.update",
 487     "#' ",
 488     "#' projects.update wrapps groups.update method by setting group_class attribute to \"project\".",
 489     "#' ",
 490     "#' @usage arv$projects.update(group, uuid)",
 491     "#' @param group Group object.",
 492     "#' @param uuid The UUID of the Group in question.",
 493     "#' @return Group object.",
 494     "#' @name projects.update",
 495     "NULL",
 496     "",
 497     "#' project.delete",
 498     "#' ",
 499     "#' projects.delete is equivalent to groups.delete method.",
 500     "#' ",
 501     "#' @usage arv$project.delete(uuid)",
 502     "#' @param uuid The UUID of the Group in question.",
 503     "#' @return Group object.",
 504     "#' @name projects.delete",
 505     "NULL",
 506     "",
 507     "#' project.list",
 508     "#' ",
 509     "#' projects.list wrapps groups.list method by setting group_class attribute to \"project\".",
 510     "#' ",
 511     "#' @usage arv$projects.list(filters = NULL,",
 512     "#'         where = NULL, order = NULL, distinct = NULL,",
 513     "#'         limit = \"100\", offset = \"0\", count = \"exact\",",
 514     "#'         include_trash = NULL, uuid = NULL, recursive = NULL)",
 515     "#' @param filters ",
 516     "#' @param where ",
 517     "#' @param order ",
 518     "#' @param distinct ",
 519     "#' @param limit ",
 520     "#' @param offset ",
 521     "#' @param count ",
 522     "#' @param include_trash Include items whose is_trashed attribute is true.",
 523     "#' @param uuid ",
 524     "#' @param recursive Include contents from child groups recursively.",
 525     "#' @return Group object.",
 526     "#' @name projects.list",
 527     "NULL",
 528     "")
 529 }
 530
 531 #NOTE: Utility functions:
 532
 533 # This function is used to split very long lines of code into smaller chunks.
 534 # This is usually the case when we pass a lot of named argumets to a function.
 535 formatArgs <- function(prependAtStart, prependToEachSplit,
 536                        args, appendAtEnd, lineLength)
 537 {
 538     if(length(args) > 1)
 539     {
 540         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 541     }
 542
 543     args[1] <- paste0(prependAtStart, args[1])
 544     args[length(args)] <- paste0(args[length(args)], appendAtEnd)
 545
 546     argsLength <- length(args)
 547     argLines <- list()
 548     index <- 1
 549
 550     while(index <= argsLength)
 551     {
 552         line <- args[index]
 553         index <- index + 1
 554
 555         while(nchar(line) < lineLength && index <= argsLength)
 556         {
 557             line <- paste(line, args[index])
 558             index <- index + 1
 559         }
 560
 561         argLines <- c(argLines, line)
 562     }
 563
 564     argLines <- unlist(argLines)
 565     argLinesLen <- length(argLines)
 566
 567     if(argLinesLen > 1)
 568         argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
 569
 570     argLines
 571 }