From ca289b2f43a5b097c4ec20308c1661a0c404399c Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 11:25:56 +0200 Subject: 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. --- lib/kernel/slug.ml | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 lib/kernel/slug.ml (limited to 'lib/kernel/slug.ml') 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 -- cgit v1.3