R/inzdocuments.R

In tmelliott/inzight: inzight State Management System

#' inzight documents list state
#' @param docs a list of documents (...inzdocument)
#' @param active integer identifying the currently active document
#' @return a inzdocuments object
#' @export
inzdocuments <- function(docs = list(),
                         active = length(docs)
                         ) {
    docs <- lapply(as.list(docs), \(x) {
        if (!inherits(x, "inzdocument")) do.call(inzdocument, x) else x
    })
    if (is.list(active)) active <- active[[1]]

    self <- list(
        docs = docs,
        active = active
    )
    class(self) <- "inzdocuments"
    self
}

#' @export
print.inzdocuments <- function(x, ...) {
    if (length(x$docs) == 0L) {
        cat(cli::style_italic("empty document list\n"))
        return()
    }
    cat("documents:\n")
    for (i in seq_along(x$docs)) {
        cat(sprintf("[%s] %s\n", ifelse(i == x$active, "*", " "), x$docs[[i]]$label))
    }
}

#' @describeIn inzdocuments Dispatch method for inzdocuments
#' @export
dispatch.inzdocuments <- function(state, action) {
    # will forward dispatch to *active* document (unless it's a delete/rename/etc action)
    cli::cli_h1("Dispatching action for inzdocuments")
    cat("\n")
    print(action)

    switch(action$action,
        'LOAD_DATA' = {
            cli::cli_h2('LOADING DATA')
            documents <- state$docs

            args <- action$payload
            args <- args[!names(args) %in% c("name", "label")]
            data <- do.call(iNZightTools::smart_read, args)
            print(head(data))

            name <- ifelse(is.null(action$payload$name),
                basename(tools::file_path_sans_ext(action$payload$file)),
                action$payload$name
            )
            label <- ifelse(is.null(action$payload$label), name, action$payload$label)

            doc <- inzdocument(data = data, name = name, label = label)
            documents <- c(documents, list(doc))
            inzdocuments(documents)
        },
        'CHANGE_DOC' = {
            state
        },
        {
            documents <- lapply(state$docs, dispatch, action = action)
            inzdocuments(documents)
        }
    )
}

#' inzight document state
#' @param data a data.frame or a data_store
#' @param name R object name
#' @param label human readable name (spaces etc OK)
#' @param settings document specific settings (inzsettings)
#' @param controls a list of global/user controls (inzcontrols)
inzdocument <- function(data,
                        name = deparse(substitute(data)),
                        label = name,
                        settings = inzsettings(),
                        controls = inzcontrols(variables = names(data))
                        ) {
    if (is.list(data) && !is.data.frame(data)) data <- data[[1]]
    if (is.list(name)) name <- name[[1]]
    if (is.list(label)) lable <- label[[1]]

    if (inherits(data, "data_store")) {
        store <- data
    } else if (is.data.frame(data)) {
        # store data somewhere
        file_path <- tempfile(pattern = name)
        store <- data_store(file_path, data)
    } else {
        store <- data_store(data)
    }

    if (!inherits(settings, "inzsettings")) settings <- do.call(inzsettings, settings)
    if (!inherits(controls, "inzcontrols")) {
        if (is.null(names(controls))) controls <- controls[[1]]
        controls <- do.call(inzcontrols, unclass(controls))
    }

    self <- list(
        data = store,
        name = name,
        label = label,
        settings = settings,
        controls = controls
    )
    class(self) <- "inzdocument"
    self
}

#' @export
as_list.inzdocument <- function(x) {
    list(
        data = x$data$path,
        name = x$name,
        label = x$label,
        settings = as_list(x$settings),
        controls = as_list(x$controls)
    )
}

#' @export
print.inzdocument <- function(x, ...) {
    cli::cli_h2("{x$label} ({x$name})\n")

    print(head(x$data$get()))

    cat("\n")
    cli::cli_h3("Controls")
    print(x$controls)

}

#' @describeIn inzdocument Dispatch method for inzdocument
#' @export
dispatch.inzdocument <- function(state, action) {
    cli::cli_h1("Dispatching action for inzdocument")
    cat("\n")
    print(action)

    switch(action$action,
        do.call(inzdocument, lapply(state, dispatch, action = action))
    )
}

#' Data Store class generator
#' @param x a data store constructor
#' @param data data to be stored (a data.frame)
#' @return a data_store object
#' @export
data_store <- function(x, data) UseMethod("data_store", x)

#' @describeIn data_store Default method for storing at a local path
#' @export
data_store.default <- function(x, data) {
    if (!missing(data)) {
        path <- paste(x, "rds", sep = ".")
        cli::cli_alert_info("Storing data in {.strong {path}}")
        saveRDS(data, file = path)
    } else {
        path <- x
    }

    self <- list(
        path = path,
        get = function() readRDS(path),
        close = function() {
            unlink(path)
            cli::cli_alert_info("Deleted {.strong {path}}")
        }
    )
    class(self) <- c("file_data_store", "data_store")
    self
}

#' @export
as_list.data_store <- function(x) list(data = x$path)