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     arvadosClassMethods <- generateClassContent(methodResources, resourceNames)
  21     arvadosAPIFooter <- generateAPIClassFooter()
  22
  23     arvadosClass <- c(doc,
  24                       arvadosAPIHeader,
  25                       arvadosClassMethods,
  26                       arvadosAPIFooter)
  27
  28     fileConn <- file("./R/Arvados.R", "w")
  29     writeLines(unlist(arvadosClass), fileConn)
  30     close(fileConn)
  31     NULL
  32 }
  33
  34 generateAPIClassHeader <- function()
  35 {
  36     c("#' @export",
  37       "Arvados <- R6::R6Class(",
  38       "",
  39       "\t\"Arvados\",",
  40       "",
  41       "\tpublic = list(",
  42       "",
  43       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
  44       "\t\t{",
  45       "\t\t\tif(!is.null(hostName))",
  46       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
  47       "",
  48       "\t\t\tif(!is.null(authToken))",
  49       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
  50       "",
  51       "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
  52       "\t\t\ttoken    <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
  53       "",
  54       "\t\t\tif(hostName == \"\" | token == \"\")",
  55       "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
  56       "\t\t\t\t\t\t   \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
  57       "\t\t\t\t\t\t   \"environment variables.\"))",
  58       "",
  59       "\t\t\tprivate$token <- token",
  60       "\t\t\tprivate$host  <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
  61       "\t\t\tprivate$numRetries <- numRetries",
  62       "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
  63       "\t\t\t                                HttpRequest$new(), HttpParser$new(),",
  64       "\t\t\t                                numRetries)",
  65       "",
  66       "\t\t},\n")
  67 }
  68
  69 generateClassContent <- function(methodResources, resourceNames)
  70 {
  71     arvadosMethods <- Map(function(resource, resourceName)
  72     {
  73         methodNames <- names(resource$methods)
  74
  75         functions <- Map(function(methodMetaData, methodName)
  76         {
  77             methodName <- paste0(resourceName, ".", methodName)
  78             createMethod(methodName, methodMetaData)
  79
  80         }, resource$methods, methodNames)
  81
  82         unlist(unname(functions))
  83
  84     }, methodResources, resourceNames)
  85
  86     arvadosMethods
  87 }
  88
  89 generateAPIClassFooter <- function()
  90 {
  91     c("\t\tgetHostName = function() private$host,",
  92       "\t\tgetToken = function() private$token,",
  93       "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
  94       "\t\tgetRESTService = function() private$REST",
  95       "\t),",
  96       "",
  97       "\tprivate = list(",
  98       "",
  99       "\t\ttoken = NULL,",
 100       "\t\thost = NULL,",
 101       "\t\tREST = NULL,",
 102       "\t\tnumRetries = NULL",
 103       "\t),",
 104       "",
 105       "\tcloneable = FALSE",
 106       ")")
 107 }
 108
 109 createMethod <- function(name, methodMetaData)
 110 {
 111     args      <- getMethodArguments(methodMetaData)
 112     signature <- getMethodSignature(name, args)
 113     body      <- getMethodBody(methodMetaData)
 114
 115     c(signature,
 116       "\t\t{",
 117           body,
 118       "\t\t},\n")
 119 }
 120
 121 #TODO: Make sure that arguments that are required always go first.
 122 #      This is not the case if request$required is false.
 123 getMethodArguments <- function(methodMetaData)
 124 {
 125     request <- methodMetaData$request
 126     requestArgs <- NULL
 127
 128     if(!is.null(request))
 129     {
 130         resourceName <- tolower(request$properties[[1]][[1]])
 131
 132         if(request$required)
 133             requestArgs <- resourceName
 134         else
 135             requestArgs <- paste(resourceName, "=", "NULL")
 136     }
 137
 138     argNames <- names(methodMetaData$parameters)
 139
 140     args <- sapply(argNames, function(argName)
 141     {
 142         arg <- methodMetaData$parameters[[argName]]
 143
 144         if(!arg$required)
 145         {
 146             if(!is.null(arg$default))
 147                 return(paste0(argName, " = ", "\"", arg$default, "\""))
 148             else
 149                 return(paste(argName, "=", "NULL"))
 150         }
 151
 152         argName
 153     })
 154
 155     c(requestArgs, args)
 156 }
 157
 158 getMethodSignature <- function(methodName, args)
 159 {
 160     collapsedArgs <- paste0(args, collapse = ", ")
 161     lineLengthLimit <- 40
 162
 163     if(nchar(collapsedArgs) > lineLengthLimit)
 164     {
 165         return(paste0("\t\t",
 166                       formatArgs(paste(methodName, "= function("),
 167                                  "\t", args, ")", lineLengthLimit)))
 168     }
 169     else
 170     {
 171         return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
 172     }
 173 }
 174
 175 getMethodBody <- function(methodMetaData)
 176 {
 177     url              <- getRequestURL(methodMetaData)
 178     headers          <- getRequestHeaders()
 179     requestQueryList <- getRequestQueryList(methodMetaData)
 180     requestBody      <- getRequestBody(methodMetaData)
 181     request          <- getRequest(methodMetaData)
 182     response         <- getResponse(methodMetaData)
 183     errorCheck       <- getErrorCheckingCode()
 184     returnStatement  <- getReturnObjectValidationCode()
 185
 186     body <- c(url,
 187               headers,
 188               requestQueryList, "",
 189               requestBody, "",
 190               request, response, "",
 191               errorCheck, "",
 192               returnStatement)
 193
 194     paste0("\t\t\t", body)
 195 }
 196
 197 getRequestURL <- function(methodMetaData)
 198 {
 199     endPoint <- methodMetaData$path
 200     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 201     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 202              paste0("url <- paste0(private$host, endPoint)"))
 203     url
 204 }
 205
 206 getRequestHeaders <- function()
 207 {
 208     c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
 209       "                \"Content-Type\" = \"application/json\")")
 210 }
 211
 212 getRequestQueryList <- function(methodMetaData)
 213 {
 214     queryArgs <- names(Filter(function(arg) arg$location == "query",
 215                         methodMetaData$parameters))
 216
 217     if(length(queryArgs) == 0)
 218         return("queryArgs <- NULL")
 219
 220     queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
 221     collapsedArgs <- paste0(queryArgs, collapse = ", ")
 222
 223     lineLengthLimit <- 40
 224
 225     if(nchar(collapsedArgs) > lineLengthLimit)
 226         return(formatArgs("queryArgs <- list(", "\t\t\t\t  ", queryArgs, ")",
 227                           lineLengthLimit))
 228     else
 229         return(paste0("queryArgs <- list(", collapsedArgs, ")"))
 230 }
 231
 232 getRequestBody <- function(methodMetaData)
 233 {
 234     request <- methodMetaData$request
 235
 236     if(is.null(request) || !request$required)
 237         return("body <- NULL")
 238
 239     resourceName <- tolower(request$properties[[1]][[1]])
 240
 241     requestParameterName <- names(request$properties)[1]
 242
 243     c(paste0("if(length(", resourceName, ") > 0)"),
 244       paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
 245              "\t                         auto_unbox = TRUE)",
 246       "else",
 247       "\tbody <- NULL")
 248 }
 249
 250 getRequest <- function(methodMetaData)
 251 {
 252     method <- methodMetaData$httpMethod
 253     c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
 254       "                                   queryArgs, private$numRetries)")
 255 }
 256
 257 getResponse <- function(methodMetaData)
 258 {
 259     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 260 }
 261
 262 getErrorCheckingCode <- function()
 263 {
 264     c("if(!is.null(resource$errors))",
 265       "\tstop(resource$errors)")
 266 }
 267
 268 getReturnObjectValidationCode <- function()
 269 {
 270     "resource"
 271 }
 272
 273 #NOTE: Arvados class documentation:
 274
 275 generateMethodsDocumentation <- function(methodResources, resourceNames)
 276 {
 277     methodsDoc <- unlist(unname(Map(function(resource, resourceName)
 278     {
 279         methodNames <- names(resource$methods)
 280
 281         methodDoc <- Map(function(methodMetaData, methodName)
 282         {
 283             methodName <- paste0(resourceName, ".", methodName)
 284             getMethodDocumentation(methodName, methodMetaData)
 285
 286         }, resource$methods, methodNames)
 287
 288         unlist(unname(methodDoc))
 289
 290     }, methodResources, resourceNames)))
 291
 292     methodsDoc
 293 }
 294
 295 getMethodDocumentation <- function(methodName, methodMetaData)
 296 {
 297     name        <- paste("#' @name", methodName)
 298     usage       <- getMethodUsage(methodName, methodMetaData)
 299     description <- paste("#'", methodName, "is a method defined in Arvados class.")
 300     params      <- getMethodDescription(methodMetaData)
 301     returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
 302
 303     c(description,
 304       "#' ",
 305       usage,
 306       params,
 307       returnValue,
 308       name,
 309       "NULL",
 310       "")
 311 }
 312
 313 getMethodUsage <- function(methodName, methodMetaData)
 314 {
 315     lineLengthLimit <- 40
 316     args <- getMethodArguments(methodMetaData)
 317     c(formatArgs(paste0("#' @usage arv$", methodName,
 318                         "("), "#' \t", args, ")", lineLengthLimit))
 319 }
 320
 321 getMethodDescription <- function(methodMetaData)
 322 {
 323     request <- methodMetaData$request
 324     requestDoc <- NULL
 325
 326     if(!is.null(request))
 327     {
 328         requestDoc <- unname(unlist(sapply(request$properties, function(prop)
 329                              {
 330                                  className <- sapply(prop, function(ref) ref)
 331                                  objectName <- paste0(tolower(substr(className, 1, 1)),
 332                                                       substr(className, 2, nchar(className)))
 333                                  paste("#' @param", objectName, className, "object.")
 334                              })))
 335     }
 336
 337     argNames <- names(methodMetaData$parameters)
 338
 339     argsDoc <- unname(unlist(sapply(argNames, function(argName)
 340     {
 341         arg <- methodMetaData$parameters[[argName]]
 342         argDescription <- arg$description
 343         paste("#' @param", argName, argDescription)
 344     })))
 345
 346     c(requestDoc, argsDoc)
 347 }
 348
 349 #NOTE: Utility functions:
 350
 351 formatArgs <- function(prependAtStart, prependToEachSplit,
 352                        args, appendAtEnd, lineLength)
 353 {
 354     if(length(args) > 1)
 355     {
 356         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 357     }
 358
 359     args[1] <- paste0(prependAtStart, args[1])
 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     argLines <- unlist(argLines)
 381     argLinesLen <- length(argLines)
 382
 383     if(argLinesLen > 1)
 384         argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
 385
 386     argLines
 387 }