-#TODO: Some methods do the same thing like collecion.index and collection.list.
-# Make one implementation of the method and make other reference to it.
-
getAPIDocument <- function(){
url <- "https://4xphq.arvadosapi.com/discovery/v1/apis/arvados/v1/rest"
serverResponse <- httr::RETRY("GET", url = url)
#' @export
generateAPI <- function()
{
- JSONDocument <- getAPIDocument()
+ #TODO: Consider passing discovery document URL as parameter.
+ #TODO: Consider passing location where to create new files.
+ discoveryDocument <- getAPIDocument()
+
+ methodResources <- discoveryDocument$resources
+ resourceNames <- names(methodResources)
+
+ doc <- generateMethodsDocumentation(methodResources, resourceNames)
+ arvadosAPIHeader <- generateAPIClassHeader()
+ arvadosProjectMethods <- generateProjectMethods()
+ arvadosClassMethods <- generateClassContent(methodResources, resourceNames)
+ arvadosAPIFooter <- generateAPIClassFooter()
+
+ arvadosClass <- c(doc,
+ arvadosAPIHeader,
+ arvadosProjectMethods,
+ arvadosClassMethods,
+ arvadosAPIFooter)
- generateArvadosClasses(JSONDocument)
- generateArvadosAPIClass(JSONDocument)
+ fileConn <- file("./R/Arvados.R", "w")
+ writeLines(unlist(arvadosClass), fileConn)
+ close(fileConn)
+ NULL
}
-generateArvadosAPIClass <- function(discoveryDocument)
+generateAPIClassHeader <- function()
{
- classMetaData <- discoveryDocument$schemas
- functionResources <- discoveryDocument$resources
- resourceNames <- names(functionResources)
+ c("#' @export",
+ "Arvados <- R6::R6Class(",
+ "",
+ "\t\"Arvados\",",
+ "",
+ "\tpublic = list(",
+ "",
+ "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
+ "\t\t{",
+ "\t\t\tif(!is.null(hostName))",
+ "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
+ "",
+ "\t\t\tif(!is.null(authToken))",
+ "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
+ "",
+ "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
+ "\t\t\ttoken <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
+ "",
+ "\t\t\tif(hostName == \"\" | token == \"\")",
+ "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
+ "\t\t\t\t\t\t \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
+ "\t\t\t\t\t\t \"environment variables.\"))",
+ "",
+ "\t\t\tprivate$token <- token",
+ "\t\t\tprivate$host <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
+ "\t\t\tprivate$numRetries <- numRetries",
+ "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
+ "\t\t\t HttpRequest$new(), HttpParser$new(),",
+ "\t\t\t numRetries)",
+ "",
+ "\t\t},\n")
+}
- arvadosAPIHeader <- generateAPIClassHeader()
- arvadosAPIFooter <- generateAPIClassFooter()
+generateProjectMethods <- function()
+{
+ c("\t\tproject.get = function(uuid)",
+ "\t\t{",
+ "\t\t\tself$groups.get(uuid)",
+ "\t\t},",
+ "",
+ "\t\tproject.create = function(group, ensure_unique_name = \"false\")",
+ "\t\t{",
+ "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
+ "\t\t\tself$groups.create(group, ensure_unique_name)",
+ "\t\t},",
+ "",
+ "\t\tproject.update = function(group, uuid)",
+ "\t\t{",
+ "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
+ "\t\t\tself$groups.update(group, uuid)",
+ "\t\t},",
+ "",
+ "\t\tproject.list = function(filters = NULL, where = NULL,",
+ "\t\t\torder = NULL, select = NULL, distinct = NULL,",
+ "\t\t\tlimit = \"100\", offset = \"0\", count = \"exact\",",
+ "\t\t\tinclude_trash = NULL)",
+ "\t\t{",
+ "\t\t\tfilters[[length(filters) + 1]] <- list(\"group_class\", \"=\", \"project\")",
+ "\t\t\tself$groups.list(filters, where, order, select, distinct,",
+ "\t\t\t limit, offset, count, include_trash)",
+ "\t\t},",
+ "",
+ "\t\tproject.delete = function(uuid)",
+ "\t\t{",
+ "\t\t\tself$groups.delete(uuid)",
+ "\t\t},",
+ "")
+}
+generateClassContent <- function(methodResources, resourceNames)
+{
arvadosMethods <- Map(function(resource, resourceName)
{
methodNames <- names(resource$methods)
functions <- Map(function(methodMetaData, methodName)
{
methodName <- paste0(resourceName, ".", methodName)
- createFunction(methodName, methodMetaData, classMetaData)
+ createMethod(methodName, methodMetaData)
}, resource$methods, methodNames)
unlist(unname(functions))
- }, functionResources, resourceNames)
+ }, methodResources, resourceNames)
- arvadosClass <- c(arvadosAPIHeader, arvadosMethods, arvadosAPIFooter)
+ arvadosMethods
+}
- #TODO: Save to a file or load in memory?
- fileConn <- file("./R/Arvados.R", "w")
- writeLines(unlist(arvadosClass), fileConn)
- close(fileConn)
- NULL
+generateAPIClassFooter <- function()
+{
+ c("\t\tgetHostName = function() private$host,",
+ "\t\tgetToken = function() private$token,",
+ "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
+ "\t\tgetRESTService = function() private$REST",
+ "\t),",
+ "",
+ "\tprivate = list(",
+ "",
+ "\t\ttoken = NULL,",
+ "\t\thost = NULL,",
+ "\t\tREST = NULL,",
+ "\t\tnumRetries = NULL",
+ "\t),",
+ "",
+ "\tcloneable = FALSE",
+ ")")
}
-getFunctionName <- function(functionMetaData)
+createMethod <- function(name, methodMetaData)
{
- stringr::str_replace(functionMetaData$id, "arvados.", "")
+ args <- getMethodArguments(methodMetaData)
+ signature <- getMethodSignature(name, args)
+ body <- getMethodBody(methodMetaData)
+
+ c(signature,
+ "\t\t{",
+ body,
+ "\t\t},\n")
}
-#TODO: Make sure that arguments that are required always go first.
-# This is not the case if request$required is false.
-getFunctionArguments <- function(functionMetaData)
+getMethodArguments <- function(methodMetaData)
{
- request <- functionMetaData$request
- requestArgument <- NULL
+ request <- methodMetaData$request
+ requestArgs <- NULL
if(!is.null(request))
+ {
+ resourceName <- tolower(request$properties[[1]][[1]])
+
if(request$required)
- requestArgument <- names(request$properties)[1]
+ requestArgs <- resourceName
else
- requestArgument <- paste(names(request$properties)[1], "=", "NULL")
+ requestArgs <- paste(resourceName, "=", "NULL")
+ }
- argNames <- names(functionMetaData$parameters)
+ argNames <- names(methodMetaData$parameters)
args <- sapply(argNames, function(argName)
{
- arg <- functionMetaData$parameters[[argName]]
+ arg <- methodMetaData$parameters[[argName]]
if(!arg$required)
{
argName
})
- paste0(c(requestArgument, args), collapse = ", ")
+ c(requestArgs, args)
}
-getFunctionBody <- function(functionMetaData, classMetaData)
+getMethodSignature <- function(methodName, args)
{
- url <- getRequestURL(functionMetaData)
- headers <- getRequestHeaders()
- requestQueryList <- getRequestQueryList(functionMetaData)
- requestBody <- getRequestBody(functionMetaData)
- request <- getRequest(functionMetaData)
- response <- getResponse(functionMetaData)
- returnObject <- getReturnObject(functionMetaData, classMetaData)
-
- body <- c(url, headers, requestQueryList, requestBody, request, response, returnObject)
- paste0("\t\t\t", body)
+ collapsedArgs <- paste0(args, collapse = ", ")
+ lineLengthLimit <- 40
+
+ if(nchar(collapsedArgs) > lineLengthLimit)
+ {
+ return(paste0("\t\t",
+ formatArgs(paste(methodName, "= function("),
+ "\t", args, ")", lineLengthLimit)))
+ }
+ else
+ {
+ return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
+ }
}
-getRequestBody <- function(functionMetaData)
+getMethodBody <- function(methodMetaData)
{
- request <- functionMetaData$request
+ url <- getRequestURL(methodMetaData)
+ headers <- getRequestHeaders()
+ requestQueryList <- getRequestQueryList(methodMetaData)
+ requestBody <- getRequestBody(methodMetaData)
+ request <- getRequest(methodMetaData)
+ response <- getResponse(methodMetaData)
+ errorCheck <- getErrorCheckingCode()
+ returnStatement <- getReturnObject()
+
+ body <- c(url,
+ headers,
+ requestQueryList, "",
+ requestBody, "",
+ request, response, "",
+ errorCheck, "",
+ returnStatement)
- if(is.null(request) || !request$required)
- return("body <- NULL")
+ paste0("\t\t\t", body)
+}
- requestParameterName <- names(request$properties)[1]
- paste0("body <- ", requestParameterName, "$toJSON()")
+getRequestURL <- function(methodMetaData)
+{
+ endPoint <- methodMetaData$path
+ endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
+ url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
+ paste0("url <- paste0(private$host, endPoint)"))
+ url
}
getRequestHeaders <- function()
{
- paste0("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
- "\"Content-Type\" = \"application/json\")")
+ c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
+ " \"Content-Type\" = \"application/json\")")
}
-getReturnObject <- function(functionMetaData, classMetaData)
+getRequestQueryList <- function(methodMetaData)
{
- returnClass <- functionMetaData$response[["$ref"]]
- classArguments <- getReturnClassArguments(returnClass, classMetaData)
+ queryArgs <- names(Filter(function(arg) arg$location == "query",
+ methodMetaData$parameters))
+
+ if(length(queryArgs) == 0)
+ return("queryArgs <- NULL")
+
+ queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
+ collapsedArgs <- paste0(queryArgs, collapse = ", ")
- if(returnClass == "Collection")
- return(c(paste0("collection <- ", returnClass, "$new(", classArguments, ")"),
- "collection$setRESTService(private$REST)",
- "collection"))
+ lineLengthLimit <- 40
- c(paste0(returnClass, "$new(", classArguments, ")"))
+ if(nchar(collapsedArgs) > lineLengthLimit)
+ return(formatArgs("queryArgs <- list(", "\t\t\t\t ", queryArgs, ")",
+ lineLengthLimit))
+ else
+ return(paste0("queryArgs <- list(", collapsedArgs, ")"))
}
-getReturnClassArguments <- function(className, classMetaData)
+getRequestBody <- function(methodMetaData)
{
- classArguments <- unique(names(classMetaData[[className]]$properties))
+ request <- methodMetaData$request
- arguments <- sapply(classArguments, function(arg)
- {
- paste0(arg, " = resource$", arg)
- })
+ if(is.null(request) || !request$required)
+ return("body <- NULL")
+
+ resourceName <- tolower(request$properties[[1]][[1]])
+
+ requestParameterName <- names(request$properties)[1]
- paste0(arguments, collapse = ", ")
+ c(paste0("if(length(", resourceName, ") > 0)"),
+ paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
+ "\t auto_unbox = TRUE)",
+ "else",
+ "\tbody <- NULL")
}
-getRequest <- function(functionMetaData)
+getRequest <- function(methodMetaData)
{
- method <- functionMetaData$httpMethod
- paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body, queryArgs)")
+ method <- methodMetaData$httpMethod
+ c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
+ " queryArgs, private$numRetries)")
}
-getResponse <- function(functionMetaData)
+getResponse <- function(methodMetaData)
{
"resource <- private$REST$httpParser$parseJSONResponse(response)"
}
-getRequestURL <- function(functionMetaData)
+getErrorCheckingCode <- function()
{
- endPoint <- functionMetaData$path
- endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
- url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
- paste0("url <- paste0(private$host, endPoint)"))
- url
+ c("if(!is.null(resource$errors))",
+ "\tstop(resource$errors)")
}
-getRequestQueryList <- function(functionMetaData)
+getReturnObject <- function()
{
- argNames <- names(functionMetaData$parameters)
+ "resource"
+}
- if(length(argNames) == 0)
- return("queryArgs <- NULL")
+#NOTE: Arvados class documentation:
- queryListContent <- sapply(argNames, function(arg) paste0(arg, " = ", arg))
+generateMethodsDocumentation <- function(methodResources, resourceNames)
+{
+ methodsDoc <- unlist(unname(Map(function(resource, resourceName)
+ {
+ methodNames <- names(resource$methods)
- paste0("queryArgs <- list(", paste0(queryListContent, collapse = ', ') , ")")
-}
+ methodDoc <- Map(function(methodMetaData, methodName)
+ {
+ methodName <- paste0(resourceName, ".", methodName)
+ getMethodDocumentation(methodName, methodMetaData)
-createFunction <- function(functionName, functionMetaData, classMetaData)
-{
- args <- getFunctionArguments(functionMetaData)
- aditionalArgs <-
- body <- getFunctionBody(functionMetaData, classMetaData)
+ }, resource$methods, methodNames)
- functionString <- c(paste0("\t\t", functionName, " = function(", args, ")"),
- "\t\t{",
- body,
- "\t\t},\n")
+ unlist(unname(methodDoc))
- functionString
+ }, methodResources, resourceNames)))
+
+ methodsDoc
}
-generateAPIClassHeader <- function()
+getMethodDocumentation <- function(methodName, methodMetaData)
{
- c("#' @export",
- "Arvados <- R6::R6Class(",
- "",
- "\t\"Arvados\",",
- "",
- "\tpublic = list(",
- "",
- "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
- "\t\t{",
- "\t\t\tif(!is.null(hostName))",
- "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
- "",
- "\t\t\tif(!is.null(authToken))",
- "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
- "",
- "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
- "\t\t\ttoken <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
- "",
- "\t\t\tif(hostName == \"\" | token == \"\")",
- "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
- "\t\t\t\t\t\t \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
- "\t\t\t\t\t\t \"environment variables.\"))",
- "",
- "\t\t\tprivate$token <- token",
- "\t\t\tprivate$host <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
- "\t\t\tprivate$numRetries <- numRetries",
- "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
- "\t\t\t HttpRequest$new(), HttpParser$new(),",
- "\t\t\t numRetries)",
- "",
- "\t\t},\n")
+ name <- paste("#' @name", methodName)
+ usage <- getMethodUsage(methodName, methodMetaData)
+ description <- paste("#'", methodName, "is a method defined in Arvados class.")
+ params <- getMethodDescription(methodMetaData)
+ returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
+
+ c(description,
+ "#' ",
+ usage,
+ params,
+ returnValue,
+ name,
+ "NULL",
+ "")
}
-generateAPIClassFooter <- function()
+getMethodUsage <- function(methodName, methodMetaData)
{
- c("\t\tgetHostName = function() private$host,",
- "\t\tgetToken = function() private$token,",
- "\t\tsetRESTService = function(newREST) private$REST <- newREST",
- "\t),",
- "",
- "\tprivate = list(",
- "",
- "\t\ttoken = NULL,",
- "\t\thost = NULL,",
- "\t\tREST = NULL,",
- "\t\tnumRetries = NULL",
- "\t),",
- "",
- "\tcloneable = FALSE",
- ")")
+ lineLengthLimit <- 40
+ args <- getMethodArguments(methodMetaData)
+ c(formatArgs(paste0("#' @usage arv$", methodName,
+ "("), "#' \t", args, ")", lineLengthLimit))
}
-generateArvadosClasses <- function(resources)
+getMethodDescription <- function(methodMetaData)
{
- classes <- sapply(resources$schemas, function(classSchema)
- {
- #NOTE: Collection is implemented manually.
- if(classSchema$id != "Collection")
- getArvadosClass(classSchema)
-
- }, USE.NAMES = TRUE)
+ request <- methodMetaData$request
+ requestDoc <- NULL
- unlist(unname(classes))
+ if(!is.null(request))
+ {
+ requestDoc <- unname(unlist(sapply(request$properties, function(prop)
+ {
+ className <- sapply(prop, function(ref) ref)
+ objectName <- paste0(tolower(substr(className, 1, 1)),
+ substr(className, 2, nchar(className)))
+ paste("#' @param", objectName, className, "object.")
+ })))
+ }
+
+ argNames <- names(methodMetaData$parameters)
+
+ argsDoc <- unname(unlist(sapply(argNames, function(argName)
+ {
+ arg <- methodMetaData$parameters[[argName]]
+ argDescription <- arg$description
+ paste("#' @param", argName, argDescription)
+ })))
- fileConn <- file("./R/ArvadosClasses.R", "w")
- writeLines(unlist(classes), fileConn)
- close(fileConn)
- NULL
+ c(requestDoc, argsDoc)
}
-getArvadosClass <- function(classSchema)
+#NOTE: Utility functions:
+
+# This function is used to split very long lines of code into smaller chunks.
+# This is usually the case when we pass a lot of named argumets to a function.
+formatArgs <- function(prependAtStart, prependToEachSplit,
+ args, appendAtEnd, lineLength)
{
- name <- classSchema$id
- fields <- unique(names(classSchema$properties))
- fieldsList <- paste0("c(", paste0("\"", fields, "\"", collapse = ", "), ")")
- constructorArgs <- paste0(fields, " = NULL", collapse = ", ")
-
- classString <- c("#' @export",
- paste0(name, " <- R6::R6Class("),
- "",
- paste0("\t\"", name, "\","),
- "",
- "\tpublic = list(",
- paste0("\t\t", fields, " = NULL,"),
- "",
- paste0("\t\tinitialize = function(", constructorArgs, ") {"),
- paste0("\t\t\tself$", fields, " <- ", fields),
- "\t\t\t",
- paste0("\t\t\tprivate$classFields <- ", fieldsList),
- "\t\t},",
- "",
- "\t\ttoJSON = function() {",
- "\t\t\tfields <- sapply(private$classFields, function(field)",
- "\t\t\t{",
- "\t\t\t\tself[[field]]",
- "\t\t\t}, USE.NAMES = TRUE)",
- "\t\t\t",
- paste0("\t\t\tjsonlite::toJSON(list(\"", tolower(name), "\" = Filter(Negate(is.null), fields)), auto_unbox = TRUE)"),
- "\t\t}",
- "\t),",
- "",
- "\tprivate = list(",
- "\t\tclassFields = NULL",
- "\t),",
- "",
- "\tcloneable = FALSE",
- ")",
- "")
+ if(length(args) > 1)
+ {
+ args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
+ }
+
+ args[1] <- paste0(prependAtStart, args[1])
+ args[length(args)] <- paste0(args[length(args)], appendAtEnd)
+
+ argsLength <- length(args)
+ argLines <- list()
+ index <- 1
+
+ while(index <= argsLength)
+ {
+ line <- args[index]
+ index <- index + 1
+
+ while(nchar(line) < lineLength && index <= argsLength)
+ {
+ line <- paste(line, args[index])
+ index <- index + 1
+ }
+
+ argLines <- c(argLines, line)
+ }
+
+ argLines <- unlist(argLines)
+ argLinesLen <- length(argLines)
+
+ if(argLinesLen > 1)
+ argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
+
+ argLines
}
projects / arvados.git / blobdiff