+# Copyright (C) The Arvados Authors. All rights reserved.
+#
+# SPDX-License-Identifier: Apache-2.0
+
getAPIDocument <- function(){
url <- "https://4xphq.arvadosapi.com/discovery/v1/apis/arvados/v1/rest"
serverResponse <- httr::RETRY("GET", url = url)
{
#TODO: Consider passing discovery document URL as parameter.
#TODO: Consider passing location where to create new files.
- JSONDocument <- getAPIDocument()
-
- generateArvadosClasses(JSONDocument)
- generateArvadosAPIClass(JSONDocument)
-}
+ discoveryDocument <- getAPIDocument()
-#NOTE: Arvados class generation:
-
-generateArvadosAPIClass <- function(discoveryDocument)
-{
- classMetaData <- discoveryDocument$schemas
methodResources <- discoveryDocument$resources
resourceNames <- names(methodResources)
- doc <- generateMethodsDocumentation(methodResources, resourceNames)
- arvadosAPIHeader <- generateAPIClassHeader()
- arvadosClassMethods <- generateClassContent(methodResources,
- resourceNames, classMetaData)
- arvadosAPIFooter <- generateAPIClassFooter()
+ methodDoc <- genMethodsDoc(methodResources, resourceNames)
+ classDoc <- genAPIClassDoc(methodResources, resourceNames)
+ arvadosAPIHeader <- genAPIClassHeader()
+ arvadosProjectMethods <- genProjectMethods()
+ arvadosClassMethods <- genClassContent(methodResources, resourceNames)
+ arvadosAPIFooter <- genAPIClassFooter()
- arvadosClass <- c(doc,
+ arvadosClass <- c(methodDoc,
+ classDoc,
arvadosAPIHeader,
+ arvadosProjectMethods,
arvadosClassMethods,
arvadosAPIFooter)
- #TODO: Save to a file or load in memory?
fileConn <- file("./R/Arvados.R", "w")
writeLines(unlist(arvadosClass), fileConn)
close(fileConn)
NULL
}
-generateAPIClassHeader <- function()
+genAPIClassHeader <- function()
{
- c("#' @export",
- "Arvados <- R6::R6Class(",
+ c("Arvados <- R6::R6Class(",
"",
"\t\"Arvados\",",
"",
"\t\t},\n")
}
-generateClassContent <- function(methodResources, resourceNames, classMetaData)
+genProjectMethods <- function()
+{
+ c("\t\tprojects.get = function(uuid)",
+ "\t\t{",
+ "\t\t\tself$groups.get(uuid)",
+ "\t\t},",
+ "",
+ "\t\tprojects.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\tprojects.update = function(group, uuid)",
+ "\t\t{",
+ "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
+ "\t\t\tself$groups.update(group, uuid)",
+ "\t\t},",
+ "",
+ "\t\tprojects.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\tprojects.delete = function(uuid)",
+ "\t\t{",
+ "\t\t\tself$groups.delete(uuid)",
+ "\t\t},",
+ "")
+}
+
+genClassContent <- function(methodResources, resourceNames)
{
arvadosMethods <- Map(function(resource, resourceName)
{
functions <- Map(function(methodMetaData, methodName)
{
+ #NOTE: Index, show and destroy are aliases for the preferred names
+ # "list", "get" and "delete". Until they are removed from discovery
+ # document we will filter them here.
+ if(methodName %in% c("index", "show", "destroy"))
+ return(NULL)
+
methodName <- paste0(resourceName, ".", methodName)
- createMethod(methodName, methodMetaData, classMetaData)
+ createMethod(methodName, methodMetaData)
}, resource$methods, methodNames)
arvadosMethods
}
-generateAPIClassFooter <- function()
+genAPIClassFooter <- function()
{
c("\t\tgetHostName = function() private$host,",
"\t\tgetToken = function() private$token,",
- "\t\tsetRESTService = function(newREST) private$REST <- newREST",
+ "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
+ "\t\tgetRESTService = function() private$REST",
"\t),",
"",
"\tprivate = list(",
")")
}
-createMethod <- function(name, methodMetaData, classMetaData)
+createMethod <- function(name, methodMetaData)
{
args <- getMethodArguments(methodMetaData)
signature <- getMethodSignature(name, args)
- body <- getMethodBody(methodMetaData, classMetaData)
+ body <- getMethodBody(methodMetaData)
c(signature,
"\t\t{",
"\t\t},\n")
}
-#TODO: Make sure that arguments that are required always go first.
-# This is not the case if request$required is false.
getMethodArguments <- function(methodMetaData)
{
request <- methodMetaData$request
if(!is.null(request))
{
+ resourceName <- tolower(request$properties[[1]][[1]])
+
if(request$required)
- requestArgs <- names(request$properties)
+ requestArgs <- resourceName
else
- requestArgs <- paste(names(request$properties), "=", "NULL")
+ requestArgs <- paste(resourceName, "=", "NULL")
}
argNames <- names(methodMetaData$parameters)
}
}
-getMethodBody <- function(methodMetaData, classMetaData)
+getMethodBody <- function(methodMetaData)
{
url <- getRequestURL(methodMetaData)
headers <- getRequestHeaders()
request <- getRequest(methodMetaData)
response <- getResponse(methodMetaData)
errorCheck <- getErrorCheckingCode()
- returnObject <- getReturnObject(methodMetaData, classMetaData)
- returnStatement <- getReturnObjectValidationCode()
+ returnStatement <- getReturnObject()
body <- c(url,
headers,
- requestQueryList,
+ requestQueryList, "",
requestBody, "",
request, response, "",
errorCheck, "",
- returnObject, "",
returnStatement)
paste0("\t\t\t", body)
getRequestQueryList <- function(methodMetaData)
{
- args <- names(methodMetaData$parameters)
+ queryArgs <- names(Filter(function(arg) arg$location == "query",
+ methodMetaData$parameters))
- if(length(args) == 0)
+ if(length(queryArgs) == 0)
return("queryArgs <- NULL")
- args <- sapply(args, function(arg) paste0(arg, " = ", arg))
- collapsedArgs <- paste0(args, collapse = ", ")
+ queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
+ collapsedArgs <- paste0(queryArgs, collapse = ", ")
- if(nchar(collapsedArgs) > 40)
- return(formatArgs("queryArgs <- list(", "\t", args, ")", 40))
+ lineLengthLimit <- 40
+
+ if(nchar(collapsedArgs) > lineLengthLimit)
+ return(formatArgs("queryArgs <- list(", "\t\t\t\t ", queryArgs, ")",
+ lineLengthLimit))
else
return(paste0("queryArgs <- list(", collapsedArgs, ")"))
}
if(is.null(request) || !request$required)
return("body <- NULL")
+ resourceName <- tolower(request$properties[[1]][[1]])
+
requestParameterName <- names(request$properties)[1]
- paste0("body <- ", requestParameterName, "$toJSON()")
+
+ c(paste0("if(length(", resourceName, ") > 0)"),
+ paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
+ "\t auto_unbox = TRUE)",
+ "else",
+ "\tbody <- NULL")
}
getRequest <- function(methodMetaData)
"\tstop(resource$errors)")
}
-getReturnObject <- function(methodMetaData, classMetaData)
+getReturnObject <- function()
{
- returnClass <- methodMetaData$response[["$ref"]]
- classArguments <- getReturnClassArguments(returnClass, classMetaData)
-
- if(returnClass == "Collection")
- return(c(formatArgs("result <- Collection$new(", "\t",
- classArguments, ")", 40),
- "",
- "result$setRESTService(private$REST)"))
-
- formatArgs(paste0("result <- ", returnClass, "$new("),
- "\t", classArguments, ")", 40)
-}
-
-getReturnObjectValidationCode <- function()
-{
- c("if(result$isEmpty())",
- "\tresource",
- "else",
- "\tresult")
-}
-
-getReturnClassArguments <- function(className, classMetaData)
-{
- classArguments <- unique(names(classMetaData[[className]]$properties))
-
- arguments <- sapply(classArguments, function(arg)
- {
- paste0(arg, " = resource$", arg)
- })
-
- arguments
+ "resource"
}
-
#NOTE: Arvados class documentation:
-generateMethodsDocumentation <- function(methodResources, resourceNames)
+genMethodsDoc <- function(methodResources, resourceNames)
{
methodsDoc <- unlist(unname(Map(function(resource, resourceName)
{
methodDoc <- Map(function(methodMetaData, methodName)
{
+ #NOTE: Index, show and destroy are aliases for the preferred names
+ # "list", "get" and "delete". Until they are removed from discovery
+ # document we will filter them here.
+ if(methodName %in% c("index", "show", "destroy"))
+ return(NULL)
+
methodName <- paste0(resourceName, ".", methodName)
- getMethodDocumentation(methodName, methodMetaData)
+ getMethodDoc(methodName, methodMetaData)
}, resource$methods, methodNames)
unlist(unname(methodDoc))
}, methodResources, resourceNames)))
-
- methodsDoc
+
+ projectDoc <- genProjectMethodsDoc()
+
+ c(methodsDoc, projectDoc)
+}
+
+genAPIClassDoc <- function(methodResources, resourceNames)
+{
+ c("#' Arvados",
+ "#'",
+ "#' Arvados class gives users ability to access Arvados REST API.",
+ "#'" ,
+ "#' @section Usage:",
+ "#' \\preformatted{arv = Arvados$new(authToken = NULL, hostName = NULL, numRetries = 0)}",
+ "#'",
+ "#' @section Arguments:",
+ "#' \\describe{",
+ "#' \t\\item{authToken}{Authentification token. If not specified ARVADOS_API_TOKEN environment variable will be used.}",
+ "#' \t\\item{hostName}{Host name. If not specified ARVADOS_API_HOST environment variable will be used.}",
+ "#' \t\\item{numRetries}{Number which specifies how many times to retry failed service requests.}",
+ "#' }",
+ "#'",
+ "#' @section Methods:",
+ "#' \\describe{",
+ getAPIClassMethodList(methodResources, resourceNames),
+ "#' }",
+ "#'",
+ "#' @name Arvados",
+ "#' @examples",
+ "#' \\dontrun{",
+ "#' arv <- Arvados$new(\"your Arvados token\", \"example.arvadosapi.com\")",
+ "#'",
+ "#' collection <- arv$collections.get(\"uuid\")",
+ "#'",
+ "#' collectionList <- arv$collections.list(list(list(\"name\", \"like\", \"Test%\")))",
+ "#' collectionList <- listAll(arv$collections.list, list(list(\"name\", \"like\", \"Test%\")))",
+ "#'",
+ "#' deletedCollection <- arv$collections.delete(\"uuid\")",
+ "#'",
+ "#' updatedCollection <- arv$collections.update(list(name = \"New name\", description = \"New description\"),",
+ "#' \"uuid\")",
+ "#'",
+ "#' createdCollection <- arv$collections.create(list(name = \"Example\",",
+ "#' description = \"This is a test collection\"))",
+ "#' }",
+ "NULL",
+ "",
+ "#' @export")
+}
+
+getAPIClassMethodList <- function(methodResources, resourceNames)
+{
+ methodList <- unlist(unname(Map(function(resource, resourceName)
+ {
+ methodNames <- names(resource$methods)
+ paste0(resourceName,
+ ".",
+ methodNames[!(methodNames %in% c("index", "show", "destroy"))])
+
+ }, methodResources, resourceNames)))
+
+ hardcodedMethods <- c("projects.create", "projects.get",
+ "projects.list", "projects.update", "projects.delete")
+ paste0("#' \t\\item{}{\\code{\\link{", sort(c(methodList, hardcodedMethods)), "}}}")
}
-getMethodDocumentation <- function(methodName, methodMetaData)
+getMethodDoc <- function(methodName, methodMetaData)
{
name <- paste("#' @name", methodName)
usage <- getMethodUsage(methodName, methodMetaData)
params <- getMethodDescription(methodMetaData)
returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
- c(description,
+ c(paste("#'", methodName),
+ "#' ",
+ description,
"#' ",
usage,
params,
className <- sapply(prop, function(ref) ref)
objectName <- paste0(tolower(substr(className, 1, 1)),
substr(className, 2, nchar(className)))
- paste("#' @param", objectName, className, "object.")
+ paste("#' @param", objectName, className, "object.")
})))
}
{
arg <- methodMetaData$parameters[[argName]]
argDescription <- arg$description
- paste("#' @param", argName, argDescription)
+ paste("#' @param", argName, argDescription)
})))
c(requestDoc, argsDoc)
}
-#NOTE: API Classes generation:
-
-generateArvadosClasses <- function(resources)
-{
- classes <- sapply(resources$schemas, function(classSchema)
- {
- #NOTE: Collection is implemented manually.
- if(classSchema$id != "Collection")
- getArvadosClass(classSchema)
-
- }, USE.NAMES = TRUE)
-
- fileConn <- file("./R/ArvadosClasses.R", "w")
- writeLines(unlist(classes), fileConn)
- close(fileConn)
- NULL
-}
-
-getArvadosClass <- function(classSchema)
+genProjectMethodsDoc <- function()
{
- name <- classSchema$id
- fields <- unique(names(classSchema$properties))
- constructorArgs <- paste(fields, "= NULL")
- documentation <- getClassDocumentation(classSchema, constructorArgs)
-
- classString <- c(documentation,
- paste0(name, " <- R6::R6Class("),
- "",
- paste0("\t\"", name, "\","),
- "",
- "\tpublic = list(",
- paste0("\t\t", fields, " = NULL,"),
- "",
- paste0("\t\t", formatArgs("initialize = function(", "\t\t",
- constructorArgs, ")", 40)),
- "\t\t{",
- paste0("\t\t\tself$", fields, " <- ", fields),
- "\t\t\t",
- paste0("\t\t\t", formatArgs("private$classFields <- c(", "\t",
- paste0("\"", fields, "\""), ")", 40)),
- "\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\tisEmpty = function() {",
- "\t\t\tfields <- sapply(private$classFields,",
- "\t\t\t function(field) self[[field]])",
- "",
- paste0("\t\t\tif(any(sapply(fields, function(field) !is.null(field)",
- " && field != \"\")))"),
- "\t\t\t\tFALSE",
- "\t\t\telse",
- "\t\t\t\tTRUE",
- "\t\t}",
- "\t),",
- "",
- "\tprivate = list(",
- "\t\tclassFields = NULL",
- "\t),",
- "",
- "\tcloneable = FALSE",
- ")",
- "")
-}
-
-#NOTE: API Classes documentation:
-
-getClassDocumentation <- function(classSchema, constructorArgs)
-{
- name <- classSchema$id
- description <- classSchema$description
- nameLowercaseFirstLetter <- paste0(tolower(substr(name, 1, 1)),
- substr(name, 2, nchar(name)))
- c(paste0("#' ", name),
- "#' ",
- paste0("#' ", description),
- "#' ",
- "#' @section Usage:",
- formatArgs(paste0("#' \\preformatted{",
- nameLowercaseFirstLetter, " -> ", name, "$new("),
- "#' \t", constructorArgs, ")", 50),
- "#' }",
- "#' ",
- paste0("#' @section Arguments:"),
- "#' \\describe{",
- paste0("#' ", getClassArgumentDescription(classSchema)),
- "#' }",
- "#' ",
- paste0("#' @name ", name),
- "NULL",
- "",
- "#' @export")
-}
-
-getClassArgumentDescription <- function(classSchema)
-{
- argDoc <- sapply(classSchema$properties, function(arg)
- {
- paste0("{", arg$description, "}")
- }, USE.NAMES = TRUE)
-
- paste0("\\item{", names(classSchema$properties), "}", argDoc)
+ #TODO: Manually update this documentation to reflect changes in discovery document.
+ c("#' project.get",
+ "#' ",
+ "#' projects.get is equivalent to groups.get method.",
+ "#' ",
+ "#' @usage arv$projects.get(uuid)",
+ "#' @param uuid The UUID of the Group in question.",
+ "#' @return Group object.",
+ "#' @name projects.get",
+ "NULL",
+ "",
+ "#' project.create",
+ "#' ",
+ "#' projects.create wrapps groups.create method by setting group_class attribute to \"project\".",
+ "#' ",
+ "#' @usage arv$projects.create(group, ensure_unique_name = \"false\")",
+ "#' @param group Group object.",
+ "#' @param ensure_unique_name Adjust name to ensure uniqueness instead of returning an error on (owner_uuid, name) collision.",
+ "#' @return Group object.",
+ "#' @name projects.create",
+ "NULL",
+ "",
+ "#' project.update",
+ "#' ",
+ "#' projects.update wrapps groups.update method by setting group_class attribute to \"project\".",
+ "#' ",
+ "#' @usage arv$projects.update(group, uuid)",
+ "#' @param group Group object.",
+ "#' @param uuid The UUID of the Group in question.",
+ "#' @return Group object.",
+ "#' @name projects.update",
+ "NULL",
+ "",
+ "#' project.delete",
+ "#' ",
+ "#' projects.delete is equivalent to groups.delete method.",
+ "#' ",
+ "#' @usage arv$project.delete(uuid)",
+ "#' @param uuid The UUID of the Group in question.",
+ "#' @return Group object.",
+ "#' @name projects.delete",
+ "NULL",
+ "",
+ "#' project.list",
+ "#' ",
+ "#' projects.list wrapps groups.list method by setting group_class attribute to \"project\".",
+ "#' ",
+ "#' @usage arv$projects.list(filters = NULL,",
+ "#' where = NULL, order = NULL, distinct = NULL,",
+ "#' limit = \"100\", offset = \"0\", count = \"exact\",",
+ "#' include_trash = NULL, uuid = NULL, recursive = NULL)",
+ "#' @param filters ",
+ "#' @param where ",
+ "#' @param order ",
+ "#' @param distinct ",
+ "#' @param limit ",
+ "#' @param offset ",
+ "#' @param count ",
+ "#' @param include_trash Include items whose is_trashed attribute is true.",
+ "#' @param uuid ",
+ "#' @param recursive Include contents from child groups recursively.",
+ "#' @return Group object.",
+ "#' @name projects.list",
+ "NULL",
+ "")
}
#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)
{
if(length(args) > 1)
{
- args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
+ args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
}
args[1] <- paste0(prependAtStart, args[1])
argLines <- c(argLines, line)
}
-
+
argLines <- unlist(argLines)
argLinesLen <- length(argLines)
if(argLinesLen > 1)
- argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
+ argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
argLines
}
projects / arvados.git / blobdiff