diff options
Diffstat (limited to 'lib/kernel')
| -rw-r--r-- | lib/kernel/lang.ml | 23 | ||||
| -rw-r--r-- | lib/kernel/lang.mli | 11 | ||||
| -rw-r--r-- | lib/kernel/slug.ml | 29 | ||||
| -rw-r--r-- | lib/kernel/slug.mli | 16 |
4 files changed, 79 insertions, 0 deletions
diff --git a/lib/kernel/lang.ml b/lib/kernel/lang.ml new file mode 100644 index 0000000..3f45f59 --- /dev/null +++ b/lib/kernel/lang.ml @@ -0,0 +1,23 @@ +(* Language codes for celebration names. Two-letter lowercase ISO-639-1; the set + is open so an overlay can add a language without a code change (spec §2.1). *) +type t = string + +let of_string s = + if String.length s <> 2 then + Error (Printf.sprintf "lang %S: expected a 2-letter ISO-639-1 code" s) + else if not (String.for_all (fun c -> c >= 'a' && c <= 'z') s) then + Error (Printf.sprintf "lang %S: must be lowercase a-z" 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 + +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 diff --git a/lib/kernel/lang.mli b/lib/kernel/lang.mli new file mode 100644 index 0000000..6d26a1d --- /dev/null +++ b/lib/kernel/lang.mli @@ -0,0 +1,11 @@ +(** Two-letter lowercase ISO-639-1 language codes. The set is deliberately open: + overlays add languages as data, never as code. *) +type t = private string + +val of_string : string -> (t, string) result +val of_string_exn : string -> t +val to_string : t -> string +val compare : t -> t -> int +val equal : t -> t -> bool +val t_of_sexp : Sexplib0.Sexp.t -> t +val sexp_of_t : t -> Sexplib0.Sexp.t diff --git a/lib/kernel/slug.ml b/lib/kernel/slug.ml new file mode 100644 index 0000000..5139c99 --- /dev/null +++ b/lib/kernel/slug.ml @@ -0,0 +1,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 diff --git a/lib/kernel/slug.mli b/lib/kernel/slug.mli new file mode 100644 index 0000000..0081e2b --- /dev/null +++ b/lib/kernel/slug.mli @@ -0,0 +1,16 @@ +(** Stable celebration identifiers: non-empty [a-z0-9-], no leading or trailing + hyphen. Also serve as lectionary keys. *) +type t = private string + +val of_string : string -> (t, string) result + +(** For literals in code and tests. Raises [Invalid_argument] on a bad slug. *) +val of_string_exn : string -> t + +val to_string : t -> string +val compare : t -> t -> int +val equal : t -> t -> bool + +(** Validating; raises [Of_sexp_error] on a malformed slug. *) +val t_of_sexp : Sexplib0.Sexp.t -> t +val sexp_of_t : t -> Sexplib0.Sexp.t |
