diff options
| -rw-r--r-- | lib/kernel/colour.ml | 14 | ||||
| -rw-r--r-- | lib/kernel/colour.mli | 6 | ||||
| -rw-r--r-- | lib/kernel/subject.ml | 13 | ||||
| -rw-r--r-- | lib/kernel/subject.mli | 6 | ||||
| -rw-r--r-- | test/test_colitur.ml | 2 | ||||
| -rw-r--r-- | test/test_colour.ml | 32 |
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 ] ) |