From 0773af2cc0a3410e16c549284c58034db315efa9 Mon Sep 17 00:00:00 2001 From: Marc Coquand Date: Fri, 16 Feb 2024 13:06:48 -0600 Subject: New Post: Form Validation in OCaml --- posts/form-validation-gist.njk | 98 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 98 insertions(+) create mode 100644 posts/form-validation-gist.njk diff --git a/posts/form-validation-gist.njk b/posts/form-validation-gist.njk new file mode 100644 index 0000000..f145c65 --- /dev/null +++ b/posts/form-validation-gist.njk @@ -0,0 +1,98 @@ +--- +layout: post.njk +title: 30-line Form Validation Library in OCaml +tags: post +date: 2024-02-16 +--- +

I was working on my side-project in Dream and needed to have a way to +easily validate forms, so I came up with the following code that +levarages the new +syntax that came in OCaml 4.08. I put this in a file validate.ml

+
type 'b error = [> `Validation of (string * string) Seq.t ] as 'b
+type ('a, 'b) validation_result = ('a, 'b error) result
+
+let pure a : ('a, 'e) validation_result = Ok a
+let map f (a : ('a, 'e) validation_result) : ('b, 'e) validation_result = Result.map f a
+let bind f (a : ('a, 'e) validation_result) : ('b, 'e) validation_result = Result.bind a f
+
+let product (a : ('a, 'e) validation_result) (b : ('b, 'e) validation_result) =
+  match a, b with
+  | Ok x, Ok y -> Ok (x, y)
+  | Error (`Validation e), Ok _ -> Error (`Validation e)
+  | Ok _, Error (`Validation e) -> Error (`Validation e)
+  | Error (`Validation e), Error (`Validation e2) -> Error (`Validation (Seq.append e e2))
+
+
+let to_error ~field a = Error (`Validation (List.to_seq [ field, a ]))
+
+let show_errors (errors : (string * string) Seq.t) =
+  let error_strings = Seq.map (fun (field, message) -> field ^ ": " ^ message) errors in
+  String.concat "\n" (List.of_seq error_strings)
+
+let opt (a : ('a, 'e) validation_result) : ('a option, 'e) validation_result =
+  match a with
+  | Ok a -> Ok (Some a)
+  | Error _ -> Ok None
+

This will wrap the regular result type with a new +validation_result and collect errors into a Seq. The +show_errors is very simple and you might want one that displays HTML +instead if you use HTMX.

+

Once the “framework” is in place, we can start writing some +validation functions, I'll show a few so you can add more on your own:

+
let url ~field a =
+  let url = Uri.of_string a in
+  if url = Uri.empty then to_error ~field "Not an url" else Ok url
+
+
+let%expect_test "fail on empty" =
+  let result = url ~field:"url" "" in
+  Printf.printf "Is error: %b" (Result.is_error result);
+  [%expect {| Is error: true |}]
+
+
+let optional (a : ('a, 'e) validation_result) : ('a option, 'e) validation_result =
+  match a with
+  | Ok a -> Ok (Some a)
+  | Error _ -> Ok None
+
+
+let int ?(max = 9999) ?(min = 9999) ~field a =
+  let int = int_of_string_opt a in
+  match int with
+  | Some int ->
+    if int <= max && int >= min
+    then Ok int
+    else
+      to_error
+        ~field
+        ("Must be between " ^ string_of_int min ^ " and " ^ string_of_int max)
+  | None -> to_error ~field "Not an int"
+
+
+let string ?(max_length = 500) ?(min_length = 0) ~field a =
+  let length = String.length a in
+  if length <= max_length && length >= min_length
+  then Ok a
+  else
+    to_error
+      ~field
+      ("Length must be between "
+       ^ string_of_int min_length
+       ^ " and "
+       ^ string_of_int max_length)
+

As you can see, each validation is also very easy to test. With +everything in place, we can write the validation for a three field form +with just a few lines of code:

+
let parse_input ~collection ~link ~comment =
+  let ( let+ ) x f = Validate.map f x in
+  let ( and+ ) = Validate.product in
+  let+ url = Validate.url ~field:"link" link
+  (* With the optional helper, we can easily ensure that certain fields are ignored if invalid *)
+  and+ cmt = Validate.string ~min_length:5 ~field:"Comment" comment |> Validate.optional
+  and+ c = Validate.int ~min:1 ~field:"Collection id" collection in
+  c, cmt, url
+

The code ends up being extremely readable and simple to use.

-- cgit v1.2.3