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             #NOTE: Index, show and destroy are aliases for the preferred names
 116             # "list", "get" and "delete". Until they are removed from discovery
 117             # document we will filter them here.
 118             if(methodName %in% c("index", "show", "destroy"))
 119                return(NULL)
 120
 121             methodName <- paste0(resourceName, ".", methodName)
 122             createMethod(methodName, methodMetaData)
 123
 124         }, resource$methods, methodNames)
 125
 126         unlist(unname(functions))
 127
 128     }, methodResources, resourceNames)
 129
 130     arvadosMethods
 131 }
 132
 133 generateAPIClassFooter <- function()
 134 {
 135     c("\t\tgetHostName = function() private$host,",
 136       "\t\tgetToken = function() private$token,",
 137       "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
 138       "\t\tgetRESTService = function() private$REST",
 139       "\t),",
 140       "",
 141       "\tprivate = list(",
 142       "",
 143       "\t\ttoken = NULL,",
 144       "\t\thost = NULL,",
 145       "\t\tREST = NULL,",
 146       "\t\tnumRetries = NULL",
 147       "\t),",
 148       "",
 149       "\tcloneable = FALSE",
 150       ")")
 151 }
 152
 153 createMethod <- function(name, methodMetaData)
 154 {
 155     args      <- getMethodArguments(methodMetaData)
 156     signature <- getMethodSignature(name, args)
 157     body      <- getMethodBody(methodMetaData)
 158
 159     c(signature,
 160       "\t\t{",
 161           body,
 162       "\t\t},\n")
 163 }
 164
 165 getMethodArguments <- function(methodMetaData)
 166 {
 167     request <- methodMetaData$request
 168     requestArgs <- NULL
 169
 170     if(!is.null(request))
 171     {
 172         resourceName <- tolower(request$properties[[1]][[1]])
 173
 174         if(request$required)
 175             requestArgs <- resourceName
 176         else
 177             requestArgs <- paste(resourceName, "=", "NULL")
 178     }
 179
 180     argNames <- names(methodMetaData$parameters)
 181
 182     args <- sapply(argNames, function(argName)
 183     {
 184         arg <- methodMetaData$parameters[[argName]]
 185
 186         if(!arg$required)
 187         {
 188             if(!is.null(arg$default))
 189                 return(paste0(argName, " = ", "\"", arg$default, "\""))
 190             else
 191                 return(paste(argName, "=", "NULL"))
 192         }
 193
 194         argName
 195     })
 196
 197     c(requestArgs, args)
 198 }
 199
 200 getMethodSignature <- function(methodName, args)
 201 {
 202     collapsedArgs <- paste0(args, collapse = ", ")
 203     lineLengthLimit <- 40
 204
 205     if(nchar(collapsedArgs) > lineLengthLimit)
 206     {
 207         return(paste0("\t\t",
 208                       formatArgs(paste(methodName, "= function("),
 209                                  "\t", args, ")", lineLengthLimit)))
 210     }
 211     else
 212     {
 213         return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
 214     }
 215 }
 216
 217 getMethodBody <- function(methodMetaData)
 218 {
 219     url              <- getRequestURL(methodMetaData)
 220     headers          <- getRequestHeaders()
 221     requestQueryList <- getRequestQueryList(methodMetaData)
 222     requestBody      <- getRequestBody(methodMetaData)
 223     request          <- getRequest(methodMetaData)
 224     response         <- getResponse(methodMetaData)
 225     errorCheck       <- getErrorCheckingCode()
 226     returnStatement  <- getReturnObject()
 227
 228     body <- c(url,
 229               headers,
 230               requestQueryList, "",
 231               requestBody, "",
 232               request, response, "",
 233               errorCheck, "",
 234               returnStatement)
 235
 236     paste0("\t\t\t", body)
 237 }
 238
 239 getRequestURL <- function(methodMetaData)
 240 {
 241     endPoint <- methodMetaData$path
 242     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 243     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 244              paste0("url <- paste0(private$host, endPoint)"))
 245     url
 246 }
 247
 248 getRequestHeaders <- function()
 249 {
 250     c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
 251       "                \"Content-Type\" = \"application/json\")")
 252 }
 253
 254 getRequestQueryList <- function(methodMetaData)
 255 {
 256     queryArgs <- names(Filter(function(arg) arg$location == "query",
 257                         methodMetaData$parameters))
 258
 259     if(length(queryArgs) == 0)
 260         return("queryArgs <- NULL")
 261
 262     queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
 263     collapsedArgs <- paste0(queryArgs, collapse = ", ")
 264
 265     lineLengthLimit <- 40
 266
 267     if(nchar(collapsedArgs) > lineLengthLimit)
 268         return(formatArgs("queryArgs <- list(", "\t\t\t\t  ", queryArgs, ")",
 269                           lineLengthLimit))
 270     else
 271         return(paste0("queryArgs <- list(", collapsedArgs, ")"))
 272 }
 273
 274 getRequestBody <- function(methodMetaData)
 275 {
 276     request <- methodMetaData$request
 277
 278     if(is.null(request) || !request$required)
 279         return("body <- NULL")
 280
 281     resourceName <- tolower(request$properties[[1]][[1]])
 282
 283     requestParameterName <- names(request$properties)[1]
 284
 285     c(paste0("if(length(", resourceName, ") > 0)"),
 286       paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
 287              "\t                         auto_unbox = TRUE)",
 288       "else",
 289       "\tbody <- NULL")
 290 }
 291
 292 getRequest <- function(methodMetaData)
 293 {
 294     method <- methodMetaData$httpMethod
 295     c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
 296       "                                   queryArgs, private$numRetries)")
 297 }
 298
 299 getResponse <- function(methodMetaData)
 300 {
 301     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 302 }
 303
 304 getErrorCheckingCode <- function()
 305 {
 306     c("if(!is.null(resource$errors))",
 307       "\tstop(resource$errors)")
 308 }
 309
 310 getReturnObject <- function()
 311 {
 312     "resource"
 313 }
 314
 315 #NOTE: Arvados class documentation:
 316
 317 generateMethodsDocumentation <- function(methodResources, resourceNames)
 318 {
 319     methodsDoc <- unlist(unname(Map(function(resource, resourceName)
 320     {
 321         methodNames <- names(resource$methods)
 322
 323         methodDoc <- Map(function(methodMetaData, methodName)
 324         {
 325             #NOTE: Index, show and destroy are aliases for the preferred names
 326             # "list", "get" and "delete". Until they are removed from discovery
 327             # document we will filter them here.
 328             if(methodName %in% c("index", "show", "destroy"))
 329                return(NULL)
 330
 331             methodName <- paste0(resourceName, ".", methodName)
 332             getMethodDocumentation(methodName, methodMetaData)
 333
 334         }, resource$methods, methodNames)
 335
 336         unlist(unname(methodDoc))
 337
 338     }, methodResources, resourceNames)))
 339
 340     methodsDoc
 341 }
 342
 343 getMethodDocumentation <- function(methodName, methodMetaData)
 344 {
 345     name        <- paste("#' @name", methodName)
 346     usage       <- getMethodUsage(methodName, methodMetaData)
 347     description <- paste("#'", methodName, "is a method defined in Arvados class.")
 348     params      <- getMethodDescription(methodMetaData)
 349     returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
 350
 351     c(description,
 352       "#' ",
 353       usage,
 354       params,
 355       returnValue,
 356       name,
 357       "NULL",
 358       "")
 359 }
 360
 361 getMethodUsage <- function(methodName, methodMetaData)
 362 {
 363     lineLengthLimit <- 40
 364     args <- getMethodArguments(methodMetaData)
 365     c(formatArgs(paste0("#' @usage arv$", methodName,
 366                         "("), "#' \t", args, ")", lineLengthLimit))
 367 }
 368
 369 getMethodDescription <- function(methodMetaData)
 370 {
 371     request <- methodMetaData$request
 372     requestDoc <- NULL
 373
 374     if(!is.null(request))
 375     {
 376         requestDoc <- unname(unlist(sapply(request$properties, function(prop)
 377                              {
 378                                  className <- sapply(prop, function(ref) ref)
 379                                  objectName <- paste0(tolower(substr(className, 1, 1)),
 380                                                       substr(className, 2, nchar(className)))
 381                                  paste("#' @param", objectName, className, "object.")
 382                              })))
 383     }
 384
 385     argNames <- names(methodMetaData$parameters)
 386
 387     argsDoc <- unname(unlist(sapply(argNames, function(argName)
 388     {
 389         arg <- methodMetaData$parameters[[argName]]
 390         argDescription <- arg$description
 391         paste("#' @param", argName, argDescription)
 392     })))
 393
 394     c(requestDoc, argsDoc)
 395 }
 396
 397 #NOTE: Utility functions:
 398
 399 # This function is used to split very long lines of code into smaller chunks.
 400 # This is usually the case when we pass a lot of named argumets to a function.
 401 formatArgs <- function(prependAtStart, prependToEachSplit,
 402                        args, appendAtEnd, lineLength)
 403 {
 404     if(length(args) > 1)
 405     {
 406         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 407     }
 408
 409     args[1] <- paste0(prependAtStart, args[1])
 410     args[length(args)] <- paste0(args[length(args)], appendAtEnd)
 411
 412     argsLength <- length(args)
 413     argLines <- list()
 414     index <- 1
 415
 416     while(index <= argsLength)
 417     {
 418         line <- args[index]
 419         index <- index + 1
 420
 421         while(nchar(line) < lineLength && index <= argsLength)
 422         {
 423             line <- paste(line, args[index])
 424             index <- index + 1
 425         }
 426
 427         argLines <- c(argLines, line)
 428     }
 429
 430     argLines <- unlist(argLines)
 431     argLinesLen <- length(argLines)
 432
 433     if(argLinesLen > 1)
 434         argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
 435
 436     argLines
 437 }