diff options
| -rw-r--r-- | bin/main.ml | 38 | ||||
| -rw-r--r-- | lib/kernel/overlay_ini.ml | 294 | ||||
| -rw-r--r-- | lib/kernel/overlay_ini.mli | 69 | ||||
| -rw-r--r-- | man/colitur-overlay.5 | 92 | ||||
| -rw-r--r-- | man/colitur.1 | 9 | ||||
| -rw-r--r-- | test/cli.t | 19 | ||||
| -rw-r--r-- | test/test_colitur.ml | 2 | ||||
| -rw-r--r-- | test/test_overlay_ini.ml | 152 |
8 files changed, 674 insertions, 1 deletions
diff --git a/bin/main.ml b/bin/main.ml index b997cbe..9b7c8a7 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -389,6 +389,7 @@ usage: colitur readings <year> the Mass reading citations, one line per day colitur day|readings <year> --overlay FILE [--overlay FILE ...] colitur new-overlay print a starter overlay file to stdout + colitur convert FILE.ini flat INI overlay -> S-expression, on stdout colitur check FILE ... load an overlay, say what it does, exit 2 if not colitur -h, --help this help colitur -V, --version print the version and exit @@ -432,6 +433,10 @@ overlays: Makefile or a pre-commit hook. It does not check a calendar against the rubrics -- nothing here can. + A flatter INI form exists for simple calendars, converted with + `colitur convert`, which verifies its own output before emitting + it. See colitur-overlay(5) for both forms. + In an added celebration, `citations` and `layer` may be omitted: they default to empty and to the overlay's own id. Dates may be (Fixed (month M) (day D)), (Easter_offset N) signed, or @@ -582,6 +587,36 @@ let check_report paths = paths; exit (if !ok then 0 else 2) +(* `colitur convert FILE.ini` -- the flat INI form to the S-expression one, + on stdout for redirection. + + A separate step rather than teaching --overlay to sniff the extension, and + deliberately so: the user gets to SEE what their INI became. When a date + form was mistyped or an edit silently dropped, "what did the engine + actually get" is the question, and an invisible transpile cannot answer it. + + {!Overlay_ini.convert} verifies its own output before returning it -- see + that function's own comment. Nothing is written if the round trip fails. *) +let convert_report path = + match + (try Ok (In_channel.with_open_text path In_channel.input_all) + with Sys_error e -> Error e) + with + | Error e -> + Printf.eprintf "colitur: %s\n" e; + exit 2 + | Ok text -> ( + match + Colitur_kernel.Overlay_ini.convert ~rank_of_string:Rite_ef.Vocab_ef.rank_of_string + ~rank_to_sexp:Rite_ef.Vocab_ef.sexp_of_rank ~rank_of_sexp:Rite_ef.Vocab_ef.rank_of_sexp text + with + | Error e -> + Printf.eprintf "colitur: %s: %s\n" path e; + exit 2 + | Ok sexp -> + print_string sexp; + exit 0) + (* `colitur new-overlay` -- a starter file on stdout, for redirection. Deliberately printed rather than written: the user picks the path, and a command that creates files where it likes is a worse citizen. Every value is @@ -660,6 +695,9 @@ let () = | "check" :: (_ :: _ as files) -> reject_overlays_for "check" overlays; check_report files + | [ "convert"; path ] -> + reject_overlays_for "convert" overlays; + convert_report path | [ "new-overlay" ] -> reject_overlays_for "new-overlay" overlays; print_string new_overlay_template; diff --git a/lib/kernel/overlay_ini.ml b/lib/kernel/overlay_ini.ml new file mode 100644 index 0000000..6b6249f --- /dev/null +++ b/lib/kernel/overlay_ini.ml @@ -0,0 +1,294 @@ +open Sexplib0.Sexp_conv + +type section = { name : string; fields : (string * string) list } + +let err fmt = Printf.ksprintf (fun s -> Error s) fmt + +(* A minimal INI reader: [section] headers, [key = value] lines, ';' and '#' + comments, blank lines ignored. Values keep interior spaces and are trimmed + at both ends. Deliberately not a general INI implementation -- no + continuations, no quoting, no repeated-key semantics -- because every + feature here is one a user can trip over, and the format's whole purpose is + to be unsurprising. *) +let parse_sections text = + let lines = String.split_on_char '\n' text in + let sections = ref [] and cur = ref None and fields = ref [] in + let flush () = + match !cur with + | Some n -> sections := { name = n; fields = List.rev !fields } :: !sections + | None -> () + in + let rec go n = function + | [] -> + flush (); + Ok (List.rev !sections) + | raw :: rest -> ( + let line = String.trim raw in + let n = n + 1 in + if line = "" || line.[0] = ';' || line.[0] = '#' then go n rest + else if line.[0] = '[' then + if line.[String.length line - 1] <> ']' then + err "line %d: %S looks like a section header but does not end with ']'" n line + else begin + flush (); + cur := Some (String.sub line 1 (String.length line - 2)); + fields := []; + go n rest + end + else + match String.index_opt line '=' with + | None -> err "line %d: %S is neither a [section] nor a key = value line" n line + | Some i -> + if !cur = None then + err "line %d: %S appears before any [section] header" n line + else begin + let k = String.trim (String.sub line 0 i) in + let v = String.trim (String.sub line (i + 1) (String.length line - i - 1)) in + fields := (k, v) :: !fields; + go n rest + end) + in + go 0 lines + +let get sec k = List.assoc_opt k sec.fields +let is_yes v = List.mem (String.lowercase_ascii v) [ "yes"; "true"; "1" ] + +let months = + [ ("jan", 1); ("feb", 2); ("mar", 3); ("apr", 4); ("may", 5); ("jun", 6); + ("jul", 7); ("aug", 8); ("sep", 9); ("oct", 10); ("nov", 11); ("dec", 12) ] + +let weekdays = + [ ("sun", Date.Sun); ("mon", Date.Mon); ("tue", Date.Tue); ("wed", Date.Wed); + ("thu", Date.Thu); ("fri", Date.Fri); ("sat", Date.Sat) ] + +(* The three {!Date_spec} shapes, flattened. Every failure names the section + and shows the three forms, because a wrong date is the commonest mistake + and "invalid date" alone does not tell anyone what to type. *) +let parse_date ~section raw = + let bad () = + err + "section [%s]: date %S is not one of the three forms: MM-DD (a civil \ + date), easter+N or easter-N (signed days from Easter), or mon/day/nth \ + such as oct/sun/1 or oct/sun/-1 (nth may be negative to count from the \ + end of the month)" + section raw + in + let low = String.lowercase_ascii raw in + let starts p = String.length low >= String.length p && String.sub low 0 (String.length p) = p in + if starts "easter" then + let tail = String.sub raw 6 (String.length raw - 6) in + match int_of_string_opt (String.trim tail) with + | Some n -> ( + match Date_spec.easter_offset n with Ok d -> Ok d | Error e -> err "section [%s]: %s" section e) + | None -> bad () + else + match String.split_on_char '/' low with + | [ m; w; n ] -> ( + match (List.assoc_opt m months, List.assoc_opt w weekdays, int_of_string_opt n) with + | Some month, Some weekday, Some nth -> ( + match Date_spec.nth_weekday ~month ~nth ~weekday with + | Ok d -> Ok d + | Error e -> err "section [%s]: %s" section e) + | _ -> bad ()) + | _ -> ( + match String.split_on_char '-' low with + | [ mm; dd ] -> ( + match (int_of_string_opt mm, int_of_string_opt dd) with + | Some month, Some day -> ( + match Date_spec.fixed ~month ~day with + | Ok d -> Ok d + | Error e -> err "section [%s]: %s" section e) + | _ -> bad ()) + | _ -> bad ()) + +let ( let* ) r f = match r with Ok v -> f v | Error e -> Error e + +let parse_names ~section sec = + let entries = + List.filter_map + (fun (k, v) -> + if String.length k > 5 && String.sub k 0 5 = "name." then + Some (String.sub k 5 (String.length k - 5), v) + else None) + sec.fields + in + match entries with + | [] -> err "section [%s]: at least one name.<lang> is required (e.g. name.en)" section + | _ -> + List.fold_left + (fun acc (l, v) -> + let* names = acc in + match Lang.of_string l with + | Error e -> err "section [%s]: name.%s: %s" section l e + | Ok lang -> Ok (Names.set names lang v)) + (Ok Names.empty) entries + +let celebration ~section ~id ~rank_of_string sec = + let* slug = + match Slug.of_string section with + | Ok s -> Ok s + | Error e -> err "section [%s]: %s" section e + in + let* names = parse_names ~section sec in + let* rank = + match get sec "rank" with + | None -> err "section [%s]: rank is required (class-1, class-2, class-3 or class-4)" section + | Some r -> ( + match rank_of_string r with + | Some r -> Ok r + | None -> err "section [%s]: unknown rank %S -- expected class-1..class-4" section r) + in + let* colour = + match get sec "colour" with + | None -> err "section [%s]: colour is required (white, red, violet, green, black, rose)" section + | Some c -> ( + match Colour.of_string (String.lowercase_ascii c) with + | Some c -> Ok c + | None -> + err "section [%s]: unknown colour %S -- expected white, red, violet, green, black or rose" + section c) + in + let* status = + match get sec "status" with + | None | Some "feast" -> Ok Celebration.Feast + | Some "commemoration" -> Ok Celebration.Commemoration_only + | Some s -> err "section [%s]: unknown status %S -- expected feast or commemoration" section s + in + let* subject = + match Option.map String.lowercase_ascii (get sec "subject") with + | None | Some "saint" -> Ok Subject.Saint + | Some "lord" -> Ok Subject.Lord + | Some "bvm" -> Ok Subject.Bvm + | Some "temporal" -> Ok Subject.Temporal + | Some s -> err "section [%s]: unknown subject %S -- expected lord, bvm, saint or temporal" section s + in + Ok (Celebration.make ~slug ~names ~rank ~status ~colour ~subject ~citations:[] ~layer:id ()) + +(* Field edits the flat form can express. Citation edits and Remove_name are + deliberately absent: both need a structured key this format has no shape + for, and a half-expressible edit is worse than one the parser refuses by + name. *) +let edits ~section ~rank_of_string sec = + List.fold_left + (fun acc (k, v) -> + let* es = acc in + match k with + | "edit" -> Ok es + | "rank" -> ( + match rank_of_string v with + | Some r -> Ok (Overlay.Set_rank r :: es) + | None -> err "section [%s]: unknown rank %S" section v) + | "colour" -> ( + match Colour.of_string (String.lowercase_ascii v) with + | Some c -> Ok (Overlay.Set_colour c :: es) + | None -> err "section [%s]: unknown colour %S" section v) + | "subject" -> ( + match String.lowercase_ascii v with + | "lord" -> Ok (Overlay.Set_subject Subject.Lord :: es) + | "bvm" -> Ok (Overlay.Set_subject Subject.Bvm :: es) + | "saint" -> Ok (Overlay.Set_subject Subject.Saint :: es) + | "temporal" -> Ok (Overlay.Set_subject Subject.Temporal :: es) + | _ -> err "section [%s]: unknown subject %S" section v) + | k when String.length k > 5 && String.sub k 0 5 = "name." -> ( + let l = String.sub k 5 (String.length k - 5) in + match Lang.of_string l with + | Ok lang -> Ok (Overlay.Set_name (lang, v) :: es) + | Error e -> err "section [%s]: name.%s: %s" section l e) + | _ -> + err + "section [%s]: %S cannot be edited from an INI overlay -- this form \ + expresses rank, colour, subject and name.<lang> only. Write the \ + S-expression form for anything else (see colitur-overlay(5))." + section k) + (Ok []) sec.fields + |> Result.map List.rev + +let parse ~rank_of_string text = + let* sections = parse_sections text in + let header, entries = List.partition (fun s -> s.name = "overlay") sections in + let* id = + match header with + | [ h ] -> ( + match get h "id" with + | Some id when String.trim id <> "" -> Ok id + | _ -> err "the [overlay] section needs an id (e.g. id = my-parish)") + | [] -> err "no [overlay] section: the file must open with one, carrying id = <name>" + | _ -> err "more than one [overlay] section" + in + let* directives = + List.fold_left + (fun acc sec -> + let* ds = acc in + let section = sec.name in + match (get sec "suppress", get sec "replace", get sec "edit") with + | Some v, _, _ when is_yes v -> ( + match Slug.of_string section with + | Ok s -> Ok (Overlay.Suppress s :: ds) + | Error e -> err "section [%s]: %s" section e) + | _, Some v, _ when is_yes v -> + err + "section [%s]: replace is not expressible in the INI form -- it \ + needs a whole entry, which is what the S-expression form is for \ + (see colitur-overlay(5)). Suppress plus a fresh section is \ + usually what you want instead." + section + | _, _, Some v when is_yes v -> ( + let* es = edits ~section ~rank_of_string sec in + match Slug.of_string section with + | Ok s when es <> [] -> Ok (Overlay.Edit (s, es) :: ds) + | Ok _ -> err "section [%s]: edit = yes but no editable field given" section + | Error e -> err "section [%s]: %s" section e) + | _ -> + let* date = + match get sec "date" with + | None -> err "section [%s]: date is required" section + | Some d -> parse_date ~section d + in + let* cel = celebration ~section ~id ~rank_of_string sec in + Ok (Overlay.Add { Layer.date; cel } :: ds)) + (Ok []) entries + |> Result.map List.rev + in + Ok { Overlay.id; directives } + +let to_sexp_string rank_to_sexp t = + Printf.sprintf + ";; GENERATED by `colitur convert` from an INI overlay -- edit the INI and\n\ + ;; regenerate, or adopt this file and drop the INI, but do not maintain\n\ + ;; both. The conversion verified that this file parses back to exactly\n\ + ;; what the INI denoted.\n\ + %s\n" + (Sexplib0.Sexp.to_string_hum (Overlay.sexp_of_t rank_to_sexp t)) + +let convert ~rank_of_string ~rank_to_sexp ~rank_of_sexp text = + let* t = parse ~rank_of_string text in + let rendered = to_sexp_string rank_to_sexp t in + (* The self-check this module exists for. Parse the emitted text back with + the SAME function the engine uses, and require the result to equal what + the INI denoted. A transpiler emitting valid-but-wrong sexp is the failure + a convenience format invites, and `colitur check` could never catch it: + the output would parse cleanly and simply mean something else. *) + (* Parse the ACTUAL text about to be returned -- not a fresh serialisation of + [t], which would make this check vacuous: [t] round-tripping through + [sexp_of_t]/[t_of_sexp] is true by construction and proves nothing about + [rendered]. The first version of this function did exactly that, and a + mutation corrupting the renderer (emitting a different overlay id) sailed + straight through it and exited 0. Two tests in test_overlay_ini.ml catch + that mutation now; they did not before, because they too must parse the + RETURNED text rather than re-derive it. *) + match Sexplib.Sexp.of_string rendered with + | exception exn -> + err "internal: generated sexp does not re-parse (%s) -- this is a bug in colitur, not in your file" + (Printexc.to_string exn) + | sexp -> ( + match Overlay.t_of_sexp rank_of_sexp sexp with + | exception exn -> + err + "internal: generated sexp does not load (%s) -- this is a bug in colitur, not in your file" + (Printexc.to_string exn) + | back -> + if back = t then Ok rendered + else + err + "internal: the generated sexp does not mean what the INI said -- \ + this is a bug in colitur, not in your file. Nothing was written.") diff --git a/lib/kernel/overlay_ini.mli b/lib/kernel/overlay_ini.mli new file mode 100644 index 0000000..bace93b --- /dev/null +++ b/lib/kernel/overlay_ini.mli @@ -0,0 +1,69 @@ +(** A flat INI front end for overlay files. + + This is a CONVENIENCE FORMAT, not a second data model. It parses to exactly + the {!Overlay.t} the S-expression form parses to, and everything downstream + -- merge, diagnostics, validation -- is the same code on the same values. + There is deliberately no second semantics to keep in step. + + It is also deliberately LESS EXPRESSIVE than the sexp form. It covers [Add], + [Suppress] and single-field [Edit], which is what a diocesan or parish + calendar needs; [Replace], multi-field edits and citation edits are not + expressible and the parser says so by name rather than failing obscurely. + Anything it cannot say is a reason to write sexp, not a reason to grow this. + + {1 Format} + + Section names are slugs. A [\[overlay\]] section carries the file's id. + + {v + [overlay] + id = my-parish + + [our-patron] + date = 07-11 + rank = class-3 + colour = white + name.en = St Example, Patron + + [some-universal-slug] + suppress = yes + v} + + Dates take three forms, matching {!Date_spec}: [MM-DD], [easter+N] or + [easter-N], and [mon/day/nth] such as [oct/sun/1] or [oct/sun/-1]. *) + +(** [parse ~rank_of_string text] is the overlay [text] denotes. + + [rank_of_string] is supplied by the rite, exactly as [Overlay.load] takes + [rank_of_sexp]: the kernel does not know one rite's rank vocabulary from + another's. + + Errors carry the section name and the offending value, never a source-file + path -- this format exists for people who are not reading the source. *) +val parse : + rank_of_string:(string -> 'r option) -> string -> ('r Overlay.t, string) result + +(** [to_sexp_string t] renders [t] as the S-expression form, with a header + noting that it was generated. *) +val to_sexp_string : ('r -> Sexplib0.Sexp.t) -> 'r Overlay.t -> string + +(** [convert ~rank_of_string ~rank_to_sexp ~rank_of_sexp text] parses [text], + renders it, and PROVES the rendering before returning it: the emitted text + is parsed back with the very function the engine uses to load an overlay, + and the result must equal what the INI denoted. + + That check is the point of this module. A transpiler that emits + syntactically valid but semantically wrong output is the failure mode a + convenience format invites, and it is one [colitur check] could not catch, + since the emitted file would parse cleanly and simply mean something else. + Verifying the round trip here makes that class of bug impossible to ship + rather than merely unlikely. + + [Error] on a parse failure, and on a round-trip mismatch -- which is a bug + in this module, and says so. *) +val convert : + rank_of_string:(string -> 'r option) -> + rank_to_sexp:('r -> Sexplib0.Sexp.t) -> + rank_of_sexp:(Sexplib0.Sexp.t -> 'r) -> + string -> + (string, string) result diff --git a/man/colitur-overlay.5 b/man/colitur-overlay.5 index 00a84a7..a2d2dae 100644 --- a/man/colitur-overlay.5 +++ b/man/colitur-overlay.5 @@ -251,6 +251,98 @@ accordingly. A local feast that never appears in output has usually lost that contest rather than failed to load \(em .B colitur check will confirm it loaded. +.SH THE FLAT INI FORM +For a calendar that only adds a few local feasts, drops one or two universal +entries, and recolours nothing complicated, there is a flatter form converted +by +.BR "colitur convert" . +Section names are slugs; a +.RB [ overlay ] +section carries the id. +.RS +.nf + +[overlay] +id = my\-parish + +[our\-patron] +date = 07\-11 +rank = class\-3 +colour = white +name.en = St Example, Patron + +[our\-dedication] +date = oct/sun/1 +rank = class\-1 +colour = white +name.en = Dedication of Our Church + +[stanislaus] +edit = yes +colour = red + +[barbara] +suppress = yes +.fi +.RE +.PP +.I status +defaults to +.BR feast , +.I subject +to +.BR saint , +and +.I layer +to the file's id, so the common case \(em an ordinary local saint's feast \(em +says only what distinguishes it. Dates take the three forms +.IR MM\-DD , +.IB easter + N +or +.IB easter - N +, and +.IB mon / day / nth +such as +.B oct/sun/1 +or +.B oct/sun/\-1 +for the last. +.PP +.B This form is deliberately less expressive. +It covers +.BR Add ", " Suppress +and single\-field +.BR Edit . +.B Replace +, multi\-field edits, citation edits and +.B Remove_name +are not expressible, and the converter refuses them +.I by name +rather than dropping them silently. Anything it cannot say is a reason to +write the S\-expression form, not a reason to grow this one. +.PP +.B The conversion verifies its own output. +The generated text is parsed back with the same function that loads an +overlay, and must equal what the INI denoted; nothing is written if it does +not. This matters because a transpiler emitting +.I valid but wrong +S\-expressions is the failure a convenience format invites, and +.B colitur check +could never catch it \(em the output would parse cleanly and simply mean +something else. +.RS +.nf + +.B colitur convert my\-parish.ini > my\-parish.sexp +.B colitur check my\-parish.sexp +.fi +.RE +.PP +The conversion is a separate step rather than something +.B \-\-overlay +does invisibly, so you can read what your INI became. When a date form was +mistyped, "what did the engine actually get" is the question, and an invisible +transpile cannot answer it. .SH SEE ALSO .BR colitur (1) .SH LICENSE diff --git a/man/colitur.1 b/man/colitur.1 index 6463415..58e46ff 100644 --- a/man/colitur.1 +++ b/man/colitur.1 @@ -65,6 +65,15 @@ occurrence, commemoration and transfer. .BI readings " YEAR" The Mass reading citations, one line per day. .TP +.BI convert " FILE" .ini +Convert a flat INI overlay to the S\-expression form, on standard output. The +conversion verifies its own output before emitting it: the generated text is +parsed back with the same function that loads an overlay, and must mean +exactly what the INI said. A separate step rather than teaching +.B \-\-overlay +to sniff the extension, so you can see what your INI became. See +.BR colitur\-overlay (5). +.TP .B new\-overlay Print a starter overlay file to standard output, for redirection. Every value in it is a placeholder that will appear in @@ -373,3 +373,22 @@ to empty and to the overlay's own id: tiny.sexp: ok -- overlay tiny, 1 directive(s): 1 add, 0 suppress, 0 replace, 0 edit every directive found its target add tiny-feast + +`convert` turns the flat INI form into the S-expression one and verifies its +own output before emitting it. The full pipeline, INI to a resolved day: + + $ printf '[overlay]\nid = my-parish\n[our-patron]\ndate = 07-11\nrank = class-3\ncolour = white\nname.en = St Example\n' > p.ini + $ colitur convert p.ini > p.sexp + $ colitur check p.sexp + p.sexp: ok -- overlay my-parish, 1 directive(s): 1 add, 0 suppress, 0 replace, 0 edit + every directive found its target + add our-patron + $ colitur day 2026 --overlay p.sexp | grep '^2026-07-11' + 2026-07-11 saturday time-after-pentecost 6 our-patron class-3 white +pius-i + +What the INI form cannot express is refused by name, not dropped silently: + + $ printf '[overlay]\nid = x\n[y]\nreplace = yes\n' > r.ini + $ colitur convert r.ini + colitur: r.ini: section [y]: replace is not expressible in the INI form -- it needs a whole entry, which is what the S-expression form is for (see colitur-overlay(5)). Suppress plus a fresh section is usually what you want instead. + [2] diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 1e6b7ed..76ff685 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -2,7 +2,7 @@ let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite; - Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; + Test_overlay.suite; Test_overlay_ini.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_rite_ef.suite; Test_differential.suite; Test_oracle.suite; Test_oracle.suite_2038; Test_oracle.suite_2035; Test_golden.suite; ("lectionary", Test_lectionary.suite); diff --git a/test/test_overlay_ini.ml b/test/test_overlay_ini.ml new file mode 100644 index 0000000..65e681a --- /dev/null +++ b/test/test_overlay_ini.ml @@ -0,0 +1,152 @@ +(* The INI overlay front end. Its contract is narrow and the tests follow it: + the flat form parses to exactly the Overlay.t the sexp form would, the + conversion PROVES that before emitting, and everything it cannot express is + refused by name rather than silently dropped. *) +module OI = Colitur_kernel.Overlay_ini +module O = Colitur_kernel.Overlay +module L = Colitur_kernel.Layer +module Cel = Colitur_kernel.Celebration +module DS = Colitur_kernel.Date_spec +module S = Colitur_kernel.Slug +module Col = Colitur_kernel.Colour +module Sub = Colitur_kernel.Subject +module V = Rite_ef.Vocab_ef + +let parse = OI.parse ~rank_of_string:V.rank_of_string + +let convert = + OI.convert ~rank_of_string:V.rank_of_string ~rank_to_sexp:V.sexp_of_rank + ~rank_of_sexp:V.rank_of_sexp + +let ok_exn = function Ok v -> v | Error e -> Alcotest.failf "expected Ok, got: %s" e +let err_exn = function Error e -> e | Ok _ -> Alcotest.fail "expected Error, got Ok" + +let minimal = + {|[overlay] +id = my-parish +[our-patron] +date = 07-11 +rank = class-3 +colour = white +name.en = St Example|} + +let test_minimal () = + let t = ok_exn (parse minimal) in + Alcotest.(check string) "id" "my-parish" t.O.id; + match t.O.directives with + | [ O.Add e ] -> + Alcotest.(check string) "slug" "our-patron" (S.to_string e.L.cel.Cel.slug); + Alcotest.(check bool) "colour" true (e.L.cel.Cel.colour = Col.White); + (* status and subject default rather than being required: a local feast + is overwhelmingly an ordinary saint's feast, and making the common + case silent is the whole point of this format. *) + Alcotest.(check bool) "status defaults to Feast" true (e.L.cel.Cel.status = Cel.Feast); + Alcotest.(check bool) "subject defaults to Saint" true (e.L.cel.Cel.subject = Sub.Saint); + (* layer defaults to the file's own id, exactly as the sexp form does *) + Alcotest.(check string) "layer" "my-parish" e.L.cel.Cel.layer + | _ -> Alcotest.fail "expected one Add" + +(* All three Date_spec shapes, since a flat string has to encode what the sexp + form spells out, and getting one wrong would be silent. *) +let test_date_forms () = + let one date = + match (ok_exn (parse (Printf.sprintf "[overlay]\nid=x\n[s]\ndate=%s\nrank=class-3\ncolour=white\nname.en=N" date))).O.directives with + | [ O.Add e ] -> e.L.date + | _ -> Alcotest.fail "expected one Add" + in + Alcotest.(check bool) "MM-DD" true (one "07-11" = ok_exn (DS.fixed ~month:7 ~day:11)); + Alcotest.(check bool) "easter+N" true (one "easter+60" = ok_exn (DS.easter_offset 60)); + Alcotest.(check bool) "easter-N" true (one "easter-46" = ok_exn (DS.easter_offset (-46))); + Alcotest.(check bool) "nth weekday" true + (one "oct/sun/1" = ok_exn (DS.nth_weekday ~month:10 ~nth:1 ~weekday:Colitur_kernel.Date.Sun)); + Alcotest.(check bool) "nth weekday, from the end" true + (one "oct/sun/-1" = ok_exn (DS.nth_weekday ~month:10 ~nth:(-1) ~weekday:Colitur_kernel.Date.Sun)) + +let test_suppress_and_edit () = + let t = ok_exn (parse "[overlay]\nid=x\n[barbara]\nsuppress=yes\n[stanislaus]\nedit=yes\ncolour=red") in + match t.O.directives with + | [ O.Suppress s; O.Edit (e, [ O.Set_colour Col.Red ]) ] -> + Alcotest.(check string) "suppress" "barbara" (S.to_string s); + Alcotest.(check string) "edit" "stanislaus" (S.to_string e) + | _ -> Alcotest.fail "expected a Suppress then an Edit" + +(* THE contract of this module. convert must never hand back text that means + something other than the INI said -- a transpiler emitting valid-but-wrong + sexp is the failure a convenience format invites, and `colitur check` could + not catch it, since the output would parse cleanly and simply differ. *) +let test_convert_round_trips () = + let text = ok_exn (convert minimal) in + let reparsed = + O.t_of_sexp V.rank_of_sexp (Sexplib.Sexp.of_string (Sexplib.Sexp.to_string (Sexplib.Sexp.of_string + (let i = String.index text '(' in String.sub text i (String.length text - i))))) + in + Alcotest.(check bool) "emitted sexp means exactly what the INI did" true + (reparsed = ok_exn (parse minimal)) + +(* Every date form, through the full convert path, so the round-trip proof + covers the shapes most likely to be mis-rendered rather than just one. *) +let test_convert_round_trips_every_date_form () = + List.iter + (fun d -> + let src = Printf.sprintf "[overlay]\nid=x\n[s]\ndate=%s\nrank=class-3\ncolour=white\nname.en=N" d in + match convert src with + | Ok _ -> () + | Error e -> Alcotest.failf "convert failed to verify its own output for date %S: %s" d e) + [ "07-11"; "02-29"; "easter+60"; "easter-46"; "easter+0"; "oct/sun/1"; "oct/sun/-1"; "jan/mon/3" ] + +let test_errors_are_values_not_exceptions () = + let cases = + [ ("[s]\ndate=07-11\nrank=class-3\ncolour=white\nname.en=N", "no [overlay] section"); + ("[overlay]\nid=x\n[s]\nrank=class-3\ncolour=white\nname.en=N", "date is required"); + ("[overlay]\nid=x\n[s]\ndate=07-11\ncolour=white\nname.en=N", "rank is required"); + ("[overlay]\nid=x\n[s]\ndate=07-11\nrank=class-3\nname.en=N", "colour is required"); + ("[overlay]\nid=x\n[s]\ndate=07-11\nrank=class-3\ncolour=white", "name.<lang>"); + (* A date that matches no form at all falls through to the three-forms + message. Note 99-99 does NOT belong here: it parses as MM-DD and gets + the more specific "month 99 out of range 1..12", which is the better + error and worth not regressing. *) + ("[overlay]\nid=x\n[s]\ndate=whenever\nrank=class-3\ncolour=white\nname.en=N", "three forms"); + ("[overlay]\nid=x\n[s]\ndate=99-99\nrank=class-3\ncolour=white\nname.en=N", "month 99"); + ("[overlay]\nid=x\n[s]\nreplace=yes", "not expressible") ] + in + List.iter + (fun (src, needle) -> + let e = err_exn (parse src) in + let contains hay n = + let nl = String.length n and hl = String.length hay in + let rec at i = i + nl <= hl && (String.sub hay i nl = n || at (i + 1)) in + at 0 + in + Alcotest.(check bool) + (Printf.sprintf "error mentions %S (got: %s)" needle e) + true (contains e needle)) + cases + +(* An INI overlay must reach the engine by exactly the path a hand-written sexp + does -- if the two diverged, this format would be a second semantics rather + than a front door. *) +let test_same_result_as_handwritten_sexp () = + let from_ini = ok_exn (parse minimal) in + let handwritten = + {|((id my-parish) + (directives + ((Add ((date (Fixed (month 7) (day 11))) + (cel ((slug our-patron) (names ((en "St Example"))) + (rank Class3) (status Feast) (colour White) + (subject Saint) (citations ()) (layer my-parish))))))))|} + in + let from_sexp = O.t_of_sexp V.rank_of_sexp (Sexplib.Sexp.of_string handwritten) in + Alcotest.(check bool) "identical Overlay.t" true (from_ini = from_sexp) + +let suite = + ( "Overlay_ini", + [ Alcotest.test_case "minimal file, with defaults" `Quick test_minimal; + Alcotest.test_case "all three date forms" `Quick test_date_forms; + Alcotest.test_case "suppress and edit" `Quick test_suppress_and_edit; + Alcotest.test_case "convert verifies its own output" `Quick test_convert_round_trips; + Alcotest.test_case "convert verifies every date form" `Quick + test_convert_round_trips_every_date_form; + Alcotest.test_case "errors are values, never exceptions" `Quick + test_errors_are_values_not_exceptions; + Alcotest.test_case "an INI overlay equals the hand-written sexp" `Quick + test_same_result_as_handwritten_sexp ] ) |