diff options
| -rw-r--r-- | lib/kernel/record.ml | 40 | ||||
| -rw-r--r-- | lib/kernel/record.mli | 23 | ||||
| -rw-r--r-- | test/test_names.ml | 43 |
3 files changed, 105 insertions, 1 deletions
diff --git a/lib/kernel/record.ml b/lib/kernel/record.ml new file mode 100644 index 0000000..af55f07 --- /dev/null +++ b/lib/kernel/record.ml @@ -0,0 +1,40 @@ +(* The canonical flat output view (spec ยง2.4). Rite-parametric types stop here: + every field is a string, so CSV, JSON and the template engine never see a + type variable. *) +type t = { + date : string; + rite : string; + season : string; + week : string; (** "" when the day is outside a numbered week *) + weekday : string; + slug : string; + rank : string; + colour : string; + subject : string; + names : (string * string) list; + citations : (string * string) list; +} + +let of_temporal ~rite vocab date (t : ('s, 'r) Temporal.t) = + let cel = t.Temporal.office in + { + date = Date.to_iso8601 date; + rite; + season = vocab.Vocab.season_to_string t.Temporal.season; + week = (match t.Temporal.week with Some n -> string_of_int n | None -> ""); + weekday = Date.weekday_to_string t.Temporal.weekday; + slug = Slug.to_string cel.Celebration.slug; + rank = vocab.Vocab.rank_to_string cel.Celebration.rank; + colour = Colour.to_string cel.Celebration.colour; + subject = Subject.to_string cel.Celebration.subject; + names = List.map (fun (l, n) -> (Lang.to_string l, n)) (Names.to_list cel.Celebration.names); + citations = + List.map (fun c -> (Citation.part_to_string c.Citation.part, c.Citation.reference)) + cel.Celebration.citations; + } + +let headers = + [ "date"; "rite"; "season"; "week"; "weekday"; "slug"; "rank"; "colour"; "subject" ] + +let to_row r = + [ r.date; r.rite; r.season; r.week; r.weekday; r.slug; r.rank; r.colour; r.subject ] diff --git a/lib/kernel/record.mli b/lib/kernel/record.mli new file mode 100644 index 0000000..858f125 --- /dev/null +++ b/lib/kernel/record.mli @@ -0,0 +1,23 @@ +(** The canonical flat output view: one row per day, every field a string. This + is the boundary at which rite-parametric types stop. *) +type t = { + date : string; + rite : string; + season : string; + week : string; + weekday : string; + slug : string; + rank : string; + colour : string; + subject : string; + names : (string * string) list; + citations : (string * string) list; +} + +val of_temporal : rite:string -> ('s, 'r) Vocab.t -> Date.t -> ('s, 'r) Temporal.t -> t + +(** Column names for [to_row]. Names and citations are excluded: they are + variable-arity and belong to richer encodings, added in Plan 5. *) +val headers : string list + +val to_row : t -> string list diff --git a/test/test_names.ml b/test/test_names.ml index f340c62..3ddf79c 100644 --- a/test/test_names.ml +++ b/test/test_names.ml @@ -93,6 +93,46 @@ let test_celebration () = let sexp = Cel.sexp_of_t sexp_of_demo_rank c in Alcotest.(check bool) "sexp roundtrip" true (Cel.t_of_sexp demo_rank_of_sexp sexp = c) +module Rec = Colitur_kernel.Record +module Voc = Colitur_kernel.Vocab +module Tmp = Colitur_kernel.Temporal + +type demo_season = Ordinary [@@deriving sexp] + +let demo_vocab : (demo_season, demo_rank) Voc.t = + { seasons = [ Ordinary ]; + season_to_string = (fun Ordinary -> "ordinary"); + season_of_string = (function "ordinary" -> Some Ordinary | _ -> None); + ranks = [ High; Low ]; + rank_to_string = (function High -> "high" | Low -> "low"); + rank_of_string = (function "high" -> Some High | "low" -> Some Low | _ -> None) } + +let test_record () = + let date = match D.make ~year:2026 ~month:4 ~day:5 with + | Ok d -> d | Error e -> Alcotest.failf "%s" e + in + let office = + Cel.make ~slug:(S.of_string_exn "ef-easter-sunday") + ~names:(N.of_list [ (lang "la", "Dominica Resurrectionis") ]) + ~rank:High ~colour:Col.White ~subject:Sub.Lord ~layer:"temporal" () + in + let t = { Tmp.season = Ordinary; week = Some 1; weekday = D.Sun; office } in + let r = Rec.of_temporal ~rite:"ef" demo_vocab date t in + Alcotest.(check string) "date" "2026-04-05" r.Rec.date; + Alcotest.(check string) "season" "ordinary" r.Rec.season; + Alcotest.(check string) "week" "1" r.Rec.week; + Alcotest.(check string) "weekday" "sunday" r.Rec.weekday; + Alcotest.(check string) "rank" "high" r.Rec.rank; + Alcotest.(check string) "colour" "white" r.Rec.colour; + Alcotest.(check string) "subject" "lord" r.Rec.subject; + Alcotest.(check (list string)) "names flattened" [ "la" ] + (List.map fst r.Rec.names); + (* A day outside a numbered week renders week as the empty string, not "0". *) + let r' = Rec.of_temporal ~rite:"ef" demo_vocab date { t with Tmp.week = None } in + Alcotest.(check string) "no week" "" r'.Rec.week; + Alcotest.(check int) "row matches headers" (List.length Rec.headers) + (List.length (Rec.to_row r)) + let suite = ( "Names/Citation/DateSpec", [ Alcotest.test_case "names basics" `Quick test_names_basics; @@ -103,4 +143,5 @@ let suite = Alcotest.test_case "citation" `Quick test_citation; Alcotest.test_case "date_spec" `Quick test_date_spec; Alcotest.test_case "date_spec sexp roundtrip" `Quick test_date_spec_sexp_roundtrip; - Alcotest.test_case "celebration" `Quick test_celebration ] ) + Alcotest.test_case "celebration" `Quick test_celebration; + Alcotest.test_case "record" `Quick test_record ] ) |