#' Remove entries from a `reactiveValues` object
#'
#' shiny offers no public way to delete a key from a [shiny::reactiveValues()]
#' object -- assigning `NULL` stores a `NULL` value but leaves the key in
#' `names()`. `trim_rv()` removes the named entries outright and invalidates
#' the affected reactive dependencies, so a key can be truly dropped (and
#' later re-added) -- for instance when a variadic block argument is unlinked.
#'
#' @param x A `reactiveValues` object.
#' @param rm Character vector of keys to remove; all must be present in `x`.
#'
#' @return `x`, invisibly.
#'
#' @export
trim_rv <- function(x, rm) {

  stopifnot(is.reactivevalues(x))

  internals <- .subset2(x, "impl")

  stopifnot(all(rm %in% internals$.nameOrder))

  # No public removal exists, so mirror the internals ReactiveValues$set()
  # touches: drop the value and its name, then invalidate the same
  # dependencies an update would (the key's own, plus names / as-list).
  for (key in rm) {

    internals$.values$remove(key)

    if (internals$.dependents$containsKey(key)) {
      internals$.dependents$get(key)$invalidate()
    }
  }

  internals$.nameOrder <- setdiff(internals$.nameOrder, rm)

  if (isTRUE(internals$.hasRetrieved$names)) {
    internals$.namesDeps$invalidate()
  }

  if (isTRUE(internals$.hasRetrieved$asList)) {
    internals$.valuesDeps$invalidate()
  }

  if (isTRUE(internals$.hasRetrieved$asListAll)) {
    internals$.allValuesDeps$invalidate()
  }

  invisible(x)
}

make_read_only <- function(x) {

  stopifnot(is.reactivevalues(x))

  res <- unclass(x)
  res[["readonly"]] <- TRUE
  class(res) <- class(x)

  res
}

destroy_outputs <- function(ns_prefix, session = get_session()) {

  for (id in starts_with(list_outputs(session), ns_prefix)) {
    destroy_output(id, session)
  }

  invisible()
}

list_outputs <- function(session = get_session()) {
  coal(
    union(
      names(session$.__enclos_env__$private$.outputs),
      names(session$.__enclos_env__$private$.outputOptions)
    ),
    character()
  )
}

destroy_output <- function(id, session = get_session()) {

  log_trace("destroying output {id}")

  session$defineOutput(id, NULL, NULL)
  session$.__enclos_env__$private$.outputs[[id]] <- NULL
  session$.__enclos_env__$private$.outputOptions[[id]] <- NULL

  invisible()
}

destroy_inputs <- function(ns_prefix, session = get_session()) {

  for (id in starts_with(names(session$input), ns_prefix)) {
    destroy_input(id, session)
  }

  invisible()
}

destroy_input <- function(id, session = get_session()) {

  log_trace("destroying input {id}")

  session$manageInputs(
    set_names(list(NULL), id),
    now = TRUE
  )

  input <- .subset2(session$input, "impl")

  input$.values$remove(id)
  input$.nameOrder <- setdiff(input$.nameOrder, id)

  invisible()
}

invalidate_inputs <- function(session = get_session()) {

  log_trace("invalidating inputs of domain {session$ns(NULL)}")

  input <- .subset2(session$input, "impl")

  input$.namesDeps$invalidate()
  input$.valuesDeps$invalidate()

  invisible()
}

destroy_observers <- function(ns_prefix, session = get_session()) {

  if (isTRUE(blockr_option("observe_hook_disabled", FALSE))) {
    return(invisible(FALSE))
  }

  obs <- get0("observers", envir = session$userData)

  if (is.null(obs)) {
    log_debug("cannot destroy uncaptured observers")
    return(invisible(FALSE))
  }

  for (i in starts_with(names(obs), ns_prefix)) {

    for (x in obs[[i]]) {

      log_trace(
        "destroying observer {x$.reactId} of domain {x$.domain$ns(NULL)}"
      )

      x$destroy()
    }

    obs[[i]] <- NULL
  }

  assign("observers", obs, envir = session$userData)

  invisible(TRUE)
}

#' Destroy a Shiny module
#'
#' Cleans up inputs, outputs and/or observers associated with a Shiny module.
#'
#' @note This function relies on non-documented, internal Shiny APIs that are
#' not officially supported or recommended to use. These internals may break
#' if Shiny's internal source code changes. Use with caution and only
#' whenever necessary.
#'
#' @param id Module namespace id.
#' @param what Character vector indicating which components to destroy.
#'   Defaults to all of `"inputs"`, `"outputs"` and `"observers"`.
#' @param session Shiny session object.
#'
#' @return The namespaced id (invisibly).
#'
#' @keywords internal
#' @export
destroy_module <- function(id, what = c("inputs", "outputs", "observers"),
                           session = get_session()) {

  what <- match.arg(what, several.ok = TRUE)

  log_debug("destroying module {id}, component{?s} {what}")

  ns <- session$ns(id)

  if ("inputs" %in% what) {
    destroy_inputs(id, session)
  }

  if ("outputs" %in% what) {
    destroy_outputs(ns, session)
  }

  if ("observers" %in% what) {
    destroy_observers(ns, session)
  }

  invisible(ns)
}

trace_observe <- function() {

  if (isTRUE(blockr_option("observe_hook_disabled", FALSE))) {
    return(invisible(FALSE))
  }

  if (is_observe_traced()) {
    return(invisible(FALSE))
  }

  log_debug("hooking observer capturing")

  suppressMessages(
    trace(
      shiny::observe,
      exit = quote(
        {
          if (!is.null(domain)) { # nocov start

            obs <- get0(
              "observers",
              envir = domain$userData,
              inherits = FALSE
            )

            if (is.null(obs)) {
              obs <- list()
            }

            dom <- domain$ns(NULL)

            if (!length(dom)) {
              dom <- ""
            }

            cur <- returnValue()

            blockr.core::log_trace(
              "capturing observer {cur$.reactId} of domain {dom}"
            )

            obs[[dom]] <- c(obs[[dom]], cur)

            assign("observers", obs, envir = domain$userData)
          } # nocov end
        }
      ),
      print = FALSE
    )
  )

  invisible(untrace_observe)
}

untrace_observe <- function() {

  if (isTRUE(blockr_option("observe_hook_disabled", FALSE))) {
    return(invisible(FALSE))
  }

  if (!is_observe_traced()) {
    return(invisible(FALSE))
  }

  log_debug("removing observer capture hook")

  suppressMessages(untrace(shiny::observe))

  invisible(TRUE)
}

is_observe_traced <- function() {
  inherits(shiny::observe, "functionWithTrace")
}

#' Shiny utilities
#'
#' Utility functions for shiny:
#' - `get_session`: See [shiny::getDefaultReactiveDomain()].
#' - `generate_plugin_args`: Meant for unit testing plugins.
#' - `notify`: Glue-capable wrapper for [shiny::showNotification()].
#'
#' @return Either `NULL` or a shiny session object for `get_session()`, a list
#' of arguments for plugin server functions in the case of
#' `generate_plugin_args()` and `notify()` is called for the side-effect of
#' displaying a browser notification (and returns `NULL` invisibly).
#'
#' @export
get_session <- function() {
  getDefaultReactiveDomain()
}

#' @param close_button Passed as `closeButton` to [shiny::showNotification()]
#' @param glue,log Whether to [glue::glue()]-interpolate `...` and whether to
#' emit a log message. Set both to `FALSE` to surface pre-formatted,
#' already-logged text (e.g. a captured condition message, which may contain
#' braces that would otherwise fail interpolation).
#'
#' @inheritParams write_log
#' @inheritParams shiny::showNotification
#'
#' @rdname get_session
#' @export
notify <- function(..., envir = parent.frame(), action = NULL, duration = 5,
                   close_button = TRUE, id = NULL,
                   type = c("message", "warning", "error"),
                   glue = TRUE, log = TRUE, session = get_session()) {

  type <- match.arg(type)

  msg <- if (glue) glue_plur(..., envir = envir) else paste0(...)
  msg <- HTML(cli::ansi_html(msg))

  showNotification(
    msg,
    action = action,
    duration = duration,
    closeButton = close_button,
    id = id,
    type = type,
    session = session
  )

  if (log) {
    switch(
      type,
      message = log_info(msg, envir = envir, use_glue = FALSE),
      warning = log_warn(msg, envir = envir, use_glue = FALSE),
      error = log_error(msg, envir = envir, use_glue = FALSE)
    )
  }

  invisible(NULL)
}

notify_remove <- function(id, session = get_session()) {
  removeNotification(id, session = session)
}
