path: root/tools/bootstrap_sanctoral.ml

(* 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

(* Every entry uses plain MM-DD (spec §4.1; 327 of them as of the
   2026-08-12 ef-rebootstrap, up from 322 -- this rule itself is about the
   date FORM, not a count, so it does not go stale as entries are added or
   removed); 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 327 entries carry an explicit
   class in the source (STALE DENOMINATOR CORRECTED, ef-rebootstrap fix
   round 1, F6 -- was "6 of 322"; the count of 6 itself did not move, but
   WHICH six did: the 2026-08-12 re-bootstrap dropped `class = lord` from
   `most-holy-name-of-mary` and added it to
   `commemoration-of-the-baptism-of-the-lord`, a straight swap, net zero),
   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)

(* name.en is always required; name.pl is not -- the 2026-08-12 re-bootstrap
   (RG16(a) blast-radius task) found 5 of the source's 327 entries missing
   it outright, 322 still carrying it (CORRECTED, fix round 1, F6: was "5
   of the source's 322 entries" -- the source has 327, of which 5 lack
   name.pl and 322 have it; the 322 is a coincidence of the OLD total, not
   the new one) (agnes-secundo, boniface-martyr, eusebius-confessor, evaristus,
   theodore -- all 5 either newly added or newly un-hidden by lectio's own
   generator fix, never previously reachable through this tool at all, since
   every entry the OLD ini shipped happened to carry both languages). Prior
   to this the field was unconditionally required (`field sec "name.pl"`,
   which `die`s on absence) -- correct for a byte-faithful mirror of a
   source that always had it, wrong once the source legitimately does not:
   Names.t itself is an open, per-language assoc list (names.mli) with no
   rule that every entry must carry every language colitur happens to know
   about, so requiring pl here was this tool's own invented constraint, not
   a kernel one. Falling back to en-only (never a placeholder string) is the
   same posture the kernel takes elsewhere for a genuinely absent field. *)
let parse_names sec =
  let en = field sec "name.en" in
  match field_opt sec "name.pl" with
  | Some pl -> Names.of_list [ (Lang.of_string_exn "en", en); (Lang.of_string_exn "pl", pl) ]
  | None -> Names.of_list [ (Lang.of_string_exn "en", en) ]

(* 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