X-Git-Url: https://git.arvados.org/arvados.git/blobdiff_plain/add8af3272303972fceb3ec35eeedeb2ca8b4af3..8e43dcf899a3322e66c709b149ce557f5255bf18:/sdk/R/R/autoGenAPI.R diff --git a/sdk/R/R/autoGenAPI.R b/sdk/R/R/autoGenAPI.R index 8dadd75cda..c86684f8b0 100644 --- a/sdk/R/R/autoGenAPI.R +++ b/sdk/R/R/autoGenAPI.R @@ -1,5 +1,9 @@ +# 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" + url <- "https://jutro.arvadosapi.com/discovery/v1/apis/arvados/v1/rest" serverResponse <- httr::RETRY("GET", url = url) httr::content(serverResponse, as = "parsed", type = "application/json") @@ -13,30 +17,39 @@ generateAPI <- function() discoveryDocument <- getAPIDocument() methodResources <- discoveryDocument$resources + + # Don't emit deprecated APIs + methodResources <- methodResources[!(names(methodResources) %in% c("jobs", "job_tasks", "pipeline_templates", "pipeline_instances", + "keep_disks", "nodes", "humans", "traits", "specimens"))] resourceNames <- names(methodResources) - doc <- generateMethodsDocumentation(methodResources, resourceNames) - arvadosAPIHeader <- generateAPIClassHeader() - arvadosProjectMethods <- generateProjectMethods() - arvadosClassMethods <- generateClassContent(methodResources, resourceNames) - 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) fileConn <- file("./R/Arvados.R", "w") + writeLines(c( + "# Copyright (C) The Arvados Authors. All rights reserved.", + "#", + "# SPDX-License-Identifier: Apache-2.0", ""), fileConn) writeLines(unlist(arvadosClass), fileConn) close(fileConn) NULL } -generateAPIClassHeader <- function() +genAPIClassHeader <- function() { - c("#' @export", - "Arvados <- R6::R6Class(", + c("Arvados <- R6::R6Class(", "", "\t\"Arvados\",", "", @@ -68,26 +81,26 @@ generateAPIClassHeader <- function() "\t\t},\n") } -generateProjectMethods <- function() +genProjectMethods <- function() { - c("\t\tproject.get = function(uuid)", + c("\t\tprojects.get = function(uuid)", "\t\t{", "\t\t\tself$groups.get(uuid)", "\t\t},", "", - "\t\tproject.create = function(group, ensure_unique_name = \"false\")", + "\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\tproject.update = function(group, uuid)", + "\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\tproject.list = function(filters = NULL, where = NULL,", + "\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)", @@ -97,14 +110,14 @@ generateProjectMethods <- function() "\t\t\t limit, offset, count, include_trash)", "\t\t},", "", - "\t\tproject.delete = function(uuid)", + "\t\tprojects.delete = function(uuid)", "\t\t{", "\t\t\tself$groups.delete(uuid)", "\t\t},", "") } -generateClassContent <- function(methodResources, resourceNames) +genClassContent <- function(methodResources, resourceNames) { arvadosMethods <- Map(function(resource, resourceName) { @@ -112,6 +125,12 @@ generateClassContent <- function(methodResources, resourceNames) 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) @@ -124,7 +143,7 @@ generateClassContent <- function(methodResources, resourceNames) arvadosMethods } -generateAPIClassFooter <- function() +genAPIClassFooter <- function() { c("\t\tgetHostName = function() private$host,", "\t\tgetToken = function() private$token,", @@ -241,7 +260,7 @@ getRequestURL <- function(methodMetaData) getRequestHeaders <- function() { - c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ", + c("headers <- list(Authorization = paste(\"Bearer\", private$token), ", " \"Content-Type\" = \"application/json\")") } @@ -308,7 +327,7 @@ getReturnObject <- function() #NOTE: Arvados class documentation: -generateMethodsDocumentation <- function(methodResources, resourceNames) +genMethodsDoc <- function(methodResources, resourceNames) { methodsDoc <- unlist(unname(Map(function(resource, resourceName) { @@ -316,19 +335,87 @@ generateMethodsDocumentation <- function(methodResources, resourceNames) 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) @@ -336,7 +423,9 @@ getMethodDocumentation <- function(methodName, methodMetaData) params <- getMethodDescription(methodMetaData) returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.") - c(description, + c(paste("#'", methodName), + "#' ", + description, "#' ", usage, params, @@ -366,7 +455,7 @@ getMethodDescription <- function(methodMetaData) 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.") }))) } @@ -376,12 +465,81 @@ getMethodDescription <- function(methodMetaData) { arg <- methodMetaData$parameters[[argName]] argDescription <- arg$description - paste("#' @param", argName, argDescription) + paste("#' @param", argName, argDescription) }))) c(requestDoc, argsDoc) } +genProjectMethodsDoc <- function() +{ + #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. @@ -391,7 +549,7 @@ formatArgs <- function(prependAtStart, prependToEachSplit, { 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]) @@ -414,12 +572,12 @@ formatArgs <- function(prependAtStart, prependToEachSplit, 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 }