open Sexplib0.Sexp_conv type entry = Slug.t * Citation.t list [@@deriving sexp] type t = entry list [@@deriving sexp] let empty = [] let of_entries es = let sorted = List.stable_sort (fun (a, _) (b, _) -> Slug.compare a b) es in let rec dup = function | (a, _) :: ((b, _) :: _ as rest) -> if Slug.equal a b then Some a else dup rest | _ -> None in match dup sorted with | Some s -> Error (Printf.sprintf "lectionary: duplicate slug %S" (Slug.to_string s)) | None -> Ok sorted let find t s = List.assoc_opt s t let mem t s = List.mem_assoc s t let entries t = t let load path = match Sexplib.Sexp.load_sexp path with | exception Sexplib.Sexp.Parse_error e -> Error (Printf.sprintf "lectionary: %s: %s" path e.err_msg) | exception Sys_error e -> Error (Printf.sprintf "lectionary: %s" e) (* Mirrors Layer.load/Overlay.load: this sexplib version raises [Failure] for some malformed inputs (e.g. an unterminated list or string, an empty file, or a file holding more than one sexp) 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 "lectionary: %s: %s" path (Printexc.to_string exn)) | sexp -> ( match t_of_sexp sexp with | exception Sexplib0.Sexp_conv_error.Of_sexp_error (exn, _) -> Error (Printf.sprintf "lectionary: %s: %s" path (Printexc.to_string exn)) (* Defence in depth: every conversion below is currently [Of_sexp_error] (including [Slug.t_of_sexp] on a malformed slug atom), but [t_of_sexp] is derived and could raise something else after a future type change -- this catch-all is what would keep that inside [Error] too, the same reasoning as the outer one above. *) | exception exn -> Error (Printf.sprintf "lectionary: %s: %s" path (Printexc.to_string exn)) | parsed -> of_entries parsed)