kernel: Slug and Lang validated private strings

Both parse through a smart constructor returning result, and both hand-write
t_of_sexp so a malformed value in a data file is rejected at load rather than
silently accepted -- deriving the converter would have bypassed validation.

1 files changed, 29 insertions, 0 deletions

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