#' Export to xlsx
#'
#' Writes a data frame to an xlsx file. To create an xlsx with (multiple) named
#' sheets, simply set \code{x} to a named list of data frames.
#'
#' Supports strings, numbers, booleans and dates automatically. For cell
#' formatting (fonts, fills, borders, number formats, ...), worksheet layout
#' (column widths, frozen panes, ...), and workbook metadata, wrap columns with
#' \code{\link{xl_cell_general}}, sheets with \code{\link{xl_sheet}}, and the
#' whole workbook with \code{\link{xl_workbook}}. See the "Formatting and
#' workbook properties" vignette and \code{\link{xl_format}}.
#'
#' \if{html}{
#' \out{
#' <link rel="stylesheet" type="text/css" href="https://jeroen.github.io/clippy/clippy.min.css" media="all">
#' <script src="https://jeroen.github.io/clippy/bundle.js"></script>
#' }}
#'
#' @export
#' @aliases writexl
#' @useDynLib writexl C_write_data_frame_list
#' @param x a data frame, an [xl_sheet], an [xl_workbook], or a (named) list of
#'   data frames / `xl_sheet`s that become the sheets in the xlsx
#' @param path a file name to write to
#' @param col_names write column names as the header row at the top of the sheet?
#' @param format_headers apply the workbook's header format to that header row?
#'   The default header format is bold and centered; change it with
#'   \code{\link{xl_properties}(header_format = )}.
#' @param use_zip64 use \href{https://en.wikipedia.org/wiki/Zip_(file_format)#ZIP64}{zip64}
#' to enable support for 4GB+ xlsx files. Not all platforms can read this.
#' @param na what to write where a value has none. `NA` (the default) leaves
#'   the cell blank, as writexl has always done; anything else is written in
#'   its place, keeping its own type. Shorthand for
#'   \code{\link{xl_properties}(na = )}, so give it there instead when `x` is
#'   already an [xl_workbook]. A column or a single cell can override it: see
#'   [xl_col_spec()] and [xl_cell_general()].
#' @param constant_memory stream rows to disk instead of building the whole
#'   workbook in memory. `NA` (the default) decides per workbook: on for large
#'   data, off for small, and always off when a feature needs it off. `TRUE`
#'   forces it on for a workbook that would otherwise be judged too small;
#'   `FALSE` forces it off. Features that cannot be written while streaming ---
#'   merged ranges, tables, embedded images and multi-cell array formulas ---
#'   turn it off regardless, with a warning if `TRUE` was asked for, because
#'   the alternative is a file that opens cleanly and is missing cells.
#' @param constant_memory_threshold how much extra memory not streaming would
#'   have to cost, in bytes, before streaming is worth it. Default 128 MiB.
#'   The cost is *estimated* from the number of cells in the workbook, using a
#'   fixed per-cell figure calibrated against a range of data; the true cost
#'   varies with the data, and is lowest for text that repeats. Streaming saves
#'   memory but produces slightly larger files, so it is not used for workbooks
#'   small enough that the saving would not be noticed.
#' @family workbook settings
#' @examples # Roundtrip example with single excel sheet named 'mysheet'
#' tmp <- write_xlsx(list(mysheet = iris))
#' readxl::read_xlsx(tmp)
write_xlsx <- function(x, path = tempfile(fileext = ".xlsx"), col_names = TRUE,
                       format_headers = TRUE, na = NA, use_zip64 = FALSE,
                       constant_memory = NA,
                       constant_memory_threshold = 128 * 1024^2){
  # Resolve the input to an xl_workbook.  A bare data frame / xl_sheet / list
  # is wrapped in a workbook with default properties; an explicit xl_workbook
  # overrides col_names/format_headers.
  if(inherits(x, "xl_workbook")){
    # a workbook carries its own properties, so the shorthand has nowhere to go
    # rather than somewhere surprising
    if(!is.null(.val_na(na)))
      stop("`na` is a shorthand for xl_properties(na = ); `x` is already an ",
           "xl_workbook, so set it there", call. = FALSE)
    wb <- x
    col_names <- wb$col_names
    format_headers <- wb$format_headers
  } else {
    wb <- xl_workbook(x, properties = xl_properties(na = na),
                      col_names = col_names, format_headers = format_headers)
  }
  props <- wb$properties
  elems <- wb$sheets
  # a chartsheet has no cells, so it stands in the data-frame list as a data
  # frame with no columns; C branches on the plan before the row loop
  is_cs <- vapply(elems, inherits, logical(1), "xl_chartsheet")
  dfs <- lapply(seq_along(elems), function(i)
    if (is_cs[[i]]) .chartsheet_placeholder()
    else if (inherits(elems[[i]], "xl_sheet")) elems[[i]]$data else elems[[i]])
  names(dfs) <- names(elems)
  dfs <- lapply(dfs, normalize_df)
  names(dfs) <- .resolve_sheet_names(names(elems), length(dfs))
  # tab visibility is the one worksheet setting whose rules span the whole
  # workbook, so it is checked here rather than per sheet
  .resolve_sheet_visibility(elems, names(dfs))
  stopifnot(is.character(path) && length(path))
  path <- normalizePath(path, mustWork = FALSE)
  # Excel has no concept of a time zone, so decide once, for the whole workbook,
  # how POSIXct values are written (see .resolve_timezones()).
  tz_res <- .resolve_timezones(dfs, props)
  dfs <- tz_res$dfs
  props <- tz_res$props
  # Resolve everything into one deduplicated workbook format table: the header
  # format, each general cell's effective format, and each sheet's column/row
  # plan -- all cascaded over the workbook default_format.
  header_offset <- if(isTRUE(as.logical(col_names))) 1L else 0L
  reg <- .new_format_registry()
  header_id <- .register_format(reg, merge_xl_format(props$default_format,
                                                     props$header_format))
  dfs <- lapply(dfs, .resolve_sheet_formats, reg = reg, props = props,
                header_offset = header_offset)
  # Table names are unique across the workbook, not the sheet, so they are
  # resolved here alongside the sheet names rather than inside xl_table().
  table_names <- .resolve_table_names(elems, names(dfs))
  # Charts resolve after the sheets are known: a series may plot data from any
  # sheet, so its range cannot be resolved against one sheet in isolation.
  chart_plans <- Map(function(el, nm)
    .resolve_charts(el, dfs[[nm]], reg, header_offset, props, dfs, nm),
    elems, names(dfs))
  sheets <- Map(function(el, df, tn, ch)
                  if (inherits(el, "xl_chartsheet"))
                    .resolve_chartsheet_plan(el, ch)
                  else
                    .resolve_sheet_plan(el, df, reg, header_offset, props, tn,
                                        ch),
                elems, dfs, table_names, chart_plans)
  # Ordering matters to libxlsxwriter's drawing numbering, so this spans the
  # whole workbook rather than any one sheet
  .check_drawing_order(sheets, names(dfs))
  cm <- .resolve_constant_memory(dfs, props, sheets, constant_memory,
                                 constant_memory_threshold)
  ret <- .Call(C_write_data_frame_list, dfs, path, col_names, format_headers,
               use_zip64, reg$table, sheets, header_id,
               .properties_payload(props, cm$on))
  invisible(ret)
}

# =============================================================================
# Time zones
# =============================================================================
#
# Excel stores a datetime as a naive serial number: it has no time zone.  Rather
# than silently converting every POSIXct to UTC, writexl decides per workbook:
#
#   * all POSIXct values share one time zone -> drop the zone and write local
#     wall-clock time (2025-12-01 01:00 in Perth is written as 01:00), and drop
#     the " UTC" suffix from the default datetime format so nothing is mislabelled;
#   * the time zones differ -> convert everything to UTC and warn, since no
#     single wall clock can represent them all.
#
# The survey covers plain POSIXct columns and POSIXct values inside
# xl_cell_general cells.

# The time zone of a POSIXct, with NULL/"" (meaning local time) resolved to the
# session zone so that an unset zone and an explicit local zone compare equal.
.tzone_of <- function(x){
  tz <- attr(x, "tzone", exact = TRUE)
  if(is.null(tz) || !length(tz) || !nzchar(tz[1])){
    loc <- Sys.timezone()
    # Sys.timezone() reports NA only where the OS has no zone configured
    if(is.na(loc)) "" else loc  # nocov
  } else {
    tz[1]
  }
}

# Every distinct time zone used by a POSIXct anywhere in the workbook.  Custom
# document properties count: they are datetimes in the same workbook, and
# writing them under a different rule than the cells would be incoherent.
.collect_tzones <- function(dfs, props = NULL){
  out <- character(0)
  if(!is.null(props$custom))
    for(v in props$custom)
      if(inherits(v, "POSIXct"))
        out <- c(out, .tzone_of(v))
  for(df in dfs){
    for(col in df){
      if(inherits(col, "POSIXct")){
        out <- c(out, .tzone_of(col))
      } else if(inherits(col, "xl_cell_general")){
        for(rec in .cell_records(col))
          if(inherits(rec$value, "POSIXct"))
            out <- c(out, .tzone_of(rec$value))
      }
    }
  }
  unique(out)
}

# Re-express a POSIXct so that its wall-clock reading is what reaches the cell.
# The offset is taken per instant, so daylight saving is handled correctly.
.drop_tzone <- function(x){
  off <- as.POSIXlt(x, tz = .tzone_of(x))$gmtoff
  # Not every platform reports gmtoff: older Windows builds of R return NULL or
  # a zero-length vector.  Fall back to leaving the value alone (i.e. UTC)
  # rather than writing something wrong -- note the length check, without which
  # a zero-length offset would recycle to nothing and silently empty the column.
  if(is.null(off) || length(off) != length(x) ||
     any(is.na(off) & !is.na(as.numeric(x))))
    return(x)  # nocov  (only on a platform whose POSIXlt has no gmtoff)
  off[is.na(off)] <- 0
  structure(as.numeric(x) + off, class = c("POSIXct", "POSIXt"), tzone = "UTC")
}

# Apply .drop_tzone() to every POSIXct in a sheet, including inside cell objects.
.drop_tzones_sheet <- function(df){
  for(j in seq_along(df)){
    col <- df[[j]]
    if(inherits(col, "POSIXct")){
      df[[j]] <- .drop_tzone(col)
    } else if(inherits(col, "xl_cell_general")){
      recs <- .cell_records(col)
      touched <- FALSE
      for(k in seq_along(recs)){
        if(inherits(recs[[k]]$value, "POSIXct")){
          recs[[k]]$value <- .drop_tzone(recs[[k]]$value)
          touched <- TRUE
        }
      }
      if(touched)
        df[[j]] <- .new_cell_vector(recs)
    }
  }
  df
}

.resolve_timezones <- function(dfs, props){
  tzs <- .collect_tzones(dfs, props)
  if(length(tzs) > 1L){
    warning("The workbook contains datetimes in ", length(tzs),
            " different time zones (", paste(tzs, collapse = ", "),
            "); all of them were converted to UTC because Excel does not ",
            "support time zones. Convert them yourself beforehand if you want ",
            "different behaviour.", call. = FALSE)
  } else if(length(tzs) == 1L){
    dfs <- lapply(dfs, .drop_tzones_sheet)
    # custom document properties follow the same rule as the cells
    if(!is.null(props$custom))
      for(k in seq_along(props$custom))
        if(inherits(props$custom[[k]], "POSIXct"))
          props$custom[[k]] <- .drop_tzone(props$custom[[k]])
    # The default format labels datetimes "UTC"; that is no longer true once the
    # zone has been dropped.  Only replace it if the caller kept the default.
    if(identical(unclass(props$datetime_format),
                 unclass(.default_datetime_format())))
      props$datetime_format <- xl_num_format("yyyy-mm-dd HH:mm:ss")
  }
  list(dfs = dfs, props = props)
}

# Walk a sheet's xl_cell_general columns, register each cell's effective format
# in the workbook registry, attach the resulting integer id vector, flatten each
# comment's xl_format into the flat fields C applies, and resolve each array
# formula's range to the 0-based quad C writes it with.
#
# Multi-cell array ranges are collected on the returned data frame (attribute
# "writexl_array_multicell") because they decide the workbook's constant-memory
# flag -- see .resolve_constant_memory().
.resolve_sheet_formats <- function(df, reg, props, header_offset = 1L) {
  multicell <- list()
  for (j in seq_along(df)) {
    col <- df[[j]]
    if (!inherits(col, "xl_cell_general")) next
    recs <- .cell_records(col)
    ids <- vapply(recs, .resolve_cell_format_id, integer(1), reg = reg, props = props)
    for (k in seq_along(recs)) {
      rec <- recs[[k]]
      if (!is.null(rec$comment)) rec$comment <- .comment_c_payload(rec$comment)
      fm_set <- !is.null(rec$formula) && length(rec$formula) == 1L &&
                !is.na(rec$formula)
      if ((isTRUE(rec$array) || isTRUE(rec$dynamic)) && fm_set) {
        anchor <- c((k - 1L) + as.integer(header_offset), j - 1L)
        q <- .resolve_array_quad(rec$array_range, anchor, df, header_offset,
                                 names(df)[j], k)
        rec$array_quad <- q
        if (q[3L] > q[1L] || q[4L] > q[2L]) {
          .check_array_no_overlap(q, anchor, df, header_offset, names(df)[j], k)
          multicell <- c(multicell, list(q))
        }
      }
      # a rich string's runs each carry their own font, registered like any
      # other format; C receives the parallel text / id vectors
      if (is_xl_rich_string(rec$value)) {
        rich <- .rich_string_c_payload(rec$value, reg, props)
        rec$rich_text <- rich$rich_text
        rec$rich_format_id <- rich$rich_format_id
        rec$value <- NULL
      }
      # the unresolved user spec has served its purpose; keep the C payload tight
      rec$array_range <- NULL
      recs[[k]] <- rec
    }
    col <- .new_cell_vector(recs)
    attr(col, "writexl_format_ids") <- ids
    df[[j]] <- col
  }
  attr(df, "writexl_array_multicell") <- multicell
  df
}

# Resolve one array formula's range.  With no declared range the formula covers
# only its own cell, which is the modern dynamic-array spelling: Excel spills
# the result itself.  A declared range must start at the cell, because
# libxlsxwriter writes the formula into the range's top-left corner -- were the
# two allowed to differ the formula would land in a different cell than the one
# the caller wrote it to.
.resolve_array_quad <- function(spec, anchor, df, header_offset, colname, k) {
  if (is.null(spec))
    return(as.integer(c(anchor[1L], anchor[2L], anchor[1L], anchor[2L])))
  arg <- sprintf('array_range (column "%s", cell %d)', colname, k)
  q <- .xl_resolve_range(spec, arg = arg, df = df,
                         header_offset = header_offset, allow_cell = TRUE)
  if (q[1L] != anchor[1L] || q[2L] != anchor[2L])
    stop(sprintf(paste0("`%s` must start at the cell that holds the formula ",
                        "(row %d, column %d of the sheet, 1-based)"),
                 arg, anchor[1L] + 1L, anchor[2L] + 1L), call. = FALSE)
  q
}

# Refuse a multi-cell array range that overlaps cells the sheet writes itself.
#
# libxlsxwriter pads a multi-cell array range with formatted zeroes, which the
# row loop would then overwrite (or which would overwrite the sheet's own
# values, depending on ordering).  Rather than emit a file whose array range is
# half data, require the range to spill into cells the sheet does not occupy.
.check_array_no_overlap <- function(q, anchor, df, header_offset, colname, k) {
  nrows <- nrow(df)
  ncols <- length(df)
  # unreachable from a written sheet: the check runs per cell, and a frame with
  # no rows or no columns has no cells
  if (nrows < 1L || ncols < 1L) return(invisible(NULL))  # nocov
  # the sheet's own data rectangle, 0-based
  first_row <- as.integer(header_offset)
  last_row  <- first_row + nrows - 1L
  r1 <- max(q[1L], first_row); r2 <- min(q[3L], last_row)
  c1 <- max(q[2L], 0L);        c2 <- min(q[4L], ncols - 1L)
  # likewise: the range is required to start at the formula's own cell, which
  # is inside the data, so the two rectangles always overlap
  if (r2 < r1 || c2 < c1) return(invisible(NULL))  # nocov
  ncell <- (as.numeric(r2 - r1) + 1) * (as.numeric(c2 - c1) + 1)
  if (ncell == 1 && r1 == anchor[1L] && c1 == anchor[2L])
    return(invisible(NULL))
  stop(sprintf(paste0(
    'the `array_range` on column "%s", cell %d covers %.0f cell(s) that the ',
    "sheet writes itself. A multi-cell array range must extend into cells the ",
    "sheet does not occupy, because the range is padded on write and the two ",
    "would overwrite each other. Either drop `array_range` (a single-cell ",
    "dynamic formula spills automatically in modern Excel) or move the range ",
    "beyond the data."), colname, k, ncell), call. = FALSE)
}

# Resolve one cell record's effective format to a registry id (0 = none),
# cascading workbook default_format, then the hyperlink/date default, then the
# cell's own format.
.resolve_cell_format_id <- function(rec, reg, props) {
  fmt <- rec$format
  val <- rec$value
  fm  <- rec$formula
  hl  <- rec$hyperlink
  formula_set   <- !(is.null(fm) || (length(fm) == 1L && is.na(fm)))
  hyperlink_set <- !(is.null(hl) || identical(hl, NA) ||
                     (is.character(hl) && length(hl) == 1L && is.na(hl)))
  base <- props$default_format
  if (hyperlink_set) {
    base <- merge_xl_format(base, props$hyperlink_format)
  } else if (!formula_set && !is.null(val) &&
             (inherits(val, "Date") || inherits(val, "POSIXct"))) {
    has_num <- is_xl_format(fmt) && !is.null(unclass(fmt)$num_format)
    if (!has_num)
      base <- merge_xl_format(base, if (inherits(val, "POSIXct"))
                                props$datetime_format else props$date_format)
  }
  .register_format(reg, merge_xl_format(base, fmt))
}

normalize_df <- function(df){
  if(nrow(df) > 1024^2){
    stop("the xlsx format does not support tables with 1M+ rows")
  }
  # Types to coerce to strings
  for(i in which(vapply(df, inherits, logical(1), c("factor", "hms")))){
    df[[i]] <- as.character(df[[i]])
  }
  for(i in which(vapply(df, function(x){is.integer(x) && inherits(x, "POSIXct")}, logical(1)))){
    # as.double() drops the class, so this dispatches to as.POSIXct.numeric(),
    # whose `origin` had no default before R 4.3 -- there it is an error,
    # "'origin' must be supplied".  1970-01-01 is what the later default uses,
    # so naming it gives the same instant on every version rather than a
    # value that depends on which R is running.
    df[[i]] <- as.POSIXct(as.double(df[[i]]), origin = "1970-01-01")
  }
  for(i in which(vapply(df, inherits, logical(1), "POSIXlt"))){
    df[[i]] <- as.POSIXct(df[[i]])
  }
  for(i in which(vapply(df, inherits, logical(1), "integer64"))){
    warning(sprintf("Coercing column %s from int64 to double", names(df)[i]), call. = FALSE)
    getNamespace("bit64")
    df[[i]] <- as.double(df[[i]])
  }
  .check_supported_columns(df)
  df
}

# Whether a column can be written at all.  This mirrors get_type() in
# src/write_xlsx.c: anything backed by a character, integer, double or logical
# vector is writable (a classed column such as Date, POSIXct or difftime is
# written from its underlying values), and xl_cell_general carries its own
# writer.  Everything else -- complex, raw, a plain list column -- has no
# representation in xlsx.
.is_supported_column <- function(x){
  if(inherits(x, "xl_cell_general"))
    return(TRUE)
  is.character(x) || is.integer(x) || is.double(x) || is.logical(x)
}

# Fail loudly on column types writexl cannot represent, rather than silently
# writing the underlying values (or nothing at all).
.check_supported_columns <- function(df){
  bad <- which(!vapply(df, .is_supported_column, logical(1)))
  if(!length(bad))
    return(invisible(NULL))
  detail <- vapply(bad, function(i){
    cls <- paste(class(df[[i]]), collapse = "/")
    ty <- typeof(df[[i]])
    sprintf("'%s' (column %d): %s", names(df)[i], i,
            if(identical(cls, ty)) cls else sprintf("%s (%s)", cls, ty))
  }, character(1))
  stop("writexl cannot write column(s) of these types:\n  ",
       paste(detail, collapse = "\n  "), call. = FALSE)
}
