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

(* Stable celebration identifiers. Also the lectionary key: EF slugs are adopted
   verbatim from lectio so the Plan 3 lectionary bootstrap needs no mapping
   table (spec §4.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