# Helpers — pull a placeholder node out of a parsed tree by keyword.
.ph_by_keyword <- function(tree, kw) {
  hits <- find_nodes(tree, function(n) {
    is_ptr_placeholder(n) && identical(n$keyword, kw)
  })
  if (!length(hits)) rlang::abort(paste0("no placeholder with keyword=", kw))
  hits[[1L]]
}

# Helpers — collect tag attribute (recursive)
.find_tags <- function(tag, has_class = NULL, has_id = NULL) {
  out <- list()
  visit <- function(x) {
    if (inherits(x, "shiny.tag")) {
      cls <- x$attribs$class %||% ""
      id <- x$attribs$id %||% ""
      class_match <- is.null(has_class) || grepl(has_class, cls, fixed = TRUE)
      id_match <- is.null(has_id) || identical(id, has_id)
      if (class_match && id_match) out[[length(out) + 1L]] <<- x
      for (child in x$children) visit(child)
    } else if (inherits(x, "shiny.tag.list") || is.list(x)) {
      for (el in x) visit(el)
    }
  }
  visit(tag)
  out
}

# ---- P6.1 / P6.2 — value placeholders ----
#
# `build_ui_for.ptr_ph_value` / `.ptr_ph_data_source` now return uiOutput
# containers (ADR 0012 / PLAN-01 — Bug B). Tests that assert on the widget
# tag use `.value_widget` / `.source_widget` from `helper-rewrite.R`,
# which mirror the renderUI composition in `ptr_setup_value_uis()` /
# `ptr_setup_source_uis()`.

test_that("P6.1 text placeholder UI renders textInput", {
  tree <- ptr_translate("ggplot(mtcars) + geom_point(color = ppText)")
  node <- .ph_by_keyword(tree, "ppText")
  ui <- .value_widget(node, layer_name = "geom_point")
  text_inputs <- .find_tags(ui, has_id = node$id)
  expect_true(length(text_inputs) > 0L)
})

test_that("P6.2 num placeholder UI renders a numeric-style input", {
  tree <- ptr_translate("ggplot(mtcars) + geom_point(size = ppNum)")
  node <- .ph_by_keyword(tree, "ppNum")
  ui <- .value_widget(node, layer_name = "geom_point")
  num_inputs <- .find_tags(ui, has_id = node$id)
  expect_true(length(num_inputs) > 0L)
})

# ---- P6.3 / P6.4 — var consumer ----

test_that("P6.3 var consumer static UI emits a uiOutput container", {
  tree <- ptr_translate("ggplot(mtcars, aes(x = ppVar)) + geom_point()")
  node <- .ph_by_keyword(tree, "ppVar")
  ui <- build_ui_for(node, layer_name = "ggplot")
  rendered <- as.character(ui)
  expect_match(rendered, "shiny-html-output")
  expect_match(rendered, paste0("id=\"", placeholder_output_id(node$id), "\""), fixed = TRUE)
})

test_that("P6.3 registry build_ui renders pickerInput populated with cols", {
  tree <- ptr_translate("ggplot(mtcars, aes(x = ppVar)) + geom_point()")
  node <- .ph_by_keyword(tree, "ppVar")
  entry <- ptr_registry_lookup("ppVar")
  picker <- entry$build_ui(node, cols = c("mpg", "hp"), label = "Pick a column")
  rendered <- as.character(picker)
  expect_match(rendered, "selectpicker")
  expect_match(rendered, "mpg")
  expect_match(rendered, "hp")
})

test_that("P6.4 var consumer with empty cols still renders an empty container", {
  tree <- ptr_translate("ggplot(mtcars, aes(x = ppVar)) + geom_point()")
  node <- .ph_by_keyword(tree, "ppVar")
  ui <- build_ui_for(node, layer_name = "ggplot")
  rendered <- as.character(ui)
  expect_match(rendered, paste0("id=\"", placeholder_output_id(node$id), "\""), fixed = TRUE)
})

# ---- P6.5 — upload source paired widgets ----
# ADR 0025 item #7: the pairing moved. `build_ui_for` (the panel layer) now
# emits the source uiOutput container PLUS the STATIC shortcut textInput;
# the source hook (`.source_widget` -> `entry$build_ui`) emits ONLY the
# fileInput, rendered server-side into that container.

test_that("P6.5 build_ui_for emits the source container + static shortcut textInput", {
  tree <- ptr_translate("ppUpload |> ggplot()")
  node <- .ph_by_keyword(tree, "ppUpload")
  ui <- build_ui_for(node)
  # the uiOutput container the server fills with the fileInput
  expect_true(length(.find_tags(ui, has_id = placeholder_output_id(node$id))) > 0L)
  # the framework-owned static shortcut textInput
  expect_true(length(.find_tags(ui, has_id = node$shortcut_id)) > 0L)
})

test_that("P6.5 the source hook emits ONLY the fileInput (no shortcut)", {
  tree <- ptr_translate("ppUpload |> ggplot()")
  node <- .ph_by_keyword(tree, "ppUpload")
  ui <- .source_widget(node)
  expect_true(length(.find_tags(ui, has_id = node$id)) > 0L)
  expect_equal(length(.find_tags(ui, has_id = node$shortcut_id)), 0L)
})

# ---- P6.13 — copy resolution ----

test_that("P6.13 copy resolution applies custom label", {
  tree <- ptr_translate("ggplot(mtcars) + geom_point(size = ppNum)")
  node <- .ph_by_keyword(tree, "ppNum")
  ui <- .value_widget(
    node,
    layer_name = "geom_point",
    ui_text = list(params = list(size = list(ppNum = list(label = "Pick a number"))))
  )
  rendered <- as.character(ui)
  expect_match(rendered, "Pick a number")
})

# ---- P6.15 — ptr_user_expr emits no UI ----

test_that("P6.15 ptr_user_expr emits no UI", {
  node <- ptr_user_expr(quote(theme_minimal()))
  ui <- build_ui_for(node)
  expect_null(ui)
})

test_that("ptr_literal / ptr_missing emit no UI", {
  expect_null(build_ui_for(ptr_literal(1)))
  expect_null(build_ui_for(ptr_missing()))
})

# ---- ns_fn rendering — ids are namespaced before passed to hook ----

test_that("build_ui_for renders id through ns_fn", {
  tree <- ptr_translate("ggplot(mtcars) + geom_point(color = ppText)")
  node <- .ph_by_keyword(tree, "ppText")
  ns <- shiny::NS("module1")
  ui <- build_ui_for(node, layer_name = "geom_point", ns_fn = ns)
  rendered <- as.character(ui)
  expect_match(rendered, fixed = TRUE, ns(node$id))
})

# ---- Phase 1 — copy fidelity: help / placeholder / empty_text reach widgets ----

test_that("text widget renders placeholder + help from resolved copy", {
  tree <- ptr_translate("ggplot(mtcars) + geom_point(color = ppText)")
  node <- .ph_by_keyword(tree, "ppText")
  ui <- .value_widget(
    node, layer_name = "geom_point",
    ui_text = list(params = list(color = list(ppText = list(
      label = "L", help = "H-help", placeholder = "P-ph"
    ))))
  )
  rendered <- as.character(ui)
  expect_match(rendered, 'placeholder="P-ph"', fixed = TRUE)
  expect_match(rendered, "help-block")
  expect_match(rendered, "H-help")
})

test_that("text widget carries the restored default placeholder", {
  tree <- ptr_translate("ggplot(mtcars) + geom_point(color = ppText)")
  node <- .ph_by_keyword(tree, "ppText")
  ui <- .value_widget(node, layer_name = "geom_point")
  expect_match(as.character(ui), "quotes are added automatically")
  expect_equal(
    ptr_default_ui_text()$defaults$ppText$placeholder,
    "Plain text - quotes are added automatically"
  )
})

test_that("expr widget renders placeholder + help from resolved copy", {
  tree <- ptr_translate("ggplot(mtcars) + geom_point() + facet_wrap(ppExpr)")
  node <- .ph_by_keyword(tree, "ppExpr")
  ui <- .value_widget(
    node, layer_name = "facet_wrap",
    ui_text = list(layers = list(facet_wrap = list(ppExpr = list(
      `__unnamed__` = list(placeholder = "~ Species", help = "facet help")
    ))))
  )
  rendered <- as.character(ui)
  expect_match(rendered, "textarea")
  expect_match(rendered, "~ Species")
  expect_match(rendered, "facet help")
})

test_that("num widget renders help only (no placeholder attr)", {
  tree <- ptr_translate("ggplot(mtcars) + geom_point(size = ppNum)")
  node <- .ph_by_keyword(tree, "ppNum")
  ui <- .value_widget(
    node, layer_name = "geom_point",
    ui_text = list(params = list(size = list(ppNum = list(help = "0 to 1"))))
  )
  rendered <- as.character(ui)
  expect_match(rendered, "help-block")
  expect_match(rendered, "0 to 1")
})

test_that("var picker honors copy$empty_text via noneSelectedText", {
  tree <- ptr_translate("ggplot(mtcars, aes(x = ppVar)) + geom_point()")
  node <- .ph_by_keyword(tree, "ppVar")
  entry <- ptr_registry_lookup("ppVar")

  default_copy <- ptr_resolve_ui_text("control", keyword = "ppVar", param = "x")
  picker_default <- entry$build_ui(node, cols = c("mpg", "hp"),
                                   label = "Pick a column", copy = default_copy)
  expect_match(as.character(picker_default), "Choose one column")

  custom_copy <- ptr_resolve_ui_text(
    "control", keyword = "ppVar", param = "x",
    ui_text = list(params = list(x = list(ppVar = list(empty_text = "Pick me"))))
  )
  picker_custom <- entry$build_ui(node, cols = c("mpg", "hp"),
                                  label = "Pick a column", copy = custom_copy)
  expect_match(as.character(picker_custom), "Pick me")
})

test_that("var default copy carries empty_text", {
  expect_equal(ptr_default_ui_text()$defaults$ppVar$empty_text, "Choose one column")
})

test_that("a third-party build_ui hook without `...`/`copy` is not passed copy", {
  withr::defer({
    if (exists("ptr_registry_clear")) ptr_registry_clear()
    ptr_register_builtins()
  })
  ptr_define_placeholder_value(
    keyword = "plain_widget",
    build_ui = function(node, label) shiny::textInput(node$id, label),
    resolve_expr = function(value, node) value
  )
  tree <- ptr_translate("ggplot(mtcars) + geom_point(color = plain_widget)")
  node <- .ph_by_keyword(tree, "plain_widget")
  expect_silent(ui <- .value_widget(node, layer_name = "geom_point"))
  expect_true(length(.find_tags(ui, has_id = node$id)) > 0L)
})

# ---- P6.14 — custom placeholder hook invoked ----

test_that("P6.14 custom placeholder UI invokes registered build_ui", {
  withr::defer({
    if (exists("ptr_registry_clear")) ptr_registry_clear()
    ptr_register_builtins()
  })
  hook_called <- FALSE
  ptr_define_placeholder_value(
    keyword = "scale_factor",
    build_ui = function(node, label = NULL, ...) {
      hook_called <<- TRUE
      shiny::numericInput(node$id, label = label, value = 1)
    },
    resolve_expr = function(value, node, ...) as.numeric(value)
  )
  tree <- ptr_translate("ggplot(mtcars) + geom_point(size = scale_factor)")
  node <- .ph_by_keyword(tree, "scale_factor")
  ui <- .value_widget(node, layer_name = "geom_point")
  expect_true(hook_called)
  expect_true(length(.find_tags(ui, has_id = node$id)) > 0L)
})
