kernel(celebration): distinguish a feast from a commemoration-only entry

The 1960 reform reduced many feasts to a bare commemoration. They keep a rank,
because RG 111 orders admitted commemorations by dignity, but they can never be
the observed day. Modelled as a separate status rather than a fifth rank: RG 8
fixes the classes at four.

3 files changed, 35 insertions, 5 deletions

diff --git a/lib/kernel/celebration.ml b/lib/kernel/celebration.ml
index 2963366..eb4249e 100644
--- a/lib/kernel/celebration.ml
+++ b/lib/kernel/celebration.ml
@@ -8,10 +8,17 @@ open Sexplib0.Sexp_conv
    but would carry no information while forcing every consumer (Layer,
    Overlay, and later Precedence and Calendar) to thread a variable that
    means nothing. *)
+(* Whether this celebration can be the observed day at all. The 1960 reform
+   reduced many feasts to a bare commemoration; they retain a rank (RG 111 orders
+   admitted commemorations by dignity) but can never be observed. NOT a fifth
+   rank: RG 8 fixes the classes at four. *)
+type status = Feast | Commemoration_only [@@deriving sexp]
+
 type 'r t = {
   slug : Slug.t;
   names : Names.t;
   rank : 'r;
+  status : status;
   colour : Colour.t;
   subject : Subject.t;
   citations : Citation.t list;
@@ -19,6 +26,6 @@ type 'r t = {
 }
 [@@deriving sexp]
 
-let make ~slug ?(names = Names.empty) ~rank ~colour ?(subject = Subject.Temporal)
-    ?(citations = []) ~layer () =
-  { slug; names; rank; colour; subject; citations; layer }
+let make ~slug ?(names = Names.empty) ~rank ?(status = Feast) ~colour
+    ?(subject = Subject.Temporal) ?(citations = []) ~layer () =
+  { slug; names; rank; status; colour; subject; citations; layer }
diff --git a/lib/kernel/celebration.mli b/lib/kernel/celebration.mli
index 1c84d35..a3c2960 100644
--- a/lib/kernel/celebration.mli
+++ b/lib/kernel/celebration.mli
@@ -1,8 +1,15 @@
+(** Whether this celebration can be the observed day at all. The 1960 reform
+    reduced many feasts to a bare commemoration; they retain a rank (RG 111
+    orders admitted commemorations by dignity) but can never be observed. NOT
+    a fifth rank: RG 8 fixes the classes at four. *)
+type status = Feast | Commemoration_only [@@deriving sexp]
+
 (** A celebration. Parameterised by the rite's rank type only. *)
 type 'r t = {
   slug : Slug.t;
   names : Names.t;
   rank : 'r;
+  status : status;
   colour : Colour.t;
   subject : Subject.t;
   citations : Citation.t list;
@@ -10,7 +17,8 @@ type 'r t = {
 }
 [@@deriving sexp]
 
-(** [subject] defaults to [Subject.Temporal], [names] to empty, [citations] to []. *)
+(** [status] defaults to [Feast], [subject] to [Subject.Temporal], [names] to
+    empty, [citations] to []. *)
 val make :
-  slug:Slug.t -> ?names:Names.t -> rank:'r -> colour:Colour.t ->
+  slug:Slug.t -> ?names:Names.t -> rank:'r -> ?status:status -> colour:Colour.t ->
   ?subject:Subject.t -> ?citations:Citation.t list -> layer:string -> unit -> 'r t
diff --git a/test/test_names.ml b/test/test_names.ml
index 809d1c0..cef7357 100644
--- a/test/test_names.ml
+++ b/test/test_names.ml
@@ -111,6 +111,20 @@ let test_celebration () =
   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 test_celebration_status () =
+  let c =
+    Cel.make ~slug:(S.of_string_exn "telesphorus") ~rank:High ~colour:Col.Red
+      ~subject:Sub.Saint ~layer:"tridentine" ()
+  in
+  Alcotest.(check bool) "defaults to Feast" true (c.Cel.status = Cel.Feast);
+  let k =
+    Cel.make ~slug:(S.of_string_exn "hyginus") ~rank:High ~colour:Col.Red
+      ~status:Cel.Commemoration_only ~subject:Sub.Saint ~layer:"tridentine" ()
+  in
+  Alcotest.(check bool) "explicit status" true (k.Cel.status = Cel.Commemoration_only);
+  let sexp = Cel.sexp_of_t sexp_of_demo_rank k in
+  Alcotest.(check bool) "sexp roundtrip" true (Cel.t_of_sexp demo_rank_of_sexp sexp = k)
+
 module Rec = Colitur_kernel.Record
 module Voc = Colitur_kernel.Vocab
 module Tmp = Colitur_kernel.Temporal
@@ -174,4 +188,5 @@ let suite =
       Alcotest.test_case "date_spec sexp roundtrip" `Quick test_date_spec_sexp_roundtrip;
       Alcotest.test_case "date_spec sexp validates" `Quick test_date_spec_sexp_validates;
       Alcotest.test_case "celebration" `Quick test_celebration;
+      Alcotest.test_case "celebration status" `Quick test_celebration_status;
       Alcotest.test_case "record" `Quick test_record ] )