[ARVADOS] updated: 1.1.3-151-g74d3e30
Git user
git at public.curoverse.com
Wed Mar 7 11:31:09 EST 2018
Summary of changes:
sdk/R/R/autoGenAPI.R | 437 ++++++++++++++++++++++++++-------------------------
1 file changed, 222 insertions(+), 215 deletions(-)
via 74d3e30605cc34564b2547cbb07dcfbd39e76f5c (commit)
from 4dde672661ea9dca680ec9eb1cdba7bd7d87fca7 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
commit 74d3e30605cc34564b2547cbb07dcfbd39e76f5c
Author: Fuad Muhic <fmuhic at capeannenterprises.com>
Date: Wed Mar 7 17:29:30 2018 +0100
Refactored autoGenApi to be more readable
Arvados-DCO-1.1-Signed-off-by: Fuad Muhic <fmuhic at capeannenterprises.com>
diff --git a/sdk/R/R/autoGenAPI.R b/sdk/R/R/autoGenAPI.R
index af758dd..2163e3a 100644
--- a/sdk/R/R/autoGenAPI.R
+++ b/sdk/R/R/autoGenAPI.R
@@ -1,6 +1,3 @@
-#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)
@@ -11,7 +8,7 @@ getAPIDocument <- function(){
#' @export
generateAPI <- function()
{
- #TODO: Consider passing discovery document URL as parameter
+ #TODO: Consider passing discovery document URL as parameter.
#TODO: Consider passing location where to create new files.
JSONDocument <- getAPIDocument()
@@ -19,19 +16,24 @@ generateAPI <- function()
generateArvadosAPIClass(JSONDocument)
}
+#NOTE: Arvados class generation:
+
generateArvadosAPIClass <- function(discoveryDocument)
{
- classMetaData <- discoveryDocument$schemas
- functionResources <- discoveryDocument$resources
- resourceNames <- names(functionResources)
+ classMetaData <- discoveryDocument$schemas
+ methodResources <- discoveryDocument$resources
+ resourceNames <- names(methodResources)
- doc <- generateMethodsDocumentation(functionResources, resourceNames)
+ doc <- generateMethodsDocumentation(methodResources, resourceNames)
arvadosAPIHeader <- generateAPIClassHeader()
- arvadosClassMethods <- generateClassContent(functionResources,
+ arvadosClassMethods <- generateClassContent(methodResources,
resourceNames, classMetaData)
arvadosAPIFooter <- generateAPIClassFooter()
- arvadosClass <- c(doc, arvadosAPIHeader, arvadosClassMethods, arvadosAPIFooter)
+ arvadosClass <- c(doc,
+ arvadosAPIHeader,
+ arvadosClassMethods,
+ arvadosAPIFooter)
#TODO: Save to a file or load in memory?
fileConn <- file("./R/Arvados.R", "w")
@@ -40,108 +42,97 @@ generateArvadosAPIClass <- function(discoveryDocument)
NULL
}
-generateClassContent <- function(functionResources, resourceNames, classMetaData)
+generateAPIClassHeader <- function()
{
- arvadosMethods <- Map(function(resource, resourceName)
- {
- methodNames <- names(resource$methods)
-
- functions <- Map(function(methodMetaData, methodName)
- {
- methodName <- paste0(resourceName, ".", methodName)
- createFunction(methodName, methodMetaData, classMetaData)
-
- }, resource$methods, methodNames)
-
- unlist(unname(functions))
-
- }, functionResources, resourceNames)
-
- arvadosMethods
+ 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")
}
-generateMethodsDocumentation <- function(functionResources, resourceNames)
+generateClassContent <- function(methodResources, resourceNames, classMetaData)
{
- arvadosMethods <- unlist(unname(Map(function(resource, resourceName)
+ arvadosMethods <- Map(function(resource, resourceName)
{
methodNames <- names(resource$methods)
functions <- Map(function(methodMetaData, methodName)
{
methodName <- paste0(resourceName, ".", methodName)
- getMethodDocumentation(methodName, methodMetaData)
+ createMethod(methodName, methodMetaData, classMetaData)
}, resource$methods, methodNames)
unlist(unname(functions))
- }, functionResources, resourceNames)))
-
- arvadosMethods
-}
-
-getMethodDocumentation <- function(methodName, methodMetaData)
-{
- 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.")
+ }, methodResources, resourceNames)
- c(description,
- "#' ",
- usage,
- params,
- returnValue,
- name,
- "NULL",
- "")
+ arvadosMethods
}
-getMethodUsage <- function(methodName, methodMetaData)
+generateAPIClassFooter <- function()
{
- args <- getFunctionArguments(methodMetaData)
- c(formatArgs(paste0("#' @usage arv$", methodName, "("), "#' \t", args, ")", 40))
+ 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",
+ ")")
}
-getMethodDescription <- function(methodMetaData)
+createMethod <- function(name, methodMetaData, classMetaData)
{
- request <- methodMetaData$request
- requestDoc <- NULL
-
- 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)
+ args <- getMethodArguments(methodMetaData)
+ signature <- getMethodSignature(name, args)
+ body <- getMethodBody(methodMetaData, classMetaData)
- argsDoc <- unname(unlist(sapply(argNames, function(argName)
- {
- arg <- methodMetaData$parameters[[argName]]
- argDescription <- arg$description
- paste("#' @param", argName, argDescription)
- })))
-
- c(requestDoc, argsDoc)
-}
-
-getFunctionName <- function(functionMetaData)
-{
- stringr::str_replace(functionMetaData$id, "arvados.", "")
+ 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
+ request <- methodMetaData$request
requestArgs <- NULL
if(!is.null(request))
@@ -152,11 +143,11 @@ getFunctionArguments <- function(functionMetaData)
requestArgs <- paste(names(request$properties), "=", "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)
{
@@ -172,17 +163,34 @@ getFunctionArguments <- function(functionMetaData)
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)
- errorCheck <- getErrorCheckingCode()
- returnObject <- getReturnObject(functionMetaData, classMetaData)
- returnStatement <- getReturnObjectValidationCode()
+ 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, ")"))
+ }
+}
+
+getMethodBody <- function(methodMetaData, classMetaData)
+{
+ url <- getRequestURL(methodMetaData)
+ headers <- getRequestHeaders()
+ requestQueryList <- getRequestQueryList(methodMetaData)
+ requestBody <- getRequestBody(methodMetaData)
+ request <- getRequest(methodMetaData)
+ response <- getResponse(methodMetaData)
+ errorCheck <- getErrorCheckingCode()
+ returnObject <- getReturnObject(methodMetaData, classMetaData)
+ returnStatement <- getReturnObjectValidationCode()
body <- c(url,
headers,
@@ -196,22 +204,40 @@ getFunctionBody <- function(functionMetaData, classMetaData)
paste0("\t\t\t", body)
}
-getReturnObjectValidationCode <- function()
+getRequestURL <- function(methodMetaData)
{
- c("if(result$isEmpty())",
- "\tresource",
- "else",
- "\tresult")
+ endPoint <- methodMetaData$path
+ endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
+ url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
+ paste0("url <- paste0(private$host, endPoint)"))
+ url
}
-getErrorCheckingCode <- function()
+getRequestHeaders <- function()
{
- c("if(!is.null(resource$errors))", "\tstop(resource$errors)")
+ c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
+ " \"Content-Type\" = \"application/json\")")
+}
+
+getRequestQueryList <- function(methodMetaData)
+{
+ args <- names(methodMetaData$parameters)
+
+ if(length(args) == 0)
+ return("queryArgs <- NULL")
+
+ args <- sapply(args, function(arg) paste0(arg, " = ", arg))
+ collapsedArgs <- paste0(args, collapse = ", ")
+
+ if(nchar(collapsedArgs) > 40)
+ return(formatArgs("queryArgs <- list(", "\t", args, ")", 40))
+ else
+ return(paste0("queryArgs <- list(", collapsedArgs, ")"))
}
-getRequestBody <- function(functionMetaData)
+getRequestBody <- function(methodMetaData)
{
- request <- functionMetaData$request
+ request <- methodMetaData$request
if(is.null(request) || !request$required)
return("body <- NULL")
@@ -220,15 +246,27 @@ getRequestBody <- function(functionMetaData)
paste0("body <- ", requestParameterName, "$toJSON()")
}
-getRequestHeaders <- function()
+getRequest <- function(methodMetaData)
{
- c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
- " \"Content-Type\" = \"application/json\")")
+ method <- methodMetaData$httpMethod
+ c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
+ " queryArgs, private$numRetries)")
}
-getReturnObject <- function(functionMetaData, classMetaData)
+getResponse <- function(methodMetaData)
{
- returnClass <- functionMetaData$response[["$ref"]]
+ "resource <- private$REST$httpParser$parseJSONResponse(response)"
+}
+
+getErrorCheckingCode <- function()
+{
+ c("if(!is.null(resource$errors))",
+ "\tstop(resource$errors)")
+}
+
+getReturnObject <- function(methodMetaData, classMetaData)
+{
+ returnClass <- methodMetaData$response[["$ref"]]
classArguments <- getReturnClassArguments(returnClass, classMetaData)
if(returnClass == "Collection")
@@ -241,6 +279,14 @@ getReturnObject <- function(functionMetaData, classMetaData)
"\t", classArguments, ")", 40)
}
+getReturnObjectValidationCode <- function()
+{
+ c("if(result$isEmpty())",
+ "\tresource",
+ "else",
+ "\tresult")
+}
+
getReturnClassArguments <- function(className, classMetaData)
{
classArguments <- unique(names(classMetaData[[className]]$properties))
@@ -253,124 +299,84 @@ getReturnClassArguments <- function(className, classMetaData)
arguments
}
-getRequest <- function(functionMetaData)
-{
- method <- functionMetaData$httpMethod
- c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
- " queryArgs, private$numRetries)")
-}
-getResponse <- function(functionMetaData)
-{
- "resource <- private$REST$httpParser$parseJSONResponse(response)"
-}
+#NOTE: Arvados class documentation:
-getRequestURL <- function(functionMetaData)
+generateMethodsDocumentation <- function(methodResources, resourceNames)
{
- endPoint <- functionMetaData$path
- endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
- url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
- paste0("url <- paste0(private$host, endPoint)"))
- url
-}
+ methodsDoc <- unlist(unname(Map(function(resource, resourceName)
+ {
+ methodNames <- names(resource$methods)
-getRequestQueryList <- function(functionMetaData)
-{
- args <- names(functionMetaData$parameters)
+ methodDoc <- Map(function(methodMetaData, methodName)
+ {
+ methodName <- paste0(resourceName, ".", methodName)
+ getMethodDocumentation(methodName, methodMetaData)
- if(length(args) == 0)
- return("queryArgs <- NULL")
+ }, resource$methods, methodNames)
- args <- sapply(args, function(arg) paste0(arg, " = ", arg))
- collapsedArgs <- paste0(args, collapse = ", ")
+ unlist(unname(methodDoc))
- if(nchar(collapsedArgs) > 40)
- return(formatArgs("queryArgs <- list(", "\t", args, ")", 40))
- else
- return(paste0("queryArgs <- list(", collapsedArgs, ")"))
+ }, methodResources, resourceNames)))
+
+ methodsDoc
}
-createFunction <- function(functionName, functionMetaData, classMetaData)
+getMethodDocumentation <- function(methodName, methodMetaData)
{
- args <- getFunctionArguments(functionMetaData)
- body <- getFunctionBody(functionMetaData, classMetaData)
- funSignature <- getFunSignature(functionName, args)
+ 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(funSignature,
- "\t\t{",
- body,
- "\t\t},\n")
+ c(description,
+ "#' ",
+ usage,
+ params,
+ returnValue,
+ name,
+ "NULL",
+ "")
}
-getFunSignature <- function(funName, args)
+getMethodUsage <- function(methodName, methodMetaData)
{
- collapsedArgs <- paste0(args, collapse = ", ")
+ lineLengthLimit <- 40
+ args <- getMethodArguments(methodMetaData)
+ c(formatArgs(paste0("#' @usage arv$", methodName,
+ "("), "#' \t", args, ")", lineLengthLimit))
+}
- if(nchar(collapsedArgs) > 40)
+getMethodDescription <- function(methodMetaData)
+{
+ request <- methodMetaData$request
+ requestDoc <- NULL
+
+ if(!is.null(request))
{
- return(paste0("\t\t",
- formatArgs(paste(funName, "= function("),
- "\t", args, ")", 40)))
+ 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.")
+ })))
}
- else
+
+ argNames <- names(methodMetaData$parameters)
+
+ argsDoc <- unname(unlist(sapply(argNames, function(argName)
{
- return(paste0("\t\t", funName, " = function(", collapsedArgs, ")"))
- }
-}
+ arg <- methodMetaData$parameters[[argName]]
+ argDescription <- arg$description
+ paste("#' @param", argName, argDescription)
+ })))
-generateAPIClassHeader <- function()
-{
- 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")
+ c(requestDoc, argsDoc)
}
-generateAPIClassFooter <- function()
-{
- 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",
- ")")
-}
+#NOTE: API Classes generation:
generateArvadosClasses <- function(resources)
{
@@ -382,8 +388,6 @@ generateArvadosClasses <- function(resources)
}, USE.NAMES = TRUE)
- unlist(unname(classes))
-
fileConn <- file("./R/ArvadosClasses.R", "w")
writeLines(unlist(classes), fileConn)
close(fileConn)
@@ -392,10 +396,10 @@ generateArvadosClasses <- function(resources)
getArvadosClass <- function(classSchema)
{
- name <- classSchema$id
- fields <- unique(names(classSchema$properties))
+ name <- classSchema$id
+ fields <- unique(names(classSchema$properties))
constructorArgs <- paste(fields, "= NULL")
- documentation <- getClassDocumentation(classSchema, constructorArgs)
+ documentation <- getClassDocumentation(classSchema, constructorArgs)
classString <- c(documentation,
paste0(name, " <- R6::R6Class("),
@@ -445,10 +449,12 @@ getArvadosClass <- function(classSchema)
"")
}
+#NOTE: API Classes documentation:
+
getClassDocumentation <- function(classSchema, constructorArgs)
{
- name <- classSchema$id
- description <- classSchema$description
+ name <- classSchema$id
+ description <- classSchema$description
nameLowercaseFirstLetter <- paste0(tolower(substr(name, 1, 1)),
substr(name, 2, nchar(name)))
c(paste0("#' ", name),
@@ -459,7 +465,6 @@ getClassDocumentation <- function(classSchema, constructorArgs)
formatArgs(paste0("#' \\preformatted{",
nameLowercaseFirstLetter, " -> ", name, "$new("),
"#' \t", constructorArgs, ")", 50),
-
"#' }",
"#' ",
paste0("#' @section Arguments:"),
@@ -483,6 +488,8 @@ getClassArgumentDescription <- function(classSchema)
paste0("\\item{", names(classSchema$properties), "}", argDoc)
}
+#NOTE: Utility functions:
+
formatArgs <- function(prependAtStart, prependToEachSplit,
args, appendAtEnd, lineLength)
{
-----------------------------------------------------------------------
hooks/post-receive
--
More information about the arvados-commits
mailing list