diff --git a/.lintr b/.lintr index cbc6dc1..1d35ae7 100644 --- a/.lintr +++ b/.lintr @@ -1,6 +1,5 @@ linters: linters_with_defaults( line_length_linter = line_length_linter(120), - cyclocomp_linter = NULL, object_usage_linter = NULL, object_name_linter = object_name_linter(styles = c("snake_case", "symbols"), regexes = c(ANL = "^ANL_?[0-9A-Z_]*$", ADaM = "^r?AD[A-Z]{2,3}_?[0-9]*$")), indentation_linter = NULL diff --git a/DESCRIPTION b/DESCRIPTION index 5f3dd39..0a86367 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,6 +33,7 @@ Imports: checkmate, cowplot, dplyr, + DT, formatters, ggplot2, ggplotify, diff --git a/NAMESPACE b/NAMESPACE index 6c91ca8..1946f8b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,9 +11,12 @@ export(or_filtering_transformator) export(patchwork_plot_decorator) export(remove_by_label) export(title_footer_decorator) +export(tm_report_manager) export(watermark_decorator) import(shiny) import(teal) +importFrom(DT,DTOutput) +importFrom(DT,renderDT) importFrom(R6,R6Class) importFrom(checkmate,assert_character) importFrom(checkmate,assert_class) @@ -86,11 +89,15 @@ importFrom(shiny,uiOutput) importFrom(shiny,updateSelectInput) importFrom(shinyBS,bsModal) importFrom(shinyWidgets,pickerInput) +importFrom(shinyjs,disable) +importFrom(shinyjs,enable) importFrom(shinyjs,hidden) importFrom(shinyjs,hide) importFrom(shinyjs,show) importFrom(shinyjs,toggle) +importFrom(shinyjs,toggleState) importFrom(shinyjs,useShinyjs) +importFrom(teal,module) importFrom(teal,teal_transform_module) importFrom(teal.code,eval_code) importFrom(teal.modules.clinical,add_expr) diff --git a/NEWS.md b/NEWS.md index 047a260..e391966 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ # Version 0.0.4.9000 - Added support for `%in%` and `!%in%` operators to `or_filtering_transformator`. This contribution was authored by [@Siddhesh2097](https://github.com/Siddhesh2097). +- Added a new module - `tm_report_manager()` - for comprehensive `teal` report management. # Version 0.0.3 diff --git a/R/ReportManager.R b/R/ReportManager.R new file mode 100644 index 0000000..43d8845 --- /dev/null +++ b/R/ReportManager.R @@ -0,0 +1,611 @@ +#' @title `ReportManager` Object +#' @description +#' This can be used to manage state of report, load and save them into file +#' It will create `shiny::reactiveVal` variables and load report list from `report_path` +#' @keywords internal +ReportManager <- R6::R6Class("ReportManager", # nolint: object_name_linter + public = list( + #' @field reports_path (`character(1)`)\cr + #' An absolute path to a folder where reports are stored + reports_path = "reports", + + #' @field current_report_title (`character(1)`)\cr + #' `reactiveVal` field that stores current report title + current_report_title = NULL, + + #' @field available_reports (`list()`)\cr + #' `reactiveVal` field that stores a list of available reports + available_reports = list(), + + #' @field my_locked_report (`character(1)`)\cr + #' `reactiveVal` field that stores currently locked report title + my_locked_report = NULL, + + #' @field read_only_mode (`logical(1)`)\cr + #' `reactiveVal` field that indicates if current report is in read-only mode + read_only_mode = NULL, + + #' @field session + #' Placeholder for Shiny session object + session = NULL, + + #' Initialize `ReportManager` + #' @description + #' This can be used to manage state of report, load and save them into file + #' It will create `shiny::reactiveVal` variables and load report list from `reports_path` + #' @param reports_path (character) An absolute path to where reports are stored + #' @param session Session object passed from `moduleServer` + #' + #' @return `ReportManager` object + initialize = function(reports_path, session) { + self$reports_path <- reports_path + if (!dir.exists(reports_path)) { + dir.create(reports_path) + } + self$session <- session + self$available_reports <- shiny::reactiveVal(list()) + self$current_report_title <- shiny::reactiveVal(NULL) + self$read_only_mode <- shiny::reactiveVal(FALSE) + self$list_reports() + + # Register cleanup if session is provided + if (!is.null(session)) { + private$register_cleanup() + } + }, + + #' List available reports from objects' `reports_path` + #' + #' @return `data.frame` with fields `reports`, `created_by`, `locked_by`, and `last_rebuild` + list_reports = function() { + reports <- list.files(self$reports_path, full.names = FALSE) + + if (length(reports) == 0) { + reports_df <- data.frame( + reports = character(0), + created_by = character(0), + locked_by = character(0), + last_rebuild = character(0), + stringsAsFactors = FALSE + ) + } else { + lockfiles <- vapply(reports, function(x) { + report_lockfile <- file.path(self$get_abs_report_path(x), ".lockfile.rds") + if (file.exists(report_lockfile)) { + val <- readRDS(report_lockfile) + if (is.null(val)) NA_character_ else as.character(val) + } else { + NA_character_ + } + }, FUN.VALUE = character(1), USE.NAMES = FALSE) + + created_by <- vapply(reports, function(x) { + creator_file <- file.path(self$get_abs_report_path(x), ".creator.rds") + if (file.exists(creator_file)) { + val <- readRDS(creator_file) + if (is.null(val)) NA_character_ else as.character(val) + } else { + NA_character_ + } + }, FUN.VALUE = character(1), USE.NAMES = FALSE) + + last_rebuild <- vapply(reports, function(x) { + rebuild_file <- file.path(self$get_abs_report_path(x), ".rebuild_time.rds") + if (file.exists(rebuild_file)) { + timestamp <- readRDS(rebuild_file) + format(timestamp, "%Y-%m-%d %H:%M:%S") + } else { + "Never" + } + }, FUN.VALUE = character(1), USE.NAMES = FALSE) + + reports_df <- data.frame( + reports = reports, + created_by = created_by, + locked_by = lockfiles, + last_rebuild = last_rebuild, + stringsAsFactors = FALSE + ) + } + + self$available_reports(reports_df) + + reports_df + }, + + #' Method for storing loaded report title inside object. + #' This assigns a value in `current_report_title` field + #' + #' @param title_or_index (character/numeric) Title of report or an index from objects' `available_reports` + set_current_report_title = function(title_or_index) { + if (is.character(title_or_index)) { + self$current_report_title(title_or_index) + } else { + self$current_report_title(self$available_reports()[title_or_index]) + } + }, + + #' Get absolute report path + #' + #' @param title (character) A title of report to get path of + #' + #' @return (character) A path of desired report + get_abs_report_path = function(title) { + paste0(self$reports_path, "/", title) + }, + + #' Save report with provided title + #' This utilizes methods from `teal.reporter::Reporter` to store files required to load and save reports + #' If a report with specific title exists, it will overwrite it. + #' @param report_title (`character`) A title for the saved report. + #' @param reporter (`Reporter`) A reporter object passed from `teal::init` + #' @param first (`logical`) Whether this is the first time saving the report. + #' + save_report_files = function(report_title, reporter, first = FALSE) { + if (!dir.exists(self$get_abs_report_path(report_title))) { + dir.create(self$get_abs_report_path(report_title)) + } + + # Store creator information if not already saved + private$save_creator(report_title) + + if (!self$is_locked_by_other(report_title)) { + # Only save to JSON if there are cards + if (length(reporter$get_cards()) > 0) { + path <- self$get_abs_report_path(report_title) + tryCatch( + { + reporter$set_id(report_title) + reporter$to_jsondir(path) + private$save_card_codes(reporter, path) + }, + error = function(e) { + showNotification(e$message, type = "error") + } + ) + } + + # Always update lock and current title + self$current_report_title(report_title) + if (!is.null(self$my_locked_report)) private$unlock_report(self$my_locked_report) + private$lock_report(report_title) + self$available_reports(self$list_reports()) + } + NULL + }, + + #' Load report to report previewer + #' This utilizes methods from `teal.reporter::Reporter` to load reports + #' + #' @param selected_title (`integer` or `character`) An index or a title of a report to load + #' @param reporter (`Reporter`) A reporter object passed from `teal::init` + #' @param skip_lock (`boolean`) Whether to skip locking a report or not + load_report = function(selected_title, reporter, skip_lock = FALSE) { + assertthat::assert_that( + is.character(selected_title) | is.numeric(selected_title) + ) + report_title <- ifelse( + is.numeric(selected_title), self$available_reports()[selected_title, ][[1]], selected_title + ) + report_dir <- self$get_abs_report_path(report_title) + + tryCatch( + { + # Change reporter ID and load saved report + report_id <- jsonlite::read_json(file.path(report_dir, "Report.json"))$id + + reporter$set_id(as.character(report_id)) + reporter$from_jsondir(report_dir) + + # Only update state if loading succeeded + if (!skip_lock) { + if (!is.null(self$my_locked_report)) private$unlock_report(self$my_locked_report) + + if (!self$is_locked_by_other(report_title, message_type = "warning")) { + private$lock_report(report_title) + self$read_only_mode(FALSE) # Full access + } else { + self$read_only_mode(TRUE) # Read-only access + } + self$current_report_title(report_title) + } else { + # Skip lock mode is read-only + self$read_only_mode(TRUE) + self$current_report_title(report_title) + } + }, + error = function(e) { + showNotification(e$message, type = "error") + } + ) + }, + + #' Merge reports together + #' + #' @param x_title Base report title + #' @param y_title Title of report to merge into x + #' @param reporter A `TealReporter` object + merge_reports = function(x_title, y_title, reporter) { + y_rep <- teal.reporter::Reporter$new() + + x_dir <- self$get_abs_report_path(x_title) + y_dir <- self$get_abs_report_path(y_title) + + # Check if Report.json exists for both reports + if (!file.exists(file.path(x_dir, "Report.json"))) { + stop(paste("Report", x_title, "has no saved content to merge")) + } + if (!file.exists(file.path(y_dir, "Report.json"))) { + stop(paste("Report", y_title, "has no saved content to merge")) + } + + self$load_report(x_title, x_rep, skip_lock = TRUE) + self$load_report(y_title, y_rep, skip_lock = TRUE) + + reporter$append_cards(y_rep$get_cards()) + + self$save_report_files(x_title, reporter) + }, + + #' Reset report manager + #' + #' @return the return of `self$list_reports()` + reset = function() { + if (!is.null(self$current_report_title()) & !is.null(self$my_locked_report)) { + private$unlock_report(self$my_locked_report) + } + self$current_report_title(NULL) + self$read_only_mode(FALSE) + self$list_reports() + }, + + #' Delete report + #' @param selected_title (integer or character) An index or a title of a report to load + delete_report = function(selected_title) { + assertthat::assert_that( + is.character(selected_title) | is.numeric(selected_title) + ) + + if (is.numeric(selected_title)) { + avail_reports <- self$available_reports() + if (nrow(avail_reports) >= selected_title) { + report_title <- as.character(avail_reports$reports[selected_title]) + } else { + showNotification("Selected report index is out of range.", type = "error") + return() + } + } else { + report_title <- selected_title + } + + # Validate report title + if (is.null(report_title) || length(report_title) == 0 || !nzchar(report_title)) { + showNotification("Invalid report title.", type = "error") + return() + } + + report_dir <- self$get_abs_report_path(report_title) + + if (!self$is_locked_by_other(report_title, verbose = FALSE)) { + success <- tryCatch( + { + unlink(report_dir, recursive = TRUE) + TRUE + }, + error = function(e) { + showNotification(paste("Error deleting report:", e$message), type = "error") + FALSE + } + ) + + if (success) { + if (identical(self$current_report_title(), report_title)) { + self$reset() + } + showNotification(paste("Successfully deleted report:", report_title), type = "message") + } + } else { + showNotification(paste("Cannot delete locked report:", report_title), type = "error") + } + + self$list_reports() + }, + + #' Checks if report is locked by another user + #' @param report_title (character) A title for the saved report. + #' @param verbose (boolean) Whether to show notification on locked report or not + #' @param message_type (character) `shiny::showNotification's` type argument + #' + #' @return logical(1) TRUE if locked by another user, FALSE if unlocked or locked by me + is_locked_by_other = function(report_title, verbose = TRUE, message_type = "error") { + if (!is.null(self$my_locked_report) && self$my_locked_report == report_title) { + return(FALSE) + } + if (file.exists(private$get_metadata_path(report_title, ".lockfile.rds"))) { + lockfile <- readRDS(private$get_metadata_path(report_title, ".lockfile.rds")) + if (verbose) { + showNotification(paste( + "This report is locked by:", lockfile, + "Cannot save or delete report until unlocked." + ), type = message_type) + } + return(TRUE) + } + FALSE + }, + + #' Rename report + #' @param old_title (character) Current report title + #' @param new_title (character) New report title + #' @param reporter (Reporter) A reporter object + rename_report = function(old_title, new_title, reporter) { + old_path <- self$get_abs_report_path(old_title) + new_path <- self$get_abs_report_path(new_title) + + if (!dir.exists(old_path)) { + stop("Report directory does not exist") + } + + if (dir.exists(new_path)) { + stop("A report with that name already exists") + } + + # Rename directory + file.rename(old_path, new_path) + + # Update current title if this is the active report + if (identical(self$current_report_title(), old_title)) { + self$current_report_title(new_title) + # Update reporter ID + reporter$set_id(new_title) + # Save updated ID to JSON + reporter$to_jsondir(new_path) + } + + self$list_reports() + }, + + #' Check if this would be a new report + #' @param reporter (Reporter) A reporter object + #' @return logical indicating if this is a new report + is_new_report = function(reporter) { + current_title <- self$current_report_title() + has_cards <- length(reporter$get_cards()) > 0 + is.null(current_title) && has_cards + }, + + #' Create new report with title + #' @param report_title (character) Title for the new report + #' @param reporter (Reporter) A reporter object + create_new_report = function(report_title, reporter) { + if (is.null(report_title) || !nzchar(report_title)) { + stop("Report title cannot be empty") + } + + # Set the current report title and full access mode + self$current_report_title(report_title) + self$read_only_mode(FALSE) + + # Create report directory if it doesn't exist + if (!dir.exists(self$get_abs_report_path(report_title))) { + dir.create(self$get_abs_report_path(report_title), recursive = TRUE) + } + + # Store creator information + private$save_creator(report_title) + + # Save the report if it has cards + if (length(reporter$get_cards()) > 0) { + self$save_report_files(report_title, reporter) + } else { + # Even without cards, lock the report for the user + if (!is.null(self$my_locked_report)) private$unlock_report(self$my_locked_report) + private$lock_report(report_title) + self$available_reports(self$list_reports()) + } + }, + + #' Add `observeEvent` to invoke auto save on reporter cards change. + #' + #' @param reporter (Reporter) A reporter object passed from `teal::init` + auto_save_observer = function(reporter) { + shiny::observeEvent(reporter$get_cards(), + { + cards_count <- length(reporter$get_cards()) + current_title <- self$current_report_title() + is_read_only <- self$read_only_mode() + + # If no current title but cards exist, trigger new report modal + if (is.null(current_title) && cards_count > 0) { + # Set a flag that a new report modal should be shown + if (!is.null(self$session)) { + self$session$sendCustomMessage("show_new_report_modal", list()) + } + return() + } + + # Reset if no cards + if (!is.null(current_title) && cards_count == 0) { + self$reset() + } + + # Auto-save only if report already exists, not in read-only mode, and not locked by others + if (!is.null(current_title) && cards_count > 0 && !is_read_only && + !self$is_locked_by_other(current_title, verbose = FALSE)) { + # Guard against external uploads overwriting the active report: + # If the reporter's ID no longer matches the current report title, + # it means the reporter was loaded externally (e.g. via teal.reporter upload). + # Reset the ReportManager to prevent saving uploaded content over the active report. + reporter_id <- reporter$get_id() + if (!identical(reporter_id, current_title)) { + self$reset() + return() + } + print("Report updated. Saving changes.") + withProgress(message = "Saving report...", value = 0.3, { + self$save_report_files(current_title, reporter) + incProgress(0.7) + }) + } else if (!is.null(current_title) && cards_count > 0 && is_read_only) { + # Show warning if trying to modify read-only report + showNotification("This report is in read-only mode. Changes cannot be saved.", type = "warning") + } + }, + ignoreInit = TRUE + ) + }, + + #' Unlock a locked report + #' @param report_title (character) Title of the report to unlock + unlock_report_public = function(report_title) { + if (self$is_locked_by_other(report_title, verbose = FALSE)) { + private$unlock_report(report_title) + self$list_reports() + showNotification(paste("Unlocked report:", report_title), type = "message") + } else { + showNotification(paste("Report is not locked:", report_title), type = "warning") + } + }, + + #' Release lock on current report (keep report loaded but make it read-only) + #' @param report_title (character) Title of the report to release lock from + release_lock = function(report_title = NULL) { + if (is.null(report_title)) { + report_title <- self$current_report_title() + } + + if (!is.null(report_title) && !is.null(self$my_locked_report) && + self$my_locked_report == report_title) { + private$unlock_report(report_title) + self$list_reports() + showNotification(paste("Released lock on report:", report_title, "(now read-only)"), type = "message") + } else { + showNotification("No locked report to release", type = "warning") + } + }, + + #' Re-build reports + #' @description + #' Rebuild reports to include data that has changed. + #' This will replace loaded report cards with new cards, that were rebuilt from + #' a code used to generate these cards. + #' @param report_title (character) A title for the saved report. + #' @param rp (Reporter) A reporter object passed from `teal::init` + rebuild_report = function(report_title, rp) { + reporter <- teal.reporter::Reporter$new() + report_dir <- self$get_abs_report_path(report_title) + report_id <- jsonlite::read_json(file.path(report_dir, "Report.json"))$id + reporter$set_id(as.character(report_id)) + reporter$from_jsondir(report_dir) + + cards <- reporter$get_cards() + code_file <- file.path(report_dir, "code.rds") + card_codes <- if (file.exists(code_file)) readRDS(code_file) else list() + + for (i in seq_along(cards)) { + card_name <- names(cards)[[i]] + card <- cards[[i]] + card_code <- if (i <= length(card_codes)) card_codes[[i]] else card[[length(card)]] + + # Remove teal's internal data-setup lines that can't be re-evaluated + code_lines <- strsplit(card_code, "\n")[[1]] + cleaned_lines <- code_lines[ + !grepl("^\\s*(stopifnot|lockEnvironment)\\(", code_lines) & + !grepl("#\\s*@linksto\\b", code_lines) & + !grepl("\\.raw_data", code_lines) & + !grepl("\\[\\]", code_lines) + ] + cleaned <- paste(cleaned_lines, collapse = "\n") + + output <- tryCatch( + eval(parse(text = cleaned)), + error = function(e) { + warning(sprintf("Failed to rebuild card '%s': %s", card_name, e$message)) + NULL + } + ) + + if (!is.null(output)) { + idx <- which( + vapply(card, function(x) inherits(x, c("TableTree", "recordedplot", "chunk_output")), logical(1)) + ) + if (length(idx) > 0) { + card[[idx[1]]] <- output + reporter$replace_card(card = teal_card(card), card_id = card_name) + reporter$to_jsondir(report_dir) + } + } + } + + # Save rebuild timestamp + saveRDS(Sys.time(), private$get_metadata_path(report_title, ".rebuild_time.rds")) + + # Reload rebuilt report if it's the same as the one loaded. + if (!is.null(self$current_report_title()) && report_title == self$current_report_title()) { + self$load_report(report_title, rp) + print("Current report loaded") + } + print(paste0(report_title, ": Rebuild done")) + self$list_reports() + } + ), + private = list( + #' Get current user name + get_user_name = function() { + user_name <- ifelse(interactive(), Sys.getenv("USER"), self$session$user) + if (is.null(user_name) || user_name == "") user_name <- "Current User" + user_name + }, + + #' Get metadata file path + get_metadata_path = function(report_title, filename) { + file.path(self$get_abs_report_path(report_title), filename) + }, + + #' Lock report so that it can't be overwritten by another user + lock_report = function(report_title) { + if (!self$is_locked_by_other(report_title)) { + self$my_locked_report <- report_title + saveRDS( + object = private$get_user_name(), + file = private$get_metadata_path(report_title, ".lockfile.rds") + ) + } + }, + + #' Unlock report + unlock_report = function(report_title) { + if (!is.null(report_title) & dir.exists(self$get_abs_report_path(report_title))) { + file.remove(private$get_metadata_path(report_title, ".lockfile.rds")) + self$my_locked_report <- NULL + } + }, + + #' Save creator information + save_creator = function(report_title) { + creator_file <- private$get_metadata_path(report_title, ".creator.rds") + if (!file.exists(creator_file)) { + saveRDS(object = private$get_user_name(), file = creator_file) + } + }, + + #' Save code from each card as `code.rds` in the report directory. + save_card_codes = function(reporter, path) { + cards <- reporter$get_cards() + code_list <- lapply(cards, function(card) { + idx <- which(vapply(card, function(x) inherits(x, "code_chunk"), logical(1))) + if (length(idx) > 0) paste(vapply(card[idx], as.character, character(1)), collapse = "\n") else NA_character_ + }) + saveRDS(unname(code_list), file.path(path, "code.rds")) + }, + + #' Register `onSessionEnded` to unlock report when session is closed + register_cleanup = function() { + if (!is.null(self$session)) { + self$session$onSessionEnded(function() { + private$unlock_report(self$my_locked_report) + }) + } + } + ) +) diff --git a/R/tm_report_manager.R b/R/tm_report_manager.R new file mode 100644 index 0000000..e88667f --- /dev/null +++ b/R/tm_report_manager.R @@ -0,0 +1,871 @@ +#' Report Manager Module +#' +#' @details +#' This module supports collaborative work on `teal` reports, generated by `teal.reporter` +#' package. This module extends functionalities of `teal.reporter` and allows to store +#' reports in chosen path. Reports will be stored as JSON files inside folders named after +#' reports. +#' +#' @param reports_path character. Absolute path where reports should be stored. +#' @param auto_save logical. Whether to save active report whenever there are any changes made. +#' +#' @importFrom teal module +#' +#' @examples +#' +#' app <- teal::init( +#' data = teal.data::teal_data(IRIS = iris), +#' modules = teal::modules( +#' teal::example_module(transformators = list(or_filtering_transformator("IRIS"))), +#' tm_report_manager() +#' ) +#' ) +#' if (interactive()) { +#' shinyApp(app$ui, app$server) +#' } +#' @export +tm_report_manager <- function( + reports_path = "reports", + auto_save = TRUE +) { + module( + ui = report_manager_ui, + server = report_manager_server, + label = "Report Manager", + server_args = list( + reports_path = reports_path, + auto_save = auto_save + ) + ) +} + +#' The `UI` of [`tm_report_manager()`] +#' +#' @param id (`character`) the id of the module. +#' @importFrom DT DTOutput +#' @import shiny +#' +#' @keywords internal +report_manager_ui <- function(id) { + ns <- NS(id) + tagList( + tags$style(HTML(" + .dt_highlight{ background-color: #eb1700 !important; color: #ffffff !important;} + + /* Badge that appears on hover for highlighted rows only */ + .current_report_badge { + display: none; + margin-left: 6px; + font-size: 0.75em; + vertical-align: middle; + } + + /* Action buttons spacing */ + .dataTables_wrapper .btn { + margin-right: 3px; + } + + /* Tooltip styling */ + .tooltip { + font-size: 12px; + } + + /* Enable text wrapping in table cells */ + table.dataTable td { + white-space: normal; + word-wrap: break-word; + } + ")), + fluidRow( + column(4, + style = "text-align: left;", + actionButton(ns("show_help"), "Help", icon = icon("question-circle"), class = "btn-info btn-sm"), + actionButton(ns("merge_reports"), "Merge reports"), + actionButton(ns("create_new_report_btn"), "Create new report", icon = icon("plus"), class = "btn-success") + ) + ), + br(), + # List of reports + DT::DTOutput(ns("report_list"), width = "75%"), + tags$script(HTML(paste0(" + $(document).on('click', '.release-lock-btn', function() { + var reportName = $(this).data('report'); + Shiny.setInputValue('", ns("release_lock_click"), "', reportName, {priority: 'event'}); + }); + "))) + ) +} + +#' The server part of [`tm_report_manager()`]. +#' +#' @inheritParams tm_report_manager +#' @inheritParams report_manager_ui +#' @param reporter the object that holds the report. Provided by `teal`. +#' @import shiny teal +#' @importFrom DT renderDT +#' @importFrom shinyjs toggleState disable enable +#' @keywords internal +report_manager_server <- function(id, reports_path = "reports", auto_save = TRUE, reporter) { + moduleServer(id, function(input, output, session) { + ns <- session$ns + + # Initialize shinyjs + shinyjs::useShinyjs() + + # Initialize report manager object + rm <- ReportManager$new(reports_path = reports_path, session) + if (auto_save) { + rm$auto_save_observer(reporter) + } + + # reactiveVals + delete_candidate <- reactiveVal(NULL) + rebuild_candidate <- reactiveVal(NULL) + load_candidate <- reactiveVal(NULL) + edit_candidate <- reactiveVal(NULL) + release_candidate <- reactiveVal(NULL) + refresh_trigger <- reactiveVal(Sys.time()) + modal_shown <- reactiveVal(FALSE) + + # Helper functions + validate_title <- function(title) { + !is.null(title) && nzchar(trimws(title)) + } + + refresh_ui <- function() { + refresh_trigger(Sys.time()) + shinyjs::toggleState("merge_reports", condition = !is.null(rm$current_report_title())) + } + + handle_error <- function(action, err) { + showNotification(sprintf("Error %s: %s", action, conditionMessage(err)), type = "error") + } + + create_action_button <- function(action, report_name, icon, btn_class, title) { + safe_name <- gsub("'", "\\'", report_name) + sprintf( + paste0( + '' + ), + btn_class, ns(action), safe_name, title, icon + ) + } + + # Initially disable merge button and trigger initial load + shinyjs::disable("merge_reports") + observe( + { + rm$list_reports() + refresh_trigger(Sys.time()) + }, + priority = 1000 + ) + + # Monitor reporter cards for new report creation + observe({ + cards_count <- length(reporter$get_cards()) + current_title <- rm$current_report_title() + + # If cards exist but no current report and modal not shown, show modal + if (is.null(current_title) && cards_count > 0 && !modal_shown()) { + modal_shown(TRUE) + showModal(modalDialog( + title = "Create New Report", + "You are creating a new report. Please enter a report title:", + textInput(ns("new_report_title"), "Report title:", value = ""), + footer = tagList( + modalButton("Cancel"), + actionButton(ns("create_new_report"), "Create Report") + ), + easyClose = FALSE + )) + } + + # Reset flag when no cards + if (cards_count == 0) { + modal_shown(FALSE) + } + }) + + observeEvent(input$create_new_report, { + new_title <- trimws(input$new_report_title) + removeModal() + modal_shown(FALSE) + + if (!validate_title(new_title)) { + showNotification("Report title cannot be empty.", type = "error") + return() + } + + tryCatch( + { + rm$create_new_report(new_title, reporter) + rm$list_reports() + refresh_ui() + showNotification(sprintf("Created new report: %s", new_title), type = "message") + }, + error = function(err) handle_error("creating report", err) + ) + }) + + # Manual create new report button + observeEvent(input$create_new_report_btn, { + showModal(modalDialog( + title = "Create New Report", + "Enter a title for the new report. Current report will be saved automatically.", + textInput(ns("manual_new_report_title"), "Report title:", value = ""), + footer = tagList( + modalButton("Cancel"), + actionButton(ns("confirm_create_new_report"), "Create Report") + ), + easyClose = FALSE + )) + }) + + observeEvent(input$confirm_create_new_report, { + new_title <- trimws(input$manual_new_report_title) + removeModal() + + if (!validate_title(new_title)) { + showNotification("Report title cannot be empty.", type = "error") + return() + } + + tryCatch( + { + rm$create_new_report(new_title, reporter) + rm$list_reports() + refresh_ui() + showNotification(sprintf("Created new report: %s", new_title), type = "message") + }, + error = function(err) handle_error("creating report", err) + ) + }) + + # Help modal + observeEvent(input$show_help, { + showModal(modalDialog( + title = "Report Permissions", + HTML(" +
| Action | +Active Report | +Your Locked Report | +Others' Locked Report | +Unlocked Report | +
|---|---|---|---|---|
| Edit Title | +Yes | +Yes | +No | +No | +
| Delete | +No | +Yes | +No | +Yes | +
| Rebuild | +Yes | +Yes | +Yes | +Yes | +
| Load/View | +Already active | +Full access | +View only | +View only | +
| Release Lock | +Yes | +Yes | +No | +N/A | +
| Merge | +Yes* | +Yes* | +Yes* | +Yes* | +
+ * Merge requires reports to have saved content (cards) +
+ "), + size = "l", + footer = modalButton("Close"), + easyClose = TRUE + )) + }) + + # Release lock by clicking on lock icon + observeEvent(input$release_lock_click, { + release_candidate(input$release_lock_click) + showModal(modalDialog( + title = "Release Lock", + sprintf( + paste0( + "Are you sure you want to release your lock on '%s'?", + "The report will remain loaded but become read-only for you." + ), + input$release_lock_click + ), + footer = tagList( + modalButton("Cancel"), + actionButton(ns("confirm_release_lock"), "Yes, release lock") + ), + easyClose = FALSE + )) + }) + + observeEvent(input$confirm_release_lock, { + removeModal() + report_name <- release_candidate() + if (!validate_title(report_name)) { + showNotification("No report selected to release lock.", type = "error") + return() + } + + withProgress(message = "Releasing lock...", value = 0.3, { + tryCatch( + { + rm$release_lock(report_name) + refresh_trigger(Sys.time()) + }, + error = function(err) handle_error("releasing lock", err) + ) + incProgress(0.7) + }) + }) + + # Refresh button handler + observeEvent(input$refresh_report_list, { + tryCatch( + { + rm$list_reports() + refresh_ui() + showNotification("Report list refreshed", type = "message") + }, + error = function(err) handle_error("refreshing list", err) + ) + }) + + output$report_list <- DT::renderDT({ + # Depend on refresh trigger and the current report title to ensure updates + refresh_trigger() + current_title <- rm$current_report_title() + + # Also depend on the reporter cards to trigger refresh when new cards are added + reporter$get_cards() + + df <- rm$available_reports() + if (is.null(df) || nrow(df) == 0) { + df <- data.frame( + reports = character(0), + created_by = character(0), + locked_by = character(0), + last_rebuild = character(0), + stringsAsFactors = FALSE + ) + } + + # Ensure all required columns exist + if (!"reports" %in% names(df)) df$reports <- character(0) + if (!"created_by" %in% names(df)) df$created_by <- character(0) + if (!"locked_by" %in% names(df)) df$locked_by <- character(0) + if (!"last_rebuild" %in% names(df)) df$last_rebuild <- character(0) + + # Ensure 'reports' is character + df$reports <- as.character(df$reports) + + # If current report exists but not in df, add it + if (!is.null(current_title) && nzchar(as.character(current_title))) { + if (length(df$reports) == 0 || !any(df$reports == as.character(current_title))) { + user_name <- ifelse(interactive(), Sys.getenv("USER"), session$user) + if (is.null(user_name) || user_name == "") user_name <- "Current User" + + current_locked_by <- if (!is.null(rm$my_locked_report) && + rm$my_locked_report == as.character(current_title)) { + user_name + } else { + "" + } + + new_row <- data.frame( + reports = as.character(current_title), + created_by = user_name, + locked_by = current_locked_by, + last_rebuild = "Never", + stringsAsFactors = FALSE + ) + df <- rbind(new_row, df) + } + } + + # Format columns for display + df$locked_by <- ifelse(is.na(df$locked_by) | df$locked_by == "", "", as.character(df$locked_by)) + df$created_by <- ifelse(is.na(df$created_by) | df$created_by == "", "", as.character(df$created_by)) + df$last_rebuild <- ifelse(is.na(df$last_rebuild) | df$last_rebuild == "", "Never", as.character(df$last_rebuild)) + + # Add status HTML column with Active/Locked/Unlocked logic + if (nrow(df) > 0) { + df$status <- vapply(seq_len(nrow(df)), function(i) { + report_name <- as.character(df$reports[i]) + locked_by_val <- as.character(df$locked_by[i]) + is_locked <- !is.na(locked_by_val) && nzchar(locked_by_val) + + if (!is.null(current_title) && identical(report_name, as.character(current_title))) { + 'Active' + } else if (is_locked) { + 'Locked' + } else { + 'Unlocked' + } + }, character(1)) + } else { + df$status <- character(0) + } + + # Add combined Actions column with icons and tooltips + if (nrow(df) > 0) { + df$actions <- vapply(seq_len(nrow(df)), function(i) { + report_name <- as.character(df$reports[i]) + locked_by_val <- as.character(df$locked_by[i]) + is_locked <- !is.na(locked_by_val) && nzchar(locked_by_val) + is_active <- !is.null(current_title) && identical(report_name, as.character(current_title)) + + # Lock status icon (first in actions) + is_my_lock <- !is.null(rm$my_locked_report) && rm$my_locked_report == report_name + if (is_locked) { + if (is_my_lock) { + # Clickable lock for user's own locks + lock_icon <- sprintf( + paste0( + '' + ), + report_name + ) + } else { + # Non-clickable lock for others' locks + lock_icon <- paste0( + '' + ) + } + } else { + lock_icon <- '' + } + + # Action buttons based on state + if (is_active) { + # Active report: can edit title, cannot delete, can rebuild + edit_btn <- create_action_button("edit_row", report_name, "edit", "btn-warning", "Edit report title") + load_btn <- paste0( + '' + ) + rebuild_btn <- create_action_button( + "rebuild_row", + report_name, "refresh", "btn-primary", "Rebuild report with new data" + ) + delete_btn <- paste0( + '' + ) + } else if (is_locked) { + if (is_my_lock) { + # My locked report: can edit, load, rebuild, delete + edit_btn <- create_action_button("edit_row", report_name, "edit", "btn-warning", "Edit report title") + load_btn <- create_action_button("load_row", report_name, "download", "btn-success", "Load this report") + rebuild_btn <- create_action_button( + "rebuild_row", report_name, "refresh", "btn-primary", "Rebuild report with new data" + ) + delete_btn <- create_action_button( + "delete_report", report_name, "trash", "btn-danger", "Delete this report" + ) + } else { + # Others' locked report: can view and rebuild, cannot edit/delete + edit_btn <- paste0( + '' + ) + load_btn <- create_action_button( + "load_row", report_name, "eye", "btn-info", "View this report (read-only)" + ) + rebuild_btn <- create_action_button( + "rebuild_row", report_name, "refresh", "btn-primary", "Rebuild report with new data" + ) + delete_btn <- paste0( + '" + ) + } + } else { + # Unlocked report: can view, delete, and rebuild, cannot edit + edit_btn <- paste0( + '' + ) + load_btn <- create_action_button("load_row", report_name, "eye", "btn-info", "View this report") + rebuild_btn <- create_action_button( + "rebuild_row", report_name, "refresh", "btn-primary", "Rebuild report with new data" + ) + delete_btn <- create_action_button( + "delete_report", report_name, "trash", "btn-danger", "Delete this report" + ) + } + + # Combine all elements with spacing + paste(lock_icon, edit_btn, load_btn, rebuild_btn, delete_btn, sep = " ") + }, character(1)) + } else { + df$actions <- character(0) + } + + # Rename columns for display + colnames(df) <- c("Report Title", "Created by", "Locked by", "Last Rebuild", "Status", "Actions") + + # Render the datatable + DT::datatable( + df, + escape = FALSE, + selection = "single", + rownames = FALSE, + options = list( + pageLength = 10, + autoWidth = TRUE, + searching = FALSE, + lengthChange = FALSE, + initComplete = DT::JS( + "function(settings, json) {", + " $('[data-toggle=\"tooltip\"]').tooltip();", + "}" + ), + drawCallback = DT::JS( + "function(settings) {", + " $('[data-toggle=\"tooltip\"]').tooltip();", + "}" + ), + rowCallback = DT::JS( + "function(row, data, index){", + " $('[data-toggle=\"tooltip\"]').tooltip();", + "}" + ) + ) + ) + }) + + # Merge reports button handler + observeEvent(input$merge_reports, { + avail_reports <- rm$available_reports() + current <- rm$current_report_title() + + # Filter reports that have Report.json (have content) + reports_with_content <- character(0) + for (report in avail_reports$reports) { + report_json <- file.path(rm$get_abs_report_path(report), "Report.json") + if (file.exists(report_json)) { + reports_with_content <- c(reports_with_content, report) + } + } + + if (length(reports_with_content) < 2) { + showNotification("Need at least 2 reports with content to merge.", type = "error") + return() + } + + showModal( + modalDialog( + title = "Merge Reports", + checkboxGroupInput( + inputId = ns("merge_select"), + label = "Select reports to merge (select 2 or more):", + choices = reports_with_content, + selected = if (!is.null(current) && current %in% reports_with_content) current else NULL + ), + textInput(ns("merged_report_title"), "New merged report title:", value = ""), + footer = tagList( + modalButton("Cancel"), + actionButton(ns("confirm_merge"), "Merge reports") + ) + ) + ) + }) + + observeEvent(input$confirm_merge, { + removeModal() + selected_reports <- input$merge_select + new_title <- trimws(input$merged_report_title) + + if (length(selected_reports) < 2) { + showNotification("Please select at least 2 reports to merge.", type = "error") + return() + } + + if (!validate_title(new_title)) { + showNotification("Merged report title cannot be empty.", type = "error") + return() + } + + withProgress(message = "Merging reports...", value = 0.3, { + tryCatch( + { + # Load first report as base + rm$load_report(selected_reports[1], reporter) + + # Merge remaining reports into it + for (i in 2:length(selected_reports)) { + rm$merge_reports(selected_reports[1], selected_reports[i], reporter) + } + + # Rename to new title + rm$rename_report(selected_reports[1], new_title, reporter) + + # Delete original reports except the first one (now renamed) + for (report in selected_reports[-1]) { + rm$delete_report(report) + } + + refresh_ui() + showNotification( + sprintf("Successfully merged %d reports into '%s'", length(selected_reports), new_title), + type = "message" + ) + }, + error = function(err) handle_error("merging reports", err) + ) + incProgress(0.7) + }) + }) + + # ---- Row button handlers (delete / rebuild / load / edit) ---- + + # Edit row clicked -> show edit modal + observeEvent(input$edit_row, { + edit_candidate(input$edit_row) + showModal(modalDialog( + title = "Edit Report Title", + textInput(ns("new_report_title"), "New report title:", value = input$edit_row), + footer = tagList( + modalButton("Cancel"), + actionButton(ns("confirm_edit"), "Save") + ), + easyClose = FALSE + )) + }) + + observeEvent(input$confirm_edit, { + removeModal() + old_title <- edit_candidate() + new_title <- trimws(input$new_report_title) + + if (!validate_title(new_title)) { + showNotification("Report title cannot be empty.", type = "error") + return() + } + + if (old_title == new_title) { + return() + } + + withProgress(message = "Renaming report...", value = 0.2, { + tryCatch( + { + rm$rename_report(old_title, new_title, reporter) + refresh_ui() + showNotification(sprintf("Renamed report from '%s' to '%s'", old_title, new_title), type = "message") + }, + error = function(err) handle_error("renaming report", err) + ) + incProgress(0.8) + }) + }) + + # Delete row clicked -> show confirm modal + observeEvent(input$delete_report, { + delete_candidate(input$delete_report) + showModal(modalDialog( + title = "Are you sure you want to delete this report?", + footer = tagList( + modalButton("Cancel"), + actionButton(ns("final_delete"), "Yes, delete report") + ), + easyClose = FALSE + )) + }) + + observeEvent(input$final_delete, { + removeModal() + report_name <- delete_candidate() + if (!validate_title(report_name)) { + showNotification("No report selected to delete.", type = "error") + return() + } + + current_title <- rm$current_report_title() + if (!is.null(current_title) && identical(as.character(report_name), as.character(current_title))) { + showNotification("Cannot delete the currently active report.", type = "error") + return() + } + + withProgress(message = "Deleting report...", value = 0.3, { + tryCatch( + { + rm$delete_report(report_name) + refresh_ui() + showNotification(sprintf("Deleted report: %s", report_name), type = "message") + }, + error = function(err) handle_error("deleting report", err) + ) + incProgress(0.7) + }) + }) + + # Rebuild row clicked -> show confirm modal + observeEvent(input$rebuild_row, { + rebuild_candidate(input$rebuild_row) + showModal(modalDialog( + title = "Are you sure you want to rebuild the report with new data?", + "Unsaved changes to the report will be lost", + footer = tagList( + modalButton("Cancel"), + actionButton(ns("confirm_rebuild"), "Yes, rebuild") + ), + easyClose = FALSE + )) + }) + + observeEvent(input$confirm_rebuild, { + removeModal() + report_id <- rebuild_candidate() + if (!validate_title(as.character(report_id))) { + showNotification("No report selected to rebuild.", type = "error") + return() + } + withProgress(message = "Rebuilding report...", value = 0.2, { + tryCatch( + { + rm$rebuild_report(report_id, rp = reporter) + refresh_ui() + showNotification(sprintf("Rebuild started for report: %s", report_id), type = "message") + }, + error = function(err) { + handle_error("rebuilding report", err) + message("Rebuild error for report: ", report_id) + message(conditionMessage(err)) + } + ) + incProgress(0.8) + }) + }) + + # Load row clicked -> confirm and call load + observeEvent(input$load_row, { + load_candidate(input$load_row) + report_name <- input$load_row + + # Check if this is a locked report by someone else or unlocked + avail_reports <- rm$available_reports() + report_row <- avail_reports[avail_reports$reports == report_name, ] + locked_by_val <- if (nrow(report_row) > 0) report_row$locked_by else "" + is_locked <- !is.na(locked_by_val) && nzchar(locked_by_val) + is_my_lock <- !is.null(rm$my_locked_report) && rm$my_locked_report == report_name + + if (is_locked && !is_my_lock) { + # Others' locked report - view only + showModal(modalDialog( + title = "View Report (Read-Only)", + "This report is locked by another user. You can view it but cannot make changes. Do you want to continue?", + footer = tagList( + modalButton("Cancel"), + actionButton(ns("confirm_view_report"), "Yes, view report") + ), + easyClose = FALSE + )) + } else { + # My locked report or can be locked - full access + showModal(modalDialog( + title = "Load report", + "Unsaved changes to the current report will be lost. Do you want to load this report?", + footer = tagList( + modalButton("Cancel"), + actionButton(ns("confirm_load_row"), "Yes, load report") + ), + easyClose = FALSE + )) + } + }) + + observeEvent(input$confirm_view_report, { + removeModal() + report_name <- load_candidate() + if (!validate_title(report_name)) { + showNotification("No report selected to view.", type = "error") + return() + } + withProgress(message = "Loading report (read-only)...", value = 0.2, { + tryCatch( + { + # Load report without locking (read-only mode) + rm$load_report(report_name, reporter, skip_lock = TRUE) + refresh_ui() + showNotification(sprintf("Loaded report in read-only mode: %s", report_name), type = "message") + }, + error = function(err) handle_error("loading report", err) + ) + incProgress(0.8) + }) + }) + + observeEvent(input$confirm_load_row, { + removeModal() + report_name <- load_candidate() + if (!validate_title(report_name)) { + showNotification("No report selected to load.", type = "error") + return() + } + withProgress(message = "Loading report...", value = 0.2, { + tryCatch( + { + rm$load_report(report_name, reporter) + refresh_ui() + showNotification(sprintf("Loaded report: %s", report_name), type = "message") + }, + error = function(err) handle_error("loading report", err) + ) + incProgress(0.8) + }) + }) + + # Insert Refresh button once + onFlushed(function() { + insertUI( + selector = "#teal-teal_modules-nav-report_manager-wrapper > div:nth-child(1) > div:nth-child(2)", + where = "afterBegin", + ui = tags$div( + id = ns("refresh_report_btn_wrapper"), + actionButton(ns("refresh_report_list"), "Refresh list", class = "btn-primary") + ) + ) + }, once = TRUE) + }) +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 6fb52f8..c16b3ce 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -38,3 +38,6 @@ reference: - title: Utility functions contents: - g_forest_with_transform + - title: Report manager + contents: + - tm_report_manager diff --git a/man/ReportManager.Rd b/man/ReportManager.Rd new file mode 100644 index 0000000..e893fa7 --- /dev/null +++ b/man/ReportManager.Rd @@ -0,0 +1,413 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ReportManager.R +\name{ReportManager} +\alias{ReportManager} +\title{\code{ReportManager} Object} +\description{ +This can be used to manage state of report, load and save them into file +It will create \code{shiny::reactiveVal} variables and load report list from \code{report_path} +} +\keyword{internal} +\section{Public fields}{ +\if{html}{\out{