Nothing
#' Create a project for a variable collection
#'
#' @param project_name The name of the project to create. The project name
#' \itemize{
#' \item{cannot be empty.}
#' \item{must be no more than 56 characters.}
#' \item{cannot end with a \code{-}.}
#' \item{must consist of lowercase letters and numbers.}
#' }
#' @param users A list collection of the users that should have access to the project
#' @param overwrite_existing Character, specifying action to take if project still exists: 'choose'
#' (default) displays a menu giving the option to overwrite or not, 'yes' overwrites the
#' existing project and 'no' exists the function with a message.
#' @return NULL
#'
#' @importFrom httr PUT
#' @importFrom dplyr case_when
#'
#' @examples
#' \dontrun{
#' armadillo.create_project("gecko")
#' }
#'
#' @export
armadillo.create_project <- function(project_name = NULL, users = NULL, overwrite_existing = "choose") { # nolint
askYesNo <- NULL
if (is.null(users)) {
users <- list()
}
project_exists <- project_name %in% armadillo.list_projects()
choice <- .get_overwrite_choice(project_name, project_exists, overwrite_existing)
if (choice == TRUE & !project_exists) {
.create_project(project_name, users)
message(.create_project_message(project_name, users))
} else if (choice == TRUE & project_exists) {
.create_project(project_name, users)
message(paste0(.create_project_message(project_name, users), " with overwrite set to 'yes'"))
} else if (choice == "cancel" & project_exists) {
message("Did not create project: operation cancelled by user")
} else {
message("Did not create project: ", "'", project_name, "'", " already exists and overwrite is set to 'no'")
}
}
.create_project <- function(project_name, users, overwrite_existing) {
.check_project_name(project_name)
response <- httr::PUT(
url = .get_url(),
path = "/access/projects",
body = list(name = project_name, users = users),
config = c(
httr::content_type_json(),
httr::add_headers(.get_auth_header())
),
encode = "json"
)
.handle_request_error(response)
}
#' Delete project
#'
#' A project represents usually a study or collection of variables
#'
#' @param project_name the name of the study or collection of variables name
#' @return NULL
#'
#' @examples
#' \dontrun{
#' armadillo.delete_project(project_name = "gecko")
#' }
#'
#' @export
armadillo.delete_project <- function(project_name) { # nolint
response <- httr::DELETE(
url = .get_url(),
path = paste0("/access/projects/", project_name),
config = httr::add_headers(.get_auth_header())
)
.handle_request_error(response)
message(paste0("Deleted project '", project_name, "'"))
}
#' List the projects
#'
#' @return the projects
#'
#' @examples
#' \dontrun{
#' armadillo.list_projects()
#' }
#'
#' @export
armadillo.list_projects <- function() { # nolint
content <- .get_projects_content()
sapply(content, function(project) project$name)
}
#' Gets the Projects information
#'
#' @return the projects and their information
#'
#' @examples
#' \dontrun{
#' armadillo.get_projects_info()
#' }
#'
#' @export
armadillo.get_projects_info <- function() { # nolint
return(.get_projects_content())
}
#' Gets the users of an given project name
#'
#' @param project_name the name of the project to extract the users from
#' @return List of all users within "project_name"
#'
#' @import rlist
#'
#' @examples
#' \dontrun{
#' armadillo.get_project_users("some-project")
#' }
#'
#' @export
armadillo.get_project_users <- function(project_name) { # nolint
# workaround for NOTE: no binding for global variable name
name <- NULL
content <- .get_projects_content()
filtered <- rlist::list.filter(content, name == project_name)
if (length(filtered) == 0) {
stop(paste0("Project ", project_name, " not found."))
}
return(filtered[[1]]$users)
}
.get_projects_content <- function() {
response <- httr::GET(
url = .get_url(),
path = "/access/projects",
config = httr::add_headers(.get_auth_header())
)
.handle_request_error(response)
content <- httr::content(response, as = "parsed")
return(content)
}
#' Displays a menu with choices if the project already exists
#'
#' @param project_name the name of the target project
#' @return Either 1, 2, or 0 depending on menu choice
#'
#' @importFrom utils askYesNo
#' @noRd
.make_overwrite_menu <- function(project_name) {
choice <- NULL
while (is.null(choice)) {
tryCatch(
{
choice <- askYesNo(
paste0("Project ", "'", project_name, "'", " already exists: do you want to overwrite?"),
default = NA)
},
error = function(cond) {
print("Unrecognised response: please choose from 'yes', 'no' or 'cancel'")
}
)
}
if (is.na(choice)) {
choice <- "cancel"
}
return(choice)
}
.get_overwrite_choice <- function(project_name, project_exists, overwrite_existing) {
if (!any(c("choose", "yes", "no") %in% overwrite_existing)) {
stop("`overwrite` must be one of 'choose', 'yes', 'no'")
}
if (project_exists & overwrite_existing == "choose") {
choice <- .make_overwrite_menu(project_name)
} else if (!project_exists | (project_exists & overwrite_existing == "yes")) {
choice <- TRUE
} else {
choice <- FALSE
}
return(choice)
}
#' Provides an exit message
#'
#' @param project_name the name of the target project
#' @param users A list collection of the users that should have access to the project
#' @return A message indicating what operation has been performed
#'
#' @noRd
.create_project_message <- function(project_name, users) {
if (length(users) == 0) {
usermessage <- "without users"
} else {
usermessage <- paste0("with users: ", paste(unlist(users), collapse = ", "))
}
paste0("Created project '", project_name, "' ", usermessage)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.