# Präambel ####

AKZENT_FARBE = "#8B2635"

KS_DISCLAIMER = paste0(
  "Diese Auswertung ist eine rein deskriptive Aufbereitung der Fragebogenantworten ",
  "und stellt keinen validierten psychometrischen Kennwert dar. Es handelt sich um ",
  "kein standardisiertes, validiertes Testverfahren mit bekannter Quelle, Norm oder ",
  "Cutoff. Die Interpretation obliegt vollstaendig der behandelnden Person."
)

# Verlauf gruen -> dunkelrot entspricht den 5 Antwortstufen 0-4, grau = keine Angabe.
KS_BADGE_FARBEN = c(
  "0" = "#4CAF50", "1" = "#F48FB1", "2" = "#EF5350", "3" = "#B71C1C", "4" = "#4A0000",
  "na" = "#9E9E9E"
)
KS_BADGE_TEXT_FARBEN = c(
  "0" = "white", "1" = "#333333", "2" = "white", "3" = "white", "4" = "white",
  "na" = "white"
)

library(shiny)
library(dplyr)
library(haven)
library(officer)


# Infrastruktur ####

PFAD_DOWNLOAD_SKRIPT  = "../API/get_data_kognitivestrategien.R"
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"

APP_VERZEICHNIS = normalizePath(getwd())

absPath = function(pfad) {
  if (grepl("^([A-Za-z]:[/\\\\]|/)", pfad)) return(pfad)
  file.path(APP_VERZEICHNIS, pfad)
}

PFAD_DOWNLOAD_SKRIPT  = normalizePath(absPath(PFAD_DOWNLOAD_SKRIPT),  mustWork = FALSE)
PFAD_PSEUDONYM_SKRIPT = normalizePath(absPath(PFAD_PSEUDONYM_SKRIPT), mustWork = FALSE)


# Helper ####

KS_ANKER_WERTE = c(
  "gar nicht" = 0, "etwas" = 1, "teilweise" = 2, "sehr" = 3, "voellig" = 4
)
# "voellig" zusaetzlich zu "völlig" gelistet, falls das Encoding beim Datenexport
# das "ö" verliert - beide Schreibweisen werden unten in den Vergleich einbezogen.
KS_ANKER_WERTE = c(KS_ANKER_WERTE, "völlig" = 4)

KS_GRUPPEN_GROESSEN = c(5, 6, 7, 5, 6, 6, 5, 7)

ks_spalten_gruppe = function(g) {
  sprintf("ks_g%d_%02d", g, seq_len(KS_GRUPPEN_GROESSEN[g]))
}

# Bildet Fall A (Choice-Text, character/factor/labelled) und Fall B (1-basierter
# Choice-Index) robust auf 0-4 ab. Nicht eindeutig zuordenbare Werte -> NA.
ks_recode_spalte = function(spalte) {
  n = length(spalte)
  ergebnis = rep(NA_integer_, n)

  text_werte = tryCatch({
    if (inherits(spalte, "haven_labelled")) {
      as.character(haven::as_factor(spalte))
    } else if (is.factor(spalte)) {
      as.character(spalte)
    } else if (is.character(spalte)) {
      spalte
    } else {
      rep(NA_character_, n)
    }
  }, error = function(e) rep(NA_character_, n))

  text_werte = trimws(text_werte)
  treffer_text = match(text_werte, names(KS_ANKER_WERTE))
  ergebnis[!is.na(treffer_text)] = KS_ANKER_WERTE[treffer_text[!is.na(treffer_text)]]

  offen = is.na(ergebnis)
  num_werte = suppressWarnings(as.numeric(spalte))
  idx_ok = offen & !is.na(num_werte) & num_werte >= 1 & num_werte <= 5 &
    num_werte == round(num_werte)
  ergebnis[idx_ok] = as.integer(num_werte[idx_ok] - 1)

  as.integer(ergebnis)
}

# Entfernt Markdown-Backslash-Escapes (z.B. "5\." -> "5.", "\*" -> "*"), die formr
# beim Export von mc-Itemtexten teils stehen laesst.
ks_entferne_markdown_escapes = function(text) {
  gsub("\\\\([\\\\`*_{}\\[\\]()#+.!>~|-])", "\\1", text, perl = TRUE)
}

# Voller Itemtext aus dem label-Attribut der Original-Spalte, sonst Spaltenname.
# Die fuehrende Nummer (z.B. "5\. " oder "5. ") wird herausgeloest, damit sie
# separat links angezeigt werden kann; der Rest wird von Markdown-Escapes bereinigt.
# Ohne label-Attribut wird die Nummer defensiv aus dem Spaltensuffix abgeleitet
# (ks_gG_NN -> NN), da die Spaltenreihenfolge der Original-Itemnummerierung entspricht.
ks_parse_label = function(spalte_original, spaltenname) {
  lbl = attr(spalte_original, "label")
  if (!is.null(lbl) && length(lbl) > 0 && !is.na(lbl[1]) &&
      trimws(as.character(lbl[1])) != "") {
    text = trimws(as.character(lbl[1]))
    m = regmatches(text, regexec("^(\\d+)\\\\?\\.\\s*(.*)$", text))[[1]]
    if (length(m) == 3) {
      return(list(
        nr        = m[2],
        text      = ks_entferne_markdown_escapes(m[3]),
        verfuegbar = TRUE
      ))
    }
    return(list(nr = NA_character_, text = ks_entferne_markdown_escapes(text), verfuegbar = TRUE))
  }
  nr_fallback = sub("^.*_0*(\\d+)$", "\\1", spaltenname)
  list(
    nr        = nr_fallback,
    text      = paste0(spaltenname, " (Itemtext nicht verfuegbar)"),
    verfuegbar = FALSE
  )
}

# Absteigend nach Wert, NA ans Ende, stabil bei Gleichstand (order() ist stabil).
ks_sortiere_items = function(items) {
  werte = sapply(items, function(x) x$wert)
  na_flag = is.na(werte)
  schluessel = ifelse(na_flag, 0, -werte)
  items[order(na_flag, schluessel)]
}

# formr liefert i.d.R. POSIXct/ISO-Zeitstempel fuer 'created'/'ended' - beim
# ersten echten Datenexport verifizieren, nicht raten.
ks_format_datum = function(x, format = "%d.%m.%Y") {
  if (is.null(x) || length(x) == 0 || is.na(x[1])) return("unbekanntes Datum")
  wert = x[1]
  if (inherits(wert, "POSIXt") || inherits(wert, "Date")) {
    return(format(wert, format))
  }
  geparst = tryCatch(as.POSIXct(as.character(wert)), error = function(e) NA)
  if (!is.na(geparst)) return(format(geparst, format))
  as.character(wert)
}

ks_fehlermeldung = function(erg) {
  switch(erg$typ,
    format_fehler = paste0(
      "Ungueltige Chiffre '", erg$chiffre, "'. Erwartetes Format: ein Grossbuchstabe ",
      "gefolgt von 6 Ziffern (z.B. P000123)."
    ),
    pfad_fehler      = erg$meldung,
    skript_fehler    = paste0("Fehler beim Ausfuehren eines Skripts: ", erg$meldung),
    objekt_fehlt     = erg$meldung,
    spalten_fehler   = erg$meldung,
    chiffre_unbekannt = paste0(
      "Chiffre '", erg$chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden."
    ),
    keine_daten = paste0(
      "Kein Fragebogen-Durchlauf 'Kognitive Strategien' fuer Chiffre '",
      erg$chiffre, "' gefunden."
    ),
    "Unbekannter Fehler."
  )
}


# UI ####

app_css = "
body { font-family: 'Segoe UI', Arial, sans-serif; background: #f5f5f5; }
.app-header {
  background: #8B2635; color: white; padding: 18px 24px 14px;
  margin-bottom: 20px; border-radius: 0 0 6px 6px;
}
.app-header h2 { margin: 0; font-size: 1.5rem; font-weight: 600; }
.app-header p  { margin: 4px 0 0; opacity: 0.85; font-size: 0.9rem; }
.input-panel {
  background: white; border-radius: 6px; padding: 16px 20px;
  margin-bottom: 16px; box-shadow: 0 1px 3px rgba(0,0,0,.12);
  display: flex; align-items: flex-end; gap: 12px; flex-wrap: wrap;
}
.input-panel .form-group { margin-bottom: 0; }
.input-panel label { font-weight: 600; color: #333; }
.btn-laden {
  background: #8B2635 !important; color: white !important;
  border: none !important; border-radius: 4px !important;
  padding: 8px 20px !important; font-weight: 600 !important; cursor: pointer;
}
.btn-laden:hover { background: #6d1e29 !important; }
.alert-fehler {
  background: #FFEBEE; border-left: 5px solid #C62828;
  padding: 12px 16px; border-radius: 4px; color: #B71C1C;
  margin-bottom: 12px; font-weight: 500;
}
.alert-warnung {
  background: #FFF3E0; border-left: 5px solid #E65100;
  padding: 10px 16px; border-radius: 4px; color: #BF360C;
  margin-bottom: 12px; font-size: 0.93em; font-weight: 500;
}
.abschnitt-karte {
  background: white; border-radius: 6px; padding: 20px 24px;
  margin-bottom: 16px; box-shadow: 0 1px 3px rgba(0,0,0,.12);
}
.abschnitt-titel {
  color: #8B2635; font-size: 1.15rem; font-weight: 700;
  border-bottom: 2px solid #8B2635; padding-bottom: 8px; margin-bottom: 14px;
}
.meta-block { margin-bottom: 10px; color: #555; font-size: 0.95em; }
.meta-block strong { color: #222; }
.item-zeile {
  display: flex; align-items: center; gap: 10px;
  padding: 7px 0; border-bottom: 1px solid #F0F0F0;
}
.item-nr   { font-weight: 700; color: #8B2635; min-width: 26px; flex-shrink: 0; }
.item-text { flex: 1; color: #333; font-size: 0.92em; }
.stufe-badge {
  border-radius: 4px; padding: 2px 9px; font-weight: 700;
  font-size: 0.82em; white-space: nowrap; display: inline-block; flex-shrink: 0;
}
.stufe-badge-0  { background: #4CAF50; color: white; }
.stufe-badge-1  { background: #F48FB1; color: #333333; }
.stufe-badge-2  { background: #EF5350; color: white; }
.stufe-badge-3  { background: #B71C1C; color: white; }
.stufe-badge-4  { background: #4A0000; color: white; }
.stufe-badge-na { background: #9E9E9E; color: white; }
"

app_css = gsub("#8B2635", AKZENT_FARBE, app_css, fixed = TRUE)

ui = fluidPage(
  tags$head(
    tags$meta(charset = "UTF-8"),
    tags$style(HTML(app_css))
  ),

  div(class = "app-header",
    tags$h2("Kognitive Strategien"),
    tags$p("Deskriptive Itemauswertung - kein validiertes, benanntes Testverfahren")
  ),

  div(class = "container-fluid",

    div(class = "input-panel",
      div(style = "min-width: 360px; white-space: nowrap;",
        textInput("pseudonym",
                   label = tagList(
                     "Pseudonym",
                     tags$span(style = "font-weight: normal; font-style: italic; font-size: 0.78em; color: #888; margin-left: 4px; white-space: nowrap;",
                               "optional, hat Vorrang vor Chiffre")
                   ),
                   placeholder = "optional", width = "340px")
      ),
      div(style = "min-width: 200px;",
        textInput("chiffre", label = "Patientenchiffre",
                  placeholder = "z.B. P000123", width = "100%")
      ),
      actionButton("btn_suchen", "Auswerten", class = "btn btn-primary btn-laden"),
      div(style = "margin-left: auto;",
        downloadButton("download_word", "Word-Export (.docx)")
      )
    ),

    uiOutput("fehler_ui"),
    uiOutput("warnung_ui"),
    uiOutput("ergebnis_ui")
  )
)


# Word-Export ####

erstelle_kognitivestrategien_docx = function(erg) {
  doc = read_docx()

  fp_titel      = fp_text(color = AKZENT_FARBE, bold = TRUE,  font.size = 18)
  fp_abschnitt  = fp_text(color = AKZENT_FARBE, bold = TRUE,  font.size = 13)
  fp_label      = fp_text(bold = TRUE,  font.size = 11)
  fp_normal     = fp_text(font.size = 11)
  fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")

  doc = body_add_fpar(doc, fpar(ftext("Kognitive Strategien - Einzelauswertung", fp_titel)))
  doc = body_add_fpar(doc, fpar(
    ftext("Chiffre: ",         fp_label), ftext(erg$chiffre, fp_normal),
    ftext("     Ausfuelldatum: ", fp_label), ftext(ks_format_datum(erg$ausfuelldatum), fp_normal)
  ))
  if (!is.null(erg$info_mehrere)) {
    doc = body_add_fpar(doc, fpar(
      ftext(erg$info_mehrere, fp_text(font.size = 10, italic = TRUE, color = "#555555"))
    ))
  }
  doc = body_add_par(doc, "", style = "Normal")

  for (g in seq_len(8)) {
    doc = body_add_fpar(doc, fpar(ftext(paste0("Gruppe ", g), fp_abschnitt)))
    for (item in erg$gruppen[[g]]) {
      sk       = if (!is.na(item$wert)) as.character(item$wert) else "na"
      wert_txt = if (is.na(item$wert)) "keine Angabe" else as.character(item$wert)
      nr_txt   = if (!is.na(item$nr)) paste0(item$nr, ". ") else ""
      fp_badge = fp_text(
        color         = KS_BADGE_TEXT_FARBEN[[sk]],
        bold          = TRUE,
        shading.color = KS_BADGE_FARBEN[[sk]],
        font.size     = 10
      )
      doc = body_add_fpar(doc, fpar(
        ftext(nr_txt,      fp_label),
        ftext(item$text,   fp_normal),
        ftext(paste0("  ", wert_txt, " "), fp_badge)
      ))
    }
    doc = body_add_par(doc, "", style = "Normal")
  }

  doc = body_add_fpar(doc, fpar(ftext(KS_DISCLAIMER, fp_disclaimer)))
  doc
}


# Server ####

server = function(input, output, session) {
  # --- pseudonym-support-injection v1 ---
  observe({
    query = parseQueryString(session$clientData$url_search)
    if (!is.null(query$pseudonym) && nchar(trimws(query$pseudonym)) > 0) {
      updateTextInput(session, "pseudonym", value = trimws(query$pseudonym))
    }
  })

  observe({
    query = parseQueryString(session$clientData$url_search)
    if (!is.null(query$chiffre) && nchar(trimws(query$chiffre)) > 0) {
      updateTextInput(session, "chiffre", value = toupper(trimws(query$chiffre)))
    }
  })

  # Skripte werden NICHT beim App-Start gesourct, nur beim Klick.
  ergebnis_r = eventReactive(input$btn_suchen, {

    chiffre = toupper(trimws(input$chiffre))

    if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre))) {
      return(list(typ = "format_fehler", chiffre = chiffre))
    }

    if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
      return(list(typ = "pfad_fehler", meldung = paste0(
        "Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
    }
    if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
      return(list(typ = "pfad_fehler", meldung = paste0(
        "Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT)))
    }

    ok = tryCatch({
      source(PFAD_DOWNLOAD_SKRIPT, local = FALSE)
      list(ok = TRUE)
    }, error = function(e) list(ok = FALSE, msg = e$message))
    if (!ok$ok) return(list(typ = "skript_fehler", meldung = ok$msg))

    db_ordner = local({
      ordner   = dirname(PFAD_PSEUDONYM_SKRIPT)
      gefunden = NULL
      for (i in 1:5) {
        if (file.exists(file.path(ordner, "pseudonyme.db"))) {
          gefunden = ordner
          break
        }
        eltern = dirname(ordner)
        if (eltern == ordner) break
        ordner = eltern
      }
      gefunden
    })

    alter_wd = getwd()
    wd_ziel  = if (!is.null(db_ordner)) db_ordner else dirname(PFAD_PSEUDONYM_SKRIPT)
    setwd(wd_ziel)
    on.exit(setwd(alter_wd), add = TRUE)

    ok2 = tryCatch({
      source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
      if (nchar(trimws(input$pseudonym)) > 0) {
        .pw_wert = trimws(input$pseudonym)
        .pw_tab = get("pseudo", envir = .GlobalEnv)
        .pw_treffer = .pw_tab[.pw_tab$pseudonym == .pw_wert, ]
        if (nrow(.pw_treffer) > 0) chiffre = toupper(trimws(.pw_treffer$chiffre[1]))
      }
      list(ok = TRUE)
    }, error = function(e) list(ok = FALSE, msg = e$message))
    if (!ok2$ok) return(list(typ = "skript_fehler", meldung = ok2$msg))

    if (!exists("daten_kognitivestrategien", envir = .GlobalEnv)) {
      return(list(typ = "objekt_fehlt", meldung = paste0(
        "Objekt 'daten_kognitivestrategien' wurde nach dem Sourcen des ",
        "Download-Skripts nicht gefunden.")))
    }
    if (!exists("pseudo", envir = .GlobalEnv)) {
      return(list(typ = "objekt_fehlt", meldung = paste0(
        "Objekt 'pseudo' wurde nach dem Sourcen des Pseudonym-Skripts nicht gefunden.")))
    }

    daten     = get("daten_kognitivestrategien", envir = .GlobalEnv)
    pseudo_df = get("pseudo", envir = .GlobalEnv)

    treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, , drop = FALSE]
    if (nrow(treffer_ps) == 0) {
      return(list(typ = "chiffre_unbekannt", chiffre = chiffre))
    }
    session_ids = unique(treffer_ps$pseudonym)
    if (nchar(trimws(input$pseudonym)) > 0) session_ids = trimws(input$pseudonym)

    # Session-Spalte: 'session' oder 'pseudonym', je nach formr-Exportbenennung.
    session_spalte = if ("session" %in% names(daten)) {
      "session"
    } else if ("pseudonym" %in% names(daten)) {
      "pseudonym"
    } else {
      NULL
    }
    if (is.null(session_spalte)) {
      return(list(typ = "spalten_fehler", meldung = paste0(
        "Weder Spalte 'session' noch 'pseudonym' in 'daten_kognitivestrategien' gefunden.")))
    }

    # Zeitstempel-Spalte: 'created' oder 'ended', je nach formr-Exportbenennung.
    zeit_spalte = if ("created" %in% names(daten)) {
      "created"
    } else if ("ended" %in% names(daten)) {
      "ended"
    } else {
      NULL
    }
    if (is.null(zeit_spalte)) {
      return(list(typ = "spalten_fehler", meldung = paste0(
        "Weder Spalte 'created' noch 'ended' in 'daten_kognitivestrategien' gefunden.")))
    }

    treffer_dat = daten[daten[[session_spalte]] %in% session_ids, , drop = FALSE]
    if (nrow(treffer_dat) == 0) {
      return(list(typ = "keine_daten", chiffre = chiffre))
    }

    info_mehrere = NULL
    if (nrow(treffer_dat) > 1) {
      reihenfolge = order(treffer_dat[[zeit_spalte]], decreasing = TRUE)
      treffer_dat = treffer_dat[reihenfolge, , drop = FALSE]
      datum_neu   = ks_format_datum(treffer_dat[[zeit_spalte]][1])
      info_mehrere = paste0(
        "Mehrere Durchlaeufe gefunden, zeige den neuesten vom ", datum_neu, "."
      )
      treffer_dat = treffer_dat[1, , drop = FALSE]
    }

    zeile             = treffer_dat[1, , drop = FALSE]
    ausfuelldatum_roh = zeile[[zeit_spalte]][1]

    fehlende_alle = character(0)
    gruppen = lapply(seq_len(8), function(g) {
      spalten  = ks_spalten_gruppe(g)
      fehlende = setdiff(spalten, names(daten))
      if (length(fehlende) > 0) {
        fehlende_alle <<- c(fehlende_alle, fehlende)
        return(NULL)
      }
      items = lapply(spalten, function(sp) {
        label = ks_parse_label(daten[[sp]], sp)
        list(
          spalte = sp,
          wert   = ks_recode_spalte(zeile[[sp]])[1],
          nr     = label$nr,
          text   = label$text
        )
      })
      ks_sortiere_items(items)
    })

    if (length(fehlende_alle) > 0) {
      return(list(typ = "spalten_fehler", meldung = paste0(
        "Fehlende Item-Spalte(n) in 'daten_kognitivestrategien': ",
        paste(fehlende_alle, collapse = ", ")
      )))
    }

    list(
      typ           = "ok",
      chiffre       = chiffre,
      ausfuelldatum = ausfuelldatum_roh,
      info_mehrere  = info_mehrere,
      gruppen       = gruppen
    )
  })

  output$fehler_ui = renderUI({
    req(input$btn_suchen)
    erg = ergebnis_r()
    if (!identical(erg$typ, "ok")) div(class = "alert-fehler", ks_fehlermeldung(erg))
  })

  output$warnung_ui = renderUI({
    req(input$btn_suchen)
    erg = ergebnis_r()
    if (!identical(erg$typ, "ok") || is.null(erg$info_mehrere)) return(NULL)
    div(class = "alert-warnung", erg$info_mehrere)
  })

  output$ergebnis_ui = renderUI({
    req(input$btn_suchen)
    erg = ergebnis_r()
    if (!identical(erg$typ, "ok")) return(NULL)

    gruppen_ui = lapply(seq_len(8), function(g) {
      items_ui = lapply(erg$gruppen[[g]], function(item) {
        sk       = if (!is.na(item$wert)) as.character(item$wert) else "na"
        wert_txt = if (is.na(item$wert)) "keine Angabe" else as.character(item$wert)
        nr_txt   = if (!is.na(item$nr)) paste0(item$nr, ".") else ""
        div(class = "item-zeile",
          div(class = "item-nr",   nr_txt),
          div(class = "item-text", item$text),
          span(class = paste0("stufe-badge stufe-badge-", sk), wert_txt)
        )
      })
      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", paste0("Gruppe ", g)),
        div(items_ui)
      )
    })

    tagList(
      div(class = "abschnitt-karte",
        div(class = "meta-block",
          tags$strong("Chiffre: "), erg$chiffre,
          tags$span("   |   ", style = "color:#ccc;"),
          tags$strong("Ausfuelldatum: "), ks_format_datum(erg$ausfuelldatum)
        )
      ),
      gruppen_ui,
      div(style = "font-size: 0.82em; color: #777; font-style: italic; padding: 4px 4px 20px;",
        KS_DISCLAIMER
      )
    )
  })

  output$download_word = downloadHandler(
    filename = function() {
      erg = tryCatch(ergebnis_r(), error = function(e) NULL)
      ok  = is.list(erg) && identical(erg$typ, "ok")
      chiffre_esc = if (ok) erg$chiffre else "export"
      datum_fn    = if (ok) ks_format_datum(erg$ausfuelldatum, "%Y%m%d") else format(Sys.Date(), "%Y%m%d")
      paste0("KognitiveStrategien_", chiffre_esc, "_", datum_fn, ".docx")
    },
    content = function(file) {
      erg = tryCatch(ergebnis_r(), error = function(e) NULL)
      ok  = is.list(erg) && identical(erg$typ, "ok")
      if (!ok) {
        doc = read_docx()
        doc = body_add_par(doc,
          "Kein gueltiger Datensatz geladen. Bitte zuerst Chiffre eingeben und 'Auswerten' klicken.",
          style = "Normal")
        print(doc, target = file)
        return()
      }
      doc = tryCatch(
        erstelle_kognitivestrategien_docx(erg),
        error = function(e) {
          err_doc = read_docx()
          body_add_par(err_doc,
            paste0("Fehler beim Erstellen des Word-Dokuments: ", e$message),
            style = "Normal")
        }
      )
      print(doc, target = file)
    }
  )
}


# Start ####

shinyApp(ui, server)