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     #TODO: Save to a file or load in memory?
  29     fileConn <- file("./R/Arvados.R", "w")
  30     writeLines(unlist(arvadosClass), fileConn)
  31     close(fileConn)
  32     NULL
  33 }
  34
  35 generateAPIClassHeader <- function()
  36 {
  37     c("#' @export",
  38       "Arvados <- R6::R6Class(",
  39       "",
  40       "\t\"Arvados\",",
  41       "",
  42       "\tpublic = list(",
  43       "",
  44       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
  45       "\t\t{",
  46       "\t\t\tif(!is.null(hostName))",
  47       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
  48       "",
  49       "\t\t\tif(!is.null(authToken))",
  50       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
  51       "",
  52       "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
  53       "\t\t\ttoken    <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
  54       "",
  55       "\t\t\tif(hostName == \"\" | token == \"\")",
  56       "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
  57       "\t\t\t\t\t\t   \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
  58       "\t\t\t\t\t\t   \"environment variables.\"))",
  59       "",
  60       "\t\t\tprivate$token <- token",
  61       "\t\t\tprivate$host  <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
  62       "\t\t\tprivate$numRetries <- numRetries",
  63       "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
  64       "\t\t\t                                HttpRequest$new(), HttpParser$new(),",
  65       "\t\t\t                                numRetries)",
  66       "",
  67       "\t\t},\n")
  68 }
  69
  70 generateClassContent <- function(methodResources, resourceNames)
  71 {
  72     arvadosMethods <- Map(function(resource, resourceName)
  73     {
  74         methodNames <- names(resource$methods)
  75
  76         functions <- Map(function(methodMetaData, methodName)
  77         {
  78             methodName <- paste0(resourceName, ".", methodName)
  79             createMethod(methodName, methodMetaData)
  80
  81         }, resource$methods, methodNames)
  82
  83         unlist(unname(functions))
  84
  85     }, methodResources, resourceNames)
  86
  87     arvadosMethods
  88 }
  89
  90 generateAPIClassFooter <- function()
  91 {
  92     c("\t\tgetHostName = function() private$host,",
  93       "\t\tgetToken = function() private$token,",
  94       "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
  95       "\t\tgetRESTService = function() private$REST",
  96       "\t),",
  97       "",
  98       "\tprivate = list(",
  99       "",
 100       "\t\ttoken = NULL,",
 101       "\t\thost = NULL,",
 102       "\t\tREST = NULL,",
 103       "\t\tnumRetries = NULL",
 104       "\t),",
 105       "",
 106       "\tcloneable = FALSE",
 107       ")")
 108 }
 109
 110 createMethod <- function(name, methodMetaData)
 111 {
 112     args      <- getMethodArguments(methodMetaData)
 113     signature <- getMethodSignature(name, args)
 114     body      <- getMethodBody(methodMetaData)
 115
 116     c(signature,
 117       "\t\t{",
 118           body,
 119       "\t\t},\n")
 120 }
 121
 122 #TODO: Make sure that arguments that are required always go first.
 123 #      This is not the case if request$required is false.
 124 getMethodArguments <- function(methodMetaData)
 125 {
 126     request <- methodMetaData$request
 127     requestArgs <- NULL
 128
 129     if(!is.null(request))
 130     {
 131         resourceName <- tolower(request$properties[[1]][[1]])
 132
 133         if(request$required)
 134             requestArgs <- resourceName
 135         else
 136             requestArgs <- paste(resourceName, "=", "NULL")
 137     }
 138
 139     argNames <- names(methodMetaData$parameters)
 140
 141     args <- sapply(argNames, function(argName)
 142     {
 143         arg <- methodMetaData$parameters[[argName]]
 144
 145         if(!arg$required)
 146         {
 147             if(!is.null(arg$default))
 148                 return(paste0(argName, " = ", "\"", arg$default, "\""))
 149             else
 150                 return(paste(argName, "=", "NULL"))
 151         }
 152
 153         argName
 154     })
 155
 156     c(requestArgs, args)
 157 }
 158
 159 getMethodSignature <- function(methodName, args)
 160 {
 161     collapsedArgs <- paste0(args, collapse = ", ")
 162     lineLengthLimit <- 40
 163
 164     if(nchar(collapsedArgs) > lineLengthLimit)
 165     {
 166         return(paste0("\t\t",
 167                       formatArgs(paste(methodName, "= function("),
 168                                  "\t", args, ")", lineLengthLimit)))
 169     }
 170     else
 171     {
 172         return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
 173     }
 174 }
 175
 176 getMethodBody <- function(methodMetaData)
 177 {
 178     url              <- getRequestURL(methodMetaData)
 179     headers          <- getRequestHeaders()
 180     requestQueryList <- getRequestQueryList(methodMetaData)
 181     requestBody      <- getRequestBody(methodMetaData)
 182     request          <- getRequest(methodMetaData)
 183     response         <- getResponse(methodMetaData)
 184     errorCheck       <- getErrorCheckingCode()
 185     returnStatement  <- getReturnObjectValidationCode()
 186
 187     body <- c(url,
 188               headers,
 189               requestQueryList, "",
 190               requestBody, "",
 191               request, response, "",
 192               errorCheck, "",
 193               returnStatement)
 194
 195     paste0("\t\t\t", body)
 196 }
 197
 198 getRequestURL <- function(methodMetaData)
 199 {
 200     endPoint <- methodMetaData$path
 201     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 202     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 203              paste0("url <- paste0(private$host, endPoint)"))
 204     url
 205 }
 206
 207 getRequestHeaders <- function()
 208 {
 209     c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
 210       "                \"Content-Type\" = \"application/json\")")
 211 }
 212
 213 getRequestQueryList <- function(methodMetaData)
 214 {
 215     queryArgs <- names(Filter(function(arg) arg$location == "query",
 216                         methodMetaData$parameters))
 217
 218     if(length(queryArgs) == 0)
 219         return("queryArgs <- NULL")
 220
 221     queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
 222     collapsedArgs <- paste0(queryArgs, collapse = ", ")
 223
 224     lineLengthLimit <- 40
 225
 226     if(nchar(collapsedArgs) > lineLengthLimit)
 227         return(formatArgs("queryArgs <- list(", "\t", queryArgs, ")", 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              "                           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 }