sdk/R/generateApi.R

   1 # Copyright (C) The Arvados Authors. All rights reserved.
   2 #
   3 # SPDX-License-Identifier: Apache-2.0
   4
   5 library(jsonlite)
   6
   7 getAPIDocument <- function(loc)
   8 {
   9     if (length(grep("^[a-z]+://", loc)) > 0) {
  10         library(httr)
  11         serverResponse <- httr::RETRY("GET", url = loc)
  12         httr::content(serverResponse, as = "parsed", type = "application/json")
  13     } else {
  14         jsonlite::read_json(loc)
  15     }
  16 }
  17
  18 #' generateAPI
  19 #'
  20 #' Autogenerate classes to interact with Arvados from the Arvados discovery document.
  21 #'
  22 #' @export
  23 generateAPI <- function(discoveryDocument)
  24 {
  25     methodResources <- discoveryDocument$resources
  26     resourceNames   <- names(methodResources)
  27
  28     classDoc <- genAPIClassDoc(methodResources, resourceNames)
  29     arvadosAPIHeader <- genAPIClassHeader()
  30     arvadosClassMethods <- genClassContent(methodResources, resourceNames)
  31     arvadosProjectMethods <- genProjectMethods(methodResources)
  32     arvadosAPIFooter <- genAPIClassFooter()
  33
  34     arvadosClass <- c(classDoc,
  35                       arvadosAPIHeader,
  36                       arvadosClassMethods,
  37                       arvadosProjectMethods,
  38                       arvadosAPIFooter)
  39
  40     fileConn <- file("./R/Arvados.R", "w")
  41     writeLines(c(
  42     "# Copyright (C) The Arvados Authors. All rights reserved.",
  43     "#",
  44     "# SPDX-License-Identifier: Apache-2.0",
  45     "",
  46     "#' Arvados",
  47     "#'",
  48     "#' This class implements a full REST client to the Arvados API.",
  49     "#'"), fileConn)
  50     writeLines(unlist(arvadosClass), fileConn)
  51     close(fileConn)
  52     NULL
  53 }
  54
  55 genAPIClassHeader <- function()
  56 {
  57     c("#' @export",
  58       "Arvados <- R6::R6Class(",
  59       "",
  60       "\t\"Arvados\",",
  61       "",
  62       "\tpublic = list(",
  63       "",
  64       "\t\t#' @description Create a new Arvados API client.",
  65       "\t\t#' @param authToken Authentification token. If not specified ARVADOS_API_TOKEN environment variable will be used.",
  66       "\t\t#' @param hostName Host name. If not specified ARVADOS_API_HOST environment variable will be used.",
  67       "\t\t#' @param numRetries Number which specifies how many times to retry failed service requests.",
  68       "\t\t#' @return A new `Arvados` object.",
  69       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
  70       "\t\t{",
  71       "\t\t\tif(!is.null(hostName))",
  72       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
  73       "",
  74       "\t\t\tif(!is.null(authToken))",
  75       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
  76       "",
  77       "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
  78       "\t\t\ttoken    <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
  79       "",
  80       "\t\t\tif(hostName == \"\" | token == \"\")",
  81       "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
  82       "\t\t\t\t\t\t   \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
  83       "\t\t\t\t\t\t   \"environment variables.\"))",
  84       "",
  85       "\t\t\tprivate$token <- token",
  86       "\t\t\tprivate$host  <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
  87       "\t\t\tprivate$numRetries <- numRetries",
  88       "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
  89       "\t\t\t                                HttpRequest$new(), HttpParser$new(),",
  90       "\t\t\t                                numRetries)",
  91       "",
  92       "\t\t},\n")
  93 }
  94
  95 genProjectMethods <- function(methodResources)
  96 {
  97     toCallArg <- function(arg) {
  98         callArg <- strsplit(arg, " *=")[[1]][1]
  99         paste(callArg, callArg, sep=" = ")
 100     }
 101     toCallArgs <- function(argList) {
 102         paste0(Map(toCallArg, argList), collapse=", ")
 103     }
 104     groupsMethods <- methodResources[["groups"]][["methods"]]
 105     getArgs <- getMethodArguments(groupsMethods[["get"]])
 106     createArgs <- getMethodArguments(groupsMethods[["create"]])
 107     updateArgs <- getMethodArguments(groupsMethods[["update"]])
 108     listArgs <- getMethodArguments(groupsMethods[["list"]])
 109     deleteArgs <- getMethodArguments(groupsMethods[["delete"]])
 110
 111     c("\t\t#' @description An alias for `groups_get`.",
 112       getMethodParams(groupsMethods[["get"]]),
 113       "\t\t#' @return A Group object.",
 114       getMethodSignature("project_get", getArgs),
 115       "\t\t{",
 116       paste("\t\t\tself$groups_get(", toCallArgs(getArgs), ")", sep=""),
 117       "\t\t},",
 118       "",
 119       "\t\t#' @description A wrapper for `groups_create` that sets `group_class=\"project\"`.",
 120       getMethodParams(groupsMethods[["create"]]),
 121       "\t\t#' @return A Group object.",
 122       getMethodSignature("project_create", createArgs),
 123       "\t\t{",
 124       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
 125       paste("\t\t\tself$groups_create(", toCallArgs(createArgs), ")", sep=""),
 126       "\t\t},",
 127       "",
 128       "\t\t#' @description A wrapper for `groups_update` that sets `group_class=\"project\"`.",
 129       getMethodParams(groupsMethods[["update"]]),
 130       "\t\t#' @return A Group object.",
 131       getMethodSignature("project_update", updateArgs),
 132       "\t\t{",
 133       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
 134       paste("\t\t\tself$groups_update(", toCallArgs(updateArgs), ")", sep=""),
 135       "\t\t},",
 136       "",
 137       "\t\t#' @description A wrapper for `groups_list` that adds a filter for `group_class=\"project\"`.",
 138       getMethodParams(groupsMethods[["list"]]),
 139       "\t\t#' @return A GroupList object.",
 140       getMethodSignature("project_list", listArgs),
 141       "\t\t{",
 142       "\t\t\tfilters[[length(filters) + 1]] <- list(\"group_class\", \"=\", \"project\")",
 143       paste("\t\t\tself$groups_list(", toCallArgs(listArgs), ")", sep=""),
 144       "\t\t},",
 145       "",
 146       "\t\t#' @description An alias for `groups_delete`.",
 147       getMethodParams(groupsMethods[["delete"]]),
 148       "\t\t#' @return A Group object.",
 149       getMethodSignature("project_delete", deleteArgs),
 150       "\t\t{",
 151       paste("\t\t\tself$groups_delete(", toCallArgs(deleteArgs), ")", sep=""),
 152       "\t\t},",
 153       "",
 154       "\t\t#' @description Test whether or not a project exists.",
 155       getMethodParams(groupsMethods[["get"]]),
 156       getMethodSignature("project_exist", getArgs),
 157       "\t\t{",
 158       paste("\t\t\tresult <- try(self$groups_get(", toCallArgs(getArgs), "))", sep=""),
 159       "\t\t\tif(inherits(result, \"try-error\"))",
 160       "\t\t\t\texists <- FALSE",
 161       "\t\t\telse",
 162       "\t\t\t\texists <- result['group_class'] == \"project\"",
 163       "\t\t\tcat(format(exists))",
 164       "\t\t},",
 165       "",
 166       "\t\t#' @description A convenience wrapper for `project_update` to set project metadata properties.",
 167       "\t\t#' @param listProperties List of new properties.",
 168       "\t\t#' @param uuid UUID of the project to update.",
 169       "\t\t#' @return A Group object.",
 170       "\t\tproject_properties_set = function(listProperties, uuid)",
 171       "\t\t{",
 172       "\t\t\tself$project_update(list(\"properties\" = listProperties), uuid)",
 173       "\t\t},",
 174       "",
 175       "\t\t#' @description Get a project and update it with additional properties.",
 176       "\t\t#' @param properties List of new properties.",
 177       "\t\t#' @param uuid UUID of the project to update.",
 178       "\t\t#' @return A Group object.",
 179       "\t\tproject_properties_append = function(properties, uuid)",
 180       "\t\t{",
 181       "\t\t\tproj <- private$get_project_by_list(uuid, list('uuid', 'properties'))",
 182       "\t\t\tnewListOfProperties <- c(proj$properties, properties)",
 183       "\t\t\tuniqueProperties <- unique(unlist(newListOfProperties))",
 184       "\t\t\tnewProperties <- suppressWarnings(newListOfProperties[which(newListOfProperties == uniqueProperties)])",
 185       "\t\t\tself$project_properties_set(newProperties, proj$uuid)",
 186       "\t\t},",
 187       "",
 188       "\t\t#' @description Get properties of a project.",
 189       "\t\t#' @param uuid The UUID of the project to query.",
 190       "\t\tproject_properties_get = function(uuid)",
 191       "\t\t{",
 192       "\t\t\tprivate$get_project_by_list(uuid, list('uuid', 'properties'))$properties",
 193       "\t\t},",
 194       "",
 195       "\t\t#' @description Delete one property from a project by name.",
 196       "\t\t#' @param oneProp Name of the property to delete.",
 197       "\t\t#' @param uuid The UUID of the project to update.",
 198       "\t\t#' @return A Group object.",
 199       "\t\tproject_properties_delete = function(oneProp, uuid)",
 200       "\t\t{",
 201       "\t\t\tprojProp <- self$project_properties_get(uuid)",
 202       "\t\t\tprojProp[[oneProp]] <- NULL",
 203       "\t\t\tself$project_properties_set(projProp, uuid)",
 204       "\t\t},",
 205       "",
 206       "\t\t#' @description Convenience wrapper of `links_list` to create a permission link.",
 207       "\t\t#' @param type The type of permission: one of `'can_read'`, `'can_write'`, or `'can_manage'`.",
 208       "\t\t#' @param uuid The UUID of the object to grant permission to.",
 209       "\t\t#' @param user The UUID of the user or group who receives this permission.",
 210       "\t\t#' @return A Link object if one was updated, else NULL.",
 211       "\t\tproject_permission_give = function(type, uuid, user)",
 212       "\t\t{",
 213       "\t\t\tlink <- list(",
 214       "\t\t\t\t'link_class' = 'permission',",
 215       "\t\t\t\t'name' = type,",
 216       "\t\t\t\t'head_uuid' = uuid,",
 217       "\t\t\t\t'tail_uuid' = user)",
 218       "\t\t\tself$links_create(link)",
 219       "\t\t},",
 220       "",
 221       "\t\t#' @description Find an existing permission link and update its level.",
 222       "\t\t#' @param typeOld The type of permission to find: one of `'can_read'`, `'can_write'`, or `'can_manage'`.",
 223       "\t\t#' @param typeNew The type of permission to set: one of `'can_read'`, `'can_write'`, or `'can_manage'`.",
 224       "\t\t#' @param uuid The UUID of the object to grant permission to.",
 225       "\t\t#' @param user The UUID of the user or group who receives this permission.",
 226       "\t\t#' @return A Link object if one was updated, else NULL.",
 227       "\t\tproject_permission_update = function(typeOld, typeNew, uuid, user)",
 228       "\t\t{",
 229       "\t\t\tlinks <- self$links_list(filters = list(",
 230       "\t\t\t\t\tlist('link_class', '=', 'permission'),",
 231       "\t\t\t\t\tlist('name', '=', typeOld),",
 232       "\t\t\t\t\tlist('head_uuid', '=', uuid),",
 233       "\t\t\t\t\tlist('tail_uuid', '=', user)",
 234       "\t\t\t\t), select=list('uuid'), count = 'none')$items",
 235       "\t\t\tif (length(links) == 0) {",
 236       "\t\t\t\tcat(format('No permission granted'))",
 237       "\t\t\t} else {",
 238       "\t\t\t\tself$links_update(list('name' = typeNew), links[[1]]$uuid)",
 239       "\t\t\t}",
 240       "\t\t},",
 241       "",
 242       "\t\t#' @description Delete an existing permission link.",
 243       "\t\t#' @param type The type of permission to delete: one of `'can_read'`, `'can_write'`, or `'can_manage'`.",
 244       "\t\t#' @param uuid The UUID of the object to grant permission to.",
 245       "\t\t#' @param user The UUID of the user or group who receives this permission.",
 246       "\t\t#' @return A Link object if one was deleted, else NULL.",
 247       "\t\tproject_permission_delete = function(type, uuid, user)",
 248       "\t\t{",
 249       "\t\t\tlinks <- self$links_list(filters = list(",
 250       "\t\t\t\t\tlist('link_class', '=', 'permission'),",
 251       "\t\t\t\t\tlist('name', '=', type),",
 252       "\t\t\t\t\tlist('head_uuid', '=', uuid),",
 253       "\t\t\t\t\tlist('tail_uuid', '=', user)",
 254       "\t\t\t\t), select=list('uuid'), count = 'none')$items",
 255       "\t\t\tif (length(links) == 0) {",
 256       "\t\t\t\tcat(format('No permission granted'))",
 257       "\t\t\t} else {",
 258       "\t\t\t\tself$links_delete(links[[1]]$uuid)",
 259       "\t\t\t}",
 260       "\t\t},",
 261       "",
 262       "\t\t#' @description Check for an existing permission link.",
 263       "\t\t#' @param type The type of permission to check: one of `'can_read'`, `'can_write'`, `'can_manage'`, or `NULL` (the default).",
 264       "\t\t#' @param uuid The UUID of the object to check permission on.",
 265       "\t\t#' @param user The UUID of the user or group to check permission for.",
 266       "\t\t#' @return If `type` is `NULL`, the list of matching permission links.",
 267       "\t\t#' Otherwise, prints and invisibly returns the level of the found permission link.",
 268       "\t\tproject_permission_check = function(uuid, user, type = NULL)",
 269       "\t\t{",
 270       "\t\t\tfilters <- list(",
 271       "\t\t\t\tlist('link_class', '=', 'permission'),",
 272       "\t\t\t\tlist('head_uuid', '=', uuid),",
 273       "\t\t\t\tlist('tail_uuid', '=', user))",
 274       "\t\t\tif (!is.null(type)) {",
 275       "\t\t\t\tfilters <- c(filters, list(list('name', '=', type)))",
 276       "\t\t\t}",
 277       "\t\t\tlinks <- self$links_list(filters = filters, count='none')$items",
 278       "\t\t\tif (is.null(type)) {",
 279       "\t\t\t\tlinks",
 280       "\t\t\t} else {",
 281       "\t\t\t\tprint(links[[1]]$name)",
 282       "\t\t\t}",
 283       "\t\t},",
 284       "")
 285 }
 286
 287 genClassContent <- function(methodResources, resourceNames)
 288 {
 289     arvadosMethods <- Map(function(resource, resourceName)
 290     {
 291         methodNames <- names(resource$methods)
 292
 293         functions <- Map(function(methodMetaData, methodName)
 294         {
 295             #NOTE: Index, show and destroy are aliases for the preferred names
 296             # "list", "get" and "delete". Until they are removed from discovery
 297             # document we will filter them here.
 298             if(methodName %in% c("index", "show", "destroy"))
 299                return(NULL)
 300
 301             methodName <- paste0(resourceName, "_", methodName)
 302             unlist(c(
 303                    getMethodDoc(methodName, methodMetaData),
 304                    createMethod(methodName, methodMetaData)
 305             ))
 306
 307         }, resource$methods, methodNames)
 308
 309         unlist(unname(functions))
 310
 311     }, methodResources, resourceNames)
 312
 313     arvadosMethods
 314 }
 315
 316 genAPIClassFooter <- function()
 317 {
 318     c("\t\t#' @description Return the host name of this client's Arvados API server.",
 319       "\t\t#' @return Hostname string.",
 320       "\t\tgetHostName = function() private$host,",
 321       "",
 322       "\t\t#' @description Return the Arvados API token used by this client.",
 323       "\t\t#' @return API token string.",
 324       "\t\tgetToken = function() private$token,",
 325       "",
 326       "\t\t#' @description Set the RESTService object used by this client.",
 327       "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
 328       "",
 329       "\t\t#' @description Return the RESTService object used by this client.",
 330       "\t\t#' @return RESTService object.",
 331       "\t\tgetRESTService = function() private$REST",
 332       "\t),",
 333       "",
 334       "\tprivate = list(",
 335       "\t\ttoken = NULL,",
 336       "\t\thost = NULL,",
 337       "\t\tREST = NULL,",
 338       "\t\tnumRetries = NULL,",
 339       "\t\tget_project_by_list = function(uuid, select = NULL)",
 340       "\t\t{",
 341       "\t\t\tself$groups_list(",
 342       "\t\t\t\tfilters = list(list('uuid', '=', uuid), list('group_class', '=', 'project')),",
 343       "\t\t\t\tselect = select,",
 344       "\t\t\t\tcount = 'none'",
 345       "\t\t\t)$items[[1]]",
 346       "\t\t}",
 347       "\t),",
 348       "",
 349       "\tcloneable = FALSE",
 350       ")")
 351 }
 352
 353 createMethod <- function(name, methodMetaData)
 354 {
 355     args      <- getMethodArguments(methodMetaData)
 356     signature <- getMethodSignature(name, args)
 357     body      <- getMethodBody(methodMetaData)
 358
 359     c(signature,
 360       "\t\t{",
 361           body,
 362       "\t\t},\n")
 363 }
 364
 365 normalizeParamName <- function(name)
 366 {
 367     # Downcase the first letter
 368     name <- sub("^(\\w)", "\\L\\1", name, perl=TRUE)
 369     # Convert snake_case to camelCase
 370     gsub("_(uuid\\b|id\\b|\\w)", "\\U\\1", name, perl=TRUE)
 371 }
 372
 373 getMethodArguments <- function(methodMetaData)
 374 {
 375     request <- methodMetaData$request
 376     requestArgs <- NULL
 377
 378     if(!is.null(request))
 379     {
 380         resourceName <- normalizeParamName(request$properties[[1]][[1]])
 381
 382         if(request$required)
 383             requestArgs <- resourceName
 384         else
 385             requestArgs <- paste(resourceName, "=", "NULL")
 386     }
 387
 388     argNames <- names(methodMetaData$parameters)
 389
 390     args <- sapply(argNames, function(argName)
 391     {
 392         arg <- methodMetaData$parameters[[argName]]
 393         argName <- normalizeParamName(argName)
 394
 395         if(!arg$required)
 396         {
 397             return(paste(argName, "=", "NULL"))
 398         }
 399
 400         argName
 401     })
 402
 403     c(requestArgs, args)
 404 }
 405
 406 getMethodSignature <- function(methodName, args)
 407 {
 408     collapsedArgs <- paste0(args, collapse = ", ")
 409     lineLengthLimit <- 40
 410
 411     if(nchar(collapsedArgs) > lineLengthLimit)
 412     {
 413         return(paste0("\t\t",
 414                       formatArgs(paste(methodName, "= function("),
 415                                  "\t", args, ")", lineLengthLimit)))
 416     }
 417     else
 418     {
 419         return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
 420     }
 421 }
 422
 423 getMethodBody <- function(methodMetaData)
 424 {
 425     url              <- getRequestURL(methodMetaData)
 426     headers          <- getRequestHeaders()
 427     requestQueryList <- getRequestQueryList(methodMetaData)
 428     requestBody      <- getRequestBody(methodMetaData)
 429     request          <- getRequest(methodMetaData)
 430     response         <- getResponse(methodMetaData)
 431     errorCheck       <- getErrorCheckingCode(methodMetaData)
 432     returnStatement  <- getReturnObject()
 433
 434     body <- c(url,
 435               headers,
 436               requestQueryList, "",
 437               requestBody, "",
 438               request, response, "",
 439               errorCheck, "",
 440               returnStatement)
 441
 442     paste0("\t\t\t", body)
 443 }
 444
 445 getRequestURL <- function(methodMetaData)
 446 {
 447     endPoint <- methodMetaData$path
 448     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 449     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 450              paste0("url <- paste0(private$host, endPoint)"))
 451     url
 452 }
 453
 454 getRequestHeaders <- function()
 455 {
 456     c("headers <- list(Authorization = paste(\"Bearer\", private$token), ",
 457       "                \"Content-Type\" = \"application/json\")")
 458 }
 459
 460 getRequestQueryList <- function(methodMetaData)
 461 {
 462     queryArgs <- names(Filter(function(arg) arg$location == "query",
 463                         methodMetaData$parameters))
 464
 465     if(length(queryArgs) == 0)
 466         return("queryArgs <- NULL")
 467
 468     queryArgs <- sapply(queryArgs, function(arg) {
 469         arg <- normalizeParamName(arg)
 470         paste(arg, "=", arg)
 471     })
 472     collapsedArgs <- paste0(queryArgs, collapse = ", ")
 473
 474     lineLengthLimit <- 40
 475
 476     if(nchar(collapsedArgs) > lineLengthLimit)
 477         return(formatArgs("queryArgs <- list(", "\t\t\t\t  ", queryArgs, ")",
 478                           lineLengthLimit))
 479     else
 480         return(paste0("queryArgs <- list(", collapsedArgs, ")"))
 481 }
 482
 483 getRequestBody <- function(methodMetaData)
 484 {
 485     request <- methodMetaData$request
 486
 487     if(is.null(request) || !request$required)
 488         return("body <- NULL")
 489
 490     resourceName <- normalizeParamName(request$properties[[1]][[1]])
 491
 492     requestParameterName <- names(request$properties)[1]
 493
 494     c(paste0("if(length(", resourceName, ") > 0)"),
 495       paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
 496              "\t                         auto_unbox = TRUE)",
 497       "else",
 498       "\tbody <- NULL")
 499 }
 500
 501 getRequest <- function(methodMetaData)
 502 {
 503     method <- methodMetaData$httpMethod
 504     c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
 505       "                                   queryArgs, private$numRetries)")
 506 }
 507
 508 getResponse <- function(methodMetaData)
 509 {
 510     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 511 }
 512
 513 getErrorCheckingCode <- function(methodMetaData)
 514 {
 515     if ("ensure_unique_name" %in% names(methodMetaData$parameters)) {
 516         body <- c("\tif (identical(sub('Entity:.*', '', resource$errors), '//railsapi.internal/arvados/v1/collections: 422 Unprocessable ')) {",
 517                   "\t\tresource <- cat(format('An object with the given name already exists with this owner. If you want to update it use the update method instead'))",
 518                   "\t} else {",
 519                   "\t\tstop(resource$errors)",
 520                   "\t}")
 521     } else {
 522         body <- "\tstop(resource$errors)"
 523     }
 524     c("if(!is.null(resource$errors)) {", body, "}")
 525 }
 526
 527 getReturnObject <- function()
 528 {
 529     "resource"
 530 }
 531
 532 genAPIClassDoc <- function(methodResources, resourceNames)
 533 {
 534     c("#' @examples",
 535       "#' \\dontrun{",
 536       "#' arv <- Arvados$new(\"your Arvados token\", \"example.arvadosapi.com\")",
 537       "#'",
 538       "#' collection <- arv$collections.get(\"uuid\")",
 539       "#'",
 540       "#' collectionList <- arv$collections.list(list(list(\"name\", \"like\", \"Test%\")))",
 541       "#' collectionList <- listAll(arv$collections.list, list(list(\"name\", \"like\", \"Test%\")))",
 542       "#'",
 543       "#' deletedCollection <- arv$collections.delete(\"uuid\")",
 544       "#'",
 545       "#' updatedCollection <- arv$collections.update(list(name = \"New name\", description = \"New description\"),",
 546       "#'                                             \"uuid\")",
 547       "#'",
 548       "#' createdCollection <- arv$collections.create(list(name = \"Example\",",
 549       "#'                                                  description = \"This is a test collection\"))",
 550       "#' }",
 551       "")
 552 }
 553
 554 getAPIClassMethodList <- function(methodResources, resourceNames)
 555 {
 556     methodList <- unlist(unname(Map(function(resource, resourceName)
 557     {
 558         methodNames <- names(resource$methods)
 559         paste0(resourceName,
 560                ".",
 561                methodNames[!(methodNames %in% c("index", "show", "destroy"))])
 562
 563     }, methodResources, resourceNames)))
 564
 565     hardcodedMethods <- c("projects.create", "projects.get",
 566                           "projects.list", "projects.update", "projects.delete")
 567     paste0("#' \t\\item{}{\\code{\\link{", sort(c(methodList, hardcodedMethods)), "}}}")
 568 }
 569
 570 getMethodDoc <- function(methodName, methodMetaData)
 571 {
 572     description <- paste("\t\t#' @description", gsub("\n", "\n\t\t#' ", methodMetaData$description))
 573     params      <- getMethodParams(methodMetaData)
 574     returnValue <- paste("\t\t#' @return", methodMetaData$response[["$ref"]], "object.")
 575
 576     c(description, params, returnValue)
 577 }
 578
 579 getMethodParams <- function(methodMetaData)
 580 {
 581     request <- methodMetaData$request
 582     requestDoc <- NULL
 583
 584     if(!is.null(request))
 585     {
 586         requestDoc <- unname(unlist(sapply(request$properties, function(prop)
 587                              {
 588                                  className <- sapply(prop, function(ref) ref)
 589                                  objectName <- normalizeParamName(className)
 590                                  paste("\t\t#' @param", objectName, className, "object.")
 591                              })))
 592     }
 593
 594     argNames <- names(methodMetaData$parameters)
 595
 596     argsDoc <- unname(unlist(sapply(argNames, function(argName)
 597     {
 598         arg <- methodMetaData$parameters[[argName]]
 599         paste("\t\t#' @param",
 600               normalizeParamName(argName),
 601               gsub("\n", "\n\t\t#' ", arg$description)
 602         )
 603     })))
 604
 605     c(requestDoc, argsDoc)
 606 }
 607
 608 #NOTE: Utility functions:
 609
 610 # This function is used to split very long lines of code into smaller chunks.
 611 # This is usually the case when we pass a lot of named argumets to a function.
 612 formatArgs <- function(prependAtStart, prependToEachSplit,
 613                        args, appendAtEnd, lineLength)
 614 {
 615     if(length(args) > 1)
 616     {
 617         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 618     }
 619
 620     args[1] <- paste0(prependAtStart, args[1])
 621     args[length(args)] <- paste0(args[length(args)], appendAtEnd)
 622
 623     argsLength <- length(args)
 624     argLines <- list()
 625     index <- 1
 626
 627     while(index <= argsLength)
 628     {
 629         line <- args[index]
 630         index <- index + 1
 631
 632         while(nchar(line) < lineLength && index <= argsLength)
 633         {
 634             line <- paste(line, args[index])
 635             index <- index + 1
 636         }
 637
 638         argLines <- c(argLines, line)
 639     }
 640
 641     argLines <- unlist(argLines)
 642     argLinesLen <- length(argLines)
 643
 644     if(argLinesLen > 1)
 645         argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
 646
 647     argLines
 648 }
 649
 650 args <- commandArgs(TRUE)
 651 if (length(args) == 0) {
 652    loc <- "arvados-v1-discovery.json"
 653 } else {
 654    loc <- args[[1]]
 655 }
 656 discoveryDocument <- getAPIDocument(loc)
 657 generateAPI(discoveryDocument)