(* Bootstraps data/ef/sanctoral.sexp from lectio's tridentine-calendar.ini
   (spec §4, docs/superpowers/specs/2026-08-11-colitur-plan3-resolution-
   engine-design.md). A documented one-shot under tools/, not part of the
   kernel: reading someone else's INI needs a reader, which does not
   contradict "no hand-written parser" -- that rule is about colitur's own
   format (S-expressions, parsed by sexplib/ppx_sexp_conv, never by hand).

   Every field is built through the kernel's own validating constructors
   (Slug.of_string, Colour.of_string, Vocab_ef.rank_of_string, ...), so the
   emitted sexp is valid by construction: a bad slug or an unknown rank fails
   the bootstrap here, not a later Layer.load.

   Usage: dune exec tools/bootstrap_sanctoral.exe -- [source.ini] [dest.sexp]
   Defaults assume the sibling checkout layout documented in CLAUDE.md
   (~/git/projects/lectio next to ~/git/projects/colitur) and a run from the
   colitur repo root. *)

module Cel = Colitur_kernel.Celebration
module Slug = Colitur_kernel.Slug
module Colour = Colitur_kernel.Colour
module Subject = Colitur_kernel.Subject
module Names = Colitur_kernel.Names
module Lang = Colitur_kernel.Lang
module DS = Colitur_kernel.Date_spec
module Layer = Colitur_kernel.Layer
module V = Rite_ef.Vocab_ef
module PE = Rite_ef.Precedence_ef

let default_source = "../lectio/internal/caldata/tridentine-calendar.ini"
let default_dest = "data/ef/sanctoral.sexp"

(* Fails loudly and stops, per the brief: a source shape the mapping does not
   cover must never fall back to a silent default. *)
let die fmt = Printf.ksprintf (fun s -> prerr_endline ("bootstrap_sanctoral: " ^ s); exit 1) fmt

(* --- A minimal INI reader for lectio's format only ------------------------

   Not a general INI library: comment lines start with ';', section headers
   are "[name]", and every other non-blank line is "key = value" with the
   value running to end of line (verified against the actual source file --
   no embedded '=', quotes, or trailing whitespace in any value; see the
   task report). This is a reader for someone else's format, not colitur's
   own -- see the module comment above. *)

type section = { name : string; fields : (string * string) list }

let parse_ini path =
  if not (Sys.file_exists path) then die "source file not found: %s" path;
  let ic = open_in path in
  Fun.protect
    ~finally:(fun () -> close_in_noerr ic)
    (fun () ->
      let sections = ref [] in
      let cur_name = ref None in
      let cur_fields = ref [] in
      let flush () =
        match !cur_name with
        | Some n -> sections := { name = n; fields = List.rev !cur_fields } :: !sections
        | None -> ()
      in
      (try
         while true do
           let raw = input_line ic in
           let line = String.trim raw in
           if line = "" || line.[0] = ';' then ()
           else if line.[0] = '[' && line.[String.length line - 1] = ']' then begin
             flush ();
             cur_name := Some (String.sub line 1 (String.length line - 2));
             cur_fields := []
           end
           else
             match String.index_opt line '=' with
             | None -> die "%s: unparseable line (no '='): %S" path line
             | Some i ->
                 let key = String.trim (String.sub line 0 i) in
                 let value = String.trim (String.sub line (i + 1) (String.length line - i - 1)) in
                 cur_fields := (key, value) :: !cur_fields
         done
       with End_of_file -> ());
      flush ();
      List.rev !sections)

(* --- Field-level mapping (spec §4.2) --------------------------------------- *)

let field sec key =
  match List.assoc_opt key sec.fields with
  | Some v -> v
  | None -> die "section [%s]: missing required field %S" sec.name key

let field_opt sec key = List.assoc_opt key sec.fields

let parse_slug sec =
  match Slug.of_string sec.name with
  | Ok s -> s
  | Error e -> die "section [%s]: invalid slug: %s" sec.name e

(* All 322 entries use plain MM-DD (spec §4.1); anything else is a date form
   the mapping does not cover. *)
let parse_date sec =
  let raw = field sec "date" in
  match String.split_on_char '-' raw with
  | [ mm; dd ] when String.length mm = 2 && String.length dd = 2 -> (
      match (int_of_string_opt mm, int_of_string_opt dd) with
      | Some month, Some day -> (
          match DS.fixed ~month ~day with
          | Ok d -> d
          | Error e -> die "section [%s]: date %S: %s" sec.name raw e)
      | _ -> die "section [%s]: date %S is not numeric MM-DD" sec.name raw)
  | _ -> die "section [%s]: unsupported date form %S -- only MM-DD is mapped" sec.name raw

(* rank = class-1..4 -> (Class1..4, Feast); rank = commemoration ->
   (Class3, Commemoration_only) -- decision 2 in the task brief and spec
   §4.3: the source gives no rank for a bare commemoration, but RG 111 orders
   admitted commemorations by dignity, so one is needed. Class3 is a
   documented INFERENCE (it is what the 1960 reform reduced most simple
   feasts from), not an RG citation -- see docs/research/rules-register.md
   §6 and Celebration.status's own doc comment for why status, not rank,
   carries "can this ever be observed". *)
let parse_rank_status sec =
  let raw = field sec "rank" in
  if raw = "commemoration" then (V.Class3, Cel.Commemoration_only)
  else
    match V.rank_of_string raw with
    | Some r -> (r, Cel.Feast)
    | None -> die "section [%s]: unknown rank %S" sec.name raw

(* Sanctoral colours are white, red, violet, black only (spec §4.1) -- green
   and rose belong to the temporal cycle. Colour.of_string's domain is wider
   (it also names green/rose), so this rejects them explicitly rather than
   passing through a colour that would be a modelling error if it ever
   appeared in sanctoral data. *)
let parse_colour sec =
  let raw = field sec "colour" in
  match Colour.of_string raw with
  | Some (Colour.White | Colour.Red | Colour.Violet | Colour.Black as c) -> c
  | Some (Colour.Green | Colour.Rose) ->
      die "section [%s]: colour %S is temporal-only, unexpected in sanctoral data" sec.name raw
  | None -> die "section [%s]: unknown colour %S" sec.name raw

(* class = lord|bvm|saint -> Subject.t; absent -> Subject.Saint (decision 1:
   Celebration.make's kernel default is Subject.Temporal, correct for the
   temporal cycle and wrong for every sanctoral entry -- overridden here,
   never left to the default). Only 6 of 322 entries carry an explicit
   class in the source, and all 6 are "lord" as of this bootstrap; bvm/saint
   are mapped in case a future lectio update adds one, but "temporal" is
   rejected -- no sanctoral entry is the temporal cycle's own office. *)
let parse_subject sec =
  match field_opt sec "class" with
  | None -> Subject.Saint
  | Some raw -> (
      match Subject.of_string raw with
      | Some Subject.Temporal ->
          die "section [%s]: class %S maps to Subject.Temporal, invalid for sanctoral data" sec.name
            raw
      | Some s -> s
      | None -> die "section [%s]: unknown class %S" sec.name raw)

let parse_names sec =
  let en = field sec "name.en" in
  let pl = field sec "name.pl" in
  Names.of_list [ (Lang.of_string_exn "en", en); (Lang.of_string_exn "pl", pl) ]

(* reading.* is deliberately ignored -- Plan 4's lectionary bootstrap. *)
let convert_entry sec : V.rank Layer.entry =
  let slug = parse_slug sec in
  let date = parse_date sec in
  let rank, status = parse_rank_status sec in
  let colour = parse_colour sec in
  let subject = parse_subject sec in
  let names = parse_names sec in
  (* PE.universal_layer, NOT lectio's own "tridentine" layer id and NOT the
     Celebration.make default "temporal": Precedence_ef.band reads
     Celebration.t.layer to classify RG 91 entries 11/16/24 (universal) vs
     12/19/23 (proper) vs 13/20 (indult, PE.indult_prefix). Every entry here
     is the General Roman Calendar's own universal sanctoral, so all 322 get
     the same provenance tag. *)
  { Layer.date; cel = Cel.make ~slug ~names ~rank ~status ~colour ~subject ~citations:[]
      ~layer:PE.universal_layer () }

(* --- Provenance (spec §4.5) ------------------------------------------------ *)

let sha256_of_file path =
  let cmd = Printf.sprintf "sha256sum %s" (Filename.quote path) in
  let ic = Unix.open_process_in cmd in
  let line = try input_line ic with End_of_file -> die "sha256sum produced no output for %s" path in
  (match Unix.close_process_in ic with
  | Unix.WEXITED 0 -> ()
  | _ -> die "sha256sum failed for %s" path);
  match String.index_opt line ' ' with
  | Some i -> String.sub line 0 i
  | None -> die "unexpected sha256sum output: %S" line

let today () =
  let tm = Unix.gmtime (Unix.time ()) in
  Printf.sprintf "%04d-%02d-%02d" (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday

(* --- Main ------------------------------------------------------------------ *)

let () =
  let source = if Array.length Sys.argv > 1 then Sys.argv.(1) else default_source in
  let dest = if Array.length Sys.argv > 2 then Sys.argv.(2) else default_dest in
  let sections = parse_ini source in
  if not (List.exists (fun s -> s.name = "layer") sections) then
    die "%s: missing the [layer] header section" source;
  let entry_sections = List.filter (fun s -> s.name <> "layer") sections in
  let entries = List.map convert_entry entry_sections in
  let layer = Layer.of_entries ~id:PE.universal_layer ~name:"EF (1962) universal sanctoral" entries in
  let sha = sha256_of_file source in
  let feasts = List.length (List.filter (fun e -> e.Layer.cel.Cel.status = Cel.Feast) entries) in
  let comms = List.length entries - feasts in
  let header =
    Printf.sprintf
      {|; data/ef/sanctoral.sexp -- EF (1962) universal sanctoral (General Roman
; Calendar), bootstrapped from lectio (sibling project; see CLAUDE.md).
; Generator: tools/bootstrap_sanctoral.ml -- do not hand-edit; re-run the
; generator against a newer lectio and commit the diff instead.
;
; Source: %s
; SHA-256: %s
; Converted (UTC): %s
; %d entries (%d feast, %d commemoration-only). Regenerate with:
;   eval $(opam env) && dune exec tools/bootstrap_sanctoral.exe -- %s %s
|}
      source sha (today ()) (List.length entries) feasts comms source dest
  in
  let body = Sexplib.Sexp.to_string_hum ~indent:2 (Layer.sexp_of_t V.sexp_of_rank layer) in
  let oc = open_out dest in
  Fun.protect
    ~finally:(fun () -> close_out_noerr oc)
    (fun () ->
      output_string oc header;
      output_string oc body;
      output_string oc "\n");
  Printf.printf "bootstrap_sanctoral: wrote %d entries (%d feast, %d commemoration-only) to %s\n"
    (List.length entries) feasts comms dest