Nothing
# Step 3 CSV branch server logic (spec §11.3–11.4)
sniff_csv_file <- function(path, threshold = 0.90) {
tryCatch({
lines <- readLines(path, n = 100, warn = FALSE)
lines <- lines[nchar(trimws(lines)) > 0]
if (length(lines) < 1) return(NULL)
candidates <- c(",", "\t", ";", "|", ":")
best_delim <- ","
best_score <- 0
for (d in candidates) {
counts <- vapply(lines, function(l) length(strsplit(l, d, fixed = TRUE)[[1]]), integer(1))
n_cols <- stats::median(counts)
if (n_cols > 1) {
score <- (n_cols - 1) * mean(counts == n_cols)
if (score > best_score) { best_score <- score; best_delim <- d }
}
}
first_fields <- strsplit(lines[1], best_delim, fixed = TRUE)[[1]]
has_header <- all(is.na(suppressWarnings(as.numeric(trimws(first_fields)))))
df <- readr::read_delim(path, delim = best_delim,
col_names = has_header,
col_types = readr::cols(.default = "c"),
n_max = 500, show_col_types = FALSE)
list(delimiter = best_delim,
has_header = has_header,
col_names = names(df),
col_types = vapply(df, infer_col_type_simple, character(1),
threshold = threshold))
}, error = function(e) list(sniff_error = conditionMessage(e)))
}
# Full-file encoding sniff. "Is this valid UTF-8?" is decidable by scanning
# every byte (pure ASCII passes: it is a UTF-8 subset), so that answer is
# returned as certain and auto-applied. Which legacy encoding a non-UTF-8
# file uses is only ever a statistical guess — those candidates carry
# confidence labels and go through the normal sniff-conflict flow. A head
# sample is never trusted for this: the file that motivated this scan had its
# first accented byte ~4M rows in, and readr::guess_encoding()'s head sample
# confidently reported "ASCII".
# Trailing bytes of `buf` that may be an incomplete multi-byte UTF-8 sequence
# continuing in the next chunk — they must be held back rather than validated at
# a chunk boundary, or a valid sequence split across chunks would false-negative
# the validity check. Returns 0 unless the buffer ends with a genuinely
# incomplete lead+continuation run. Mirrors dqcheckr's .utf8_incomplete_tail
# (kept in sync so the wizard preview matches the run-time scan).
.utf8_incomplete_tail <- function(buf) {
n <- length(buf)
if (n == 0L) return(0L)
i <- n; cont <- 0L
while (i >= 1L && cont < 3L && bitwAnd(as.integer(buf[i]), 0xC0L) == 0x80L) {
cont <- cont + 1L; i <- i - 1L
}
if (i < 1L) return(0L) # only continuation bytes: malformed
lead <- as.integer(buf[i])
need <- if (bitwAnd(lead, 0x80L) == 0x00L) 1L
else if (bitwAnd(lead, 0xE0L) == 0xC0L) 2L
else if (bitwAnd(lead, 0xF0L) == 0xE0L) 3L
else if (bitwAnd(lead, 0xF8L) == 0xF0L) 4L
else 1L
have <- cont + 1L
if (need > 1L && have < need) have else 0L
}
# Statistically guess the legacy encoding of a buffer known to contain non-ASCII
# bytes: locate the first 1MB window with a byte > 127 and run ICU's detector.
# Chunking the search is safe because "contains a byte above 127" is a per-byte
# property (unlike UTF-8 sequence validity).
.guess_legacy_candidates <- function(raw) {
window <- NULL; chunk <- 1e6; start <- 1; n <- length(raw)
while (start <= n) {
end <- min(start + chunk - 1, n); piece <- raw[start:end]
if (!stringi::stri_enc_isascii(piece)) { window <- piece; break }
start <- end + 1
}
cand <- NULL
if (!is.null(window)) {
det <- tryCatch(stringi::stri_enc_detect(window)[[1]], error = function(e) NULL)
if (!is.null(det) && nrow(det) > 0) {
# Drop Unicode candidates the detector may offer for a locally-valid
# window (the whole file already failed UTF-8), and NA-encoding rows that
# would otherwise propagate as top = NA and crash the step-3 observer.
det <- det[!is.na(det$Encoding) &
!grepl("^UTF", det$Encoding, ignore.case = TRUE), , drop = FALSE]
if (nrow(det) > 0) {
k <- seq_len(min(3, nrow(det)))
cand <- setNames(det$Encoding[k],
sprintf("%s (%.0f%%)", det$Encoding[k], det$Confidence[k] * 100))
}
}
}
if (is.null(cand)) cand <- c("ISO-8859-1" = "ISO-8859-1")
cand
}
sniff_file_encoding <- function(path, chunk_size = 64L * 1024L * 1024L) {
size <- suppressWarnings(file.size(path))
if (is.na(size) || size <= 0)
return(list(top = "UTF-8", certain = TRUE, candidates = c("UTF-8" = "UTF-8")))
# Stream the file in bounded chunks rather than reading it into one raw vector
# the full size of the file: a multi-GB delivery would otherwise block the
# single-threaded reactive session and risk OOM (B-10). A head-sample shortcut
# is unsafe — the first invalid/accented byte can sit arbitrarily deep (the
# exact trap this scan exists to catch), so the whole file is still verified.
con <- file(path, open = "rb")
on.exit(close(con), add = TRUE)
carry <- raw(0)
repeat {
chunk <- readBin(con, what = "raw", n = chunk_size)
if (length(chunk) == 0L) break
buf <- if (length(carry) > 0L) c(carry, chunk) else chunk
tail_n <- .utf8_incomplete_tail(buf)
head_n <- length(buf) - tail_n
head_bytes <- if (head_n > 0L) buf[seq_len(head_n)] else raw(0)
carry <- if (tail_n > 0L) buf[seq.int(head_n + 1L, length(buf))] else raw(0)
if (length(head_bytes) > 0L && !stringi::stri_enc_isutf8(head_bytes)) {
cand <- .guess_legacy_candidates(head_bytes)
return(list(top = cand[[1]], certain = FALSE, candidates = cand))
}
}
# Bytes still held at EOF are a multi-byte sequence truncated by the file end.
if (length(carry) > 0L && !stringi::stri_enc_isutf8(carry)) {
cand <- .guess_legacy_candidates(carry)
return(list(top = cand[[1]], certain = FALSE, candidates = cand))
}
list(top = "UTF-8", certain = TRUE,
candidates = c("UTF-8 (validated, whole file)" = "UTF-8"))
}
load_raw_preview <- function(session, path, wiz) {
lines <- tryCatch(
readLines(path, n=50, warn=FALSE, encoding="bytes"),
error=function(e) paste("Could not read file:", e$message)
)
wiz$raw_lines <- lines
shinyAce::updateAceEditor(session, "raw_preview",
value=paste(lines, collapse="\n"))
# Update ruler (guard: max(numeric(0)) is -Inf with a warning on empty files)
lines_ok <- lines[!is.na(lines)]
max_chars <- if (length(lines_ok) > 0) max(nchar(lines_ok)) else 40L
max_chars <- min(max(max_chars, 40), 200)
ruler_str <- make_ruler_string(max_chars)
wiz$ruler_string <- ruler_str
}
server_step3_csv <- function(input, output, session, wiz, gcfg_rv) {
# CSV fields shown/hidden
output$step3_csv_fields <- renderUI({
req(input$wiz_format == "csv")
# A delimiter/quote loaded from a saved config may sit outside the fixed
# choice list (the wizard's own "Other" delimiter, or a hand-authored
# config). A plain <select> whose `selected` is absent from `choices`
# silently falls back to its first option, and the input observer then
# overwrites wiz$ with that wrong default on edit-reopen (B-01). So map a
# non-standard delimiter to the "Other" branch, and widen the quote choices
# to include whatever was loaded, so the real value round-trips visibly.
std_delims <- c(",", "\t", ";", "|", " ", ":")
cur_delim <- wiz$delimiter %||% ","
delim_sel <- if (cur_delim %in% std_delims) cur_delim else "other"
quote_choices <- c('Double quote "'='"', "Single quote '"="'", "None"="")
cur_quote <- wiz$quote_char %||% '"'
if (!(cur_quote %in% quote_choices))
quote_choices <- c(quote_choices,
setNames(cur_quote, sprintf("Custom (%s)", cur_quote)))
tagList(
fluidRow(
column(3,
selectInput("wiz_delimiter", "Delimiter",
choices=c("Comma (,)"=",", "Tab"="\t", "Semicolon (;)"=";",
"Pipe (|)"="|", "Space"=" ", "Colon (:)"=":",
"Other"="other"),
selected=delim_sel)
),
column(3,
uiOutput("step3_other_delimiter")
),
column(3,
selectInput("wiz_encoding", "Encoding",
choices=wiz$encoding_choices %||% c("UTF-8","ISO-8859-1","Windows-1252","UTF-16LE","CP1250"),
selected=wiz$encoding %||% "UTF-8")
),
column(3,
selectInput("wiz_quote_char", "Quote character",
choices=quote_choices,
selected=cur_quote)
)
),
fluidRow(
column(6,
radioButtons("wiz_has_header", "First row",
choices=c("Contains column headers"=TRUE, "Is data — no headers"=FALSE),
selected=as.character(isTRUE(wiz$has_header %||% TRUE)))
)
),
div(class="mt-2",
actionButton("step3_preview_btn", "Preview with these settings",
class="btn btn-outline-primary btn-sm")
)
)
})
output$step3_other_delimiter <- renderUI({
req(input$wiz_delimiter == "other")
# Pre-fill with the loaded custom delimiter on edit-reopen so it survives
# the round-trip (B-01); empty for a fresh "Other" selection.
std_delims <- c(",", "\t", ";", "|", " ", ":")
cur <- isolate(wiz$delimiter)
val <- if (!is.null(cur) && !(cur %in% std_delims)) cur else ""
textInput("wiz_delimiter_custom", "Custom:", value=val, width="80px")
})
output$step3_fwf_fields <- renderUI({
req(input$wiz_format == "fwf")
tagList(
fluidRow(
column(4,
numericInput("wiz_fwf_skip", "Header rows to skip",
value=wiz$fwf_skip %||% 0L, min=0, max=10, step=1)
),
column(8,
actionButton("step3_fwf_autodetect", "Auto-detect boundaries",
class="btn btn-outline-secondary btn-sm mt-4"),
p(class="text-muted mt-1", style="font-size:11px;",
"Works best when columns are space-separated. For tightly packed files, click on the text above to place boundaries.")
)
),
uiOutput("fwf_col_def_table"),
uiOutput("fwf_record_length_badge")
)
})
# Format hint below raw preview
output$step3_format_hint <- renderUI({
if (isTRUE(input$wiz_format == "fwf")) {
div(class="alert alert-info p-2 mt-1", style="font-size:12px;",
"Click on the text above to add a column boundary. Drag a boundary to move it. Double-click a boundary to remove it.",
br(),
"The character position is shown in the bottom-right of the preview.")
}
})
# Auto-run sniff when file loaded.
# New mode: auto-apply sniffed values (no config to preserve).
# Edit mode: compare sniffed vs config-loaded; surface conflicts at step 3 without
# overwriting. The user decides per-field whether to keep the config value or adopt
# the detected one.
observe({
req(length(wiz$raw_lines) > 0)
path <- wiz$current_preview_path
req(nchar(path %||% "") > 0)
sniff <- sniff_csv_file(path, wiz_type_threshold(wiz, gcfg_rv()))
# A failed sniff must not fail silently (twin of the FWF auto-detect
# notification): the user picked a CSV and expects delimiter/header/columns
# to populate. sniff_csv_file marks a caught error with $sniff_error.
if (!is.null(sniff) && !is.null(sniff$sniff_error)) {
showNotification(
paste("Could not analyse the CSV file:", sniff$sniff_error),
type = "error", duration = 10)
sniff <- NULL
}
if (!is.null(sniff) && !is.null(sniff$col_names)) {
wiz$sniff_col_names <- sniff$col_names
wiz$sniff_col_types <- sniff$col_types
}
enc_sniff <- tryCatch(sniff_file_encoding(path), error = function(e) {
showNotification(
paste("Could not detect the file encoding:", conditionMessage(e)),
type = "warning", duration = 8)
NULL
})
top_enc <- NULL
enc_choices <- NULL
if (!is.null(enc_sniff)) {
top_enc <- enc_sniff$top
enc_choices <- unique(c(
enc_sniff$candidates,
c("UTF-8" = "UTF-8", "ISO-8859-1" = "ISO-8859-1",
"Windows-1252" = "Windows-1252", "UTF-16LE" = "UTF-16LE", "CP1250" = "CP1250")
))
wiz$encoding_choices <- enc_choices
}
if (isTRUE(wiz$mode == "edit")) {
conflicts <- list()
if (!is.null(sniff) && isTRUE(wiz$format == "csv")) {
detected_delim <- sniff$delimiter %||% ","
if (detected_delim %in% c(",", "\t", ";", "|", " ", ":") &&
detected_delim != (wiz$delimiter %||% ",")) {
conflicts[["delimiter"]] <- list(
field = "delimiter",
config_val = wiz$delimiter %||% ",",
sniffed_val = detected_delim,
label = "Delimiter"
)
}
sniff_hdr <- isTRUE(sniff$has_header)
if (sniff_hdr != isTRUE(wiz$has_header)) {
conflicts[["has_header"]] <- list(
field = "has_header",
config_val = isTRUE(wiz$has_header),
sniffed_val = sniff_hdr,
label = "Header row"
)
}
}
if (!is.null(top_enc) && top_enc != (wiz$encoding %||% "UTF-8")) {
conflicts[["encoding"]] <- list(
field = "encoding",
config_val = wiz$encoding %||% "UTF-8",
sniffed_val = top_enc,
label = "Encoding"
)
}
if (!is.null(enc_choices))
updateSelectInput(session, "wiz_encoding",
choices = enc_choices,
selected = wiz$encoding %||% "UTF-8")
wiz$sniff_conflicts <- conflicts
} else {
if (!is.null(sniff)) {
detected_delim <- sniff$delimiter %||% ","
if (detected_delim %in% c(",", "\t", ";", "|", " ", ":")) {
updateSelectInput(session, "wiz_delimiter", selected = detected_delim)
wiz$delimiter <- detected_delim
}
has_hdr <- isTRUE(sniff$has_header)
updateRadioButtons(session, "wiz_has_header", selected = as.character(has_hdr))
wiz$has_header <- has_hdr
}
if (!is.null(enc_choices) && !is.null(top_enc)) {
updateSelectInput(session, "wiz_encoding", choices = enc_choices, selected = top_enc)
wiz$encoding <- top_enc
}
}
})
# Conflict banner — shown at step 3 in edit mode when sniffed values differ from config
output$step3_sniff_conflicts <- renderUI({
conflicts <- wiz$sniff_conflicts
if (length(conflicts) == 0) return(NULL)
fmt_val <- function(field, val) {
if (field == "has_header") {
if (isTRUE(val)) "has header row" else "no header row"
} else {
as.character(val)
}
}
panels <- lapply(conflicts, function(cf) {
div(class = "alert alert-warning p-2 mb-2", style = "font-size:12px;",
tags$strong(paste0(cf$label, " mismatch — ")),
sprintf("config says \"%s\", file looks like \"%s\".",
fmt_val(cf$field, cf$config_val),
fmt_val(cf$field, cf$sniffed_val)),
div(class = "mt-1 d-flex gap-2",
actionButton(paste0("sniff_keep_", cf$field),
paste0("Keep config: ", fmt_val(cf$field, cf$config_val)),
class = "btn btn-outline-secondary btn-sm",
style = "font-size:11px; padding:2px 8px;"),
actionButton(paste0("sniff_use_", cf$field),
paste0("Use detected: ", fmt_val(cf$field, cf$sniffed_val)),
class = "btn btn-outline-primary btn-sm",
style = "font-size:11px; padding:2px 8px;")
)
)
})
tagList(panels)
})
# Dismiss conflict — keep config value
observeEvent(input$sniff_keep_delimiter, {
cf <- wiz$sniff_conflicts; cf[["delimiter"]] <- NULL; wiz$sniff_conflicts <- cf
})
observeEvent(input$sniff_keep_has_header, {
cf <- wiz$sniff_conflicts; cf[["has_header"]] <- NULL; wiz$sniff_conflicts <- cf
})
observeEvent(input$sniff_keep_encoding, {
cf <- wiz$sniff_conflicts; cf[["encoding"]] <- NULL; wiz$sniff_conflicts <- cf
})
# Accept detected value and dismiss
observeEvent(input$sniff_use_delimiter, {
cf <- wiz$sniff_conflicts[["delimiter"]]; req(!is.null(cf))
wiz$delimiter <- cf$sniffed_val
updateSelectInput(session, "wiz_delimiter", selected = cf$sniffed_val)
cfs <- wiz$sniff_conflicts; cfs[["delimiter"]] <- NULL; wiz$sniff_conflicts <- cfs
})
observeEvent(input$sniff_use_has_header, {
cf <- wiz$sniff_conflicts[["has_header"]]; req(!is.null(cf))
v <- isTRUE(cf$sniffed_val)
wiz$has_header <- v
updateRadioButtons(session, "wiz_has_header", selected = as.character(v))
cfs <- wiz$sniff_conflicts; cfs[["has_header"]] <- NULL; wiz$sniff_conflicts <- cfs
})
observeEvent(input$sniff_use_encoding, {
cf <- wiz$sniff_conflicts[["encoding"]]; req(!is.null(cf))
wiz$encoding <- cf$sniffed_val
updateSelectInput(session, "wiz_encoding", selected = cf$sniffed_val)
cfs <- wiz$sniff_conflicts; cfs[["encoding"]] <- NULL; wiz$sniff_conflicts <- cfs
})
# Update wiz from inputs
observeEvent(input$wiz_format, { wiz$format <- input$wiz_format
if (input$wiz_format == "fwf") session$sendCustomMessage("fwf_ruler_activate", list())
else session$sendCustomMessage("fwf_ruler_deactivate", list()) })
# On "Other" with an empty/not-yet-rendered custom field, keep the existing
# wiz$delimiter instead of clobbering it to "," — otherwise a loaded custom
# delimiter is lost on the observer's init fire before the text box renders
# (B-01). isolate() avoids a write-read reactive loop on wiz$delimiter.
observeEvent(input$wiz_delimiter, { wiz$delimiter <- if(input$wiz_delimiter=="other") input$wiz_delimiter_custom %||% isolate(wiz$delimiter) %||% "," else input$wiz_delimiter })
observeEvent(input$wiz_delimiter_custom, {
if (isTRUE(input$wiz_delimiter == "other") && nzchar(input$wiz_delimiter_custom %||% ""))
wiz$delimiter <- input$wiz_delimiter_custom
})
observeEvent(input$wiz_encoding, { wiz$encoding <- input$wiz_encoding })
observeEvent(input$wiz_quote_char,{ wiz$quote_char <- input$wiz_quote_char })
observeEvent(input$wiz_has_header,{ wiz$has_header <- isTRUE(as.logical(input$wiz_has_header)) })
observeEvent(input$wiz_fwf_skip, { wiz$fwf_skip <- as.integer(input$wiz_fwf_skip %||% 0) })
# Preview trigger (CSV)
observeEvent(input$step3_preview_btn, {
trigger_csv_preview(input, wiz, wiz_type_threshold(wiz, gcfg_rv()))
})
# Also auto-preview when format is CSV and file is loaded
observe({
req(input$wiz_format == "csv", length(wiz$raw_lines) > 0)
trigger_csv_preview(input, wiz, wiz_type_threshold(wiz, gcfg_rv()))
})
# FWF boundary positions → widths
observeEvent(input$fwf_boundary_positions, {
positions <- sort(unique(c(0L, as.integer(input$fwf_boundary_positions))))
line_len <- max(nchar(wiz$raw_lines[nchar(wiz$raw_lines)>0]), na.rm=TRUE)
if (!is.finite(line_len)) line_len <- 80L
widths <- diff(c(positions, as.integer(line_len)))
widths <- widths[widths > 0]
wiz$fwf_widths <- widths
wiz$fwf_starts <- positions[positions > 0] + 1L
wiz$fwf_line_len <- line_len
})
# FWF auto-detect
observeEvent(input$step3_fwf_autodetect, {
path <- wiz$current_preview_path
req(nchar(path %||% "") > 0)
err <- NULL
result <- tryCatch(
readr::fwf_empty(path, skip=as.integer(input$wiz_fwf_skip %||% 0), n=100),
error=function(e) { err <<- conditionMessage(e); NULL }
)
if (!is.null(result) && nrow(result) > 1) {
# Convert to 0-based char positions (boundary starts)
positions <- result$begin[-1] # skip the first (=0)
session$sendCustomMessage("fwf_restore_boundaries", list(positions=as.list(positions)))
showNotification(sprintf("Auto-detected %d columns — please verify.", nrow(result)), type="message")
} else if (!is.null(err)) {
# A real read/encoding error must be distinguishable from a legitimately
# ragged file — both used to show the same "no boundaries" message (B-12).
showNotification(paste("Could not analyse the file for boundaries:", err),
type="error", duration=10)
} else {
showNotification("Auto-detection found no boundaries. Set manually using the ruler.", type="warning")
}
})
# FWF column name inputs
output$fwf_col_def_table <- renderUI({
n <- length(wiz$fwf_widths)
if (n == 0) return(p(class="text-muted fst-italic", "No column boundaries set yet. Click on the text preview above."))
seq_no <- isolate(wiz$open_seq)
starts <- c(1L, cumsum(wiz$fwf_widths[-length(wiz$fwf_widths)]) + 1L)
rows <- lapply(seq_len(n), function(i) {
name_id <- wiz_input_id("fwf_col_name", seq_no, i)
type_id <- wiz_input_id("fwf_col_type", seq_no, i)
current_name <- if (i <= length(wiz$fwf_col_names)) wiz$fwf_col_names[i] else paste0("col_", i)
# Restore a previously-saved type (loaded into col_types_override) so
# revisiting Step 3 in edit mode does not reset the selector to "character".
saved_type <- wiz$col_types_override[[current_name]] %||% "character"
if (!saved_type %in% c("character","numeric","date")) saved_type <- "character"
fluidRow(class="mb-1 align-items-center",
column(1, span(class="badge bg-secondary", i)),
column(2, span(class="text-muted", style="font-size:12px;", sprintf("%d–%d", starts[i], starts[i]+wiz$fwf_widths[i]-1L))),
column(2, span(class="text-muted", style="font-size:12px;", paste("w:", wiz$fwf_widths[i]))),
column(4, textInput(name_id, NULL, value=current_name, placeholder=paste0("col_", i))),
column(3, selectInput(type_id, NULL, width="100%",
choices=c("character","numeric","date"), selected=saved_type))
)
})
tagList(
div(class="mt-2 mb-1", tags$strong("Column definitions", style="font-size:13px;")),
div(style="max-height:300px;overflow-y:auto;", rows)
)
})
# Collect FWF column names from inputs
observe({
n <- length(wiz$fwf_widths)
seq_no <- wiz$open_seq
if (n == 0) return()
names_vec <- character(n)
for (i in seq_len(n)) {
v <- input[[wiz_input_id("fwf_col_name", seq_no, i)]]
names_vec[i] <- if (!is.null(v) && nchar(v) > 0) v else paste0("col_", i)
}
wiz$fwf_col_names <- names_vec
})
# Collect FWF column types from inputs
observe({
n <- length(wiz$fwf_widths)
seq_no <- wiz$open_seq
if (n == 0) return()
# Bail until THIS open's Step-3 type inputs have rendered (mirrors the Step-4
# collector). Otherwise the un-rendered inputs read NULL and would overwrite
# col_types_inferred with all-"character", clobbering saved FWF types on an
# edit-mode resave where the user never visited Step 3.
if (is.null(input[[wiz_input_id("fwf_col_type", seq_no, 1)]])) return()
col_names <- wiz$fwf_col_names
types_vec <- character(n)
for (i in seq_len(n)) {
v <- input[[wiz_input_id("fwf_col_type", seq_no, i)]]
types_vec[i] <- if (!is.null(v)) v else "character"
}
names(types_vec) <- if (length(col_names) == n) col_names else paste0("col_", seq_len(n))
wiz$col_types_inferred <- types_vec
})
# FWF record length badge
output$fwf_record_length_badge <- renderUI({
req(length(wiz$fwf_widths) > 0, length(wiz$raw_lines) > 0)
line_len <- max(nchar(wiz$raw_lines[nchar(wiz$raw_lines) > 0]), na.rm=TRUE)
total_width <- sum(wiz$fwf_widths)
if (!is.finite(line_len)) return(NULL)
if (total_width == line_len) {
div(class="alert alert-success p-1 mt-2", style="font-size:12px;",
sprintf("✅ Record length: %d / %d characters", total_width, line_len))
} else if (total_width < line_len) {
div(class="alert alert-warning p-1 mt-2", style="font-size:12px;",
sprintf("⚠ Column definitions cover %d of %d characters — %d characters unaccounted for at end of record.",
total_width, line_len, line_len - total_width))
} else {
div(class="alert alert-danger p-1 mt-2", style="font-size:12px;",
sprintf("✗ Column definitions (%d) exceed actual line length (%d).", total_width, line_len))
}
})
# Column-naming panel. Renders for headerless files (always) and for header
# files whose raw header names are invalid or duplicated (e.g. RBB RefundsPaid
# repeats `PayeeName`). Pre-fills suggestions with an inline reason; fully
# overridable. Input ids are shared across both modes (`csv_name_<i>`).
output$step3_no_header_naming <- renderUI({
req(input$wiz_format == "csv")
has_header <- isTRUE(as.logical(input$wiz_has_header %||% "TRUE"))
cols <- wiz$csv_col_names_detected # reactive trigger: the column SET
if (is.null(cols) || length(cols) == 0) return(NULL)
if (!csv_needs_naming(wiz, has_header)) return(NULL)
# Read the editable values WITHOUT subscribing to them. The collector below
# writes wiz$col_names on every keystroke; if this panel re-rendered on each
# change it would rebuild the DOM mid-edit, resetting the preview's scroll
# position and fighting the cursor. We only want to rebuild when the column
# set itself changes (handled by the reactive reads above). isolate() is the
# wizard's standard tool for exactly this.
isolate({
seq_no <- wiz$open_seq
reasons <- wiz$col_name_reasons
rows <- lapply(seq_along(cols), function(i) {
name_id <- wiz_input_id("csv_name", seq_no, i)
current <- if (i <= length(wiz$col_names)) wiz$col_names[i] else paste0("col_", i)
left <- if (has_header) cols[i] else paste0("col_", i)
hint <- if (length(reasons) >= i && nzchar(reasons[i]))
span(class="text-warning", style="font-size:11px;", paste0("⚠ ", reasons[i]))
else NULL
fluidRow(class="mb-1 align-items-center",
column(3, span(class="text-muted", style="font-size:12px;", paste0(left, " →"))),
column(4, textInput(name_id, NULL, value=current, placeholder=paste0("col_",i), width="100%")),
column(5, hint)
)
})
div(class="p-2 border rounded bg-light mb-3",
tags$strong("Column names", style="font-size:13px;"),
if (has_header)
p(class="text-muted mb-1", style="font-size:11px;",
"Some names in the file's header are invalid or duplicated. Adjust as needed — the original header row will be skipped when the file is read."),
div(style="max-height:240px;overflow-y:auto;", rows)
)
})
})
# Collect names from the editor (runs under the same condition that renders it)
observe({
req(input$wiz_format == "csv")
has_header <- isTRUE(as.logical(input$wiz_has_header %||% "TRUE"))
cols <- wiz$csv_col_names_detected
seq_no <- wiz$open_seq
req(!is.null(cols), length(cols) > 0)
if (!csv_needs_naming(wiz, has_header)) return()
names_vec <- character(length(cols))
for (i in seq_along(cols)) {
v <- input[[wiz_input_id("csv_name", seq_no, i)]]
names_vec[i] <- if (!is.null(v) && nchar(v) > 0) v
else if (i <= length(wiz$col_names)) wiz$col_names[i]
else paste0("col_", i)
}
wiz$col_names <- names_vec
})
# Parsed preview (CSV)
output$step3_parsed_preview <- renderUI({
req(input$wiz_format == "csv", !is.null(wiz$csv_preview_df))
reactable::reactableOutput("step3_reactable_preview")
})
output$step3_reactable_preview <- reactable::renderReactable({
req(!is.null(wiz$csv_preview_df))
df <- wiz$csv_preview_df
reactable::reactable(df,
resizable=TRUE, wrap=FALSE, fullWidth=TRUE,
defaultPageSize=20, striped=TRUE, highlight=TRUE,
style=list(fontSize="12px"))
})
# FWF parsed preview
observe({
req(input$wiz_format == "fwf",
length(wiz$fwf_widths) > 0,
length(wiz$fwf_col_names) > 0,
nchar(wiz$current_preview_path %||% "") > 0)
path <- wiz$current_preview_path
tryCatch({
df <- readr::read_fwf(path,
col_positions=readr::fwf_widths(wiz$fwf_widths, wiz$fwf_col_names),
col_types=readr::cols(.default="c"),
n_max=20,
skip=as.integer(wiz$fwf_skip %||% 0),
locale=readr::locale(encoding=wiz$encoding %||% "UTF-8"))
wiz$fwf_preview_df <- as.data.frame(df)
}, error=function(e) {
# Surface the parse failure inline instead of silently blanking the
# preview (the panel is gated on !is.null and would just vanish) — mirrors
# the CSV preview path so an FWF user sees why it failed (B-24).
wiz$fwf_preview_df <- data.frame(Error=paste("Parse failed:", conditionMessage(e)))
})
})
# FWF parsed preview output
output$step3_fwf_preview <- reactable::renderReactable({
req(!is.null(wiz$fwf_preview_df))
reactable::reactable(wiz$fwf_preview_df,
resizable=TRUE, wrap=FALSE, fullWidth=TRUE,
defaultPageSize=20, striped=TRUE, highlight=TRUE,
style=list(fontSize="12px"))
})
}
# Helper to trigger CSV re-parse
trigger_csv_preview <- function(input, wiz, threshold = 0.90) {
path <- wiz$current_preview_path
if (is.null(path) || nchar(path) == 0) return()
delim <- if (!is.null(input$wiz_delimiter) && input$wiz_delimiter == "other")
input$wiz_delimiter_custom %||% ","
else input$wiz_delimiter %||% ","
enc <- input$wiz_encoding %||% "UTF-8"
hdr <- isTRUE(as.logical(input$wiz_has_header %||% "TRUE"))
quot <- input$wiz_quote_char %||% '"'
tryCatch({
df <- readr::read_delim(path,
delim=delim,
col_names=hdr,
col_types=readr::cols(.default="c"),
n_max=20,
quote=quot,
locale=readr::locale(encoding=enc),
show_col_types=FALSE)
df <- as.data.frame(df)
ncols <- ncol(df)
# `wiz$col_names` is the single source of truth for column names. Reseed it
# ONLY when the column count changes — never clobber an existing list of the
# right length, or we would erase the user's edits / our own suggestions on
# every re-preview (the auto-preview observer fires on each step-3 render).
if (!hdr) {
wiz$raw_header_names <- character(0)
wiz$col_name_reasons <- character(0)
wiz$csv_col_names_detected <- names(df)
if (length(wiz$col_names) != ncols)
wiz$col_names <- paste0("col_", seq_len(ncols))
} else {
# Probe the *unmangled* header so duplicates survive (readr's default
# name_repair mangles them to `name...NN`, which we can't fix in the UI).
raw <- tryCatch(
names(readr::read_delim(path, delim=delim, n_max=0, quote=quot,
name_repair="minimal",
locale=readr::locale(encoding=enc),
show_col_types=FALSE)),
error=function(e) names(df))
if (length(raw) != ncols) raw <- names(df) # safety: keep counts aligned
sug <- suggest_col_names(raw)
wiz$raw_header_names <- raw
wiz$col_name_reasons <- sug$reason
wiz$csv_col_names_detected <- raw
if (length(wiz$col_names) != ncols)
wiz$col_names <- sug$names
}
# Show the preview under the resolved names, not the raw/mangled ones.
if (length(wiz$col_names) == ncols) names(df) <- wiz$col_names
# Infer types from sample
wiz$col_types_inferred <- vapply(df, function(x)
infer_col_type_simple(x, threshold = threshold), character(1))
wiz$csv_preview_df <- df
}, error=function(e) {
wiz$csv_preview_df <- data.frame(Error=paste("Parse failed:", e$message))
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.