New Post: Form Validation in OCaml

1 files changed, 98 insertions, 0 deletions

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
+---
+<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
+levarages 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> &#39;b error = [&gt; `Validation <span class="kw">of</span> (<span class="dt">string</span> * <span class="dt">string</span>) Seq.t ] <span class="kw">as</span> &#39;b</span>
+<span id="cb1-2"><a href="#cb1-2" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> (&#39;a, &#39;b) validation_result = (&#39;a, &#39;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 : (&#39;a, &#39;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 : (&#39;a, &#39;e) validation_result) : (&#39;b, &#39;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 : (&#39;a, &#39;e) validation_result) : (&#39;b, &#39;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 : (&#39;a, &#39;e) validation_result) (b : (&#39;b, &#39;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 -&gt; Ok (x, y)</span>
+<span id="cb1-11"><a href="#cb1-11" aria-hidden="true" tabindex="-1"></a>  | Error (`Validation e), Ok _ -&gt; Error (`Validation e)</span>
+<span id="cb1-12"><a href="#cb1-12" aria-hidden="true" tabindex="-1"></a>  | Ok _, Error (`Validation e) -&gt; Error (`Validation e)</span>
+<span id="cb1-13"><a href="#cb1-13" aria-hidden="true" tabindex="-1"></a>  | Error (`Validation e), Error (`Validation e2) -&gt; 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) -&gt; field ^ <span class="st">&quot;: &quot;</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">&quot;</span><span class="ch">\n</span><span class="st">&quot;</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 : (&#39;a, &#39;e) validation_result) : (&#39;a <span class="dt">option</span>, &#39;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 -&gt; Ok (<span class="dt">Some</span> a)</span>
+<span id="cb1-25"><a href="#cb1-25" aria-hidden="true" tabindex="-1"></a>  | Error _ -&gt; 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">&quot;Not an url&quot;</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">&quot;fail on empty&quot;</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">&quot;url&quot;</span> <span class="st">&quot;&quot;</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">&quot;Is error: %b&quot;</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 : (&#39;a, &#39;e) validation_result) : (&#39;a <span class="dt">option</span>, &#39;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 -&gt; Ok (<span class="dt">Some</span> a)</span>
+<span id="cb2-15"><a href="#cb2-15" aria-hidden="true" tabindex="-1"></a>  | Error _ -&gt; 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> -&gt;</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> &lt;= <span class="dt">max</span> &amp;&amp; <span class="dt">int</span> &gt;= <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">&quot;Must be between &quot;</span> ^ <span class="dt">string_of_int</span> <span class="dt">min</span> ^ <span class="st">&quot; and &quot;</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> -&gt; to_error ~field <span class="st">&quot;Not an int&quot;</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 &lt;= max_length &amp;&amp; length &gt;= 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">&quot;Length must be between &quot;</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">&quot; and &quot;</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">&quot;link&quot;</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">&quot;Comment&quot;</span> comment |&gt; 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">&quot;Collection id&quot;</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>