1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
---
layout: post.njk
title: 30-line Form Validation Library in OCaml
tags: post
date: 2024-02-16
---
<p>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
leverage the <a
href="https://jobjo.github.io//2019/04/24/ocaml-has-some-new-shiny-syntax.html">new
syntax that came in OCaml 4.08</a>. I put this in a file validate.ml</p>
<div class="sourceCode" id="cb1"><pre
class="sourceCode ocaml"><code class="sourceCode ocaml"><span id="cb1-1"><a href="#cb1-1" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> 'b error = [> `Validation <span class="kw">of</span> (<span class="dt">string</span> * <span class="dt">string</span>) Seq.t ] <span class="kw">as</span> 'b</span>
<span id="cb1-2"><a href="#cb1-2" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> ('a, 'b) validation_result = ('a, 'b error) result</span>
<span id="cb1-3"><a href="#cb1-3" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb1-4"><a href="#cb1-4" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> pure a : ('a, 'e) validation_result = Ok a</span>
<span id="cb1-5"><a href="#cb1-5" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> map f (a : ('a, 'e) validation_result) : ('b, 'e) validation_result = Result.map f a</span>
<span id="cb1-6"><a href="#cb1-6" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> bind f (a : ('a, 'e) validation_result) : ('b, 'e) validation_result = Result.bind a f</span>
<span id="cb1-7"><a href="#cb1-7" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb1-8"><a href="#cb1-8" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> product (a : ('a, 'e) validation_result) (b : ('b, 'e) validation_result) =</span>
<span id="cb1-9"><a href="#cb1-9" aria-hidden="true" tabindex="-1"></a> <span class="kw">match</span> a, b <span class="kw">with</span></span>
<span id="cb1-10"><a href="#cb1-10" aria-hidden="true" tabindex="-1"></a> | Ok x, Ok y -> Ok (x, y)</span>
<span id="cb1-11"><a href="#cb1-11" aria-hidden="true" tabindex="-1"></a> | Error (`Validation e), Ok _ -> Error (`Validation e)</span>
<span id="cb1-12"><a href="#cb1-12" aria-hidden="true" tabindex="-1"></a> | Ok _, Error (`Validation e) -> Error (`Validation e)</span>
<span id="cb1-13"><a href="#cb1-13" aria-hidden="true" tabindex="-1"></a> | Error (`Validation e), Error (`Validation e2) -> Error (`Validation (Seq.append e e2))</span>
<span id="cb1-14"><a href="#cb1-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb1-15"><a href="#cb1-15" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb1-16"><a href="#cb1-16" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> to_error ~field a = Error (`Validation (<span class="dt">List</span>.to_seq [ field, a ]))</span>
<span id="cb1-17"><a href="#cb1-17" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb1-18"><a href="#cb1-18" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> show_errors (errors : (<span class="dt">string</span> * <span class="dt">string</span>) Seq.t) =</span>
<span id="cb1-19"><a href="#cb1-19" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> error_strings = Seq.map (<span class="kw">fun</span> (field, message) -> field ^ <span class="st">": "</span> ^ message) errors <span class="kw">in</span></span>
<span id="cb1-20"><a href="#cb1-20" aria-hidden="true" tabindex="-1"></a> <span class="dt">String</span>.concat <span class="st">"</span><span class="ch">\n</span><span class="st">"</span> (<span class="dt">List</span>.of_seq error_strings)</span>
<span id="cb1-21"><a href="#cb1-21" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb1-22"><a href="#cb1-22" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> opt (a : ('a, 'e) validation_result) : ('a <span class="dt">option</span>, 'e) validation_result =</span>
<span id="cb1-23"><a href="#cb1-23" aria-hidden="true" tabindex="-1"></a> <span class="kw">match</span> a <span class="kw">with</span></span>
<span id="cb1-24"><a href="#cb1-24" aria-hidden="true" tabindex="-1"></a> | Ok a -> Ok (<span class="dt">Some</span> a)</span>
<span id="cb1-25"><a href="#cb1-25" aria-hidden="true" tabindex="-1"></a> | Error _ -> Ok <span class="dt">None</span></span></code></pre></div>
<p>This will wrap the regular result type with a new
<code>validation_result</code> 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.</p>
<p>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:</p>
<div class="sourceCode" id="cb2"><pre
class="sourceCode ocaml"><code class="sourceCode ocaml"><span id="cb2-1"><a href="#cb2-1" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> url ~field a =</span>
<span id="cb2-2"><a href="#cb2-2" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> url = Uri.of_string a <span class="kw">in</span></span>
<span id="cb2-3"><a href="#cb2-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">if</span> url = Uri.empty <span class="kw">then</span> to_error ~field <span class="st">"Not an url"</span> <span class="kw">else</span> Ok url</span>
<span id="cb2-4"><a href="#cb2-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-5"><a href="#cb2-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-6"><a href="#cb2-6" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span>%expect_test <span class="st">"fail on empty"</span> =</span>
<span id="cb2-7"><a href="#cb2-7" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> result = url ~field:<span class="st">"url"</span> <span class="st">""</span> <span class="kw">in</span></span>
<span id="cb2-8"><a href="#cb2-8" aria-hidden="true" tabindex="-1"></a> <span class="dt">Printf</span>.printf <span class="st">"Is error: %b"</span> (Result.is_error result);</span>
<span id="cb2-9"><a href="#cb2-9" aria-hidden="true" tabindex="-1"></a> [%expect {| Is error: <span class="kw">true</span> |}]</span>
<span id="cb2-10"><a href="#cb2-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-11"><a href="#cb2-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-12"><a href="#cb2-12" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> optional (a : ('a, 'e) validation_result) : ('a <span class="dt">option</span>, 'e) validation_result =</span>
<span id="cb2-13"><a href="#cb2-13" aria-hidden="true" tabindex="-1"></a> <span class="kw">match</span> a <span class="kw">with</span></span>
<span id="cb2-14"><a href="#cb2-14" aria-hidden="true" tabindex="-1"></a> | Ok a -> Ok (<span class="dt">Some</span> a)</span>
<span id="cb2-15"><a href="#cb2-15" aria-hidden="true" tabindex="-1"></a> | Error _ -> Ok <span class="dt">None</span></span>
<span id="cb2-16"><a href="#cb2-16" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-17"><a href="#cb2-17" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-18"><a href="#cb2-18" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> <span class="dt">int</span> ?(<span class="dt">max</span> = <span class="dv">9999</span>) ?(<span class="dt">min</span> = <span class="dv">9999</span>) ~field a =</span>
<span id="cb2-19"><a href="#cb2-19" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> <span class="dt">int</span> = int_of_string_opt a <span class="kw">in</span></span>
<span id="cb2-20"><a href="#cb2-20" aria-hidden="true" tabindex="-1"></a> <span class="kw">match</span> <span class="dt">int</span> <span class="kw">with</span></span>
<span id="cb2-21"><a href="#cb2-21" aria-hidden="true" tabindex="-1"></a> | <span class="dt">Some</span> <span class="dt">int</span> -></span>
<span id="cb2-22"><a href="#cb2-22" aria-hidden="true" tabindex="-1"></a> <span class="kw">if</span> <span class="dt">int</span> <= <span class="dt">max</span> && <span class="dt">int</span> >= <span class="dt">min</span></span>
<span id="cb2-23"><a href="#cb2-23" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> Ok <span class="dt">int</span></span>
<span id="cb2-24"><a href="#cb2-24" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span></span>
<span id="cb2-25"><a href="#cb2-25" aria-hidden="true" tabindex="-1"></a> to_error</span>
<span id="cb2-26"><a href="#cb2-26" aria-hidden="true" tabindex="-1"></a> ~field</span>
<span id="cb2-27"><a href="#cb2-27" aria-hidden="true" tabindex="-1"></a> (<span class="st">"Must be between "</span> ^ <span class="dt">string_of_int</span> <span class="dt">min</span> ^ <span class="st">" and "</span> ^ <span class="dt">string_of_int</span> <span class="dt">max</span>)</span>
<span id="cb2-28"><a href="#cb2-28" aria-hidden="true" tabindex="-1"></a> | <span class="dt">None</span> -> to_error ~field <span class="st">"Not an int"</span></span>
<span id="cb2-29"><a href="#cb2-29" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-30"><a href="#cb2-30" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-31"><a href="#cb2-31" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> <span class="dt">string</span> ?(max_length = <span class="dv">500</span>) ?(min_length = <span class="dv">0</span>) ~field a =</span>
<span id="cb2-32"><a href="#cb2-32" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> length = <span class="dt">String</span>.length a <span class="kw">in</span></span>
<span id="cb2-33"><a href="#cb2-33" aria-hidden="true" tabindex="-1"></a> <span class="kw">if</span> length <= max_length && length >= min_length</span>
<span id="cb2-34"><a href="#cb2-34" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> Ok a</span>
<span id="cb2-35"><a href="#cb2-35" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span></span>
<span id="cb2-36"><a href="#cb2-36" aria-hidden="true" tabindex="-1"></a> to_error</span>
<span id="cb2-37"><a href="#cb2-37" aria-hidden="true" tabindex="-1"></a> ~field</span>
<span id="cb2-38"><a href="#cb2-38" aria-hidden="true" tabindex="-1"></a> (<span class="st">"Length must be between "</span></span>
<span id="cb2-39"><a href="#cb2-39" aria-hidden="true" tabindex="-1"></a> ^ <span class="dt">string_of_int</span> min_length</span>
<span id="cb2-40"><a href="#cb2-40" aria-hidden="true" tabindex="-1"></a> ^ <span class="st">" and "</span></span>
<span id="cb2-41"><a href="#cb2-41" aria-hidden="true" tabindex="-1"></a> ^ <span class="dt">string_of_int</span> max_length)</span></code></pre></div>
<p>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:</p>
<div class="sourceCode" id="cb3"><pre
class="sourceCode ocaml"><code class="sourceCode ocaml"><span id="cb3-1"><a href="#cb3-1" aria-hidden="true" tabindex="-1"></a><span class="kw">let</span> parse_input ~collection ~link ~comment =</span>
<span id="cb3-2"><a href="#cb3-2" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> ( <span class="kw">let</span>+ ) x f = Validate.map f x <span class="kw">in</span></span>
<span id="cb3-3"><a href="#cb3-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> ( <span class="kw">and</span>+ ) = Validate.product <span class="kw">in</span></span>
<span id="cb3-4"><a href="#cb3-4" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span>+ url = Validate.url ~field:<span class="st">"link"</span> link</span>
<span id="cb3-5"><a href="#cb3-5" aria-hidden="true" tabindex="-1"></a> <span class="co">(* With the optional helper, we can easily ensure that certain fields are ignored if invalid *)</span></span>
<span id="cb3-6"><a href="#cb3-6" aria-hidden="true" tabindex="-1"></a> <span class="kw">and</span>+ cmt = Validate.<span class="dt">string</span> ~min_length:<span class="dv">5</span> ~field:<span class="st">"Comment"</span> comment |> Validate.optional</span>
<span id="cb3-7"><a href="#cb3-7" aria-hidden="true" tabindex="-1"></a> <span class="kw">and</span>+ c = Validate.<span class="dt">int</span> ~<span class="dt">min</span>:<span class="dv">1</span> ~field:<span class="st">"Collection id"</span> collection <span class="kw">in</span></span>
<span id="cb3-8"><a href="#cb3-8" aria-hidden="true" tabindex="-1"></a> c, cmt, url</span></code></pre></div>
<p>The code ends up being extremely readable and simple to use.</p>
|