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     JSONDocument <- getAPIDocument()
  12
  13     generateArvadosClasses(JSONDocument)
  14     generateArvadosAPIClass(JSONDocument)
  15 }
  16
  17 generateArvadosAPIClass <- function(discoveryDocument)
  18 {
  19     classMetadata     <- discoveryDocument$schemas
  20     functionResources <- discoveryDocument$resources
  21     resourceNames     <- names(functionResources)
  22
  23     arvadosAPIHeader <- generateAPIClassHeader()
  24     arvadosAPIFooter <- generateAPIClassFooter()
  25
  26     arvadosMethods <- Map(function(resource, resourceName)
  27     {
  28         methodNames <- names(resource$methods)
  29
  30         functions <- Map(function(methodMetadata, methodName)
  31         {
  32             methodName <- paste0(resourceName, ".", methodName)
  33             createFunction(methodName, methodMetadata, classMetadata)
  34
  35         }, resource$methods, methodNames)
  36
  37         unlist(unname(functions))
  38
  39     }, functionResources, resourceNames)
  40
  41     arvadosClass <- c(arvadosAPIHeader, arvadosMethods, arvadosAPIFooter)
  42
  43     #TODO: To file or load in memory?
  44     fileConn <- file("ArvadosAPI.R", "w")
  45     writeLines(unlist(arvadosClass), fileConn)
  46     close(fileConn)
  47     NULL
  48 }
  49
  50 getFunctionName <- function(functionMetaData)
  51 {
  52     stringr::str_replace(functionMetaData$id, "arvados.", "")
  53 }
  54
  55 getFunctionArguments <- function(functionMetaData)
  56 {
  57     argNames <- names(functionMetaData$parameters)
  58     args <- sapply(argNames, function(argName)
  59     {
  60         arg <- functionMetaData$parameters[[argName]]
  61
  62         if(!arg$required)
  63         {
  64             if(!is.null(arg$default))
  65                 return(paste0(argName, " = ", "\"", arg$default, "\""))
  66             else
  67                 return(paste(argName, "=", "NULL"))
  68         }
  69
  70         argName
  71     })
  72
  73     paste0(args, collapse = ", ")
  74 }
  75
  76 getFunctionBody <- function(functionMetaData, classMetadata)
  77 {
  78     url  <- getRequestURL(functionMetaData)
  79     headers <- getRequestHeaders()
  80     requestQueryList <- getRequestQueryList(functionMetaData)
  81     request <- getRequest()
  82     response <- getResponse(functionMetaData)
  83     returnObject <- getReturnObject(functionMetaData, classMetadata)
  84
  85     body <- c(url, headers, requestQueryList, request, response, returnObject)
  86     paste0("\t\t\t", body)
  87 }
  88
  89 getRequestHeaders <- function()
  90 {
  91     "headers <- list(Authorization = paste(\"OAuth2\", private$token))"
  92 }
  93
  94 getReturnObject <- function(functionMetaData, classMetadata)
  95 {
  96     returnClass <- functionMetaData$response[["$ref"]]
  97     classArguments <- getReturnClassArguments(returnClass, classMetadata)
  98
  99     c(paste0(returnClass, "$new(", classArguments, ")"))
 100 }
 101
 102 getReturnClassArguments <- function(className, classMetadata)
 103 {
 104     classArguments <- unique(names(classMetadata[[className]]$properties))
 105
 106     arguments <- sapply(classArguments, function(arg)
 107     {
 108         paste0(arg, " = resource$", arg)
 109     })
 110
 111     paste0(arguments, collapse = ", ")
 112 }
 113
 114 getRequest <- function()
 115 {
 116     "response <- private$http$exec(\"GET\", url, headers, NULL, queryArgs)"
 117 }
 118
 119 getResponse <- function(functionMetaData)
 120 {
 121     "resource <- private$httpParser$parseJSONResponse(response)"
 122 }
 123
 124 getRequestURL <- function(functionMetaData)
 125 {
 126     endPoint <- functionMetaData$path
 127     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 128     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 129              paste0("url <- paste0(private$host, endPoint)"))
 130     url
 131 }
 132
 133 getRequestQueryList <- function(functionMetaData)
 134 {
 135     argNames <- names(functionMetaData$parameters)
 136
 137     if(length(argNames) == 0)
 138         return("queryArgs <- NULL")
 139
 140     queryListContent <- sapply(argNames, function(arg) paste0(arg, " = ", arg))
 141
 142     paste0("queryArgs <- list(", paste0(queryListContent, collapse = ', ') , ")")
 143 }
 144
 145 createFunction <- function(functionName, functionMetaData, classMetadata)
 146 {
 147     name <- functionName
 148     args <- getFunctionArguments(functionMetaData)
 149     body <- getFunctionBody(functionMetaData, classMetadata)
 150
 151     functionString <- c(paste0("\t\t", name, " = function(", args, ")"),
 152                        "\t\t{",
 153                            body,
 154                        "\t\t},\n")
 155
 156     functionString
 157 }
 158
 159 generateAPIClassHeader <- function()
 160 {
 161     c("#' @export",
 162       "ArvadosAPI <- R6::R6Class(",
 163       "",
 164       "\t\"ArvadosAPI\",",
 165       "",
 166       "\tpublic = list(",
 167       "",
 168       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
 169       "\t\t{",
 170       "\t\t\tif(!is.null(hostName))",
 171       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
 172       "",
 173       "\t\t\tif(!is.null(authToken))",
 174       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
 175       "",
 176       "\t\t\tprivate$rawHost <- Sys.getenv(\"ARVADOS_API_HOST\")",
 177       "\t\t\tprivate$host <- paste0(\"http://\", private$rawHost, \"/arvados/v1/\")",
 178       "\t\t\tprivate$token <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
 179       "\t\t\tprivate$numRetries  <- numRetries",
 180       "\t\t\tprivate$http  <- ArvadosR:::HttpRequest$new()",
 181       "\t\t\tprivate$httpParser  <- ArvadosR:::HttpParser$new()",
 182       "",
 183       "\t\t\tif(private$rawHost == \"\" | private$token == \"\")",
 184       "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
 185       "\t\t\t\t\t\t   \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
 186       "\t\t\t\t\t\t   \"environment variables.\"))",
 187       "\t\t},\n")
 188 }
 189
 190 generateAPIClassFooter <- function()
 191 {
 192     c("\t\tgetHostName = function() private$host,",
 193       "\t\tgetToken = function() private$token",
 194       "\t),",
 195       "",
 196       "\tprivate = list(",
 197       "",
 198       "\t\ttoken = NULL,",
 199       "\t\trawHost = NULL,",
 200       "\t\thost = NULL,",
 201       "\t\thttp = NULL,",
 202       "\t\thttpParser = NULL,",
 203       "\t\tnumRetries = NULL",
 204       "\t),",
 205       "",
 206       "\tcloneable = FALSE",
 207       ")")
 208 }
 209
 210 generateArvadosClasses <- function(resources)
 211 {
 212     classes <- sapply(resources$schemas, function(classSchema)
 213     {
 214         getArvadosClass(classSchema)
 215
 216     }, USE.NAMES = TRUE)
 217
 218     unlist(unname(classes))
 219
 220     #Todo: To file or directley to memory?
 221     fileConn <- file("ArvadosClasses.R", "w")
 222     writeLines(unlist(classes), fileConn)
 223     close(fileConn)
 224     NULL
 225 }
 226
 227 getArvadosClass <- function(classSchema)
 228 {
 229     name   <- classSchema$id
 230     fields <- unique(names(classSchema$properties))
 231     fieldsList <- paste0("c(", paste0("\"", fields, "\"", collapse = ", "), ")")
 232     constructorArgs <- paste0(fields, " = NULL", collapse = ", ")
 233
 234     classString <- c(paste0(name, " <- R6::R6Class("),
 235                      "",
 236               paste0("\t\"", name, "\","),
 237                      "",
 238                      "\tpublic = list(",
 239               paste0("\t\t", fields, " = NULL,"),
 240                      "",
 241               paste0("\t\tinitialize = function(", constructorArgs, ") {"),
 242               paste0("\t\t\tself$", fields, " <- ", fields),
 243                      "\t\t\t",
 244               paste0("\t\t\tprivate$classFields <- ", fieldsList),
 245                      "\t\t},",
 246                      "",
 247                      "\t\ttoJSON = function() {",
 248                      "\t\t\tfields <- sapply(private$classFields, function(field)",
 249                      "\t\t\t{",
 250                      "\t\t\t\tself[[field]]",
 251                      "\t\t\t}, USE.NAMES = TRUE)",
 252                      "\t\t\t",
 253               paste0("\t\t\tlist(\"", name, "\" = Filter(Negate(is.null), fields))"),
 254                      "\t\t}",
 255                      "\t),",
 256                      "",
 257                      "\tprivate = list(",
 258                      "\t\tclassFields = NULL",
 259                      "\t),",
 260                      "",
 261                      "\tcloneable = FALSE",
 262                      ")",
 263                      "")
 264 }