R/app_module_file.R

Defines functions app_upload_accept app_under_folder app_isofile_types data_only_aggregator ie_file_ui ie_file_server

Documented in ie_file_server ie_file_ui

#' Central file-management module
#'
#' The single source of truth for the isofiles in an isoexplorer app, and the hub
#' every other module talks to. It maintains a *running* set of read isofiles
#' (seeded from `get_isofiles()`, grown by uploads and watched folders), splits it
#' into the three measurement types (scans / continuous flow / dual inlet) with
#' [isoreader2::ir_filter_for_scans()] and friends, owns the shared intensity-units
#' selection and the per-type file selection, and exposes the per-type metadata
#' (for the [ie_metadata_server()] selector tables) and the selection-filtered
#' aggregated data (for the `*_plot_server()` modules).
#'
#' Selector tables read `get_<type>_metadata()` and push their selection via
#' `set_selected_<type>()`; plot modules read `get_aggregated_<type>_data()` and
#' drive the shared units via `get_units()` / `set_units()`.
#'
#' **Dynamic files.** New files (uploaded, or appearing in `monitoring_folders`)
#' are read with [isoreader2::ir_read_isofiles()] and appended; aggregation is
#' incremental (only new files are read/aggregated, then combined with `c()`), so
#' already-read files are never re-read.
#'
#' **Upload.** When `upload_folder` is set the module owns a navbar upload button
#' (the [ie_file_ui()] placeholder) that opens a modal to upload multiple files or
#' whole folders bundled as `.zip` archives (the picker allows `.zip`, the file
#' types isoreader2 reads, and `.json` -- which covers their `.<type>.json`
#' serializations such as `foo.cf.json`). Uploaded files are stored in
#' `upload_folder` (archives unpacked), and **only the just-uploaded files are
#' read** -- files already present in `upload_folder` when the app started are
#' left untouched. An "Auto-select the newly uploaded files" checkbox (off by
#' default) exclusively selects the new files in the relevant type's table and, in
#' the full multi-tab app, switches to that type's tab.
#'
#' **Monitoring.** `monitoring_folders` are polled; any isofiles found there with
#' [isoreader2::ir_find_isofiles()] (including files already present at startup)
#' are read and added.
#'
#' **Getting started.** When `examples_folder` and/or `upload_folder` is set but the
#' app is launched without data (empty `get_isofiles()`), a prompt is shown once
#' inviting the user to load the examples and/or upload their own files; an app
#' launched with data never sees it.
#'
#' @param id the module id (namespace)
#' @param get_isofiles a reactive returning an `ir_isofiles` to seed the app with
#'   (already read); `reactive(NULL)` is fine when files only arrive via upload /
#'   monitoring
#' @param initial_selection what is selected, per type, before any selector pushes
#'   a selection. An expression evaluated as a [dplyr::filter()] on the type's
#'   aggregated metadata tibble: `TRUE` (default) selects everything, `FALSE`
#'   selects nothing, and any other expression selects the matching rows (e.g.
#'   `grepl("std", file_name)`). Captured via tidy evaluation, so it may reference
#'   variables from the calling environment. Passed pre-quoted (a quosure) by the
#'   `ie_explore_*()` / [ie_run_app()] wrappers.
#' @param upload_folder directory where uploaded files are stored (created on
#'   demand); `NULL` (the default) means no upload button -- set a directory path
#'   to enable uploads.
#' @param monitoring_folders character vector of folders to watch; isofiles found
#'   there with [isoreader2::ir_find_isofiles()] are read and added automatically.
#'   `NULL` (default) disables monitoring.
#' @param examples_folder directory the "Load examples" navbar button copies the
#'   isoreader2 bundled example files into (and then loads). `NULL` (the default)
#'   means no examples button.
#' @param temporary_storage if `TRUE`, the upload dialog states that uploaded
#'   files are stored only for the duration of the session. Informational only --
#'   it does not change how or where files are stored (default `FALSE`).
#' @return The "file handle": a list of reactive accessors / setters. For each
#'   `<type>` in `scans` / `cf` / `di`: `get_units()`/`set_units(units)` (shared
#'   intensity units, default "mV"); `get_<type>_metadata()`;
#'   `set_selected_<type>(rows)`; `get_<type>_selection()`;
#'   `get_aggregated_<type>_data()`; plus `get_<type>_select_signal()` (file paths
#'   a selector should select, fired by upload auto-select) and `get_active_type()`
#'   (the type whose tab to activate after an auto-select).
#' @examples
#' if (interactive()) {
#'   library(shiny)
#'   # read the bundled isoreader2 examples for some scans data
#'   iso <-
#'     isoreader2::ir_examples_folder() |>
#'     isoreader2::ir_find_isofiles() |>
#'     isoreader2::ir_read_isofiles()
#'
#'   ui <- bslib::page_fillable(
#'     ie_type_explorer_ui("meta", ie_scans_plot_ui("scan"))
#'   )
#'   server <- function(input, output, session) {
#'     # the hub: every other module reads/writes through this handle
#'     file <- ie_file_server("files", get_isofiles = reactive(iso))
#'     ie_scans_metadata_server("meta", file) # selection -> file server
#'     ie_scans_plot_server("scan", file)     # file server -> plot
#'   }
#'   shinyApp(ui, server)
#' }
#' @export
ie_file_server <- function(
  id,
  get_isofiles,
  initial_selection = TRUE,
  upload_folder = NULL,
  monitoring_folders = NULL,
  examples_folder = NULL,
  temporary_storage = FALSE
) {
  # `initial_selection` is a tidy-eval filter expression (TRUE = all, FALSE = none,
  # else a dplyr::filter condition on the metadata). Capture it here; callers that
  # already hold a quosure (app_server, the ie_explore_*/ie_run_app wrappers)
  # forward it spliced (`!!`) so this enquo() picks up the original quosure.
  initial_selection <- rlang::enquo(initial_selection)
  upload_folder |>
    check_arg(
      is.null(upload_folder) || is_scalar_character(upload_folder),
      "must be a directory path or NULL"
    )
  examples_folder |>
    check_arg(
      is.null(examples_folder) || is_scalar_character(examples_folder),
      "must be a directory path or NULL"
    )
  monitoring_folders |>
    check_arg(
      is.null(monitoring_folders) || is.character(monitoring_folders),
      "must be a character vector of folder paths or NULL"
    )
  # the file server performs the isoreader2 aggregation, so make sure isoreader2
  # is attached and its aggregators are registered -- this lets apps built from
  # the modules directly (a raw shinyApp, not via ie_run_app) work too
  ensure_isoreader2_attached()
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    # shared intensity units (default mV) -- plot modules get/set this
    units <- reactiveVal("mV")
    get_units <- reactive(units())
    set_units <- function(new_units) units(new_units)

    # surface any isoreader2 `$problems` recorded in a read/aggregate result.
    # These are collected internally, NOT thrown as R conditions, so
    # try_catch_cnds() never sees them. We display exactly what ir_show_problems()
    # prints -- its concise, cli-formatted summary -- captured with cli::cli_fmt()
    # (no backtraces) in a modal dialog (line breaks kept via \n -> <br>, like
    # log_error). `last_problems` dedups: a read and its follow-up aggregation, and
    # every units-driven re-aggregation, all re-surface the SAME problems, so we
    # only pop the dialog when a genuinely new problem appears.
    last_problems <- ""
    log_problems <- function(result, user_msg) {
      if (is.null(result) || nrow(isoreader2::ir_get_problems(result)) == 0) {
        return(invisible(NULL))
      }
      summary <- paste(
        cli::cli_fmt(isoreader2::ir_show_problems(result)),
        collapse = "\n"
      )
      if (identical(summary, last_problems)) {
        return(invisible(NULL))
      }
      last_problems <<- summary
      rlog::log_warn(paste0("[", ns(NULL), "] ", user_msg, "\n", summary))
      showModal(modalDialog(
        title = user_msg,
        pre(HTML(gsub("\\n", "<br>", cli::ansi_html(summary)))),
        easyClose = TRUE,
        footer = modalButton("Close")
      ))
    }

    # RUNNING set of read isofiles =====
    # grows as files are added; already-read files (by file_path) are never
    # re-read -- new files are read, then combined onto the running set with c().
    managed <- reactiveVal(NULL)
    current_paths <- function() {
      m <- isolate(managed())
      if (is.null(m)) character(0) else m$file_path
    }
    # append already-read isofiles, keeping only rows whose file_path is new
    merge_isofiles <- function(iso) {
      if (is.null(iso) || nrow(iso) == 0) {
        return(invisible(NULL))
      }
      keep <- iso[!(iso$file_path %in% current_paths()), , drop = FALSE]
      if (nrow(keep) == 0) {
        return(invisible(NULL))
      }
      class(keep) <- class(iso)
      cur <- isolate(managed())
      managed(if (is.null(cur)) keep else c(cur, keep))
      invisible(keep)
    }
    # read the paths that aren't already read and append; returns the new isofiles
    add_paths <- function(paths) {
      new <- setdiff(unique(paths), current_paths())
      if (length(new) == 0) {
        return(invisible(NULL))
      }
      # reading can take a while for many/large files; show a progress indicator
      # so the user knows the upload / load is being processed (the file picker's
      # own bar only covers the browser->server transfer, not the read)
      out <- withProgress(
        message = format_inline("Loading {length(new)} data file{?s}"),
        detail = "This may take a moment...",
        value = 0.5,
        isoreader2::ir_read_isofiles(new, show_progress = FALSE) |>
          try_catch_cnds()
      )
      out |> log_cnds(ns = ns)
      log_problems(out$result, "Problem(s) reading data files")
      merge_isofiles(out$result)
    }

    # seed from / merge in the externally provided isofiles (already read)
    observeEvent(
      get_isofiles(),
      merge_isofiles(get_isofiles()),
      ignoreNULL = TRUE
    )

    # per-type isofiles: filter the running set; NULL when a type has no files
    # (aggregating a 0-row isofiles errors)
    split_for <- function(filter_fn) {
      reactive({
        m <- managed()
        if (is.null(m) || nrow(m) == 0) {
          return(NULL)
        }
        out <- filter_fn(m) |> try_catch_cnds()
        out |> log_cnds(ns = ns)
        res <- out$result
        if (is.null(res) || nrow(res) == 0) NULL else res
      })
    }
    scans_isofiles <- split_for(isoreader2::ir_filter_for_scans)
    cf_isofiles <- split_for(isoreader2::ir_filter_for_continuous_flow)
    di_isofiles <- split_for(isoreader2::ir_filter_for_dual_inlet)

    # INCREMENTAL aggregation =====
    # a running ir_aggregated_data for get_subset(): only files whose file_path is
    # new since the last run are aggregated (then c()-ed on); a change in
    # reset_key() (e.g. units) forces a full re-aggregation from scratch.
    incremental_agg <- function(
      get_subset,
      aggregate,
      reset_key = reactive(NULL)
    ) {
      out <- reactiveVal(NULL)
      state <- list(paths = character(0), key = NULL)
      observe({
        iso <- get_subset()
        key <- reset_key()
        isolate({
          if (is.null(iso) || nrow(iso) == 0) {
            out(NULL)
            state <<- list(paths = character(0), key = key)
            return()
          }
          if (!identical(state$key, key)) {
            res <- aggregate(iso) |> try_catch_cnds()
            res |> log_cnds(ns = ns)
            log_problems(res$result, "Problem(s) aggregating data")
            out(res$result)
            state <<- list(paths = iso$file_path, key = key)
            return()
          }
          new <- setdiff(iso$file_path, state$paths)
          if (length(new) == 0) {
            return()
          }
          new_iso <- iso[iso$file_path %in% new, , drop = FALSE]
          class(new_iso) <- class(iso)
          res <- aggregate(new_iso) |> try_catch_cnds()
          res |> log_cnds(ns = ns)
          log_problems(res$result, "Problem(s) aggregating data")
          cur <- out()
          out(if (is.null(cur)) res$result else c(cur, res$result))
          state <<- list(paths = iso$file_path, key = key)
        })
      })
      out
    }
    # the data-only aggregator (no metadata aggregation); built once at runtime
    # (isoreader2 is attached by then). The metadata is aggregated separately
    # (metadata aggregator) and re-attached below, so it is not aggregated twice.
    data_aggregator <- data_only_aggregator()
    meta_agg_for <- function(get_subset) {
      incremental_agg(get_subset, function(iso) {
        withProgress(
          message = "Aggregating metadata",
          detail = "This may take a moment...",
          value = 0.5,
          isoreader2::ir_aggregate_isofiles(
            iso,
            aggregator = "metadata",
            show_progress = FALSE
          )
        )
      })
    }
    data_agg_for <- function(get_subset, type_label) {
      incremental_agg(
        get_subset,
        function(iso) {
          log_info(
            ns = ns,
            user_msg = paste0(
              "Aggregating ",
              type_label,
              " data with intensity units ",
              get_units()
            )
          )
          res <- withProgress(
            message = paste0("Aggregating ", type_label, " data"),
            detail = "This may take a moment...",
            value = 0.5,
            # data-only aggregator: metadata is re-used from the metadata
            # aggregation (see combine_meta_data() below), not recomputed here
            isoreader2::ir_aggregate_isofiles(
              iso,
              intensity_units = get_units(),
              aggregator = data_aggregator,
              show_progress = FALSE
            )
          )
          # attach a minimal uidx/file_path metadata so the result is a complete
          # ir_aggregated_data (problem reporting + c() rely on $metadata); the full
          # metadata is re-attached from the metadata aggregation in
          # combine_meta_data(). uidx is assigned by file position, matching the data
          # tables (and the metadata aggregation, which sees the same files in order)
          res$metadata <- tibble::tibble(
            uidx = seq_len(nrow(iso)),
            file_path = iso$file_path
          )
          res
        },
        reset_key = get_units
      )
    }
    scans_meta_agg <- meta_agg_for(scans_isofiles)
    cf_meta_agg <- meta_agg_for(cf_isofiles)
    di_meta_agg <- meta_agg_for(di_isofiles)
    scans_data_agg <- data_agg_for(scans_isofiles, "scans")
    cf_data_agg <- data_agg_for(cf_isofiles, "continuous flow")
    di_data_agg <- data_agg_for(di_isofiles, "dual inlet")

    metadata_of <- function(get_agg) {
      reactive({
        a <- get_agg()
        if (is.null(a)) NULL else a$metadata
      })
    }
    get_scans_metadata <- metadata_of(scans_meta_agg)
    get_cf_metadata <- metadata_of(cf_meta_agg)
    get_di_metadata <- metadata_of(di_meta_agg)

    # attach the separately-aggregated metadata to the data-only aggregation (their
    # uidx line up -- both aggregate the same per-type isofiles in the same order),
    # so the plot data has the `$metadata` the plotting functions join against
    # without the data aggregation having to recompute it
    combine_meta_data <- function(get_data_agg, get_meta_agg) {
      reactive({
        d <- get_data_agg()
        if (is.null(d)) {
          return(NULL)
        }
        m <- get_meta_agg()
        if (!is.null(m)) {
          d$metadata <- m$metadata
        }
        d
      })
    }
    scans_data_full <- combine_meta_data(scans_data_agg, scans_meta_agg)
    cf_data_full <- combine_meta_data(cf_data_agg, cf_meta_agg)
    di_data_full <- combine_meta_data(di_data_agg, di_meta_agg)

    # resolve the configured `initial_selection` filter for a type given its
    # metadata (NULL = all, 0-row = none, else the matching rows; see
    # resolve_selection_filter()). A filter that errors (e.g. an unknown column) is
    # surfaced and treated as "nothing selected".
    resolve_initial_selection <- function(metadata) {
      out <- resolve_selection_filter(metadata, initial_selection) |>
        try_catch_cnds()
      out |> log_cnds(ns = ns)
      if (nrow(out$conditions) > 0 && any(out$conditions$type == "error")) {
        return(tibble::tibble())
      }
      out$result
    }

    # per-type selection: a user override (NULL until a selector pushes something)
    # on top of `initial_selection` (NULL = all, 0-row = none, else filter by uidx).
    # `has_override` reports whether a concrete selection has been pushed yet (vs
    # the initial-selection default still being in effect); the upload handler
    # uses it to keep that default from claiming files the user declined to select.
    make_selection <- function(get_type_metadata) {
      override <- reactiveVal(NULL)
      list(
        get = reactive({
          if (!is.null(override())) {
            override()
          } else {
            resolve_initial_selection(get_type_metadata())
          }
        }),
        set = function(x) override(x),
        has_override = function() !is.null(isolate(override()))
      )
    }
    scans_selection <- make_selection(get_scans_metadata)
    cf_selection <- make_selection(get_cf_metadata)
    di_selection <- make_selection(get_di_metadata)
    selections <- list(
      scans = scans_selection,
      cf = cf_selection,
      di = di_selection
    )

    # the selection-filtered aggregated data the plot modules consume
    aggregated_for <- function(get_data_agg, get_selected) {
      reactive({
        agg <- get_data_agg()
        if (is.null(agg)) {
          return(NULL)
        }
        selected <- get_selected()
        if (is.null(selected)) {
          return(agg) # nothing pushed yet -> all files
        }
        filter_agg_data_by_metadata(agg, selected) # NULL when 0 rows -> empty
      })
    }

    # FOLDER MONITORING (optional) =====
    if (length(monitoring_folders) > 0) {
      find_all <- function() {
        unlist(lapply(monitoring_folders, function(f) {
          if (dir.exists(f)) isoreader2::ir_find_isofiles(f) else character(0)
        }))
      }
      monitored <- reactivePoll(
        intervalMillis = 2000,
        session = session,
        checkFunc = function() paste(sort(find_all()), collapse = "|"),
        valueFunc = find_all
      )
      observe(add_paths(monitored()))
    }

    # AUTO-SELECT signals (upload) =====
    # `active_type` carries list(type, n) so re-uploads of the same type re-fire;
    # each `<type>_select_signal` carries the file_paths a selector should select.
    active_type <- reactiveVal(NULL)
    active_n <- 0L
    set_active_type <- function(type) {
      active_n <<- active_n + 1L
      active_type(list(type = type, n = active_n))
    }
    select_signals <- list(
      scans = reactiveVal(NULL),
      cf = reactiveVal(NULL),
      di = reactiveVal(NULL)
    )
    type_filters <- list(
      scans = isoreader2::ir_filter_for_scans,
      cf = isoreader2::ir_filter_for_continuous_flow,
      di = isoreader2::ir_filter_for_dual_inlet
    )
    # select the freshly-added isofiles in each type's selector (via the select
    # signal). `activate` also switches to the first type that received files --
    # used for uploads (the user acted on specific files); examples populate every
    # type, so they select without yanking the user to a different tab.
    select_new <- function(new_iso, activate = TRUE) {
      first_type <- NULL
      for (type in names(type_filters)) {
        sub <- type_filters[[type]](new_iso)
        if (!is.null(sub) && nrow(sub) > 0) {
          select_signals[[type]](sub$file_path)
          if (is.null(first_type)) first_type <- type
        }
      }
      if (activate && !is.null(first_type)) set_active_type(first_type)
    }

    # LOAD EXAMPLES (optional) =====
    # a navbar button that copies the isoreader2 bundled example files into
    # `examples_folder` and loads everything in it; rendered only when set
    output$examples_button <- renderUI({
      if (is.null(examples_folder)) {
        return(NULL)
      }
      actionButton(
        ns("load_examples"),
        "Load examples",
        icon = icon("flask"),
        class = "btn-sm"
      )
    })

    do_load_examples <- function() {
      # copy the isoreader2 bundled examples into examples_folder, then read them
      isoreader2::ir_copy_examples(examples_folder)
      new_iso <- add_paths(isoreader2::ir_find_isofiles(examples_folder))
      n <- if (is.null(new_iso)) 0L else nrow(new_iso)
      log_info(
        ns = ns,
        user_msg = sprintf(
          "Loaded %d example file%s",
          n,
          if (n == 1L) "" else "s"
        )
      )
      # examples are always selected on load (no checkbox), across every type
      if (n > 0) select_new(new_iso, activate = FALSE)
    }
    observeEvent(input$load_examples, do_load_examples())

    # FILE UPLOAD (optional) =====
    output$upload_button <- renderUI({
      if (is.null(upload_folder)) {
        return(NULL)
      }
      actionButton(
        ns("upload"),
        "Upload",
        icon = icon("upload"),
        class = "btn-sm"
      )
    })

    show_upload_modal <- function() {
      showModal(modalDialog(
        title = "Upload data files",
        p(
          "Upload multiple files at once, or whole folders bundled as ",
          tags$code(".zip"),
          " archives (the archive contents are unpacked)."
        ),
        if (isTRUE(temporary_storage)) {
          div(
            class = "alert alert-info",
            "Note: uploaded files are stored only temporarily, for the duration of your session."
          )
        },
        checkboxInput(
          ns("upload_autoselect"),
          "Auto-select the newly uploaded files",
          value = FALSE
        ),
        fileInput(
          ns("upload_files"),
          label = NULL,
          multiple = TRUE,
          accept = app_upload_accept(),
          width = "100%",
          buttonLabel = "Browse...",
          placeholder = "No files selected"
        ),
        footer = modalButton("Close"),
        easyClose = TRUE
      ))
    }
    observeEvent(input$upload, show_upload_modal())

    observeEvent(input$upload_files, {
      uploads <- input$upload_files
      req(uploads)
      if (!dir.exists(upload_folder)) {
        dir.create(upload_folder, recursive = TRUE)
      }
      # remember exactly the files written by THIS upload, so files that already
      # existed in upload_folder are not loaded
      written <- character(0)
      for (i in seq_len(nrow(uploads))) {
        nm <- uploads$name[i]
        src <- uploads$datapath[i]
        if (grepl("\\.zip$", nm, ignore.case = TRUE)) {
          written <- c(written, utils::unzip(src, exdir = upload_folder))
        } else {
          dest <- file.path(upload_folder, nm)
          file.copy(src, dest, overwrite = TRUE)
          written <- c(written, dest)
        }
      }
      removeModal()
      # read the just-uploaded isofiles: ir_find_isofiles detects/canonicalizes
      # everything in the folder (incl. `.json` variants -- foo.cf.json canonicalizes
      # to foo.cf, which ir_read_isofiles resolves); intersecting with the files we
      # just wrote (canonicalized the same way by dropping a trailing .json) loads
      # ONLY the uploads, leaving any pre-existing folder contents untouched.
      new_iso <- add_paths(intersect(
        isoreader2::ir_find_isofiles(upload_folder),
        sub("\\.json$", "", written)
      ))
      n_new <- if (is.null(new_iso)) 0L else nrow(new_iso)
      log_info(
        ns = ns,
        user_msg = sprintf(
          "Uploaded %d file%s",
          n_new,
          if (n_new == 1L) "" else "s"
        )
      )
      # auto-select the uploaded files (per type) + switch to their tab
      if (isTRUE(input$upload_autoselect) && n_new > 0) {
        select_new(new_iso)
      } else if (n_new > 0) {
        # the user opted NOT to select the uploads: prevent the default "select
        # all" initial selection from grabbing them on a type's first-ever upload.
        # A type with no selection pushed yet is pinned to "none"; a type that
        # already has a selection keeps it (the new files simply aren't added).
        for (type in names(type_filters)) {
          sub <- type_filters[[type]](new_iso)
          if (
            !is.null(sub) && nrow(sub) > 0 && !selections[[type]]$has_override()
          ) {
            selections[[type]]$set(tibble::tibble())
          }
        }
      }
    })

    # STARTUP PROMPT (optional) =====
    # if examples and/or uploads are enabled but the app was launched without data,
    # prompt the user (once) to get started. We key off get_isofiles() -- the only
    # startup seed -- so the check is race-free; an app launched with data skips it.
    # The buttons reuse the same load / upload actions as the navbar buttons.
    if (!is.null(examples_folder) || !is.null(upload_folder)) {
      observeEvent(
        get_isofiles(),
        {
          seed <- get_isofiles()
          if (is.null(seed) || nrow(seed) == 0) {
            actions <- list()
            if (!is.null(examples_folder)) {
              actions <- c(
                actions,
                list(actionButton(
                  ns("prompt_load_examples"),
                  "Load examples",
                  icon = icon("flask")
                ))
              )
            }
            if (!is.null(upload_folder)) {
              actions <- c(
                actions,
                list(actionButton(
                  ns("prompt_upload"),
                  "Upload files",
                  icon = icon("upload")
                ))
              )
            }
            intro <- if (!is.null(examples_folder) && !is.null(upload_folder)) {
              "To get started, load the bundled example files, or upload your own data files."
            } else if (!is.null(examples_folder)) {
              "Load the bundled example files to get started."
            } else {
              "Upload your own data files to get started."
            }
            showModal(modalDialog(
              title = "No data loaded yet",
              p(intro),
              footer = do.call(tagList, c(actions, list(modalButton("Close")))),
              easyClose = TRUE
            ))
          }
        },
        ignoreNULL = FALSE,
        once = TRUE
      )
    }
    observeEvent(input$prompt_load_examples, {
      removeModal()
      do_load_examples()
    })
    observeEvent(input$prompt_upload, show_upload_modal())

    # whether any loaded file came from the examples / upload folder -- the code
    # server uses these to choose the read folders ("examples" + ir_copy_examples,
    # and/or "data") in the generated read step
    get_examples_loaded <- reactive({
      m <- managed()
      if (is.null(m) || nrow(m) == 0) {
        return(FALSE)
      }
      any(app_under_folder(m$file_path, examples_folder))
    })
    get_uploads_loaded <- reactive({
      m <- managed()
      if (is.null(m) || nrow(m) == 0) {
        return(FALSE)
      }
      any(app_under_folder(m$file_path, upload_folder))
    })

    list(
      # whether any loaded file came from the examples / upload folder
      get_examples_loaded = get_examples_loaded,
      get_uploads_loaded = get_uploads_loaded,
      # shared intensity units (default mV)
      get_units = get_units,
      set_units = set_units,
      # per-type metadata for the selector tables
      get_scans_metadata = get_scans_metadata,
      get_cf_metadata = get_cf_metadata,
      get_di_metadata = get_di_metadata,
      # per-type selection setters (selector tables push their selection here)
      set_selected_scans = scans_selection$set,
      set_selected_cf = cf_selection$set,
      set_selected_di = di_selection$set,
      # per-type current (resolved) selection getters
      get_scans_selection = scans_selection$get,
      get_cf_selection = cf_selection$get,
      get_di_selection = di_selection$get,
      # per-type "select these file paths" signal (fired by upload auto-select)
      get_scans_select_signal = reactive(select_signals$scans()),
      get_cf_select_signal = reactive(select_signals$cf()),
      get_di_select_signal = reactive(select_signals$di()),
      # the type whose tab to activate after an auto-select (list(type, n))
      get_active_type = reactive(active_type()),
      # per-type selection-filtered aggregated data for the plot modules (ratios,
      # if requested, are calculated by the plot module from its Ratios popover)
      get_aggregated_scans_data = aggregated_for(
        scans_data_full,
        scans_selection$get
      ),
      get_aggregated_cf_data = aggregated_for(cf_data_full, cf_selection$get),
      get_aggregated_di_data = aggregated_for(di_data_full, di_selection$get)
    )
  })
}

#' @describeIn ie_file_server the navbar placeholders for the "Load examples" and
#'   "Upload" buttons (each rendered only when the server's `examples_folder` /
#'   `upload_folder` is set). Pair with [ie_file_server()] on the same `id`.
#' @export
ie_file_ui <- function(id) {
  ns <- NS(id)
  tagList(
    uiOutput(ns("examples_button"), inline = TRUE),
    uiOutput(ns("upload_button"), inline = TRUE)
  )
}

# the "standard" isoreader2 aggregator with the metadata rules removed: only the
# data series (traces / cycles / scans / ...), which carry their own uidx +
# analysis keys. The file server uses this for the data aggregation so the
# (potentially expensive) metadata aggregation is not repeated -- the metadata is
# aggregated once with the "metadata" aggregator and re-attached to the data.
# Requires isoreader2 to be attached (its .onAttach registers the aggregators).
data_only_aggregator <- function() {
  agg <- isoreader2::ir_get_aggregator("standard")
  agg <- agg[agg$dataset != "metadata", , drop = FALSE]
  # base subsetting drops the aggregator class/name attribute -- restore them
  class(agg) <- unique(c("ir_aggregator", class(agg)))
  attr(agg, "name") <- "data"
  agg
}

# the isofile types isoreader2 can read (the `ir_find_isofiles` defaults)
app_isofile_types <- function() {
  tryCatch(
    eval(formals(isoreader2::ir_find_isofiles)$types),
    error = function(e) character(0)
  )
}

# which of `paths` live inside `folder` (a logical vector). Used to tell where a
# loaded file came from (examples vs upload folder) for the generated read code.
app_under_folder <- function(paths, folder) {
  if (is.null(folder) || length(paths) == 0 || !dir.exists(folder)) {
    return(logical(length(paths)))
  }
  nf <- normalizePath(folder, winslash = "/", mustWork = FALSE)
  np <- normalizePath(paths, winslash = "/", mustWork = FALSE)
  startsWith(np, paste0(nf, "/"))
}

# accepted upload extensions for the file picker: .zip, every type isoreader2 can
# read, and a bare ".json" for the `.<type>.json` serializations -- browsers do
# NOT reliably match multi-part extensions like ".cf.json" (they key off the last
# extension), so ".json" is what actually makes those selectable. This is only a
# picker hint; ir_find_isofiles still decides what is ingested server-side.
app_upload_accept <- function() {
  c(".zip", paste0(".", app_isofile_types()), ".json")
}

Try the isoexplorer package in your browser

Any scripts or data that you put into this service are public.

isoexplorer documentation built on Sept. 8, 2026, 1:07 a.m.