# (pseudo-)unique IDs
# Restore .Random.seed on exit so table creation does not consume the user's
# global RNG stream. Reseed with a per-call unique value (time + counter) so
# consecutive ids still differ even though the user's seed is restored.
get_id_counter <- local({
  i <- 0L
  function() {
    i <<- i + 1L
    i
  }
})

get_id <- function(stem = "id") {
  if (exists(".Random.seed", globalenv(), inherits = FALSE)) {
    old <- get(".Random.seed", globalenv())
    on.exit(assign(".Random.seed", old, globalenv()), add = TRUE)
  } else {
    on.exit(
      if (exists(".Random.seed", globalenv(), inherits = FALSE)) {
        rm(".Random.seed", envir = globalenv())
      },
      add = TRUE
    )
  }
  set.seed(as.integer(Sys.time()) %% 1000000L + get_id_counter())
  id <- sample(c(0:9, letters), 20, replace = TRUE)
  paste0(stem, paste(id, collapse = ""))
}

# Clamp colspan values so spans never extend past the last column
clamp_colspan <- function(style, ncol) {
  if (nrow(style) > 0 && "colspan" %in% colnames(style)) {
    end <- style$j + style$colspan - 1
    style$colspan <- ifelse(!is.na(end) & end > ncol, style$colspan - (end - ncol), style$colspan)
  }
  style
}

# getOption with deprecation warnings
get_option <- function(x, default = NULL) {
  deprecated <- c(
    # old = new
    "tinytable_grid_hlines" = "tinytable_markdown_hlines",
    "tinytable_save_pdf_clean" = "tinytable_pdf_clean",
    "tinytable_save_pdf_engine" = "tinytable_pdf_engine"
  )
  if (x %in% names(deprecated)) {
    x_new <- deprecated[[x]]
    warning(
      sprintf("Option `%s` is deprecated. Use `%s` instead.", x, x_new),
      call. = FALSE
    )
    x <- x_new
  }
  getOption(x, default = default)
}

format_markup_num <- function(x) {
  out <- format(
    x,
    scientific = FALSE,
    trim = TRUE,
    digits = 15,
    decimal.mark = ".",
    drop0trailing = TRUE
  )
  sub("^-0$", "0", out)
}

format_markup_unit <- function(x, unit) {
  paste0(format_markup_num(x), unit)
}

ttempdir <- function() {
  d <- tempdir()
  d <- file.path(d, "tinytable")
  # start fresh
  if (dir.exists(d)) {
    unlink(d, recursive = TRUE)
  }
  dir.create(d)
  return(d)
}

lines_drop_consecutive_empty <- function(x) {
  if (!nzchar(x)) {
    return(x)
  }

  # strsplit() drops one terminal delimiter; mirror that behavior before
  # collapsing runs. The regex matches repeated *identical* whitespace-only
  # lines, which is the exact behavior of the former rle(lines) implementation,
  # without allocating and rejoining every line in large rendered tables.
  if (endsWith(x, "\n")) {
    x <- substr(x, 1L, nchar(x) - 1L)
  }
  gsub(
    "(?m)^([ \\t\\r]*)(?:\\n\\1)+(?=\\n|$)",
    "\\1",
    x,
    perl = TRUE
  )
}

lines_drop <- function(
    old,
    regex,
    position = "equal",
    fixed = FALSE,
    unique = TRUE,
    perl = FALSE) {
  assert_choice(position, c("equal", "before", "after", "all"))
  lines <- strsplit(old, "\n")[[1]]
  idx <- grep(regex, lines, fixed = fixed, perl = perl)
  if (isTRUE(unique) && length(idx) > 1 && position != "all") {
    stop(
      "The `regex` supplied `lines_drop()` did not match a unique line.",
      call. = FALSE
    )
  }
  if (length(idx) > 0) {
    if (position == "equal") {
      lines <- lines[!seq_along(lines) %in% idx]
    } else if (position == "before") {
      lines <- lines[idx:length(lines)]
    } else if (position == "after") {
      lines <- lines[1:idx]
    } else if (position == "all") {
      lines <- lines[!seq_along(lines) %in% idx]
    }
  }
  out <- paste(lines, collapse = "\n")
  return(out)
}

lines_drop_between <- function(text, regex_start, regex_end, fixed = FALSE, perl = FALSE) {
  lines <- strsplit(text, "\n")[[1]]
  idx_start <- grep(regex_start, lines, fixed = fixed, perl = perl)
  idx_end <- grep(regex_end, lines, fixed = fixed, perl = perl)
  if (length(idx_start) != 1) {
    stop("The `regex_start` did not match a unique line.", call. = FALSE)
  }
  if (length(idx_end) != 1) {
    stop("The `regex_end` did not match a unique line.", call. = FALSE)
  }
  if (idx_start >= idx_end) {
    stop("`regex_start` matches a line after `regex_end`.", call. = FALSE)
  }
  keep <- setdiff(seq_along(lines), idx_start:idx_end)
  out <- paste(lines[keep], collapse = "\n")
  return(out)
}

lines_insert <- function(old, new, regex, position = c("before", "after"),
                         fixed = FALSE, perl = FALSE, occurrence = 1L,
                         require_unique = FALSE) {
  position <- match.arg(position)
  lines <- strsplit(old, "\n", fixed = TRUE)[[1]]
  hits <- grep(regex, lines, fixed = fixed, perl = perl)

  if (length(hits) == 0L || anyNA(hits)) stop("`regex` did not match.", call. = FALSE)
  if (require_unique && length(hits) != 1L) stop("`regex` did not match a unique line.", call. = FALSE)
  if (occurrence > length(hits)) stop("`occurrence` out of range.", call. = FALSE)

  idx <- hits[occurrence]
  after <- if (position == "before") idx - 1L else idx
  out <- append(lines, values = new, after = after)
  paste(out, collapse = "\n")
}

# Fast path for inserting content after several unique fixed-text marker lines.
# Character offsets are resolved first and the output is assembled once.
lines_insert_after_fixed <- function(old, markers, values) {
  stopifnot(length(markers) == length(values))
  marker_pos <- vapply(
    markers,
    function(marker) regexpr(marker, old, fixed = TRUE)[1L],
    integer(1)
  )
  if (any(marker_pos < 1L)) {
    stop("`marker` did not match.", call. = FALSE)
  }

  line_end <- vapply(seq_along(marker_pos), function(k) {
    suffix <- substring(old, marker_pos[k])
    rel <- regexpr("\n", suffix, fixed = TRUE)[1L]
    if (rel < 0L) nchar(old) else marker_pos[k] + rel - 1L
  }, integer(1))
  ord <- order(line_end)
  line_end <- line_end[ord]
  values <- values[ord]

  pieces <- character(length(line_end) * 2L + 1L)
  start <- 1L
  p <- 1L
  for (k in seq_along(line_end)) {
    pieces[p] <- substr(old, start, line_end[k])
    pieces[p + 1L] <- paste0(values[k], "\n")
    start <- line_end[k] + 1L
    p <- p + 2L
  }
  pieces[p] <- substr(old, start, nchar(old))
  paste0(pieces, collapse = "")
}


rbind_nocol <- function(...) {
  dflist <- list(...)
  out <- lapply(dflist, function(k) stats::setNames(k, seq_len(ncol(k))))
  do.call(rbind, out)
}


...get <- function(x, ifnotfound = NULL) {
  eval(
    quote(
      if (!anyNA(.m1 <- match(.x, ...names())) && !is.null(.m2 <- ...elt(.m1))) {
        .m2
      } else {
        .ifnotfound
      }),
    pairlist(.x = x[1L], .ifnotfound = ifnotfound),
    parent.frame(1L)
  )
}


#' Helper function to get value with fallback
#' @param value Primary value
#' @param fallback Fallback value
#' @return Value or fallback
#' @keywords internal
#' @noRd
`%||%` <- function(value, fallback) {
  if (is.null(value)) fallback else value
}


#' Parse a column-group header row into spans.
#'
#' Canonical span parser shared by all backends. `group_row` is a character
#' vector where `NA` means "no group" and `""` (or whitespace-only) means
#' "continuation of the preceding label". A non-empty label starts a span;
#' following empty strings extend it; `NA` or a new non-empty label closes it.
#' Empty strings with no open label (e.g. at the start of the row or after an
#' `NA`) belong to no span and are skipped.
#'
#' @param group_row Character vector (one element per table column).
#' @return A `data.frame` with columns `label` (raw, untrimmed), `start`, and
#'   `end`, one row per span, in column order. Duplicate labels are preserved.
#' @keywords internal
#' @noRd
parse_group_spans <- function(group_row) {
  labels <- character(0)
  starts <- integer(0)
  ends <- integer(0)

  pos <- 1L
  n <- length(group_row)
  while (pos <= n) {
    current_label <- group_row[pos]

    # NA = ungrouped column: no span
    if (is.na(current_label)) {
      pos <- pos + 1L
      next
    }

    span_start <- pos
    pos <- pos + 1L

    # Consume continuation cells (empty strings) following this position
    while (pos <= n && !is.na(group_row[pos]) && trimws(group_row[pos]) == "") {
      pos <- pos + 1L
    }

    # Only record spans that start with a non-empty label; orphan empty
    # strings (no preceding label) are skipped along with their run.
    if (trimws(current_label) != "") {
      labels <- c(labels, current_label)
      starts <- c(starts, span_start)
      ends <- c(ends, pos - 1L)
    }
  }

  data.frame(
    label = labels,
    start = starts,
    end = ends,
    stringsAsFactors = FALSE
  )
}


percent_sum_100 <- function(x, digits = 0) {
  stopifnot(is.numeric(x), all(is.finite(x)), all(x >= 0))
  s <- sum(x)
  if (s <= 0) stop("sum(x) must be > 0")
  p <- x / s

  units <- 100L * 10^digits
  scaled <- p * units
  base <- floor(scaled)
  rem <- scaled - base

  leftover <- units - sum(base) # how many 1/10^digits to distribute
  if (leftover != 0) {
    ix <- order(rem, decreasing = TRUE, method = "radix")
    base[ix[seq_len(leftover)]] <- base[ix[seq_len(leftover)]] + 1L
  }

  out <- base / 10^digits
  return(out)
}
