sdk/R/R/autoGenAPI.R

   1 #TODO: Some methods do the same thing like collecion.index and collection.list.
   2 #      Make one implementation of the method and make other reference to it.
   3
   4 getAPIDocument <- function(){
   5     url <- "https://4xphq.arvadosapi.com/discovery/v1/apis/arvados/v1/rest"
   6     serverResponse <- httr::RETRY("GET", url = url)
   7
   8     httr::content(serverResponse, as = "parsed", type = "application/json")
   9 }
  10
  11 #' @export
  12 generateAPI <- function()
  13 {
  14     JSONDocument <- getAPIDocument()
  15
  16     generateArvadosClasses(JSONDocument)
  17     generateArvadosAPIClass(JSONDocument)
  18 }
  19
  20 generateArvadosAPIClass <- function(discoveryDocument)
  21 {
  22     classMetaData     <- discoveryDocument$schemas
  23     functionResources <- discoveryDocument$resources
  24     resourceNames     <- names(functionResources)
  25
  26     arvadosAPIHeader <- generateAPIClassHeader()
  27     arvadosAPIFooter <- generateAPIClassFooter()
  28
  29     arvadosMethods <- Map(function(resource, resourceName)
  30     {
  31         methodNames <- names(resource$methods)
  32
  33         functions <- Map(function(methodMetaData, methodName)
  34         {
  35             methodName <- paste0(resourceName, ".", methodName)
  36             createFunction(methodName, methodMetaData, classMetaData)
  37
  38         }, resource$methods, methodNames)
  39
  40         unlist(unname(functions))
  41
  42     }, functionResources, resourceNames)
  43
  44     arvadosClass <- c(arvadosAPIHeader, arvadosMethods, arvadosAPIFooter)
  45
  46     #TODO: Save to a file or load in memory?
  47     fileConn <- file("./R/Arvados.R", "w")
  48     writeLines(unlist(arvadosClass), fileConn)
  49     close(fileConn)
  50     NULL
  51 }
  52
  53 getFunctionName <- function(functionMetaData)
  54 {
  55     stringr::str_replace(functionMetaData$id, "arvados.", "")
  56 }
  57
  58 #TODO: Make sure that arguments that are required always go first.
  59 #      This is not the case if request$required is false.
  60 getFunctionArguments <- function(functionMetaData)
  61 {
  62     request <- functionMetaData$request
  63     requestArgument <- NULL
  64
  65     if(!is.null(request))
  66         if(request$required)
  67             requestArgument <- names(request$properties)[1]
  68         else
  69             requestArgument <- paste(names(request$properties)[1], "=", "NULL")
  70
  71     argNames <- names(functionMetaData$parameters)
  72
  73     args <- sapply(argNames, function(argName)
  74     {
  75         arg <- functionMetaData$parameters[[argName]]
  76
  77         if(!arg$required)
  78         {
  79             if(!is.null(arg$default))
  80                 return(paste0(argName, " = ", "\"", arg$default, "\""))
  81             else
  82                 return(paste(argName, "=", "NULL"))
  83         }
  84
  85         argName
  86     })
  87
  88     paste0(c(requestArgument, args), collapse = ", ")
  89 }
  90
  91 getFunctionBody <- function(functionMetaData, classMetaData)
  92 {
  93     url  <- getRequestURL(functionMetaData)
  94     headers <- getRequestHeaders()
  95     requestQueryList <- getRequestQueryList(functionMetaData)
  96     requestBody <- getRequestBody(functionMetaData)
  97     request <- getRequest(functionMetaData)
  98     response <- getResponse(functionMetaData)
  99     returnObject <- getReturnObject(functionMetaData, classMetaData)
 100
 101     body <- c(url, headers, requestQueryList, requestBody, request, response, returnObject)
 102     paste0("\t\t\t", body)
 103 }
 104
 105 getRequestBody <- function(functionMetaData)
 106 {
 107     request <- functionMetaData$request
 108
 109     if(is.null(request) || !request$required)
 110         return("body <- NULL")
 111
 112     requestParameterName <- names(request$properties)[1]
 113     paste0("body <- ", requestParameterName, "$toJSON()")
 114 }
 115
 116 getRequestHeaders <- function()
 117 {
 118     paste0("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
 119                             "\"Content-Type\" = \"application/json\")")
 120 }
 121
 122 getReturnObject <- function(functionMetaData, classMetaData)
 123 {
 124     returnClass <- functionMetaData$response[["$ref"]]
 125     classArguments <- getReturnClassArguments(returnClass, classMetaData)
 126
 127     if(returnClass == "Collection")
 128         return(c(paste0("collection <- ", returnClass, "$new(", classArguments, ")"),
 129                  "collection$setRESTService(private$REST)",
 130                  "collection"))
 131
 132     c(paste0(returnClass, "$new(", classArguments, ")"))
 133 }
 134
 135 getReturnClassArguments <- function(className, classMetaData)
 136 {
 137     classArguments <- unique(names(classMetaData[[className]]$properties))
 138
 139     arguments <- sapply(classArguments, function(arg)
 140     {
 141         paste0(arg, " = resource$", arg)
 142     })
 143
 144     paste0(arguments, collapse = ", ")
 145 }
 146
 147 getRequest <- function(functionMetaData)
 148 {
 149     method <- functionMetaData$httpMethod
 150     paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body, queryArgs)")
 151 }
 152
 153 getResponse <- function(functionMetaData)
 154 {
 155     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 156 }
 157
 158 getRequestURL <- function(functionMetaData)
 159 {
 160     endPoint <- functionMetaData$path
 161     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 162     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 163              paste0("url <- paste0(private$host, endPoint)"))
 164     url
 165 }
 166
 167 getRequestQueryList <- function(functionMetaData)
 168 {
 169     argNames <- names(functionMetaData$parameters)
 170
 171     if(length(argNames) == 0)
 172         return("queryArgs <- NULL")
 173
 174     queryListContent <- sapply(argNames, function(arg) paste0(arg, " = ", arg))
 175
 176     paste0("queryArgs <- list(", paste0(queryListContent, collapse = ', ') , ")")
 177 }
 178
 179 createFunction <- function(functionName, functionMetaData, classMetaData)
 180 {
 181     args <- getFunctionArguments(functionMetaData)
 182     aditionalArgs <-
 183     body <- getFunctionBody(functionMetaData, classMetaData)
 184
 185     functionString <- c(paste0("\t\t", functionName, " = function(", args, ")"),
 186                        "\t\t{",
 187                            body,
 188                        "\t\t},\n")
 189
 190     functionString
 191 }
 192
 193 generateAPIClassHeader <- function()
 194 {
 195     c("#' @export",
 196       "Arvados <- R6::R6Class(",
 197       "",
 198       "\t\"Arvados\",",
 199       "",
 200       "\tpublic = list(",
 201       "",
 202       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
 203       "\t\t{",
 204       "\t\t\tif(!is.null(hostName))",
 205       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
 206       "",
 207       "\t\t\tif(!is.null(authToken))",
 208       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
 209       "",
 210       "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
 211       "\t\t\ttoken    <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
 212       "",
 213       "\t\t\tif(hostName == \"\" | token == \"\")",
 214       "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
 215       "\t\t\t\t\t\t   \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
 216       "\t\t\t\t\t\t   \"environment variables.\"))",
 217       "",
 218       "\t\t\tprivate$token <- token",
 219       "\t\t\tprivate$host  <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
 220       "\t\t\tprivate$numRetries <- numRetries",
 221       "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
 222       "\t\t\t                                HttpRequest$new(), HttpParser$new(),",
 223       "\t\t\t                                numRetries)",
 224       "",
 225       "\t\t},\n")
 226 }
 227
 228 generateAPIClassFooter <- function()
 229 {
 230     c("\t\tgetHostName = function() private$host,",
 231       "\t\tgetToken = function() private$token,",
 232       "\t\tsetRESTService = function(newREST) private$REST <- newREST",
 233       "\t),",
 234       "",
 235       "\tprivate = list(",
 236       "",
 237       "\t\ttoken = NULL,",
 238       "\t\thost = NULL,",
 239       "\t\tREST = NULL,",
 240       "\t\tnumRetries = NULL",
 241       "\t),",
 242       "",
 243       "\tcloneable = FALSE",
 244       ")")
 245 }
 246
 247 generateArvadosClasses <- function(resources)
 248 {
 249     classes <- sapply(resources$schemas, function(classSchema)
 250     {
 251         #NOTE: Collection is implemented manually.
 252         if(classSchema$id != "Collection")
 253             getArvadosClass(classSchema)
 254
 255     }, USE.NAMES = TRUE)
 256
 257     unlist(unname(classes))
 258
 259     fileConn <- file("./R/ArvadosClasses.R", "w")
 260     writeLines(unlist(classes), fileConn)
 261     close(fileConn)
 262     NULL
 263 }
 264
 265 getArvadosClass <- function(classSchema)
 266 {
 267     name   <- classSchema$id
 268     fields <- unique(names(classSchema$properties))
 269     fieldsList <- paste0("c(", paste0("\"", fields, "\"", collapse = ", "), ")")
 270     constructorArgs <- paste0(fields, " = NULL", collapse = ", ")
 271
 272     classString <- c("#' @export",
 273               paste0(name, " <- R6::R6Class("),
 274                      "",
 275               paste0("\t\"", name, "\","),
 276                      "",
 277                      "\tpublic = list(",
 278               paste0("\t\t", fields, " = NULL,"),
 279                      "",
 280               paste0("\t\tinitialize = function(", constructorArgs, ") {"),
 281               paste0("\t\t\tself$", fields, " <- ", fields),
 282                      "\t\t\t",
 283               paste0("\t\t\tprivate$classFields <- ", fieldsList),
 284                      "\t\t},",
 285                      "",
 286                      "\t\ttoJSON = function() {",
 287                      "\t\t\tfields <- sapply(private$classFields, function(field)",
 288                      "\t\t\t{",
 289                      "\t\t\t\tself[[field]]",
 290                      "\t\t\t}, USE.NAMES = TRUE)",
 291                      "\t\t\t",
 292               paste0("\t\t\tjsonlite::toJSON(list(\"", tolower(name), "\" = Filter(Negate(is.null), fields)), auto_unbox = TRUE)"),
 293                      "\t\t}",
 294                      "\t),",
 295                      "",
 296                      "\tprivate = list(",
 297                      "\t\tclassFields = NULL",
 298                      "\t),",
 299                      "",
 300                      "\tcloneable = FALSE",
 301                      ")",
 302                      "")
 303 }