#' Progression Handler: Progress Reported via 'cli' Progress Bars (Text) in the Terminal
#'
#' A progression handler for [cli::cli_progress_bar()].
#'
#' @inheritParams make_progression_handler
#'
#' @return A function of class `progression_handler` that takes a
#' [progression] condition as its first and only argument.
#'
#' @param show_after (numeric) Number of seconds to wait before displaying
#' the progress bar.
#'
#' @param type (character) The type of progress bar to display, which
#' controls the default `format` and `format_done` passed to [cli::cli_progress_bar()].
#' If `"default"`, the \pkg{cli} default format is used (`format = NULL`).
#' If `"steps"`, the progress bar shows the current and total number of
#' steps using the format string
#' `"{cli::pb_spin} {cli::pb_bar} {cli::pb_current}/{cli::pb_total} {cli::pb_status}"`
#' (and `format_done = "{cli::pb_bar} {cli::pb_current}/{cli::pb_total} {cli::pb_status}"`).
#' If `"percent"`, the progress bar shows the percentage completed using
#' the format string
#' `"{cli::pb_spin} {cli::pb_bar} {cli::pb_percent} {cli::pb_status}"`
#' (and `format_done = "{cli::pb_bar} {cli::pb_percent} {cli::pb_status}"`).
#' If `"time"`, the progress bar shows the percentage completed, the
#' current and total number of steps, the estimated time remaining (ETA),
#' and the total elapsed time using the format string
#' `"[{cli::pb_elapsed}] {cli::pb_spin} {cli::pb_bar} {cli::pb_percent} [{cli::pb_current}/{cli::pb_total}] (ETA: {cli::pb_eta}) {cli::pb_status}"`
#' (and `format_done = "[{cli::pb_elapsed}] {cli::pb_bar} {cli::pb_percent} [{cli::pb_current}/{cli::pb_total}] {cli::pb_status}"`).
#' For the meaning of these format variables, see
#' [Progress bar variables][cli::progress-variables] in the \pkg{cli} package.
#' This argument is ignored if `format` is explicitly specified via `...`.
#'
#' @param \ldots Additional arguments passed to [cli::cli_progress_bar()]
#' and [make_progression_handler()].
#'
#' @section Requirements:
#' This progression handler requires the \pkg{cli} package.
#'
#' @section Appearance:
#' Below are a few examples on how to use and customize this progress handler.
#' In all cases, we use `handlers(global = TRUE)`.
#'
#' ```{asciicast handler_cli-default}
#' #| asciicast_at = "all",
#' #| asciicast_knitr_output = "svg",
#' #| asciicast_cursor = FALSE
#' library(progressr)
#' handlers("cli")
#' y <- slow_sum_p(1:25)
#' ```
#'
#' ```{asciicast handler_cli-type-steps}
#' #| asciicast_at = "all",
#' #| asciicast_knitr_output = "svg",
#' #| asciicast_cursor = FALSE
#' library(progressr)
#' handlers(handler_cli(type = "steps"))
#' y <- slow_sum_p(1:25)
#' ```
#'
#' ```{asciicast handler_cli-type-percent}
#' #| asciicast_at = "all",
#' #| asciicast_knitr_output = "svg",
#' #| asciicast_cursor = FALSE
#' library(progressr)
#' handlers(handler_cli(type = "percent"))
#' y <- slow_sum_p(1:25)
#' ```
#'
#' ```{asciicast handler_cli-type-time}
#' #| asciicast_at = "all",
#' #| asciicast_knitr_output = "svg",
#' #| asciicast_cursor = FALSE
#' library(progressr)
#' handlers(handler_cli(type = "time"))
#' y <- slow_sum_p(1:25)
#' ```
#'
#' ```{asciicast handler_cli-format-1}
#' #| asciicast_at = "all",
#' #| asciicast_knitr_output = "svg",
#' #| asciicast_cursor = FALSE
#' library(progressr)
#' handlers(handler_cli(format = "{cli::pb_spin} {cli::pb_bar} {cli::pb_current}/{cli::pb_total} {cli::pb_status}"))
#' y <- slow_sum_p(1:25)
#' ```
#'
#' @example incl/handler_cli.R
#'
#' @export
handler_cli <- function(show_after = 0.0, intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", type = c("default", "steps", "percent", "time"), ...) {
  type <- match.arg(type)

  ## Additional arguments passed to the progress-handler backend
  backend_args <- handler_backend_args(...)

  ## Default 'format' depending on 'type', unless 'format' is already specified
  if (is.null(backend_args[["format"]])) {
    format <- switch(type,
      default = NULL,
      steps   = "{cli::pb_spin} {cli::pb_bar} {cli::pb_current}/{cli::pb_total} {cli::pb_status}",
      percent = "{cli::pb_spin} {cli::pb_bar} {cli::pb_percent} {cli::pb_status}",
      time    = "[{cli::pb_elapsed}] {cli::pb_spin} {cli::pb_bar} {cli::pb_percent} [{cli::pb_current}/{cli::pb_total}] (ETA: {cli::pb_eta}) {cli::pb_status}"
    )
    if (!is.null(format)) backend_args[["format"]] <- format
  }

  ## Default 'format_done' depending on 'type', unless 'format_done' is already specified
  if (is.null(backend_args[["format_done"]])) {
    format_done <- switch(type,
      default = NULL,
      steps   = "{cli::pb_bar} {cli::pb_current}/{cli::pb_total} {cli::pb_status}",
      percent = "{cli::pb_bar} {cli::pb_percent} {cli::pb_status}",
      time    = "[{cli::pb_elapsed}] {cli::pb_bar} {cli::pb_percent} [{cli::pb_current}/{cli::pb_total}] {cli::pb_status}"
    )
    if (!is.null(format_done)) backend_args[["format_done"]] <- format_done
  }

  if (!is_fake("handler_cli")) {
    cli_n_colors <- cli::num_ansi_colors()

    cli_freeze_color_options <- function() {      
      options(
        cli.num_colors = cli_n_colors,
        crayon.enabled = (cli_n_colors > 1L),
        crayon.colors = cli_n_colors
      )
    }

    cli_progress_call <- function(fun, ...) {
      opts <- cli_freeze_color_options()
      on.exit(options(opts), add = TRUE)

      withCallingHandlers({
        res <- fun(...)
      }, cliMessage = function(msg) {
        output <- conditionMessage(msg)
        ## WORKAROUND: cli_progress_done() outputs a newline
        ## at the end. This prevents us from (optionally)
        ## clearing the line afterward
        if (identical(fun, cli::cli_progress_done)) {
          output <- gsub("[\n\r]+$", "", output)
        }
        cat(output, file = stderr())
        tryInvokeRestart("muffleMessage")
      })

      invisible(res)
    }

    cli_progress_bar <- function(total, ...) {
      ## WORKAROUND: Do not involve 'cli' when total = 0
      if (total == 0) return(NA_character_)

      ## Make sure to always use the built-in 'cli' handler, no matter
      ## what 'cli.progress_handlers*' options might be set
      opts2 <- options(cli.progress_handlers_only = "cli")
      on.exit(options(opts2), add = TRUE)

      cli_progress_call(cli::cli_progress_bar, total = total, ...)
    }

    cli_progress_update <- function(id, ..., .envir) {
      ## WORKAROUND: Do not involve 'cli' when total = 0
      if (.envir$total == 0) return(id)
      cli_progress_call(cli::cli_progress_update, id = id, ..., .envir = .envir)
    }

    cli_progress_done <- function(id, ..., .envir) {
      ## WORKAROUND: Do not involve 'cli' when total = 0
      if (.envir$total == 0) return(id)
      cli_progress_call(cli::cli_progress_done, id = id, ..., .envir = .envir)
    }

    erase_progress_bar <- function(pb) {
      if (is.null(pb)) return()
      stopifnot(is.character(pb$id), is.environment(pb$envir))
      pb_width <- local({
        oopts <- options(cli.width = NULL)
        on.exit(options(oopts))
        cli::console_width()
      }) - 1L
      msg <- c("\r", rep(" ", times = pb_width), "\r")
      msg <- paste(msg, collapse = "")
      cat(msg, file = stderr())
    }
    
    redraw_progress_bar <- function(pb) {
      if (is.null(pb)) return()
      stopifnot(is.character(pb$id), is.environment(pb$envir))
      cli_progress_update(id = pb$id, inc = 0, .envir = pb$envir)
    }
  } else {
    cli_progress_bar <- function(total, ...) "id-dummy"
    cli_progress_update <- function(id, ..., .envir) "id-dummy"
    cli_progress_done <- function(id, ..., .envir) "id-dummy"
    erase_progress_bar <- function(pb) NULL
    redraw_progress_bar <- function(pb) NULL
  }

  reporter <- local({
    pb <- NULL
    
    make_pb <- function(total, clear, show_after, ...) {
      if (!is.null(pb)) return(pb)
      stop_if_not(
        is.numeric(total), length(total) == 1L, is.finite(total)
      )
      envir <- new.env()
      envir$total <- total
      args <- c(list(total = total, ..., .envir = envir), backend_args)
      args$clear <- FALSE
      args$auto_terminate <- FALSE
      args$.auto_close <- FALSE

      old_show_after <- getOption("cli.progress_show_after", NULL)
      options(cli.progress_show_after = show_after)
      on.exit(options(cli.progress_show_after = old_show_after))

      id <- do.call(cli_progress_bar, args = args)

      pb <<- list(id = id, total = total, envir = envir, show_after = show_after)
      stopifnot(is.character(pb$id), is.environment(pb$envir))
    }

    pb_tick <- function(pb, delta = 0, message = NULL, ...) {
      if (is.null(pb)) return()
      stopifnot(
        is.character(pb$id), length(pb$id) == 1L,
        is.numeric(delta), length(delta) == 1L, is.finite(delta),
        is.environment(pb$envir)
      )
      if (delta <= 0) return()

      old_show_after <- getOption("cli.progress_show_after", NULL)
      options(cli.progress_show_after = pb$show_after)
      on.exit(options(cli.progress_show_after = old_show_after))

      cli_progress_update(id = pb$id, inc = delta, status = message, .envir = pb$envir)
    }

    pb_update <- function(pb, ratio, message = NULL, ...) {
      if (is.null(pb)) return()
      stopifnot(is.character(pb$id), is.environment(pb$envir))

      old_show_after <- getOption("cli.progress_show_after", NULL)
      options(cli.progress_show_after = pb$show_after)
      on.exit(options(cli.progress_show_after = old_show_after))

      if (ratio >= 1.0) {
        cli_progress_done(id = pb$id, .envir = pb$envir)
      } else {
        set <- ratio * pb$total
        stopifnot(length(set) == 1L, is.numeric(set), is.finite(set),
                  set >= 0, set < pb$total)
        cli_progress_update(id = pb$id, set = set, status = message, .envir = pb$envir)
      }
    }

    list(
      reset = function(...) {
        pb <<- NULL
      },

      hide = function(...) {
        if (is.null(pb)) return()
        erase_progress_bar(pb)
      },

      unhide = function(...) {
        if (is.null(pb)) return()
        redraw_progress_bar(pb)
      },

      interrupt = function(config, state, progression, ...) {
        if (is.null(pb)) return()
        stopifnot(is.character(pb$id), is.environment(pb$envir))

        ## WORKAROUND: At times, we might get 'Error in
        ## del_from:length(app$styles) : NA/NaN argument'.
        tryCatch({
          erase_progress_bar(pb)
          redraw_progress_bar(pb)
        }, error = identity)
        
        msg <- conditionMessage(progression)
        msg <- paste(c("", msg, ""), collapse = "\n")
        cat(msg, file = stderr())
      },

      initiate = function(config, state, progression, ...) {
        if (!state$enabled || config$times == 1L) return()
        stop_if_not(is.null(pb))
        make_pb(total = config$max_steps,
                clear = config$clear, show_after = config$enable_after)
        pb_tick(pb, delta = 0, message = state$message)
      },
        
      update = function(config, state, progression, ...) {
        if (!state$enabled || config$times <= 2L) return()
        if (progression$amount == 0) return()
        
        make_pb(total = config$max_steps,
                clear = config$clear, show_after = config$enable_after)
        if (inherits(progression, "sticky") && length(state$message) > 0) {
          # FIXME: pb$message(state$message)
        }
        old_show_after <- getOption("cli.progress_show_after", NULL)
        options(cli.progress_show_after = pb$show_after)
        on.exit(options(cli.progress_show_after = old_show_after))

        cli_progress_update(id = pb$id, set = state$step, status = state$message, .envir = pb$envir)
      },
        
      finish = function(config, state, progression, ...) {
        ## Already finished?
        if (is.null(pb)) return()
        stopifnot(is.character(pb$id), is.environment(pb$envir))
        make_pb(total = config$max_steps,
                clear = config$clear, show_after = config$enable_after)
        reporter$update(config = config, state = state, progression = progression, ...)
        if (config$clear) {
          pb_update(pb, ratio = 1.0)
          erase_progress_bar(pb)
        } else {
          pb_update(pb, ratio = 1.0)
          cat(file = stderr(), "\n")
        }
        
        pb <<- NULL
      }
    )
  })

  make_progression_handler("cli", reporter, intrusiveness = intrusiveness, target = target, ...)
}
