# inst/shiny/app.R
# SurveyStudio - build, edit, preview, and analyse surveyframe instruments.

`%||%` <- function(x, y) {
  if (is.null(x)) y else x
}

tags <- shiny::tags
HTML <- shiny::HTML
fluidPage <- shiny::fluidPage
fluidRow <- shiny::fluidRow
column <- shiny::column
uiOutput <- shiny::uiOutput
renderUI <- shiny::renderUI
actionButton <- shiny::actionButton
checkboxInput <- shiny::checkboxInput
checkboxGroupInput <- shiny::checkboxGroupInput
dateInput <- shiny::dateInput
downloadButton <- shiny::downloadButton
downloadHandler <- shiny::downloadHandler
fileInput <- shiny::fileInput
numericInput <- shiny::numericInput
observe <- shiny::observe
observeEvent <- shiny::observeEvent
radioButtons <- shiny::radioButtons
reactive <- shiny::reactive
reactiveValues <- shiny::reactiveValues
req <- shiny::req
selectInput <- shiny::selectInput
showNotification <- shiny::showNotification
shinyApp <- shiny::shinyApp
tagList <- shiny::tagList
textAreaInput <- shiny::textAreaInput
textInput <- shiny::textInput
updateCheckboxGroupInput <- shiny::updateCheckboxGroupInput
updateSelectInput <- shiny::updateSelectInput
updateTextAreaInput <- shiny::updateTextAreaInput
updateTextInput <- shiny::updateTextInput

builder_empty_state <- surveyframe::sframe_builder_empty_state
builder_state_from_instrument <- surveyframe::sframe_builder_state_from_instrument
builder_validate_draft <- surveyframe::sframe_builder_validate_draft
sf_branch <- surveyframe::sf_branch
sf_check <- surveyframe::sf_check
sf_choices <- surveyframe::sf_choices
sf_item <- surveyframe::sf_item
sf_scale <- surveyframe::sf_scale
write_sframe <- surveyframe::write_sframe

status_badge <- function(ok, label_ok = "Ready", label_no = "Pending") {
  if (ok) {
    tags$span(class = "badge badge-ok", label_ok)
  } else {
    tags$span(class = "badge badge-wait", label_no)
  }
}

trim_or_null <- function(x) {
  x <- trimws(x %||% "")
  if (nzchar(x)) x else NULL
}

parse_lines <- function(text) {
  if (is.null(text) || !nzchar(text)) {
    return(character(0))
  }
  values <- trimws(unlist(strsplit(text, "\n", fixed = TRUE), use.names = FALSE))
  values[nzchar(values)]
}

parse_csv <- function(text) {
  if (is.null(text) || !nzchar(trimws(text))) {
    return(character(0))
  }
  values <- trimws(unlist(strsplit(text, ",", fixed = TRUE), use.names = FALSE))
  values[nzchar(values)]
}

parse_choice_values <- function(text) {
  values <- parse_lines(text)
  if (length(values) == 0) {
    return(values)
  }
  utils::type.convert(values, as.is = TRUE)
}

parse_branch_value <- function(text, operator) {
  raw <- trimws(text %||% "")
  if (!nzchar(raw)) {
    return(NULL)
  }
  if (identical(operator, "%in%")) {
    values <- parse_csv(raw)
    if (length(values) == 0) {
      return(NULL)
    }
    return(utils::type.convert(values, as.is = TRUE))
  }
  utils::type.convert(raw, as.is = TRUE)
}

parse_check_values <- function(text) {
  values <- parse_csv(text %||% "")
  if (length(values) == 0) {
    return(NULL)
  }
  utils::type.convert(values, as.is = TRUE)
}

sframe_upload_ext <- function(upload) {
  tolower(tools::file_ext(upload$name %||% ""))
}

sframe_validate_upload <- function(upload, extensions, max_size = 10 * 1024^2) {
  if (is.null(upload) || is.null(upload$datapath) || !file.exists(upload$datapath)) {
    stop("No file was uploaded. Select a .sframe file and try again.", call. = FALSE)
  }

  ext <- sframe_upload_ext(upload)
  if (!ext %in% extensions) {
    stop(
      paste0(
        "Unsupported file type '.", ext, "'. Expected: .",
        paste(extensions, collapse = ", ."), "."
      ),
      call. = FALSE
    )
  }

  size <- file.info(upload$datapath)$size
  if (is.na(size) || size <= 0 || size > max_size) {
    stop("Uploaded file is empty or too large.", call. = FALSE)
  }

  con <- file(upload$datapath, open = "rb")
  on.exit(close(con), add = TRUE)
  bytes <- readBin(con, what = "raw", n = min(size, 512))
  if (length(bytes) == 0 || any(bytes == as.raw(0))) {
    stop("Upload a .sframe or JSON text file.", call. = FALSE)
  }

  text_start <- sub("^\ufeff", "", rawToChar(bytes))
  if (identical(ext, "sframe") && !startsWith(trimws(text_start), "{")) {
    stop("Uploaded .sframe file must contain JSON.", call. = FALSE)
  }

  normalizePath(upload$datapath, mustWork = TRUE)
}

format_value <- function(x) {
  if (is.null(x) || length(x) == 0) {
    return("")
  }
  paste(as.character(x), collapse = ", ")
}

upsert_component <- function(components, component) {
  if (length(components) == 0) {
    return(list(component))
  }

  ids <- vapply(components, function(x) x$id, character(1))
  idx <- match(component$id, ids)
  if (is.na(idx)) {
    c(components, list(component))
  } else {
    components[[idx]] <- component
    components
  }
}

remove_component <- function(components, id) {
  if (length(components) == 0) {
    return(components)
  }
  Filter(function(component) !identical(component$id, id), components)
}

drop_item_from_builder <- function(builder, item_id) {
  builder$items <- remove_component(builder$items, item_id)

  if (length(builder$scales) > 0) {
    builder$scales <- Filter(function(scale) {
      scale$items <- setdiff(scale$items %||% character(0), item_id)
      scale$reverse_items <- intersect(scale$reverse_items %||% character(0), scale$items)
      length(scale$items) > 0
    }, builder$scales)
  }

  if (length(builder$branching) > 0) {
    builder$branching <- Filter(function(rule) {
      !identical(rule$item_id, item_id) && !identical(rule$depends_on, item_id)
    }, builder$branching)
  }

  if (length(builder$checks) > 0) {
    builder$checks <- Filter(function(check) !identical(check$item_id, item_id), builder$checks)
  }

  builder
}

optional_choices <- function(ids, none_label = "(None)") {
  choices <- stats::setNames(ids, ids)
  c(stats::setNames("", none_label), choices)
}

table_card <- function(title, headers, rows, empty_label) {
  tags$div(class = "card",
    tags$div(class = "card-title", title),
    if (length(rows) == 0) {
      tags$p(class = "hint", empty_label)
    } else {
      tags$table(class = "sf-table",
        tags$thead(tags$tr(do.call(tagList, lapply(headers, tags$th)))),
        tags$tbody(rows)
      )
    }
  )
}

analysis_role <- function(id, label, min = 1, max = 1, levels = "any") {
  list(id = id, label = label, min = min, max = max, levels = levels)
}

analysis_registry <- local({
  role <- analysis_role
  list(
    frequency = list(
      family = "descriptive", label = "Frequency table",
      roles = list(role("variable", "Variable", levels = c("nominal", "ordinal", "likert"))),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = character(0),
      output = "Counts, percentages, valid percentages, and missing values.",
      refs = character(0)
    ),
    descriptives = list(
      family = "descriptive", label = "Descriptives",
      roles = list(
        role("variables", "Variables", max = 99, levels = c("continuous", "scale", "ordinal", "likert")),
        role("split_by", "Split by", min = 0, max = 1, levels = c("nominal", "ordinal"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = character(0),
      output = "N, valid N, missing N, mean, SD, median, IQR, range, skewness, kurtosis, SE, and CI.",
      refs = character(0)
    ),
    missing_data = list(
      family = "data_quality", label = "Missing values",
      roles = list(role("variables", "Variables", min = 0, max = 99, levels = "any")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = character(0),
      output = "Item missingness, respondent missingness, missing patterns, and deletion summary.",
      refs = character(0)
    ),
    quality = list(
      family = "data_quality", label = "Quality report",
      roles = list(role("variables", "Variables", min = 0, max = 99, levels = "any")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = character(0),
      output = "Attention checks, response quality flags, and quality summary.",
      refs = character(0)
    ),
    scale_descriptives = list(
      family = "descriptive", label = "Scale descriptives",
      roles = list(role("scales", "Scale scores", min = 0, max = 99, levels = "scale")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = character(0),
      output = "Scale means, variability, missingness, and confidence intervals.",
      refs = character(0)
    ),
    crosstab = list(
      family = "categorical", label = "Cross-tab",
      roles = list(
        role("row", "Row variable", levels = c("nominal", "ordinal")),
        role("column", "Column variable", levels = c("nominal", "ordinal"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = TRUE,
      assumptions = "Expected cell counts",
      output = "Cross-tabulation with association measures when run.",
      refs = "field_2018"
    ),
    chi_square = list(
      family = "categorical", label = "Chi-square",
      roles = list(
        role("row", "Variable X", levels = c("nominal", "ordinal")),
        role("column", "Variable Y", levels = c("nominal", "ordinal"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Expected-count check",
      output = "Chi-square, p value, Cramer's V or phi.",
      refs = c("field_2018", "cohen_1988")
    ),
    fisher_exact = list(
      family = "categorical", label = "Fisher's exact",
      roles = list(
        role("row", "Variable X", levels = c("nominal", "ordinal")),
        role("column", "Variable Y", levels = c("nominal", "ordinal"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Sparse-table handling",
      output = "Fisher's exact p value and odds ratio for 2 x 2 tables.",
      refs = "field_2018"
    ),
    mcnemar = list(
      family = "related_samples", label = "McNemar",
      roles = list(
        role("before", "Before or condition 1", levels = "nominal"),
        role("after", "After or condition 2", levels = "nominal")
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = FALSE,
      assumptions = "Paired binary categories",
      output = "McNemar chi-square and p value.",
      refs = "field_2018"
    ),
    cochran_q = list(
      family = "related_samples", label = "Cochran's Q",
      roles = list(role("measures", "Binary repeated measures", min = 2, max = 99, levels = "nominal")),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = FALSE,
      assumptions = "Related binary measures",
      output = "Cochran's Q and pairwise McNemar plan.",
      refs = "field_2018"
    ),
    mann_whitney = list(
      family = "group_comparison", label = "Mann-Whitney U",
      roles = list(
        role("group", "Grouping variable", levels = c("nominal", "ordinal")),
        role("outcome", "Outcome variable", levels = c("ordinal", "continuous", "scale", "likert"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Exactly two groups",
      output = "U statistic, p value, and rank-biserial effect size.",
      refs = c("mann_1947", "cohen_1988")
    ),
    t_test_ind = list(
      family = "group_comparison", label = "Independent t-test",
      roles = list(
        role("group", "Grouping variable", levels = "nominal"),
        role("outcome", "Outcome variable", levels = c("continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = c("Normality", "Equal variance"),
      output = "t, df, p value, and Cohen's d.",
      refs = c("field_2018", "cohen_1988")
    ),
    t_test_pair = list(
      family = "related_samples", label = "Paired t-test",
      roles = list(
        role("before", "Measure 1", levels = c("continuous", "scale")),
        role("after", "Measure 2", levels = c("continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Normality of differences",
      output = "Paired t, df, p value, and dz.",
      refs = "field_2018"
    ),
    wilcoxon_pair = list(
      family = "related_samples", label = "Wilcoxon signed-rank",
      roles = list(
        role("before", "Measure 1", levels = c("ordinal", "continuous", "scale", "likert")),
        role("after", "Measure 2", levels = c("ordinal", "continuous", "scale", "likert"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Paired ordinal or continuous measures",
      output = "V, p value, and r effect size.",
      refs = "cohen_1988"
    ),
    kruskal_wallis = list(
      family = "group_comparison", label = "Kruskal-Wallis",
      roles = list(
        role("group", "Grouping variable", levels = c("nominal", "ordinal")),
        role("outcome", "Outcome variable", levels = c("ordinal", "continuous", "scale", "likert"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Independent groups",
      output = "H, p value, eta-squared, and pairwise plan.",
      refs = c("kruskal_1952", "cohen_1988")
    ),
    anova_one = list(
      family = "group_comparison", label = "One-way ANOVA",
      roles = list(
        role("group", "Grouping variable", levels = "nominal"),
        role("outcome", "Outcome variable", levels = c("continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = c("Normality", "Homogeneity of variance"),
      output = "F, p value, eta-squared, and post-hoc plan.",
      refs = c("field_2018", "cohen_1988")
    ),
    anova_two = list(
      family = "group_comparison", label = "Two-way ANOVA",
      roles = list(
        role("factor1", "Factor 1", levels = "nominal"),
        role("factor2", "Factor 2", levels = "nominal"),
        role("outcome", "Outcome", levels = c("continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = c("Interaction interpretation", "Homogeneity of variance"),
      output = "Main effects, interaction, and partial eta-squared.",
      refs = c("field_2018", "cohen_1988")
    ),
    ancova = list(
      family = "group_comparison", label = "ANCOVA",
      roles = list(
        role("group", "Group", levels = "nominal"),
        role("covariates", "Covariates", min = 1, max = 99, levels = c("continuous", "scale")),
        role("outcome", "Outcome", levels = c("continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Homogeneity of regression slopes",
      output = "Adjusted group effects and slope warning.",
      refs = "field_2018"
    ),
    repeated_anova = list(
      family = "related_samples", label = "Repeated-measures ANOVA",
      roles = list(role("measures", "Repeated measures", min = 2, max = 99, levels = c("continuous", "scale"))),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Within-subject design",
      output = "Within-subject ANOVA summary.",
      refs = "field_2018"
    ),
    friedman = list(
      family = "related_samples", label = "Friedman",
      roles = list(role("measures", "Repeated ordinal measures", min = 2, max = 99, levels = c("ordinal", "continuous", "scale", "likert"))),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = FALSE,
      assumptions = "Related measures",
      output = "Friedman chi-square and p value.",
      refs = "field_2018"
    ),
    correlation_pearson = list(
      family = "association", label = "Pearson correlation",
      roles = list(
        role("x", "Variable X", levels = c("continuous", "scale")),
        role("y", "Variable Y", levels = c("continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = c("Linearity", "Bivariate normality"),
      output = "r, p value, and confidence interval where feasible.",
      refs = c("field_2018", "cohen_1988")
    ),
    correlation_spearman = list(
      family = "association", label = "Spearman correlation",
      roles = list(
        role("x", "Variable X", levels = c("ordinal", "continuous", "scale", "likert")),
        role("y", "Variable Y", levels = c("ordinal", "continuous", "scale", "likert"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Monotonic association",
      output = "rho and p value.",
      refs = c("spearman_1904", "cohen_1988")
    ),
    correlation_kendall = list(
      family = "association", label = "Kendall tau",
      roles = list(
        role("x", "Variable X", levels = c("ordinal", "likert")),
        role("y", "Variable Y", levels = c("ordinal", "likert"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Ordinal association",
      output = "tau and p value.",
      refs = "kendall_1938"
    ),
    partial_correlation = list(
      family = "association", label = "Partial correlation",
      roles = list(
        role("x", "Variable X", levels = c("continuous", "scale")),
        role("y", "Variable Y", levels = c("continuous", "scale")),
        role("controls", "Control variables", min = 1, max = 99, levels = c("continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Linear control model",
      output = "Partial r and p value.",
      refs = "field_2018"
    ),
    regression_linear = list(
      family = "regression", label = "Linear regression",
      roles = list(
        role("dependent", "Dependent variable", levels = c("continuous", "scale")),
        role("predictors", "Predictors", min = 1, max = 99, levels = c("nominal", "ordinal", "continuous", "scale", "likert"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = c("Residual normality", "VIF", "Cook distance"),
      output = "Model fit, coefficients, and assumptions.",
      refs = "field_2018"
    ),
    regression_logistic_binary = list(
      family = "regression", label = "Binary logistic",
      roles = list(
        role("dependent", "Binary outcome", levels = "nominal"),
        role("predictors", "Predictors", min = 1, max = 99, levels = c("nominal", "ordinal", "continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = c("Sparse cells", "Separation warning"),
      output = "Odds ratios, pseudo R-squared, and classification table.",
      refs = "hosmer_2013"
    ),
    regression_logistic_ordinal = list(
      family = "regression", label = "Ordinal logistic",
      roles = list(
        role("dependent", "Ordinal outcome", levels = c("ordinal", "likert")),
        role("predictors", "Predictors", min = 1, max = 99, levels = c("nominal", "ordinal", "continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Ordered outcome",
      output = "MASS::polr model plan, odds ratios, and fit table.",
      refs = "hosmer_2013"
    ),
    regression_logistic_multinomial = list(
      family = "regression", label = "Multinomial logistic",
      roles = list(
        role("dependent", "Nominal outcome", levels = "nominal"),
        role("predictors", "Predictors", min = 1, max = 99, levels = c("nominal", "ordinal", "continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Reference category",
      output = "nnet::multinom plan, odds ratios, and classification table.",
      refs = "hosmer_2013"
    ),
    firth_logistic = list(
      family = "regression", label = "Firth penalised logistic",
      roles = list(
        role("dependent", "Binary outcome", levels = "nominal"),
        role("predictors", "Predictors", min = 1, max = 99, levels = c("nominal", "ordinal", "continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = c("Small sample", "Separation warning"),
      output = "Penalised odds ratios with profile-likelihood confidence intervals. Requires the logistf package.",
      refs = c("firth_1993", "heinze_2002")
    ),
    mediation = list(
      family = "regression", label = "Mediation",
      roles = list(
        role("predictor", "Predictor", levels = c("continuous", "scale", "nominal")),
        role("mediator", "Mediator", levels = c("continuous", "scale")),
        role("outcome", "Outcome", levels = c("continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = c("Regression assumptions", "Bootstrap CI"),
      output = "Direct, indirect, total effects, and bootstrap CI.",
      refs = "mackinnon_2008"
    ),
    moderation = list(
      family = "regression", label = "Moderation",
      roles = list(
        role("predictor", "Predictor", levels = c("continuous", "scale")),
        role("moderator", "Moderator", levels = c("continuous", "scale")),
        role("outcome", "Outcome", levels = c("continuous", "scale"))
      ),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Interaction model",
      output = "Interaction coefficient and conditional effects.",
      refs = "aiken_1991"
    ),
    reliability_alpha = list(
      family = "measurement", label = "Reliability alpha",
      roles = list(role("items", "Scale items", min = 2, max = 99, levels = c("ordinal", "likert", "continuous"))),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = character(0),
      output = "Alpha, item-total correlations, and alpha if deleted.",
      refs = "cronbach_1951"
    ),
    reliability_omega = list(
      family = "measurement", label = "Reliability omega",
      roles = list(role("items", "Scale items", min = 2, max = 99, levels = c("ordinal", "likert", "continuous"))),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = character(0),
      output = "Omega estimate when the optional psych package is available.",
      refs = "cronbach_1951"
    ),
    item_diagnostics = list(
      family = "measurement", label = "Item diagnostics",
      roles = list(role("items", "Items", min = 1, max = 99, levels = c("ordinal", "likert", "continuous"))),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = character(0),
      output = "Item distributions, item-total correlations, and floor or ceiling checks.",
      refs = "field_2018"
    ),
    efa_readiness = list(
      family = "measurement", label = "EFA readiness",
      roles = list(role("items", "Items", min = 3, max = 99, levels = c("ordinal", "likert", "continuous"))),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("KMO", "Bartlett test"),
      output = "KMO, Bartlett, and parallel-analysis planning.",
      refs = "field_2018"
    ),
    efa_solution = list(
      family = "measurement", label = "EFA solution",
      roles = list(role("items", "Items", min = 3, max = 99, levels = c("ordinal", "likert", "continuous"))),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("Factor retention", "Cross-loadings"),
      output = "Loadings, communalities, uniqueness, and cross-loading flags.",
      refs = "field_2018"
    ),
    cfa_lavaan_syntax = list(
      family = "model", label = "CFA lavaan syntax",
      roles = list(role("model", "Saved model", min = 0, max = 1, levels = "model")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = "Construct indicators",
      output = "lavaan measurement model syntax.",
      refs = "field_2018"
    ),
    sem_lavaan_syntax = list(
      family = "model", label = "CB-SEM lavaan syntax",
      roles = list(role("model", "Saved model", levels = "model")),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Measurement and structural paths",
      output = "lavaan measurement, structural, indirect, and total-effect syntax.",
      refs = "field_2018"
    ),
    seminr_syntax = list(
      family = "model", label = "PLS-SEM seminr syntax",
      roles = list(role("model", "Saved model", levels = "model")),
      show_alpha = TRUE, show_hypotheses = TRUE, show_effect_size = TRUE,
      assumptions = "Construct modes and bootstrapping",
      output = "seminr measurement, structural, bootstrap, reliability, AVE, and HTMT syntax.",
      refs = "field_2018"
    ),
    topsis = list(
      family = "decision", label = "TOPSIS",
      roles = list(
        role("performance_items", "Performance matrix items (one per criterion)", min = 1, max = 99, levels = "matrix"),
        role("weights_item", "Weights item", levels = c("pairwise_saaty", "criteria_weight"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("Weights sum to 1 (renormalised if not)", "Criteria labelled benefit or cost"),
      output = "Ranking table (alternative, score, rank) by closeness to the ideal solution.",
      refs = "hwang_1981"
    ),
    vikor = list(
      family = "decision", label = "VIKOR",
      roles = list(
        role("performance_items", "Performance matrix items (one per criterion)", min = 1, max = 99, levels = "matrix"),
        role("weights_item", "Weights item", levels = c("pairwise_saaty", "criteria_weight"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("Weights sum to 1 (renormalised if not)", "Criteria labelled benefit or cost"),
      output = "Compromise ranking (S, R, Q) with acceptable-advantage and acceptable-stability checks.",
      refs = character(0)
    ),
    moora = list(
      family = "decision", label = "MOORA",
      roles = list(
        role("performance_items", "Performance matrix items (one per criterion)", min = 1, max = 99, levels = "matrix"),
        role("weights_item", "Weights item", levels = c("pairwise_saaty", "criteria_weight"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("Weights sum to 1 (renormalised if not)", "Criteria labelled benefit or cost"),
      output = "Ranking table (alternative, score, rank) by the ratio system.",
      refs = character(0)
    ),
    smart = list(
      family = "decision", label = "SMART",
      roles = list(
        role("performance_items", "Performance matrix items (one per criterion)", min = 1, max = 99, levels = "matrix"),
        role("weights_item", "Weights item", levels = c("pairwise_saaty", "criteria_weight"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("Weights sum to 1 (renormalised if not)", "Criteria labelled benefit or cost"),
      output = "Ranking table (alternative, score, rank) by normalised weighted value.",
      refs = character(0)
    ),
    waspas = list(
      family = "decision", label = "WASPAS",
      roles = list(
        role("performance_items", "Performance matrix items (one per criterion)", min = 1, max = 99, levels = "matrix"),
        role("weights_item", "Weights item", levels = c("pairwise_saaty", "criteria_weight"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("Weights sum to 1 (renormalised if not)", "Criteria labelled benefit or cost"),
      output = "Ranking table (alternative, score, rank) by the WSM/WPM blend.",
      refs = character(0)
    ),
    promethee = list(
      family = "decision", label = "PROMETHEE II",
      roles = list(
        role("performance_items", "Performance matrix items (one per criterion)", min = 1, max = 99, levels = "matrix"),
        role("weights_item", "Weights item", levels = c("pairwise_saaty", "criteria_weight"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("Weights sum to 1 (renormalised if not)", "Criteria labelled benefit or cost"),
      output = "Ranking table (alternative, score, rank) by net preference flow.",
      refs = character(0)
    ),
    electre = list(
      family = "decision", label = "ELECTRE I",
      roles = list(
        role("performance_items", "Performance matrix items (one per criterion)", min = 1, max = 99, levels = "matrix"),
        role("weights_item", "Weights item", levels = c("pairwise_saaty", "criteria_weight"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("Weights sum to 1 (renormalised if not)", "Criteria labelled benefit or cost"),
      output = "Outranking relation and best-effort ranking (ELECTRE I does not always produce a total order).",
      refs = character(0)
    ),
    ahp = list(
      family = "decision", label = "AHP",
      roles = list(role("pairwise", "Pairwise comparison item", levels = "pairwise_saaty")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("Reciprocal pairwise matrix", "Consistency ratio below 0.10 recommended"),
      output = "Criterion weights and consistency ratio.",
      refs = "saaty_1980"
    ),
    anp = list(
      family = "decision", label = "ANP",
      roles = list(role("pairwise", "Pairwise comparison item", levels = "pairwise_saaty")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = c("Reciprocal pairwise matrix", "Supermatrix must converge"),
      output = "Limiting priority weights from the supermatrix.",
      refs = character(0)
    ),
    dematel = list(
      family = "decision", label = "DEMATEL",
      roles = list(role("pairwise", "Influence comparison item", levels = "pairwise_influence")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      assumptions = "Directed 0-4 influence matrix",
      output = "Cause-effect table (prominence, relation, role) and influence map.",
      refs = character(0)
    ),
    term_freq = list(
      family = "text", label = "Term frequency",
      roles = list(
        role("item", "Text item", levels = "text"),
        role("group", "Group by", min = 0, max = 1, levels = c("nominal", "ordinal"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      show_wordcloud = TRUE, show_top_n = TRUE, default_top_n = 30L,
      assumptions = "At least 10 usable responses",
      output = "Top terms by frequency, optionally split by a group variable, and a bar chart or word cloud.",
      refs = character(0)
    ),
    co_occurrence = list(
      family = "text", label = "Co-occurrence",
      roles = list(role("item", "Text item", levels = "text")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      show_top_n = TRUE, default_top_n = 20L,
      assumptions = c("At least 10 usable responses", "At least 1 co-occurring term pair"),
      output = "Pairwise within-response co-occurrence counts on the top terms, and a heatmap.",
      refs = character(0)
    ),
    ngram_freq = list(
      family = "text", label = "N-gram frequency",
      roles = list(role("item", "Text item", levels = "text")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      show_ngram_n = TRUE, show_top_n = TRUE, default_top_n = 30L,
      assumptions = "At least 10 usable responses",
      output = "Top bigrams or trigrams by frequency, and a bar chart.",
      refs = character(0)
    ),
    term_context = list(
      family = "text", label = "Keyword in context",
      roles = list(role("item", "Text item", levels = "text")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      show_term = TRUE,
      assumptions = c("At least 10 usable responses"),
      output = "A keyword-in-context concordance table (before/match/after) for a chosen term.",
      refs = character(0)
    ),
    co_occurrence_network = list(
      family = "text", label = "Co-occurrence network",
      roles = list(role("item", "Text item", levels = "text")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      show_top_n = TRUE, default_top_n = 20L, show_seed = TRUE,
      assumptions = c("At least 10 usable responses",
                      "At least 5 distinct terms with 1 co-occurrence edge",
                      "Requires the optional igraph package"),
      output = "A Louvain-clustered, force-directed term co-occurrence network (node table plus edge list).",
      refs = c("blondel_2008", "fruchterman_1991")
    ),
    tidy_sentiment = list(
      family = "text", label = "Sentiment",
      roles = list(
        role("item", "Text item", levels = "text"),
        role("group", "Group by", min = 0, max = 1, levels = c("nominal", "ordinal"))
      ),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      show_wordcloud = TRUE,
      assumptions = c("At least 10 usable responses", "Requires the optional tidytext package"),
      output = paste("Positive/negative sentiment counts and proportion positive (bing lexicon),",
                     "optionally split by a group variable, and a diverging bar chart or a",
                     "positive/negative comparison cloud (options$wordcloud = TRUE)."),
      refs = character(0)
    ),
    quanteda_dfm = list(
      family = "text", label = "Document-feature matrix",
      roles = list(role("item", "Text item", levels = "text")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      show_top_n = TRUE, default_top_n = 30L,
      assumptions = c("At least 10 usable responses", "Requires the optional quanteda package"),
      output = "Document-feature matrix summary: feature count, sparsity, and top features.",
      refs = character(0)
    ),
    topic_model_lda = list(
      family = "text", label = "Topic model (LDA)",
      roles = list(role("item", "Text item", levels = "text")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      show_k = TRUE, default_k = 4L, show_seed = TRUE,
      assumptions = c("At least 10 usable responses", "Enough documents to support k topics",
                      "Requires the optional tidytext and topicmodels packages"),
      output = "Top terms per topic (LDA, Gibbs-free VEM) as a ranked table, and a faceted bar chart.",
      refs = character(0)
    ),
    stm_topics = list(
      family = "text", label = "Topic model (STM)",
      roles = list(role("item", "Text item", levels = "text")),
      show_alpha = FALSE, show_hypotheses = FALSE, show_effect_size = FALSE,
      show_k = TRUE, default_k = 3L, show_seed = TRUE,
      assumptions = c("At least 10 usable responses", "Enough documents to support k topics",
                      "Requires the optional stm and tidytext packages"),
      output = "Top terms per topic (structural topic model) as a ranked table, and a faceted bar chart.",
      refs = character(0)
    )
  )
})

analysis_method_choices <- function() {
  stats::setNames(names(analysis_registry), vapply(analysis_registry, function(x) x$label, character(1)))
}

studio_level_meta <- function(item = NULL, scale = NULL) {
  if (!is.null(scale)) {
    return(list(level = "scale", code = "SCL", type = "scale score"))
  }
  type <- item$type %||% "text"
  if (identical(type, "likert")) {
    return(list(level = "likert", code = "LIK", type = type))
  }
  if (type %in% c("single_choice", "multiple_choice")) {
    return(list(level = "nominal", code = "NOM", type = type))
  }
  if (identical(type, "ranking")) {
    return(list(level = "ordinal", code = "ORD", type = type))
  }
  if (type %in% c("numeric", "slider", "rating")) {
    return(list(level = "continuous", code = "CON", type = type))
  }
  if (type %in% c("text", "textarea")) {
    return(list(level = "text", code = "TXT", type = type))
  }
  # Decision-family items. The 2 comparison scales get separate levels because
  # they are not interchangeable: AHP and ANP read reciprocal Saaty importance,
  # DEMATEL reads a directed 0-4 influence matrix, and a weights source must
  # express importance rather than influence. The builder's varLevel() and
  # validate_sframe() enforce the same split.
  if (identical(type, "pairwise_comparison")) {
    influence <- identical(item$comparison_scale %||% "saaty", "influence")
    return(list(
      level = if (influence) "pairwise_influence" else "pairwise_saaty",
      code  = "PWC",
      type  = if (influence) "influence matrix" else "pairwise comparison"
    ))
  }
  if (identical(type, "criteria_weight")) {
    return(list(level = "criteria_weight", code = "WGT", type = "criteria weights"))
  }
  # A matrix item is how the rated performance matrix gets collected: one
  # matrix item per criterion, rows are the alternatives. That is what the 7
  # ranking methods read through their performance_items role, which declares
  # levels = "matrix". Without this branch a matrix item fell through to
  # "identifier", so nothing ever carried the level the role wanted and the
  # dropdown was empty for all 7 methods, leaving the whole rated-matrix path
  # unwirable here. Same failure shape as the decision item types before A6.
  if (identical(type, "matrix")) {
    return(list(level = "matrix", code = "MTX", type = type))
  }
  list(level = "identifier", code = "ID", type = type)
}

studio_variable_catalog <- function(instrument) {
  if (is.null(instrument)) {
    return(list())
  }
  # Display-only items are not response variables and must not appear as
  # analysis variables or role choices.
  question_items <- Filter(
    function(item) !(item$type %in% c("section_break", "text_block")),
    instrument$items %||% list()
  )
  item_rows <- lapply(question_items, function(item) {
    meta <- studio_level_meta(item = item)
    scale_membership <- item$scale_id %||% ""
    if (!nzchar(scale_membership) && length(instrument$scales %||% list()) > 0) {
      hits <- vapply(instrument$scales, function(scale) item$id %in% (scale$items %||% character(0)), logical(1))
      scale_membership <- paste(vapply(instrument$scales[hits], function(scale) scale$id, character(1)), collapse = ", ")
    }
    list(
      id = item$id,
      label = item$label %||% item$id,
      kind = "item",
      level = meta$level,
      code = meta$code,
      type = meta$type,
      choice_set = item$choice_set %||% "",
      scale = scale_membership,
      required = isTRUE(item$required)
    )
  })
  scale_rows <- lapply(instrument$scales %||% list(), function(scale) {
    meta <- studio_level_meta(scale = scale)
    list(
      id = scale$id,
      label = scale$label %||% scale$id,
      kind = "scale",
      level = meta$level,
      code = meta$code,
      type = meta$type,
      choice_set = "",
      scale = scale$id,
      required = FALSE
    )
  })
  c(item_rows, scale_rows)
}

studio_role_choices <- function(role, catalog, models) {
  if ("model" %in% (role$levels %||% character(0))) {
    ids <- vapply(models %||% list(), function(model) model$id %||% "", character(1))
    labels <- vapply(models %||% list(), function(model) {
      paste0(model$id %||% "", " (", model$type %||% "model", ")")
    }, character(1))
    return(stats::setNames(ids[nzchar(ids)], labels[nzchar(ids)]))
  }
  keep <- vapply(catalog, function(v) {
    "any" %in% role$levels || v$level %in% role$levels || v$kind %in% role$levels
  }, logical(1))
  vars <- catalog[keep]
  ids <- vapply(vars, function(v) v$id, character(1))
  labels <- vapply(vars, function(v) paste0(v$id, " - ", substr(v$label, 1, 48)), character(1))
  stats::setNames(ids, labels)
}

studio_flatten_roles <- function(roles) {
  vals <- unlist(roles, use.names = FALSE)
  unique(vals[nzchar(vals)])
}

studio_validate_plan_roles <- function(method, roles) {
  reg <- analysis_registry[[method]] %||% list(roles = list())
  messages <- character(0)
  for (role in reg$roles %||% list()) {
    vals <- roles[[role$id]] %||% character(0)
    vals <- vals[nzchar(vals)]
    n <- length(vals)
    if (n < role$min) {
      messages <- c(messages, paste0("Select ", role$min, " ", tolower(role$label), "."))
    }
    if (!is.null(role$max) && n > role$max) {
      messages <- c(messages, paste0(role$label, " allows at most ", role$max, " selection(s)."))
    }
  }
  guidance <- switch(
    method,
    frequency = "Select one variable for the frequency table.",
    mann_whitney = "Mann-Whitney U requires one grouping variable and one ordinal or continuous outcome.",
    chi_square = "Chi-square requires categorical variables.",
    fisher_exact = "Fisher's exact test is intended for sparse categorical tables.",
    correlation_pearson = "Pearson correlation requires continuous or scale-score variables.",
    correlation_spearman = "Spearman is safer for ordinal or Likert variables.",
    correlation_kendall = "Kendall tau is safer for ordinal or Likert variables.",
    regression_linear = "Regression requires one dependent variable and at least one predictor.",
    reliability_alpha = "Reliability requires at least two items in a scale.",
    efa_readiness = "EFA readiness usually requires at least three indicators.",
    efa_solution = "EFA solution usually requires at least three indicators.",
    cfa_lavaan_syntax = "CFA requires a saved model or construct plan; constructs with fewer than three indicators should be justified.",
    sem_lavaan_syntax = "CB-SEM requires a saved model with measurement and structural paths.",
    seminr_syntax = "PLS-SEM requires at least one construct and one structural path.",
    topsis = ,
    vikor = ,
    moora = ,
    smart = ,
    waspas = ,
    promethee = ,
    electre = "Needs a performance matrix (either supplied directly or one matrix item per criterion) and a weights item or supplied weights.",
    ahp = ,
    anp = "Needs a pairwise comparison item (Saaty 1-9 scale) or a supplied reciprocal matrix.",
    dematel = "Needs a pairwise comparison item using the influence (0-4) scale, or a supplied directed matrix.",
    "Review compatibility before saving."
  )
  list(valid = length(messages) == 0, messages = messages, guidance = guidance)
}

studio_next_plan_id <- function(plan) {
  paste0("RQ", length(plan %||% list()) + 1L)
}

# Deterministic Shiny input id for a plan block's Export-screen
# interpretation field. The queue index keeps ids unique even when two
# sanitised block ids collide.
studio_interp_input_id <- function(i, block_id) {
  paste0("rpt_interp_", i, "_", studio_safe_id(block_id, prefix = "rq"))
}

# Embed a ggplot as a base64 PNG tag so result cards can carry their charts
# inside renderUI without registering one dynamic plot output per research
# question. Same sizing as the report's HTML fallback.
studio_ggplot_img <- function(gg, alt = "result chart") {
  if (is.null(gg) || !requireNamespace("ggplot2", quietly = TRUE)) {
    return(NULL)
  }
  tmp <- tempfile(fileext = ".png")
  ok <- tryCatch({
    ggplot2::ggsave(tmp, gg, width = 7.2, height = 4.2, dpi = 110, bg = "white")
    TRUE
  }, error = function(e) FALSE)
  if (!isTRUE(ok) || !file.exists(tmp)) {
    return(NULL)
  }
  raw <- readBin(tmp, "raw", file.info(tmp)$size)
  unlink(tmp)
  tags$img(alt = alt, style = "max-width:100%;height:auto",
           src = paste0("data:image/png;base64,", openssl::base64_encode(raw)))
}

# Render a result's $table data frame as the same APA-styled table used
# elsewhere in the studio, so the results canvas shows the actual numbers
# instead of just the prose APA string.
studio_result_table_tag <- function(tbl) {
  if (!is.data.frame(tbl) || nrow(tbl) == 0) {
    return(NULL)
  }
  num_cols <- vapply(tbl, is.numeric, logical(1))
  if (any(num_cols)) {
    tbl[num_cols] <- lapply(tbl[num_cols], function(col) round(col, 3))
  }
  header <- tags$tr(do.call(tagList, lapply(colnames(tbl), tags$th)))
  body_rows <- lapply(seq_len(nrow(tbl)), function(r) {
    tags$tr(do.call(tagList, lapply(tbl[r, , drop = TRUE], function(cell) {
      tags$td(as.character(cell))
    })))
  })
  tags$table(class = "sf-table", tags$thead(header), tags$tbody(do.call(tagList, body_rows)))
}

# The chart(s) attached to one analysis-plan result: the main chart, plus a
# regression's four diagnostic panels stacked beneath it, matching the
# report's table-plus-plot pairing.
studio_result_plot_tags <- function(result) {
  plot_tags <- list(studio_ggplot_img(result$plot))
  if (is.list(result$diagnostic_plots)) {
    plot_tags <- c(plot_tags,
      lapply(result$diagnostic_plots, studio_ggplot_img, alt = "regression diagnostic"))
  }
  Filter(Negate(is.null), plot_tags)
}

# The canvas's "Copy result" button: a JASP/jamovi output canvas lets you
# copy one output block without generating a whole report, so the same
# affordance belongs here. The click handler (window.studioCopyResultBlock,
# defined once in the page's <script> block) builds the clipboard content
# client-side from the block's live DOM, including the current
# interpretation text, the table, and the chart image, not just an APA
# string, so it survives a paste into Word or LibreOffice as a rich block.
studio_copy_result_btn <- function() {
  tags$button(
    type = "button", class = "btn-outline studio-copy-btn",
    onclick = "studioCopyResultBlock(this)",
    "Copy result"
  )
}

studio_safe_id <- function(x, prefix = "M") {
  x <- gsub("[^A-Za-z0-9_]", "_", trimws(x %||% ""))
  if (!nzchar(x)) {
    x <- prefix
  }
  if (!grepl("^[A-Za-z]", x)) {
    x <- paste0(prefix, "_", x)
  }
  x
}

studio_parse_paths <- function(text) {
  lines <- parse_lines(text %||% "")
  Filter(Negate(is.null), lapply(lines, function(line) {
    parts <- trimws(strsplit(line, "->", fixed = TRUE)[[1]])
    if (length(parts) != 2 || any(!nzchar(parts))) {
      return(NULL)
    }
    surveyframe::sf_path(parts[1], parts[2])
  }))
}

studio_parse_covariances <- function(text) {
  lines <- parse_lines(text %||% "")
  Filter(Negate(is.null), lapply(lines, function(line) {
    parts <- trimws(strsplit(line, "~~", fixed = TRUE)[[1]])
    if (length(parts) != 2 || any(!nzchar(parts))) {
      return(NULL)
    }
    surveyframe::sf_covariance(parts[1], parts[2])
  }))
}

studio_parse_indirect <- function(text) {
  lines <- parse_lines(text %||% "")
  Filter(Negate(is.null), lapply(lines, function(line) {
    parts <- trimws(strsplit(line, "->", fixed = TRUE)[[1]])
    if (length(parts) < 3 || any(!nzchar(parts))) {
      return(NULL)
    }
    surveyframe::sf_indirect(parts[1], parts[2:(length(parts) - 1)], parts[length(parts)])
  }))
}

INITIAL_INSTRUMENT <- shiny::getShinyOption("surveyframe_instrument", NULL)
INITIAL_RESPONSES <- shiny::getShinyOption("surveyframe_responses", NULL)
INITIAL_SCREEN <- shiny::getShinyOption("surveyframe_initial_screen", "auto")

if (is.null(INITIAL_SCREEN) || !nzchar(INITIAL_SCREEN)) {
  INITIAL_SCREEN <- "auto"
}

initial_builder <- if (inherits(INITIAL_INSTRUMENT, "sframe")) {
  builder_state_from_instrument(INITIAL_INSTRUMENT)
} else {
  builder_empty_state()
}

initial_tab <- INITIAL_SCREEN
if (identical(initial_tab, "data")) {
  initial_tab <- "responses"
}
if (identical(initial_tab, "auto")) {
  initial_tab <- if (!is.null(INITIAL_RESPONSES)) {
    "dashboard"
  } else if (inherits(INITIAL_INSTRUMENT, "sframe")) {
    "preview"
  } else {
    "open"
  }
}
if (!initial_tab %in% c("open", "preview", "responses", "quality",
                       "reliability", "analysis", "dashboard", "export")) {
  initial_tab <- if (inherits(INITIAL_INSTRUMENT, "sframe")) {
    "preview"
  } else {
    "open"
  }
}

tab_link_class <- function(tab) {
  if (identical(initial_tab, tab)) "active" else NULL
}

screen_class <- function(tab) {
  paste("screen", if (identical(initial_tab, tab)) "active")
}

ui <- fluidPage(
  tags$head(
    tags$title("SurveyStudio"),
    tags$style(HTML("
      body { font-family: 'Helvetica Neue', Arial, sans-serif;
             background: #f7f8fa; color: #1a1a2e; margin: 0; }
      .studio-shell { display: flex; min-height: 100vh; }
      .studio-sidebar {
        width: 240px; min-width: 240px; background: #1a1a2e;
        color: #c8ccd8; padding: 0; display: flex; flex-direction: column;
        position: fixed; top: 0; bottom: 0; left: 0; overflow-y: auto; z-index: 100;
      }
      .studio-logo {
        padding: 24px 20px 16px; font-size: 18px; font-weight: 700;
        color: #ffffff; letter-spacing: 0.02em; border-bottom: 1px solid #2e3250;
      }
      .studio-logo span { color: #16B3B1; }
      .studio-logo img { height: 22px; margin-right: 8px; vertical-align: middle; }
      .studio-nav { list-style: none; margin: 0; padding: 12px 0; flex: 1; }
      .studio-nav-item a {
        display: flex; align-items: center; gap: 10px;
        padding: 10px 20px; color: #9aa0b8; text-decoration: none;
        font-size: 14px; border-left: 3px solid transparent;
        transition: background 0.15s, color 0.15s;
      }
      .studio-nav-item a:hover,
      .studio-nav-item a.active {
        background: #22274a; color: #ffffff; border-left-color: #16B3B1;
      }
      .studio-status {
        padding: 16px 20px; font-size: 12px;
        border-top: 1px solid #2e3250; color: #9aa0b8;
      }
      .studio-main {
        margin-left: 240px; flex: 1; padding: 32px;
        min-height: 100vh; box-sizing: border-box;
        min-width: 0;
      }
      .screen { display: none; }
      .screen.active { display: block; }
      .card {
        background: #ffffff; border-radius: 8px;
        box-shadow: 0 1px 4px rgba(0,0,0,0.08);
        padding: 24px; margin-bottom: 20px;
      }
      .card-title {
        font-size: 16px; font-weight: 600; margin: 0 0 16px;
        color: #1a1a2e;
      }
      .card-actions {
        display: flex; gap: 10px; flex-wrap: wrap; margin-top: 12px;
      }
      .badge {
        display: inline-block; padding: 3px 10px; border-radius: 12px;
        font-size: 12px; font-weight: 600;
      }
      .badge-ok { background: #e6f4ea; color: #2e7d32; }
      .badge-wait { background: #fef3cd; color: #856404; }
      .badge-warn { background: #fde8e8; color: #b91c1c; }
      .stat-row { display: flex; gap: 16px; flex-wrap: wrap; margin-bottom: 16px; }
      .stat-box {
        flex: 1; min-width: 120px; background: #f7f8fa; border-radius: 8px;
        padding: 16px; text-align: center;
      }
      .stat-box .stat-val { font-size: 28px; font-weight: 700; color: #1a1a2e; }
      .stat-box .stat-lbl { font-size: 12px; color: #6b718e; margin-top: 4px; }
      table.sf-table { width: 100%; border-collapse: collapse; font-size: 14px;
        display: block; overflow-x: auto; max-width: 100%; }
      /* Academic (APA) tables: horizontal rules only, no shading, no vertical lines */
      .sf-table th {
        background: none; text-align: left; padding: 8px 12px;
        font-weight: 700; color: #1a1a2e;
        border-top: 2px solid #1a1a2e; border-bottom: 1px solid #1a1a2e;
      }
      .sf-table td { padding: 8px 12px; border: none; vertical-align: top; overflow-wrap: anywhere; }
      .sf-table tbody tr:last-child td { border-bottom: 2px solid #1a1a2e; }
      .btn-primary {
        background: #16B3B1; color: #fff; border: none; border-radius: 6px;
        padding: 9px 20px; font-size: 14px; cursor: pointer; font-weight: 600;
      }
      .btn-primary:hover { background: #129a98; }
      .btn-outline {
        background: transparent; color: #16B3B1; border: 1.5px solid #16B3B1;
        border-radius: 6px; padding: 8px 18px; font-size: 14px;
        cursor: pointer; font-weight: 600;
      }
      .btn-outline:hover { background: #e6f7f7; }
      /* Brand pill tabs (match the dashboard nav), used for the studio sub-tabs */
      .studio-tabs .shiny-options-group {
        display: flex; gap: 2px; flex-wrap: wrap; background: #1e293b;
        padding: 6px; border-radius: 8px; margin: 4px 0 18px;
      }
      .studio-tabs .control-label { display: none; }
      .studio-tabs .radio-inline { margin: 0; padding: 0; }
      .studio-tabs .radio-inline input[type=radio] {
        position: absolute; opacity: 0; pointer-events: none;
      }
      .studio-tabs .radio-inline span {
        display: inline-block; padding: 7px 16px; border-radius: 6px;
        font-size: 12px; font-weight: 600; color: rgba(255,255,255,.6);
        cursor: pointer; transition: all .15s;
      }
      .studio-tabs .radio-inline:hover span {
        background: rgba(255,255,255,.06); color: rgba(255,255,255,.85);
      }
      .studio-tabs .radio-inline input[type=radio]:checked + span {
        background: #16B3B1; color: #fff;
      }
      h2.screen-title {
        font-size: 22px; font-weight: 700; margin: 0 0 24px; color: #1a1a2e;
      }
      .hint { font-size: 13px; color: #6b718e; margin-top: 6px; }
      .problem-list { margin: 0; padding-left: 18px; }
      .problem-list li { margin-bottom: 6px; }
      .sf-code {
        white-space: pre-wrap; background: #f7f8fa; border: 1px solid #e0e3ea;
        border-radius: 6px; padding: 12px; overflow-x: auto;
      }
      .role-card { border: 1px solid #e0e3ea; border-radius: 8px; padding: 12px; margin-bottom: 12px; }
      .role-card label { font-size: 13px; font-weight: 600; color: #1a1a2e; }
      .vmeta { border-bottom: 1px solid #f0f1f4; padding: 10px 0; }
      .vmeta:last-child { border-bottom: none; }
      .vmeta-id { font-size: 13px; font-weight: 700; color: #1a1a2e; }
      .vmeta-lbl { font-size: 12px; color: #4b5563; margin: 2px 0 5px; display: block; }
      .result-canvas-block .sf-table { margin: 10px 0; }
      .result-canvas-block img { margin: 8px 0; border: 1px solid #f0f1f4; border-radius: 6px; }
      .result-canvas-block textarea {
        min-height: 160px; resize: vertical; font-size: 14px; line-height: 1.5;
      }
      .studio-copy-btn { margin: 10px 0; padding: 5px 14px; font-size: 12px; }
      .vbadge {
        display: inline-block; border: 1px solid #d9e2ec; border-radius: 999px;
        padding: 2px 7px; margin: 2px 3px 2px 0; font-size: 11px;
        color: #334155; background: #f8fafc;
      }
      .plan-msg { border-radius: 6px; padding: 10px; background: #fef3cd; color: #856404; }
      .plan-msg.ok { background: #e6f4ea; color: #2e7d32; }
      #survey_preview_frame {
        border: 1px solid #e0e3ea; border-radius: 8px; padding: 24px; background: #fff;
      }
    "))
  ),
  tags$div(class = "studio-shell",
    tags$div(class = "studio-sidebar",
      tags$div(class = "studio-logo",
        tags$img(src = "surveyframe-shiny-square-icon.png", alt = "surveyframe"),
        "Survey", tags$span("Studio")
      ),
      tags$ul(class = "studio-nav",
        tags$li(class = "studio-nav-item",
          tags$a(href = "#", `data-tab` = "open",
                 class = tab_link_class("open"), "Open Instrument")),
        tags$li(class = "studio-nav-item",
          tags$a(href = "#", `data-tab` = "preview",
                 class = tab_link_class("preview"), "Preview Survey")),
        tags$li(class = "studio-nav-item",
          tags$a(href = "#", `data-tab` = "responses",
                 class = tab_link_class("responses"), "Upload Responses")),
        tags$li(class = "studio-nav-item",
          tags$a(href = "#", `data-tab` = "quality",
                 class = tab_link_class("quality"), "Quality Dashboard")),
        tags$li(class = "studio-nav-item",
          tags$a(href = "#", `data-tab` = "reliability",
                 class = tab_link_class("reliability"), "Reliability")),
        tags$li(class = "studio-nav-item",
          tags$a(href = "#", `data-tab` = "analysis",
                 class = tab_link_class("analysis"), "Analysis Plan")),
        tags$li(class = "studio-nav-item",
          tags$a(href = "#", `data-tab` = "dashboard",
                 class = tab_link_class("dashboard"), "Dashboard")),
        tags$li(class = "studio-nav-item",
          tags$a(href = "#", `data-tab` = "export",
                 class = tab_link_class("export"), "Export"))
      ),
      tags$div(class = "studio-status", uiOutput("sidebar_status"))
    ),
    tags$div(class = "studio-main",
      tags$script(HTML("
        $(document).on('click', '[data-tab]', function(e) {
          e.preventDefault();
          var tab = $(this).data('tab');
          $('.studio-nav-item a').removeClass('active');
          $(this).addClass('active');
          $('.screen').removeClass('active');
          $('#screen-' + tab).addClass('active');
          Shiny.setInputValue('current_tab', tab, {priority: 'event'});
        });

        Shiny.addCustomMessageHandler('surveyframe-switch-tab', function(tab) {
          var link = $('[data-tab=\"' + tab + '\"]');
          if (link.length === 0) return;
          $('.studio-nav-item a').removeClass('active');
          link.addClass('active');
          $('.screen').removeClass('active');
          $('#screen-' + tab).addClass('active');
          Shiny.setInputValue('current_tab', tab, {priority: 'event'});
        });

        // Copies a whole result-canvas block (title, badges, APA line,
        // table, chart, decision rule, and the interpretation as currently
        // typed) as one rich-text unit, so pasting into Word/LibreOffice/
        // Google Docs brings the table and chart image over instead of a
        // flat text dump. Built client-side from the live DOM (not from a
        // string baked in at render time) so the interpretation textarea's
        // current value is included even though it was typed after the
        // page loaded.
        window.studioCopyResultBlock = function(btn) {
          var block = btn.closest('.result-canvas-block');
          if (!block) return;
          var clone = block.cloneNode(true);
          var cloneBtn = clone.querySelector('.studio-copy-btn');
          if (cloneBtn) cloneBtn.remove();
          var ta = block.querySelector('textarea');
          var taClone = clone.querySelector('textarea');
          if (ta && taClone) {
            var div = document.createElement('div');
            div.style.whiteSpace = 'pre-wrap';
            div.textContent = ta.value || '';
            taClone.parentNode.replaceChild(div, taClone);
          }
          var html = '<div>' + clone.innerHTML + '</div>';
          var text = clone.textContent || '';
          var restore = function() {
            var t = btn.textContent;
            btn.textContent = 'Copied';
            setTimeout(function() { btn.textContent = t; }, 1400);
          };
          if (window.ClipboardItem && navigator.clipboard && navigator.clipboard.write) {
            var item = new ClipboardItem({
              'text/html': new Blob([html], {type: 'text/html'}),
              'text/plain': new Blob([text], {type: 'text/plain'})
            });
            navigator.clipboard.write([item]).then(restore, function() {
              navigator.clipboard.writeText(text).then(restore);
            });
          } else {
            navigator.clipboard.writeText(text).then(restore);
          }
        };
      ")),

      tags$div(id = "screen-open", class = screen_class("open"),
        tags$h2(class = "screen-title", "Open Instrument"),
        tags$div(class = "card",
          tags$div(class = "card-title", "Load an existing .sframe"),
          fileInput("instr_file", NULL,
                    accept = ".sframe",
                    buttonLabel = "Browse .sframe file",
                    placeholder = "No file selected"),
          tags$p(class = "hint",
            "Design questions, welcome screen, logo, and thank-you page in the SurveyBuilder, then load the .sframe here to preview, analyse, and re-export."),
          uiOutput("open_status")
        ),
        uiOutput("instrument_summary_card")
      ),

      tags$div(id = "screen-preview", class = screen_class("preview"),
        tags$h2(class = "screen-title", "Preview Survey"),
        uiOutput("preview_gate"),
        tags$div(id = "survey_preview_frame", uiOutput("survey_preview_items"))
      ),

      tags$div(id = "screen-responses", class = screen_class("responses"),
        tags$h2(class = "screen-title", "Upload Responses"),
        uiOutput("responses_gate"),
        tags$div(class = "card",
          tags$div(class = "card-title", "Response data"),
          fileInput("resp_file", NULL,
                    accept = ".csv",
                    buttonLabel = "Browse CSV file",
                    placeholder = "No file selected"),
          fluidRow(
            column(4, textInput("resp_id_col", "Respondent ID column", placeholder = "e.g. id")),
            column(4, textInput("resp_time_col", "Submitted-at column", placeholder = "e.g. submitted_at")),
            column(4, checkboxInput("resp_strict", "Strict column check", value = TRUE))
          ),
          actionButton("load_responses_btn", "Load responses", class = "btn-primary")
        ),
        tags$div(class = "card",
          tags$div(class = "card-title", "Loading responses collected elsewhere"),
          tags$p(class = "hint",
            "Responses can come from the exported surveyframe survey or from another tool (Microsoft Forms, Qualtrics, Google Forms, and similar). Export them to CSV, then:"),
          tags$ol(class = "hint", style = "margin: 0 0 12px; padding-left: 18px; line-height: 1.7",
            tags$li("Open the matching instrument on the Open Instrument screen. The .sframe carries the analysis plan, so it is still required."),
            tags$li("Make sure the CSV column names match the item IDs in that instrument (download the sample CSV below for the expected format)."),
            tags$li("Browse the CSV above, set the respondent-ID and submitted-at columns if present, then click Load responses.")
          ),
          downloadButton("download_sample_csv", "Download sample CSV format", class = "btn-outline"),
          actionButton("load_sample_btn", "Or load the bundled demo", class = "btn-outline")
        ),
        tags$div(class = "card",
          tags$div(class = "card-title", "Read responses from a deployed Google Sheet"),
          tags$p(class = "hint",
            "If the survey was deployed with the surveyframe Google Sheets collector, read the live responses straight from the sheet. This needs the googlesheets4 package and access to the sheet."),
          textInput("sheet_url", "Google Sheet ID or URL",
                    placeholder = "https://docs.google.com/spreadsheets/d/YOUR_SHEET_ID"),
          fluidRow(
            column(4, textInput("sheet_tab", "Sheet tab", value = "Responses")),
            column(4, textInput("sheet_id_col", "Respondent ID column", value = "respondent_id")),
            column(4, textInput("sheet_time_col", "Submitted-at column", value = "submitted_at"))
          ),
          actionButton("load_sheet_btn", "Read from Google Sheet", class = "btn-primary")
        ),
        uiOutput("responses_summary_card")
      ),

      tags$div(id = "screen-quality", class = screen_class("quality"),
        tags$h2(class = "screen-title", "Quality Dashboard"),
        uiOutput("quality_gate"),
        uiOutput("quality_output"),
        plotOutput("studio_quality_chart", height = "260px"),
        plotOutput("studio_missing_chart", height = "260px")
      ),

      tags$div(id = "screen-reliability", class = screen_class("reliability"),
        tags$h2(class = "screen-title", "Reliability"),
        uiOutput("reliability_gate"),
        uiOutput("reliability_output"),
        plotOutput("studio_reliability_chart", height = "300px")
      ),

      tags$div(id = "screen-analysis", class = screen_class("analysis"),
        tags$h2(class = "screen-title", "Analysis Plan"),
        uiOutput("analysis_gate"),
        tags$div(class = "studio-tabs",
          radioButtons(
            "analysis_stage", NULL,
            choices = c("Plan" = "Plan", "Run preview" = "Run", "Report outline" = "Report"),
            selected = "Plan",
            inline = TRUE
          )
        ),
        fluidRow(
          column(4, uiOutput("analysis_left_panel")),
          column(4, uiOutput("analysis_middle_panel")),
          column(4, uiOutput("analysis_right_panel"))
        )
      ),

      tags$div(id = "screen-dashboard", class = screen_class("dashboard"),
        tags$h2(class = "screen-title", "Dashboard"),
        uiOutput("dashboard_gate"),
        tags$div(class = "studio-tabs",
          radioButtons(
            "dashboard_view", NULL,
            choices = c("Overview", "Items", "Scales", "Data"),
            selected = "Overview",
            inline = TRUE
          )
        ),
        uiOutput("studio_dashboard_content")
      ),

      tags$div(id = "screen-export", class = screen_class("export"),
        tags$h2(class = "screen-title", "Export"),
        uiOutput("export_gate"),
        tags$div(class = "card",
          tags$div(class = "card-title", "Instrument file"),
          tags$p(class = "hint",
            "Download the current validated draft as a .sframe file."),
          uiOutput("export_sframe_ui")
        ),
        tags$div(class = "card",
          tags$div(class = "card-title", "Report contents"),
          checkboxInput("rpt_codebook", "Include codebook", value = TRUE),
          checkboxInput("rpt_quality", "Include quality report", value = TRUE),
          checkboxInput("rpt_missing", "Include missing-data report", value = TRUE),
          checkboxInput("rpt_descriptives", "Include descriptives", value = TRUE),
          checkboxInput("rpt_reliability", "Include reliability", value = TRUE),
          checkboxInput("rpt_analysis", "Include analysis-plan results", value = TRUE),
          checkboxInput("rpt_models", "Include saved models and syntax", value = TRUE),
          shiny::radioButtons(
            "rpt_palette", "Chart theme",
            choices = c(
              "Colour (on-screen reading)" = "web",
              "Black and white (print and journal submission)" = "print"
            ),
            selected = "web"
          )
        ),
        tags$div(class = "card",
          tags$div(class = "card-title", "Interpretations"),
          tags$p(class = "hint",
            "Write an interpretation for each research question before exporting. The report shows it alongside the pre-declared decision rule. Interpretations go into the report only, never into the instrument file."),
          uiOutput("export_interpretations_ui")
        ),
        tags$div(class = "card",
          tags$div(class = "card-title", "Generate"),
          uiOutput("export_report_ui"),
          tags$p(class = "hint",
            "Generates a self-contained HTML report. Quarto is optional; an internal HTML fallback is available."),
          tags$p(class = "hint",
            "To export the deployable survey HTML or the Google Sheets collector, use the SurveyBuilder, which owns survey design and deployment.")
        )
      )
    )
  )
)

server <- function(input, output, session) {
  rv <- reactiveValues(
    builder = initial_builder,
    instrument = INITIAL_INSTRUMENT,
    responses = INITIAL_RESPONSES,
    active_screen = initial_tab
  )

  set_builder_state <- function(state) {
    rv$builder <- state
    invisible(state)
  }

  if (!is.null(INITIAL_RESPONSES) && !is.data.frame(INITIAL_RESPONSES) &&
      !is.null(rv$instrument)) {
    tryCatch({
      rv$responses <- surveyframe::read_responses(INITIAL_RESPONSES, rv$instrument)
    }, error = function(e) NULL)
  }

  switch_tab <- function(tab) {
    session$sendCustomMessage("surveyframe-switch-tab", tab)
  }

  observeEvent(input$current_tab, {
    rv$active_screen <- input$current_tab
  }, ignoreInit = TRUE)

  sync_builder_inputs <- function(state) {
    updateTextInput(session, "draft_title", value = state$meta$title %||% "Untitled Survey")
    updateTextInput(session, "draft_version", value = state$meta$version %||% "0.1.0")
    updateTextAreaInput(session, "draft_description", value = state$meta$description %||% "")
    updateTextInput(session, "draft_authors", value = format_value(state$meta$authors))
    updateTextInput(session, "draft_languages", value = format_value(state$meta$languages))
  }

  builder_meta <- reactive({
    # Design now happens in the SurveyBuilder; the studio Build screen was
    # removed. Meta comes from the loaded instrument (rv$builder$meta); the
    # draft_* inputs no longer exist, so each field falls back to it.
    m <- rv$builder$meta %||% list()
    languages <- parse_csv(input$draft_languages %||% "")
    list(
      title = trimws(input$draft_title %||% m$title %||% "Untitled Survey"),
      version = trimws(input$draft_version %||% m$version %||% "0.1.0"),
      description = trim_or_null(input$draft_description) %||% (m$description %||% NULL),
      authors = {
        values <- parse_csv(input$draft_authors %||% "")
        if (length(values) == 0) (m$authors %||% NULL) else values
      },
      languages = if (length(languages) == 0) (m$languages %||% "en") else languages
    )
  })

  draft_result <- reactive({
    builder_validate_draft(
      meta = builder_meta(),
      choices = rv$builder$choices,
      items = rv$builder$items,
      scales = rv$builder$scales,
      branching = rv$builder$branching,
      checks = rv$builder$checks,
      analysis_plan = rv$builder$analysis_plan %||% list(),
      models = rv$builder$models %||% list(),
      render = rv$builder$render %||% list()
    )
  })

  preview_instrument <- reactive({
    draft_result()$instrument
  })

  observe({
    if (draft_result()$valid) {
      rv$instrument <- draft_result()$instrument
    }
  })

  observe({
    choice_ids <- vapply(rv$builder$choices, function(choice) choice$id, character(1))
    updateSelectInput(
      session,
      "item_choice_set",
      choices = optional_choices(choice_ids),
      selected = if ((input$item_choice_set %||% "") %in% c("", choice_ids)) input$item_choice_set else ""
    )
    updateSelectInput(session, "remove_choice_id", choices = optional_choices(choice_ids, "(Select one)"))
  })

  observe({
    item_ids <- vapply(rv$builder$items, function(item) item$id, character(1))
    updateSelectInput(session, "remove_item_id", choices = optional_choices(item_ids, "(Select one)"))
    updateCheckboxGroupInput(
      session,
      "scale_items",
      choices = stats::setNames(item_ids, item_ids),
      selected = intersect(input$scale_items %||% character(0), item_ids)
    )
    current_scale_items <- intersect(input$scale_items %||% character(0), item_ids)
    updateCheckboxGroupInput(
      session,
      "scale_reverse_items",
      choices = stats::setNames(current_scale_items, current_scale_items),
      selected = intersect(input$scale_reverse_items %||% character(0), current_scale_items)
    )
    updateSelectInput(session, "branch_item_id", choices = optional_choices(item_ids, "(Select one)"))
    updateSelectInput(session, "branch_depends_on", choices = optional_choices(item_ids, "(Select one)"))
    branch_labels <- if (length(rv$builder$branching) == 0) {
      character(0)
    } else {
      vapply(
        rv$builder$branching,
        function(rule) paste(rule$item_id, rule$action, "when", rule$depends_on, rule$operator, format_value(rule$value)),
        character(1)
      )
    }
    branch_keys <- if (length(rv$builder$branching) == 0) character(0) else seq_along(rv$builder$branching)
    updateSelectInput(session, "remove_branch_key",
                      choices = c(stats::setNames("", "(Select one)"), stats::setNames(as.character(branch_keys), branch_labels)))
    updateSelectInput(session, "check_item_id", choices = optional_choices(item_ids, "(Select one)"))
  })

  observe({
    scale_ids <- vapply(rv$builder$scales, function(scale) scale$id, character(1))
    updateSelectInput(session, "remove_scale_id", choices = optional_choices(scale_ids, "(Select one)"))
  })

  observe({
    check_ids <- vapply(rv$builder$checks, function(check) check$id, character(1))
    updateSelectInput(session, "remove_check_id", choices = optional_choices(check_ids, "(Select one)"))
  })

  session$onFlushed(function() {
    switch_tab(shiny::isolate(rv$active_screen %||% initial_tab))
  }, once = TRUE)

  observeEvent(input$new_survey_btn, {
    rv$builder <- builder_empty_state()
    rv$instrument <- NULL
    rv$responses <- NULL
    sync_builder_inputs(rv$builder)
    showNotification("Cleared the loaded instrument.", type = "message")
    switch_tab("open")
  })

  observeEvent(input$go_preview_btn, {
    switch_tab("preview")
  })

  observeEvent(input$add_choice_btn, {
    choice_id <- trim_or_null(input$choice_id)
    values <- parse_choice_values(input$choice_values)
    labels <- parse_lines(input$choice_labels)

    if (is.null(choice_id)) {
      showNotification("Choice set ID is required.", type = "error")
      return()
    }
    if (length(values) == 0 || length(labels) == 0) {
      showNotification("Enter at least one value and label.", type = "error")
      return()
    }
    if (length(values) != length(labels)) {
      showNotification("Choice set values and labels must have the same length.", type = "error")
      return()
    }

    choice <- sf_choices(
      id = choice_id,
      values = values,
      labels = labels,
      allow_other = isTRUE(input$choice_allow_other),
      randomise = isTRUE(input$choice_randomise)
    )
    existing <- choice_id %in% vapply(rv$builder$choices, function(x) x$id, character(1))
    state <- rv$builder
    state$choices <- upsert_component(state$choices, choice)
    set_builder_state(state)
    showNotification(
      if (existing) "Choice set updated." else "Choice set added.",
      type = "message"
    )
  })

  observeEvent(input$remove_choice_btn, {
    choice_id <- trim_or_null(input$remove_choice_id)
    if (is.null(choice_id)) {
      return()
    }
    in_use <- vapply(rv$builder$items, function(item) identical(item$choice_set, choice_id), logical(1))
    if (any(in_use)) {
      showNotification("That choice set is still used by one or more items.", type = "error")
      return()
    }
    state <- rv$builder
    state$choices <- remove_component(state$choices, choice_id)
    set_builder_state(state)
    showNotification("Choice set deleted.", type = "message")
  })

  observeEvent(input$add_item_btn, {
    item_id <- trim_or_null(input$item_id)
    item_label <- trim_or_null(input$item_label)
    item_type <- input$item_type %||% "text"
    choice_set <- trim_or_null(input$item_choice_set)

    if (is.null(item_id) || is.null(item_label)) {
      showNotification("Item ID and question text are required.", type = "error")
      return()
    }
    if (item_type %in% c("single_choice", "multiple_choice", "likert") && is.null(choice_set)) {
      showNotification("Choice items need a choice set.", type = "error")
      return()
    }

    item <- sf_item(
      id = item_id,
      label = item_label,
      type = item_type,
      required = isTRUE(input$item_required),
      choice_set = if (item_type %in% c("single_choice", "multiple_choice", "likert")) choice_set else NULL,
      help = trim_or_null(input$item_help),
      placeholder = if (item_type %in% c("text", "textarea")) trim_or_null(input$item_placeholder) else NULL
    )

    existing <- item_id %in% vapply(rv$builder$items, function(x) x$id, character(1))
    state <- rv$builder
    state$items <- upsert_component(state$items, item)
    set_builder_state(state)
    showNotification(if (existing) "Item updated." else "Item added.", type = "message")
  })

  observeEvent(input$remove_item_btn, {
    item_id <- trim_or_null(input$remove_item_id)
    if (is.null(item_id)) {
      return()
    }
    rv$builder <- drop_item_from_builder(rv$builder, item_id)
    showNotification("Item deleted. Related scale membership, branching, and checks were updated.", type = "message")
  })

  observeEvent(input$add_scale_btn, {
    scale_id <- trim_or_null(input$scale_id)
    scale_label <- trim_or_null(input$scale_label)
    scale_items <- input$scale_items %||% character(0)
    min_valid <- suppressWarnings(as.integer(input$scale_min_valid))

    if (is.null(scale_id) || is.null(scale_label)) {
      showNotification("Scale ID and label are required.", type = "error")
      return()
    }
    if (length(scale_items) == 0) {
      showNotification("Select at least one item for the scale.", type = "error")
      return()
    }
    if (is.na(min_valid) || min_valid < 1) {
      min_valid <- NULL
    }
    if (!is.null(min_valid) && min_valid > length(scale_items)) {
      showNotification("Minimum valid items must be less than or equal to the number of scale items.", type = "error")
      return()
    }

    scale <- sf_scale(
      id = scale_id,
      label = scale_label,
      items = scale_items,
      method = input$scale_method %||% "mean",
      min_valid = min_valid,
      reverse_items = input$scale_reverse_items %||% NULL
    )
    existing <- scale_id %in% vapply(rv$builder$scales, function(x) x$id, character(1))
    state <- rv$builder
    state$scales <- upsert_component(state$scales, scale)
    set_builder_state(state)
    showNotification(if (existing) "Scale updated." else "Scale added.", type = "message")
  })

  observeEvent(input$remove_scale_btn, {
    scale_id <- trim_or_null(input$remove_scale_id)
    if (is.null(scale_id)) {
      return()
    }
    state <- rv$builder
    state$scales <- remove_component(state$scales, scale_id)
    set_builder_state(state)
    showNotification("Scale deleted.", type = "message")
  })

  observeEvent(input$add_branch_btn, {
    target <- trim_or_null(input$branch_item_id)
    depends_on <- trim_or_null(input$branch_depends_on)
    operator <- input$branch_operator %||% "=="
    value <- parse_branch_value(input$branch_value, operator)

    if (is.null(target) || is.null(depends_on)) {
      showNotification("Select both a target item and a controlling item.", type = "error")
      return()
    }
    if (identical(target, depends_on)) {
      showNotification("Choose a different controlling item for this branching rule.", type = "error")
      return()
    }
    if (is.null(value)) {
      showNotification("Enter a match value for the branching rule.", type = "error")
      return()
    }

    rule <- sf_branch(
      item_id = target,
      depends_on = depends_on,
      operator = operator,
      value = value,
      action = input$branch_action %||% "show"
    )

    branch_key <- paste(target, depends_on, operator, input$branch_action %||% "show", sep = "|")
    existing_keys <- if (length(rv$builder$branching) == 0) {
      character(0)
    } else {
      vapply(rv$builder$branching, function(x) {
        paste(x$item_id, x$depends_on, x$operator, x$action, sep = "|")
      }, character(1))
    }

    if (branch_key %in% existing_keys) {
      idx <- match(branch_key, existing_keys)
      state <- rv$builder
      state$branching[[idx]] <- rule
      set_builder_state(state)
      showNotification("Branching rule updated.", type = "message")
    } else {
      state <- rv$builder
      state$branching <- c(state$branching, list(rule))
      set_builder_state(state)
      showNotification("Branching rule added.", type = "message")
    }
  })

  observeEvent(input$remove_branch_btn, {
    branch_key <- suppressWarnings(as.integer(input$remove_branch_key %||% NA))
    if (is.na(branch_key) || branch_key < 1 || branch_key > length(rv$builder$branching)) {
      return()
    }
    state <- rv$builder
    state$branching <- state$branching[-branch_key]
    set_builder_state(state)
    showNotification("Branching rule deleted.", type = "message")
  })

  observeEvent(input$add_check_btn, {
    check_id <- trim_or_null(input$check_id)
    item_id <- trim_or_null(input$check_item_id)
    check_type <- input$check_type %||% "attention"
    pass_values <- parse_check_values(input$check_pass_values)

    if (is.null(check_id) || is.null(item_id)) {
      showNotification("Check ID and check item are required.", type = "error")
      return()
    }
    if (check_type %in% c("attention", "instructional") && is.null(pass_values)) {
      showNotification("Enter at least one pass value for this check.", type = "error")
      return()
    }

    check <- sf_check(
      id = check_id,
      item_id = item_id,
      type = check_type,
      pass_values = pass_values,
      fail_action = input$check_fail_action %||% "flag",
      label = trim_or_null(input$check_label),
      notes = trim_or_null(input$check_notes)
    )

    existing <- check_id %in% vapply(rv$builder$checks, function(x) x$id, character(1))
    state <- rv$builder
    state$checks <- upsert_component(state$checks, check)
    set_builder_state(state)
    showNotification(if (existing) "Check updated." else "Check added.", type = "message")
  })

  observeEvent(input$remove_check_btn, {
    check_id <- trim_or_null(input$remove_check_id)
    if (is.null(check_id)) {
      return()
    }
    state <- rv$builder
    state$checks <- remove_component(state$checks, check_id)
    set_builder_state(state)
    showNotification("Check deleted.", type = "message")
  })

  observeEvent(input$instr_file, {
    req(input$instr_file)
    tryCatch({
      path <- sframe_validate_upload(input$instr_file, "sframe")
      loaded <- surveyframe::read_sframe(path)
      rv$builder <- builder_state_from_instrument(loaded)
      rv$instrument <- loaded
      rv$responses <- NULL
      sync_builder_inputs(rv$builder)
      showNotification("Instrument loaded. Showing the survey preview.", type = "message")
      switch_tab("preview")
    }, error = function(e) {
      showNotification(paste("Error:", conditionMessage(e)), type = "error")
    })
  })

  observeEvent(input$load_responses_btn, {
    req(input$resp_file, rv$instrument)
    id_col <- trim_or_null(input$resp_id_col)
    time_col <- trim_or_null(input$resp_time_col)
    tryCatch({
      path <- sframe_validate_upload(input$resp_file, "csv")
      rv$responses <- surveyframe::read_responses(
        x = path,
        instrument = rv$instrument,
        respondent_id = id_col,
        submitted_at = time_col,
        strict = isTRUE(input$resp_strict)
      )
      showNotification(paste(nrow(rv$responses), "responses loaded."), type = "message")
      switch_tab("quality")
    }, error = function(e) {
      showNotification(paste("Error:", conditionMessage(e)), type = "error")
    })
  })

  observeEvent(input$load_sheet_btn, {
    req(rv$instrument)
    sheet <- trim_or_null(input$sheet_url)
    if (is.null(sheet)) {
      showNotification("Enter the Google Sheet ID or URL first.", type = "warning")
      return(invisible(NULL))
    }
    if (!requireNamespace("googlesheets4", quietly = TRUE)) {
      showNotification(
        "Reading from Google Sheets needs the googlesheets4 package. Install it, then try again.",
        type = "error", duration = NULL)
      return(invisible(NULL))
    }
    tryCatch({
      rv$responses <- surveyframe::read_sheet_responses(
        sheet_id      = sheet,
        instrument    = rv$instrument,
        sheet_name    = trim_or_null(input$sheet_tab) %||% "Responses",
        respondent_id = trim_or_null(input$sheet_id_col),
        submitted_at  = trim_or_null(input$sheet_time_col)
      )
      showNotification(paste(nrow(rv$responses), "responses read from the Google Sheet."),
                       type = "message")
      switch_tab("quality")
    }, error = function(e) {
      showNotification(paste("Google Sheet error:", conditionMessage(e)), type = "error")
    })
  })

  observeEvent(input$load_sample_btn, {
    tryCatch({
      demo <- surveyframe::sframe_input_types_demo_data()
      rv$builder <- builder_state_from_instrument(demo$instrument)
      rv$instrument <- demo$instrument
      rv$responses <- demo$responses
      sync_builder_inputs(rv$builder)
      showNotification(
        paste0("Sample loaded: ", nrow(demo$responses),
               " responses. Explore Quality, Reliability, Analysis Plan, and Dashboard."),
        type = "message"
      )
      switch_tab("dashboard")
    }, error = function(e) {
      showNotification(paste("Could not load sample:", conditionMessage(e)), type = "error")
    })
  })

  output$download_sample_csv <- downloadHandler(
    filename = function() "surveyframe_input_types_responses.csv",
    content = function(file) {
      src <- system.file("extdata", "surveyframe_input_types_responses.csv",
                         package = "surveyframe")
      file.copy(src, file, overwrite = TRUE)
    }
  )

  output$sidebar_status <- renderUI({
    draft <- draft_result()
    tagList(
      tags$div(if (draft$valid) "Draft ready" else "Draft needs fixes"),
      tags$div(if (!is.null(rv$instrument)) "Instrument ready" else "No valid instrument"),
      tags$div(if (!is.null(rv$responses)) "Responses loaded" else "No responses")
    )
  })

  output$builder_summary_card <- renderUI({
    draft <- draft_result()
    tags$div(class = "card",
      tags$div(class = "card-title", draft$instrument$meta$title %||% "Survey draft"),
      tags$div(class = "stat-row",
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", length(rv$builder$choices)),
          tags$div(class = "stat-lbl", "Choice sets")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", length(rv$builder$items)),
          tags$div(class = "stat-lbl", "Items")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", length(rv$builder$scales)),
          tags$div(class = "stat-lbl", "Scales")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", length(rv$builder$analysis_plan %||% list())),
          tags$div(class = "stat-lbl", "Plans")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", length(rv$builder$models %||% list())),
          tags$div(class = "stat-lbl", "Models")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", if (draft$valid) "Ready" else "Fix"),
          tags$div(class = "stat-lbl", "Status"))
      )
    )
  })

  output$builder_validation_card <- renderUI({
    draft <- draft_result()
    tags$div(class = "card",
      tags$div(class = "card-title", "Draft validation"),
      if (draft$valid) {
        tagList(
          tags$p(status_badge(TRUE, "Validated", "Needs fixes")),
          tags$p(class = "hint",
            "This draft can be previewed, saved as a .sframe, and used for downstream analysis.")
        )
      } else {
        tagList(
          tags$p(status_badge(FALSE, "Validated", "Needs fixes")),
          tags$ul(class = "problem-list",
            do.call(tagList, lapply(draft$problems, tags$li))
          )
        )
      }
    )
  })

  output$choices_table <- renderUI({
    rows <- lapply(rv$builder$choices, function(choice) {
      tags$tr(
        tags$td(choice$id),
        tags$td(length(choice$values)),
        tags$td(format_value(choice$labels)),
        tags$td(if (isTRUE(choice$allow_other)) "Yes" else "No"),
        tags$td(if (isTRUE(choice$randomise)) "Yes" else "No")
      )
    })
    table_card("Current choice sets",
      headers = c("ID", "Options", "Labels", "Other", "Randomise"),
      rows = rows,
      empty_label = "No choice sets yet.")
  })

  output$items_table <- renderUI({
    rows <- lapply(rv$builder$items, function(item) {
      tags$tr(
        tags$td(item$id),
        tags$td(item$type),
        tags$td(item$choice_set %||% ""),
        tags$td(if (isTRUE(item$required)) "Yes" else "No"),
        tags$td(item$label)
      )
    })
    table_card("Current items",
      headers = c("ID", "Type", "Choice set", "Required", "Label"),
      rows = rows,
      empty_label = "No items yet.")
  })

  output$scales_table <- renderUI({
    rows <- lapply(rv$builder$scales, function(scale) {
      tags$tr(
        tags$td(scale$id),
        tags$td(scale$label),
        tags$td(format_value(scale$items)),
        tags$td(scale$method),
        tags$td(scale$min_valid %||% ""),
        tags$td(format_value(scale$reverse_items))
      )
    })
    table_card("Current scales",
      headers = c("ID", "Label", "Items", "Method", "Min valid", "Reverse"),
      rows = rows,
      empty_label = "No scales yet.")
  })

  output$branching_table <- renderUI({
    rows <- lapply(rv$builder$branching, function(rule) {
      tags$tr(
        tags$td(rule$item_id),
        tags$td(rule$depends_on),
        tags$td(rule$operator),
        tags$td(format_value(rule$value)),
        tags$td(rule$action)
      )
    })
    table_card("Current branching rules",
      headers = c("Target", "Depends on", "Operator", "Value", "Action"),
      rows = rows,
      empty_label = "No branching rules yet.")
  })

  output$checks_table <- renderUI({
    rows <- lapply(rv$builder$checks, function(check) {
      tags$tr(
        tags$td(check$id),
        tags$td(check$item_id),
        tags$td(check$type),
        tags$td(format_value(check$pass_values)),
        tags$td(check$fail_action)
      )
    })
    table_card("Current checks",
      headers = c("ID", "Item", "Type", "Pass values", "Fail action"),
      rows = rows,
      empty_label = "No checks yet.")
  })

  output$open_status <- renderUI({
    if (!is.null(rv$instrument)) {
      status_badge(TRUE, "Loaded", "No instrument loaded")
    } else {
      status_badge(FALSE, "Loaded", "No instrument loaded")
    }
  })

  output$instrument_summary_card <- renderUI({
    req(rv$instrument)
    instr <- rv$instrument
    tags$div(class = "card",
      tags$div(class = "card-title", instr$meta$title),
      tags$div(class = "stat-row",
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", length(instr$items)),
          tags$div(class = "stat-lbl", "Items")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", length(instr$scales)),
          tags$div(class = "stat-lbl", "Scales")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", length(instr$analysis_plan %||% list())),
          tags$div(class = "stat-lbl", "Plans")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", length(instr$models %||% list())),
          tags$div(class = "stat-lbl", "Models")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", instr$meta$version),
          tags$div(class = "stat-lbl", "Version")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val",
                   if (isTRUE(instr$meta$validated)) "Valid" else "Draft"),
          tags$div(class = "stat-lbl", "Status"))
      )
    )
  })

  output$preview_gate <- renderUI({
    draft <- draft_result()
    if (length(draft$instrument$items) == 0) {
      return(tags$div(class = "card",
        "Add at least one item in Build Survey before previewing."))
    }
    if (!draft$valid) {
      return(tags$div(class = "card",
        tags$p("The current draft has validation issues. Preview is still shown so you can inspect the question flow."),
        tags$ul(class = "problem-list", do.call(tagList, lapply(draft$problems, tags$li)))
      ))
    }
    NULL
  })

  output$survey_preview_items <- renderUI({
    instr <- preview_instrument()
    req(instr)
    # Render the exact deployable survey so the preview is identical to what
    # respondents see. Reuses the single static-survey template through
    # export_static_survey() instead of re-creating the layout with widgets.
    tmp <- tempfile(fileext = ".html")
    ok <- tryCatch({
      suppressMessages(surveyframe::export_static_survey(
        instr, output_path = tmp, open = FALSE, overwrite = TRUE
      ))
      TRUE
    }, error = function(e) FALSE)
    if (!isTRUE(ok)) {
      return(tags$p(class = "hint",
        "Add at least one question and pass validation to preview the survey."))
    }
    html <- paste(readLines(tmp, warn = FALSE, encoding = "UTF-8"), collapse = "\n")
    tagList(
      tags$p(class = "hint", style = "margin-bottom: 12px;",
        "This is the exact deployable survey. Anything entered here stays in this preview."),
      tags$iframe(
        srcdoc = html,
        style = "width:100%;height:78vh;border:1px solid var(--cb);border-radius:10px;background:#fff;",
        title = "Survey preview"
      )
    )
  })

  output$responses_gate <- renderUI({
    if (is.null(rv$instrument)) {
      tags$div(class = "card",
        "Build or open a valid instrument before uploading responses.")
    }
  })

  output$responses_summary_card <- renderUI({
    req(rv$responses)
    tags$div(class = "card",
      tags$div(class = "card-title", "Loaded response data"),
      tags$div(class = "stat-row",
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", nrow(rv$responses)),
          tags$div(class = "stat-lbl", "Respondents")),
        tags$div(class = "stat-box",
          tags$div(class = "stat-val", ncol(rv$responses)),
          tags$div(class = "stat-lbl", "Columns"))
      )
    )
  })

  output$quality_gate <- renderUI({
    if (is.null(rv$instrument) || is.null(rv$responses)) {
      tags$div(class = "card",
        "Build or open a valid instrument and load responses before running quality checks.")
    }
  })

  quality_result <- reactive({
    req(rv$instrument, rv$responses)
    id_col <- trim_or_null(input$resp_id_col)
    # Timing analysis needs the timestamp columns passed explicitly; detect
    # the standard collector columns so sheet imports get completion times.
    sub_col <- if ("submitted_at" %in% names(rv$responses)) "submitted_at"
    st_col  <- if ("started_at" %in% names(rv$responses)) "started_at"
    surveyframe::quality_report(rv$responses, rv$instrument,
                                respondent_id = id_col,
                                submitted_at = sub_col,
                                started_at = st_col)
  })

  output$quality_output <- renderUI({
    req(rv$instrument, rv$responses)
    qr <- quality_result()
    n <- qr$summary$n_respondents
    n_flag <- qr$summary$n_flagged %||% 0L
    stat_box <- function(v, l) tags$div(class = "stat-box",
      tags$div(class = "stat-val", v), tags$div(class = "stat-lbl", l))

    tagList(
      tags$div(class = "card",
        tags$div(class = "card-title", "Summary"),
        tags$div(class = "stat-row",
          stat_box(n, "Respondents"),
          stat_box(qr$summary$n_items, "Items"),
          stat_box(n - n_flag, "Clean"),
          stat_box(sprintf("%d (%.1f%%)", n_flag, qr$summary$flag_rate * 100), "Flagged")
        ),
        tags$p(class = "hint",
          "A respondent is flagged if caught by any check below: a failed attention check, straight-lining a scale, completing too fast, missing more than the threshold, or being a duplicate row.")
      ),

      if (length(qr$attention) > 0) {
        rows <- lapply(qr$attention, function(chk) {
          tags$tr(
            tags$td(chk$check_id),
            tags$td(chk$type),
            tags$td(chk$n_pass %||% NA),
            tags$td(chk$n_fail),
            tags$td(sprintf("%.1f%%", chk$pass_rate * 100))
          )
        })
        table_card("Attention checks",
          headers = c("Check ID", "Type", "n pass", "n fail", "Pass rate"),
          rows = rows,
          empty_label = "No checks.")
      },

      if (length(qr$straightline %||% list()) > 0) {
        rows <- lapply(qr$straightline, function(s) {
          tags$tr(
            tags$td(s$scale_id),
            tags$td(s$n_items),
            tags$td(length(s$flagged_rows %||% integer(0))),
            tags$td(sprintf("%.1f%%", (s$flag_rate %||% 0) * 100))
          )
        })
        table_card("Straight-lining by scale",
          headers = c("Scale", "Items", "Flagged", "Rate"),
          rows = rows,
          empty_label = "No multi-item scales.")
      },

      tags$div(class = "card",
        tags$div(class = "card-title", "Completion time"),
        if (isTRUE(qr$timing$available)) {
          tags$p(sprintf(
            "Median completion %.0f seconds. %d respondent(s) (%.1f%%) flagged as too fast.",
            qr$timing$median_sec %||% NA_real_,
            qr$timing$n_flagged %||% 0L,
            (qr$timing$flag_rate %||% 0) * 100))
        } else {
          tags$p(class = "hint",
            qr$timing$reason %||% "Timing analysis needs started_at and submitted_at columns.")
        }
      ),

      tags$div(class = "card",
        tags$div(class = "card-title", "Duplicates and missingness"),
        tags$p(sprintf("%d duplicate response row(s) detected.",
                       qr$duplicates$n_duplicates %||% 0L)),
        tags$p(sprintf(
          "%.1f%% of respondents exceed the %.0f%% missing threshold.",
          mean(qr$missing$respondent_miss > qr$missing$flagged_threshold, na.rm = TRUE) * 100,
          qr$missing$flagged_threshold * 100
        ))
      )
    )
  })

  output$reliability_gate <- renderUI({
    if (is.null(rv$instrument) || is.null(rv$responses)) {
      tags$div(class = "card",
        "Build or open a valid instrument and load responses to compute reliability.")
    }
  })

  reliability_result <- reactive({
    req(rv$instrument, rv$responses)
    tryCatch(
      surveyframe::reliability_report(rv$responses, rv$instrument),
      error = function(e) NULL
    )
  })

  # plot() dispatches to plot.sframe_quality_report()/plot.sframe_reliability_report()
  # (ggplot2, guarded); returns NULL and draws nothing when ggplot2 is absent
  # or the report has no plottable rows, so these panels degrade quietly
  # rather than erroring.
  output$studio_quality_chart <- shiny::renderPlot({
    req(rv$instrument, rv$responses)
    gg <- tryCatch(graphics::plot(quality_result()), error = function(e) NULL)
    if (!is.null(gg)) print(gg)
  }, bg = "white")

  output$studio_missing_chart <- shiny::renderPlot({
    req(rv$instrument, rv$responses)
    mr <- tryCatch(
      surveyframe::missing_data_report(rv$responses, rv$instrument),
      error = function(e) NULL
    )
    if (is.null(mr)) return()
    gg <- tryCatch(graphics::plot(mr), error = function(e) NULL)
    if (!is.null(gg)) print(gg)
  }, bg = "white")

  # Scale-score correlation heatmap for the Dashboard tab's Scales view.
  # Scores are local row means per scale, matching the standalone dashboard.
  output$studio_scale_cor_chart <- shiny::renderPlot({
    req(rv$instrument, rv$responses)
    resp <- rv$responses
    scs <- Filter(function(s) length(intersect(s$items, names(resp))) > 0,
                  rv$instrument$scales %||% list())
    if (length(scs) < 2) {
      plot.new(); text(.5, .5, "Define at least two scales to see correlations.", col = "#94a3b8")
      return()
    }
    scored <- as.data.frame(lapply(scs, function(sc) {
      nums <- lapply(resp[intersect(sc$items, names(resp))],
                     function(x) suppressWarnings(as.numeric(x)))
      rowMeans(do.call(cbind, nums), na.rm = TRUE)
    }))
    names(scored) <- vapply(scs, `[[`, character(1), "id")
    gg <- tryCatch(
      surveyframe::sframe_plot_correlation_matrix(scored, names(scored)),
      error = function(e) NULL
    )
    if (!is.null(gg)) { print(gg); return() }
    plot.new(); text(.5, .5, "Install ggplot2 to see the correlation heatmap.", col = "#94a3b8")
  }, bg = "white")

  output$studio_reliability_chart <- shiny::renderPlot({
    req(rv$instrument, rv$responses)
    rr <- reliability_result()
    if (is.null(rr) || length(rr) == 0) return()
    gg <- tryCatch(graphics::plot(rr), error = function(e) NULL)
    if (!is.null(gg)) print(gg)
  }, bg = "white")

  output$reliability_output <- renderUI({
    req(rv$instrument, rv$responses)
    rr <- reliability_result()
    if (is.null(rr) || length(rr) == 0) {
      return(tags$div(class = "card",
        "No scales with two or more items found in response data."))
    }

    cards <- lapply(rr, function(scale) {
      rows <- list(
        tags$tr(tags$td("Items"), tags$td(scale$n_items)),
        tags$tr(tags$td("N"), tags$td(scale$n))
      )
      if (!is.null(scale$alpha)) {
        rows <- c(rows, list(tags$tr(tags$td("Cronbach alpha"),
                                     tags$td(sprintf("%.3f", scale$alpha)))))
      }
      if (!is.null(scale$omega_h)) {
        rows <- c(rows, list(tags$tr(tags$td("Omega h"),
                                     tags$td(sprintf("%.3f", scale$omega_h)))))
      }
      if (!is.null(scale$omega_t)) {
        rows <- c(rows, list(tags$tr(tags$td("Omega total"),
                                     tags$td(sprintf("%.3f", scale$omega_t)))))
      }

      tags$div(class = "card",
        tags$div(class = "card-title", paste0(scale$label, " (", scale$scale_id, ")")),
        tags$table(class = "sf-table", tags$tbody(rows))
      )
    })

    do.call(tagList, cards)
  })

  output$analysis_gate <- renderUI({
    if (is.null(rv$instrument)) {
      return(tags$div(class = "card",
        "Build or open a valid instrument before planning analyses."))
    }
    NULL
  })

  analysis_catalog <- reactive({
    req(rv$instrument)
    studio_variable_catalog(rv$instrument)
  })

  current_analysis_roles <- reactive({
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    roles <- list()
    for (role in reg$roles %||% list()) {
      id <- paste0("analysis_role_", role$id)
      vals <- input[[id]] %||% character(0)
      vals <- as.character(vals)
      vals <- vals[nzchar(vals)]
      roles[[role$id]] <- if ((role$max %||% 1) > 1) vals else vals[1] %||% ""
    }
    roles
  })

  plan_table_ui <- function(plan) {
    plan <- rv$instrument$analysis_plan %||% list()
    if (length(plan) == 0) {
      return(tags$div(class = "card",
        tags$div(class = "card-title", "Saved analysis plans"),
        tags$p(class = "hint", "No saved analysis plans yet.")))
    }

    role_text <- function(block) {
      roles <- block$roles %||% NULL
      if (!is.null(roles) && length(roles) > 0) {
        return(paste(
          sprintf("%s: %s", names(roles), vapply(roles, format_value, character(1))),
          collapse = "; "
        ))
      }
      format_value(block$variables %||% character(0))
    }

    rows <- lapply(plan, function(block) {
      method <- block$method %||% block$test %||% ""
      reg <- analysis_registry[[method]] %||% list(label = method)
      tags$tr(
        tags$td(block$id %||% ""),
        tags$td(block$family %||% ""),
        tags$td(reg$label %||% method),
        tags$td(role_text(block)),
        tags$td(block$status %||% ""),
        tags$td(if (isTRUE(block$requires_data %||% TRUE)) "Yes" else "No")
      )
    })
    table_card("Saved analysis plans",
      headers = c("ID", "Family", "Method", "Roles", "Status", "Needs data"),
      rows = rows,
      empty_label = "No saved analysis plans.")
  }

  output$analysis_left_panel <- renderUI({
    req(rv$instrument)
    catalog <- analysis_catalog()
    variable_rows <- lapply(catalog, function(v) {
      tags$div(class = "vmeta",
        tags$div(class = "vmeta-id", v$id),
        tags$div(class = "vmeta-lbl", v$label),
        tags$div(
          tags$span(class = "vbadge", v$code),
          tags$span(class = "vbadge", v$type),
          tags$span(class = "vbadge", v$kind),
          if (nzchar(v$choice_set)) tags$span(class = "vbadge", paste("choice:", v$choice_set)),
          if (nzchar(v$scale)) tags$span(class = "vbadge", paste("scale:", v$scale)),
          tags$span(class = "vbadge", if (isTRUE(v$required)) "required" else "missing allowed")
        )
      )
    })
    models <- rv$instrument$models %||% list()
    model_rows <- lapply(models, function(model) {
      constructs <- model$measurement$constructs %||% list()
      paths <- model$structural$paths %||% list()
      tags$div(class = "vmeta",
        tags$div(class = "vmeta-id", model$id %||% ""),
        tags$div(class = "vmeta-lbl", model$label %||% ""),
        tags$div(
          tags$span(class = "vbadge", model$type %||% "model"),
          tags$span(class = "vbadge", model$engine %||% ""),
          tags$span(class = "vbadge", paste(length(constructs), "construct(s)")),
          tags$span(class = "vbadge", paste(length(paths), "path(s)"))
        )
      )
    })
    tagList(
      tags$div(class = "card",
        tags$div(class = "card-title", "Variables and constructs"),
        if (length(variable_rows) == 0) {
          tags$p(class = "hint", "Define items and scales before assigning variable roles.")
        } else {
          do.call(tagList, variable_rows)
        }
      ),
      tags$div(class = "card",
        tags$div(class = "card-title", "Saved models"),
        if (length(model_rows) == 0) {
          tags$p(class = "hint", "No saved models yet.")
        } else {
          do.call(tagList, model_rows)
        }
      )
    )
  })

  output$analysis_middle_panel <- renderUI({
    req(rv$instrument)
    stage <- input$analysis_stage %||% "Plan"
    if (identical(stage, "Run")) {
      full_plan  <- rv$instrument$analysis_plan %||% list()
      run_plan   <- Filter(function(b) !isFALSE(b$requires_data), full_plan)
      syntax_n   <- length(full_plan) - length(run_plan)
      return(tagList(
        plan_table_ui(run_plan),
        if (syntax_n > 0) tags$p(class = "hint", paste0(
          syntax_n, " syntax-only method(s) excluded from the run queue ",
          "(generate lavaan or seminr strings without response data).")),
        uiOutput("analysis_results_output")
      ))
    }
    if (identical(stage, "Report")) {
      return(tags$div(class = "card",
        tags$div(class = "card-title", "Report outline"),
        tags$p(class = "hint",
          "Use Export to generate the HTML report with codebook, quality, missing data, descriptives, reliability, saved analysis results, and model appendices."),
        tags$div(class = "stat-row",
          tags$div(class = "stat-box",
            tags$div(class = "stat-val", length(rv$instrument$analysis_plan %||% list())),
            tags$div(class = "stat-lbl", "Plans")),
          tags$div(class = "stat-box",
            tags$div(class = "stat-val", length(rv$instrument$models %||% list())),
            tags$div(class = "stat-lbl", "Models"))
        )
      ))
    }

    plan <- rv$instrument$analysis_plan %||% list()
    tagList(
      tags$div(class = "card",
        tags$div(class = "card-title", "Analysis options"),
        textInput(
          "analysis_plan_id",
          "Plan ID",
          value = shiny::isolate(input$analysis_plan_id %||% studio_next_plan_id(plan))
        ),
        textAreaInput(
          "analysis_question",
          "Research question",
          value = shiny::isolate(input$analysis_question %||% ""),
          rows = 3
        ),
        selectInput(
          "analysis_method",
          "Analysis method",
          choices = analysis_method_choices(),
          selected = shiny::isolate(input$analysis_method %||% "descriptives")
        ),
        tags$div(class = "hint", "Variables are assigned below by methodological role."),
        uiOutput("analysis_role_fields"),
        uiOutput("analysis_alpha_field"),
        uiOutput("analysis_term_field"),
        uiOutput("analysis_wordcloud_field"),
        uiOutput("analysis_top_n_field"),
        uiOutput("analysis_ngram_n_field"),
        uiOutput("analysis_k_field"),
        uiOutput("analysis_seed_field"),
        textAreaInput(
          "analysis_decision_rule",
          "Planned decision rule",
          value = shiny::isolate(input$analysis_decision_rule %||% ""),
          rows = 3
        ),
        uiOutput("analysis_plan_validation"),
        uiOutput("save_analysis_plan_control"),
        tags$hr(),
        selectInput(
          "delete_analysis_plan_id",
          "Delete saved plan",
          choices = optional_choices(vapply(plan, function(block) block$id %||% "", character(1)), "(Select one)")
        ),
        actionButton("delete_analysis_plan_btn", "Delete plan", class = "btn-outline")
      ),
      uiOutput("model_builder_card")
    )
  })

  output$analysis_right_panel <- renderUI({
    req(rv$instrument)
    stage <- input$analysis_stage %||% "Plan"
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    if (identical(stage, "Run")) {
      return(tags$div(class = "card",
        tags$div(class = "card-title", "Run preview"),
        tags$p(class = "hint",
          if (is.null(rv$responses)) {
            "Upload response data before running saved plans."
          } else {
            "Saved plans are run against the uploaded response data."
          })
      ))
    }
    if (identical(stage, "Report")) {
      return(tagList(
        uiOutput("models_table"),
        uiOutput("model_syntax_output")
      ))
    }
    tagList(
      tags$div(class = "card",
        tags$div(class = "card-title", "Output preview and reporting card"),
        tags$p(tags$strong(reg$label %||% method)),
        tags$p(reg$output %||% "Structured result."),
        if (length(reg$assumptions %||% character(0)) > 0) {
          tags$p(tags$strong("Assumptions: "), paste(reg$assumptions, collapse = ", "))
        },
        if (isTRUE(reg$show_alpha)) {
          tags$p(tags$strong("Significance level: "), input$analysis_alpha %||% 0.05)
        },
        if (isTRUE(reg$show_term)) {
          tags$p(tags$strong("Keyword: "), input$analysis_term %||% "(not set)")
        },
        if (isTRUE(reg$show_wordcloud)) {
          tags$p(tags$strong("Display: "),
                 if (isTRUE(input$analysis_wordcloud)) "Word cloud" else "Bar chart")
        },
        if (isTRUE(reg$show_top_n)) {
          tags$p(tags$strong("Top N: "), input$analysis_top_n %||% reg$default_top_n %||% 30L)
        },
        if (isTRUE(reg$show_ngram_n)) {
          tags$p(tags$strong("N-gram size: "),
                 paste0(input$analysis_ngram_n %||% "2", "-word"))
        },
        if (isTRUE(reg$show_k)) {
          tags$p(tags$strong("Topics (k): "), input$analysis_k %||% reg$default_k %||% 4L)
        },
        if (isTRUE(reg$show_seed)) {
          tags$p(tags$strong("Random seed: "), input$analysis_seed %||% 42L)
        },
        if (length(reg$refs %||% character(0)) > 0) {
          tags$p(tags$strong("Reporting references: "), paste(reg$refs, collapse = ", "))
        }
      ),
      plan_table_ui(rv$instrument$analysis_plan %||% list())
    )
  })

  output$analysis_role_fields <- renderUI({
    req(rv$instrument)
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    catalog <- analysis_catalog()
    models <- rv$instrument$models %||% list()
    fields <- lapply(reg$roles %||% list(), function(role) {
      choices <- studio_role_choices(role, catalog, models)
      selected <- input[[paste0("analysis_role_", role$id)]] %||% character(0)
      selected <- intersect(as.character(selected), unname(choices))
      tags$div(class = "role-card",
        selectInput(
          paste0("analysis_role_", role$id),
          paste0(role$label, if (role$min > 0) " *" else ""),
          choices = choices,
          selected = selected,
          multiple = (role$max %||% 1) > 1
        ),
        tags$div(class = "hint",
          paste0("Accepts: ", paste(role$levels, collapse = ", "),
                 ". Required: ", role$min, "; max: ", role$max, "."))
      )
    })
    do.call(tagList, fields)
  })

  output$analysis_alpha_field <- renderUI({
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    if (!isTRUE(reg$show_alpha)) {
      return(NULL)
    }
    numericInput(
      "analysis_alpha",
      "Significance level",
      value = shiny::isolate(input$analysis_alpha %||% 0.05),
      min = 0.001,
      max = 0.2,
      step = 0.001
    )
  })

  output$analysis_term_field <- renderUI({
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    if (!isTRUE(reg$show_term)) {
      return(NULL)
    }
    textInput(
      "analysis_term",
      "Keyword *",
      value = shiny::isolate(input$analysis_term %||% ""),
      placeholder = "Enter the keyword to search for"
    )
  })

  output$analysis_wordcloud_field <- renderUI({
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    if (!isTRUE(reg$show_wordcloud)) {
      return(NULL)
    }
    checkboxInput(
      "analysis_wordcloud",
      "Show as word cloud (instead of a bar chart)",
      value = shiny::isolate(input$analysis_wordcloud %||% FALSE)
    )
  })

  output$analysis_top_n_field <- renderUI({
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    if (!isTRUE(reg$show_top_n)) {
      return(NULL)
    }
    numericInput(
      "analysis_top_n",
      "Top N terms",
      value = shiny::isolate(input$analysis_top_n %||% reg$default_top_n %||% 30L),
      min = 1, max = 200, step = 1
    )
  })

  output$analysis_ngram_n_field <- renderUI({
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    if (!isTRUE(reg$show_ngram_n)) {
      return(NULL)
    }
    selectInput(
      "analysis_ngram_n",
      "N-gram size",
      choices = c("Bigrams (2 words)" = "2", "Trigrams (3 words)" = "3"),
      selected = shiny::isolate(input$analysis_ngram_n %||% "2")
    )
  })

  output$analysis_k_field <- renderUI({
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    if (!isTRUE(reg$show_k)) {
      return(NULL)
    }
    numericInput(
      "analysis_k",
      "Number of topics (k)",
      value = shiny::isolate(input$analysis_k %||% reg$default_k %||% 4L),
      min = 2, max = 20, step = 1
    )
  })

  output$analysis_seed_field <- renderUI({
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    if (!isTRUE(reg$show_seed)) {
      return(NULL)
    }
    numericInput(
      "analysis_seed",
      "Random seed",
      value = shiny::isolate(input$analysis_seed %||% 42L),
      min = 0, step = 1
    )
  })

  output$analysis_plan_validation <- renderUI({
    method <- input$analysis_method %||% "descriptives"
    status <- studio_validate_plan_roles(method, current_analysis_roles())
    tags$div(class = paste("plan-msg", if (status$valid) "ok" else ""),
      if (status$valid) {
        paste("Required roles are complete.", status$guidance)
      } else {
        paste(status$messages, collapse = " ")
      }
    )
  })

  output$save_analysis_plan_control <- renderUI({
    method <- input$analysis_method %||% "descriptives"
    status <- studio_validate_plan_roles(method, current_analysis_roles())
    if (isTRUE(status$valid)) {
      actionButton("save_analysis_plan_btn", "Save analysis plan", class = "btn-primary")
    } else {
      tags$button(type = "button", class = "btn-primary", disabled = "disabled", "Save analysis plan")
    }
  })

  observeEvent(input$save_analysis_plan_btn, {
    req(rv$instrument)
    method <- input$analysis_method %||% "descriptives"
    reg <- analysis_registry[[method]] %||% analysis_registry$descriptives
    roles <- current_analysis_roles()
    status <- studio_validate_plan_roles(method, roles)
    if (!isTRUE(status$valid)) {
      showNotification(paste(status$messages, collapse = " "), type = "error")
      return()
    }
    if (isTRUE(reg$show_term) && is.null(trim_or_null(input$analysis_term))) {
      showNotification("A keyword is required for this method.", type = "error")
      return()
    }
    plan_id <- studio_safe_id(trim_or_null(input$analysis_plan_id) %||%
                                studio_next_plan_id(rv$builder$analysis_plan), prefix = "RQ")
    question <- trim_or_null(input$analysis_question) %||% paste(reg$label, "analysis")
    options <- list()
    if (isTRUE(reg$show_alpha)) {
      options$alpha <- input$analysis_alpha %||% 0.05
    }
    if (isTRUE(reg$show_term)) {
      options$term <- trim_or_null(input$analysis_term) %||% ""
    }
    if (isTRUE(reg$show_wordcloud)) {
      options$wordcloud <- isTRUE(input$analysis_wordcloud)
    }
    if (isTRUE(reg$show_top_n)) {
      options$top_n <- as.integer(input$analysis_top_n %||% reg$default_top_n %||% 30L)
    }
    if (isTRUE(reg$show_ngram_n)) {
      options$n <- as.integer(input$analysis_ngram_n %||% "2")
    }
    if (isTRUE(reg$show_k)) {
      options$k <- as.integer(input$analysis_k %||% reg$default_k %||% 4L)
    }
    if (isTRUE(reg$show_seed)) {
      options$seed <- as.integer(input$analysis_seed %||% 42L)
    }
    block <- list(
      id = plan_id,
      research_question = question,
      family = reg$family %||% "",
      method = method,
      test = method,
      roles = roles,
      variables = studio_flatten_roles(roles),
      options = options,
      hypotheses = if (isTRUE(reg$show_hypotheses)) {
        list(null = "No effect or association is present.",
             alternative = "An effect or association is present.")
      } else {
        NULL
      },
      decision_rule = trim_or_null(input$analysis_decision_rule) %||% "",
      interpretation = trim_or_null(input$analysis_decision_rule) %||% "",
      reporting_references = reg$refs %||% character(0),
      citations = reg$refs %||% character(0),
      status = "valid_plan",
      requires_data = !method %in% c("cfa_lavaan_syntax", "sem_lavaan_syntax", "seminr_syntax")
    )
    state <- rv$builder
    existing <- vapply(state$analysis_plan %||% list(), function(x) x$id %||% "", character(1))
    idx <- match(plan_id, existing)
    if (is.na(idx)) {
      state$analysis_plan <- c(state$analysis_plan %||% list(), list(block))
    } else {
      state$analysis_plan[[idx]] <- block
    }
    set_builder_state(state)
    draft <- draft_result()
    if (draft$valid) {
      rv$instrument <- draft$instrument
    }
    showNotification("Analysis plan saved.", type = "message")
  })

  # One shared execution of the analysis plan (with charts when ggplot2 is
  # installed), reused by the Run result cards and the Export screen's
  # Interpretations card, so the plan does not run once per consumer.
  # Depends on input$rpt_palette so switching the Export screen's Chart
  # theme radio re-renders the preview charts in the chosen palette instead
  # of leaving them fixed at whatever palette was active on first run.
  analysis_results_r <- reactive({
    req(rv$instrument)
    if (is.null(rv$responses)) {
      return(NULL)
    }
    tryCatch(
      surveyframe::run_analysis_plan(
        rv$responses, rv$instrument,
        plots = requireNamespace("ggplot2", quietly = TRUE),
        plot_palette = input$rpt_palette %||% "web"
      ),
      error = function(e) e
    )
  })

  # Rendering a chart to an embeddable base64 PNG (studio_ggplot_img()) is
  # the expensive part of a results canvas with 30+ blocks, so it happens
  # once per result here and both the Run stage cards and the Export
  # screen's Interpretations canvas reuse the same tags instead of each
  # re-encoding every chart.
  analysis_result_plot_tags_r <- reactive({
    results <- analysis_results_r()
    if (is.null(results) || inherits(results, "error")) {
      return(list())
    }
    lapply(results, studio_result_plot_tags)
  })

  output$analysis_results_output <- renderUI({
    req(rv$instrument)
    if (length(rv$instrument$analysis_plan %||% list()) == 0) {
      return(NULL)
    }
    if (is.null(rv$responses)) {
      return(tags$div(class = "card",
        tags$div(class = "card-title", "Run results"),
        tags$p(class = "hint", "Upload response data to run saved analysis plans.")))
    }

    results <- analysis_results_r()
    if (inherits(results, "error")) {
      return(tags$div(class = "card",
        tags$div(class = "card-title", "Run results"),
        tags$p(conditionMessage(results))))
    }

    all_plot_tags <- analysis_result_plot_tags_r()
    cards <- lapply(seq_along(results), function(i) {
      result <- results[[i]]
      # The chart sits inside its result card, directly under the APA
      # string, matching the report's table-plus-plot pairing. Regression
      # adds its four diagnostic panels beneath the main chart.
      plot_tags <- all_plot_tags[[i]] %||% list()
      tags$div(class = "card",
        tags$div(class = "card-title",
          sprintf("RQ %d: %s", i, result$block_id %||% "")),
        tags$p(result$research_question %||% ""),
        tags$div(
          tags$span(class = "vbadge", result$test %||% result$method %||% ""),
          if (!is.null(result$effect_label)) {
            tags$span(class = "vbadge", paste(result$effect_label, "effect"))
          }
        ),
        if (!is.null(result$error)) {
          tags$p(class = "hint", paste("Error:", result$error))
        } else {
          tagList(
            tags$p(tags$strong("Result: "),
                   result$apa %||% "See the matching section of the report."),
            studio_result_table_tag(result$table),
            # A CFA/SEM/PLS-SEM syntax block has no table or chart: its
            # whole output is the generated syntax text.
            if (!is.null(result$syntax)) tags$pre(class = "sf-code", result$syntax)
          )
        },
        if (length(plot_tags) > 0) do.call(tagList, plot_tags)
      )
    })
    do.call(tagList, cards)
  })

  observeEvent(input$delete_analysis_plan_btn, {
    plan_id <- trim_or_null(input$delete_analysis_plan_id)
    if (is.null(plan_id)) {
      return()
    }
    state <- rv$builder
    state$analysis_plan <- Filter(function(block) !identical(block$id, plan_id), state$analysis_plan %||% list())
    set_builder_state(state)
    draft <- draft_result()
    if (draft$valid) {
      rv$instrument <- draft$instrument
    }
    showNotification("Analysis plan deleted.", type = "message")
  })

  output$model_builder_card <- renderUI({
    req(rv$instrument)
    scale_ids <- vapply(rv$instrument$scales %||% list(), function(scale) scale$id, character(1))
    model_count <- length(rv$instrument$models %||% list()) + 1L
    tags$div(class = "card",
      tags$div(class = "card-title", "Model Builder"),
      textInput(
        "model_id",
        "Model ID",
        value = shiny::isolate(input$model_id %||% paste0("model_", model_count))
      ),
      textInput(
        "model_label",
        "Model label",
        value = shiny::isolate(input$model_label %||% paste(rv$instrument$meta$title %||% "Survey", "model"))
      ),
      selectInput(
        "model_type",
        "Output engine",
        choices = c("lavaan CFA" = "cfa", "lavaan CB-SEM" = "cb_sem", "seminr PLS-SEM" = "pls_sem"),
        selected = shiny::isolate(input$model_type %||% "cfa")
      ),
      radioButtons(
        "model_mode",
        "Measurement mode",
        choices = c("Reflective" = "reflective", "Composite" = "composite", "Single item" = "single_item"),
        selected = shiny::isolate(input$model_mode %||% "reflective"),
        inline = TRUE
      ),
      checkboxGroupInput(
        "model_scales",
        "Create constructs from scales",
        choices = stats::setNames(scale_ids, scale_ids),
        selected = intersect(shiny::isolate(input$model_scales %||% character(0)), scale_ids)
      ),
      textAreaInput("model_paths", "Structural paths", value = shiny::isolate(input$model_paths %||% ""),
                    rows = 3, placeholder = "SAT -> LOY"),
      textAreaInput("model_covariances", "Covariances", value = shiny::isolate(input$model_covariances %||% ""),
                    rows = 2, placeholder = "SAT ~~ LOY"),
      textAreaInput("model_indirect", "Indirect effects", value = shiny::isolate(input$model_indirect %||% ""),
                    rows = 2, placeholder = "SAT -> TRUST -> LOY"),
      numericInput("model_bootstrap", "Bootstrap samples", value = shiny::isolate(input$model_bootstrap %||% 5000),
                   min = 0, step = 100),
      tags$div(class = "card-actions",
        actionButton("save_model_btn", "Save model", class = "btn-primary")
      ),
      if (length(scale_ids) == 0) {
        tags$p(class = "hint", "Create scales before saving CFA, CB-SEM, or PLS-SEM models.")
      }
    )
  })

  observeEvent(input$save_model_btn, {
    req(rv$instrument)
    scale_ids <- input$model_scales %||% character(0)
    if (length(scale_ids) == 0) {
      showNotification("Select at least one scale to create model constructs.", type = "error")
      return()
    }
    scales <- Filter(function(scale) scale$id %in% scale_ids, rv$instrument$scales %||% list())
    type <- input$model_type %||% "cfa"
    mode <- if (identical(type, "pls_sem")) {
      input$model_mode %||% "composite"
    } else {
      "reflective"
    }
    constructs <- lapply(scales, function(scale) {
      surveyframe::sf_construct(
        id = studio_safe_id(scale$id, prefix = "C"),
        label = scale$label %||% scale$id,
        items = scale$items %||% character(0),
        mode = mode
      )
    })
    paths <- studio_parse_paths(input$model_paths)
    if (type %in% c("cb_sem", "pls_sem") && length(paths) == 0) {
      showNotification("CB-SEM and PLS-SEM models require at least one structural path.", type = "error")
      return()
    }
    model <- surveyframe::sf_model(
      id = studio_safe_id(trim_or_null(input$model_id) %||% paste0("model_", length(rv$instrument$models %||% list()) + 1L), prefix = "model"),
      label = trim_or_null(input$model_label),
      type = type,
      engine = if (identical(type, "pls_sem")) "seminr" else "lavaan",
      constructs = constructs,
      paths = paths,
      covariances = studio_parse_covariances(input$model_covariances),
      indirect = studio_parse_indirect(input$model_indirect),
      options = list(
        estimator = "MLR",
        standardised = TRUE,
        bootstrap = input$model_bootstrap %||% 5000,
        missing = "fiml"
      )
    )
    tryCatch({
      surveyframe::validate_model(model, instrument = rv$instrument, strict = TRUE)
      state <- rv$builder
      existing <- vapply(state$models %||% list(), function(x) x$id %||% "", character(1))
      idx <- match(model$id, existing)
      if (is.na(idx)) {
        state$models <- c(state$models %||% list(), list(model))
      } else {
        state$models[[idx]] <- model
      }
      set_builder_state(state)
      draft <- draft_result()
      if (draft$valid) {
        rv$instrument <- draft$instrument
      }
      showNotification("Model saved into the .sframe draft.", type = "message")
    }, error = function(e) {
      showNotification(paste("Model error:", conditionMessage(e)), type = "error")
    })
  })

  output$models_table <- renderUI({
    req(rv$instrument)
    models <- rv$instrument$models %||% list()
    if (length(models) == 0) {
      return(NULL)
    }

    rows <- lapply(models, function(model) {
      constructs <- model$measurement$constructs %||% model$constructs %||% list()
      paths <- model$structural$paths %||% model$paths %||% list()
      tags$tr(
        tags$td(model$id %||% ""),
        tags$td(model$label %||% ""),
        tags$td(model$type %||% ""),
        tags$td(model$engine %||% ""),
        tags$td(length(constructs)),
        tags$td(length(paths))
      )
    })
    table_card("Saved models",
      headers = c("ID", "Label", "Type", "Engine", "Constructs", "Paths"),
      rows = rows,
      empty_label = "No saved models.")
  })

  output$model_syntax_output <- renderUI({
    req(rv$instrument)
    models <- rv$instrument$models %||% list()
    if (length(models) == 0) {
      return(NULL)
    }

    cards <- lapply(models, function(model) {
      syntax <- tryCatch(
        switch(model$type %||% "",
          cfa = surveyframe::cfa_lavaan_syntax(instrument = rv$instrument, model = model),
          cb_sem = surveyframe::sem_lavaan_syntax(model, instrument = rv$instrument),
          sem = surveyframe::sem_lavaan_syntax(model, instrument = rv$instrument),
          pls_sem = surveyframe::seminr_syntax(model),
          "Syntax preview is not available for this model type."
        ),
        error = function(e) paste("Syntax preview could not be generated:", conditionMessage(e))
      )
      json <- tryCatch(
        surveyframe::model_json(model, pretty = TRUE),
        error = function(e) paste("Model JSON could not be generated:", conditionMessage(e))
      )
      tags$div(class = "card",
        tags$div(class = "card-title", model$label %||% model$id %||% "Saved model"),
        tags$p(class = "hint", paste("Type:", model$type %||% "", "| Engine:", model$engine %||% "")),
        tags$h4("Syntax"),
        tags$pre(class = "sf-code", syntax),
        tags$h4("Model JSON"),
        tags$pre(class = "sf-code", json)
      )
    })
    do.call(tagList, cards)
  })

  output$dashboard_gate <- renderUI({
    if (is.null(rv$instrument)) {
      return(tags$div(class = "card",
        "Load or build an instrument before opening the dashboard."))
    }
    if (is.null(rv$responses)) {
      return(tags$div(class = "card",
        "Load responses before opening a response dashboard."))
    }
    NULL
  })

  # Inline response dashboard, ported from launch_dashboard() and wired to the
  # studio's reactive instrument and responses (base-R charts, no new imports).
  dash_theme <- "#16B3B1"
  dash_q_items <- reactive({
    Filter(function(i) !(i$type %in% c("section_break", "text_block")),
           rv$instrument$items %||% list())
  })
  dash_find <- function(components, id) {
    for (cp in components %||% list()) if (identical(cp$id, id)) return(cp)
    NULL
  }

  output$studio_dashboard_content <- renderUI({
    req(rv$instrument)
    if (is.null(rv$responses)) return(NULL)
    view <- input$dashboard_view %||% "Overview"
    resp <- rv$responses
    instr <- rv$instrument

    if (identical(view, "Overview")) {
      date_range <- "Not available"
      if ("submitted_at" %in% names(resp)) {
        dts <- suppressWarnings(as.Date(substr(as.character(resp$submitted_at), 1, 10)))
        dts <- dts[!is.na(dts)]
        if (length(dts) > 1) {
          date_range <- paste0(format(min(dts), "%d %b"), " to ",
                               format(max(dts), "%d %b %Y"))
        }
      }
      kpi <- function(v, l) tags$div(class = "stat-box",
        tags$div(class = "stat-val", v), tags$div(class = "stat-lbl", l))
      return(tagList(
        tags$div(class = "stat-row",
          kpi(nrow(resp), "Responses"),
          kpi(length(dash_q_items()), "Items"),
          kpi(length(instr$scales %||% list()), "Scales"),
          kpi(length(instr$checks %||% list()), "Checks"),
          kpi(date_range, "Date range")
        ),
        tags$div(class = "card",
          tags$div(class = "card-title", "Instrument summary"),
          tags$p(class = "hint", paste0(
            "Title: ", instr$meta$title %||% "Untitled",
            "  |  Version: ", instr$meta$version %||% "Not available",
            "  |  Mode: ", instr$render$mode %||% "standard"))
        )
      ))
    }

    if (identical(view, "Items")) {
      qi <- dash_q_items()
      if (!length(qi)) return(tags$div(class = "card", "No question items."))
      ch <- stats::setNames(
        vapply(qi, `[[`, character(1), "id"),
        vapply(qi, function(i) paste0(i$id, ": ", substr(i$label %||% "", 1, 40)),
               character(1)))
      return(tagList(
        selectInput("dash_item_sel", "Select item", choices = ch, width = "420px"),
        tags$div(class = "card",
          tags$div(class = "card-title", "Response distribution"),
          shiny::plotOutput("studio_item_chart", height = "300px")),
        uiOutput("studio_item_table")
      ))
    }

    if (identical(view, "Scales")) {
      scs <- instr$scales %||% list()
      if (!length(scs)) return(tags$div(class = "card", "No scales defined."))
      ch <- stats::setNames(
        vapply(scs, `[[`, character(1), "id"),
        vapply(scs, function(s) paste0(s$id, ": ", s$label), character(1)))
      def_rows <- lapply(scs, function(s) {
        tags$tr(
          tags$td(s$id),
          tags$td(s$label %||% ""),
          tags$td(s$method %||% s$scoring %||% "mean"),
          tags$td(paste(s$items, collapse = ", ")),
          tags$td(paste(s$reverse %||% character(0), collapse = ", "))
        )
      })
      return(tagList(
        selectInput("dash_scale_sel", "Select scale", choices = ch, width = "380px"),
        tags$div(class = "card",
          tags$div(class = "card-title", "Scale score distribution"),
          shiny::plotOutput("studio_scale_chart", height = "280px")),
        if (length(scs) >= 2) {
          tags$div(class = "card",
            tags$div(class = "card-title", "Scale score correlations"),
            shiny::plotOutput("studio_scale_cor_chart", height = "320px"))
        },
        table_card("Scale definitions",
          headers = c("ID", "Label", "Method", "Items", "Reverse items"),
          rows = def_rows, empty_label = "No scales defined.")
      ))
    }

    tags$div(class = "card",
      tags$div(class = "card-title", "Raw responses"),
      downloadButton("dash_dl_csv", "Download CSV", class = "btn-outline"),
      tags$p(class = "hint", paste0("Showing the first 200 of ", nrow(resp), " rows.")),
      tags$div(style = "overflow-x:auto", shiny::tableOutput("studio_raw_table"))
    )
  })

  output$studio_item_chart <- shiny::renderPlot({
    req(rv$instrument, rv$responses, input$dash_item_sel)
    resp <- rv$responses
    item <- dash_find(rv$instrument$items, input$dash_item_sel)
    if (is.null(item) || !input$dash_item_sel %in% names(resp)) {
      plot.new(); text(.5, .5, "No data for this item.", col = "#94a3b8"); return()
    }
    col_data <- resp[[input$dash_item_sel]]
    t <- item$type
    cs <- dash_find(rv$instrument$choices, item$choice_set %||% "")
    gg <- tryCatch(sframe_plot_item_chart(item, col_data, cs), error = function(e) NULL)
    if (!is.null(gg)) { print(gg); return() }
    op <- par(mar = c(4, 9, 2, 1), bg = "white"); on.exit(par(op))
    if (t %in% c("likert", "single_choice", "multiple_choice")) {
      if (!is.null(cs)) {
        freq <- table(factor(col_data, levels = as.character(cs$values)))
        names(freq) <- cs$labels
      } else {
        freq <- table(col_data)
      }
      barplot(freq, horiz = TRUE, las = 1, col = dash_theme, border = NA,
              xlab = "Frequency", cex.names = .8, cex.axis = .8)
    } else if (t %in% c("numeric", "slider", "rating")) {
      num <- suppressWarnings(as.numeric(col_data)); num <- num[!is.na(num)]
      if (!length(num)) { plot.new(); text(.5, .5, "No numeric data."); return() }
      hist(num, col = dash_theme, border = "white", main = NULL,
           xlab = item$label, ylab = "Count", las = 1, cex.axis = .8)
    } else {
      plot.new()
      text(.5, .5, paste0("Chart unavailable for type '", t, "'."), col = "#94a3b8")
    }
  }, bg = "white")
  shiny::outputOptions(output, "studio_item_chart", suspendWhenHidden = FALSE)

  output$studio_item_table <- renderUI({
    req(rv$instrument, rv$responses, input$dash_item_sel)
    resp <- rv$responses
    item <- dash_find(rv$instrument$items, input$dash_item_sel)
    if (is.null(item) || !input$dash_item_sel %in% names(resp)) return(NULL)
    col_data <- resp[[input$dash_item_sel]]
    if (item$type %in% c("likert", "single_choice", "multiple_choice")) {
      cs <- dash_find(rv$instrument$choices, item$choice_set %||% "")
      if (!is.null(cs)) {
        freq <- table(factor(col_data, levels = as.character(cs$values)))
        labs <- cs$labels
        vals <- as.character(cs$values)
      } else {
        freq <- table(col_data); labs <- names(freq); vals <- names(freq)
      }
      tot <- sum(freq)
      rows <- lapply(seq_along(freq), function(i) tags$tr(
        tags$td(vals[i]), tags$td(labs[i]), tags$td(as.integer(freq[i])),
        tags$td(if (tot > 0) sprintf("%.1f%%", 100 * freq[i] / tot) else "0%")
      ))
      table_card("Frequency counts",
        headers = c("Value", "Label", "Count", "Percent"),
        rows = rows, empty_label = "No responses.")
    } else if (item$type %in% c("numeric", "slider", "rating")) {
      num <- suppressWarnings(as.numeric(col_data)); num <- num[!is.na(num)]
      if (!length(num)) return(NULL)
      rows <- list(tags$tr(
        tags$td(length(num)), tags$td(round(mean(num), 2)), tags$td(round(stats::sd(num), 2)),
        tags$td(round(min(num), 2)), tags$td(round(stats::median(num), 2)), tags$td(round(max(num), 2))
      ))
      table_card("Summary statistics",
        headers = c("N", "Mean", "SD", "Min", "Median", "Max"),
        rows = rows, empty_label = "No numeric data.")
    } else {
      NULL
    }
  })
  shiny::outputOptions(output, "studio_item_table", suspendWhenHidden = FALSE)

  output$studio_scale_chart <- shiny::renderPlot({
    req(rv$instrument, rv$responses, input$dash_scale_sel)
    resp <- rv$responses
    sc <- dash_find(rv$instrument$scales, input$dash_scale_sel)
    if (is.null(sc)) return()
    cols <- intersect(sc$items, names(resp))
    if (!length(cols)) {
      plot.new(); text(.5, .5, "Scale items not in responses.", col = "#94a3b8"); return()
    }
    nums <- lapply(resp[cols], function(x) suppressWarnings(as.numeric(x)))
    scores <- rowMeans(do.call(cbind, nums), na.rm = TRUE); scores <- scores[!is.na(scores)]
    if (!length(scores)) {
      plot.new(); text(.5, .5, "No valid scale scores.", col = "#94a3b8"); return()
    }
    gg <- tryCatch(sframe_plot_scale_chart(scores, sc$label), error = function(e) NULL)
    if (!is.null(gg)) { print(gg); return() }
    op <- par(mar = c(4, 4, 2, 1), bg = "white"); on.exit(par(op))
    hist(scores, col = dash_theme, border = "white", main = NULL,
         xlab = paste0(sc$label, " score"), ylab = "Count", las = 1, cex.axis = .8)
    abline(v = mean(scores), col = "#dc2626", lwd = 2, lty = 2)
  }, bg = "white")
  shiny::outputOptions(output, "studio_scale_chart", suspendWhenHidden = FALSE)

  output$studio_raw_table <- shiny::renderTable({
    req(rv$responses)
    head(rv$responses, 200)
  }, striped = TRUE, hover = TRUE, bordered = FALSE, width = "100%", na = "")

  output$dash_dl_csv <- downloadHandler(
    filename = function() {
      paste0(gsub("[^a-zA-Z0-9]", "_", rv$instrument$meta$title %||% "survey"),
             "_responses.csv")
    },
    content = function(file) {
      utils::write.csv(rv$responses, file, row.names = FALSE, na = "")
    }
  )

  output$export_gate <- renderUI({
    if (is.null(rv$instrument)) {
      tags$div(class = "card",
        "Build or open a valid instrument before exporting files.")
    }
  })

  # A non-clickable placeholder shown when an export is not yet possible, so the
  # user cannot trigger a download that would error.
  export_disabled_btn <- function(label, hint) {
    tagList(
      tags$button(type = "button", class = "btn btn-primary", disabled = NA,
        style = "opacity: .5; cursor: not-allowed;",
        shiny::icon("download"), " ", label),
      tags$p(class = "hint", hint)
    )
  }

  output$export_sframe_ui <- renderUI({
    if (isTRUE(draft_result()$valid)) {
      downloadButton("download_sframe_btn", "Download .sframe", class = "btn-primary")
    } else {
      export_disabled_btn(
        "Download .sframe",
        "Open or build a valid instrument before downloading the .sframe file.")
    }
  })

  output$export_report_ui <- renderUI({
    if (!is.null(rv$instrument)) {
      downloadButton("download_report_btn", "Generate HTML report", class = "btn-primary")
    } else {
      export_disabled_btn(
        "Generate HTML report",
        "Open or build a valid instrument before generating the report.")
    }
  })

  output$download_sframe_btn <- downloadHandler(
    filename = function() {
      title <- draft_result()$instrument$meta$title %||% "survey"
      paste0(gsub("[^a-zA-Z0-9]", "_", title), ".sframe")
    },
    content = function(file) {
      draft <- draft_result()
      if (!draft$valid) {
        stop("Draft validation must pass before exporting a .sframe file.")
      }
      tmp <- tempfile(fileext = ".sframe")
      surveyframe::write_sframe(draft$instrument, tmp, overwrite = TRUE)
      file.copy(tmp, file, overwrite = TRUE)
    }
  )

  # The Interpretations card is a JASP/JAMOVI-style output canvas: every
  # research question is one self-contained block in reading order (badges,
  # the APA line, the numbers table, the chart), the planned decision rule
  # sits directly above the box where you write the interpretation that
  # answers it, and a "Copy result" button gets one output out without
  # generating a whole report. This is the single place to read a result and
  # write about it, rather than switching between the Run stage (which has
  # the chart but no writing box) and a text-only interpretation list.
  output$export_interpretations_ui <- renderUI({
    req(rv$instrument)
    plan <- rv$instrument$analysis_plan %||% list()
    if (length(plan) == 0) {
      return(tags$p(class = "hint",
        "Save analysis plans on the Analyse screen to add interpretations."))
    }
    results <- NULL
    all_plot_tags <- list()
    if (!is.null(rv$responses)) {
      results <- analysis_results_r()
      if (inherits(results, "error")) {
        results <- NULL
      } else {
        all_plot_tags <- analysis_result_plot_tags_r()
      }
    }
    result_block_ids <- if (!is.null(results)) {
      vapply(results, function(r) r$block_id %||% "", character(1))
    } else {
      character(0)
    }
    fields <- lapply(seq_along(plan), function(i) {
      block <- plan[[i]]
      block_id <- block$id %||% ""
      fld <- studio_interp_input_id(i, block_id)
      result <- NULL
      plot_tags <- list()
      hit_idx <- match(block_id, result_block_ids)
      if (!is.na(hit_idx)) {
        result <- results[[hit_idx]]
        plot_tags <- all_plot_tags[[hit_idx]] %||% list()
      }
      tags$div(class = "card result-canvas-block",
        tags$div(class = "card-title", sprintf("RQ %d: %s", i, block_id)),
        tags$p(block$research_question %||% ""),
        tags$div(
          tags$span(class = "vbadge", block$method %||% block$test %||% ""),
          if (!is.null(result) && !is.null(result$effect_label)) {
            tags$span(class = "vbadge", paste(result$effect_label, "effect"))
          }
        ),
        if (is.null(result)) {
          tags$p(class = "hint",
            "Upload response data to see the result while you write.")
        } else if (!is.null(result$error)) {
          tags$p(class = "hint", paste("Error:", result$error))
        } else {
          tagList(
            tags$p(tags$strong("Result: "), result$apa %||% ""),
            studio_result_table_tag(result$table),
            if (!is.null(result$syntax)) tags$pre(class = "sf-code", result$syntax),
            do.call(tagList, plot_tags)
          )
        },
        studio_copy_result_btn(),
        if (nzchar(block$decision_rule %||% "")) {
          tags$p(class = "hint",
            paste("Planned decision rule:", block$decision_rule))
        },
        tags$label(class = "vmeta-lbl", "Interpretation"),
        textAreaInput(fld, NULL,
          value = shiny::isolate(input[[fld]] %||% ""),
          rows = 8, width = "100%",
          placeholder = "State what this result means for the research question.")
      )
    })
    do.call(tagList, fields)
  })

  # Collect the non-empty Export-screen interpretation fields as the named
  # list render_report() expects, keyed by plan block id.
  studio_collect_interpretations <- function() {
    plan <- rv$instrument$analysis_plan %||% list()
    out <- list()
    for (i in seq_along(plan)) {
      block_id <- plan[[i]]$id %||% ""
      if (!nzchar(block_id)) next
      text <- trim_or_null(input[[studio_interp_input_id(i, block_id)]])
      if (!is.null(text)) {
        out[[block_id]] <- text
      }
    }
    if (length(out) > 0) out else NULL
  }

  output$download_report_btn <- downloadHandler(
    filename = function() {
      paste0(
        gsub("[^a-zA-Z0-9]", "_", (rv$instrument$meta$title %||% "survey")),
        "_report.html"
      )
    },
    content = function(file) {
      tryCatch({
        surveyframe::render_report(
          instrument = rv$instrument,
          data = rv$responses,
          output_file = file,
          include_codebook = isTRUE(input$rpt_codebook),
          include_quality = isTRUE(input$rpt_quality),
          include_missing = isTRUE(input$rpt_missing),
          include_descriptives = isTRUE(input$rpt_descriptives),
          include_reliability = isTRUE(input$rpt_reliability),
          include_analysis = isTRUE(input$rpt_analysis),
          include_models = isTRUE(input$rpt_models),
          plot_palette = input$rpt_palette %||% "web",
          interpretations = studio_collect_interpretations()
        )
      }, error = function(e) {
        showNotification(paste("Report error:", conditionMessage(e)), type = "error")
      })
    }
  )

  # Screens are shown and hidden with custom CSS classes, so Shiny would suspend
  # the content outputs inside hidden screens and not always wake them on switch.
  # Keep the per-screen content outputs evaluated so every tab renders reliably.
  for (.oid in c(
    "instrument_summary_card", "survey_preview_items", "responses_summary_card",
    "quality_output", "reliability_output",
    "studio_quality_chart", "studio_reliability_chart",
    "studio_missing_chart", "studio_scale_cor_chart",
    "analysis_left_panel", "analysis_middle_panel", "analysis_right_panel",
    "analysis_results_output", "studio_dashboard_content",
    "export_sframe_ui", "export_report_ui", "export_interpretations_ui",
    "download_sframe_btn", "download_report_btn"
  )) {
    shiny::outputOptions(output, .oid, suspendWhenHidden = FALSE)
  }
}

shinyApp(ui = ui, server = server)
