# P11 — eval. Typed tree -> ggplot object.
# For each surviving layer, build an evaluable R `language` object: pipelines
# fold via `desugar_pipe_to_call` (so neither `|>` nor `%>%` requires runtime
# magrittr); other nodes reconstitute directly. Each layer expression is
# re-validated by P5 (post-substitution structure may differ) before eval.
# Layer results accumulate with `+`. No-layers errors out distinctly from
# safety errors (BDD P5.18 / P11.3).

ptr_eval <- function(node, eval_env = parent.frame(), expr_check = TRUE) {
  if (!is_ptr_root(node)) {
    rlang::abort("ptr_eval expects a ptr_root.")
  }
  ptr_assert_no_placeholders(node)
  ptr_assert_no_missing(node)
  if (length(node$layers) == 0L) {
    rlang::abort("No layers to evaluate (after pruning).")
  }
  exprs <- lapply(node$layers, layer_to_eval_expr)
  ph_names <- ptr_registry_keywords()
  for (e in exprs) {
    validate_expr_safety(e, expr_check = expr_check, placeholder_names = ph_names)
  }
  results <- lapply(exprs, function(e) eval(e, envir = eval_env))
  Reduce(`+`, results[-1L], results[[1L]])
}

layer_to_eval_expr <- function(layer) {
  if (is_ptr_user_expr(layer)) return(layer$inner)
  if (is_ptr_placeholder(layer)) {
    rlang::abort(paste0(
      "Unsubstituted placeholder layer reached eval (keyword=",
      layer$keyword %||% "?", ")."
    ))
  }
  head_expr <- layer_head_lang(layer)
  is_piped <- layer_is_piped(layer)
  child_args <- node_list_to_lang(layer$children)
  if (is_piped && is_ptr_pipeline(layer$data_arg)) {
    upstream <- pipeline_to_eval_expr(layer$data_arg)
    rhs <- as.call(c(list(head_expr), child_args))
    return(desugar_pipe_to_call(upstream, rhs))
  }
  if (is.null(layer$data_arg)) {
    return(as.call(c(list(head_expr), child_args)))
  }
  data_expr <- node_to_lang(layer$data_arg)
  # Emit `data = ...` (named), not positional: `ggplot()` takes `data`
  # first, but `geom_*()`/`stat_*()` take `mapping` first, so a positional
  # data slot there misroutes the frame into `mapping` ("`mapping` must be
  # created by `aes()`"). The original formula carried `data =` explicitly
  # for those layers; reconstruct it the same way.
  as.call(c(list(head_expr), list(data = data_expr), child_args))
}

layer_head_lang <- function(layer) {
  e <- layer$expr
  if (is.call(e)) {
    while (is.call(e) && is.symbol(e[[1L]]) &&
           as.character(e[[1L]]) %in% c("%>%", "%ptrPipeNative%", "|>")) {
      e <- e[[3L]]
    }
    if (is.call(e)) return(e[[1L]])
  }
  if (!is.null(layer$name)) return(as.name(layer$name))
  rlang::abort("Layer has no extractable head.")
}

pipeline_to_eval_expr <- function(node) {
  if (length(node$stages) == 0L) {
    rlang::abort("Empty pipeline reached eval.")
  }
  if (length(node$stages) == 1L) return(node_to_lang(node$stages[[1L]]))
  acc <- node_to_lang(node$stages[[1L]])
  for (i in seq(2L, length(node$stages))) {
    stage_node <- node$stages[[i]]
    stage      <- node_to_lang(stage_node)
    fan        <- stage_node$first_arg_name %||% ""
    acc        <- desugar_pipe_to_call(acc, stage, first_arg_name = fan)
  }
  acc
}

# `lhs |> rhs(args)` -> `rhs(lhs, args)`. For bare-symbol rhs (`lhs |> f`)
# -> `f(lhs)`. Both pipe ops desugar identically — we honor surface only at
# render time, never at eval time.
#
# `first_arg_name` (chr scalar, defaults to "") names the inserted lhs slot
# when the source position was named in the user's original chain (e.g.
# `ggplot(data = penguins, ...)` carries `first_arg_name = "data"` on the
# stage). PLAN-02 (ADR 0012) captures this name at lift time so the canonical
# pipeline round-trips losslessly through eval. Existing direct callers of
# this helper get the default `""` and behave exactly as before.
desugar_pipe_to_call <- function(lhs, rhs, first_arg_name = "") {
  if (is.call(rhs)) {
    lhs_slot <- list(lhs)
    if (nzchar(first_arg_name)) names(lhs_slot) <- first_arg_name
    rest <- as.list(rhs[-1L])
    new_args <- c(lhs_slot, rest)
    return(as.call(c(list(rhs[[1L]]), new_args)))
  }
  if (nzchar(first_arg_name)) {
    return(rlang::call2(rhs, !!first_arg_name := lhs))
  }
  rlang::call2(rhs, lhs)
}

node_to_lang <- function(node) {
  if (!is_ptr_node(node)) return(node)
  if (is_ptr_literal(node)) return(node$expr)
  if (is_ptr_user_expr(node)) return(node$inner)
  if (is_ptr_call(node)) {
    head <- node$fun
    args <- node_list_to_lang(node$args)
    return(as.call(c(list(head), args)))
  }
  if (is_ptr_closure(node)) {
    return(call("function", node$formals, node_to_lang(node$body)))
  }
  if (is_ptr_pipeline(node)) return(pipeline_to_eval_expr(node))
  if (is_ptr_missing(node)) {
    rlang::abort(paste0(
      "Internal error: a missing-value node reached evaluation; it should ",
      "have been removed earlier. Please report this at ",
      "https://github.com/willju-wangqian/ggpaintr/issues."
    ))
  }
  if (is_ptr_placeholder(node)) {
    rlang::abort(paste0(
      "Unsubstituted placeholder reached eval (id=", node$id %||% "?", ")."
    ))
  }
  rlang::abort(paste0("Unknown node class for eval: ", class(node)[1L]))
}

node_list_to_lang <- function(args) {
  if (length(args) == 0L) return(list())
  out <- vector("list", length(args))
  # `out[i] <- list(x)` (not `out[[i]] <- x`): a node whose lang is `NULL`
  # (e.g. a literal `y = NULL` arg) must keep its slot. `[[<-` with NULL
  # deletes the element, which would desync `out` from `names(args)`.
  for (i in seq_along(args)) out[i] <- list(node_to_lang(args[[i]]))
  names(out) <- names(args)
  out
}
