R/console_app.R

Defines functions console_app_navigate_inspector console_app_refresh_inspector_overlay console_app_open_turn_overlay render_console_turn_inspector build_console_inspector_lines format_console_tool_detail format_console_turn_detail console_app_get_turn_by_id console_app_get_last_turn render_console_tool_timeline format_console_tool_timeline console_app_finish_turn console_app_record_tool_result extract_console_tool_diagnostics console_app_record_tool_start console_app_append_intermediate_text console_app_remove_assistant_text_once console_app_append_assistant_text console_app_register_display_text console_app_text_key console_app_update_current_turn console_app_get_current_turn console_app_start_turn render_console_overlay build_console_overlay_box console_app_close_overlay_by_type console_app_close_overlay console_app_open_overlay console_app_get_active_overlay render_console_status_bar build_console_status_lines pack_console_status_segments build_console_status_segments build_console_status_line console_app_status_snapshot console_app_set_local_execution_enabled console_app_set_stream_enabled console_app_set_view_mode console_app_sync_session create_console_app_state detect_console_capabilities console_view_mode_show_thinking console_view_mode_tool_log_mode normalize_console_view_mode

#' @title Console App State Helpers
#' @description
#' Internal helpers for the incremental console TUI architecture. These
#' functions centralize view mode, capability detection, per-turn transcript
#' state, and append-only status/timeline rendering.
#' @name console_app
#' @keywords internal
NULL

console_app_overlay_counter <- local({
  state <- new.env(parent = emptyenv())
  state$next_id <- 1L
  function() {
    id <- sprintf("overlay-%d", state$next_id)
    state$next_id <- state$next_id + 1L
    id
  }
})

#' @keywords internal
normalize_console_view_mode <- function(view_mode = "clean") {
  mode <- tolower(view_mode %||% "clean")
  if (!mode %in% c("clean", "inspect", "debug")) {
    rlang::abort("view_mode must be one of 'clean', 'inspect', or 'debug'.")
  }
  mode
}

#' @keywords internal
console_view_mode_tool_log_mode <- function(view_mode) {
  if (identical(normalize_console_view_mode(view_mode), "debug")) {
    "detailed"
  } else {
    "compact"
  }
}

#' @keywords internal
console_view_mode_show_thinking <- function(view_mode) {
  identical(normalize_console_view_mode(view_mode), "debug")
}

#' @keywords internal
detect_console_capabilities <- function() {
  has_cli <- requireNamespace("cli", quietly = TRUE)
  ansi_colors <- if (has_cli) {
    tryCatch(cli::num_ansi_colors(), error = function(e) 1L)
  } else {
    1L
  }

  list(
    interactive = interactive(),
    ansi = isTRUE(ansi_colors > 1L),
    unicode = isTRUE(l10n_info()[["UTF-8"]]),
    cursor_addressing = interactive() && isTRUE(ansi_colors > 1L),
    bracketed_paste = FALSE,
    truecolor = isTRUE(ansi_colors >= 256L),
    inline_images = FALSE,
    ime_safe_cursor = FALSE
  )
}

#' @keywords internal
create_console_app_state <- function(session,
                                     agent_enabled = FALSE,
                                     sandbox_mode = "permissive",
                                     stream_enabled = TRUE,
                                     local_execution_enabled = FALSE,
                                     view_mode = "clean",
                                     capabilities = detect_console_capabilities()) {
  state <- new.env(parent = emptyenv())
  state$session <- session
  state$agent_enabled <- isTRUE(agent_enabled)
  state$sandbox_mode <- sandbox_mode
  state$stream_enabled <- isTRUE(stream_enabled)
  state$local_execution_enabled <- isTRUE(local_execution_enabled)
  state$view_mode <- normalize_console_view_mode(view_mode)
  state$capabilities <- capabilities
  state$phase <- "idle"
  state$tool_state <- "idle"
  state$turns <- list()
  state$current_turn_id <- NULL
  state$next_turn_id <- 1L
  state$next_tool_id <- 1L
  state$overlay_stack <- list()
  state$focus_target <- "composer"
  state$last_rendered_frame <- NULL
  console_app_sync_session(state, session)
  state$local_execution_enabled <- isTRUE(local_execution_enabled)
  state
}

#' @keywords internal
console_app_sync_session <- function(state, session = state$session) {
  state$session <- session
  state$model_id <- session$get_model_id() %||% "(not set)"
  state$persona_label <- console_persona_status_label(session)
  state$local_execution_enabled <- isTRUE(session$get_envir()$.local_mode)
  invisible(state)
}

#' @keywords internal
console_app_set_view_mode <- function(state, view_mode) {
  state$view_mode <- normalize_console_view_mode(view_mode)
  invisible(state)
}

#' @keywords internal
console_app_set_stream_enabled <- function(state, stream_enabled) {
  state$stream_enabled <- isTRUE(stream_enabled)
  invisible(state)
}

#' @keywords internal
console_app_set_local_execution_enabled <- function(state, enabled) {
  state$local_execution_enabled <- isTRUE(enabled)
  invisible(state)
}

#' @keywords internal
console_app_status_snapshot <- function(state) {
  list(
    model_id = state$model_id %||% "(not set)",
    persona_label = state$persona_label %||% console_default_persona_label(),
    sandbox_mode = state$sandbox_mode %||% "unknown",
    view_mode = state$view_mode %||% "clean",
    stream_enabled = isTRUE(state$stream_enabled),
    local_execution_enabled = isTRUE(state$local_execution_enabled),
    tool_state = state$tool_state %||% "idle",
    phase = state$phase %||% "idle"
  )
}

#' @keywords internal
build_console_status_line <- function(state) {
  paste(build_console_status_segments(state, compact = FALSE), collapse = " | ")
}

#' @keywords internal
build_console_status_segments <- function(state, compact = FALSE) {
  snapshot <- console_app_status_snapshot(state)
  context <- get_console_context_metrics(state$session)
  context_fields <- character(0)
  if (!is.null(context)) {
    suffix <- if (isTRUE(context$estimated)) "(est)" else ""
    context_label <- paste0("Ctx", suffix)
    used_label <- paste0("Used", suffix)
    left_label <- paste0("Left", suffix)
    if (!is.na(context$context_window)) {
      context_fields <- c(
        context_fields,
        sprintf("%s: %s", context_label, format_console_token_compact(context$context_window)),
        sprintf("%s: %s", used_label, format_console_token_compact(context$used_tokens)),
        sprintf("%s: %s", left_label, format_console_token_compact(context$remaining_tokens))
      )
    } else if (!is.na(context$used_tokens)) {
      context_fields <- c(
        context_fields,
        sprintf("%s: %s", used_label, format_console_token_compact(context$used_tokens))
      )
    }
    if (!is.na(context$max_output)) {
      context_fields <- c(
        context_fields,
        sprintf("Out: %s", format_console_token_compact(context$max_output))
      )
    }
  }

  model_option_fields <- character(0)
  model_options <- tryCatch(state$session$get_model_options(), error = function(e) list())
  call_options <- list_get_exact(model_options, "call_options", list())
  if (!is.null(list_get_exact(call_options, "thinking"))) {
    model_option_fields <- c(
      model_option_fields,
      sprintf("Think: %s", format_console_thinking_value(list_get_exact(call_options, "thinking")))
    )
  }
  if (!is.null(list_get_exact(call_options, "reasoning_effort"))) {
    model_option_fields <- c(
      model_option_fields,
      sprintf("Effort: %s", list_get_exact(call_options, "reasoning_effort"))
    )
  }
  if (!is.null(list_get_exact(call_options, "thinking_budget"))) {
    model_option_fields <- c(
      model_option_fields,
      sprintf("Budget: %s", format_console_token_compact(list_get_exact(call_options, "thinking_budget")))
    )
  }
  if (!is.null(list_get_exact(call_options, "max_tokens"))) {
    model_option_fields <- c(
      model_option_fields,
      sprintf("Max: %s", format_console_token_compact(list_get_exact(call_options, "max_tokens")))
    )
  }

  model_value <- if (compact) compact_text_preview(snapshot$model_id, width = 28) else snapshot$model_id
  c(
    sprintf("Model: %s", model_value),
    sprintf(if (compact) "Persona: %s" else "Persona: %s", compact_text_preview(snapshot$persona_label, width = 20)),
    context_fields,
    model_option_fields,
    sprintf(if (compact) "Sb: %s" else "Sandbox: %s", snapshot$sandbox_mode),
    sprintf(if (compact) "View: %s" else "View: %s", snapshot$view_mode),
    sprintf(if (compact) "Strm: %s" else "Stream: %s", if (snapshot$stream_enabled) "on" else "off"),
    sprintf(if (compact) "Local: %s" else "Local: %s", if (snapshot$local_execution_enabled) "on" else "off"),
    sprintf(if (compact) "Tools: %s" else "Tools: %s", snapshot$tool_state)
  )
}

#' @keywords internal
pack_console_status_segments <- function(segments, width) {
  lines <- character(0)
  current <- character(0)

  for (segment in segments) {
    candidate <- if (length(current) == 0) {
      segment
    } else {
      paste(c(current, segment), collapse = " | ")
    }

    if (length(current) > 0 && nchar(candidate, type = "width") > width) {
      lines <- c(lines, paste(current, collapse = " | "))
      current <- segment
    } else {
      current <- c(current, segment)
    }
  }

  if (length(current) > 0) {
    lines <- c(lines, paste(current, collapse = " | "))
  }

  lines
}

#' @keywords internal
build_console_status_lines <- function(state, width = getOption("width", 80)) {
  width <- max(40L, as.integer(width %||% 80L))

  if (width >= 110L) {
    return(build_console_status_line(state))
  }

  compact <- width < 70L
  segments <- build_console_status_segments(state, compact = compact)

  primary_idx <- c(1L, grep("^Ctx|^Used|^Left|^Out:", segments), grep("^View:", segments), grep("^Tools:", segments))
  primary_idx <- unique(primary_idx[primary_idx >= 1L & primary_idx <= length(segments)])
  secondary_idx <- setdiff(seq_along(segments), primary_idx)

  c(
    pack_console_status_segments(segments[primary_idx], width = width),
    pack_console_status_segments(segments[secondary_idx], width = width)
  )
}

#' @keywords internal
render_console_status_bar <- function(state, width = getOption("width", 80)) {
  lines <- build_console_status_lines(state, width = width)

  if (!requireNamespace("cli", quietly = TRUE)) {
    cat(paste0(lines, "\n"), sep = "")
    return(invisible(lines))
  }

  for (line in lines) {
    cli::cli_text(cli::col_grey(line))
  }
  cli::cli_rule()
  invisible(lines)
}

#' @keywords internal
console_app_get_active_overlay <- function(state) {
  if (length(state$overlay_stack) == 0) {
    return(NULL)
  }
  state$overlay_stack[[length(state$overlay_stack)]]
}

#' @keywords internal
console_app_open_overlay <- function(state, type, title, lines, payload = NULL, focus_target = NULL) {
  overlay <- list(
    id = console_app_overlay_counter(),
    type = type,
    title = title,
    lines = lines %||% character(0),
    payload = payload,
    focus_target = focus_target %||% paste0("overlay:", type),
    opened_at = Sys.time()
  )

  state$overlay_stack[[length(state$overlay_stack) + 1L]] <- overlay
  state$focus_target <- overlay$focus_target
  invisible(overlay)
}

#' @keywords internal
console_app_close_overlay <- function(state, overlay_id = NULL) {
  if (length(state$overlay_stack) == 0) {
    state$focus_target <- "composer"
    return(invisible(NULL))
  }

  if (is.null(overlay_id)) {
    state$overlay_stack <- state$overlay_stack[-length(state$overlay_stack)]
  } else {
    keep <- vapply(state$overlay_stack, function(item) !identical(item$id, overlay_id), logical(1))
    state$overlay_stack <- state$overlay_stack[keep]
  }

  active <- console_app_get_active_overlay(state)
  state$focus_target <- if (is.null(active)) "composer" else active$focus_target
  invisible(active)
}

#' @keywords internal
console_app_close_overlay_by_type <- function(state, type) {
  if (length(state$overlay_stack) == 0) {
    state$focus_target <- "composer"
    return(invisible(NULL))
  }

  keep <- vapply(state$overlay_stack, function(item) !identical(item$type, type), logical(1))
  state$overlay_stack <- state$overlay_stack[keep]
  active <- console_app_get_active_overlay(state)
  state$focus_target <- if (is.null(active)) "composer" else active$focus_target
  invisible(active)
}

#' @keywords internal
build_console_overlay_box <- function(state, overlay = console_app_get_active_overlay(state)) {
  if (is.null(overlay)) {
    return(character(0))
  }

  unicode <- isTRUE(state$capabilities$unicode)
  top_left <- if (unicode) "\u256d" else "+"
  top_right <- if (unicode) "\u256e" else "+"
  bottom_left <- if (unicode) "\u2570" else "+"
  bottom_right <- if (unicode) "\u256f" else "+"
  horizontal <- if (unicode) "\u2500" else "-"
  vertical <- if (unicode) "\u2502" else "|"

  content <- c(
    sprintf("Type: %s", overlay$type %||% "overlay"),
    overlay$lines %||% character(0),
    "Close: /inspect close"
  )

  width <- max(nchar(c(overlay$title %||% "Overlay", content), type = "width"), 24L)
  border <- paste0(strrep(horizontal, width + 2L))
  title_line <- sprintf("%s %-*s %s", vertical, width, overlay$title %||% "Overlay", vertical)
  content_lines <- vapply(content, function(line) {
    sprintf("%s %-*s %s", vertical, width, line, vertical)
  }, character(1))

  c(
    paste0(top_left, border, top_right),
    title_line,
    paste0(vertical, strrep(" ", width + 2L), vertical),
    content_lines,
    paste0(bottom_left, border, bottom_right)
  )
}

#' @keywords internal
render_console_overlay <- function(state, overlay = console_app_get_active_overlay(state)) {
  lines <- build_console_overlay_box(state, overlay)
  if (!length(lines)) {
    return(invisible(lines))
  }

  if (!requireNamespace("cli", quietly = TRUE)) {
    cat(paste0(lines, "\n"), sep = "")
    return(invisible(lines))
  }

  cli::cli_text("")
  for (line in lines) {
    cli::cli_text(cli::col_yellow(line))
  }
  invisible(lines)
}

#' @keywords internal
console_app_start_turn <- function(state, user_input) {
  turn_id <- state$next_turn_id
  state$next_turn_id <- state$next_turn_id + 1L

  turn <- list(
    turn_id = turn_id,
    started_at = Sys.time(),
    ended_at = NULL,
    phase = "thinking",
    user_text = user_input %||% "",
    assistant_text = "",
    intermediate_text = "",
    displayed_text_keys = character(),
    assistant_text_keys = character(),
    intermediate_text_keys = character(),
    tool_calls = list(),
    warnings = character(),
    messages = character(),
    elapsed_ms = NULL
  )

  state$current_turn_id <- turn_id
  state$turns[[as.character(turn_id)]] <- turn
  state$phase <- "thinking"
  state$tool_state <- "idle"
  invisible(turn)
}

#' @keywords internal
console_app_get_current_turn <- function(state) {
  turn_id <- state$current_turn_id
  if (is.null(turn_id)) {
    return(NULL)
  }
  state$turns[[as.character(turn_id)]]
}

#' @keywords internal
console_app_update_current_turn <- function(state, turn) {
  if (is.null(turn$turn_id)) {
    return(invisible(state))
  }
  state$turns[[as.character(turn$turn_id)]] <- turn
  invisible(state)
}

#' @keywords internal
console_app_text_key <- function(text) {
  normalized <- gsub("[[:space:]]+", " ", trimws(text %||% ""))
  if (!nzchar(normalized)) {
    return("")
  }
  digest::digest(normalized, algo = "md5")
}

#' @keywords internal
console_app_register_display_text <- function(state, text) {
  key <- console_app_text_key(text)
  if (!nzchar(key)) {
    return(FALSE)
  }

  turn <- console_app_get_current_turn(state)
  if (is.null(turn)) {
    return(FALSE)
  }

  seen <- turn$displayed_text_keys %||% character()
  duplicate <- key %in% seen
  if (!duplicate) {
    turn$displayed_text_keys <- c(seen, key)
    console_app_update_current_turn(state, turn)
  }
  !duplicate
}

#' @keywords internal
console_app_append_assistant_text <- function(state, text, dedupe = FALSE) {
  if (is.null(text) || !nzchar(text)) {
    return(invisible(state))
  }

  turn <- console_app_get_current_turn(state)
  if (is.null(turn)) {
    return(invisible(state))
  }

  if (isTRUE(dedupe)) {
    key <- console_app_text_key(text)
    seen <- turn$assistant_text_keys %||% character()
    if (nzchar(key) && key %in% seen) {
      return(invisible(FALSE))
    }
    if (nzchar(key)) {
      turn$assistant_text_keys <- c(seen, key)
    }
  }

  turn$assistant_text <- paste0(turn$assistant_text %||% "", text)
  if (length(turn$tool_calls) > 0) {
    state$phase <- "rendering"
  }
  turn$phase <- state$phase
  console_app_update_current_turn(state, turn)
  invisible(TRUE)
}

#' @keywords internal
console_app_remove_assistant_text_once <- function(state, text) {
  if (is.null(text) || !nzchar(text)) {
    return(invisible(FALSE))
  }

  turn <- console_app_get_current_turn(state)
  if (is.null(turn) || !nzchar(turn$assistant_text %||% "")) {
    return(invisible(FALSE))
  }

  pos <- regexpr(text, turn$assistant_text, fixed = TRUE)[[1]]
  if (pos < 1L) {
    return(invisible(FALSE))
  }

  before <- if (pos > 1L) substr(turn$assistant_text, 1L, pos - 1L) else ""
  after_start <- pos + nchar(text, type = "chars")
  after <- if (after_start <= nchar(turn$assistant_text, type = "chars")) {
    substr(turn$assistant_text, after_start, nchar(turn$assistant_text, type = "chars"))
  } else {
    ""
  }
  turn$assistant_text <- paste0(before, after)

  key <- console_app_text_key(text)
  if (nzchar(key)) {
    turn$assistant_text_keys <- setdiff(turn$assistant_text_keys %||% character(), key)
  }

  console_app_update_current_turn(state, turn)
  invisible(TRUE)
}

#' @keywords internal
console_app_append_intermediate_text <- function(state, text, dedupe = TRUE) {
  if (is.null(text) || !nzchar(text)) {
    return(invisible(state))
  }

  turn <- console_app_get_current_turn(state)
  if (is.null(turn)) {
    return(invisible(state))
  }

  if (isTRUE(dedupe)) {
    key <- console_app_text_key(text)
    seen <- turn$intermediate_text_keys %||% character()
    if (nzchar(key) && key %in% seen) {
      return(invisible(FALSE))
    }
    if (nzchar(key)) {
      turn$intermediate_text_keys <- c(seen, key)
    }
  }

  turn$intermediate_text <- paste0(turn$intermediate_text %||% "", text)
  state$phase <- "rendering"
  turn$phase <- state$phase
  console_app_update_current_turn(state, turn)
  invisible(TRUE)
}

#' @keywords internal
console_app_record_tool_start <- function(state, name, arguments) {
  turn <- console_app_get_current_turn(state)
  if (is.null(turn)) {
    return(invisible(state))
  }

  tool_id <- sprintf("tool-%d", state$next_tool_id)
  state$next_tool_id <- state$next_tool_id + 1L

  turn$tool_calls[[length(turn$tool_calls) + 1L]] <- list(
    tool_id = tool_id,
    name = name,
    status = "running",
    start_time = Sys.time(),
    end_time = NULL,
    elapsed_ms = NULL,
    args_summary = compact_tool_start_label(name, arguments),
    result_summary = NULL,
    messages = character(0),
    warnings = character(0),
    raw_args = arguments,
    raw_result = NULL
  )

  turn$phase <- "tool_running"
  state$phase <- "tool_running"
  state$tool_state <- "running"
  console_app_update_current_turn(state, turn)
}

#' @keywords internal
extract_console_tool_diagnostics <- function(raw_result, rendered_result = raw_result) {
  messages <- character(0)
  warnings <- character(0)

  if (is.list(raw_result)) {
    messages <- c(messages, raw_result$messages %||% character(0))
    warnings <- c(warnings, raw_result$warnings %||% character(0))
  }

  if (is.character(raw_result)) {
    messages <- c(messages, attr(raw_result, "aisdk_messages", exact = TRUE) %||% character(0))
    warnings <- c(warnings, attr(raw_result, "aisdk_warnings", exact = TRUE) %||% character(0))
  }

  text_lines <- character(0)
  if (is.character(rendered_result)) {
    text_lines <- unlist(strsplit(rendered_result, "\n", fixed = TRUE), use.names = FALSE)
  } else if (is.character(raw_result)) {
    text_lines <- unlist(strsplit(raw_result, "\n", fixed = TRUE), use.names = FALSE)
  }

  if (length(text_lines)) {
    msg_lines <- grep("^Message:\\s*", text_lines, value = TRUE)
    warn_lines <- grep("^Warning:\\s*", text_lines, value = TRUE)
    if (length(msg_lines)) {
      messages <- c(messages, sub("^Message:\\s*", "", msg_lines))
    }
    if (length(warn_lines)) {
      warnings <- c(warnings, sub("^Warning:\\s*", "", warn_lines))
    }
  }

  list(
    messages = unique(trimws(messages[nzchar(trimws(messages))])),
    warnings = unique(trimws(warnings[nzchar(trimws(warnings))]))
  )
}

#' @keywords internal
console_app_record_tool_result <- function(state, name, result, success = TRUE, raw_result = result) {
  turn <- console_app_get_current_turn(state)
  if (is.null(turn) || length(turn$tool_calls) == 0) {
    return(invisible(state))
  }

  failed <- tool_result_failed(result, success)
  match_idx <- NULL
  for (i in rev(seq_along(turn$tool_calls))) {
    item <- turn$tool_calls[[i]]
    if (identical(item$name, name) && identical(item$status, "running")) {
      match_idx <- i
      break
    }
  }
  if (is.null(match_idx)) {
    match_idx <- length(turn$tool_calls)
  }

  item <- turn$tool_calls[[match_idx]]
  item$end_time <- Sys.time()
  display_status <- if (is.list(raw_result) && identical(raw_result$error_type %||% NULL, "invalid_tool_arguments")) {
    "invalid_arguments"
  } else {
    NULL
  }
  item$status <- if (failed) "failed" else "done"
  item$result_summary <- compact_tool_result_label(
    name,
    result,
    success = !failed,
    display_status = display_status
  )
  item$raw_result <- raw_result

  diagnostics <- extract_console_tool_diagnostics(raw_result, rendered_result = result)
  item$messages <- diagnostics$messages
  item$warnings <- diagnostics$warnings

  if (!is.null(item$start_time) && !is.null(item$end_time)) {
    item$elapsed_ms <- as.numeric(difftime(item$end_time, item$start_time, units = "secs")) * 1000
  }

  turn$tool_calls[[match_idx]] <- item
  turn$messages <- unique(c(turn$messages %||% character(0), diagnostics$messages))
  turn$warnings <- unique(c(turn$warnings %||% character(0), diagnostics$warnings))
  turn$phase <- if (failed) "error" else "rendering"
  state$phase <- turn$phase
  state$tool_state <- if (failed) "error" else "idle"
  console_app_update_current_turn(state, turn)
}

#' @keywords internal
console_app_finish_turn <- function(state, failed = FALSE, cancelled = FALSE) {
  turn <- console_app_get_current_turn(state)
  failed <- isTRUE(failed)
  cancelled <- isTRUE(cancelled)
  terminal_phase <- if (cancelled) "cancelled" else if (failed) "error" else "done"
  if (is.null(turn)) {
    state$phase <- if (failed || cancelled) terminal_phase else "idle"
    state$tool_state <- if (failed && !cancelled) "error" else "idle"
    return(invisible(state))
  }

  turn$ended_at <- Sys.time()
  turn$phase <- terminal_phase
  if (!is.null(turn$started_at) && !is.null(turn$ended_at)) {
    turn$elapsed_ms <- as.numeric(difftime(turn$ended_at, turn$started_at, units = "secs")) * 1000
  }

  state$phase <- if (failed || cancelled) terminal_phase else "idle"
  if (cancelled) {
    state$tool_state <- "idle"
  } else if (!failed && identical(state$tool_state, "running")) {
    state$tool_state <- "idle"
  } else if (failed && identical(state$tool_state, "running")) {
    state$tool_state <- "error"
  }

  console_app_update_current_turn(state, turn)
}

#' @keywords internal
format_console_tool_timeline <- function(turn) {
  if (is.null(turn) || length(turn$tool_calls) == 0) {
    return(character(0))
  }

  vapply(seq_along(turn$tool_calls), function(i) {
    tool <- turn$tool_calls[[i]]
    duration <- if (!is.null(tool$elapsed_ms) && is.finite(tool$elapsed_ms)) {
      sprintf(" (%.0f ms)", tool$elapsed_ms)
    } else {
      ""
    }
    paste0(
      i, ". ", tool$name,
      " [", tool$status, "] ",
      tool$args_summary %||% paste0("Running ", tool$name),
      if (!is.null(tool$result_summary)) paste0(" -> ", tool$result_summary) else "",
      if (length(tool$messages %||% character(0))) paste0(" | messages: ", length(tool$messages)) else "",
      if (length(tool$warnings %||% character(0))) paste0(" | warnings: ", length(tool$warnings)) else "",
      duration
    )
  }, character(1))
}

#' @keywords internal
render_console_tool_timeline <- function(state, turn = console_app_get_current_turn(state)) {
  lines <- format_console_tool_timeline(turn)
  if (length(lines) == 0) {
    return(invisible(lines))
  }

  if (!requireNamespace("cli", quietly = TRUE)) {
    cat("Tool Timeline\n", sep = "")
    cat(paste0("- ", lines, "\n"), sep = "")
    return(invisible(lines))
  }

  cli::cli_h2("Tool Timeline")
  cli::cli_ul(lines)
  invisible(lines)
}

#' @keywords internal
console_app_get_last_turn <- function(state) {
  if (length(state$turns) == 0) {
    return(NULL)
  }

  turn_ids <- suppressWarnings(as.integer(names(state$turns)))
  if (all(is.na(turn_ids))) {
    return(state$turns[[length(state$turns)]])
  }

  state$turns[[as.character(max(turn_ids, na.rm = TRUE))]]
}

#' @keywords internal
console_app_get_turn_by_id <- function(state, turn_id) {
  if (is.null(turn_id)) {
    return(NULL)
  }
  state$turns[[as.character(turn_id)]]
}

#' @keywords internal
format_console_turn_detail <- function(turn) {
  if (is.null(turn)) {
    return(character(0))
  }

  elapsed <- if (!is.null(turn$elapsed_ms) && is.finite(turn$elapsed_ms)) {
    sprintf("%.0f ms", turn$elapsed_ms)
  } else {
    "n/a"
  }

  assistant_preview <- compact_text_preview(turn$assistant_text %||% "", width = 120)
  user_preview <- compact_text_preview(turn$user_text %||% "", width = 120)
  tool_lines <- format_console_tool_timeline(turn)

  c(
    sprintf("Turn: %s", turn$turn_id %||% "unknown"),
    sprintf("Phase: %s", turn$phase %||% "unknown"),
    sprintf("Elapsed: %s", elapsed),
    sprintf("User: %s", user_preview),
    sprintf("Assistant: %s", assistant_preview),
    if (length(turn$messages %||% character(0))) paste0("Messages: ", paste(turn$messages, collapse = " | ")) else "Messages: none",
    if (length(turn$warnings %||% character(0))) paste0("Warnings: ", paste(turn$warnings, collapse = " | ")) else "Warnings: none",
    if (length(tool_lines)) "Timeline:" else "Timeline: none",
    if (length(tool_lines)) paste0("- ", tool_lines) else character(0)
  )
}

#' @keywords internal
format_console_tool_detail <- function(turn, tool_index) {
  if (is.null(turn) || length(turn$tool_calls) == 0) {
    return(character(0))
  }

  if (length(tool_index) == 0 || is.na(tool_index) || tool_index < 1 || tool_index > length(turn$tool_calls)) {
    return(character(0))
  }

  tool <- turn$tool_calls[[tool_index]]
  elapsed <- if (!is.null(tool$elapsed_ms) && is.finite(tool$elapsed_ms)) {
    sprintf("%.0f ms", tool$elapsed_ms)
  } else {
    "n/a"
  }

  args_preview <- tryCatch(
    compact_text_preview(safe_to_json(tool$raw_args, auto_unbox = TRUE), width = 160),
    error = function(e) compact_text_preview(tool$args_summary %||% "", width = 160)
  )
  result_preview <- if (is.null(tool$raw_result)) {
    compact_text_preview(tool$result_summary %||% "", width = 160)
  } else {
    tryCatch(
      if (is.character(tool$raw_result)) {
        compact_text_preview(tool$raw_result, width = 160)
      } else {
        compact_text_preview(safe_to_json(tool$raw_result, auto_unbox = TRUE), width = 160)
      },
      error = function(e) compact_text_preview(tool$result_summary %||% "", width = 160)
    )
  }

  c(
    sprintf("Tool: %s", tool$name %||% "unknown"),
    sprintf("Status: %s", tool$status %||% "unknown"),
    sprintf("Elapsed: %s", elapsed),
    sprintf("Args summary: %s", tool$args_summary %||% "none"),
    sprintf("Result summary: %s", tool$result_summary %||% "none"),
    if (length(tool$messages %||% character(0))) paste0("Messages: ", paste(tool$messages, collapse = " | ")) else "Messages: none",
    if (length(tool$warnings %||% character(0))) paste0("Warnings: ", paste(tool$warnings, collapse = " | ")) else "Warnings: none",
    paste0("Args raw: ", args_preview),
    paste0("Result raw: ", result_preview)
  )
}

#' @keywords internal
build_console_inspector_lines <- function(turn, tool_index = NULL) {
  lines <- if (is.null(tool_index)) {
    format_console_turn_detail(turn)
  } else {
    format_console_tool_detail(turn, tool_index)
  }

  if (!length(lines)) {
    return(lines)
  }

  navigation <- if (is.null(tool_index)) {
    if (length(turn$tool_calls) > 0) {
      c("Navigation: /inspect next opens the first tool", "Navigation: /inspect tool <index> opens a specific tool")
    } else {
      "Navigation: no tool entries are available for this turn"
    }
  } else {
    c("Navigation: /inspect prev | /inspect next", "Navigation: /inspect turn returns to the turn summary")
  }

  c(lines, navigation)
}

#' @keywords internal
render_console_turn_inspector <- function(state, turn = console_app_get_last_turn(state), tool_index = NULL) {
  if (is.null(turn)) {
    if (requireNamespace("cli", quietly = TRUE)) {
      cli::cli_alert_info("No turns are available to inspect yet.")
    } else {
      cat("No turns are available to inspect yet.\n", sep = "")
    }
    return(invisible(character(0)))
  }

  lines <- build_console_inspector_lines(turn, tool_index = tool_index)

  if (!length(lines)) {
    if (requireNamespace("cli", quietly = TRUE)) {
      cli::cli_alert_warning("Requested inspection target is not available.")
    } else {
      cat("Requested inspection target is not available.\n", sep = "")
    }
    return(invisible(character(0)))
  }

  if (!requireNamespace("cli", quietly = TRUE)) {
    cat(paste0(lines, "\n"), sep = "")
    return(invisible(lines))
  }

  cli::cli_h2(if (is.null(tool_index)) "Turn Inspector" else sprintf("Tool Inspector #%d", tool_index))
  cli::cli_ul(lines)
  invisible(lines)
}

#' @keywords internal
console_app_open_turn_overlay <- function(state, turn = console_app_get_last_turn(state), tool_index = NULL) {
  if (is.null(turn)) {
    return(NULL)
  }

  lines <- build_console_inspector_lines(turn, tool_index = tool_index)
  if (!length(lines)) {
    return(NULL)
  }

  console_app_close_overlay_by_type(state, "inspector")
  console_app_open_overlay(
    state = state,
    type = "inspector",
    title = if (is.null(tool_index)) "Inspector Overlay" else sprintf("Inspector Overlay: Tool %d", tool_index),
    lines = lines,
    payload = list(turn_id = turn$turn_id %||% NULL, tool_index = tool_index)
  )
}

#' @keywords internal
console_app_refresh_inspector_overlay <- function(state) {
  overlay <- console_app_get_active_overlay(state)
  if (is.null(overlay) || !identical(overlay$type, "inspector")) {
    return(NULL)
  }

  turn <- console_app_get_turn_by_id(state, overlay$payload$turn_id %||% NULL)
  if (is.null(turn)) {
    return(NULL)
  }

  tool_index <- overlay$payload$tool_index %||% NULL
  overlay$lines <- build_console_inspector_lines(turn, tool_index = tool_index)
  overlay$title <- if (is.null(tool_index)) "Inspector Overlay" else sprintf("Inspector Overlay: Tool %d", tool_index)
  state$overlay_stack[[length(state$overlay_stack)]] <- overlay
  overlay
}

#' @keywords internal
console_app_navigate_inspector <- function(state, direction = c("next", "prev")) {
  direction <- match.arg(direction)
  overlay <- console_app_get_active_overlay(state)
  if (is.null(overlay) || !identical(overlay$type, "inspector")) {
    return(NULL)
  }

  turn <- console_app_get_turn_by_id(state, overlay$payload$turn_id %||% NULL)
  if (is.null(turn) || length(turn$tool_calls) == 0) {
    return(NULL)
  }

  step <- if (identical(direction, "next")) 1L else -1L
  current_index <- overlay$payload$tool_index %||% 0L
  target_index <- if (current_index <= 0L) {
    if (step > 0L) 1L else length(turn$tool_calls)
  } else {
    current_index + step
  }

  if (target_index < 1L || target_index > length(turn$tool_calls)) {
    return(NULL)
  }

  console_app_open_turn_overlay(state, turn = turn, tool_index = target_index)
}

Try the aisdk package in your browser

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

aisdk documentation built on May 29, 2026, 9:07 a.m.