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 <- generateMethodsDocumentation(methodResources, resourceNames)
  19     classDoc <- generateAPIClassDocumentation(methodResources, resourceNames)
  20     arvadosAPIHeader <- generateAPIClassHeader()
  21     arvadosProjectMethods <- generateProjectMethods()
  22     arvadosClassMethods <- generateClassContent(methodResources, resourceNames)
  23     arvadosAPIFooter <- generateAPIClassFooter()
  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 generateAPIClassHeader <- 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 generateProjectMethods <- 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 generateClassContent <- 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 generateAPIClassFooter <- 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
 319 generateMethodsDocumentation <- function(methodResources, resourceNames)
 320 {
 321     methodsDoc <- unlist(unname(Map(function(resource, resourceName)
 322     {
 323         methodNames <- names(resource$methods)
 324
 325         methodDoc <- Map(function(methodMetaData, methodName)
 326         {
 327             #NOTE: Index, show and destroy are aliases for the preferred names
 328             # "list", "get" and "delete". Until they are removed from discovery
 329             # document we will filter them here.
 330             if(methodName %in% c("index", "show", "destroy"))
 331                return(NULL)
 332
 333             methodName <- paste0(resourceName, ".", methodName)
 334             getMethodDocumentation(methodName, methodMetaData)
 335
 336         }, resource$methods, methodNames)
 337
 338         unlist(unname(methodDoc))
 339
 340     }, methodResources, resourceNames)))
 341
 342     methodsDoc
 343 }
 344
 345 generateAPIClassDocumentation <- function(methodResources, resourceNames)
 346 {
 347     c("#' Arvados",
 348       "#'",
 349       "#' Arvados class gives users ability to manipulate collections and projects.",
 350       "#'" ,
 351       "#' @section Usage:",
 352       "#' \\preformatted{arv = Arvados$new(authToken = NULL, hostName = NULL, numRetries = 0)}",
 353       "#'",
 354       "#' @section Arguments:",
 355       "#' \\describe{",
 356       "#' \t\\item{authToken}{Authentification token. If not specified ARVADOS_API_TOKEN environment variable will be used.}",
 357       "#' \t\\item{hostName}{Host name. If not specified ARVADOS_API_HOST environment variable will be used.}",
 358       "#' \t\\item{numRetries}{Number which specifies how many times to retry failed service requests.}",
 359       "#' }",
 360       "#'",
 361       "#' @section Methods:",
 362       "#' \\describe{",
 363       getAPIClassMethodList(methodResources, resourceNames),
 364       "#' }",
 365       "#'",
 366       "#' @name Arvados",
 367       "#' @examples",
 368       "#' \\dontrun{",
 369       "#' arv <- Arvados$new(\"your Arvados token\", \"example.arvadosapi.com\")",
 370       "#'",
 371       "#' collection <- arv$collections.get(\"uuid\")",
 372       "#'",
 373       "#' collectionList <- arv$collections.list(list(list(\"name\", \"like\", \"Test%\")))",
 374       "#' collectionList <- listAll(arv$collections.list, list(list(\"name\", \"like\", \"Test%\")))",
 375       "#'",
 376       "#' deletedCollection <- arv$collections.delete(\"uuid\")",
 377       "#'",
 378       "#' updatedCollection <- arv$collections.update(list(name = \"New name\", description = \"New description\"),",
 379       "#'                                             \"uuid\")",
 380       "#'",
 381       "#' createdCollection <- arv$collections.create(list(name = \"Example\",",
 382       "#'                                                  description = \"This is a test collection\"))",
 383       "#' }",
 384       "NULL",
 385       "",
 386       "#' @export")
 387 }
 388
 389 getAPIClassMethodList <- function(methodResources, resourceNames)
 390 {
 391     methodList <- unlist(unname(Map(function(resource, resourceName)
 392     {
 393         methodNames <- names(resource$methods)
 394         paste0(resourceName,
 395                ".",
 396                methodNames[!(methodNames %in% c("index", "show", "destroy"))])
 397
 398     }, methodResources, resourceNames)))
 399
 400     hardcodedMethods <- c("projects.create", "projects.get",
 401                           "projects.list", "projects.update", "projects.delete")
 402     paste0("#' \t\\item{}{\\code{\\link{", sort(c(methodList, hardcodedMethods)), "}}}")
 403 }
 404
 405 getMethodDocumentation <- function(methodName, methodMetaData)
 406 {
 407     name        <- paste("#' @name", methodName)
 408     usage       <- getMethodUsage(methodName, methodMetaData)
 409     description <- paste("#'", methodName, "is a method defined in Arvados class.")
 410     params      <- getMethodDescription(methodMetaData)
 411     returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
 412
 413     c(description,
 414       "#' ",
 415       usage,
 416       params,
 417       returnValue,
 418       name,
 419       "NULL",
 420       "")
 421 }
 422
 423 getMethodUsage <- function(methodName, methodMetaData)
 424 {
 425     lineLengthLimit <- 40
 426     args <- getMethodArguments(methodMetaData)
 427     c(formatArgs(paste0("#' @usage arv$", methodName,
 428                         "("), "#' \t", args, ")", lineLengthLimit))
 429 }
 430
 431 getMethodDescription <- function(methodMetaData)
 432 {
 433     request <- methodMetaData$request
 434     requestDoc <- NULL
 435
 436     if(!is.null(request))
 437     {
 438         requestDoc <- unname(unlist(sapply(request$properties, function(prop)
 439                              {
 440                                  className <- sapply(prop, function(ref) ref)
 441                                  objectName <- paste0(tolower(substr(className, 1, 1)),
 442                                                       substr(className, 2, nchar(className)))
 443                                  paste("#' @param", objectName, className, "object.")
 444                              })))
 445     }
 446
 447     argNames <- names(methodMetaData$parameters)
 448
 449     argsDoc <- unname(unlist(sapply(argNames, function(argName)
 450     {
 451         arg <- methodMetaData$parameters[[argName]]
 452         argDescription <- arg$description
 453         paste("#' @param", argName, argDescription)
 454     })))
 455
 456     c(requestDoc, argsDoc)
 457 }
 458
 459 #NOTE: Utility functions:
 460
 461 # This function is used to split very long lines of code into smaller chunks.
 462 # This is usually the case when we pass a lot of named argumets to a function.
 463 formatArgs <- function(prependAtStart, prependToEachSplit,
 464                        args, appendAtEnd, lineLength)
 465 {
 466     if(length(args) > 1)
 467     {
 468         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 469     }
 470
 471     args[1] <- paste0(prependAtStart, args[1])
 472     args[length(args)] <- paste0(args[length(args)], appendAtEnd)
 473
 474     argsLength <- length(args)
 475     argLines <- list()
 476     index <- 1
 477
 478     while(index <= argsLength)
 479     {
 480         line <- args[index]
 481         index <- index + 1
 482
 483         while(nchar(line) < lineLength && index <= argsLength)
 484         {
 485             line <- paste(line, args[index])
 486             index <- index + 1
 487         }
 488
 489         argLines <- c(argLines, line)
 490     }
 491
 492     argLines <- unlist(argLines)
 493     argLinesLen <- length(argLines)
 494
 495     if(argLinesLen > 1)
 496         argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
 497
 498     argLines
 499 }