rite(ef): season and rank vocabulary per RG 71-77 and RG 8

Eight seasons in canonical liturgical-year order, each carrying its RG
citation, and the four classes. season_slug_word is deliberately distinct from
season_to_string: slugs are lectionary keys adopted verbatim from lectio,
which calls Paschaltide 'easter' and Christmastide 'christmas'.

6 files changed, 126 insertions, 2 deletions

diff --git a/lib/rites/rite_ef/dune b/lib/rites/rite_ef/dune
new file mode 100644
index 0000000..26aacf3
--- /dev/null
+++ b/lib/rites/rite_ef/dune
@@ -0,0 +1,5 @@
+(library
+ (name rite_ef)
+ (libraries colitur_kernel sexplib)
+ (preprocess
+  (pps ppx_sexp_conv)))
diff --git a/lib/rites/rite_ef/vocab_ef.ml b/lib/rites/rite_ef/vocab_ef.ml
new file mode 100644
index 0000000..13e7309
--- /dev/null
+++ b/lib/rites/rite_ef/vocab_ef.ml
@@ -0,0 +1,63 @@
+(* EF (1962) season and rank vocabulary. Both are closed variants private to
+   this rite: OF code cannot name them, and this rite cannot name OF's. *)
+
+(* Seasons per RG 71-77, in canonical liturgical-year order. *)
+type season =
+  | Advent  (** RG 71 *)
+  | Christmastide  (** RG 72-73: to 13 January inclusive *)
+  | Time_after_epiphany  (** RG 77: from 14 January *)
+  | Septuagesima  (** RG 73 *)
+  | Lent  (** RG 74 *)
+  | Passiontide  (** RG 75 *)
+  | Paschaltide  (** RG 76 *)
+  | Time_after_pentecost  (** RG 77 *)
+[@@deriving sexp]
+
+(* RG 8: "Dies liturgici sunt primae, secundae, tertiae aut quartae classis." *)
+type rank = Class1 | Class2 | Class3 | Class4 [@@deriving sexp]
+
+let seasons =
+  [ Advent; Christmastide; Time_after_epiphany; Septuagesima; Lent; Passiontide;
+    Paschaltide; Time_after_pentecost ]
+
+let ranks = [ Class1; Class2; Class3; Class4 ]
+
+let season_to_string = function
+  | Advent -> "advent"
+  | Christmastide -> "christmastide"
+  | Time_after_epiphany -> "time-after-epiphany"
+  | Septuagesima -> "septuagesima"
+  | Lent -> "lent"
+  | Passiontide -> "passiontide"
+  | Paschaltide -> "paschaltide"
+  | Time_after_pentecost -> "time-after-pentecost"
+
+let season_of_string = function
+  | "advent" -> Some Advent
+  | "christmastide" -> Some Christmastide
+  | "time-after-epiphany" -> Some Time_after_epiphany
+  | "septuagesima" -> Some Septuagesima
+  | "lent" -> Some Lent
+  | "passiontide" -> Some Passiontide
+  | "paschaltide" -> Some Paschaltide
+  | "time-after-pentecost" -> Some Time_after_pentecost
+  | _ -> None
+
+(* Deliberately NOT season_to_string: slugs are lectionary keys adopted verbatim
+   from lectio, which names these two seasons differently. Changing these words
+   would silently break the Plan 3 lectionary bootstrap. *)
+let season_slug_word = function
+  | Christmastide -> "christmas"
+  | Paschaltide -> "easter"
+  | s -> season_to_string s
+
+let rank_to_string = function
+  | Class1 -> "class-1" | Class2 -> "class-2" | Class3 -> "class-3" | Class4 -> "class-4"
+
+let rank_of_string = function
+  | "class-1" -> Some Class1 | "class-2" -> Some Class2
+  | "class-3" -> Some Class3 | "class-4" -> Some Class4
+  | _ -> None
+
+let vocab : (season, rank) Colitur_kernel.Vocab.t =
+  { seasons; season_to_string; season_of_string; ranks; rank_to_string; rank_of_string }
diff --git a/lib/rites/rite_ef/vocab_ef.mli b/lib/rites/rite_ef/vocab_ef.mli
new file mode 100644
index 0000000..7607cc1
--- /dev/null
+++ b/lib/rites/rite_ef/vocab_ef.mli
@@ -0,0 +1,28 @@
+(** EF (1962) season and rank vocabulary. *)
+
+type season =
+  | Advent
+  | Christmastide
+  | Time_after_epiphany
+  | Septuagesima
+  | Lent
+  | Passiontide
+  | Paschaltide
+  | Time_after_pentecost
+[@@deriving sexp]
+
+type rank = Class1 | Class2 | Class3 | Class4 [@@deriving sexp]
+
+val seasons : season list
+val ranks : rank list
+val season_to_string : season -> string
+val season_of_string : string -> season option
+
+(** The word used when building a slug. Deliberately differs from
+    {!season_to_string} for [Christmastide] ("christmas") and [Paschaltide]
+    ("easter"), because slugs are lectionary keys adopted verbatim from lectio. *)
+val season_slug_word : season -> string
+
+val rank_to_string : rank -> string
+val rank_of_string : string -> rank option
+val vocab : (season, rank) Colitur_kernel.Vocab.t
diff --git a/test/dune b/test/dune
index 34f5888..07a4aae 100644
--- a/test/dune
+++ b/test/dune
@@ -1,6 +1,6 @@
 (test
  (name test_colitur)
- (libraries colitur_kernel alcotest qcheck qcheck-alcotest sexplib)
+ (libraries colitur_kernel rite_ef alcotest qcheck qcheck-alcotest sexplib)
  (preprocess
   (pps ppx_sexp_conv)))
 
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index 2f5e87a..293e439 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -2,4 +2,4 @@
 let () =
   Alcotest.run "colitur"
     [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite;
-      Test_overlay.suite ]
+      Test_overlay.suite; Test_temporal_ef.suite ]
diff --git a/test/test_temporal_ef.ml b/test/test_temporal_ef.ml
new file mode 100644
index 0000000..f7851c1
--- /dev/null
+++ b/test/test_temporal_ef.ml
@@ -0,0 +1,28 @@
+module V = Rite_ef.Vocab_ef
+
+let test_vocab_roundtrips () =
+  List.iter
+    (fun s ->
+      Alcotest.(check bool) "season string roundtrip" true
+        (V.season_of_string (V.season_to_string s) = Some s))
+    V.seasons;
+  List.iter
+    (fun r ->
+      Alcotest.(check bool) "rank string roundtrip" true
+        (V.rank_of_string (V.rank_to_string r) = Some r))
+    V.ranks;
+  Alcotest.(check int) "eight seasons" 8 (List.length V.seasons);
+  Alcotest.(check int) "four ranks" 4 (List.length V.ranks)
+
+(* Slug words are lectio's lectionary-key vocabulary, deliberately distinct from
+   the season names (spec §4.4, plan correction 2). *)
+let test_slug_words () =
+  Alcotest.(check string) "paschaltide slugs as easter" "easter" (V.season_slug_word V.Paschaltide);
+  Alcotest.(check string) "christmastide slugs as christmas" "christmas"
+    (V.season_slug_word V.Christmastide);
+  Alcotest.(check string) "season name differs" "paschaltide" (V.season_to_string V.Paschaltide)
+
+let suite =
+  ( "Rite_ef",
+    [ Alcotest.test_case "vocab roundtrips" `Quick test_vocab_roundtrips;
+      Alcotest.test_case "slug words" `Quick test_slug_words ] )