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.

2 files changed, 33 insertions, 1 deletions

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 ] )