diff options
Diffstat (limited to 'lib/kernel')
| -rw-r--r-- | lib/kernel/layer.ml | 56 | ||||
| -rw-r--r-- | lib/kernel/layer.mli | 25 |
2 files changed, 81 insertions, 0 deletions
diff --git a/lib/kernel/layer.ml b/lib/kernel/layer.ml new file mode 100644 index 0000000..bf71206 --- /dev/null +++ b/lib/kernel/layer.ml @@ -0,0 +1,56 @@ +open Sexplib0.Sexp_conv + +(* One calendar layer: a rite's base sanctoral, or any data file with the same + shape. Entries are kept sorted by slug as the canonical form, so equal layers + serialise identically and merge results do not depend on input order. *) +type 'r entry = { date : Date_spec.t; cel : 'r Celebration.t } [@@deriving sexp] +type 'r t = { id : string; name : string; entries : 'r entry list } [@@deriving sexp] + +let by_slug a b = Slug.compare a.cel.Celebration.slug b.cel.Celebration.slug +let canonical entries = List.sort by_slug entries +let empty ~id ~name = { id; name; entries = [] } +let of_entries ~id ~name entries = { id; name; entries = canonical entries } +let find t slug = List.find_opt (fun e -> Slug.equal e.cel.Celebration.slug slug) t.entries +let mem t slug = find t slug <> None + +let remove t slug = + { t with entries = List.filter (fun e -> not (Slug.equal e.cel.Celebration.slug slug)) t.entries } + +let set t entry = + let t = remove t entry.cel.Celebration.slug in + { t with entries = canonical (entry :: t.entries) } + +(* Dates are year-independent, so the index is built once per layer rather than + once per year -- a full 1583..9999 sweep would otherwise rescan the entry + list for every day. *) +type 'r by_date = (int * int, 'r entry list) Hashtbl.t + +let key = function Date_spec.Fixed { month; day } -> (month, day) + +let index_by_date t = + let tbl : 'r by_date = Hashtbl.create 512 in + List.iter + (fun e -> + let k = key e.date in + Hashtbl.replace tbl k (e :: (try Hashtbl.find tbl k with Not_found -> []))) + t.entries; + (* restore canonical order within each date bucket *) + Hashtbl.iter (fun k v -> Hashtbl.replace tbl k (canonical v)) tbl; + tbl + +let on_date tbl ~month ~day = + try Hashtbl.find tbl (month, day) with Not_found -> [] + +let load rank_of_sexp path = + match Sexplib.Sexp.load_sexp path with + | exception Sys_error msg -> Error msg + (* This sexplib version raises [Failure] for some malformed inputs (e.g. an + unterminated list or string) rather than [Sexplib.Sexp.Parse_error], so a + catch-all here -- placed last among the exception branches -- is what + actually keeps every parse failure inside [Error] instead of escaping. *) + | exception exn -> Error (Printf.sprintf "%s: %s" path (Printexc.to_string exn)) + | sexp -> ( + match t_of_sexp rank_of_sexp sexp with + | t -> Ok { t with entries = canonical t.entries } + | exception Sexplib0.Sexp_conv_error.Of_sexp_error (exn, _) -> + Error (Printf.sprintf "%s: %s" path (Printexc.to_string exn))) diff --git a/lib/kernel/layer.mli b/lib/kernel/layer.mli new file mode 100644 index 0000000..3092353 --- /dev/null +++ b/lib/kernel/layer.mli @@ -0,0 +1,25 @@ +(** One calendar layer: a rite's base sanctoral, or a data file of the same + shape. Entries are canonically sorted by slug. *) +type 'r entry = { date : Date_spec.t; cel : 'r Celebration.t } [@@deriving sexp] +type 'r t = { id : string; name : string; entries : 'r entry list } [@@deriving sexp] + +val empty : id:string -> name:string -> 'r t +val of_entries : id:string -> name:string -> 'r entry list -> 'r t +val find : 'r t -> Slug.t -> 'r entry option +val mem : 'r t -> Slug.t -> bool + +(** Replaces any entry with the same slug. *) +val set : 'r t -> 'r entry -> 'r t + +val remove : 'r t -> Slug.t -> 'r t + +(** Date index. Built once per layer, not per year: [Date_spec] dates are + year-independent. *) +type 'r by_date + +val index_by_date : 'r t -> 'r by_date +val on_date : 'r by_date -> month:int -> day:int -> 'r entry list + +(** Loads a layer from a sexp file. Parse and validation failures come back as + [Error], never as an exception. *) +val load : (Sexplib0.Sexp.t -> 'r) -> string -> ('r t, string) result |
