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, 23 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