## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(blockr.session) ## ----constructor-------------------------------------------------------------- demo_store <- function(dir = tempfile("demo_store")) { dir.create(dir, showWarnings = FALSE, recursive = TRUE) structure(list(dir = dir), class = c("demo_store", "rack_backend")) } ## ----helpers------------------------------------------------------------------ record_dir <- function(backend, id) { file.path(backend$dir, id) } read_meta <- function(backend, id) { path <- file.path(record_dir(backend, id), "meta.json") if (!file.exists(path)) { return(list(name = id, versions = list())) } jsonlite::read_json(path) } write_meta <- function(backend, id, meta) { jsonlite::write_json( meta, file.path(record_dir(backend, id), "meta.json"), auto_unbox = TRUE, null = "null" ) } ## ----as-rack-id--------------------------------------------------------------- as_rack_id.demo_store <- function(x, backend, ...) { new_rack_id(x$id, version = x$version, class = "rack_id_demo") } ## ----rack-upload-------------------------------------------------------------- rack_upload.demo_store <- function(backend, path, id, name = NULL, content_hash = NULL, ...) { dir <- record_dir(backend, id$id) dir.create(dir, showWarnings = FALSE, recursive = TRUE) meta <- read_meta(backend, id$id) version <- as.character(length(meta$versions) + 1L) file.copy(path, file.path(dir, paste0(version, ".json")), overwrite = TRUE) if (!is.null(name)) { meta$name <- name } meta$versions <- c( meta$versions, list( list(version = version, created = format(Sys.time()), hash = content_hash) ) ) write_meta(backend, id$id, meta) new_rack_id(id$id, version = version, class = "rack_id_demo") } ## ----rack-list---------------------------------------------------------------- rack_list.demo_store <- function(backend, tags = NULL, ...) { ids <- list.dirs(backend$dir, full.names = FALSE, recursive = FALSE) lapply( ids, function(rid) { meta <- read_meta(backend, rid) latest <- meta$versions[[length(meta$versions)]] new_rack_record(id = rid, name = meta$name, saved = latest$created) } ) } ## ----record-read-------------------------------------------------------------- rack_exists.rack_id_demo <- function(id, backend, ...) { file.exists(file.path(record_dir(backend, id$id), "meta.json")) } rack_download.rack_id_demo <- function(id, backend, ...) { info <- rack_info(id, backend) if (nrow(info) == 0L) { stop("No versions stored for record ", id$id) } version <- if (is.null(id$version)) info$version[1L] else id$version file.path(record_dir(backend, id$id), paste0(version, ".json")) } rack_info.rack_id_demo <- function(id, backend, ...) { versions <- read_meta(backend, id$id)$versions if (length(versions) == 0L) { return( data.frame( version = character(), created = as.POSIXct(character()), ref = character(), stringsAsFactors = FALSE ) ) } version <- vapply(versions, `[[`, character(1L), "version") created <- vapply(versions, `[[`, character(1L), "created") newest_first <- rev(seq_along(version)) data.frame( version = version[newest_first], created = as.POSIXct(created[newest_first]), ref = version[newest_first], stringsAsFactors = FALSE ) } ## ----record-meta-------------------------------------------------------------- rack_name.rack_id_demo <- function(id, backend, ...) { read_meta(backend, id$id)$name } rack_rename.rack_id_demo <- function(id, backend, name, ...) { meta <- read_meta(backend, id$id) meta$name <- name write_meta(backend, id$id, meta) new_rack_id(id$id, version = id$version, class = "rack_id_demo") } rack_content_hash.rack_id_demo <- function(id, backend, ...) { versions <- read_meta(backend, id$id)$versions if (length(versions) == 0L) { return(NULL) } versions[[length(versions)]]$hash } ## ----record-delete------------------------------------------------------------ rack_delete.rack_id_demo <- function(id, backend, ...) { meta <- read_meta(backend, id$id) version <- if (is.null(id$version)) { meta$versions[[length(meta$versions)]]$version } else { id$version } unlink(file.path(record_dir(backend, id$id), paste0(version, ".json"))) meta$versions <- Filter( function(v) !identical(v$version, version), meta$versions ) if (length(meta$versions) == 0L) { unlink(record_dir(backend, id$id), recursive = TRUE) } else { write_meta(backend, id$id, meta) } invisible(TRUE) } rack_purge.rack_id_demo <- function(id, backend, ...) { unlink(record_dir(backend, id$id), recursive = TRUE) invisible(TRUE) } ## ----capabilities------------------------------------------------------------- rack_capabilities.demo_store <- function(backend, ...) { list( versioning = TRUE, metadata = TRUE, tags = FALSE, sharing = FALSE, visibility = FALSE, user_discovery = FALSE ) } ## ----roundtrip-create--------------------------------------------------------- store <- demo_store() board <- list( blocks = list(list(id = "a", type = "dataset")), links = list() ) id <- rack_create(store, board, id = "sales-report", name = "Sales report") id ## ----roundtrip-list-load------------------------------------------------------ rack_list(store) identical(rack_load(id, store), board) ## ----roundtrip-append--------------------------------------------------------- board$blocks <- c(board$blocks, list(list(id = "b", type = "filter"))) rack_append(id, store, board) rack_info(id, store) ## ----roundtrip-meta----------------------------------------------------------- rack_rename(id, store, "Quarterly sales") rack_name(as_rack_id(list(id = "sales-report"), store), store) rack_content_hash(id, store) ## ----roundtrip-delete--------------------------------------------------------- rack_purge(id, store) rack_list(store) ## ----wiring, eval = FALSE----------------------------------------------------- # options( # blockr.session_mgmt_backend = function() demo_store("~/blockr-workflows") # ) # # library(blockr.core) # library(blockr.dock) # # serve( # new_dock_board(), # plugins = custom_plugins(manage_project()), # loader = rack_loader() # )