kernel: Colour and Subject shared vocabulary

The six liturgical colours and the Lord/BVM/saint/temporal distinction are
common to both Roman forms, so they are shared closed variants rather than
rite-parametric. Subject is so named because class is an OCaml keyword.

6 files changed, 72 insertions, 1 deletions

diff --git a/lib/kernel/colour.ml b/lib/kernel/colour.ml
new file mode 100644
index 0000000..c7f81c2
--- /dev/null
+++ b/lib/kernel/colour.ml
@@ -0,0 +1,14 @@
+(* Liturgical colours. Shared across Roman rites (spec §2.1): not
+   rite-parametric, because EF and OF use the same six. *)
+type t = White | Red | Green | Violet | Rose | Black [@@deriving sexp]
+
+let all = [ White; Red; Green; Violet; Rose; Black ]
+
+let to_string = function
+  | White -> "white" | Red -> "red" | Green -> "green"
+  | Violet -> "violet" | Rose -> "rose" | Black -> "black"
+
+let of_string = function
+  | "white" -> Some White | "red" -> Some Red | "green" -> Some Green
+  | "violet" -> Some Violet | "rose" -> Some Rose | "black" -> Some Black
+  | _ -> None
diff --git a/lib/kernel/colour.mli b/lib/kernel/colour.mli
new file mode 100644
index 0000000..f419ecb
--- /dev/null
+++ b/lib/kernel/colour.mli
@@ -0,0 +1,6 @@
+(** Liturgical colours, shared by all Roman rites. *)
+type t = White | Red | Green | Violet | Rose | Black [@@deriving sexp]
+
+val all : t list
+val to_string : t -> string
+val of_string : string -> t option
diff --git a/lib/kernel/subject.ml b/lib/kernel/subject.ml
new file mode 100644
index 0000000..000aaff
--- /dev/null
+++ b/lib/kernel/subject.ml
@@ -0,0 +1,13 @@
+(* Whom the celebration is of. Named [Subject] rather than [Class] because
+   [class] is an OCaml keyword. Used by precedence in Plan 3 (RG 91). *)
+type t = Temporal | Saint | Bvm | Lord [@@deriving sexp]
+
+let all = [ Temporal; Saint; Bvm; Lord ]
+
+let to_string = function
+  | Temporal -> "temporal" | Saint -> "saint" | Bvm -> "bvm" | Lord -> "lord"
+
+let of_string = function
+  | "temporal" -> Some Temporal | "saint" -> Some Saint
+  | "bvm" -> Some Bvm | "lord" -> Some Lord
+  | _ -> None
diff --git a/lib/kernel/subject.mli b/lib/kernel/subject.mli
new file mode 100644
index 0000000..443364d
--- /dev/null
+++ b/lib/kernel/subject.mli
@@ -0,0 +1,6 @@
+(** Whom a celebration is of. [Temporal] is the temporal cycle's own office. *)
+type t = Temporal | Saint | Bvm | Lord [@@deriving sexp]
+
+val all : t list
+val to_string : t -> string
+val of_string : string -> t option
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index 19671ce..c6c5b91 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -1,2 +1,2 @@
 (* Aggregating test runner. Per-module suites live in test_<module>.ml. *)
-let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite ]
+let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite; Test_colour.suite ]
diff --git a/test/test_colour.ml b/test/test_colour.ml
new file mode 100644
index 0000000..0f41f11
--- /dev/null
+++ b/test/test_colour.ml
@@ -0,0 +1,32 @@
+module C = Colitur_kernel.Colour
+module S = Colitur_kernel.Subject
+
+let test_colour_strings () =
+  Alcotest.(check string) "violet" "violet" (C.to_string C.Violet);
+  Alcotest.(check bool) "of_string rose" true (C.of_string "rose" = Some C.Rose);
+  Alcotest.(check bool) "of_string junk" true (C.of_string "puce" = None);
+  Alcotest.(check int) "all has six" 6 (List.length C.all)
+
+let test_subject_strings () =
+  Alcotest.(check string) "bvm" "bvm" (S.to_string S.Bvm);
+  Alcotest.(check bool) "of_string lord" true (S.of_string "lord" = Some S.Lord);
+  Alcotest.(check int) "all has four" 4 (List.length S.all)
+
+(* Every constructor round-trips through both string and sexp. *)
+let test_roundtrips () =
+  List.iter
+    (fun c ->
+      Alcotest.(check bool) "colour string roundtrip" true (C.of_string (C.to_string c) = Some c);
+      Alcotest.(check bool) "colour sexp roundtrip" true (C.t_of_sexp (C.sexp_of_t c) = c))
+    C.all;
+  List.iter
+    (fun s ->
+      Alcotest.(check bool) "subject string roundtrip" true (S.of_string (S.to_string s) = Some s);
+      Alcotest.(check bool) "subject sexp roundtrip" true (S.t_of_sexp (S.sexp_of_t s) = s))
+    S.all
+
+let suite =
+  ( "Colour/Subject",
+    [ Alcotest.test_case "colour strings" `Quick test_colour_strings;
+      Alcotest.test_case "subject strings" `Quick test_subject_strings;
+      Alcotest.test_case "roundtrips" `Quick test_roundtrips ] )