diff options
| -rw-r--r-- | lib/kernel/celebration.ml | 20 | ||||
| -rw-r--r-- | lib/kernel/celebration.mli | 16 | ||||
| -rw-r--r-- | lib/kernel/temporal.ml | 26 | ||||
| -rw-r--r-- | lib/kernel/temporal.mli | 24 | ||||
| -rw-r--r-- | lib/kernel/vocab.ml | 19 | ||||
| -rw-r--r-- | lib/kernel/vocab.mli | 19 | ||||
| -rw-r--r-- | test/dune | 4 | ||||
| -rw-r--r-- | test/test_names.ml | 22 |
8 files changed, 148 insertions, 2 deletions
diff --git a/lib/kernel/celebration.ml b/lib/kernel/celebration.ml new file mode 100644 index 0000000..3f7a577 --- /dev/null +++ b/lib/kernel/celebration.ml @@ -0,0 +1,20 @@ +open Sexplib0.Sexp_conv + +(* A celebration as computed or as loaded from a layer. + + One type parameter, not two: the record has no season field, and OCaml + rejects a type variable that appears in no field. *) +type 'r t = { + slug : Slug.t; + names : Names.t; + rank : 'r; + colour : Colour.t; + subject : Subject.t; + citations : Citation.t list; + layer : string; (** provenance: "temporal", a layer id, or an overlay id *) +} +[@@deriving sexp] + +let make ~slug ?(names = Names.empty) ~rank ~colour ?(subject = Subject.Temporal) + ?(citations = []) ~layer () = + { slug; names; rank; colour; subject; citations; layer } diff --git a/lib/kernel/celebration.mli b/lib/kernel/celebration.mli new file mode 100644 index 0000000..1c84d35 --- /dev/null +++ b/lib/kernel/celebration.mli @@ -0,0 +1,16 @@ +(** A celebration. Parameterised by the rite's rank type only. *) +type 'r t = { + slug : Slug.t; + names : Names.t; + rank : 'r; + colour : Colour.t; + subject : Subject.t; + citations : Citation.t list; + layer : string; +} +[@@deriving sexp] + +(** [subject] defaults to [Subject.Temporal], [names] to empty, [citations] to []. *) +val make : + slug:Slug.t -> ?names:Names.t -> rank:'r -> colour:Colour.t -> + ?subject:Subject.t -> ?citations:Citation.t list -> layer:string -> unit -> 'r t diff --git a/lib/kernel/temporal.ml b/lib/kernel/temporal.ml new file mode 100644 index 0000000..a34eeb0 --- /dev/null +++ b/lib/kernel/temporal.ml @@ -0,0 +1,26 @@ +open Sexplib0.Sexp_conv + +(* The temporal identity of a date: where in the liturgical year it sits, and + the temporal cycle's own office for it. *) +type ('s, 'r) t = { + season : 's; + week : int option; (** [None] for named days outside a numbered week *) + weekday : Date.weekday; + office : 'r Celebration.t; +} +[@@deriving sexp] + +module type RITE = sig + val id : string + + type season + type rank + + val vocab : (season, rank) Vocab.t + + (** First day of the liturgical year opening in civil year [y]. *) + val year_start : int -> Date.t + + (** Total over 1583..9999: every date yields exactly one temporal identity. *) + val temporal : Date.t -> (season, rank) t +end diff --git a/lib/kernel/temporal.mli b/lib/kernel/temporal.mli new file mode 100644 index 0000000..055f9aa --- /dev/null +++ b/lib/kernel/temporal.mli @@ -0,0 +1,24 @@ +(** The temporal identity of a date: where in the liturgical year it sits, and + the temporal cycle's own office for it. *) +type ('s, 'r) t = { + season : 's; + week : int option; (** [None] for named days outside a numbered week *) + weekday : Date.weekday; + office : 'r Celebration.t; +} +[@@deriving sexp] + +module type RITE = sig + val id : string + + type season + type rank + + val vocab : (season, rank) Vocab.t + + (** First day of the liturgical year opening in civil year [y]. *) + val year_start : int -> Date.t + + (** Total over 1583..9999: every date yields exactly one temporal identity. *) + val temporal : Date.t -> (season, rank) t +end diff --git a/lib/kernel/vocab.ml b/lib/kernel/vocab.ml new file mode 100644 index 0000000..78729bb --- /dev/null +++ b/lib/kernel/vocab.ml @@ -0,0 +1,19 @@ +(* A rite's season and rank vocabulary, as a record of operations. Carries + functions, so it has no sexp form. + + The kernel is parameterised by type variables plus this record rather than by + functors (spec §2.3): the safety that matters -- EF code cannot name an OF + season -- is the same either way, and ppx_sexp_conv derives converters for + parametric types natively. *) +type ('s, 'r) t = { + seasons : 's list; + (** canonical liturgical-year order; Validate's contiguity check reads this *) + season_to_string : 's -> string; + season_of_string : string -> 's option; + ranks : 'r list; + (** documentation order, highest first. Plan 2 uses it only for the + closure check -- it is not a precedence relation until Plan 3 + defines one. *) + rank_to_string : 'r -> string; + rank_of_string : string -> 'r option; +} diff --git a/lib/kernel/vocab.mli b/lib/kernel/vocab.mli new file mode 100644 index 0000000..78729bb --- /dev/null +++ b/lib/kernel/vocab.mli @@ -0,0 +1,19 @@ +(* A rite's season and rank vocabulary, as a record of operations. Carries + functions, so it has no sexp form. + + The kernel is parameterised by type variables plus this record rather than by + functors (spec §2.3): the safety that matters -- EF code cannot name an OF + season -- is the same either way, and ppx_sexp_conv derives converters for + parametric types natively. *) +type ('s, 'r) t = { + seasons : 's list; + (** canonical liturgical-year order; Validate's contiguity check reads this *) + season_to_string : 's -> string; + season_of_string : string -> 's option; + ranks : 'r list; + (** documentation order, highest first. Plan 2 uses it only for the + closure check -- it is not a precedence relation until Plan 3 + defines one. *) + rank_to_string : 'r -> string; + rank_of_string : string -> 'r option; +} @@ -1,6 +1,8 @@ (test (name test_colitur) - (libraries colitur_kernel alcotest qcheck qcheck-alcotest sexplib)) + (libraries colitur_kernel alcotest qcheck qcheck-alcotest sexplib) + (preprocess + (pps ppx_sexp_conv))) (cram (deps %{bin:colitur})) diff --git a/test/test_names.ml b/test/test_names.ml index 9db8217..f340c62 100644 --- a/test/test_names.ml +++ b/test/test_names.ml @@ -74,6 +74,25 @@ let test_date_spec_sexp_roundtrip () = Alcotest.(check bool) "sexp roundtrip" true (ds = ds') | Error e -> Alcotest.failf "fixed: %s" e) +module Cel = Colitur_kernel.Celebration +module S = Colitur_kernel.Slug +module Col = Colitur_kernel.Colour +module Sub = Colitur_kernel.Subject + +(* A throwaway rank vocabulary, to exercise the parametric type. *) +type demo_rank = High | Low [@@deriving sexp] + +let test_celebration () = + let c = + 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 + Alcotest.(check string) "slug" "ef-easter-sunday" (S.to_string c.Cel.slug); + Alcotest.(check bool) "default citations empty" true (c.Cel.citations = []); + 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) + let suite = ( "Names/Citation/DateSpec", [ Alcotest.test_case "names basics" `Quick test_names_basics; @@ -83,4 +102,5 @@ let suite = Alcotest.test_case "names sexp roundtrip" `Quick test_names_sexp_roundtrip; 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 "date_spec sexp roundtrip" `Quick test_date_spec_sexp_roundtrip; + Alcotest.test_case "celebration" `Quick test_celebration ] ) |