lib/kernel/slug.ml


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

(* Stable celebration identifiers. Also the lectionary key: EF slugs are adopted
   verbatim from lectio so the Plan 4 lectionary bootstrap needs no mapping
   table (spec §4.4). CORRECTED (final fix wave, item 7): this comment said
   "Plan 3" -- the SANCTORAL bootstrap (data/ef/sanctoral.sexp) is Plan 3 and
   shipped in this branch; the LECTIONARY bootstrap (reading citations,
   Liturgical_day.t's own [citations] field) is a separate, later Plan 4,
   per that field's own doc comment ("always empty until Plan 4"). *)
type t = string

let valid_char c = (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c = '-'

let of_string s =
  if String.length s = 0 then Error "slug: empty"
  else if not (String.for_all valid_char s) then
    Error (Printf.sprintf "slug %S: only [a-z0-9-] allowed" s)
  else if s.[0] = '-' || s.[String.length s - 1] = '-' then
    Error (Printf.sprintf "slug %S: must not start or end with '-'" s)
  else Ok s

let of_string_exn s = match of_string s with Ok t -> t | Error e -> invalid_arg e
let to_string t = t
let compare = String.compare
let equal = String.equal

let sexp_of_t t = Sexplib0.Sexp_conv.sexp_of_string t

(* Validating parser: a malformed slug in a data file is an error, never a
   silently-accepted value. Loaders convert the exception to a [result]. *)
let t_of_sexp sexp =
  let s = Sexplib0.Sexp_conv.string_of_sexp sexp in
  match of_string s with
  | Ok t -> t
  | Error msg -> Sexplib0.Sexp_conv.of_sexp_error msg sexp