Posts tagged "nilenso" on abhinavsarkar.nethttps://abhinavsarkar.net/tags/nilenso/feed.atom2018-08-13T00:00:00ZAbhinav Sarkarhttps://abhinavsarkar.net/about/abhinav@abhinavsarkar.nethttps://abhinavsarkar.net/images/favicon.ico© 2017–2023, Abhinav Sarkarhttps://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-3/Fast Sudoku Solver in Haskell #3: Picking the Right Data Structures2018-08-13T00:00:00ZAbhinav Sarkarhttps://abhinavsarkar.net/about/abhinav@abhinavsarkar.net<p>In the <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/?mtm_campaign=feed">previous part</a> in this series of posts, we optimized the simple Sudoku solver by implementing a new strategy to prune cells, and were able to achieve a speedup of almost 200x. Afterwards, we profiled the solution and found that there were bottlenecks in the program, leading to a slowdown. In this post, we are going to follow the profiler and use the right <em>Data Structures</em> to improve the solution further and make it <strong>faster</strong>.</p>
<p>This post was originally published on <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-3/?mtm_campaign=feed">abhinavsarkar.net</a>.</p><!--more-->
<p>This is the third post in a series of posts:</p>
<ol type="1">
<li><a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-1/?mtm_campaign=feed">Fast Sudoku Solver in Haskell #1: A Simple Solution</a></li>
<li><a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/?mtm_campaign=feed">Fast Sudoku Solver in Haskell #2: A 200x Faster Solution</a></li>
<li>Fast Sudoku Solver in Haskell #3: Picking the Right Data Structures</li>
</ol>
<nav id="toc" class="right-toc"><h3>Contents</h3><ol><li><a href="#quick-recap">Quick Recap</a></li><li><a href="#profile-twice-code-once">Profile Twice, Code Once</a></li><li><a href="#a-set-for-all-occasions">A Set for All Occasions</a></li><li><a href="#bit-by-bit-we-get-faster">Bit by Bit, We Get Faster</a></li><li><a href="#back-to-the-profiler">Back to the Profiler</a></li><li><a href="#vectors-of-speed">Vectors of Speed</a></li><li><a href="#revenge-of-the">Revenge of the <code>(==)</code></a></li><li><a href="#one-function-to-prune-them-all">One Function to Prune Them All</a></li><li><a href="#rise-of-the-mutables">Rise of the Mutables</a></li><li><a href="#comparison-of-implementations">Comparison of Implementations</a></li><li><a href="#conclusion">Conclusion</a></li></ol></nav>
<h2 data-track-content data-content-name="quick-recap" data-content-piece="fast-sudoku-solver-in-haskell-3" id="quick-recap">Quick Recap</h2>
<p><a href="https://en.wikipedia.org/wiki/Sudoku" target="_blank" rel="noopener">Sudoku</a> is a number placement puzzle. It consists of a 9x9 grid which is to be filled with digits from 1 to 9 such that each row, each column and each of the nine 3x3 sub-grids contain all the digits. Some of the cells of the grid come pre-filled and the player has to fill the rest.</p>
<p>In the previous post, we improved the performance of the simple Sudoku solver by implementing a new strategy to prune cells. This <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/?mtm_campaign=feed#a-little-forward-a-little-backward">new strategy</a> found the digits which occurred uniquely, in pairs, or in triplets and fixed the cells to those digits. It led to a speedup of about 200x over our original naive solution. This is our current run<a href="#fn1" class="footnote-ref" id="fnref1" role="doc-noteref"><sup>1</sup></a> time for solving all the 49151 <a href="https://abhinavsarkar.net/files/sudoku17.txt.bz2?mtm_campaign=feed">17-clue puzzles</a>:</p>
<pre class="plain"><code>$ cat sudoku17.txt | time stack exec sudoku > /dev/null
258.97 real 257.34 user 1.52 sys</code></pre>
<p>Let’s try to improve this time.<a href="#fn2" class="footnote-ref" id="fnref2" role="doc-noteref"><sup>2</sup></a></p>
<h2 data-track-content data-content-name="profile-twice-code-once" data-content-piece="fast-sudoku-solver-in-haskell-3" id="profile-twice-code-once">Profile Twice, Code Once</h2>
<p>Instead of trying to guess how to improve the performance of our solution, let’s be methodical about it. We start with profiling the code to find the bottlenecks. Let’s compile and run the code with profiling flags:</p>
<pre class="plain"><code>$ stack build --profile
$ head -1000 sudoku17.txt | stack exec -- sudoku +RTS -p > /dev/null</code></pre>
<p>This generates a <code>sudoku.prof</code> file with the profiling output. Here are the top seven <em>Cost Centres</em><a href="#fn3" class="footnote-ref" id="fnref3" role="doc-noteref"><sup>3</sup></a> from the file (cleaned for brevity):</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Cost Centre</th>
<th style="text-align: left;">Src</th>
<th style="text-align: right;">%time</th>
<th style="text-align: right;">%alloc</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities</code></td>
<td style="text-align: left;">Sudoku.hs:(49,1)-(62,26)</td>
<td style="text-align: right;">18.9</td>
<td style="text-align: right;">11.4</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>pruneCellsByFixed.pruneCell</code></td>
<td style="text-align: left;">Sudoku.hs:(75,5)-(76,36)</td>
<td style="text-align: right;">17.7</td>
<td style="text-align: right;">30.8</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities.\.\</code></td>
<td style="text-align: left;">Sudoku.hs:55:38-70</td>
<td style="text-align: right;">11.7</td>
<td style="text-align: right;">20.3</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>fixM.\</code></td>
<td style="text-align: left;">Sudoku.hs:13:27-65</td>
<td style="text-align: right;">10.7</td>
<td style="text-align: right;">0.0</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>==</code></td>
<td style="text-align: left;">Sudoku.hs:15:56-57</td>
<td style="text-align: right;">5.6</td>
<td style="text-align: right;">0.0</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>pruneGrid'</code></td>
<td style="text-align: left;">Sudoku.hs:(103,1)-(106,64)</td>
<td style="text-align: right;">5.0</td>
<td style="text-align: right;">6.7</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>pruneCellsByFixed</code></td>
<td style="text-align: left;">Sudoku.hs:(71,1)-(76,36)</td>
<td style="text-align: right;">4.5</td>
<td style="text-align: right;">5.0</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>exclusivePossibilities.\</code></td>
<td style="text-align: left;">Sudoku.hs:58:36-68</td>
<td style="text-align: right;">3.4</td>
<td style="text-align: right;">2.5</td>
</tr>
</tbody>
</table>
</div>
<p><em>Cost Centre</em> points to a function, either named or anonymous. <em>Src</em> gives the line and column numbers of the source code of the function. <em>%time</em> and <em>%alloc</em> are the percentages of time spent and memory allocated in the function, respectively.</p>
<p>We see that <code>exclusivePossibilities</code> and the nested functions inside it take up almost 34% time of the entire run time. Second biggest bottleneck is the <code>pruneCell</code> function inside the <code>pruneCellsByFixed</code> function.</p>
<p>We are going to look at <code>exclusivePossibilities</code> later. For now, it is easy to guess the possible reason for <code>pruneCell</code> taking so much time. Here’s the code for reference:</p>
<div class="sourceCode" id="cb3" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb3-1"><a href="#cb3-1" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneCellsByFixed ::</span> [<span class="dt">Cell</span>] <span class="ot">-></span> <span class="dt">Maybe</span> [<span class="dt">Cell</span>]</span>
<span id="cb3-2"><a href="#cb3-2" aria-hidden="true" tabindex="-1"></a>pruneCellsByFixed cells <span class="ot">=</span> <span class="fu">traverse</span> pruneCell cells</span>
<span id="cb3-3"><a href="#cb3-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb3-4"><a href="#cb3-4" aria-hidden="true" tabindex="-1"></a> fixeds <span class="ot">=</span> [x <span class="op">|</span> <span class="dt">Fixed</span> x <span class="ot"><-</span> cells]</span>
<span id="cb3-5"><a href="#cb3-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-6"><a href="#cb3-6" aria-hidden="true" tabindex="-1"></a> pruneCell (<span class="dt">Possible</span> xs) <span class="ot">=</span> makeCell (xs <span class="dt">Data.List</span><span class="op">.</span>\\ fixeds)</span>
<span id="cb3-7"><a href="#cb3-7" aria-hidden="true" tabindex="-1"></a> pruneCell x <span class="ot">=</span> <span class="dt">Just</span> x</span></code></pre></div>
<p><code>pruneCell</code> uses <code>Data.List.\\</code> to find the difference of the cell’s possible digits and the fixed digits in the cell’s block. In Haskell, lists are implemented as <a href="https://en.wikipedia.org/wiki/Linked_list#Singly_linked_list" target="_blank" rel="noopener">singly linked lists</a>. So, finding the difference or intersection of two lists is O(n<sup>2</sup>), that is, quadratic <a href="https://en.wikipedia.org/wiki/Asymptotic_complexity" target="_blank" rel="noopener">asymptotic complexity</a>. Let’s tackle this bottleneck first.</p>
<h2 data-track-content data-content-name="a-set-for-all-occasions" data-content-piece="fast-sudoku-solver-in-haskell-3" id="a-set-for-all-occasions">A Set for All Occasions</h2>
<p>What is a efficient data structure for finding differences and intersections? Why, a <a href="https://en.wikipedia.org/wiki/Set_(abstract_data_type)" target="_blank" rel="noopener"><em>Set</em></a> of course! A Set stores unique values and provides fast operations for testing membership of its elements. If we use a Set to represent the possible values of cells instead of a List, the program should run faster. Since the possible values are already unique (<code>1</code>–<code>9</code>), it should not break anything.</p>
<p>Haskell comes with a bunch of Set implementations:</p>
<ul>
<li><a href="https://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Set.html" target="_blank" rel="noopener"><code>Data.Set</code></a> which is a generic data structure implemented as <a href="https://en.wikipedia.org/wiki/Self-balancing_binary_search_tree" target="_blank" rel="noopener">self-balancing binary search tree</a>.</li>
<li><a href="https://hackage.haskell.org/package/unordered-containers-0.2.9.0/docs/Data-HashSet.html" target="_blank" rel="noopener"><code>Data.HashSet</code></a> which is a generic data structure implemented as <a href="https://en.wikipedia.org/wiki/Hash_array_mapped_trie" target="_blank" rel="noopener">hash array mapped trie</a>.</li>
<li><a href="https://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-IntSet.html" target="_blank" rel="noopener"><code>Data.IntSet</code></a> which is a specialized data structure for integer values, implemented as <a href="https://en.wikipedia.org/wiki/Radix_tree" target="_blank" rel="noopener">radix tree</a>.</li>
</ul>
<p>However, a much faster implementation is possible for our particular use-case. We can use a <a href="https://en.wikipedia.org/wiki/Bitset" target="_blank" rel="noopener"><em>BitSet</em></a>.</p>
<p>A BitSet uses <a href="https://en.wikipedia.org/wiki/Bit" target="_blank" rel="noopener">bits</a> to represent unique members of a Set. We map values to particular bits using some function. If the bit corresponding to a particular value is set to 1 then the value is present in the Set, else it is not. So, we need as many bits in a BitSet as the number of values in our domain, which makes is difficult to use for generic problems. But, for our Sudoku solver, we need to store only the digits <code>1</code>–<code>9</code> in the Set, which make BitSet very suitable for us. Also, the Set operations on BitSet are implemented using bit-level instructions in hardware, making them much faster than those on the other data structure listed above.</p>
<p>In Haskell, we can use the <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Word.html" target="_blank" rel="noopener"><code>Data.Word</code></a> module to represent a BitSet. Specifically, we can use the <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Word.html#t:Word16" target="_blank" rel="noopener"><code>Data.Word.Word16</code></a> type which has sixteen bits because we need only nine bits to represent the nine digits. The bit-level operations on <code>Word16</code> are provided by the <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Bits.html" target="_blank" rel="noopener"><code>Data.Bits</code></a> module.</p>
<h2 data-track-content data-content-name="bit-by-bit-we-get-faster" data-content-piece="fast-sudoku-solver-in-haskell-3" id="bit-by-bit-we-get-faster">Bit by Bit, We Get Faster</h2>
<p>First, we replace List with <code>Word16</code> in the <code>Cell</code> type and add a helper function:</p>
<div class="sourceCode" id="cb4" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb4-1"><a href="#cb4-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">Cell</span> <span class="ot">=</span> <span class="dt">Fixed</span> <span class="dt">Data.Word.Word16</span></span>
<span id="cb4-2"><a href="#cb4-2" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="dt">Possible</span> <span class="dt">Data.Word.Word16</span></span>
<span id="cb4-3"><a href="#cb4-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</span>
<span id="cb4-4"><a href="#cb4-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb4-5"><a href="#cb4-5" aria-hidden="true" tabindex="-1"></a><span class="ot">setBits ::</span> <span class="dt">Data.Word.Word16</span> <span class="ot">-></span> [<span class="dt">Data.Word.Word16</span>] <span class="ot">-></span> <span class="dt">Data.Word.Word16</span></span>
<span id="cb4-6"><a href="#cb4-6" aria-hidden="true" tabindex="-1"></a>setBits <span class="ot">=</span> Data.List.foldl' (<span class="op">Data.Bits..|.</span>)</span></code></pre></div>
<p>Then we replace <code>Int</code> related operations with bit related ones in the read and show functions:</p>
<div class="sourceCode" id="cb5" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb5-1"><a href="#cb5-1" aria-hidden="true" tabindex="-1"></a><span class="ot">readGrid ::</span> <span class="dt">String</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb5-2"><a href="#cb5-2" aria-hidden="true" tabindex="-1"></a>readGrid s</span>
<span id="cb5-3"><a href="#cb5-3" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">length</span> s <span class="op">==</span> <span class="dv">81</span> <span class="ot">=</span></span>
<span id="cb5-4"><a href="#cb5-4" aria-hidden="true" tabindex="-1"></a> <span class="fu">traverse</span> (<span class="fu">traverse</span> readCell) <span class="op">.</span> Data.List.Split.chunksOf <span class="dv">9</span> <span class="op">$</span> s</span>
<span id="cb5-5"><a href="#cb5-5" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> <span class="dt">Nothing</span></span>
<span id="cb5-6"><a href="#cb5-6" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb5-7"><a href="#cb5-7" aria-hidden="true" tabindex="-1"></a> allBitsSet <span class="ot">=</span> <span class="dv">1022</span></span>
<span id="cb5-8"><a href="#cb5-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb5-9"><a href="#cb5-9" aria-hidden="true" tabindex="-1"></a> readCell <span class="ch">'.'</span> <span class="ot">=</span> <span class="dt">Just</span> <span class="op">$</span> <span class="dt">Possible</span> allBitsSet</span>
<span id="cb5-10"><a href="#cb5-10" aria-hidden="true" tabindex="-1"></a> readCell c</span>
<span id="cb5-11"><a href="#cb5-11" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> Data.Char.isDigit c <span class="op">&&</span> c <span class="op">></span> <span class="ch">'0'</span> <span class="ot">=</span></span>
<span id="cb5-12"><a href="#cb5-12" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> <span class="op">.</span> <span class="dt">Fixed</span> <span class="op">.</span> Data.Bits.bit <span class="op">.</span> Data.Char.digitToInt <span class="op">$</span> c</span>
<span id="cb5-13"><a href="#cb5-13" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> <span class="dt">Nothing</span></span>
<span id="cb5-14"><a href="#cb5-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb5-15"><a href="#cb5-15" aria-hidden="true" tabindex="-1"></a><span class="ot">showGrid ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">String</span></span>
<span id="cb5-16"><a href="#cb5-16" aria-hidden="true" tabindex="-1"></a>showGrid <span class="ot">=</span> <span class="fu">unlines</span> <span class="op">.</span> <span class="fu">map</span> (<span class="fu">unwords</span> <span class="op">.</span> <span class="fu">map</span> showCell)</span>
<span id="cb5-17"><a href="#cb5-17" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb5-18"><a href="#cb5-18" aria-hidden="true" tabindex="-1"></a> showCell (<span class="dt">Fixed</span> x) <span class="ot">=</span> <span class="fu">show</span> <span class="op">.</span> Data.Bits.countTrailingZeros <span class="op">$</span> x</span>
<span id="cb5-19"><a href="#cb5-19" aria-hidden="true" tabindex="-1"></a> showCell _ <span class="ot">=</span> <span class="st">"."</span></span>
<span id="cb5-20"><a href="#cb5-20" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb5-21"><a href="#cb5-21" aria-hidden="true" tabindex="-1"></a><span class="ot">showGridWithPossibilities ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">String</span></span>
<span id="cb5-22"><a href="#cb5-22" aria-hidden="true" tabindex="-1"></a>showGridWithPossibilities <span class="ot">=</span> <span class="fu">unlines</span> <span class="op">.</span> <span class="fu">map</span> (<span class="fu">unwords</span> <span class="op">.</span> <span class="fu">map</span> showCell)</span>
<span id="cb5-23"><a href="#cb5-23" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb5-24"><a href="#cb5-24" aria-hidden="true" tabindex="-1"></a> showCell (<span class="dt">Fixed</span> x) <span class="ot">=</span> (<span class="fu">show</span> <span class="op">.</span> Data.Bits.countTrailingZeros <span class="op">$</span> x) <span class="op">++</span> <span class="st">" "</span></span>
<span id="cb5-25"><a href="#cb5-25" aria-hidden="true" tabindex="-1"></a> showCell (<span class="dt">Possible</span> xs) <span class="ot">=</span></span>
<span id="cb5-26"><a href="#cb5-26" aria-hidden="true" tabindex="-1"></a> <span class="st">"["</span> <span class="op">++</span></span>
<span id="cb5-27"><a href="#cb5-27" aria-hidden="true" tabindex="-1"></a> <span class="fu">map</span> (\i <span class="ot">-></span> <span class="kw">if</span> Data.Bits.testBit xs i</span>
<span id="cb5-28"><a href="#cb5-28" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> Data.Char.intToDigit i</span>
<span id="cb5-29"><a href="#cb5-29" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span> <span class="ch">' '</span>)</span>
<span id="cb5-30"><a href="#cb5-30" aria-hidden="true" tabindex="-1"></a> [<span class="dv">1</span><span class="op">..</span><span class="dv">9</span>]</span>
<span id="cb5-31"><a href="#cb5-31" aria-hidden="true" tabindex="-1"></a> <span class="op">++</span> <span class="st">"]"</span></span></code></pre></div>
<p>We set the same bits as the digits to indicate the presence of the digits in the possibilities. For example, for digit <code>1</code>, we set the bit 1 so that the resulting <code>Word16</code> is <code>0000 0000 0000 0010</code> or 2. This also means, for fixed cells, the value is <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Bits.html#v:countTrailingZeros" target="_blank" rel="noopener">count of the zeros from right</a>.</p>
<p>The change in the <code>exclusivePossibilities</code> function is pretty minimal:</p>
<div class="sourceCode" id="cb6" data-lang="diff"><pre class="sourceCode numberSource diff"><code class="sourceCode diff"><span id="cb6-1"><a href="#cb6-1" aria-hidden="true" tabindex="-1"></a><span class="st">-exclusivePossibilities :: [Cell] -> [[Int]]</span></span>
<span id="cb6-2"><a href="#cb6-2" aria-hidden="true" tabindex="-1"></a><span class="va">+exclusivePossibilities :: [Cell] -> [Data.Word.Word16]</span></span>
<span id="cb6-3"><a href="#cb6-3" aria-hidden="true" tabindex="-1"></a> exclusivePossibilities row =</span>
<span id="cb6-4"><a href="#cb6-4" aria-hidden="true" tabindex="-1"></a> row</span>
<span id="cb6-5"><a href="#cb6-5" aria-hidden="true" tabindex="-1"></a> & zip [1..9]</span>
<span id="cb6-6"><a href="#cb6-6" aria-hidden="true" tabindex="-1"></a> & filter (isPossible . snd)</span>
<span id="cb6-7"><a href="#cb6-7" aria-hidden="true" tabindex="-1"></a> & Data.List.foldl'</span>
<span id="cb6-8"><a href="#cb6-8" aria-hidden="true" tabindex="-1"></a> (\acc ~(i, Possible xs) -></span>
<span id="cb6-9"><a href="#cb6-9" aria-hidden="true" tabindex="-1"></a><span class="st">- Data.List.foldl'</span></span>
<span id="cb6-10"><a href="#cb6-10" aria-hidden="true" tabindex="-1"></a><span class="st">- (\acc' x -> Map.insertWith prepend x [i] acc')</span></span>
<span id="cb6-11"><a href="#cb6-11" aria-hidden="true" tabindex="-1"></a><span class="st">- acc</span></span>
<span id="cb6-12"><a href="#cb6-12" aria-hidden="true" tabindex="-1"></a><span class="st">- xs)</span></span>
<span id="cb6-13"><a href="#cb6-13" aria-hidden="true" tabindex="-1"></a><span class="va">+ Data.List.foldl'</span></span>
<span id="cb6-14"><a href="#cb6-14" aria-hidden="true" tabindex="-1"></a><span class="va">+ (\acc' x -> if Data.Bits.testBit xs x</span></span>
<span id="cb6-15"><a href="#cb6-15" aria-hidden="true" tabindex="-1"></a><span class="va">+ then Map.insertWith prepend x [i] acc'</span></span>
<span id="cb6-16"><a href="#cb6-16" aria-hidden="true" tabindex="-1"></a><span class="va">+ else acc')</span></span>
<span id="cb6-17"><a href="#cb6-17" aria-hidden="true" tabindex="-1"></a><span class="va">+ acc</span></span>
<span id="cb6-18"><a href="#cb6-18" aria-hidden="true" tabindex="-1"></a><span class="va">+ [1..9])</span></span>
<span id="cb6-19"><a href="#cb6-19" aria-hidden="true" tabindex="-1"></a> Map.empty</span>
<span id="cb6-20"><a href="#cb6-20" aria-hidden="true" tabindex="-1"></a> & Map.filter ((< 4) . length)</span>
<span id="cb6-21"><a href="#cb6-21" aria-hidden="true" tabindex="-1"></a> & Map.foldlWithKey' (\acc x is -> Map.insertWith prepend is [x] acc) Map.empty</span>
<span id="cb6-22"><a href="#cb6-22" aria-hidden="true" tabindex="-1"></a> & Map.filterWithKey (\is xs -> length is == length xs)</span>
<span id="cb6-23"><a href="#cb6-23" aria-hidden="true" tabindex="-1"></a> & Map.elems</span>
<span id="cb6-24"><a href="#cb6-24" aria-hidden="true" tabindex="-1"></a><span class="va">+ & map (Data.List.foldl' Data.Bits.setBit Data.Bits.zeroBits)</span></span>
<span id="cb6-25"><a href="#cb6-25" aria-hidden="true" tabindex="-1"></a> where</span>
<span id="cb6-26"><a href="#cb6-26" aria-hidden="true" tabindex="-1"></a> prepend ~[y] ys = y:ys</span></code></pre></div>
<p>In the nested folding step, instead of folding over the possible values of the cells, now we fold over the digits from <code>1</code> to <code>9</code> and insert the entry in the map if the bit corresponding to the digit is set in the possibilities. And as the last step, we convert the exclusive possibilities to <code>Word16</code> by folding them, starting with zero. As example in the <em>REPL</em> should be instructive:</p>
<div class="sourceCode" id="cb7" data-lang="ghci"><pre class="sourceCode lhs numberSource"><code class="sourceCode literatehaskell"><span id="cb7-1"><a href="#cb7-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> poss <span class="ot">=</span> Data.List.foldl' Data.Bits.setBit Data.Bits.zeroBits</span>
<span id="cb7-2"><a href="#cb7-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> row <span class="ot">=</span> [<span class="dt">Possible</span> <span class="op">$</span> poss [<span class="dv">4</span>,<span class="dv">6</span>,<span class="dv">9</span>], <span class="dt">Fixed</span> <span class="op">$</span> poss [<span class="dv">1</span>], <span class="dt">Fixed</span> <span class="op">$</span> poss [<span class="dv">5</span>], <span class="dt">Possible</span> <span class="op">$</span> poss [<span class="dv">6</span>,<span class="dv">9</span>], <span class="dt">Fixed</span> <span class="op">$</span> poss [<span class="dv">7</span>], <span class="dt">Possible</span> <span class="op">$</span> poss [<span class="dv">2</span>,<span class="dv">3</span>,<span class="dv">6</span>,<span class="dv">8</span>,<span class="dv">9</span>], <span class="dt">Possible</span> <span class="op">$</span> poss [<span class="dv">6</span>,<span class="dv">9</span>], <span class="dt">Possible</span> <span class="op">$</span> poss [<span class="dv">2</span>,<span class="dv">3</span>,<span class="dv">6</span>,<span class="dv">8</span>,<span class="dv">9</span>], <span class="dt">Possible</span> <span class="op">$</span> poss [<span class="dv">2</span>,<span class="dv">3</span>,<span class="dv">6</span>,<span class="dv">8</span>,<span class="dv">9</span>]]</span>
<span id="cb7-3"><a href="#cb7-3" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities [row]</span>
<span id="cb7-4"><a href="#cb7-4" aria-hidden="true" tabindex="-1"></a>[ 4 6 9] 1 5 [ 6 9] 7 [ 23 6 89] [ 6 9] [ 23 6 89] [ 23 6 89]</span>
<span id="cb7-5"><a href="#cb7-5" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> exclusivePossibilities row</span>
<span id="cb7-6"><a href="#cb7-6" aria-hidden="true" tabindex="-1"></a>[16,268]</span>
<span id="cb7-7"><a href="#cb7-7" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> [poss [<span class="dv">4</span>], poss [<span class="dv">8</span>,<span class="dv">3</span>,<span class="dv">2</span>]]</span>
<span id="cb7-8"><a href="#cb7-8" aria-hidden="true" tabindex="-1"></a>[16,268]</span></code></pre></div>
<p>This is the same example row as the <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/?mtm_campaign=feed#a-little-forward-a-little-backward">last time</a>. And it returns same results, excepts as a list of <code>Word16</code> now.</p>
<p>Now, we change <code>makeCell</code> to use bit operations instead of list ones:</p>
<div class="sourceCode" id="cb8" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb8-1"><a href="#cb8-1" aria-hidden="true" tabindex="-1"></a><span class="ot">makeCell ::</span> <span class="dt">Data.Word.Word16</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Cell</span></span>
<span id="cb8-2"><a href="#cb8-2" aria-hidden="true" tabindex="-1"></a>makeCell ys</span>
<span id="cb8-3"><a href="#cb8-3" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> ys <span class="op">==</span> Data.Bits.zeroBits <span class="ot">=</span> <span class="dt">Nothing</span></span>
<span id="cb8-4"><a href="#cb8-4" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> Data.Bits.popCount ys <span class="op">==</span> <span class="dv">1</span> <span class="ot">=</span> <span class="dt">Just</span> <span class="op">$</span> <span class="dt">Fixed</span> ys</span>
<span id="cb8-5"><a href="#cb8-5" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> <span class="dt">Just</span> <span class="op">$</span> <span class="dt">Possible</span> ys</span></code></pre></div>
<p>And we change cell pruning functions too:</p>
<div class="sourceCode" id="cb9" data-lang="diff"><pre class="sourceCode numberSource diff"><code class="sourceCode diff"><span id="cb9-1"><a href="#cb9-1" aria-hidden="true" tabindex="-1"></a> pruneCellsByFixed :: [Cell] -> Maybe [Cell]</span>
<span id="cb9-2"><a href="#cb9-2" aria-hidden="true" tabindex="-1"></a> pruneCellsByFixed cells = traverse pruneCell cells</span>
<span id="cb9-3"><a href="#cb9-3" aria-hidden="true" tabindex="-1"></a> where</span>
<span id="cb9-4"><a href="#cb9-4" aria-hidden="true" tabindex="-1"></a><span class="st">- fixeds = [x | Fixed x <- cells]</span></span>
<span id="cb9-5"><a href="#cb9-5" aria-hidden="true" tabindex="-1"></a><span class="va">+ fixeds = setBits Data.Bits.zeroBits [x | Fixed x <- cells]</span></span>
<span id="cb9-6"><a href="#cb9-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-7"><a href="#cb9-7" aria-hidden="true" tabindex="-1"></a><span class="st">- pruneCell (Possible xs) = makeCell (xs Data.List.\\ fixeds)</span></span>
<span id="cb9-8"><a href="#cb9-8" aria-hidden="true" tabindex="-1"></a><span class="va">+ pruneCell (Possible xs) =</span></span>
<span id="cb9-9"><a href="#cb9-9" aria-hidden="true" tabindex="-1"></a><span class="va">+ makeCell (xs Data.Bits..&. Data.Bits.complement fixeds)</span></span>
<span id="cb9-10"><a href="#cb9-10" aria-hidden="true" tabindex="-1"></a> pruneCell x = Just x</span>
<span id="cb9-11"><a href="#cb9-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-12"><a href="#cb9-12" aria-hidden="true" tabindex="-1"></a> pruneCellsByExclusives :: [Cell] -> Maybe [Cell]</span>
<span id="cb9-13"><a href="#cb9-13" aria-hidden="true" tabindex="-1"></a> pruneCellsByExclusives cells = case exclusives of</span>
<span id="cb9-14"><a href="#cb9-14" aria-hidden="true" tabindex="-1"></a> [] -> Just cells</span>
<span id="cb9-15"><a href="#cb9-15" aria-hidden="true" tabindex="-1"></a> _ -> traverse pruneCell cells</span>
<span id="cb9-16"><a href="#cb9-16" aria-hidden="true" tabindex="-1"></a> where</span>
<span id="cb9-17"><a href="#cb9-17" aria-hidden="true" tabindex="-1"></a> exclusives = exclusivePossibilities cells</span>
<span id="cb9-18"><a href="#cb9-18" aria-hidden="true" tabindex="-1"></a><span class="st">- allExclusives = concat exclusives</span></span>
<span id="cb9-19"><a href="#cb9-19" aria-hidden="true" tabindex="-1"></a><span class="va">+ allExclusives = setBits Data.Bits.zeroBits exclusives</span></span>
<span id="cb9-20"><a href="#cb9-20" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-21"><a href="#cb9-21" aria-hidden="true" tabindex="-1"></a> pruneCell cell@(Fixed _) = Just cell</span>
<span id="cb9-22"><a href="#cb9-22" aria-hidden="true" tabindex="-1"></a> pruneCell cell@(Possible xs)</span>
<span id="cb9-23"><a href="#cb9-23" aria-hidden="true" tabindex="-1"></a> | intersection `elem` exclusives = makeCell intersection</span>
<span id="cb9-24"><a href="#cb9-24" aria-hidden="true" tabindex="-1"></a> | otherwise = Just cell</span>
<span id="cb9-25"><a href="#cb9-25" aria-hidden="true" tabindex="-1"></a> where</span>
<span id="cb9-26"><a href="#cb9-26" aria-hidden="true" tabindex="-1"></a><span class="st">- intersection = xs `Data.List.intersect` allExclusives</span></span>
<span id="cb9-27"><a href="#cb9-27" aria-hidden="true" tabindex="-1"></a><span class="va">+ intersection = xs Data.Bits..&. allExclusives</span></span></code></pre></div>
<p>Notice how the list difference and intersection functions are replaced by <code>Data.Bits</code> functions. Specifically, list difference is replace by bitwise-and of the bitwise-complement, and list intersection is replaced by bitwise-and.</p>
<p>We make a one-line change in the <code>isGridInvalid</code> function to find empty possible cells using bit ops:</p>
<div class="sourceCode" id="cb10" data-lang="diff"><pre class="sourceCode numberSource diff"><code class="sourceCode diff"><span id="cb10-1"><a href="#cb10-1" aria-hidden="true" tabindex="-1"></a> isGridInvalid :: Grid -> Bool</span>
<span id="cb10-2"><a href="#cb10-2" aria-hidden="true" tabindex="-1"></a> isGridInvalid grid =</span>
<span id="cb10-3"><a href="#cb10-3" aria-hidden="true" tabindex="-1"></a> any isInvalidRow grid</span>
<span id="cb10-4"><a href="#cb10-4" aria-hidden="true" tabindex="-1"></a> || any isInvalidRow (Data.List.transpose grid)</span>
<span id="cb10-5"><a href="#cb10-5" aria-hidden="true" tabindex="-1"></a> || any isInvalidRow (subGridsToRows grid)</span>
<span id="cb10-6"><a href="#cb10-6" aria-hidden="true" tabindex="-1"></a> where</span>
<span id="cb10-7"><a href="#cb10-7" aria-hidden="true" tabindex="-1"></a> isInvalidRow row =</span>
<span id="cb10-8"><a href="#cb10-8" aria-hidden="true" tabindex="-1"></a> let fixeds = [x | Fixed x <- row]</span>
<span id="cb10-9"><a href="#cb10-9" aria-hidden="true" tabindex="-1"></a><span class="st">- emptyPossibles = [x | Possible x <- row, null x]</span></span>
<span id="cb10-10"><a href="#cb10-10" aria-hidden="true" tabindex="-1"></a><span class="va">+ emptyPossibles = [() | Possible x <- row, x == Data.Bits.zeroBits]</span></span>
<span id="cb10-11"><a href="#cb10-11" aria-hidden="true" tabindex="-1"></a> in hasDups fixeds || not (null emptyPossibles)</span>
<span id="cb10-12"><a href="#cb10-12" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-13"><a href="#cb10-13" aria-hidden="true" tabindex="-1"></a> hasDups l = hasDups' l []</span>
<span id="cb10-14"><a href="#cb10-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-15"><a href="#cb10-15" aria-hidden="true" tabindex="-1"></a> hasDups' [] _ = False</span>
<span id="cb10-16"><a href="#cb10-16" aria-hidden="true" tabindex="-1"></a> hasDups' (y:ys) xs</span>
<span id="cb10-17"><a href="#cb10-17" aria-hidden="true" tabindex="-1"></a> | y `elem` xs = True</span>
<span id="cb10-18"><a href="#cb10-18" aria-hidden="true" tabindex="-1"></a> | otherwise = hasDups' ys (y:xs)</span></code></pre></div>
<p>And finally, we change the <code>nextGrids</code> functions to use bit operations:</p>
<div class="sourceCode" id="cb11" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb11-1"><a href="#cb11-1" aria-hidden="true" tabindex="-1"></a><span class="ot">nextGrids ::</span> <span class="dt">Grid</span> <span class="ot">-></span> (<span class="dt">Grid</span>, <span class="dt">Grid</span>)</span>
<span id="cb11-2"><a href="#cb11-2" aria-hidden="true" tabindex="-1"></a>nextGrids grid <span class="ot">=</span></span>
<span id="cb11-3"><a href="#cb11-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> (i, first<span class="op">@</span>(<span class="dt">Fixed</span> _), rest) <span class="ot">=</span></span>
<span id="cb11-4"><a href="#cb11-4" aria-hidden="true" tabindex="-1"></a> fixCell</span>
<span id="cb11-5"><a href="#cb11-5" aria-hidden="true" tabindex="-1"></a> <span class="op">.</span> Data.List.minimumBy (<span class="fu">compare</span> <span class="ot">`Data.Function.on`</span> (possibilityCount <span class="op">.</span> <span class="fu">snd</span>))</span>
<span id="cb11-6"><a href="#cb11-6" aria-hidden="true" tabindex="-1"></a> <span class="op">.</span> <span class="fu">filter</span> (isPossible <span class="op">.</span> <span class="fu">snd</span>)</span>
<span id="cb11-7"><a href="#cb11-7" aria-hidden="true" tabindex="-1"></a> <span class="op">.</span> <span class="fu">zip</span> [<span class="dv">0</span><span class="op">..</span>]</span>
<span id="cb11-8"><a href="#cb11-8" aria-hidden="true" tabindex="-1"></a> <span class="op">.</span> <span class="fu">concat</span></span>
<span id="cb11-9"><a href="#cb11-9" aria-hidden="true" tabindex="-1"></a> <span class="op">$</span> grid</span>
<span id="cb11-10"><a href="#cb11-10" aria-hidden="true" tabindex="-1"></a> <span class="kw">in</span> (replace2D i first grid, replace2D i rest grid)</span>
<span id="cb11-11"><a href="#cb11-11" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb11-12"><a href="#cb11-12" aria-hidden="true" tabindex="-1"></a> possibilityCount (<span class="dt">Possible</span> xs) <span class="ot">=</span> Data.Bits.popCount xs</span>
<span id="cb11-13"><a href="#cb11-13" aria-hidden="true" tabindex="-1"></a> possibilityCount (<span class="dt">Fixed</span> _) <span class="ot">=</span> <span class="dv">1</span></span>
<span id="cb11-14"><a href="#cb11-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-15"><a href="#cb11-15" aria-hidden="true" tabindex="-1"></a> fixCell <span class="op">~</span>(i, <span class="dt">Possible</span> xs) <span class="ot">=</span></span>
<span id="cb11-16"><a href="#cb11-16" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> x <span class="ot">=</span> Data.Bits.countTrailingZeros xs</span>
<span id="cb11-17"><a href="#cb11-17" aria-hidden="true" tabindex="-1"></a> <span class="kw">in</span> <span class="kw">case</span> makeCell (Data.Bits.clearBit xs x) <span class="kw">of</span></span>
<span id="cb11-18"><a href="#cb11-18" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="fu">error</span> <span class="st">"Impossible case"</span></span>
<span id="cb11-19"><a href="#cb11-19" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> cell <span class="ot">-></span> (i, <span class="dt">Fixed</span> (Data.Bits.bit x), cell)</span>
<span id="cb11-20"><a href="#cb11-20" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-21"><a href="#cb11-21" aria-hidden="true" tabindex="-1"></a><span class="ot"> replace2D ::</span> <span class="dt">Int</span> <span class="ot">-></span> a <span class="ot">-></span> [[a]] <span class="ot">-></span> [[a]]</span>
<span id="cb11-22"><a href="#cb11-22" aria-hidden="true" tabindex="-1"></a> replace2D i v <span class="ot">=</span></span>
<span id="cb11-23"><a href="#cb11-23" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> (x, y) <span class="ot">=</span> (i <span class="ot">`quot`</span> <span class="dv">9</span>, i <span class="ot">`mod`</span> <span class="dv">9</span>) <span class="kw">in</span> replace x (replace y (<span class="fu">const</span> v))</span>
<span id="cb11-24"><a href="#cb11-24" aria-hidden="true" tabindex="-1"></a> replace p f xs <span class="ot">=</span> [<span class="kw">if</span> i <span class="op">==</span> p <span class="kw">then</span> f x <span class="kw">else</span> x <span class="op">|</span> (x, i) <span class="ot"><-</span> <span class="fu">zip</span> xs [<span class="dv">0</span><span class="op">..</span>]]</span></code></pre></div>
<p><code>possibilityCount</code> now uses <code>Data.Bits.popCount</code> to count the number of bits set to 1. <code>fixCell</code> now chooses the first set bit from right as the digit to fix. Rest of the code stays the same. Let’s build and run it:</p>
<pre class="plain"><code>$ stack build
$ cat sudoku17.txt | time stack exec sudoku > /dev/null
69.44 real 69.12 user 0.37 sys</code></pre>
<p>Wow! That is almost 3.7x faster than the previous solution. It’s a massive win! But let’s not be content yet. To the profiler again<a href="#fn4" class="footnote-ref" id="fnref4" role="doc-noteref"><sup>4</sup></a>!</p>
<h2 data-track-content data-content-name="back-to-the-profiler" data-content-piece="fast-sudoku-solver-in-haskell-3" id="back-to-the-profiler">Back to the Profiler</h2>
<p>Running the profiler again gives us these top six culprits:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Cost Centre</th>
<th style="text-align: left;">Src</th>
<th style="text-align: right;">%time</th>
<th style="text-align: right;">%alloc</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities</code></td>
<td style="text-align: left;">Sudoku.hs:(57,1)-(74,26)</td>
<td style="text-align: right;">25.2</td>
<td style="text-align: right;">16.6</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>exclusivePossibilities.\.\</code></td>
<td style="text-align: left;">Sudoku.hs:64:23-96</td>
<td style="text-align: right;">19.0</td>
<td style="text-align: right;">32.8</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>fixM.\</code></td>
<td style="text-align: left;">Sudoku.hs:15:27-65</td>
<td style="text-align: right;">12.5</td>
<td style="text-align: right;">0.1</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>pruneCellsByFixed</code></td>
<td style="text-align: left;">Sudoku.hs:(83,1)-(88,36)</td>
<td style="text-align: right;">5.9</td>
<td style="text-align: right;">7.1</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>pruneGrid'</code></td>
<td style="text-align: left;">Sudoku.hs:(115,1)-(118,64)</td>
<td style="text-align: right;">5.0</td>
<td style="text-align: right;">8.6</td>
</tr>
</tbody>
</table>
</div>
<p>Hurray! <code>pruneCellsByFixed.pruneCell</code> has disappeared from the list of top bottlenecks. Though <code>exclusivePossibilities</code> still remains here as expected.</p>
<p><code>exclusivePossibilities</code> is a big function. The profiler does not really tell us which parts of it are the slow ones. That’s because by default, the profiler only considers functions as <em>Cost Centres</em>. We need to give it hints for it to be able to find bottlenecks inside functions. For that, we need to insert <a href="https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/profiling.html#inserting-cost-centres-by-hand" target="_blank" rel="noopener"><em>Cost Centre</em> annotations</a> in the code:</p>
<div class="sourceCode" id="cb13" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb13-1"><a href="#cb13-1" aria-hidden="true" tabindex="-1"></a><span class="ot">exclusivePossibilities ::</span> [<span class="dt">Cell</span>] <span class="ot">-></span> [<span class="dt">Data.Word.Word16</span>]</span>
<span id="cb13-2"><a href="#cb13-2" aria-hidden="true" tabindex="-1"></a>exclusivePossibilities row <span class="ot">=</span></span>
<span id="cb13-3"><a href="#cb13-3" aria-hidden="true" tabindex="-1"></a> row</span>
<span id="cb13-4"><a href="#cb13-4" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> (<span class="ot">{-# SCC "EP.zip" #-}</span> <span class="fu">zip</span> [<span class="dv">1</span><span class="op">..</span><span class="dv">9</span>])</span>
<span id="cb13-5"><a href="#cb13-5" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> (<span class="ot">{-# SCC "EP.filter" #-}</span> <span class="fu">filter</span> (isPossible <span class="op">.</span> <span class="fu">snd</span>))</span>
<span id="cb13-6"><a href="#cb13-6" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> (<span class="ot">{-# SCC "EP.foldl" #-}</span> Data.List.foldl'</span>
<span id="cb13-7"><a href="#cb13-7" aria-hidden="true" tabindex="-1"></a> (\acc <span class="op">~</span>(i, <span class="dt">Possible</span> xs) <span class="ot">-></span></span>
<span id="cb13-8"><a href="#cb13-8" aria-hidden="true" tabindex="-1"></a> Data.List.foldl'</span>
<span id="cb13-9"><a href="#cb13-9" aria-hidden="true" tabindex="-1"></a> (\acc' n <span class="ot">-></span> <span class="kw">if</span> Data.Bits.testBit xs n</span>
<span id="cb13-10"><a href="#cb13-10" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> Map.insertWith prepend n [i] acc'</span>
<span id="cb13-11"><a href="#cb13-11" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span> acc')</span>
<span id="cb13-12"><a href="#cb13-12" aria-hidden="true" tabindex="-1"></a> acc</span>
<span id="cb13-13"><a href="#cb13-13" aria-hidden="true" tabindex="-1"></a> [<span class="dv">1</span><span class="op">..</span><span class="dv">9</span>])</span>
<span id="cb13-14"><a href="#cb13-14" aria-hidden="true" tabindex="-1"></a> Map.empty)</span>
<span id="cb13-15"><a href="#cb13-15" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> (<span class="ot">{-# SCC "EP.Map.filter1" #-}</span> Map.filter ((<span class="op"><</span> <span class="dv">4</span>) <span class="op">.</span> <span class="fu">length</span>))</span>
<span id="cb13-16"><a href="#cb13-16" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> (<span class="ot">{-# SCC "EP.Map.foldl" #-}</span></span>
<span id="cb13-17"><a href="#cb13-17" aria-hidden="true" tabindex="-1"></a> Map.foldlWithKey'</span>
<span id="cb13-18"><a href="#cb13-18" aria-hidden="true" tabindex="-1"></a> (\acc x is <span class="ot">-></span> Map.insertWith prepend is [x] acc)</span>
<span id="cb13-19"><a href="#cb13-19" aria-hidden="true" tabindex="-1"></a> Map.empty)</span>
<span id="cb13-20"><a href="#cb13-20" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> (<span class="ot">{-# SCC "EP.Map.filter2" #-}</span></span>
<span id="cb13-21"><a href="#cb13-21" aria-hidden="true" tabindex="-1"></a> Map.filterWithKey (\is xs <span class="ot">-></span> <span class="fu">length</span> is <span class="op">==</span> <span class="fu">length</span> xs))</span>
<span id="cb13-22"><a href="#cb13-22" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> (<span class="ot">{-# SCC "EP.Map.elems" #-}</span> Map.elems)</span>
<span id="cb13-23"><a href="#cb13-23" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> (<span class="ot">{-# SCC "EP.map" #-}</span></span>
<span id="cb13-24"><a href="#cb13-24" aria-hidden="true" tabindex="-1"></a> <span class="fu">map</span> (Data.List.foldl' Data.Bits.setBit Data.Bits.zeroBits))</span>
<span id="cb13-25"><a href="#cb13-25" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb13-26"><a href="#cb13-26" aria-hidden="true" tabindex="-1"></a> prepend <span class="op">~</span>[y] ys <span class="ot">=</span> y<span class="op">:</span>ys</span></code></pre></div>
<p>Here, <code>{-# SCC "EP.zip" #-}</code> is a <em>Cost Centre</em> annotation. <code>"EP.zip"</code> is the name we choose to give to this <em>Cost Centre</em>.</p>
<p>After profiling the code again, we get a different list of bottlenecks:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Cost Centre</th>
<th style="text-align: left;">Src</th>
<th style="text-align: right;">%time</th>
<th style="text-align: right;">%alloc</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities.\.\</code></td>
<td style="text-align: left;">Sudoku.hs:(64,23)-(66,31)</td>
<td style="text-align: right;">19.5</td>
<td style="text-align: right;">31.4</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>fixM.\</code></td>
<td style="text-align: left;">Sudoku.hs:15:27-65</td>
<td style="text-align: right;">13.1</td>
<td style="text-align: right;">0.1</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>pruneCellsByFixed</code></td>
<td style="text-align: left;">Sudoku.hs:(85,1)-(90,36)</td>
<td style="text-align: right;">5.4</td>
<td style="text-align: right;">6.8</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>pruneGrid'</code></td>
<td style="text-align: left;">Sudoku.hs:(117,1)-(120,64)</td>
<td style="text-align: right;">4.8</td>
<td style="text-align: right;">8.3</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>EP.zip</code></td>
<td style="text-align: left;">Sudoku.hs:59:27-36</td>
<td style="text-align: right;">4.3</td>
<td style="text-align: right;">10.7</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>EP.Map.filter1</code></td>
<td style="text-align: left;">Sudoku.hs:70:35-61</td>
<td style="text-align: right;">4.2</td>
<td style="text-align: right;">0.5</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>chunksOf</code></td>
<td style="text-align: left;">Data/List/Split/Internals.hs:(514,1)-(517,49)</td>
<td style="text-align: right;">4.1</td>
<td style="text-align: right;">7.4</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>exclusivePossibilities.\</code></td>
<td style="text-align: left;">Sudoku.hs:71:64-96</td>
<td style="text-align: right;">4.0</td>
<td style="text-align: right;">3.4</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>EP.filter</code></td>
<td style="text-align: left;">Sudoku.hs:60:30-54</td>
<td style="text-align: right;">2.9</td>
<td style="text-align: right;">3.4</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>EP.foldl</code></td>
<td style="text-align: left;">Sudoku.hs:(61,29)-(69,15)</td>
<td style="text-align: right;">2.8</td>
<td style="text-align: right;">1.8</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities</code></td>
<td style="text-align: left;">Sudoku.hs:(57,1)-(76,26)</td>
<td style="text-align: right;">2.7</td>
<td style="text-align: right;">1.9</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>chunksOf.splitter</code></td>
<td style="text-align: left;">Data/List/Split/Internals.hs:(516,3)-(517,49)</td>
<td style="text-align: right;">2.5</td>
<td style="text-align: right;">2.7</td>
</tr>
</tbody>
</table>
</div>
<p>So almost one-fifth of the time is actually going in this nested one-line anonymous function inside <code>exclusivePossibilities</code>:</p>
<div class="sourceCode" id="cb14" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb14-1"><a href="#cb14-1" aria-hidden="true" tabindex="-1"></a>(\acc' n <span class="ot">-></span></span>
<span id="cb14-2"><a href="#cb14-2" aria-hidden="true" tabindex="-1"></a> <span class="kw">if</span> Data.Bits.testBit xs n <span class="kw">then</span> Map.insertWith prepend n [i] acc' <span class="kw">else</span> acc')</span></code></pre></div>
<p>But we are going to ignore it for now.</p>
<p>If we look closely, we also find that around 17% of the run time now goes into list traversal and manipulation. This is in the functions <code>pruneCellsByFixed</code>, <code>pruneGrid'</code>, <code>chunksOf</code> and <code>chunksOf.splitter</code>, where the first two are majorly list traversal and transposition, and the last two are list splitting. Maybe it is time to get rid of lists altogether?</p>
<h2 data-track-content data-content-name="vectors-of-speed" data-content-piece="fast-sudoku-solver-in-haskell-3" id="vectors-of-speed">Vectors of Speed</h2>
<p><a href="https://hackage.haskell.org/package/vector-0.12.0.1" target="_blank" rel="noopener">Vector</a> is a Haskell library for working with arrays. It implements very performant operations for integer-indexed array data. Unlike the lists in Haskell which are implemented as <a href="https://en.wikipedia.org/wiki/Linked_list#Singly_linked_list" target="_blank" rel="noopener">singly linked lists</a>, vectors are stored in a contiguous set of memory locations. This makes random access to the elements a constant time operation. The memory overhead per additional item in vectors is also much smaller. Lists allocate memory for each item in the heap and have pointers to the memory locations in nodes, leading to a lot of wasted memory in holding pointers. On the other hand, operations on lists are lazy, whereas, operations on vectors are strict, and this may need to useless computation depending on the use-case<a href="#fn5" class="footnote-ref" id="fnref5" role="doc-noteref"><sup>5</sup></a>.</p>
<p>In our current code, we represent the grid as a list of lists of cells. All the pruning operations require us to traverse the grid list or the row lists. We also need to transform the grid back-and-forth for being able to use the same pruning operations for rows, columns and sub-grids. The pruning of cells and the choosing of pivot cells also requires us to replace cells in the grid with new ones, leading to a lot of list traversals.</p>
<p>To prevent all this linear-time list traversals, we can replace the nested list of lists with a single vector. Then all we need to do it to go over the right parts of this vector, looking up and replacing cells as needed. Since both lookups and updates on vectors are constant time, this should lead to a speedup.</p>
<p>Let’s start by changing the grid to a vector of cells.:</p>
<div class="sourceCode" id="cb15" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb15-1"><a href="#cb15-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">Cell</span> <span class="ot">=</span> <span class="dt">Fixed</span> <span class="dt">Data.Word.Word16</span></span>
<span id="cb15-2"><a href="#cb15-2" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="dt">Possible</span> <span class="dt">Data.Word.Word16</span></span>
<span id="cb15-3"><a href="#cb15-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</span>
<span id="cb15-4"><a href="#cb15-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb15-5"><a href="#cb15-5" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> <span class="dt">Grid</span> <span class="ot">=</span> <span class="dt">Data.Vector.Vector</span> <span class="dt">Cell</span></span></code></pre></div>
<p>Since we plan to traverse different parts of the same vector, let’s define these different parts first:</p>
<div class="sourceCode" id="cb16" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb16-1"><a href="#cb16-1" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> <span class="dt">CellIxs</span> <span class="ot">=</span> [<span class="dt">Int</span>]</span>
<span id="cb16-2"><a href="#cb16-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb16-3"><a href="#cb16-3" aria-hidden="true" tabindex="-1"></a><span class="ot">fromXY ::</span> (<span class="dt">Int</span>, <span class="dt">Int</span>) <span class="ot">-></span> <span class="dt">Int</span></span>
<span id="cb16-4"><a href="#cb16-4" aria-hidden="true" tabindex="-1"></a>fromXY (x, y) <span class="ot">=</span> x <span class="op">*</span> <span class="dv">9</span> <span class="op">+</span> y</span>
<span id="cb16-5"><a href="#cb16-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb16-6"><a href="#cb16-6" aria-hidden="true" tabindex="-1"></a>allRowIxs, allColIxs,<span class="ot"> allSubGridIxs ::</span> [<span class="dt">CellIxs</span>]</span>
<span id="cb16-7"><a href="#cb16-7" aria-hidden="true" tabindex="-1"></a>allRowIxs <span class="ot">=</span> [getRow i <span class="op">|</span> i <span class="ot"><-</span> [<span class="dv">0</span><span class="op">..</span><span class="dv">8</span>]]</span>
<span id="cb16-8"><a href="#cb16-8" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span> getRow n <span class="ot">=</span> [ fromXY (n, i) <span class="op">|</span> i <span class="ot"><-</span> [<span class="dv">0</span><span class="op">..</span><span class="dv">8</span>] ]</span>
<span id="cb16-9"><a href="#cb16-9" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb16-10"><a href="#cb16-10" aria-hidden="true" tabindex="-1"></a>allColIxs <span class="ot">=</span> [getCol i <span class="op">|</span> i <span class="ot"><-</span> [<span class="dv">0</span><span class="op">..</span><span class="dv">8</span>]]</span>
<span id="cb16-11"><a href="#cb16-11" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span> getCol n <span class="ot">=</span> [ fromXY (i, n) <span class="op">|</span> i <span class="ot"><-</span> [<span class="dv">0</span><span class="op">..</span><span class="dv">8</span>] ]</span>
<span id="cb16-12"><a href="#cb16-12" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb16-13"><a href="#cb16-13" aria-hidden="true" tabindex="-1"></a>allSubGridIxs <span class="ot">=</span> [getSubGrid i <span class="op">|</span> i <span class="ot"><-</span> [<span class="dv">0</span><span class="op">..</span><span class="dv">8</span>]]</span>
<span id="cb16-14"><a href="#cb16-14" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span> getSubGrid n <span class="ot">=</span> <span class="kw">let</span> (r, c) <span class="ot">=</span> (n <span class="ot">`quot`</span> <span class="dv">3</span>, n <span class="ot">`mod`</span> <span class="dv">3</span>)</span>
<span id="cb16-15"><a href="#cb16-15" aria-hidden="true" tabindex="-1"></a> <span class="kw">in</span> [ fromXY (<span class="dv">3</span> <span class="op">*</span> r <span class="op">+</span> i, <span class="dv">3</span> <span class="op">*</span> c <span class="op">+</span> j) <span class="op">|</span> i <span class="ot"><-</span> [<span class="dv">0</span><span class="op">..</span><span class="dv">2</span>], j <span class="ot"><-</span> [<span class="dv">0</span><span class="op">..</span><span class="dv">2</span>] ]</span></code></pre></div>
<p>We define a type for cell indices as a list of integers. Then we create three lists of cell indices: all row indices, all column indices, and all sub-grid indices. Let’s check these out in the <em>REPL</em>:</p>
<div class="sourceCode" id="cb17" data-lang="ghci"><pre class="sourceCode lhs numberSource"><code class="sourceCode literatehaskell"><span id="cb17-1"><a href="#cb17-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> Control.Monad.mapM_ <span class="fu">print</span> allRowIxs</span>
<span id="cb17-2"><a href="#cb17-2" aria-hidden="true" tabindex="-1"></a>[0,1,2,3,4,5,6,7,8]</span>
<span id="cb17-3"><a href="#cb17-3" aria-hidden="true" tabindex="-1"></a>[9,10,11,12,13,14,15,16,17]</span>
<span id="cb17-4"><a href="#cb17-4" aria-hidden="true" tabindex="-1"></a>[18,19,20,21,22,23,24,25,26]</span>
<span id="cb17-5"><a href="#cb17-5" aria-hidden="true" tabindex="-1"></a>[27,28,29,30,31,32,33,34,35]</span>
<span id="cb17-6"><a href="#cb17-6" aria-hidden="true" tabindex="-1"></a>[36,37,38,39,40,41,42,43,44]</span>
<span id="cb17-7"><a href="#cb17-7" aria-hidden="true" tabindex="-1"></a>[45,46,47,48,49,50,51,52,53]</span>
<span id="cb17-8"><a href="#cb17-8" aria-hidden="true" tabindex="-1"></a>[54,55,56,57,58,59,60,61,62]</span>
<span id="cb17-9"><a href="#cb17-9" aria-hidden="true" tabindex="-1"></a>[63,64,65,66,67,68,69,70,71]</span>
<span id="cb17-10"><a href="#cb17-10" aria-hidden="true" tabindex="-1"></a>[72,73,74,75,76,77,78,79,80]</span>
<span id="cb17-11"><a href="#cb17-11" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> Control.Monad.mapM_ <span class="fu">print</span> allColIxs</span>
<span id="cb17-12"><a href="#cb17-12" aria-hidden="true" tabindex="-1"></a>[0,9,18,27,36,45,54,63,72]</span>
<span id="cb17-13"><a href="#cb17-13" aria-hidden="true" tabindex="-1"></a>[1,10,19,28,37,46,55,64,73]</span>
<span id="cb17-14"><a href="#cb17-14" aria-hidden="true" tabindex="-1"></a>[2,11,20,29,38,47,56,65,74]</span>
<span id="cb17-15"><a href="#cb17-15" aria-hidden="true" tabindex="-1"></a>[3,12,21,30,39,48,57,66,75]</span>
<span id="cb17-16"><a href="#cb17-16" aria-hidden="true" tabindex="-1"></a>[4,13,22,31,40,49,58,67,76]</span>
<span id="cb17-17"><a href="#cb17-17" aria-hidden="true" tabindex="-1"></a>[5,14,23,32,41,50,59,68,77]</span>
<span id="cb17-18"><a href="#cb17-18" aria-hidden="true" tabindex="-1"></a>[6,15,24,33,42,51,60,69,78]</span>
<span id="cb17-19"><a href="#cb17-19" aria-hidden="true" tabindex="-1"></a>[7,16,25,34,43,52,61,70,79]</span>
<span id="cb17-20"><a href="#cb17-20" aria-hidden="true" tabindex="-1"></a>[8,17,26,35,44,53,62,71,80]</span>
<span id="cb17-21"><a href="#cb17-21" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> Control.Monad.mapM_ <span class="fu">print</span> allSubGridIxs</span>
<span id="cb17-22"><a href="#cb17-22" aria-hidden="true" tabindex="-1"></a>[0,1,2,9,10,11,18,19,20]</span>
<span id="cb17-23"><a href="#cb17-23" aria-hidden="true" tabindex="-1"></a>[3,4,5,12,13,14,21,22,23]</span>
<span id="cb17-24"><a href="#cb17-24" aria-hidden="true" tabindex="-1"></a>[6,7,8,15,16,17,24,25,26]</span>
<span id="cb17-25"><a href="#cb17-25" aria-hidden="true" tabindex="-1"></a>[27,28,29,36,37,38,45,46,47]</span>
<span id="cb17-26"><a href="#cb17-26" aria-hidden="true" tabindex="-1"></a>[30,31,32,39,40,41,48,49,50]</span>
<span id="cb17-27"><a href="#cb17-27" aria-hidden="true" tabindex="-1"></a>[33,34,35,42,43,44,51,52,53]</span>
<span id="cb17-28"><a href="#cb17-28" aria-hidden="true" tabindex="-1"></a>[54,55,56,63,64,65,72,73,74]</span>
<span id="cb17-29"><a href="#cb17-29" aria-hidden="true" tabindex="-1"></a>[57,58,59,66,67,68,75,76,77]</span>
<span id="cb17-30"><a href="#cb17-30" aria-hidden="true" tabindex="-1"></a>[60,61,62,69,70,71,78,79,80]</span></code></pre></div>
<p>We can verify manually that these indices are correct.</p>
<p>Read and show functions are easy to change for vector:</p>
<div class="sourceCode" id="cb18" data-lang="diff"><pre class="sourceCode numberSource diff"><code class="sourceCode diff"><span id="cb18-1"><a href="#cb18-1" aria-hidden="true" tabindex="-1"></a> readGrid :: String -> Maybe Grid</span>
<span id="cb18-2"><a href="#cb18-2" aria-hidden="true" tabindex="-1"></a> readGrid s</span>
<span id="cb18-3"><a href="#cb18-3" aria-hidden="true" tabindex="-1"></a><span class="st">- | length s == 81 = traverse (traverse readCell) . Data.List.Split.chunksOf 9 $ s</span></span>
<span id="cb18-4"><a href="#cb18-4" aria-hidden="true" tabindex="-1"></a><span class="va">+ | length s == 81 = Data.Vector.fromList <$> traverse readCell s</span></span>
<span id="cb18-5"><a href="#cb18-5" aria-hidden="true" tabindex="-1"></a> | otherwise = Nothing</span>
<span id="cb18-6"><a href="#cb18-6" aria-hidden="true" tabindex="-1"></a> where</span>
<span id="cb18-7"><a href="#cb18-7" aria-hidden="true" tabindex="-1"></a> allBitsSet = 1022</span>
<span id="cb18-8"><a href="#cb18-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb18-9"><a href="#cb18-9" aria-hidden="true" tabindex="-1"></a> readCell '.' = Just $ Possible allBitsSet</span>
<span id="cb18-10"><a href="#cb18-10" aria-hidden="true" tabindex="-1"></a> readCell c</span>
<span id="cb18-11"><a href="#cb18-11" aria-hidden="true" tabindex="-1"></a> | Data.Char.isDigit c && c > '0' =</span>
<span id="cb18-12"><a href="#cb18-12" aria-hidden="true" tabindex="-1"></a> Just . Fixed . Data.Bits.bit . Data.Char.digitToInt $ c</span>
<span id="cb18-13"><a href="#cb18-13" aria-hidden="true" tabindex="-1"></a> | otherwise = Nothing</span>
<span id="cb18-14"><a href="#cb18-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb18-15"><a href="#cb18-15" aria-hidden="true" tabindex="-1"></a> showGrid :: Grid -> String</span>
<span id="cb18-16"><a href="#cb18-16" aria-hidden="true" tabindex="-1"></a><span class="st">-showGrid = unlines . map (unwords . map showCell)</span></span>
<span id="cb18-17"><a href="#cb18-17" aria-hidden="true" tabindex="-1"></a><span class="va">+showGrid grid =</span></span>
<span id="cb18-18"><a href="#cb18-18" aria-hidden="true" tabindex="-1"></a><span class="va">+ unlines . map (unwords . map (showCell . (grid !))) $ allRowIxs</span></span>
<span id="cb18-19"><a href="#cb18-19" aria-hidden="true" tabindex="-1"></a> where</span>
<span id="cb18-20"><a href="#cb18-20" aria-hidden="true" tabindex="-1"></a> showCell (Fixed x) = show . Data.Bits.countTrailingZeros $ x</span>
<span id="cb18-21"><a href="#cb18-21" aria-hidden="true" tabindex="-1"></a> showCell _ = "."</span>
<span id="cb18-22"><a href="#cb18-22" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb18-23"><a href="#cb18-23" aria-hidden="true" tabindex="-1"></a> showGridWithPossibilities :: Grid -> String</span>
<span id="cb18-24"><a href="#cb18-24" aria-hidden="true" tabindex="-1"></a><span class="st">-showGridWithPossibilities = unlines . map (unwords . map showCell)</span></span>
<span id="cb18-25"><a href="#cb18-25" aria-hidden="true" tabindex="-1"></a><span class="va">+showGridWithPossibilities grid =</span></span>
<span id="cb18-26"><a href="#cb18-26" aria-hidden="true" tabindex="-1"></a><span class="va">+ unlines . map (unwords . map (showCell . (grid !))) $ allRowIxs</span></span>
<span id="cb18-27"><a href="#cb18-27" aria-hidden="true" tabindex="-1"></a> where</span>
<span id="cb18-28"><a href="#cb18-28" aria-hidden="true" tabindex="-1"></a> showCell (Fixed x) = (show . Data.Bits.countTrailingZeros $ x) ++ " "</span>
<span id="cb18-29"><a href="#cb18-29" aria-hidden="true" tabindex="-1"></a> showCell (Possible xs) =</span>
<span id="cb18-30"><a href="#cb18-30" aria-hidden="true" tabindex="-1"></a> "[" ++</span>
<span id="cb18-31"><a href="#cb18-31" aria-hidden="true" tabindex="-1"></a> map (\i -> if Data.Bits.testBit xs i</span>
<span id="cb18-32"><a href="#cb18-32" aria-hidden="true" tabindex="-1"></a> then Data.Char.intToDigit i</span>
<span id="cb18-33"><a href="#cb18-33" aria-hidden="true" tabindex="-1"></a> else ' ')</span>
<span id="cb18-34"><a href="#cb18-34" aria-hidden="true" tabindex="-1"></a> [1..9]</span>
<span id="cb18-35"><a href="#cb18-35" aria-hidden="true" tabindex="-1"></a> ++ "]"</span></code></pre></div>
<p><code>readGrid</code> simply changes to work on a single vector of cells instead of a list of lists. Show functions have a pretty minor change to do lookups from a vector using the row indices and the <a href="https://hackage.haskell.org/package/vector-0.12.0.1/docs/Data-Vector.html#v:-33-" target="_blank" rel="noopener"><code>(!)</code></a> function. The <code>(!)</code> function is the vector indexing function which is similar to the <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Prelude.html#v:-33--33-" target="_blank" rel="noopener"><code>(!!)</code></a> function, except it executes in constant time.</p>
<p>The pruning related functions are rewritten for working with vectors:</p>
<div class="sourceCode" id="cb19" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb19-1"><a href="#cb19-1" aria-hidden="true" tabindex="-1"></a><span class="ot">replaceCell ::</span> <span class="dt">Int</span> <span class="ot">-></span> <span class="dt">Cell</span> <span class="ot">-></span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">Grid</span></span>
<span id="cb19-2"><a href="#cb19-2" aria-hidden="true" tabindex="-1"></a>replaceCell i c g <span class="ot">=</span> g <span class="op">Data.Vector.//</span> [(i, c)]</span>
<span id="cb19-3"><a href="#cb19-3" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb19-4"><a href="#cb19-4" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneCellsByFixed ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">CellIxs</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb19-5"><a href="#cb19-5" aria-hidden="true" tabindex="-1"></a>pruneCellsByFixed grid cellIxs <span class="ot">=</span></span>
<span id="cb19-6"><a href="#cb19-6" aria-hidden="true" tabindex="-1"></a> Control.Monad.foldM pruneCell grid <span class="op">.</span> <span class="fu">map</span> (\i <span class="ot">-></span> (i, grid <span class="op">!</span> i)) <span class="op">$</span> cellIxs</span>
<span id="cb19-7"><a href="#cb19-7" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb19-8"><a href="#cb19-8" aria-hidden="true" tabindex="-1"></a> fixeds <span class="ot">=</span> setBits Data.Bits.zeroBits [x <span class="op">|</span> <span class="dt">Fixed</span> x <span class="ot"><-</span> <span class="fu">map</span> (grid <span class="op">!</span>) cellIxs]</span>
<span id="cb19-9"><a href="#cb19-9" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb19-10"><a href="#cb19-10" aria-hidden="true" tabindex="-1"></a> pruneCell g (_, <span class="dt">Fixed</span> _) <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb19-11"><a href="#cb19-11" aria-hidden="true" tabindex="-1"></a> pruneCell g (i, <span class="dt">Possible</span> xs)</span>
<span id="cb19-12"><a href="#cb19-12" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> xs' <span class="op">==</span> xs <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb19-13"><a href="#cb19-13" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> <span class="fu">flip</span> (replaceCell i) g <span class="op"><$></span> makeCell xs'</span>
<span id="cb19-14"><a href="#cb19-14" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb19-15"><a href="#cb19-15" aria-hidden="true" tabindex="-1"></a> xs' <span class="ot">=</span> xs <span class="op">Data.Bits..&.</span> Data.Bits.complement fixeds</span>
<span id="cb19-16"><a href="#cb19-16" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb19-17"><a href="#cb19-17" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneCellsByExclusives ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">CellIxs</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb19-18"><a href="#cb19-18" aria-hidden="true" tabindex="-1"></a>pruneCellsByExclusives grid cellIxs <span class="ot">=</span> <span class="kw">case</span> exclusives <span class="kw">of</span></span>
<span id="cb19-19"><a href="#cb19-19" aria-hidden="true" tabindex="-1"></a> [] <span class="ot">-></span> <span class="dt">Just</span> grid</span>
<span id="cb19-20"><a href="#cb19-20" aria-hidden="true" tabindex="-1"></a> _ <span class="ot">-></span> Control.Monad.foldM pruneCell grid <span class="op">.</span> <span class="fu">zip</span> cellIxs <span class="op">$</span> cells</span>
<span id="cb19-21"><a href="#cb19-21" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb19-22"><a href="#cb19-22" aria-hidden="true" tabindex="-1"></a> cells <span class="ot">=</span> <span class="fu">map</span> (grid <span class="op">!</span>) cellIxs</span>
<span id="cb19-23"><a href="#cb19-23" aria-hidden="true" tabindex="-1"></a> exclusives <span class="ot">=</span> exclusivePossibilities cells</span>
<span id="cb19-24"><a href="#cb19-24" aria-hidden="true" tabindex="-1"></a> allExclusives <span class="ot">=</span> setBits Data.Bits.zeroBits exclusives</span>
<span id="cb19-25"><a href="#cb19-25" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb19-26"><a href="#cb19-26" aria-hidden="true" tabindex="-1"></a> pruneCell g (_, <span class="dt">Fixed</span> _) <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb19-27"><a href="#cb19-27" aria-hidden="true" tabindex="-1"></a> pruneCell g (i, <span class="dt">Possible</span> xs)</span>
<span id="cb19-28"><a href="#cb19-28" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> intersection <span class="op">==</span> xs <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb19-29"><a href="#cb19-29" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> intersection <span class="ot">`elem`</span> exclusives <span class="ot">=</span></span>
<span id="cb19-30"><a href="#cb19-30" aria-hidden="true" tabindex="-1"></a> <span class="fu">flip</span> (replaceCell i) g <span class="op"><$></span> makeCell intersection</span>
<span id="cb19-31"><a href="#cb19-31" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb19-32"><a href="#cb19-32" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb19-33"><a href="#cb19-33" aria-hidden="true" tabindex="-1"></a> intersection <span class="ot">=</span> xs <span class="op">Data.Bits..&.</span> allExclusives</span>
<span id="cb19-34"><a href="#cb19-34" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb19-35"><a href="#cb19-35" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneCells ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">CellIxs</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb19-36"><a href="#cb19-36" aria-hidden="true" tabindex="-1"></a>pruneCells grid cellIxs <span class="ot">=</span></span>
<span id="cb19-37"><a href="#cb19-37" aria-hidden="true" tabindex="-1"></a> fixM (<span class="fu">flip</span> pruneCellsByFixed cellIxs) grid</span>
<span id="cb19-38"><a href="#cb19-38" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> fixM (<span class="fu">flip</span> pruneCellsByExclusives cellIxs)</span></code></pre></div>
<p>All the three functions now take the grid and the cell indices instead of a list of cells, and use the cell indices to lookup the cells from the grid. Also, instead of using the <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Traversable.html#v:traverse" target="_blank" rel="noopener"><code>traverse</code></a> function as earlier, now we use the <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Control-Monad.html#v:foldM" target="_blank" rel="noopener"><code>Control.Monad.foldM</code></a> function to fold over the cell-index-and-cell tuples in the context of the <code>Maybe</code> monad, making changes to the grid directly.</p>
<p>We use the <code>replaceCell</code> function to replace cells at an index in the grid. It is a simple wrapper over the vector update function <code>Data.Vector.//</code>. Rest of the code is same in essence, except a few changes to accommodate the changed function parameters.</p>
<p><code>pruneGrid'</code> function does not need to do transpositions and back-transpositions anymore as now we use the cell indices to go over the right parts of the grid vector directly:</p>
<div class="sourceCode" id="cb20" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb20-1"><a href="#cb20-1" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneGrid' ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb20-2"><a href="#cb20-2" aria-hidden="true" tabindex="-1"></a>pruneGrid' grid <span class="ot">=</span></span>
<span id="cb20-3"><a href="#cb20-3" aria-hidden="true" tabindex="-1"></a> Control.Monad.foldM pruneCells grid allRowIxs</span>
<span id="cb20-4"><a href="#cb20-4" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> <span class="fu">flip</span> (Control.Monad.foldM pruneCells) allColIxs</span>
<span id="cb20-5"><a href="#cb20-5" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> <span class="fu">flip</span> (Control.Monad.foldM pruneCells) allSubGridIxs</span></code></pre></div>
<p>Notice that the <code>traverse</code> function here is also replaced by the <code>Control.Monad.foldM</code> function.</p>
<p>Similarly, the grid predicate functions change a little to go over a vector instead of a list of lists:</p>
<div class="sourceCode" id="cb21" data-lang="diff"><pre class="sourceCode numberSource diff"><code class="sourceCode diff"><span id="cb21-1"><a href="#cb21-1" aria-hidden="true" tabindex="-1"></a> isGridFilled :: Grid -> Bool</span>
<span id="cb21-2"><a href="#cb21-2" aria-hidden="true" tabindex="-1"></a><span class="st">-isGridFilled grid = null [ () | Possible _ <- concat grid ]</span></span>
<span id="cb21-3"><a href="#cb21-3" aria-hidden="true" tabindex="-1"></a><span class="va">+isGridFilled = not . Data.Vector.any isPossible</span></span>
<span id="cb21-4"><a href="#cb21-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-5"><a href="#cb21-5" aria-hidden="true" tabindex="-1"></a> isGridInvalid :: Grid -> Bool</span>
<span id="cb21-6"><a href="#cb21-6" aria-hidden="true" tabindex="-1"></a> isGridInvalid grid =</span>
<span id="cb21-7"><a href="#cb21-7" aria-hidden="true" tabindex="-1"></a><span class="st">- any isInvalidRow grid</span></span>
<span id="cb21-8"><a href="#cb21-8" aria-hidden="true" tabindex="-1"></a><span class="st">- || any isInvalidRow (Data.List.transpose grid)</span></span>
<span id="cb21-9"><a href="#cb21-9" aria-hidden="true" tabindex="-1"></a><span class="st">- || any isInvalidRow (subGridsToRows grid)</span></span>
<span id="cb21-10"><a href="#cb21-10" aria-hidden="true" tabindex="-1"></a><span class="va">+ any isInvalidRow (map (map (grid !)) allRowIxs)</span></span>
<span id="cb21-11"><a href="#cb21-11" aria-hidden="true" tabindex="-1"></a><span class="va">+ || any isInvalidRow (map (map (grid !)) allColIxs)</span></span>
<span id="cb21-12"><a href="#cb21-12" aria-hidden="true" tabindex="-1"></a><span class="va">+ || any isInvalidRow (map (map (grid !)) allSubGridIxs)</span></span></code></pre></div>
<p>And finally, we change the <code>nextGrids</code> function to replace the list related operations with the vector related ones:</p>
<div class="sourceCode" id="cb22" data-lang="diff"><pre class="sourceCode numberSource diff"><code class="sourceCode diff"><span id="cb22-1"><a href="#cb22-1" aria-hidden="true" tabindex="-1"></a> nextGrids :: Grid -> (Grid, Grid)</span>
<span id="cb22-2"><a href="#cb22-2" aria-hidden="true" tabindex="-1"></a> nextGrids grid =</span>
<span id="cb22-3"><a href="#cb22-3" aria-hidden="true" tabindex="-1"></a> let (i, first@(Fixed _), rest) =</span>
<span id="cb22-4"><a href="#cb22-4" aria-hidden="true" tabindex="-1"></a> fixCell</span>
<span id="cb22-5"><a href="#cb22-5" aria-hidden="true" tabindex="-1"></a><span class="st">- . Data.List.minimumBy</span></span>
<span id="cb22-6"><a href="#cb22-6" aria-hidden="true" tabindex="-1"></a><span class="va">+ . Data.Vector.minimumBy</span></span>
<span id="cb22-7"><a href="#cb22-7" aria-hidden="true" tabindex="-1"></a> (compare `Data.Function.on` (possibilityCount . snd))</span>
<span id="cb22-8"><a href="#cb22-8" aria-hidden="true" tabindex="-1"></a><span class="st">- . filter (isPossible . snd)</span></span>
<span id="cb22-9"><a href="#cb22-9" aria-hidden="true" tabindex="-1"></a><span class="st">- . zip [0..]</span></span>
<span id="cb22-10"><a href="#cb22-10" aria-hidden="true" tabindex="-1"></a><span class="st">- . concat</span></span>
<span id="cb22-11"><a href="#cb22-11" aria-hidden="true" tabindex="-1"></a><span class="va">+ . Data.Vector.imapMaybe</span></span>
<span id="cb22-12"><a href="#cb22-12" aria-hidden="true" tabindex="-1"></a><span class="va">+ (\j cell -> if isPossible cell then Just (j, cell) else Nothing)</span></span>
<span id="cb22-13"><a href="#cb22-13" aria-hidden="true" tabindex="-1"></a> $ grid</span>
<span id="cb22-14"><a href="#cb22-14" aria-hidden="true" tabindex="-1"></a><span class="st">- in (replace2D i first grid, replace2D i rest grid)</span></span>
<span id="cb22-15"><a href="#cb22-15" aria-hidden="true" tabindex="-1"></a><span class="va">+ in (replaceCell i first grid, replaceCell i rest grid)</span></span></code></pre></div>
<p>We also switch the <code>replace2D</code> function which went over the entire list of lists of cells to replace a cell, with the vector-based <code>replaceCell</code> function.</p>
<p>All the required changes are done. Let’s do a run:</p>
<pre class="plain"><code>$ stack build
$ cat sudoku17.txt | time stack exec sudoku > /dev/null
88.53 real 88.16 user 0.41 sys</code></pre>
<p>Oops! Instead of getting a speedup, our vector-based code is actually 1.3x slower than the list-based code. How did this happen? Time to bust out the profiler again!</p>
<h2 data-track-content data-content-name="revenge-of-the" data-content-piece="fast-sudoku-solver-in-haskell-3" id="revenge-of-the">Revenge of the <code>(==)</code></h2>
<p>Profiling the current code gives us the following hotspots:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Cost Centre</th>
<th style="text-align: left;">Src</th>
<th style="text-align: right;">%time</th>
<th style="text-align: right;">%alloc</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;"><code>>>=</code></td>
<td style="text-align: left;">Data/Vector/Fusion/Util.hs:36:3-18</td>
<td style="text-align: right;">52.2</td>
<td style="text-align: right;">51.0</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>basicUnsafeIndexM</code></td>
<td style="text-align: left;">Data/Vector.hs:278:3-62</td>
<td style="text-align: right;">22.2</td>
<td style="text-align: right;">20.4</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities</code></td>
<td style="text-align: left;">Sudoku.hs:(75,1)-(93,26)</td>
<td style="text-align: right;">6.8</td>
<td style="text-align: right;">8.3</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>exclusivePossibilities.\.\</code></td>
<td style="text-align: left;">Sudoku.hs:83:23-96</td>
<td style="text-align: right;">3.8</td>
<td style="text-align: right;">8.8</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>pruneCellsByFixed.fixeds</code></td>
<td style="text-align: left;">Sudoku.hs:105:5-77</td>
<td style="text-align: right;">2.0</td>
<td style="text-align: right;">1.7</td>
</tr>
</tbody>
</table>
</div>
<p>We see a sudden appearance of <code>(>>=)</code> from the <code>Data.Vector.Fusion.Util</code> module at the top of the list, taking more than half of the run time. For more clues, we dive into the detailed profiler report and find this bit:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Cost Centre</th>
<th style="text-align: left;">Src</th>
<th style="text-align: right;">%time</th>
<th style="text-align: right;">%alloc</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;"><code>pruneGrid</code></td>
<td style="text-align: left;">Sudoku.hs:143:1-27</td>
<td style="text-align: right;">0.0</td>
<td style="text-align: right;">0.0</td>
</tr>
<tr class="even">
<td style="text-align: left;"> <code>fixM</code></td>
<td style="text-align: left;">Sudoku.hs:16:1-65</td>
<td style="text-align: right;">0.1</td>
<td style="text-align: right;">0.0</td>
</tr>
<tr class="odd">
<td style="text-align: left;"> <code>fixM.\</code></td>
<td style="text-align: left;">Sudoku.hs:16:27-65</td>
<td style="text-align: right;">0.2</td>
<td style="text-align: right;">0.1</td>
</tr>
<tr class="even">
<td style="text-align: left;"> <code>==</code></td>
<td style="text-align: left;">Data/Vector.hs:287:3-50</td>
<td style="text-align: right;">1.0</td>
<td style="text-align: right;">1.4</td>
</tr>
<tr class="odd">
<td style="text-align: left;"> <code>>>=</code></td>
<td style="text-align: left;">Data/Vector/Fusion/Util.hs:36:3-18</td>
<td style="text-align: right;">51.9</td>
<td style="text-align: right;">50.7</td>
</tr>
<tr class="even">
<td style="text-align: left;"> <code>basicUnsafeIndexM</code></td>
<td style="text-align: left;">Data/Vector.hs:278:3-62</td>
<td style="text-align: right;">19.3</td>
<td style="text-align: right;">20.3</td>
</tr>
</tbody>
</table>
</div>
<p>Here, the indentation indicated nesting of operations. We see that both the <code>(>>=)</code> and <code>basicUnsafeIndexM</code> functions—which together take around three-quarter of the run time—are being called from the <code>(==)</code> function in the <code>fixM</code> function<a href="#fn6" class="footnote-ref" id="fnref6" role="doc-noteref"><sup>6</sup></a>. It seems like we are checking for equality too many times. Here’s the usage of the <code>fixM</code> for reference:</p>
<div class="sourceCode" id="cb24" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb24-1"><a href="#cb24-1" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneCells ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">CellIxs</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb24-2"><a href="#cb24-2" aria-hidden="true" tabindex="-1"></a>pruneCells grid cellIxs <span class="ot">=</span></span>
<span id="cb24-3"><a href="#cb24-3" aria-hidden="true" tabindex="-1"></a> fixM (<span class="fu">flip</span> pruneCellsByFixed cellIxs) grid</span>
<span id="cb24-4"><a href="#cb24-4" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> fixM (<span class="fu">flip</span> pruneCellsByExclusives cellIxs)</span>
<span id="cb24-5"><a href="#cb24-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb24-6"><a href="#cb24-6" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneGrid ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb24-7"><a href="#cb24-7" aria-hidden="true" tabindex="-1"></a>pruneGrid <span class="ot">=</span> fixM pruneGrid'</span></code></pre></div>
<p>In <code>pruneGrid</code>, we run <code>pruneGrid'</code> till the resultant grid settles, that is, the grid computed in a particular iteration is <strong>equal to</strong> the grid in the previous iteration. Interestingly, we do the same thing in <code>pruneCells</code> too. We equate <strong>the whole grid</strong> to check for settling of each block of cells. This is the reason of the slowdown.</p>
<h2 data-track-content data-content-name="one-function-to-prune-them-all" data-content-piece="fast-sudoku-solver-in-haskell-3" id="one-function-to-prune-them-all">One Function to Prune Them All</h2>
<p>Why did we add <code>fixM</code> in the <code>pruneCells</code> function at all? Quoting from the <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/?mtm_campaign=feed#fn6">previous post</a>,</p>
<blockquote>
<p>We need to run <code>pruneCellsByFixed</code> and <code>pruneCellsByExclusives</code> repeatedly using <code>fixM</code> because an unsettled row can lead to wrong solutions.</p>
<p>Imagine a row which just got a <code>9</code> fixed because of <code>pruneCellsByFixed</code>. If we don’t run the function again, the row may be left with one non-fixed cell with a <code>9</code>. When we run this row through <code>pruneCellsByExclusives</code>, it’ll consider the <code>9</code> in the non-fixed cell as a <em>Single</em> and fix it. This will lead to two <code>9</code>s in the same row, causing the solution to fail.</p>
</blockquote>
<p>So the reason we added <code>fixM</code> is that, we run the two pruning strategies one-after-another. That way, they see the cells in the same block in different states. If we were to merge the two pruning functions into a single one such that they work in lockstep, we would not need to run <code>fixM</code> at all!</p>
<p>With this idea, we rewrite <code>pruneCells</code> as a single function:</p>
<div class="sourceCode" id="cb25" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb25-1"><a href="#cb25-1" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneCells ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">CellIxs</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb25-2"><a href="#cb25-2" aria-hidden="true" tabindex="-1"></a>pruneCells grid cellIxs <span class="ot">=</span> Control.Monad.foldM pruneCell grid cellIxs</span>
<span id="cb25-3"><a href="#cb25-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb25-4"><a href="#cb25-4" aria-hidden="true" tabindex="-1"></a> cells <span class="ot">=</span> <span class="fu">map</span> (grid <span class="op">!</span>) cellIxs</span>
<span id="cb25-5"><a href="#cb25-5" aria-hidden="true" tabindex="-1"></a> exclusives <span class="ot">=</span> exclusivePossibilities cells</span>
<span id="cb25-6"><a href="#cb25-6" aria-hidden="true" tabindex="-1"></a> allExclusives <span class="ot">=</span> setBits Data.Bits.zeroBits exclusives</span>
<span id="cb25-7"><a href="#cb25-7" aria-hidden="true" tabindex="-1"></a> fixeds <span class="ot">=</span> setBits Data.Bits.zeroBits [x <span class="op">|</span> <span class="dt">Fixed</span> x <span class="ot"><-</span> cells]</span>
<span id="cb25-8"><a href="#cb25-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb25-9"><a href="#cb25-9" aria-hidden="true" tabindex="-1"></a> pruneCell g i <span class="ot">=</span></span>
<span id="cb25-10"><a href="#cb25-10" aria-hidden="true" tabindex="-1"></a> pruneCellByFixed g (i, g <span class="op">!</span> i) <span class="op">>>=</span> \g' <span class="ot">-></span> pruneCellByExclusives g' (i, g' <span class="op">!</span> i)</span>
<span id="cb25-11"><a href="#cb25-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb25-12"><a href="#cb25-12" aria-hidden="true" tabindex="-1"></a> pruneCellByFixed g (_, <span class="dt">Fixed</span> _) <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb25-13"><a href="#cb25-13" aria-hidden="true" tabindex="-1"></a> pruneCellByFixed g (i, <span class="dt">Possible</span> xs)</span>
<span id="cb25-14"><a href="#cb25-14" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> xs' <span class="op">==</span> xs <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb25-15"><a href="#cb25-15" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> <span class="fu">flip</span> (replaceCell i) g <span class="op"><$></span> makeCell xs'</span>
<span id="cb25-16"><a href="#cb25-16" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb25-17"><a href="#cb25-17" aria-hidden="true" tabindex="-1"></a> xs' <span class="ot">=</span> xs <span class="op">Data.Bits..&.</span> Data.Bits.complement fixeds</span>
<span id="cb25-18"><a href="#cb25-18" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb25-19"><a href="#cb25-19" aria-hidden="true" tabindex="-1"></a> pruneCellByExclusives g (_, <span class="dt">Fixed</span> _) <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb25-20"><a href="#cb25-20" aria-hidden="true" tabindex="-1"></a> pruneCellByExclusives g (i, <span class="dt">Possible</span> xs)</span>
<span id="cb25-21"><a href="#cb25-21" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">null</span> exclusives <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb25-22"><a href="#cb25-22" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> intersection <span class="op">==</span> xs <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb25-23"><a href="#cb25-23" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> intersection <span class="ot">`elem`</span> exclusives <span class="ot">=</span></span>
<span id="cb25-24"><a href="#cb25-24" aria-hidden="true" tabindex="-1"></a> <span class="fu">flip</span> (replaceCell i) g <span class="op"><$></span> makeCell intersection</span>
<span id="cb25-25"><a href="#cb25-25" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb25-26"><a href="#cb25-26" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb25-27"><a href="#cb25-27" aria-hidden="true" tabindex="-1"></a> intersection <span class="ot">=</span> xs <span class="op">Data.Bits..&.</span> allExclusives</span></code></pre></div>
<p>We have merged the two pruning functions almost blindly. The important part here is the nested <code>pruneCell</code> function which uses monadic bind <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Control-Monad.html#v:-62--62--61-" target="_blank" rel="noopener"><code>(>>=)</code></a> to ensure that cells fixed in the first step are seen by the next step. Merging the two functions ensures that both strategies will see same <em>Exclusives</em> and <em>Fixeds</em>, thereby running in lockstep.</p>
<p>Let’s try it out:</p>
<pre class="plain"><code>$ stack build
$ cat sudoku17.txt | time stack exec sudoku > /dev/null
57.67 real 57.12 user 0.46 sys</code></pre>
<p>Ah, now it’s faster than the list-based implementation by 1.2x<a href="#fn7" class="footnote-ref" id="fnref7" role="doc-noteref"><sup>7</sup></a>. Let’s see what the profiler says:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Cost Centre</th>
<th style="text-align: left;">Src</th>
<th style="text-align: right;">%time</th>
<th style="text-align: right;">%alloc</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities.\.\</code></td>
<td style="text-align: left;">Sudoku.hs:82:23-96</td>
<td style="text-align: right;">15.7</td>
<td style="text-align: right;">33.3</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>pruneCells</code></td>
<td style="text-align: left;">Sudoku.hs:(101,1)-(126,53)</td>
<td style="text-align: right;">9.6</td>
<td style="text-align: right;">6.8</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>pruneCells.pruneCell</code></td>
<td style="text-align: left;">Sudoku.hs:(108,5)-(109,83)</td>
<td style="text-align: right;">9.5</td>
<td style="text-align: right;">2.1</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>basicUnsafeIndexM</code></td>
<td style="text-align: left;">Data/Vector.hs:278:3-62</td>
<td style="text-align: right;">9.4</td>
<td style="text-align: right;">0.5</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>pruneCells.pruneCell.\</code></td>
<td style="text-align: left;">Sudoku.hs:109:48-83</td>
<td style="text-align: right;">7.6</td>
<td style="text-align: right;">2.1</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>pruneCells.cells</code></td>
<td style="text-align: left;">Sudoku.hs:103:5-40</td>
<td style="text-align: right;">7.1</td>
<td style="text-align: right;">10.9</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities.\</code></td>
<td style="text-align: left;">Sudoku.hs:87:64-96</td>
<td style="text-align: right;">3.5</td>
<td style="text-align: right;">3.8</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>EP.Map.filter1</code></td>
<td style="text-align: left;">Sudoku.hs:86:35-61</td>
<td style="text-align: right;">3.0</td>
<td style="text-align: right;">0.6</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>>>=</code></td>
<td style="text-align: left;">Data/Vector/Fusion/Util.hs:36:3-18</td>
<td style="text-align: right;">2.8</td>
<td style="text-align: right;">2.0</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>replaceCell</code></td>
<td style="text-align: left;">Sudoku.hs:59:1-45</td>
<td style="text-align: right;">2.5</td>
<td style="text-align: right;">1.1</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>EP.filter</code></td>
<td style="text-align: left;">Sudoku.hs:78:30-54</td>
<td style="text-align: right;">2.4</td>
<td style="text-align: right;">3.3</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>primitive</code></td>
<td style="text-align: left;">Control/Monad/Primitive.hs:195:3-16</td>
<td style="text-align: right;">2.3</td>
<td style="text-align: right;">6.5</td>
</tr>
</tbody>
</table>
</div>
<p>The double nested anonymous function mentioned before is still the biggest culprit but <code>fixM</code> has disappeared from the list. Let’s tackle <code>exclusivePossibilities</code> now.</p>
<h2 data-track-content data-content-name="rise-of-the-mutables" data-content-piece="fast-sudoku-solver-in-haskell-3" id="rise-of-the-mutables">Rise of the Mutables</h2>
<p>Here’s <code>exclusivePossibilities</code> again for reference:</p>
<div class="sourceCode" id="cb27" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb27-1"><a href="#cb27-1" aria-hidden="true" tabindex="-1"></a><span class="ot">exclusivePossibilities ::</span> [<span class="dt">Cell</span>] <span class="ot">-></span> [<span class="dt">Data.Word.Word16</span>]</span>
<span id="cb27-2"><a href="#cb27-2" aria-hidden="true" tabindex="-1"></a>exclusivePossibilities row <span class="ot">=</span></span>
<span id="cb27-3"><a href="#cb27-3" aria-hidden="true" tabindex="-1"></a> row</span>
<span id="cb27-4"><a href="#cb27-4" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> <span class="fu">zip</span> [<span class="dv">1</span><span class="op">..</span><span class="dv">9</span>]</span>
<span id="cb27-5"><a href="#cb27-5" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> <span class="fu">filter</span> (isPossible <span class="op">.</span> <span class="fu">snd</span>)</span>
<span id="cb27-6"><a href="#cb27-6" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> Data.List.foldl'</span>
<span id="cb27-7"><a href="#cb27-7" aria-hidden="true" tabindex="-1"></a> (\acc <span class="op">~</span>(i, <span class="dt">Possible</span> xs) <span class="ot">-></span></span>
<span id="cb27-8"><a href="#cb27-8" aria-hidden="true" tabindex="-1"></a> Data.List.foldl'</span>
<span id="cb27-9"><a href="#cb27-9" aria-hidden="true" tabindex="-1"></a> (\acc' n <span class="ot">-></span> <span class="kw">if</span> Data.Bits.testBit xs n</span>
<span id="cb27-10"><a href="#cb27-10" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> Map.insertWith prepend n [i] acc'</span>
<span id="cb27-11"><a href="#cb27-11" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span> acc')</span>
<span id="cb27-12"><a href="#cb27-12" aria-hidden="true" tabindex="-1"></a> acc</span>
<span id="cb27-13"><a href="#cb27-13" aria-hidden="true" tabindex="-1"></a> [<span class="dv">1</span><span class="op">..</span><span class="dv">9</span>])</span>
<span id="cb27-14"><a href="#cb27-14" aria-hidden="true" tabindex="-1"></a> Map.empty</span>
<span id="cb27-15"><a href="#cb27-15" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> Map.filter ((<span class="op"><</span> <span class="dv">4</span>) <span class="op">.</span> <span class="fu">length</span>)</span>
<span id="cb27-16"><a href="#cb27-16" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> Map.foldlWithKey'(\acc x is <span class="ot">-></span> Map.insertWith prepend is [x] acc) Map.empty</span>
<span id="cb27-17"><a href="#cb27-17" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> Map.filterWithKey (\is xs <span class="ot">-></span> <span class="fu">length</span> is <span class="op">==</span> <span class="fu">length</span> xs)</span>
<span id="cb27-18"><a href="#cb27-18" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> Map.elems</span>
<span id="cb27-19"><a href="#cb27-19" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> <span class="fu">map</span> (Data.List.foldl' Data.Bits.setBit Data.Bits.zeroBits)</span>
<span id="cb27-20"><a href="#cb27-20" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb27-21"><a href="#cb27-21" aria-hidden="true" tabindex="-1"></a> prepend <span class="op">~</span>[y] ys <span class="ot">=</span> y<span class="op">:</span>ys</span></code></pre></div>
<p>Let’s zoom into lines 6–14. Here, we do a fold with a nested fold over the non-fixed cells of the given block to accumulate the mapping from the digits to the indices of the cells they occur in. We use a <a href="https://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Strict.html" target="_blank" rel="noopener"><code>Data.Map.Strict</code></a> map as the accumulator. If a digit is not present in the map as a key then we add a singleton list containing the corresponding cell index as the value. If the digit is already present in the map then we prepend the cell index to the list of indices for the digit. So we end up “mutating” the map repeatedly.</p>
<p>Of course, it’s not actual mutation because the map data structure we are using is immutable. Each change to the map instance creates a new copy with the addition, which we thread through the fold operation, and we get the final copy at the end. This may be the reason of the slowness in this section of the code.</p>
<p>What if, instead of using an immutable data structure for this, we used a mutable one? But how can we do that when we know that Haskell is a pure language? Purity means that all code must be <a href="https://en.wikipedia.org/wiki/Referential_transparency" target="_blank" rel="noopener">referentially transparent</a>, and mutability certainly isn’t. It turns out, there is an escape hatch to mutability in Haskell. Quoting the relevant section from the book <a href="http://book.realworldhaskell.org/read/advanced-library-design-building-a-bloom-filter.html#id680273" target="_blank" rel="noopener">Real World Haskell</a>:</p>
<blockquote>
<p>Haskell provides a special monad, named <code>ST</code>, which lets us work safely with mutable state. Compared to the <code>State</code> monad, it has some powerful added capabilities.</p>
<ul>
<li>We can <em>thaw</em> an immutable array to give a mutable array; modify the mutable array in place; and freeze a new immutable array when we are done.</li>
<li>We have the ability to use <em>mutable references</em>. This lets us implement data structures that we can modify after construction, as in an imperative language. This ability is vital for some imperative data structures and algorithms, for which similarly efficient purely functional alternatives have not yet been discovered.</li>
</ul>
</blockquote>
<p>So if we use a mutable map in the <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Control-Monad-ST.html" target="_blank" rel="noopener"><code>ST</code> monad</a>, we may be able to get rid of this bottleneck. But, we can actually do better! Since the keys of our map are digits <code>1</code>–<code>9</code>, we can use a <a href="https://hackage.haskell.org/package/vector-0.12.0.1/docs/Data-Vector-Mutable.html" target="_blank" rel="noopener">mutable vector</a> to store the indices. In fact, we can go one step even further and store the indices as a BitSet as <code>Word16</code> because they also range from 1 to 9, and are unique for a block. This lets us use an <a href="https://hackage.haskell.org/package/vector-0.12.0.1/docs/Data-Vector-Unboxed-Mutable.html" target="_blank" rel="noopener">unboxed mutable vector</a>. What is <em>unboxing</em> you ask? Quoting from the <a href="https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/glasgow_exts.html#unboxed-types" target="_blank" rel="noopener">GHC docs</a>:</p>
<blockquote>
<p>Most types in GHC are boxed, which means that values of that type are represented by a pointer to a heap object. The representation of a Haskell <code>Int</code>, for example, is a two-word heap object. An unboxed type, however, is represented by the value itself, no pointers or heap allocation are involved.</p>
</blockquote>
<p>When combined with vector, unboxing of values means the whole vector is stored as single byte array, avoiding pointer redirections completely. This is more memory efficient and allows better usage of caches<a href="#fn8" class="footnote-ref" id="fnref8" role="doc-noteref"><sup>8</sup></a>. Let’s rewrite <code>exclusivePossibilities</code> using <code>ST</code> and unboxed mutable vectors.</p>
<p>First we write the core of this operation, the function <code>cellIndicesList</code> which take a list of cells and returns the digit to cell indices mapping. The mapping is returned as a list. The zeroth value in this list is the indices of the cells which have <code>1</code> as a possible digit, and so on. The indices themselves are packed as BitSets. If the bit 1 is set then the first cell has a particular digit. Let’s say it returns <code>[0,688,54,134,0,654,652,526,670]</code>. In 10-bit binary it is:</p>
<pre class="plain"><code>[0000000000, 1010110000, 0000110110, 0010000110, 0000000000, 1010001110, 1010001100, 1000001110, 1010011110]</code></pre>
<p>We can arrange it in a table for further clarity:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: right;">Digits</th>
<th style="text-align: right;">Cell 9</th>
<th style="text-align: right;">Cell 8</th>
<th style="text-align: right;">Cell 7</th>
<th style="text-align: right;">Cell 6</th>
<th style="text-align: right;">Cell 5</th>
<th style="text-align: right;">Cell 4</th>
<th style="text-align: right;">Cell 3</th>
<th style="text-align: right;">Cell 2</th>
<th style="text-align: right;">Cell 1</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
</tr>
<tr class="even">
<td style="text-align: right;">2</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
</tr>
<tr class="odd">
<td style="text-align: right;">3</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
</tr>
<tr class="even">
<td style="text-align: right;">4</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
</tr>
<tr class="odd">
<td style="text-align: right;">5</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
</tr>
<tr class="even">
<td style="text-align: right;">6</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
</tr>
<tr class="odd">
<td style="text-align: right;">7</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
</tr>
<tr class="even">
<td style="text-align: right;">8</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
</tr>
<tr class="odd">
<td style="text-align: right;">9</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">0</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
<td style="text-align: right;">1</td>
</tr>
</tbody>
</table>
</div>
<p>If the value of the intersection of a particular digit and a particular cell index in the table is set to 1, then the digit is a possibility in the cell, else it is not. Here’s the code:</p>
<div class="sourceCode" id="cb29" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb29-1"><a href="#cb29-1" aria-hidden="true" tabindex="-1"></a><span class="ot">cellIndicesList ::</span> [<span class="dt">Cell</span>] <span class="ot">-></span> [<span class="dt">Data.Word.Word16</span>]</span>
<span id="cb29-2"><a href="#cb29-2" aria-hidden="true" tabindex="-1"></a>cellIndicesList cells <span class="ot">=</span></span>
<span id="cb29-3"><a href="#cb29-3" aria-hidden="true" tabindex="-1"></a> Data.Vector.Unboxed.toList <span class="op">$</span> Control.Monad.ST.runST <span class="op">$</span> <span class="kw">do</span></span>
<span id="cb29-4"><a href="#cb29-4" aria-hidden="true" tabindex="-1"></a> vec <span class="ot"><-</span> Data.Vector.Unboxed.Mutable.replicate <span class="dv">9</span> Data.Bits.zeroBits</span>
<span id="cb29-5"><a href="#cb29-5" aria-hidden="true" tabindex="-1"></a> ref <span class="ot"><-</span> Data.STRef.newSTRef (<span class="dv">1</span><span class="ot"> ::</span> <span class="dt">Int</span>)</span>
<span id="cb29-6"><a href="#cb29-6" aria-hidden="true" tabindex="-1"></a> Control.Monad.forM_ cells <span class="op">$</span> \cell <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb29-7"><a href="#cb29-7" aria-hidden="true" tabindex="-1"></a> i <span class="ot"><-</span> Data.STRef.readSTRef ref</span>
<span id="cb29-8"><a href="#cb29-8" aria-hidden="true" tabindex="-1"></a> <span class="kw">case</span> cell <span class="kw">of</span></span>
<span id="cb29-9"><a href="#cb29-9" aria-hidden="true" tabindex="-1"></a> <span class="dt">Fixed</span> _ <span class="ot">-></span> <span class="fu">return</span> ()</span>
<span id="cb29-10"><a href="#cb29-10" aria-hidden="true" tabindex="-1"></a> <span class="dt">Possible</span> xs <span class="ot">-></span> Control.Monad.forM_ [<span class="dv">0</span><span class="op">..</span><span class="dv">8</span>] <span class="op">$</span> \d <span class="ot">-></span></span>
<span id="cb29-11"><a href="#cb29-11" aria-hidden="true" tabindex="-1"></a> Control.Monad.when (Data.Bits.testBit xs (d<span class="op">+</span><span class="dv">1</span>)) <span class="op">$</span></span>
<span id="cb29-12"><a href="#cb29-12" aria-hidden="true" tabindex="-1"></a> Data.Vector.Unboxed.Mutable.unsafeModify vec (<span class="ot">`Data.Bits.setBit`</span> i) d</span>
<span id="cb29-13"><a href="#cb29-13" aria-hidden="true" tabindex="-1"></a> Data.STRef.writeSTRef ref (i<span class="op">+</span><span class="dv">1</span>)</span>
<span id="cb29-14"><a href="#cb29-14" aria-hidden="true" tabindex="-1"></a> Data.Vector.Unboxed.unsafeFreeze vec</span></code></pre></div>
<p>The whole mutable code runs inside the <code>runST</code> function. <code>runST</code> take an operation in <code>ST</code> monad and executes it, making sure that the mutable references created inside it cannot escape the scope of <code>runST</code>. This is done using a type-system trickery called <a href="https://web.archive.org/web/20180813050307/https://prime.haskell.org/wiki/Rank2Types" target="_blank" rel="noopener">Rank-2 types</a>.</p>
<p>Inside the <code>ST</code> operation, we start with creating a mutable vector of <code>Word16</code>s of size 9 with all its values initially set to zero. We also initialize a mutable reference to keep track of the cell index we are on. Then we run two nested for loops, going over each cell and each digit <code>1</code>–<code>9</code>, setting the right bit of the right index of the mutable vector. During this, we mutate the vector directly using the <code>Data.Vector.Unboxed.Mutable.unsafeModify</code> function. At the end of the <code>ST</code> operation, we freeze the mutable vector to return an immutable version of it. Outside <code>runST</code>, we convert the immutable vector to a list. Notice how this code is quite similar to how we’d write it in <a href="https://en.wikipedia.org/wiki/Imperative_programming" target="_blank" rel="noopener">imperative programming</a> languages like C or Java<a href="#fn9" class="footnote-ref" id="fnref9" role="doc-noteref"><sup>9</sup></a>.</p>
<p>It is easy to use this function now to rewrite <code>exclusivePossibilities</code>:</p>
<div class="sourceCode" id="cb30" data-lang="diff"><pre class="sourceCode numberSource diff"><code class="sourceCode diff"><span id="cb30-1"><a href="#cb30-1" aria-hidden="true" tabindex="-1"></a> exclusivePossibilities :: [Cell] -> [Data.Word.Word16]</span>
<span id="cb30-2"><a href="#cb30-2" aria-hidden="true" tabindex="-1"></a> exclusivePossibilities row =</span>
<span id="cb30-3"><a href="#cb30-3" aria-hidden="true" tabindex="-1"></a> row</span>
<span id="cb30-4"><a href="#cb30-4" aria-hidden="true" tabindex="-1"></a><span class="st">- & zip [1..9]</span></span>
<span id="cb30-5"><a href="#cb30-5" aria-hidden="true" tabindex="-1"></a><span class="st">- & filter (isPossible . snd)</span></span>
<span id="cb30-6"><a href="#cb30-6" aria-hidden="true" tabindex="-1"></a><span class="st">- & Data.List.foldl'</span></span>
<span id="cb30-7"><a href="#cb30-7" aria-hidden="true" tabindex="-1"></a><span class="st">- (\acc ~(i, Possible xs) -></span></span>
<span id="cb30-8"><a href="#cb30-8" aria-hidden="true" tabindex="-1"></a><span class="st">- Data.List.foldl'</span></span>
<span id="cb30-9"><a href="#cb30-9" aria-hidden="true" tabindex="-1"></a><span class="st">- (\acc' n -> if Data.Bits.testBit xs n</span></span>
<span id="cb30-10"><a href="#cb30-10" aria-hidden="true" tabindex="-1"></a><span class="st">- then Map.insertWith prepend n [i] acc'</span></span>
<span id="cb30-11"><a href="#cb30-11" aria-hidden="true" tabindex="-1"></a><span class="st">- else acc')</span></span>
<span id="cb30-12"><a href="#cb30-12" aria-hidden="true" tabindex="-1"></a><span class="st">- acc</span></span>
<span id="cb30-13"><a href="#cb30-13" aria-hidden="true" tabindex="-1"></a><span class="st">- [1..9])</span></span>
<span id="cb30-14"><a href="#cb30-14" aria-hidden="true" tabindex="-1"></a><span class="st">- Map.empty</span></span>
<span id="cb30-15"><a href="#cb30-15" aria-hidden="true" tabindex="-1"></a><span class="va">+ & cellIndicesList</span></span>
<span id="cb30-16"><a href="#cb30-16" aria-hidden="true" tabindex="-1"></a><span class="va">+ & zip [1..9]</span></span>
<span id="cb30-17"><a href="#cb30-17" aria-hidden="true" tabindex="-1"></a><span class="st">- & Map.filter ((< 4) . length)</span></span>
<span id="cb30-18"><a href="#cb30-18" aria-hidden="true" tabindex="-1"></a><span class="st">- & Map.foldlWithKey' (\acc x is -> Map.insertWith prepend is [x] acc) Map.empty</span></span>
<span id="cb30-19"><a href="#cb30-19" aria-hidden="true" tabindex="-1"></a><span class="st">- & Map.filterWithKey (\is xs -> length is == length xs)</span></span>
<span id="cb30-20"><a href="#cb30-20" aria-hidden="true" tabindex="-1"></a><span class="va">+ & filter (\(_, is) -> let p = Data.Bits.popCount is in p > 0 && p < 4)</span></span>
<span id="cb30-21"><a href="#cb30-21" aria-hidden="true" tabindex="-1"></a><span class="va">+ & Data.List.foldl' (\acc (x, is) -> Map.insertWith prepend is [x] acc) Map.empty</span></span>
<span id="cb30-22"><a href="#cb30-22" aria-hidden="true" tabindex="-1"></a><span class="va">+ & Map.filterWithKey (\is xs -> Data.Bits.popCount is == length xs)</span></span>
<span id="cb30-23"><a href="#cb30-23" aria-hidden="true" tabindex="-1"></a> & Map.elems</span>
<span id="cb30-24"><a href="#cb30-24" aria-hidden="true" tabindex="-1"></a> & map (Data.List.foldl' Data.Bits.setBit Data.Bits.zeroBits)</span>
<span id="cb30-25"><a href="#cb30-25" aria-hidden="true" tabindex="-1"></a> where</span>
<span id="cb30-26"><a href="#cb30-26" aria-hidden="true" tabindex="-1"></a> prepend ~[y] ys = y:ys</span></code></pre></div>
<p>We replace the nested two-fold operation with <code>cellIndicesList</code>. Then we replace some map related function with the corresponding list ones because <code>cellIndicesList</code> returns a list. We also replace the <code>length</code> function call on cell indices with <code>Data.Bits.popCount</code> function call as the indices are represented as <code>Word16</code> now.</p>
<p>That is it. Let’s build and run it now:</p>
<pre class="plain"><code>$ stack build
$ cat sudoku17.txt | time stack exec sudoku > /dev/null
35.04 real 34.84 user 0.24 sys</code></pre>
<p>That’s a 1.6x speedup over the map-and-fold based version. Let’s check what the profiler has to say:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Cost Centre</th>
<th style="text-align: left;">Src</th>
<th style="text-align: right;">%time</th>
<th style="text-align: right;">%alloc</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;"><code>cellIndicesList.\.\</code></td>
<td style="text-align: left;">Sudoku.hs:(88,11)-(89,81)</td>
<td style="text-align: right;">10.7</td>
<td style="text-align: right;">6.0</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>primitive</code></td>
<td style="text-align: left;">Control/Monad/Primitive.hs:195:3-16</td>
<td style="text-align: right;">7.9</td>
<td style="text-align: right;">6.9</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>pruneCells</code></td>
<td style="text-align: left;">Sudoku.hs:(113,1)-(138,53)</td>
<td style="text-align: right;">7.5</td>
<td style="text-align: right;">6.4</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>cellIndicesList</code></td>
<td style="text-align: left;">Sudoku.hs:(79,1)-(91,40)</td>
<td style="text-align: right;">7.4</td>
<td style="text-align: right;">10.1</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>basicUnsafeIndexM</code></td>
<td style="text-align: left;">Data/Vector.hs:278:3-62</td>
<td style="text-align: right;">7.3</td>
<td style="text-align: right;">0.5</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>pruneCells.pruneCell</code></td>
<td style="text-align: left;">Sudoku.hs:(120,5)-(121,83)</td>
<td style="text-align: right;">6.8</td>
<td style="text-align: right;">2.0</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities</code></td>
<td style="text-align: left;">Sudoku.hs:(94,1)-(104,26)</td>
<td style="text-align: right;">6.5</td>
<td style="text-align: right;">9.7</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>pruneCells.pruneCell.\</code></td>
<td style="text-align: left;">Sudoku.hs:121:48-83</td>
<td style="text-align: right;">6.1</td>
<td style="text-align: right;">2.0</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>cellIndicesList.\</code></td>
<td style="text-align: left;">Sudoku.hs:(83,42)-(90,37)</td>
<td style="text-align: right;">5.5</td>
<td style="text-align: right;">3.5</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>pruneCells.cells</code></td>
<td style="text-align: left;">Sudoku.hs:115:5-40</td>
<td style="text-align: right;">5.0</td>
<td style="text-align: right;">10.4</td>
</tr>
</tbody>
</table>
</div>
<p>The run time is spread quite evenly over all the functions now and there are no hotspots anymore. We stop optimizating at this point<a href="#fn10" class="footnote-ref" id="fnref10" role="doc-noteref"><sup>10</sup></a>. Let’s see how far we have come up.</p>
<h2 data-track-content data-content-name="comparison-of-implementations" data-content-piece="fast-sudoku-solver-in-haskell-3" id="comparison-of-implementations">Comparison of Implementations</h2>
<p>Below is a table showing the speedups we got with each new implementation:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Implementation</th>
<th style="text-align: right;">Run Time (s)</th>
<th style="text-align: right;">Incremental Speedup</th>
<th style="text-align: right;">Cumulative Speedup</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;">Simple</td>
<td style="text-align: right;">47450</td>
<td style="text-align: right;">1x</td>
<td style="text-align: right;">1x</td>
</tr>
<tr class="even">
<td style="text-align: left;">Exclusive Pruning</td>
<td style="text-align: right;">258.97</td>
<td style="text-align: right;">183.23x</td>
<td style="text-align: right;">183x</td>
</tr>
<tr class="odd">
<td style="text-align: left;">BitSet</td>
<td style="text-align: right;">69.44</td>
<td style="text-align: right;">3.73x</td>
<td style="text-align: right;">683x</td>
</tr>
<tr class="even">
<td style="text-align: left;">Vector</td>
<td style="text-align: right;">57.67</td>
<td style="text-align: right;">1.20x</td>
<td style="text-align: right;">823x</td>
</tr>
<tr class="odd">
<td style="text-align: left;">Mutable Vector</td>
<td style="text-align: right;">35.04</td>
<td style="text-align: right;">1.65x</td>
<td style="text-align: right;">1354x</td>
</tr>
</tbody>
</table>
</div>
<p>The first improvement over the simple solution got us the most major speedup of 183x. After that, we followed the profiler, fixing bottlenecks by using the right data structures. We got quite significant speedup over the naive list-based solution, leading to drop in the run time from 259 seconds to 35 seconds. In total, we have done more than a thousand times improvement in the run time since the first solution!</p>
<h2 data-track-content data-content-name="conclusion" data-content-piece="fast-sudoku-solver-in-haskell-3" id="conclusion">Conclusion</h2>
<p>In this post, we improved upon our list-based Sudoku solution from the <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/?mtm_campaign=feed">last time</a>. We profiled the code at each step, found the bottlenecks and fixed them by choosing the right data structure for the case. We ended up using BitSets and Vectors—both immutable and mutable varieties—for the different parts of the code. Finally, we sped up our program by 7.4 times. Can we go even faster? How about using all those other CPU cores which have been lying idle? Come back for the next post in this series where we’ll explore the parallel programming facilities in Haskell. The code till now is available <a href="https://code.abhinavsarkar.net/abhin4v/hasdoku/src/commit/4a9a1531d5780e7abc7d5ab2a26dccbf34382031?mtm_campaign=feed" target="_blank" rel="noopener">here</a>.</p>
<section id="footnotes" class="footnotes footnotes-end-of-document" role="doc-endnotes">
<hr></hr>
<ol>
<li id="fn1"><p>All the runs were done on my MacBook Pro from 2014 with 2.2 GHz Intel Core i7 CPU and 16 GB memory.<a href="#fnref1" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn2"><p>A lot of the code in this post references the code from the previous posts, including showing diffs. So, please read the previous posts if you have not already done so.<a href="#fnref2" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn3"><p>Notice the British English spelling of the word “Centre”. GHC was originally developed in <a href="https://en.wikipedia.org/wiki/University_of_Glasgow" target="_blank" rel="noopener">University of Glasgow</a> in Scotland.<a href="#fnref3" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn4"><p>The code for the BitSet based implementation can be found <a href="https://code.abhinavsarkar.net/abhin4v/hasdoku/src/commit/5a3044e09cd86dd6154bc50760095c4b38c48c6a?mtm_campaign=feed" target="_blank" rel="noopener">here</a>.<a href="#fnref4" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn5"><p><a href="https://www.schoolofhaskell.com/user/commercial/content/vector" target="_blank" rel="noopener">This article</a> on School of Haskell goes into details about performance of vectors vs. lists. There are also <a href="https://github.com/haskell-perf/sequences/blob/master/README.md" target="_blank" rel="noopener">these</a> benchmarks for sequence data structures in Haskell: lists, vectors, seqs, etc.<a href="#fnref5" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn6"><p>We see Haskell’s laziness at work here. In the code for the <code>fixM</code> function, the <code>(==)</code> function is nested inside the <code>(>>=)</code> function, but because of laziness, they are actually evaluated in the reverse order. The evaluation of parameters for the <code>(==)</code> function causes the <code>(>>=)</code> function to be evaluated.<a href="#fnref6" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn7"><p>The code for the vector based implementation can be found <a href="https://code.abhinavsarkar.net/abhin4v/hasdoku/src/commit/a320a7874c6fa0c39665151cc8e073532cc750a1?mtm_campaign=feed" target="_blank" rel="noopener">here</a>.<a href="#fnref7" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn8"><p>Unboxed vectors have some <a href="https://hackage.haskell.org/package/vector-0.12.0.1/docs/Data-Vector-Unboxed.html#t:Unbox" target="_blank" rel="noopener">restrictions</a> on the kind of values that can be put into them but <code>Word16</code> already follows those restrictions so we are good.<a href="#fnref8" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn9"><p>Haskell can be a pretty good imperative programming language using the <code>ST</code> monad. <a href="https://vaibhavsagar.com/blog/2017/05/29/imperative-haskell/" target="_blank" rel="noopener">This article</a> shows how to implement some algorithms which require mutable data structures in Haskell.<a href="#fnref9" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn10"><p>The code for the mutable vector based implementation can be found <a href="https://code.abhinavsarkar.net/abhin4v/hasdoku/src/commit/4a9a1531d5780e7abc7d5ab2a26dccbf34382031?mtm_campaign=feed" target="_blank" rel="noopener">here</a>.<a href="#fnref10" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
</ol>
</section><p>If you liked this post, please <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-3/?mtm_campaign=feed#syndications">leave a comment</a>.</p><img referrerpolicy="no-referrer-when-downgrade" src="https://anna.abhinavsarkar.net/matomo.php?idsite=1&rec=1" style="border:0" alt="" />2018-08-13T00:00:00Z<p>In the <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/">previous part</a> in this series of posts, we optimized the simple Sudoku solver by implementing a new strategy to prune cells, and were able to achieve a speedup of almost 200x. Afterwards, we profiled the solution and found that there were bottlenecks in the program, leading to a slowdown. In this post, we are going to follow the profiler and use the right <em>Data Structures</em> to improve the solution further and make it <strong>faster</strong>.</p>
https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/Fast Sudoku Solver in Haskell #2: A 200x Faster Solution2018-07-11T00:00:00ZAbhinav Sarkarhttps://abhinavsarkar.net/about/abhinav@abhinavsarkar.net<p>In the <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-1/?mtm_campaign=feed">first part</a> of this series of posts, we wrote a simple <a href="https://en.wikipedia.org/wiki/Sudoku" target="_blank" rel="noopener">Sudoku</a> solver in <a href="https://www.haskell.org/" target="_blank" rel="noopener">Haskell</a>. It used a <a href="https://en.wikipedia.org/wiki/Constraint_satisfaction_problem" target="_blank" rel="noopener">constraint satisfaction</a> algorithm with <a href="https://en.wikipedia.org/wiki/Depth-first_search" target="_blank" rel="noopener">backtracking</a>. The solution worked well but was very slow. In this post, we are going to improve it and make it <strong>fast</strong>.</p>
<p>This post was originally published on <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/?mtm_campaign=feed">abhinavsarkar.net</a>.</p><!--more-->
<p>This is the second post in a series of posts:</p>
<ol type="1">
<li><a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-1/?mtm_campaign=feed">Fast Sudoku Solver in Haskell #1: A Simple Solution</a></li>
<li>Fast Sudoku Solver in Haskell #2: A 200x Faster Solution</li>
<li><a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-3/?mtm_campaign=feed">Fast Sudoku Solver in Haskell #3: Picking the Right Data Structures</a></li>
</ol>
<nav id="toc" class="right-toc"><h3>Contents</h3><ol><li><a href="#quick-recap">Quick Recap</a></li><li><a href="#constraints-and-corollaries">Constraints and Corollaries</a></li><li><a href="#singles-twins-and-triplets">Singles, Twins and Triplets</a></li><li><a href="#a-little-forward-a-little-backward">A Little Forward, a Little Backward</a></li><li><a href="#pruning-the-cells-exclusively">Pruning the Cells, Exclusively</a></li><li><a href="#faster-than-a-speeding-bullet">Faster than a Speeding Bullet!</a><ol><li><a href="#update">Update</a></li></ol></li><li><a href="#conclusion">Conclusion</a></li></ol></nav>
<h2 data-track-content data-content-name="quick-recap" data-content-piece="fast-sudoku-solver-in-haskell-2" id="quick-recap">Quick Recap</h2>
<p><a href="https://en.wikipedia.org/wiki/Sudoku" target="_blank" rel="noopener">Sudoku</a> is a number placement puzzle. It consists of a 9x9 grid which is to be filled with digits from 1 to 9 such that each row, each column and each of the nine 3x3 sub-grids contain all the digits. Some of the cells of the grid come pre-filled and the player has to fill the rest.</p>
<p>In the previous post, we implemented a simple Sudoku solver without paying much attention to its performance characteristics. We ran<a href="#fn1" class="footnote-ref" id="fnref1" role="doc-noteref"><sup>1</sup></a> some of <a href="https://abhinavsarkar.net/files/sudoku17.txt.bz2?mtm_campaign=feed">17-clue puzzles</a><a href="#fn2" class="footnote-ref" id="fnref2" role="doc-noteref"><sup>2</sup></a> through our program to see how fast it was:</p>
<pre class="plain"><code>$ head -n100 sudoku17.txt | time stack exec sudoku
... output omitted ...
116.70 real 198.09 user 94.46 sys</code></pre>
<p>So, it took about 117 seconds to solve one hundred puzzles. At this speed, it would take about 16 hours to solve all the 49151 puzzles contained in the file. This is way too slow. We need to find ways to make it faster. Let’s go back to the drawing board.</p>
<h2 data-track-content data-content-name="constraints-and-corollaries" data-content-piece="fast-sudoku-solver-in-haskell-2" id="constraints-and-corollaries">Constraints and Corollaries</h2>
<p>In a Sudoku puzzle, we have a partially filled 9x9 grid which we have to fill completely while following the constraints of the game.</p>
<figure>
<img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 201 209'%3E%3C/svg%3E" class="lazyload ascii-art nolink w-30pct" style="--image-aspect-ratio: 0.9617224880382775" data-src="/images/fast-sudoku-solver-in-haskell-1/sudoku01.svg" alt="A sample puzzle"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-1/sudoku01.svg" class="ascii-art nolink w-30pct" alt="A sample puzzle"></img></noscript>
<figcaption>A sample puzzle</figcaption>
</figure>
<figure>
<img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 201 209'%3E%3C/svg%3E" class="lazyload ascii-art nolink w-30pct" style="--image-aspect-ratio: 0.9617224880382775" data-src="/images/fast-sudoku-solver-in-haskell-1/sudoku02.svg" alt="And its solution"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-1/sudoku02.svg" class="ascii-art nolink w-30pct" alt="And its solution"></img></noscript>
<figcaption>And its solution</figcaption>
</figure>
<p>Earlier, we followed a simple pruning algorithm which removed all the solved (or <em>fixed</em>) digits from neighbours of the fixed cells. We repeated the pruning till the fixed and non-fixed values in the grid stopped changing (or the grid <em>settled</em>). Here’s an example of a grid before pruning:</p>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 209'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 4.4066985645933014" data-src="/images/fast-sudoku-solver-in-haskell-1/sudoku1.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-1/sudoku1.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<p>And here’s the same grid when it settles after repeated pruning:</p>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 209'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 4.4066985645933014" data-src="/images/fast-sudoku-solver-in-haskell-1/sudoku4.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-1/sudoku4.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<p>We see how the possibilities conflicting with the fixed values are removed. We also see how some of the non-fixed cells turn into fixed ones as all their other possible values get eliminated.</p>
<p>This simple strategy follows directly from the constraints of Sudoku. But, are there more complex strategies which are implied indirectly?</p>
<h2 data-track-content data-content-name="singles-twins-and-triplets" data-content-piece="fast-sudoku-solver-in-haskell-2" id="singles-twins-and-triplets">Singles, Twins and Triplets</h2>
<p>Let’s have a look at this sample row captured from a solution in progress:</p>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 49'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 18.79591836734694" data-src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line1.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line1.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<p>Notice how the sixth cell is the only one with <code>1</code> as a possibility in it. It is obvious that we should fix the sixth cell to <code>1</code> as we cannot place <code>1</code> in any other cell in the row. Let’s call this the <em>Singles</em><a href="#fn3" class="footnote-ref" id="fnref3" role="doc-noteref"><sup>3</sup></a> scenario.</p>
<p>But, our current solution will not fix the sixth cell to <code>1</code> till one of these cases arise:</p>
<ol type="a">
<li>all other possibilities of the cell are pruned away, or,</li>
<li>the cell is chosen as pivot in the <code>nextGrids</code> function and <code>1</code> is chosen as the value to fix.</li>
</ol>
<p>This may take very long and lead to a longer solution time. Let’s assume that we recognize the Singles scenario while pruning cells and fix the cell to <code>1</code> right then. That would cut down the search tree by a lot and make the solution much faster.</p>
<p>It turns out, we can generalize this pattern. Let’s check out this sample row from middle of a solution:</p>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 49'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 18.79591836734694" data-src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line2.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line2.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<p>It is a bit difficult to notice with the naked eye but there’s something special here too. The digits <code>5</code> and <code>7</code> occur only in the third and the ninth cells. Though they are accompanied by other digits in those cells, they are not present in any other cells. This means, we can place <code>5</code> and <code>7</code> either in the third or the ninth cell and no other cells. This implies that we can prune the third and ninth cells to have only <code>5</code> and <code>7</code> like this:</p>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 49'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 18.79591836734694" data-src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line3.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line3.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<p>This is the <em>Twins</em> scenario. As we can imagine, this pattern extends to groups of three digits and beyond. When three digits can be found only in three cells in a block, it is the <em>Triplets</em> scenario, as in the example below:</p>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 49'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 18.79591836734694" data-src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line4.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line4.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<p>In this case, the triplet digits are <code>3</code>, <code>8</code> and <code>9</code>. And as before, we can prune the block by fixing these digits in their cells:</p>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 49'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 18.79591836734694" data-src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line5.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line5.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<p>Let’s call these three scenarios <em>Exclusives</em> in general.</p>
<p>We can extend this to <em>Quadruplets</em> scenario and further. But such scenarios occur rarely in a 9x9 Sudoku puzzle. Trying to find them may end up being more computationally expensive than the benefit we may get in solution time speedup by finding them.</p>
<p>Now that we have discovered these new strategies to prune cells, let’s implement them in Haskell.</p>
<h2 data-track-content data-content-name="a-little-forward-a-little-backward" data-content-piece="fast-sudoku-solver-in-haskell-2" id="a-little-forward-a-little-backward">A Little Forward, a Little Backward</h2>
<p>We can implement the three new strategies to prune cells as one function for each. However, we can actually implement all these strategies in a single function. But, this function is a bit more complex than the previous pruning function. So first, let’s try to understand its working using tables. Let’s take this sample row:</p>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 49'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 18.79591836734694" data-src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line6.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-2/sudoku-line6.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<p>First, we make a table mapping the digits to the cells in which they occur, excluding the fixed cells:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Digit</th>
<th style="text-align: right;">Cells</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;">2</td>
<td style="text-align: right;">6, 8, 9</td>
</tr>
<tr class="even">
<td style="text-align: left;">3</td>
<td style="text-align: right;">6, 8, 9</td>
</tr>
<tr class="odd">
<td style="text-align: left;">4</td>
<td style="text-align: right;">1</td>
</tr>
<tr class="even">
<td style="text-align: left;">6</td>
<td style="text-align: right;">1, 4, 6, 7, 8, 9</td>
</tr>
<tr class="odd">
<td style="text-align: left;">8</td>
<td style="text-align: right;">6, 8, 9</td>
</tr>
<tr class="even">
<td style="text-align: left;">9</td>
<td style="text-align: right;">1, 4, 6, 7, 8, 9</td>
</tr>
</tbody>
</table>
</div>
<p>Then, we flip this table and collect all the digits that occur in the same set of cells:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Cells</th>
<th style="text-align: right;">Digits</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;">1</td>
<td style="text-align: right;">4</td>
</tr>
<tr class="even">
<td style="text-align: left;">6, 8, 9</td>
<td style="text-align: right;">2, 3, 8</td>
</tr>
<tr class="odd">
<td style="text-align: left;">1, 4, 6, 7, 8, 9</td>
<td style="text-align: right;">6, 9</td>
</tr>
</tbody>
</table>
</div>
<p>And finally, we remove the rows of the table in which the count of the cells is not the same as the count of the digits:</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Cells</th>
<th style="text-align: right;">Digits</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;">1</td>
<td style="text-align: right;">4</td>
</tr>
<tr class="even">
<td style="text-align: left;">6, 8, 9</td>
<td style="text-align: right;">2, 3, 8</td>
</tr>
</tbody>
</table>
</div>
<p>Voilà! We have found a Single <code>4</code> and a set of Triplets <code>2</code>, <code>3</code> and <code>8</code>. You can go over the puzzle row and verify that this indeed is the case.</p>
<p>Translating this logic to Haskell is quite easy now:</p>
<div class="sourceCode" id="cb2" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb2-1"><a href="#cb2-1" aria-hidden="true" tabindex="-1"></a><span class="ot">isPossible ::</span> <span class="dt">Cell</span> <span class="ot">-></span> <span class="dt">Bool</span></span>
<span id="cb2-2"><a href="#cb2-2" aria-hidden="true" tabindex="-1"></a>isPossible (<span class="dt">Possible</span> _) <span class="ot">=</span> <span class="dt">True</span></span>
<span id="cb2-3"><a href="#cb2-3" aria-hidden="true" tabindex="-1"></a>isPossible _ <span class="ot">=</span> <span class="dt">False</span></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 class="ot">exclusivePossibilities ::</span> [<span class="dt">Cell</span>] <span class="ot">-></span> [[<span class="dt">Int</span>]]</span>
<span id="cb2-6"><a href="#cb2-6" aria-hidden="true" tabindex="-1"></a>exclusivePossibilities row <span class="ot">=</span></span>
<span id="cb2-7"><a href="#cb2-7" aria-hidden="true" tabindex="-1"></a> <span class="co">-- input</span></span>
<span id="cb2-8"><a href="#cb2-8" aria-hidden="true" tabindex="-1"></a> row</span>
<span id="cb2-9"><a href="#cb2-9" aria-hidden="true" tabindex="-1"></a> <span class="co">-- [Possible [4,6,9], Fixed 1, Fixed 5, Possible [6,9], Fixed 7, Possible [2,3,6,8,9],</span></span>
<span id="cb2-10"><a href="#cb2-10" aria-hidden="true" tabindex="-1"></a> <span class="co">-- Possible [6,9], Possible [2,3,6,8,9], Possible [2,3,6,8,9]]</span></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="co">-- step 1</span></span>
<span id="cb2-13"><a href="#cb2-13" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> <span class="fu">zip</span> [<span class="dv">1</span><span class="op">..</span><span class="dv">9</span>]</span>
<span id="cb2-14"><a href="#cb2-14" aria-hidden="true" tabindex="-1"></a> <span class="co">-- [(1,Possible [4,6,9]),(2,Fixed 1),(3,Fixed 5),(4,Possible [6,9]),(5,Fixed 7),</span></span>
<span id="cb2-15"><a href="#cb2-15" aria-hidden="true" tabindex="-1"></a> <span class="co">-- (6,Possible [2,3,6,8,9]),(7,Possible [6,9]),(8,Possible [2,3,6,8,9]),</span></span>
<span id="cb2-16"><a href="#cb2-16" aria-hidden="true" tabindex="-1"></a> <span class="co">-- (9,Possible [2,3,6,8,9])]</span></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="co">-- step 2</span></span>
<span id="cb2-19"><a href="#cb2-19" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> <span class="fu">filter</span> (isPossible <span class="op">.</span> <span class="fu">snd</span>)</span>
<span id="cb2-20"><a href="#cb2-20" aria-hidden="true" tabindex="-1"></a> <span class="co">-- [(1,Possible [4,6,9]),(4,Possible [6,9]),(6,Possible [2,3,6,8,9]),</span></span>
<span id="cb2-21"><a href="#cb2-21" aria-hidden="true" tabindex="-1"></a> <span class="co">-- (7,Possible [6,9]), (8,Possible [2,3,6,8,9]),(9,Possible [2,3,6,8,9])]</span></span>
<span id="cb2-22"><a href="#cb2-22" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-23"><a href="#cb2-23" aria-hidden="true" tabindex="-1"></a> <span class="co">-- step 3</span></span>
<span id="cb2-24"><a href="#cb2-24" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> Data.List.foldl'</span>
<span id="cb2-25"><a href="#cb2-25" aria-hidden="true" tabindex="-1"></a> (\acc <span class="op">~</span>(i, <span class="dt">Possible</span> xs) <span class="ot">-></span></span>
<span id="cb2-26"><a href="#cb2-26" aria-hidden="true" tabindex="-1"></a> Data.List.foldl' (\acc' x <span class="ot">-></span> Map.insertWith prepend x [i] acc') acc xs)</span>
<span id="cb2-27"><a href="#cb2-27" aria-hidden="true" tabindex="-1"></a> Map.empty</span>
<span id="cb2-28"><a href="#cb2-28" aria-hidden="true" tabindex="-1"></a> <span class="co">-- fromList [(2,[9,8,6]),(3,[9,8,6]),(4,[1]),(6,[9,8,7,6,4,1]),(8,[9,8,6]),</span></span>
<span id="cb2-29"><a href="#cb2-29" aria-hidden="true" tabindex="-1"></a> <span class="co">-- (9,[9,8,7,6,4,1])]</span></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="co">-- step 4</span></span>
<span id="cb2-32"><a href="#cb2-32" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> Map.filter ((<span class="op"><</span> <span class="dv">4</span>) <span class="op">.</span> <span class="fu">length</span>)</span>
<span id="cb2-33"><a href="#cb2-33" aria-hidden="true" tabindex="-1"></a> <span class="co">-- fromList [(2,[9,8,6]),(3,[9,8,6]),(4,[1]),(8,[9,8,6])]</span></span>
<span id="cb2-34"><a href="#cb2-34" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-35"><a href="#cb2-35" aria-hidden="true" tabindex="-1"></a> <span class="co">-- step 5</span></span>
<span id="cb2-36"><a href="#cb2-36" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> Map.foldlWithKey'(\acc x is <span class="ot">-></span> Map.insertWith prepend is [x] acc) Map.empty</span>
<span id="cb2-37"><a href="#cb2-37" aria-hidden="true" tabindex="-1"></a> <span class="co">-- fromList [([1],[4]),([9,8,6],[8,3,2])]</span></span>
<span id="cb2-38"><a href="#cb2-38" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-39"><a href="#cb2-39" aria-hidden="true" tabindex="-1"></a> <span class="co">-- step 6</span></span>
<span id="cb2-40"><a href="#cb2-40" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> Map.filterWithKey (\is xs <span class="ot">-></span> <span class="fu">length</span> is <span class="op">==</span> <span class="fu">length</span> xs)</span>
<span id="cb2-41"><a href="#cb2-41" aria-hidden="true" tabindex="-1"></a> <span class="co">-- fromList [([1],[4]),([9,8,6],[8,3,2])]</span></span>
<span id="cb2-42"><a href="#cb2-42" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb2-43"><a href="#cb2-43" aria-hidden="true" tabindex="-1"></a> <span class="co">-- step 7</span></span>
<span id="cb2-44"><a href="#cb2-44" aria-hidden="true" tabindex="-1"></a> <span class="op">&</span> Map.elems</span>
<span id="cb2-45"><a href="#cb2-45" aria-hidden="true" tabindex="-1"></a> <span class="co">-- [[4],[8,3,2]]</span></span>
<span id="cb2-46"><a href="#cb2-46" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb2-47"><a href="#cb2-47" aria-hidden="true" tabindex="-1"></a> prepend <span class="op">~</span>[y] ys <span class="ot">=</span> y<span class="op">:</span>ys</span></code></pre></div>
<p>We extract the <code>isPossible</code> function to the top level from the <code>nextGrids</code> function for reuse. Then we write the <code>exclusivePossibilities</code> function which finds the Exclusives in the input row. This function is written using the reverse application operator <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Function.html#v:-38-" target="_blank" rel="noopener"><code>(&)</code></a><a href="#fn4" class="footnote-ref" id="fnref4" role="doc-noteref"><sup>4</sup></a> instead of the usual <code>($)</code> operator so that we can read it from top to bottom. We also show the intermediate values for a sample input after every step in the function chain.</p>
<p>The nub of the function lies in step 3 (pun intended). We do a nested fold over all the non-fixed cells and all the possible digits in them to compute the map<a href="#fn5" class="footnote-ref" id="fnref5" role="doc-noteref"><sup>5</sup></a> which represents the first table. Thereafter, we filter the map to keep only the entries with length less than four (step 4). Then we flip it to create a new map which represents the second table (step 5). Finally, we filter the flipped map for the entries where the cell count is same as the digit count (step 6) to arrive at the final table. The step 7 just gets the values in the map which is the list of all the Exclusives in the input row.</p>
<h2 data-track-content data-content-name="pruning-the-cells-exclusively" data-content-piece="fast-sudoku-solver-in-haskell-2" id="pruning-the-cells-exclusively">Pruning the Cells, Exclusively</h2>
<p>To start with, we extract some reusable code from the previous <code>pruneCells</code> function and rename it to <code>pruneCellsByFixed</code>:</p>
<div class="sourceCode" id="cb3" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb3-1"><a href="#cb3-1" aria-hidden="true" tabindex="-1"></a><span class="ot">makeCell ::</span> [<span class="dt">Int</span>] <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Cell</span></span>
<span id="cb3-2"><a href="#cb3-2" aria-hidden="true" tabindex="-1"></a>makeCell ys <span class="ot">=</span> <span class="kw">case</span> ys <span class="kw">of</span></span>
<span id="cb3-3"><a href="#cb3-3" aria-hidden="true" tabindex="-1"></a> [] <span class="ot">-></span> <span class="dt">Nothing</span></span>
<span id="cb3-4"><a href="#cb3-4" aria-hidden="true" tabindex="-1"></a> [y] <span class="ot">-></span> <span class="dt">Just</span> <span class="op">$</span> <span class="dt">Fixed</span> y</span>
<span id="cb3-5"><a href="#cb3-5" aria-hidden="true" tabindex="-1"></a> _ <span class="ot">-></span> <span class="dt">Just</span> <span class="op">$</span> <span class="dt">Possible</span> ys</span>
<span id="cb3-6"><a href="#cb3-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-7"><a href="#cb3-7" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneCellsByFixed ::</span> [<span class="dt">Cell</span>] <span class="ot">-></span> <span class="dt">Maybe</span> [<span class="dt">Cell</span>]</span>
<span id="cb3-8"><a href="#cb3-8" aria-hidden="true" tabindex="-1"></a>pruneCellsByFixed cells <span class="ot">=</span> <span class="fu">traverse</span> pruneCell cells</span>
<span id="cb3-9"><a href="#cb3-9" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb3-10"><a href="#cb3-10" aria-hidden="true" tabindex="-1"></a> fixeds <span class="ot">=</span> [x <span class="op">|</span> <span class="dt">Fixed</span> x <span class="ot"><-</span> cells]</span>
<span id="cb3-11"><a href="#cb3-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-12"><a href="#cb3-12" aria-hidden="true" tabindex="-1"></a> pruneCell (<span class="dt">Possible</span> xs) <span class="ot">=</span> makeCell (xs <span class="dt">Data.List</span><span class="op">.</span>\\ fixeds)</span>
<span id="cb3-13"><a href="#cb3-13" aria-hidden="true" tabindex="-1"></a> pruneCell x <span class="ot">=</span> <span class="dt">Just</span> x</span></code></pre></div>
<p>Now we write the <code>pruneCellsByExclusives</code> function which uses the <code>exclusivePossibilities</code> function to prune the cells:</p>
<div class="sourceCode" id="cb4" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb4-1"><a href="#cb4-1" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneCellsByExclusives ::</span> [<span class="dt">Cell</span>] <span class="ot">-></span> <span class="dt">Maybe</span> [<span class="dt">Cell</span>]</span>
<span id="cb4-2"><a href="#cb4-2" aria-hidden="true" tabindex="-1"></a>pruneCellsByExclusives cells <span class="ot">=</span> <span class="kw">case</span> exclusives <span class="kw">of</span></span>
<span id="cb4-3"><a href="#cb4-3" aria-hidden="true" tabindex="-1"></a> [] <span class="ot">-></span> <span class="dt">Just</span> cells</span>
<span id="cb4-4"><a href="#cb4-4" aria-hidden="true" tabindex="-1"></a> _ <span class="ot">-></span> <span class="fu">traverse</span> pruneCell cells</span>
<span id="cb4-5"><a href="#cb4-5" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb4-6"><a href="#cb4-6" aria-hidden="true" tabindex="-1"></a> exclusives <span class="ot">=</span> exclusivePossibilities cells</span>
<span id="cb4-7"><a href="#cb4-7" aria-hidden="true" tabindex="-1"></a> allExclusives <span class="ot">=</span> <span class="fu">concat</span> exclusives</span>
<span id="cb4-8"><a href="#cb4-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb4-9"><a href="#cb4-9" aria-hidden="true" tabindex="-1"></a> pruneCell cell<span class="op">@</span>(<span class="dt">Fixed</span> _) <span class="ot">=</span> <span class="dt">Just</span> cell</span>
<span id="cb4-10"><a href="#cb4-10" aria-hidden="true" tabindex="-1"></a> pruneCell cell<span class="op">@</span>(<span class="dt">Possible</span> xs)</span>
<span id="cb4-11"><a href="#cb4-11" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> intersection <span class="ot">`elem`</span> exclusives <span class="ot">=</span> makeCell intersection</span>
<span id="cb4-12"><a href="#cb4-12" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> <span class="dt">Just</span> cell</span>
<span id="cb4-13"><a href="#cb4-13" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb4-14"><a href="#cb4-14" aria-hidden="true" tabindex="-1"></a> intersection <span class="ot">=</span> xs <span class="ot">`Data.List.intersect`</span> allExclusives</span></code></pre></div>
<p><code>pruneCellsByExclusives</code> works exactly as shown in the examples above. We first find the list of Exclusives in the given cells. If there are no Exclusives, there’s nothing to do and we just return the cells. If we find any Exclusives, we <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Traversable.html#v:traverse" target="_blank" rel="noopener"><code>traverse</code></a> the cells, pruning each cell to only the intersection of the possible digits in the cell and Exclusive digits. That’s it! We reuse the <code>makeCell</code> function to create a new cell with the intersection.</p>
<p>As the final step, we rewrite the <code>pruneCells</code> function by combining both the functions.</p>
<div class="sourceCode" id="cb5" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb5-1"><a href="#cb5-1" aria-hidden="true" tabindex="-1"></a><span class="ot">fixM ::</span> (<span class="dt">Eq</span> t, <span class="dt">Monad</span> m) <span class="ot">=></span> (t <span class="ot">-></span> m t) <span class="ot">-></span> t <span class="ot">-></span> m t</span>
<span id="cb5-2"><a href="#cb5-2" aria-hidden="true" tabindex="-1"></a>fixM f x <span class="ot">=</span> f x <span class="op">>>=</span> \x' <span class="ot">-></span> <span class="kw">if</span> x' <span class="op">==</span> x <span class="kw">then</span> <span class="fu">return</span> x <span class="kw">else</span> fixM f x'</span>
<span id="cb5-3"><a href="#cb5-3" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb5-4"><a href="#cb5-4" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneCells ::</span> [<span class="dt">Cell</span>] <span class="ot">-></span> <span class="dt">Maybe</span> [<span class="dt">Cell</span>]</span>
<span id="cb5-5"><a href="#cb5-5" aria-hidden="true" tabindex="-1"></a>pruneCells cells <span class="ot">=</span> fixM pruneCellsByFixed cells <span class="op">>>=</span> fixM pruneCellsByExclusives</span></code></pre></div>
<p>We have extracted <code>fixM</code> as a top level function from the <code>pruneGrid</code> function. Just like the <code>pruneGrid'</code> function, we need to use monadic bind (<a href="https://hackage.haskell.org/package/base-4.10.1.0/docs/Control-Monad.html#v:-62--62--61-" target="_blank" rel="noopener"><code>>>=</code></a>) to chain the two pruning steps. We also use <code>fixM</code> to apply each step repeatedly till the pruned cells settle<a href="#fn6" class="footnote-ref" id="fnref6" role="doc-noteref"><sup>6</sup></a>.</p>
<p>No further code changes are required. It is time to check out the improvements.</p>
<h2 data-track-content data-content-name="faster-than-a-speeding-bullet" data-content-piece="fast-sudoku-solver-in-haskell-2" id="faster-than-a-speeding-bullet">Faster than a Speeding Bullet!</h2>
<p>Let’s build the program and run the exact same number of puzzles as before:</p>
<pre class="plain"><code>$ head -n100 sudoku17.txt | time stack exec sudoku
... output omitted ...
0.53 real 0.58 user 0.23 sys</code></pre>
<p>Woah! It is way faster than before. Let’s solve all the puzzles now:</p>
<pre class="plain"><code>$ cat sudoku17.txt | time stack exec sudoku > /dev/null
282.98 real 407.25 user 109.27 sys</code></pre>
<p>So it is took about 283 seconds to solve all the 49151 puzzles. The speedup is about 200x<a href="#fn7" class="footnote-ref" id="fnref7" role="doc-noteref"><sup>7</sup></a>. That’s about 5.8 milliseconds per puzzle.</p>
<p>Let’s do a quick profiling to see where the time is going:</p>
<pre class="plain"><code>$ stack build --profile
$ head -n1000 sudoku17.txt | stack exec -- sudoku +RTS -p > /dev/null</code></pre>
<p>This generates a file named <code>sudoku.prof</code> with the profiling results. Here are the top five most time-taking functions (cleaned for brevity):</p>
<div class="scrollable-table">
<table>
<thead>
<tr class="header">
<th style="text-align: left;">Cost Center</th>
<th style="text-align: left;">Source</th>
<th style="text-align: right;">%time</th>
<th style="text-align: right;">%alloc</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities</code></td>
<td style="text-align: left;">(49,1)-(62,26)</td>
<td style="text-align: right;">17.6</td>
<td style="text-align: right;">11.4</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>pruneCellsByFixed.pruneCell</code></td>
<td style="text-align: left;">(75,5)-(76,36)</td>
<td style="text-align: right;">16.9</td>
<td style="text-align: right;">30.8</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>exclusivePossibilities.\.\</code></td>
<td style="text-align: left;">55:38-70</td>
<td style="text-align: right;">12.2</td>
<td style="text-align: right;">20.3</td>
</tr>
<tr class="even">
<td style="text-align: left;"><code>fixM.\</code></td>
<td style="text-align: left;">13:27-65</td>
<td style="text-align: right;">10.0</td>
<td style="text-align: right;">0.0</td>
</tr>
<tr class="odd">
<td style="text-align: left;"><code>==</code></td>
<td style="text-align: left;">15:56-57</td>
<td style="text-align: right;">7.2</td>
<td style="text-align: right;">0.0</td>
</tr>
</tbody>
</table>
</div>
<p>Looking at the report, my guess is that a lot of time is going into list operations. Lists are known to be inefficient in Haskell so maybe we should switch to some other data structures?</p>
<h3 id="update">Update</h3>
<p>As per the <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/?mtm_campaign=feed#comment-97ca7640-8531-11e8-a1d5-1fd7d3dbc496">comment</a> below by Chris Casinghino, I ran both the versions of code without the <code>-threaded</code>, <code>-rtsopts</code> and <code>-with-rtsopts=-N</code> options. The time for previous post’s code:</p>
<pre class="plain"><code>$ head -n100 sudoku17.txt | time stack exec sudoku
... output omitted ...
96.54 real 95.90 user 0.66 sys</code></pre>
<p>And the time for this post’s code:</p>
<pre class="plain"><code>$ cat sudoku17.txt | time stack exec sudoku > /dev/null
258.97 real 257.34 user 1.52 sys</code></pre>
<p>So, both the versions run about 10% faster without the threading options. I suspect this has something to do with GHC’s parallel GC as described in <a href="https://web.archive.org/web/20170612225421/https://inner-haven.net/posts/2017-05-08-speed-up-haskell-programs-weird-trick.html" target="_blank" rel="noopener">this post</a>. So for now, I’ll keep threading disabled.</p>
<h2 data-track-content data-content-name="conclusion" data-content-piece="fast-sudoku-solver-in-haskell-2" id="conclusion">Conclusion</h2>
<p>In this post, we improved upon our simple Sudoku solution from the <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-1/?mtm_campaign=feed">last time</a>. We discovered and implemented a new strategy to prune cells, and we achieved a 200x speedup. But profiling shows that we still have many possibilities for improvements. We’ll work on that and more in the upcoming posts in this series. The code till now is available <a href="https://code.abhinavsarkar.net/abhin4v/hasdoku/src/commit/9d6eb18229f905c52cb4c98b569abb70757ba022?mtm_campaign=feed" target="_blank" rel="noopener">here</a>.</p>
<section id="footnotes" class="footnotes footnotes-end-of-document" role="doc-endnotes">
<hr></hr>
<ol>
<li id="fn1"><p>All the runs were done on my MacBook Pro from 2014 with 2.2 GHz Intel Core i7 CPU and 16 GB memory.<a href="#fnref1" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn2"><p>At least 17 cells must be pre-filled in a Sudoku puzzle for it to have a unique solution. So 17-clue puzzles are the most difficult of all puzzles. <a href="https://arxiv.org/pdf/1201.0749v2.pdf" target="_blank" rel="noopener">This paper</a> by McGuire, Tugemann and Civario gives the proof of the same.<a href="#fnref2" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn3"><p>“Single” as in <a href="https://en.wikipedia.org/wiki/Single_child" target="_blank" rel="noopener">“Single child”</a><a href="#fnref3" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn4"><p>Reverse application operation is not used much in Haskell. But it is the preferred way of function chaining in some other functional programming languages like <a href="https://clojuredocs.org/clojure.core/-%3E" target="_blank" rel="noopener">Clojure</a>, <a href="https://en.wikibooks.org/wiki/F_Sharp_Programming/Higher_Order_Functions#The_%7C%3E_Operator" target="_blank" rel="noopener">FSharp</a>, and <a href="https://hexdocs.pm/elixir/Kernel.html#%7C%3E/2" target="_blank" rel="noopener">Elixir</a>.<a href="#fnref4" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn5"><p>We use <a href="https://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Strict.html" target="_blank" rel="noopener">Data.Map.Strict</a> as the map implementation.<a href="#fnref5" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn6"><p>We need to run <code>pruneCellsByFixed</code> and <code>pruneCellsByExclusives</code> repeatedly using <code>fixM</code> because an unsettled row can lead to wrong solutions.</p>
<p>Imagine a row which just got a <code>9</code> fixed because of <code>pruneCellsByFixed</code>. If we don’t run the function again, the row may be left with one non-fixed cell with a <code>9</code>. When we run this row through <code>pruneCellsByExclusives</code>, it’ll consider the <code>9</code> in the non-fixed cell as a Single and fix it. This will lead to two <code>9</code>s in the same row, causing the solution to fail.<a href="#fnref6" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn7"><p>Speedup calculation: 116.7 / 100 * 49151 / 282.98 = 202.7<a href="#fnref7" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
</ol>
</section><p>If you liked this post, please <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/?mtm_campaign=feed#syndications">leave a comment</a>.</p><img referrerpolicy="no-referrer-when-downgrade" src="https://anna.abhinavsarkar.net/matomo.php?idsite=1&rec=1" style="border:0" alt="" />2018-07-11T00:00:00Z<p>In the <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-1/">first part</a> of this series of posts, we wrote a simple <a href="https://en.wikipedia.org/wiki/Sudoku" target="_blank" rel="noopener">Sudoku</a> solver in <a href="https://www.haskell.org/" target="_blank" rel="noopener">Haskell</a>. It used a <a href="https://en.wikipedia.org/wiki/Constraint_satisfaction_problem" target="_blank" rel="noopener">constraint satisfaction</a> algorithm with <a href="https://en.wikipedia.org/wiki/Depth-first_search" target="_blank" rel="noopener">backtracking</a>. The solution worked well but was very slow. In this post, we are going to improve it and make it <strong>fast</strong>.</p>
https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-1/Fast Sudoku Solver in Haskell #1: A Simple Solution2018-06-28T00:00:00ZAbhinav Sarkarhttps://abhinavsarkar.net/about/abhinav@abhinavsarkar.net<p><a href="https://en.wikipedia.org/wiki/Sudoku" target="_blank" rel="noopener">Sudoku</a> is a number placement puzzle. It consists of a 9x9 grid which is to be filled with digits from 1 to 9. Some of the cells of the grid come pre-filled and the player has to fill the rest.</p>
<p><a href="https://www.haskell.org/" target="_blank" rel="noopener">Haskell</a> is a purely functional programming language. It is a good choice to solve Sudoku given the problem’s <a href="https://en.wikipedia.org/wiki/Combinatorics" target="_blank" rel="noopener">combinatorial</a> nature. The aim of this series of posts is to write a <strong>fast</strong> Sudoku solver in Haskell. We’ll focus on both implementing the solution and making it efficient, step-by-step, starting with a slow but simple solution in this post<a href="#fn1" class="footnote-ref" id="fnref1" role="doc-noteref"><sup>1</sup></a>.</p>
<p>This post was originally published on <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-1/?mtm_campaign=feed">abhinavsarkar.net</a>.</p><!--more-->
<p>This is the first post in a series of posts:</p>
<ol type="1">
<li>Fast Sudoku Solver in Haskell #1: A Simple Solution</li>
<li><a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-2/?mtm_campaign=feed">Fast Sudoku Solver in Haskell #2: A 200x Faster Solution</a></li>
<li><a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-3/?mtm_campaign=feed">Fast Sudoku Solver in Haskell #3: Picking the Right Data Structures</a></li>
</ol>
<nav id="toc" class="right-toc"><h3>Contents</h3><ol><li><a href="#constraint-satisfaction-problem">Constraint Satisfaction Problem</a></li><li><a href="#setting-up">Setting up</a></li><li><a href="#pruning-the-cells">Pruning the Cells</a></li><li><a href="#pruning-the-grid">Pruning the Grid</a></li><li><a href="#making-the-choice">Making the Choice</a></li><li><a href="#solving-the-puzzle">Solving the Puzzle</a></li><li><a href="#conclusion">Conclusion</a></li></ol></nav>
<h2 data-track-content data-content-name="constraint-satisfaction-problem" data-content-piece="fast-sudoku-solver-in-haskell-1" id="constraint-satisfaction-problem">Constraint Satisfaction Problem</h2>
<p>Solving Sudoku is a <a href="https://en.wikipedia.org/wiki/Constraint_satisfaction_problem" target="_blank" rel="noopener">constraint satisfaction problem</a>. We are given a partially filled grid which we have to fill completely such that each of the following constraints are satisfied:</p>
<ol type="1">
<li>Each of the nine rows must have all the digits, from 1 to 9.</li>
<li>Each of the nine columns must have all the digits, from 1 to 9.</li>
<li>Each of the nine 3x3 sub-grids must have all the digits, from 1 to 9.</li>
</ol>
<figure>
<img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 201 209'%3E%3C/svg%3E" class="lazyload ascii-art nolink w-30pct" style="--image-aspect-ratio: 0.9617224880382775" data-src="/images/fast-sudoku-solver-in-haskell-1/sudoku01.svg" alt="A sample puzzle"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-1/sudoku01.svg" class="ascii-art nolink w-30pct" alt="A sample puzzle"></img></noscript>
<figcaption>A sample puzzle</figcaption>
</figure>
<figure>
<img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 201 209'%3E%3C/svg%3E" class="lazyload ascii-art nolink w-30pct" style="--image-aspect-ratio: 0.9617224880382775" data-src="/images/fast-sudoku-solver-in-haskell-1/sudoku02.svg" alt="And its solution"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-1/sudoku02.svg" class="ascii-art nolink w-30pct" alt="And its solution"></img></noscript>
<figcaption>And its solution</figcaption>
</figure>
<p>Each cell in the grid is member of one row, one column and one sub-grid (called <em>block</em> in general). Digits in the pre-filled cells impose constraints on the rows, columns, and sub-grids they are part of. For example, if a cell contains <code>1</code> then no other cell in that cell’s row, column or sub-grid can contain <code>1</code>. Given these constraints, we can devise a simple algorithm to solve Sudoku:</p>
<ol type="1">
<li>Each cell contains either a single digit or has a set of possible digits. For example, a grid showing the possibilities of all non-filled cells for the sample puzzle above:</li>
</ol>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 209'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 4.4066985645933014" data-src="/images/fast-sudoku-solver-in-haskell-1/sudoku1.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-1/sudoku1.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<ol start="2" type="1">
<li>If a cell contains a digit, remove that digit from the list of the possible digits from all its neighboring cells. Neighboring cells are the other cells in the given cell’s row, column and sub-grid. For example, the grid after removing the fixed value <code>4</code> of the row-2-column-1 cell from its neighboring cells:</li>
</ol>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 209'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 4.4066985645933014" data-src="/images/fast-sudoku-solver-in-haskell-1/sudoku2.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-1/sudoku2.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<ol start="3" type="1">
<li>Repeat the previous step for all the cells that are have been solved (or <em>fixed</em>), either pre-filled or filled in the previous iteration of the solution. For example, the grid after removing all fixed values from all non-fixed cells:</li>
</ol>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 209'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 4.4066985645933014" data-src="/images/fast-sudoku-solver-in-haskell-1/sudoku3.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-1/sudoku3.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<ol start="4" type="1">
<li>Continue till the grid <em>settles</em>, that is, there are no more changes in the possibilities of any cells. For example, the settled grid for the current iteration:</li>
</ol>
<div class="scrollable-img">
<p><img src="data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 921 209'%3E%3C/svg%3E" class="lazyload ascii-art nolink extra-width" style="--image-aspect-ratio: 4.4066985645933014" data-src="/images/fast-sudoku-solver-in-haskell-1/sudoku4.svg"></img>
<noscript><img src="/images/fast-sudoku-solver-in-haskell-1/sudoku4.svg" class="ascii-art nolink extra-width"></img></noscript></p>
</div>
<ol start="5" type="1">
<li>Once the grid settles, choose one of the non-fixed cells following some strategy. Select one of the digits from all the possibilities of the cell, and fix (assume) the cell to have that digit. Go back to step 1 and repeat.</li>
<li>The elimination of possibilities may result in inconsistencies. For example, you may end up with a cell with no possibilities. In such a case, discard that branch of solution, and backtrack to last point where you fixed a cell. Choose a different possibility to fix and repeat.</li>
<li>If at any point the grid is completely filled, you’ve found the solution!</li>
<li>If you exhaust all branches of the solution then the puzzle is unsolvable. This can happen if it starts with cells pre-filled wrongly.</li>
</ol>
<p>This algorithm is actually a <a href="https://en.wikipedia.org/wiki/Depth-first_search" target="_blank" rel="noopener">Depth-First Search</a> on the <a href="https://en.wikipedia.org/wiki/State_space_search" target="_blank" rel="noopener">state space</a> of the grid configurations. It guarantees to either find a solution or prove a puzzle to be unsolvable.</p>
<h2 data-track-content data-content-name="setting-up" data-content-piece="fast-sudoku-solver-in-haskell-1" id="setting-up">Setting up</h2>
<p>We start with writing types to represent the cells and the grid:</p>
<div class="sourceCode" id="cb1" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb1-1"><a href="#cb1-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">Cell</span> <span class="ot">=</span> <span class="dt">Fixed</span> <span class="dt">Int</span> <span class="op">|</span> <span class="dt">Possible</span> [<span class="dt">Int</span>] <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</span>
<span id="cb1-2"><a href="#cb1-2" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> <span class="dt">Row</span> <span class="ot">=</span> [<span class="dt">Cell</span>]</span>
<span id="cb1-3"><a href="#cb1-3" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> <span class="dt">Grid</span> <span class="ot">=</span> [<span class="dt">Row</span>]</span></code></pre></div>
<p>A cell is either fixed with a particular digit or has a set of digits as possibilities. So it is natural to represent it as a <a href="https://en.wikipedia.org/wiki/Algebraic_data_type" target="_blank" rel="noopener">sum type</a> with <code>Fixed</code> and <code>Possible</code> constructors. A row is a list of cells and a grid is a list of rows.</p>
<p>We’ll take the input puzzle as a string of 81 characters representing the cells, left-to-right and top-to-bottom. An example is:</p>
<pre class="plain"><code>.......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6...</code></pre>
<p>Here, <code>.</code> represents an non-filled cell. Let’s write a function to read this input and parse it to our <code>Grid</code> data structure:</p>
<div class="sourceCode" id="cb3" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb3-1"><a href="#cb3-1" aria-hidden="true" tabindex="-1"></a><span class="ot">readGrid ::</span> <span class="dt">String</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb3-2"><a href="#cb3-2" aria-hidden="true" tabindex="-1"></a>readGrid s</span>
<span id="cb3-3"><a href="#cb3-3" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">length</span> s <span class="op">==</span> <span class="dv">81</span> <span class="ot">=</span> <span class="fu">traverse</span> (<span class="fu">traverse</span> readCell) <span class="op">.</span> Data.List.Split.chunksOf <span class="dv">9</span> <span class="op">$</span> s</span>
<span id="cb3-4"><a href="#cb3-4" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> <span class="dt">Nothing</span></span>
<span id="cb3-5"><a href="#cb3-5" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb3-6"><a href="#cb3-6" aria-hidden="true" tabindex="-1"></a> readCell <span class="ch">'.'</span> <span class="ot">=</span> <span class="dt">Just</span> <span class="op">$</span> <span class="dt">Possible</span> [<span class="dv">1</span><span class="op">..</span><span class="dv">9</span>]</span>
<span id="cb3-7"><a href="#cb3-7" aria-hidden="true" tabindex="-1"></a> readCell c</span>
<span id="cb3-8"><a href="#cb3-8" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> Data.Char.isDigit c <span class="op">&&</span> c <span class="op">></span> <span class="ch">'0'</span> <span class="ot">=</span> <span class="dt">Just</span> <span class="op">.</span> <span class="dt">Fixed</span> <span class="op">.</span> Data.Char.digitToInt <span class="op">$</span> c</span>
<span id="cb3-9"><a href="#cb3-9" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> <span class="dt">Nothing</span></span></code></pre></div>
<p><code>readGrid</code> return a <code>Just grid</code> if the input is correct, else it returns a <code>Nothing</code>. It parses a <code>.</code> to a <code>Possible</code> cell with all digits as possibilities, and a digit char to a <code>Fixed</code> cell with that digit. Let’s try it out in the <em>REPL</em>:</p>
<div class="sourceCode" id="cb4" data-lang="ghci"><pre class="sourceCode lhs numberSource"><code class="sourceCode literatehaskell"><span id="cb4-1"><a href="#cb4-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span> readGrid <span class="st">".......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6..."</span></span>
<span id="cb4-2"><a href="#cb4-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">mapM_</span> <span class="fu">print</span> grid</span>
<span id="cb4-3"><a href="#cb4-3" aria-hidden="true" tabindex="-1"></a>[Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Fixed 1,Possible [1,2,3,4,5,6,7,8,9]]</span>
<span id="cb4-4"><a href="#cb4-4" aria-hidden="true" tabindex="-1"></a>[Fixed 4,Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9]]</span>
<span id="cb4-5"><a href="#cb4-5" aria-hidden="true" tabindex="-1"></a>[Possible [1,2,3,4,5,6,7,8,9],Fixed 2,Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9]]</span>
<span id="cb4-6"><a href="#cb4-6" aria-hidden="true" tabindex="-1"></a>[Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Fixed 5,Possible [1,2,3,4,5,6,7,8,9],Fixed 4,Possible [1,2,3,4,5,6,7,8,9],Fixed 7]</span>
<span id="cb4-7"><a href="#cb4-7" aria-hidden="true" tabindex="-1"></a>[Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Fixed 8,Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Fixed 3,Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9]]</span>
<span id="cb4-8"><a href="#cb4-8" aria-hidden="true" tabindex="-1"></a>[Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Fixed 1,Possible [1,2,3,4,5,6,7,8,9],Fixed 9,Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9]]</span>
<span id="cb4-9"><a href="#cb4-9" aria-hidden="true" tabindex="-1"></a>[Fixed 3,Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Fixed 4,Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Fixed 2,Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9]]</span>
<span id="cb4-10"><a href="#cb4-10" aria-hidden="true" tabindex="-1"></a>[Possible [1,2,3,4,5,6,7,8,9],Fixed 5,Possible [1,2,3,4,5,6,7,8,9],Fixed 1,Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9]]</span>
<span id="cb4-11"><a href="#cb4-11" aria-hidden="true" tabindex="-1"></a>[Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Fixed 8,Possible [1,2,3,4,5,6,7,8,9],Fixed 6,Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9],Possible [1,2,3,4,5,6,7,8,9]]</span></code></pre></div>
<p>The output is a bit unreadable but correct. We can write a few functions to clean it up:</p>
<div class="sourceCode" id="cb5" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb5-1"><a href="#cb5-1" aria-hidden="true" tabindex="-1"></a><span class="ot">showGrid ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">String</span></span>
<span id="cb5-2"><a href="#cb5-2" aria-hidden="true" tabindex="-1"></a>showGrid <span class="ot">=</span> <span class="fu">unlines</span> <span class="op">.</span> <span class="fu">map</span> (<span class="fu">unwords</span> <span class="op">.</span> <span class="fu">map</span> showCell)</span>
<span id="cb5-3"><a href="#cb5-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb5-4"><a href="#cb5-4" aria-hidden="true" tabindex="-1"></a> showCell (<span class="dt">Fixed</span> x) <span class="ot">=</span> <span class="fu">show</span> x</span>
<span id="cb5-5"><a href="#cb5-5" aria-hidden="true" tabindex="-1"></a> showCell _ <span class="ot">=</span> <span class="st">"."</span></span>
<span id="cb5-6"><a href="#cb5-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb5-7"><a href="#cb5-7" aria-hidden="true" tabindex="-1"></a><span class="ot">showGridWithPossibilities ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">String</span></span>
<span id="cb5-8"><a href="#cb5-8" aria-hidden="true" tabindex="-1"></a>showGridWithPossibilities <span class="ot">=</span> <span class="fu">unlines</span> <span class="op">.</span> <span class="fu">map</span> (<span class="fu">unwords</span> <span class="op">.</span> <span class="fu">map</span> showCell)</span>
<span id="cb5-9"><a href="#cb5-9" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb5-10"><a href="#cb5-10" aria-hidden="true" tabindex="-1"></a> showCell (<span class="dt">Fixed</span> x) <span class="ot">=</span> <span class="fu">show</span> x <span class="op">++</span> <span class="st">" "</span></span>
<span id="cb5-11"><a href="#cb5-11" aria-hidden="true" tabindex="-1"></a> showCell (<span class="dt">Possible</span> xs) <span class="ot">=</span></span>
<span id="cb5-12"><a href="#cb5-12" aria-hidden="true" tabindex="-1"></a> (<span class="op">++</span> <span class="st">"]"</span>)</span>
<span id="cb5-13"><a href="#cb5-13" aria-hidden="true" tabindex="-1"></a> <span class="op">.</span> Data.List.foldl' (\acc x <span class="ot">-></span> acc <span class="op">++</span> <span class="kw">if</span> x <span class="ot">`elem`</span> xs <span class="kw">then</span> <span class="fu">show</span> x <span class="kw">else</span> <span class="st">" "</span>) <span class="st">"["</span></span>
<span id="cb5-14"><a href="#cb5-14" aria-hidden="true" tabindex="-1"></a> <span class="op">$</span> [<span class="dv">1</span><span class="op">..</span><span class="dv">9</span>]</span></code></pre></div>
<p>Back to the <em>REPL</em> again:</p>
<div class="sourceCode" id="cb6" data-lang="ghci"><pre class="sourceCode lhs numberSource"><code class="sourceCode literatehaskell"><span id="cb6-1"><a href="#cb6-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span> readGrid <span class="st">".......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6..."</span></span>
<span id="cb6-2"><a href="#cb6-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStrLn</span> <span class="op">$</span> showGrid grid</span>
<span id="cb6-3"><a href="#cb6-3" aria-hidden="true" tabindex="-1"></a>. . . . . . . 1 .</span>
<span id="cb6-4"><a href="#cb6-4" aria-hidden="true" tabindex="-1"></a>4 . . . . . . . .</span>
<span id="cb6-5"><a href="#cb6-5" aria-hidden="true" tabindex="-1"></a>. 2 . . . . . . .</span>
<span id="cb6-6"><a href="#cb6-6" aria-hidden="true" tabindex="-1"></a>. . . . 5 . 4 . 7</span>
<span id="cb6-7"><a href="#cb6-7" aria-hidden="true" tabindex="-1"></a>. . 8 . . . 3 . .</span>
<span id="cb6-8"><a href="#cb6-8" aria-hidden="true" tabindex="-1"></a>. . 1 . 9 . . . .</span>
<span id="cb6-9"><a href="#cb6-9" aria-hidden="true" tabindex="-1"></a>3 . . 4 . . 2 . .</span>
<span id="cb6-10"><a href="#cb6-10" aria-hidden="true" tabindex="-1"></a>. 5 . 1 . . . . .</span>
<span id="cb6-11"><a href="#cb6-11" aria-hidden="true" tabindex="-1"></a>. . . 8 . 6 . . .</span></code></pre></div>
<div class="sourceCode" id="cb7" data-lang="ghci"><pre class="sourceCode lhs numberSource small overflow"><code class="sourceCode literatehaskell"><span id="cb7-1"><a href="#cb7-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStrLn</span> <span class="op">$</span> showGridWithPossibilities grid</span>
<span id="cb7-2"><a href="#cb7-2" aria-hidden="true" tabindex="-1"></a>[123456789] [123456789] [123456789] [123456789] [123456789] [123456789] [123456789] 1 [123456789]</span>
<span id="cb7-3"><a href="#cb7-3" aria-hidden="true" tabindex="-1"></a>4 [123456789] [123456789] [123456789] [123456789] [123456789] [123456789] [123456789] [123456789]</span>
<span id="cb7-4"><a href="#cb7-4" aria-hidden="true" tabindex="-1"></a>[123456789] 2 [123456789] [123456789] [123456789] [123456789] [123456789] [123456789] [123456789]</span>
<span id="cb7-5"><a href="#cb7-5" aria-hidden="true" tabindex="-1"></a>[123456789] [123456789] [123456789] [123456789] 5 [123456789] 4 [123456789] 7</span>
<span id="cb7-6"><a href="#cb7-6" aria-hidden="true" tabindex="-1"></a>[123456789] [123456789] 8 [123456789] [123456789] [123456789] 3 [123456789] [123456789]</span>
<span id="cb7-7"><a href="#cb7-7" aria-hidden="true" tabindex="-1"></a>[123456789] [123456789] 1 [123456789] 9 [123456789] [123456789] [123456789] [123456789]</span>
<span id="cb7-8"><a href="#cb7-8" aria-hidden="true" tabindex="-1"></a>3 [123456789] [123456789] 4 [123456789] [123456789] 2 [123456789] [123456789]</span>
<span id="cb7-9"><a href="#cb7-9" aria-hidden="true" tabindex="-1"></a>[123456789] 5 [123456789] 1 [123456789] [123456789] [123456789] [123456789] [123456789]</span>
<span id="cb7-10"><a href="#cb7-10" aria-hidden="true" tabindex="-1"></a>[123456789] [123456789] [123456789] 8 [123456789] 6 [123456789] [123456789] [123456789]</span></code></pre></div>
<p>The output is more readable now. We see that, at the start, all the non-filled cells have all the digits as possible values. We’ll use these functions for debugging as we go forward. We can now start solving the puzzle.</p>
<div class="page-break">
</div>
<h2 data-track-content data-content-name="pruning-the-cells" data-content-piece="fast-sudoku-solver-in-haskell-1" id="pruning-the-cells">Pruning the Cells</h2>
<p>We can remove the digits of fixed cells from their neighboring cells, one cell as a time. But, it is faster to find all the fixed digits in a row of cells and remove them from the possibilities of all the non-fixed cells of the row, at once. Then we can repeat this <em>pruning</em> step for all the rows of the grid (and columns and sub-grids too! We’ll see how).</p>
<div class="sourceCode" id="cb8" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb8-1"><a href="#cb8-1" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneCells ::</span> [<span class="dt">Cell</span>] <span class="ot">-></span> <span class="dt">Maybe</span> [<span class="dt">Cell</span>]</span>
<span id="cb8-2"><a href="#cb8-2" aria-hidden="true" tabindex="-1"></a>pruneCells cells <span class="ot">=</span> <span class="fu">traverse</span> pruneCell cells</span>
<span id="cb8-3"><a href="#cb8-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb8-4"><a href="#cb8-4" aria-hidden="true" tabindex="-1"></a> fixeds <span class="ot">=</span> [x <span class="op">|</span> <span class="dt">Fixed</span> x <span class="ot"><-</span> cells]</span>
<span id="cb8-5"><a href="#cb8-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb8-6"><a href="#cb8-6" aria-hidden="true" tabindex="-1"></a> pruneCell (<span class="dt">Possible</span> xs) <span class="ot">=</span> <span class="kw">case</span> xs <span class="dt">Data.List</span><span class="op">.</span>\\ fixeds <span class="kw">of</span></span>
<span id="cb8-7"><a href="#cb8-7" aria-hidden="true" tabindex="-1"></a> [] <span class="ot">-></span> <span class="dt">Nothing</span></span>
<span id="cb8-8"><a href="#cb8-8" aria-hidden="true" tabindex="-1"></a> [y] <span class="ot">-></span> <span class="dt">Just</span> <span class="op">$</span> <span class="dt">Fixed</span> y</span>
<span id="cb8-9"><a href="#cb8-9" aria-hidden="true" tabindex="-1"></a> ys <span class="ot">-></span> <span class="dt">Just</span> <span class="op">$</span> <span class="dt">Possible</span> ys</span>
<span id="cb8-10"><a href="#cb8-10" aria-hidden="true" tabindex="-1"></a> pruneCell x <span class="ot">=</span> <span class="dt">Just</span> x</span></code></pre></div>
<p><code>pruneCells</code> prunes a list of cells as described before. We start with finding the fixed digits in the list of cells. Then we go over each non-fixed cells, removing the fixed digits we found, from their possible values. Two special cases arise:</p>
<ul>
<li>If pruning results in a cell with no possible digits, it is a sign that this branch of search has no solution and hence, we return a <code>Nothing</code> in that case.</li>
<li>If only one possible digit remains after pruning, then we turn that cell into a fixed cell with that digit.</li>
</ul>
<p>We use the <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Traversable.html#v:traverse" target="_blank" rel="noopener"><code>traverse</code></a> function for pruning the cells so that a <code>Nothing</code> resulting from pruning one cell propagates to the entire list.</p>
<p>Let’s take it for a spin in the <em>REPL</em>:</p>
<div class="sourceCode" id="cb9" data-lang="ghci"><pre class="sourceCode lhs numberSource small overflow"><code class="sourceCode literatehaskell"><span id="cb9-1"><a href="#cb9-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>{</span>
<span id="cb9-2"><a href="#cb9-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span></span>
<span id="cb9-3"><a href="#cb9-3" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> readGrid <span class="st">"6......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6..."</span></span>
<span id="cb9-4"><a href="#cb9-4" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>}</span>
<span id="cb9-5"><a href="#cb9-5" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities <span class="op">$</span> [<span class="fu">head</span> grid] <span class="co">-- first row of the grid</span></span>
<span id="cb9-6"><a href="#cb9-6" aria-hidden="true" tabindex="-1"></a>6 [123456789] [123456789] [123456789] [123456789] [123456789] [123456789] 1 [123456789]</span>
<span id="cb9-7"><a href="#cb9-7" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities [fromJust <span class="op">$</span> pruneCells <span class="op">$</span> <span class="fu">head</span> grid] <span class="co">-- same row after pruning</span></span>
<span id="cb9-8"><a href="#cb9-8" aria-hidden="true" tabindex="-1"></a>6 [ 2345 789] [ 2345 789] [ 2345 789] [ 2345 789] [ 2345 789] [ 2345 789] 1 [ 2345 789]</span></code></pre></div>
<p>It works! <code>6</code> and <code>1</code> are removed from the possibilities of the other cells. Now we are ready for …</p>
<h2 data-track-content data-content-name="pruning-the-grid" data-content-piece="fast-sudoku-solver-in-haskell-1" id="pruning-the-grid">Pruning the Grid</h2>
<p>Pruning a grid requires us to prune each row, each column and each sub-grid. Let’s try to solve it in the <em>REPL</em> first:</p>
<div class="sourceCode" id="cb10" data-lang="ghci"><pre class="sourceCode lhs numberSource small overflow"><code class="sourceCode literatehaskell"><span id="cb10-1"><a href="#cb10-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>{</span>
<span id="cb10-2"><a href="#cb10-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span></span>
<span id="cb10-3"><a href="#cb10-3" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> readGrid <span class="st">"6......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6..."</span></span>
<span id="cb10-4"><a href="#cb10-4" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>}</span>
<span id="cb10-5"><a href="#cb10-5" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid' <span class="ot">=</span> <span class="fu">traverse</span> pruneCells grid</span>
<span id="cb10-6"><a href="#cb10-6" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities grid'</span>
<span id="cb10-7"><a href="#cb10-7" aria-hidden="true" tabindex="-1"></a>6 [ 2345 789] [ 2345 789] [ 2345 789] [ 2345 789] [ 2345 789] [ 2345 789] 1 [ 2345 789]</span>
<span id="cb10-8"><a href="#cb10-8" aria-hidden="true" tabindex="-1"></a>4 [123 56789] [123 56789] [123 56789] [123 56789] [123 56789] [123 56789] [123 56789] [123 56789]</span>
<span id="cb10-9"><a href="#cb10-9" aria-hidden="true" tabindex="-1"></a>[1 3456789] 2 [1 3456789] [1 3456789] [1 3456789] [1 3456789] [1 3456789] [1 3456789] [1 3456789]</span>
<span id="cb10-10"><a href="#cb10-10" aria-hidden="true" tabindex="-1"></a>[123 6 89] [123 6 89] [123 6 89] [123 6 89] 5 [123 6 89] 4 [123 6 89] 7</span>
<span id="cb10-11"><a href="#cb10-11" aria-hidden="true" tabindex="-1"></a>[12 4567 9] [12 4567 9] 8 [12 4567 9] [12 4567 9] [12 4567 9] 3 [12 4567 9] [12 4567 9]</span>
<span id="cb10-12"><a href="#cb10-12" aria-hidden="true" tabindex="-1"></a>[ 2345678 ] [ 2345678 ] 1 [ 2345678 ] 9 [ 2345678 ] [ 2345678 ] [ 2345678 ] [ 2345678 ]</span>
<span id="cb10-13"><a href="#cb10-13" aria-hidden="true" tabindex="-1"></a>3 [1 56789] [1 56789] 4 [1 56789] [1 56789] 2 [1 56789] [1 56789]</span>
<span id="cb10-14"><a href="#cb10-14" aria-hidden="true" tabindex="-1"></a>[ 234 6789] 5 [ 234 6789] 1 [ 234 6789] [ 234 6789] [ 234 6789] [ 234 6789] [ 234 6789]</span>
<span id="cb10-15"><a href="#cb10-15" aria-hidden="true" tabindex="-1"></a>[12345 7 9] [12345 7 9] [12345 7 9] 8 [12345 7 9] 6 [12345 7 9] [12345 7 9] [12345 7 9]</span></code></pre></div>
<p>By <code>traverse</code>-ing the grid with <code>pruneCells</code>, we are able to prune each row, one-by-one. Since pruning a row doesn’t affect another row, we don’t have to pass the resulting rows between each pruning step. That is to say, <code>traverse</code> is enough for us, we don’t need <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Foldable.html#v:foldl" target="_blank" rel="noopener"><code>foldl</code></a> here.</p>
<p>How do we do the same thing for columns now? Since our representation for the grid is rows-first, we first need to convert it to a columns-first representation. Luckily, that’s what <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-List.html#v:transpose" target="_blank" rel="noopener"><code>Data.List.transpose</code></a> function does:</p>
<div class="sourceCode" id="cb11" data-lang="ghci"><pre class="sourceCode lhs numberSource"><code class="sourceCode literatehaskell"><span id="cb11-1"><a href="#cb11-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span> readGrid <span class="st">"693784512487512936125963874932651487568247391741398625319475268856129743274836159"</span></span>
<span id="cb11-2"><a href="#cb11-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGrid grid</span>
<span id="cb11-3"><a href="#cb11-3" aria-hidden="true" tabindex="-1"></a>6 9 3 7 8 4 5 1 2</span>
<span id="cb11-4"><a href="#cb11-4" aria-hidden="true" tabindex="-1"></a>4 8 7 5 1 2 9 3 6</span>
<span id="cb11-5"><a href="#cb11-5" aria-hidden="true" tabindex="-1"></a>1 2 5 9 6 3 8 7 4</span>
<span id="cb11-6"><a href="#cb11-6" aria-hidden="true" tabindex="-1"></a>9 3 2 6 5 1 4 8 7</span>
<span id="cb11-7"><a href="#cb11-7" aria-hidden="true" tabindex="-1"></a>5 6 8 2 4 7 3 9 1</span>
<span id="cb11-8"><a href="#cb11-8" aria-hidden="true" tabindex="-1"></a>7 4 1 3 9 8 6 2 5</span>
<span id="cb11-9"><a href="#cb11-9" aria-hidden="true" tabindex="-1"></a>3 1 9 4 7 5 2 6 8</span>
<span id="cb11-10"><a href="#cb11-10" aria-hidden="true" tabindex="-1"></a>8 5 6 1 2 9 7 4 3</span>
<span id="cb11-11"><a href="#cb11-11" aria-hidden="true" tabindex="-1"></a>2 7 4 8 3 6 1 5 9</span>
<span id="cb11-12"><a href="#cb11-12" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGrid <span class="op">$</span> Data.List.transpose grid</span>
<span id="cb11-13"><a href="#cb11-13" aria-hidden="true" tabindex="-1"></a>6 4 1 9 5 7 3 8 2</span>
<span id="cb11-14"><a href="#cb11-14" aria-hidden="true" tabindex="-1"></a>9 8 2 3 6 4 1 5 7</span>
<span id="cb11-15"><a href="#cb11-15" aria-hidden="true" tabindex="-1"></a>3 7 5 2 8 1 9 6 4</span>
<span id="cb11-16"><a href="#cb11-16" aria-hidden="true" tabindex="-1"></a>7 5 9 6 2 3 4 1 8</span>
<span id="cb11-17"><a href="#cb11-17" aria-hidden="true" tabindex="-1"></a>8 1 6 5 4 9 7 2 3</span>
<span id="cb11-18"><a href="#cb11-18" aria-hidden="true" tabindex="-1"></a>4 2 3 1 7 8 5 9 6</span>
<span id="cb11-19"><a href="#cb11-19" aria-hidden="true" tabindex="-1"></a>5 9 8 4 3 6 2 7 1</span>
<span id="cb11-20"><a href="#cb11-20" aria-hidden="true" tabindex="-1"></a>1 3 7 8 9 2 6 4 5</span>
<span id="cb11-21"><a href="#cb11-21" aria-hidden="true" tabindex="-1"></a>2 6 4 7 1 5 8 3 9</span></code></pre></div>
<p>Pruning columns is easy now:</p>
<div class="sourceCode" id="cb12" data-lang="ghci"><pre class="sourceCode lhs numberSource small overflow"><code class="sourceCode literatehaskell"><span id="cb12-1"><a href="#cb12-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>{</span>
<span id="cb12-2"><a href="#cb12-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span></span>
<span id="cb12-3"><a href="#cb12-3" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> readGrid <span class="st">"6......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6..."</span></span>
<span id="cb12-4"><a href="#cb12-4" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>}</span>
<span id="cb12-5"><a href="#cb12-5" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid' <span class="ot">=</span> <span class="fu">fmap</span> Data.List.transpose <span class="op">.</span> <span class="fu">traverse</span> pruneCells <span class="op">.</span> Data.List.transpose <span class="op">$</span> grid</span>
<span id="cb12-6"><a href="#cb12-6" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities grid'</span>
<span id="cb12-7"><a href="#cb12-7" aria-hidden="true" tabindex="-1"></a>6 [1 34 6789] [ 234567 9] [ 23 567 9] [1234 678 ] [12345 789] [1 56789] 1 [123456 89]</span>
<span id="cb12-8"><a href="#cb12-8" aria-hidden="true" tabindex="-1"></a>4 [1 34 6789] [ 234567 9] [ 23 567 9] [1234 678 ] [12345 789] [1 56789] [ 23456789] [123456 89]</span>
<span id="cb12-9"><a href="#cb12-9" aria-hidden="true" tabindex="-1"></a>[12 5 789] 2 [ 234567 9] [ 23 567 9] [1234 678 ] [12345 789] [1 56789] [ 23456789] [123456 89]</span>
<span id="cb12-10"><a href="#cb12-10" aria-hidden="true" tabindex="-1"></a>[12 5 789] [1 34 6789] [ 234567 9] [ 23 567 9] 5 [12345 789] 4 [ 23456789] 7</span>
<span id="cb12-11"><a href="#cb12-11" aria-hidden="true" tabindex="-1"></a>[12 5 789] [1 34 6789] 8 [ 23 567 9] [1234 678 ] [12345 789] 3 [ 23456789] [123456 89]</span>
<span id="cb12-12"><a href="#cb12-12" aria-hidden="true" tabindex="-1"></a>[12 5 789] [1 34 6789] 1 [ 23 567 9] 9 [12345 789] [1 56789] [ 23456789] [123456 89]</span>
<span id="cb12-13"><a href="#cb12-13" aria-hidden="true" tabindex="-1"></a>3 [1 34 6789] [ 234567 9] 4 [1234 678 ] [12345 789] 2 [ 23456789] [123456 89]</span>
<span id="cb12-14"><a href="#cb12-14" aria-hidden="true" tabindex="-1"></a>[12 5 789] 5 [ 234567 9] 1 [1234 678 ] [12345 789] [1 56789] [ 23456789] [123456 89]</span>
<span id="cb12-15"><a href="#cb12-15" aria-hidden="true" tabindex="-1"></a>[12 5 789] [1 34 6789] [ 234567 9] 8 [1234 678 ] 6 [1 56789] [ 23456789] [123456 89]</span></code></pre></div>
<p>First, we <code>transpose</code> the grid to convert the columns into rows. Then, we prune the rows by <code>traverse</code>-ing <code>pruneCells</code> over them. And finally, we turn the rows back into columns by <code>transpose</code>-ing the grid back again. The last <code>transpose</code> needs to be <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Prelude.html#v:fmap" target="_blank" rel="noopener"><code>fmap</code></a>-ped because <code>traverse pruneCells</code> returns a <code>Maybe</code>.</p>
<p>Pruning sub-grids is a bit trickier. Following the same idea as pruning columns, we need two functions to transform the sub-grids into rows and back. Let’s write the first one:</p>
<div class="sourceCode" id="cb13" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb13-1"><a href="#cb13-1" aria-hidden="true" tabindex="-1"></a><span class="ot">subGridsToRows ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">Grid</span></span>
<span id="cb13-2"><a href="#cb13-2" aria-hidden="true" tabindex="-1"></a>subGridsToRows <span class="ot">=</span></span>
<span id="cb13-3"><a href="#cb13-3" aria-hidden="true" tabindex="-1"></a> <span class="fu">concatMap</span> (\rows <span class="ot">-></span> <span class="kw">let</span> [r1, r2, r3] <span class="ot">=</span> <span class="fu">map</span> (Data.List.Split.chunksOf <span class="dv">3</span>) rows</span>
<span id="cb13-4"><a href="#cb13-4" aria-hidden="true" tabindex="-1"></a> <span class="kw">in</span> <span class="fu">zipWith3</span> (\a b c <span class="ot">-></span> a <span class="op">++</span> b <span class="op">++</span> c) r1 r2 r3)</span>
<span id="cb13-5"><a href="#cb13-5" aria-hidden="true" tabindex="-1"></a> <span class="op">.</span> Data.List.Split.chunksOf <span class="dv">3</span></span></code></pre></div>
<p>And try it out:</p>
<div class="sourceCode" id="cb14" data-lang="ghci"><pre class="sourceCode lhs numberSource"><code class="sourceCode literatehaskell"><span id="cb14-1"><a href="#cb14-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span> readGrid <span class="st">"693784512487512936125963874932651487568247391741398625319475268856129743274836159"</span></span>
<span id="cb14-2"><a href="#cb14-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGrid grid</span>
<span id="cb14-3"><a href="#cb14-3" aria-hidden="true" tabindex="-1"></a>6 9 3 7 8 4 5 1 2</span>
<span id="cb14-4"><a href="#cb14-4" aria-hidden="true" tabindex="-1"></a>4 8 7 5 1 2 9 3 6</span>
<span id="cb14-5"><a href="#cb14-5" aria-hidden="true" tabindex="-1"></a>1 2 5 9 6 3 8 7 4</span>
<span id="cb14-6"><a href="#cb14-6" aria-hidden="true" tabindex="-1"></a>9 3 2 6 5 1 4 8 7</span>
<span id="cb14-7"><a href="#cb14-7" aria-hidden="true" tabindex="-1"></a>5 6 8 2 4 7 3 9 1</span>
<span id="cb14-8"><a href="#cb14-8" aria-hidden="true" tabindex="-1"></a>7 4 1 3 9 8 6 2 5</span>
<span id="cb14-9"><a href="#cb14-9" aria-hidden="true" tabindex="-1"></a>3 1 9 4 7 5 2 6 8</span>
<span id="cb14-10"><a href="#cb14-10" aria-hidden="true" tabindex="-1"></a>8 5 6 1 2 9 7 4 3</span>
<span id="cb14-11"><a href="#cb14-11" aria-hidden="true" tabindex="-1"></a>2 7 4 8 3 6 1 5 9</span>
<span id="cb14-12"><a href="#cb14-12" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGrid <span class="op">$</span> subGridsToRows grid</span>
<span id="cb14-13"><a href="#cb14-13" aria-hidden="true" tabindex="-1"></a>6 9 3 4 8 7 1 2 5</span>
<span id="cb14-14"><a href="#cb14-14" aria-hidden="true" tabindex="-1"></a>7 8 4 5 1 2 9 6 3</span>
<span id="cb14-15"><a href="#cb14-15" aria-hidden="true" tabindex="-1"></a>5 1 2 9 3 6 8 7 4</span>
<span id="cb14-16"><a href="#cb14-16" aria-hidden="true" tabindex="-1"></a>9 3 2 5 6 8 7 4 1</span>
<span id="cb14-17"><a href="#cb14-17" aria-hidden="true" tabindex="-1"></a>6 5 1 2 4 7 3 9 8</span>
<span id="cb14-18"><a href="#cb14-18" aria-hidden="true" tabindex="-1"></a>4 8 7 3 9 1 6 2 5</span>
<span id="cb14-19"><a href="#cb14-19" aria-hidden="true" tabindex="-1"></a>3 1 9 8 5 6 2 7 4</span>
<span id="cb14-20"><a href="#cb14-20" aria-hidden="true" tabindex="-1"></a>4 7 5 1 2 9 8 3 6</span>
<span id="cb14-21"><a href="#cb14-21" aria-hidden="true" tabindex="-1"></a>2 6 8 7 4 3 1 5 9</span></code></pre></div>
<p>You can go over the code and the output and make yourself sure that it works. Also, it turns out that we don’t need to write the back-transform function. <code>subGridsToRows</code> is its own back-transform:</p>
<div class="sourceCode" id="cb15" data-lang="ghci"><pre class="sourceCode lhs numberSource"><code class="sourceCode literatehaskell"><span id="cb15-1"><a href="#cb15-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGrid grid</span>
<span id="cb15-2"><a href="#cb15-2" aria-hidden="true" tabindex="-1"></a>6 9 3 7 8 4 5 1 2</span>
<span id="cb15-3"><a href="#cb15-3" aria-hidden="true" tabindex="-1"></a>4 8 7 5 1 2 9 3 6</span>
<span id="cb15-4"><a href="#cb15-4" aria-hidden="true" tabindex="-1"></a>1 2 5 9 6 3 8 7 4</span>
<span id="cb15-5"><a href="#cb15-5" aria-hidden="true" tabindex="-1"></a>9 3 2 6 5 1 4 8 7</span>
<span id="cb15-6"><a href="#cb15-6" aria-hidden="true" tabindex="-1"></a>5 6 8 2 4 7 3 9 1</span>
<span id="cb15-7"><a href="#cb15-7" aria-hidden="true" tabindex="-1"></a>7 4 1 3 9 8 6 2 5</span>
<span id="cb15-8"><a href="#cb15-8" aria-hidden="true" tabindex="-1"></a>3 1 9 4 7 5 2 6 8</span>
<span id="cb15-9"><a href="#cb15-9" aria-hidden="true" tabindex="-1"></a>8 5 6 1 2 9 7 4 3</span>
<span id="cb15-10"><a href="#cb15-10" aria-hidden="true" tabindex="-1"></a>2 7 4 8 3 6 1 5 9</span>
<span id="cb15-11"><a href="#cb15-11" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGrid <span class="op">$</span> subGridsToRows <span class="op">$</span> subGridsToRows <span class="op">$</span> grid</span>
<span id="cb15-12"><a href="#cb15-12" aria-hidden="true" tabindex="-1"></a>6 9 3 7 8 4 5 1 2</span>
<span id="cb15-13"><a href="#cb15-13" aria-hidden="true" tabindex="-1"></a>4 8 7 5 1 2 9 3 6</span>
<span id="cb15-14"><a href="#cb15-14" aria-hidden="true" tabindex="-1"></a>1 2 5 9 6 3 8 7 4</span>
<span id="cb15-15"><a href="#cb15-15" aria-hidden="true" tabindex="-1"></a>9 3 2 6 5 1 4 8 7</span>
<span id="cb15-16"><a href="#cb15-16" aria-hidden="true" tabindex="-1"></a>5 6 8 2 4 7 3 9 1</span>
<span id="cb15-17"><a href="#cb15-17" aria-hidden="true" tabindex="-1"></a>7 4 1 3 9 8 6 2 5</span>
<span id="cb15-18"><a href="#cb15-18" aria-hidden="true" tabindex="-1"></a>3 1 9 4 7 5 2 6 8</span>
<span id="cb15-19"><a href="#cb15-19" aria-hidden="true" tabindex="-1"></a>8 5 6 1 2 9 7 4 3</span>
<span id="cb15-20"><a href="#cb15-20" aria-hidden="true" tabindex="-1"></a>2 7 4 8 3 6 1 5 9</span></code></pre></div>
<p>Nice! Now writing the sub-grid pruning function is easy:</p>
<div class="sourceCode" id="cb16" data-lang="ghci"><pre class="sourceCode lhs numberSource small overflow"><code class="sourceCode literatehaskell"><span id="cb16-1"><a href="#cb16-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>{</span>
<span id="cb16-2"><a href="#cb16-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span></span>
<span id="cb16-3"><a href="#cb16-3" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> readGrid <span class="st">"6......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6..."</span></span>
<span id="cb16-4"><a href="#cb16-4" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>}</span>
<span id="cb16-5"><a href="#cb16-5" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid' <span class="ot">=</span> <span class="fu">fmap</span> subGridsToRows <span class="op">.</span> <span class="fu">traverse</span> pruneCells <span class="op">.</span> subGridsToRows <span class="op">$</span> grid</span>
<span id="cb16-6"><a href="#cb16-6" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities grid'</span>
<span id="cb16-7"><a href="#cb16-7" aria-hidden="true" tabindex="-1"></a>6 [1 3 5 789] [1 3 5 789] [123456789] [123456789] [123456789] [ 23456789] 1 [ 23456789]</span>
<span id="cb16-8"><a href="#cb16-8" aria-hidden="true" tabindex="-1"></a>4 [1 3 5 789] [1 3 5 789] [123456789] [123456789] [123456789] [ 23456789] [ 23456789] [ 23456789]</span>
<span id="cb16-9"><a href="#cb16-9" aria-hidden="true" tabindex="-1"></a>[1 3 5 789] 2 [1 3 5 789] [123456789] [123456789] [123456789] [ 23456789] [ 23456789] [ 23456789]</span>
<span id="cb16-10"><a href="#cb16-10" aria-hidden="true" tabindex="-1"></a>[ 234567 9] [ 234567 9] [ 234567 9] [1234 678 ] 5 [1234 678 ] 4 [12 56 89] 7</span>
<span id="cb16-11"><a href="#cb16-11" aria-hidden="true" tabindex="-1"></a>[ 234567 9] [ 234567 9] 8 [1234 678 ] [1234 678 ] [1234 678 ] 3 [12 56 89] [12 56 89]</span>
<span id="cb16-12"><a href="#cb16-12" aria-hidden="true" tabindex="-1"></a>[ 234567 9] [ 234567 9] 1 [1234 678 ] 9 [1234 678 ] [12 56 89] [12 56 89] [12 56 89]</span>
<span id="cb16-13"><a href="#cb16-13" aria-hidden="true" tabindex="-1"></a>3 [12 4 6789] [12 4 6789] 4 [ 23 5 7 9] [ 23 5 7 9] 2 [1 3456789] [1 3456789]</span>
<span id="cb16-14"><a href="#cb16-14" aria-hidden="true" tabindex="-1"></a>[12 4 6789] 5 [12 4 6789] 1 [ 23 5 7 9] [ 23 5 7 9] [1 3456789] [1 3456789] [1 3456789]</span>
<span id="cb16-15"><a href="#cb16-15" aria-hidden="true" tabindex="-1"></a>[12 4 6789] [12 4 6789] [12 4 6789] 8 [ 23 5 7 9] 6 [1 3456789] [1 3456789] [1 3456789]</span></code></pre></div>
<p>It works well. Now we can string together these three steps to prune the entire grid. We also have to make sure that result of pruning each step is fed into the next step. This is so that the fixed cells created into one step cause more pruning in the further steps. We use monadic bind (<a href="https://hackage.haskell.org/package/base-4.10.1.0/docs/Control-Monad.html#v:-62--62--61-" target="_blank" rel="noopener"><code>>>=</code></a>) for that. Here’s the final code:</p>
<div class="sourceCode" id="cb17" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb17-1"><a href="#cb17-1" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneGrid' ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb17-2"><a href="#cb17-2" aria-hidden="true" tabindex="-1"></a>pruneGrid' grid <span class="ot">=</span></span>
<span id="cb17-3"><a href="#cb17-3" aria-hidden="true" tabindex="-1"></a> <span class="fu">traverse</span> pruneCells grid</span>
<span id="cb17-4"><a href="#cb17-4" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> <span class="fu">fmap</span> Data.List.transpose <span class="op">.</span> <span class="fu">traverse</span> pruneCells <span class="op">.</span> Data.List.transpose</span>
<span id="cb17-5"><a href="#cb17-5" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> <span class="fu">fmap</span> subGridsToRows <span class="op">.</span> <span class="fu">traverse</span> pruneCells <span class="op">.</span> subGridsToRows</span></code></pre></div>
<p>And the test:</p>
<div class="sourceCode" id="cb18" data-lang="ghci"><pre class="sourceCode lhs numberSource small overflow"><code class="sourceCode literatehaskell"><span id="cb18-1"><a href="#cb18-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>{</span>
<span id="cb18-2"><a href="#cb18-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span></span>
<span id="cb18-3"><a href="#cb18-3" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> readGrid <span class="st">"6......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6..."</span></span>
<span id="cb18-4"><a href="#cb18-4" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>}</span>
<span id="cb18-5"><a href="#cb18-5" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid' <span class="ot">=</span> pruneGrid' grid</span>
<span id="cb18-6"><a href="#cb18-6" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities grid'</span>
<span id="cb18-7"><a href="#cb18-7" aria-hidden="true" tabindex="-1"></a>6 [ 3 789] [ 3 5 7 9] [ 23 5 7 9] [ 234 78 ] [ 2345 789] [ 5 789] 1 [ 2345 89]</span>
<span id="cb18-8"><a href="#cb18-8" aria-hidden="true" tabindex="-1"></a>4 [1 3 789] [ 3 5 7 9] [ 23 567 9] [123 678 ] [123 5 789] [ 56789] [ 23 56789] [ 23 56 89]</span>
<span id="cb18-9"><a href="#cb18-9" aria-hidden="true" tabindex="-1"></a>[1 5 789] 2 [ 3 5 7 9] [ 3 567 9] [1 34 678 ] [1 345 789] [ 56789] [ 3456789] [ 3456 89]</span>
<span id="cb18-10"><a href="#cb18-10" aria-hidden="true" tabindex="-1"></a>[ 2 9] [ 3 6 9] [ 23 6 9] [ 23 6 ] 5 [123 8 ] 4 [ 2 6 89] 7</span>
<span id="cb18-11"><a href="#cb18-11" aria-hidden="true" tabindex="-1"></a>[ 2 5 7 9] [ 4 67 9] 8 [ 2 67 ] [12 4 67 ] [12 4 7 ] 3 [ 2 56 9] [12 56 9]</span>
<span id="cb18-12"><a href="#cb18-12" aria-hidden="true" tabindex="-1"></a>[ 2 5 7 ] [ 34 67 ] 1 [ 23 67 ] 9 [ 234 78 ] [ 56 8 ] [ 2 56 8 ] [ 2 56 8 ]</span>
<span id="cb18-13"><a href="#cb18-13" aria-hidden="true" tabindex="-1"></a>3 [1 6789] [ 67 9] 4 7 [ 5 7 9] 2 [ 56789] [1 56 89]</span>
<span id="cb18-14"><a href="#cb18-14" aria-hidden="true" tabindex="-1"></a>[ 2 789] 5 [ 2 4 67 9] 1 [ 23 7 ] [ 23 7 9] [ 6789] [ 34 6789] [ 34 6 89]</span>
<span id="cb18-15"><a href="#cb18-15" aria-hidden="true" tabindex="-1"></a>[12 7 9] [1 4 7 9] [ 2 4 7 9] 8 [ 23 7 ] 6 [1 5 7 9] [ 345 7 9] [1 345 9]</span>
<span id="cb18-16"><a href="#cb18-16" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGrid grid</span>
<span id="cb18-17"><a href="#cb18-17" aria-hidden="true" tabindex="-1"></a>6 . . . . . . 1 .</span>
<span id="cb18-18"><a href="#cb18-18" aria-hidden="true" tabindex="-1"></a>4 . . . . . . . .</span>
<span id="cb18-19"><a href="#cb18-19" aria-hidden="true" tabindex="-1"></a>. 2 . . . . . . .</span>
<span id="cb18-20"><a href="#cb18-20" aria-hidden="true" tabindex="-1"></a>. . . . 5 . 4 . 7</span>
<span id="cb18-21"><a href="#cb18-21" aria-hidden="true" tabindex="-1"></a>. . 8 . . . 3 . .</span>
<span id="cb18-22"><a href="#cb18-22" aria-hidden="true" tabindex="-1"></a>. . 1 . 9 . . . .</span>
<span id="cb18-23"><a href="#cb18-23" aria-hidden="true" tabindex="-1"></a>3 . . 4 . . 2 . .</span>
<span id="cb18-24"><a href="#cb18-24" aria-hidden="true" tabindex="-1"></a>. 5 . 1 . . . . .</span>
<span id="cb18-25"><a href="#cb18-25" aria-hidden="true" tabindex="-1"></a>. . . 8 . 6 . . .</span>
<span id="cb18-26"><a href="#cb18-26" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGrid grid'</span>
<span id="cb18-27"><a href="#cb18-27" aria-hidden="true" tabindex="-1"></a>6 . . . . . . 1 .</span>
<span id="cb18-28"><a href="#cb18-28" aria-hidden="true" tabindex="-1"></a>4 . . . . . . . .</span>
<span id="cb18-29"><a href="#cb18-29" aria-hidden="true" tabindex="-1"></a>. 2 . . . . . . .</span>
<span id="cb18-30"><a href="#cb18-30" aria-hidden="true" tabindex="-1"></a>. . . . 5 . 4 . 7</span>
<span id="cb18-31"><a href="#cb18-31" aria-hidden="true" tabindex="-1"></a>. . 8 . . . 3 . .</span>
<span id="cb18-32"><a href="#cb18-32" aria-hidden="true" tabindex="-1"></a>. . 1 . 9 . . . .</span>
<span id="cb18-33"><a href="#cb18-33" aria-hidden="true" tabindex="-1"></a>3 . . 4 7 . 2 . .</span>
<span id="cb18-34"><a href="#cb18-34" aria-hidden="true" tabindex="-1"></a>. 5 . 1 . . . . .</span>
<span id="cb18-35"><a href="#cb18-35" aria-hidden="true" tabindex="-1"></a>. . . 8 . 6 . . .</span></code></pre></div>
<p>We can clearly see the massive pruning of possibilities all around the grid. We also see a <code>7</code> pop up in the row-7-column-5 cell. This means that we can prune the grid further, until it settles. If you are familiar with Haskell, you may recognize this as trying to find a <a href="https://en.wikipedia.org/wiki/Fixed_point_%28mathematics%29" target="_blank" rel="noopener">fixed point</a> for the <code>pruneGrid'</code> function, except in a monadic context. It is simple to implement:</p>
<div class="sourceCode" id="cb19" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb19-1"><a href="#cb19-1" aria-hidden="true" tabindex="-1"></a><span class="ot">pruneGrid ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb19-2"><a href="#cb19-2" aria-hidden="true" tabindex="-1"></a>pruneGrid <span class="ot">=</span> fixM pruneGrid'</span>
<span id="cb19-3"><a href="#cb19-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb19-4"><a href="#cb19-4" aria-hidden="true" tabindex="-1"></a> fixM f x <span class="ot">=</span> f x <span class="op">>>=</span> \x' <span class="ot">-></span> <span class="kw">if</span> x' <span class="op">==</span> x <span class="kw">then</span> <span class="fu">return</span> x <span class="kw">else</span> fixM f x'</span></code></pre></div>
<p>The crux of this code is the <code>fixM</code> function. It takes a monadic function <code>f</code> and an initial value, and recursively calls itself till the return value settles. Let’s do another round in the <em>REPL</em>:</p>
<div class="sourceCode" id="cb20" data-lang="ghci"><pre class="sourceCode lhs numberSource small overflow"><code class="sourceCode literatehaskell"><span id="cb20-1"><a href="#cb20-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>{</span>
<span id="cb20-2"><a href="#cb20-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span></span>
<span id="cb20-3"><a href="#cb20-3" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> readGrid <span class="st">"6......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6..."</span></span>
<span id="cb20-4"><a href="#cb20-4" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>}</span>
<span id="cb20-5"><a href="#cb20-5" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid' <span class="ot">=</span> pruneGrid grid</span>
<span id="cb20-6"><a href="#cb20-6" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities grid'</span>
<span id="cb20-7"><a href="#cb20-7" aria-hidden="true" tabindex="-1"></a>6 [ 3 789] [ 3 5 7 9] [ 23 5 7 9] [ 234 8 ] [ 2345 789] [ 5 789] 1 [ 2345 89]</span>
<span id="cb20-8"><a href="#cb20-8" aria-hidden="true" tabindex="-1"></a>4 [1 3 789] [ 3 5 7 9] [ 23 567 9] [123 6 8 ] [123 5 789] [ 56789] [ 23 56789] [ 23 56 89]</span>
<span id="cb20-9"><a href="#cb20-9" aria-hidden="true" tabindex="-1"></a>[1 5 789] 2 [ 3 5 7 9] [ 3 567 9] [1 34 6 8 ] [1 345 789] [ 56789] [ 3456789] [ 3456 89]</span>
<span id="cb20-10"><a href="#cb20-10" aria-hidden="true" tabindex="-1"></a>[ 2 9] [ 3 6 9] [ 23 6 9] [ 23 6 ] 5 [123 8 ] 4 [ 2 6 89] 7</span>
<span id="cb20-11"><a href="#cb20-11" aria-hidden="true" tabindex="-1"></a>[ 2 5 7 9] [ 4 67 9] 8 [ 2 67 ] [12 4 6 ] [12 4 7 ] 3 [ 2 56 9] [12 56 9]</span>
<span id="cb20-12"><a href="#cb20-12" aria-hidden="true" tabindex="-1"></a>[ 2 5 7 ] [ 34 67 ] 1 [ 23 67 ] 9 [ 234 78 ] [ 56 8 ] [ 2 56 8 ] [ 2 56 8 ]</span>
<span id="cb20-13"><a href="#cb20-13" aria-hidden="true" tabindex="-1"></a>3 [1 6 89] [ 6 9] 4 7 [ 5 9] 2 [ 56 89] [1 56 89]</span>
<span id="cb20-14"><a href="#cb20-14" aria-hidden="true" tabindex="-1"></a>[ 2 789] 5 [ 2 4 67 9] 1 [ 23 ] [ 23 9] [ 6789] [ 34 6789] [ 34 6 89]</span>
<span id="cb20-15"><a href="#cb20-15" aria-hidden="true" tabindex="-1"></a>[12 7 9] [1 4 7 9] [ 2 4 7 9] 8 [ 23 ] 6 [1 5 7 9] [ 345 7 9] [1 345 9]</span></code></pre></div>
<p>We see that <code>7</code> in the row-7-column-5 cell is eliminated from all its neighboring cells. We can’t prune the grid anymore. Now it is time to make the choice.</p>
<h2 data-track-content data-content-name="making-the-choice" data-content-piece="fast-sudoku-solver-in-haskell-1" id="making-the-choice">Making the Choice</h2>
<p>One the grid is settled, we need to choose a non-fixed cell and make it fixed by assuming one of its possible values. This gives us two grids, next in the state-space of the solution search:</p>
<ul>
<li>one which has this chosen cell fixed to this chosen digit, and,</li>
<li>the other in which the chosen cell has all the other possibilities except the one we chose to fix.</li>
</ul>
<p>We call this function, <code>nextGrids</code>:</p>
<div class="sourceCode" id="cb21" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb21-1"><a href="#cb21-1" aria-hidden="true" tabindex="-1"></a><span class="ot">nextGrids ::</span> <span class="dt">Grid</span> <span class="ot">-></span> (<span class="dt">Grid</span>, <span class="dt">Grid</span>)</span>
<span id="cb21-2"><a href="#cb21-2" aria-hidden="true" tabindex="-1"></a>nextGrids grid <span class="ot">=</span></span>
<span id="cb21-3"><a href="#cb21-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> (i, first<span class="op">@</span>(<span class="dt">Fixed</span> _), rest) <span class="ot">=</span></span>
<span id="cb21-4"><a href="#cb21-4" aria-hidden="true" tabindex="-1"></a> fixCell</span>
<span id="cb21-5"><a href="#cb21-5" aria-hidden="true" tabindex="-1"></a> <span class="op">.</span> Data.List.minimumBy (<span class="fu">compare</span> <span class="ot">`Data.Function.on`</span> (possibilityCount <span class="op">.</span> <span class="fu">snd</span>))</span>
<span id="cb21-6"><a href="#cb21-6" aria-hidden="true" tabindex="-1"></a> <span class="op">.</span> <span class="fu">filter</span> (isPossible <span class="op">.</span> <span class="fu">snd</span>)</span>
<span id="cb21-7"><a href="#cb21-7" aria-hidden="true" tabindex="-1"></a> <span class="op">.</span> <span class="fu">zip</span> [<span class="dv">0</span><span class="op">..</span>]</span>
<span id="cb21-8"><a href="#cb21-8" aria-hidden="true" tabindex="-1"></a> <span class="op">.</span> <span class="fu">concat</span></span>
<span id="cb21-9"><a href="#cb21-9" aria-hidden="true" tabindex="-1"></a> <span class="op">$</span> grid</span>
<span id="cb21-10"><a href="#cb21-10" aria-hidden="true" tabindex="-1"></a> <span class="kw">in</span> (replace2D i first grid, replace2D i rest grid)</span>
<span id="cb21-11"><a href="#cb21-11" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb21-12"><a href="#cb21-12" aria-hidden="true" tabindex="-1"></a> isPossible (<span class="dt">Possible</span> _) <span class="ot">=</span> <span class="dt">True</span></span>
<span id="cb21-13"><a href="#cb21-13" aria-hidden="true" tabindex="-1"></a> isPossible _ <span class="ot">=</span> <span class="dt">False</span></span>
<span id="cb21-14"><a href="#cb21-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-15"><a href="#cb21-15" aria-hidden="true" tabindex="-1"></a> possibilityCount (<span class="dt">Possible</span> xs) <span class="ot">=</span> <span class="fu">length</span> xs</span>
<span id="cb21-16"><a href="#cb21-16" aria-hidden="true" tabindex="-1"></a> possibilityCount (<span class="dt">Fixed</span> _) <span class="ot">=</span> <span class="dv">1</span></span>
<span id="cb21-17"><a href="#cb21-17" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-18"><a href="#cb21-18" aria-hidden="true" tabindex="-1"></a> fixCell (i, <span class="dt">Possible</span> [x, y]) <span class="ot">=</span> (i, <span class="dt">Fixed</span> x, <span class="dt">Fixed</span> y)</span>
<span id="cb21-19"><a href="#cb21-19" aria-hidden="true" tabindex="-1"></a> fixCell (i, <span class="dt">Possible</span> (x<span class="op">:</span>xs)) <span class="ot">=</span> (i, <span class="dt">Fixed</span> x, <span class="dt">Possible</span> xs)</span>
<span id="cb21-20"><a href="#cb21-20" aria-hidden="true" tabindex="-1"></a> fixCell _ <span class="ot">=</span> <span class="fu">error</span> <span class="st">"Impossible case"</span></span>
<span id="cb21-21"><a href="#cb21-21" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-22"><a href="#cb21-22" aria-hidden="true" tabindex="-1"></a><span class="ot"> replace2D ::</span> <span class="dt">Int</span> <span class="ot">-></span> a <span class="ot">-></span> [[a]] <span class="ot">-></span> [[a]]</span>
<span id="cb21-23"><a href="#cb21-23" aria-hidden="true" tabindex="-1"></a> replace2D i v <span class="ot">=</span></span>
<span id="cb21-24"><a href="#cb21-24" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> (x, y) <span class="ot">=</span> (i <span class="ot">`quot`</span> <span class="dv">9</span>, i <span class="ot">`mod`</span> <span class="dv">9</span>) <span class="kw">in</span> replace x (replace y (<span class="fu">const</span> v))</span>
<span id="cb21-25"><a href="#cb21-25" aria-hidden="true" tabindex="-1"></a> replace p f xs <span class="ot">=</span> [<span class="kw">if</span> i <span class="op">==</span> p <span class="kw">then</span> f x <span class="kw">else</span> x <span class="op">|</span> (x, i) <span class="ot"><-</span> <span class="fu">zip</span> xs [<span class="dv">0</span><span class="op">..</span>]]</span></code></pre></div>
<p>We choose the non-fixed cell with least count of possibilities as the pivot. This strategy make sense intuitively, as with a cell with fewest possibilities, we have the most chance of being right when assuming one. Fixing a non-fixed cell leads to one of the two cases:</p>
<ol type="a">
<li>the cell has only two possible values, resulting in two fixed cells, or,</li>
<li>the cell has more than two possible values, resulting in one fixed and one non-fixed cell.</li>
</ol>
<p>Then all we are left with is replacing the non-fixed cell with its fixed and fixed/non-fixed choices, which we do with some math and some list traversal. A quick check on the <em>REPL</em>:</p>
<div class="sourceCode" id="cb22" data-lang="ghci"><pre class="sourceCode lhs numberSource small overflow"><code class="sourceCode literatehaskell"><span id="cb22-1"><a href="#cb22-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>{</span>
<span id="cb22-2"><a href="#cb22-2" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span></span>
<span id="cb22-3"><a href="#cb22-3" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> readGrid <span class="st">"6......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6..."</span></span>
<span id="cb22-4"><a href="#cb22-4" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="op">:</span>}</span>
<span id="cb22-5"><a href="#cb22-5" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid' <span class="ot">=</span> pruneGrid grid</span>
<span id="cb22-6"><a href="#cb22-6" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities grid'</span>
<span id="cb22-7"><a href="#cb22-7" aria-hidden="true" tabindex="-1"></a>6 [ 3 789] [ 3 5 7 9] [ 23 5 7 9] [ 234 8 ] [ 2345 789] [ 5 789] 1 [ 2345 89]</span>
<span id="cb22-8"><a href="#cb22-8" aria-hidden="true" tabindex="-1"></a>4 [1 3 789] [ 3 5 7 9] [ 23 567 9] [123 6 8 ] [123 5 789] [ 56789] [ 23 56789] [ 23 56 89]</span>
<span id="cb22-9"><a href="#cb22-9" aria-hidden="true" tabindex="-1"></a>[1 5 789] 2 [ 3 5 7 9] [ 3 567 9] [1 34 6 8 ] [1 345 789] [ 56789] [ 3456789] [ 3456 89]</span>
<span id="cb22-10"><a href="#cb22-10" aria-hidden="true" tabindex="-1"></a>[ 2 9] [ 3 6 9] [ 23 6 9] [ 23 6 ] 5 [123 8 ] 4 [ 2 6 89] 7</span>
<span id="cb22-11"><a href="#cb22-11" aria-hidden="true" tabindex="-1"></a>[ 2 5 7 9] [ 4 67 9] 8 [ 2 67 ] [12 4 6 ] [12 4 7 ] 3 [ 2 56 9] [12 56 9]</span>
<span id="cb22-12"><a href="#cb22-12" aria-hidden="true" tabindex="-1"></a>[ 2 5 7 ] [ 34 67 ] 1 [ 23 67 ] 9 [ 234 78 ] [ 56 8 ] [ 2 56 8 ] [ 2 56 8 ]</span>
<span id="cb22-13"><a href="#cb22-13" aria-hidden="true" tabindex="-1"></a>3 [1 6 89] [ 6 9] 4 7 [ 5 9] 2 [ 56 89] [1 56 89]</span>
<span id="cb22-14"><a href="#cb22-14" aria-hidden="true" tabindex="-1"></a>[ 2 789] 5 [ 2 4 67 9] 1 [ 23 ] [ 23 9] [ 6789] [ 34 6789] [ 34 6 89]</span>
<span id="cb22-15"><a href="#cb22-15" aria-hidden="true" tabindex="-1"></a>[12 7 9] [1 4 7 9] [ 2 4 7 9] 8 [ 23 ] 6 [1 5 7 9] [ 345 7 9] [1 345 9]</span>
<span id="cb22-16"><a href="#cb22-16" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="co">-- the row-4-column-1 cell is the first cell with only two possibilities, [2, 9].</span></span>
<span id="cb22-17"><a href="#cb22-17" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="co">-- it is chosen as the pivot cell to find the next grids.</span></span>
<span id="cb22-18"><a href="#cb22-18" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> (grid1, grid2) <span class="ot">=</span> nextGrids grid'</span>
<span id="cb22-19"><a href="#cb22-19" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities grid1</span>
<span id="cb22-20"><a href="#cb22-20" aria-hidden="true" tabindex="-1"></a>6 [ 3 789] [ 3 5 7 9] [ 23 5 7 9] [ 234 8 ] [ 2345 789] [ 5 789] 1 [ 2345 89]</span>
<span id="cb22-21"><a href="#cb22-21" aria-hidden="true" tabindex="-1"></a>4 [1 3 789] [ 3 5 7 9] [ 23 567 9] [123 6 8 ] [123 5 789] [ 56789] [ 23 56789] [ 23 56 89]</span>
<span id="cb22-22"><a href="#cb22-22" aria-hidden="true" tabindex="-1"></a>[1 5 789] 2 [ 3 5 7 9] [ 3 567 9] [1 34 6 8 ] [1 345 789] [ 56789] [ 3456789] [ 3456 89]</span>
<span id="cb22-23"><a href="#cb22-23" aria-hidden="true" tabindex="-1"></a>2 [ 3 6 9] [ 23 6 9] [ 23 6 ] 5 [123 8 ] 4 [ 2 6 89] 7</span>
<span id="cb22-24"><a href="#cb22-24" aria-hidden="true" tabindex="-1"></a>[ 2 5 7 9] [ 4 67 9] 8 [ 2 67 ] [12 4 6 ] [12 4 7 ] 3 [ 2 56 9] [12 56 9]</span>
<span id="cb22-25"><a href="#cb22-25" aria-hidden="true" tabindex="-1"></a>[ 2 5 7 ] [ 34 67 ] 1 [ 23 67 ] 9 [ 234 78 ] [ 56 8 ] [ 2 56 8 ] [ 2 56 8 ]</span>
<span id="cb22-26"><a href="#cb22-26" aria-hidden="true" tabindex="-1"></a>3 [1 6 89] [ 6 9] 4 7 [ 5 9] 2 [ 56 89] [1 56 89]</span>
<span id="cb22-27"><a href="#cb22-27" aria-hidden="true" tabindex="-1"></a>[ 2 789] 5 [ 2 4 67 9] 1 [ 23 ] [ 23 9] [ 6789] [ 34 6789] [ 34 6 89]</span>
<span id="cb22-28"><a href="#cb22-28" aria-hidden="true" tabindex="-1"></a>[12 7 9] [1 4 7 9] [ 2 4 7 9] 8 [ 23 ] 6 [1 5 7 9] [ 345 7 9] [1 345 9]</span>
<span id="cb22-29"><a href="#cb22-29" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGridWithPossibilities grid2</span>
<span id="cb22-30"><a href="#cb22-30" aria-hidden="true" tabindex="-1"></a>6 [ 3 789] [ 3 5 7 9] [ 23 5 7 9] [ 234 8 ] [ 2345 789] [ 5 789] 1 [ 2345 89]</span>
<span id="cb22-31"><a href="#cb22-31" aria-hidden="true" tabindex="-1"></a>4 [1 3 789] [ 3 5 7 9] [ 23 567 9] [123 6 8 ] [123 5 789] [ 56789] [ 23 56789] [ 23 56 89]</span>
<span id="cb22-32"><a href="#cb22-32" aria-hidden="true" tabindex="-1"></a>[1 5 789] 2 [ 3 5 7 9] [ 3 567 9] [1 34 6 8 ] [1 345 789] [ 56789] [ 3456789] [ 3456 89]</span>
<span id="cb22-33"><a href="#cb22-33" aria-hidden="true" tabindex="-1"></a>9 [ 3 6 9] [ 23 6 9] [ 23 6 ] 5 [123 8 ] 4 [ 2 6 89] 7</span>
<span id="cb22-34"><a href="#cb22-34" aria-hidden="true" tabindex="-1"></a>[ 2 5 7 9] [ 4 67 9] 8 [ 2 67 ] [12 4 6 ] [12 4 7 ] 3 [ 2 56 9] [12 56 9]</span>
<span id="cb22-35"><a href="#cb22-35" aria-hidden="true" tabindex="-1"></a>[ 2 5 7 ] [ 34 67 ] 1 [ 23 67 ] 9 [ 234 78 ] [ 56 8 ] [ 2 56 8 ] [ 2 56 8 ]</span>
<span id="cb22-36"><a href="#cb22-36" aria-hidden="true" tabindex="-1"></a>3 [1 6 89] [ 6 9] 4 7 [ 5 9] 2 [ 56 89] [1 56 89]</span>
<span id="cb22-37"><a href="#cb22-37" aria-hidden="true" tabindex="-1"></a>[ 2 789] 5 [ 2 4 67 9] 1 [ 23 ] [ 23 9] [ 6789] [ 34 6789] [ 34 6 89]</span>
<span id="cb22-38"><a href="#cb22-38" aria-hidden="true" tabindex="-1"></a>[12 7 9] [1 4 7 9] [ 2 4 7 9] 8 [ 23 ] 6 [1 5 7 9] [ 345 7 9] [1 345 9]</span></code></pre></div>
<h2 data-track-content data-content-name="solving-the-puzzle" data-content-piece="fast-sudoku-solver-in-haskell-1" id="solving-the-puzzle">Solving the Puzzle</h2>
<p>We have implemented parts of our algorithm till now. Now we’ll put everything together to solve the puzzle. First, we need to know if we are done or have messed up:</p>
<div class="sourceCode" id="cb23" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb23-1"><a href="#cb23-1" aria-hidden="true" tabindex="-1"></a><span class="ot">isGridFilled ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">Bool</span></span>
<span id="cb23-2"><a href="#cb23-2" aria-hidden="true" tabindex="-1"></a>isGridFilled grid <span class="ot">=</span> <span class="fu">null</span> [ () <span class="op">|</span> <span class="dt">Possible</span> _ <span class="ot"><-</span> <span class="fu">concat</span> grid ]</span>
<span id="cb23-3"><a href="#cb23-3" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb23-4"><a href="#cb23-4" aria-hidden="true" tabindex="-1"></a><span class="ot">isGridInvalid ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">Bool</span></span>
<span id="cb23-5"><a href="#cb23-5" aria-hidden="true" tabindex="-1"></a>isGridInvalid grid <span class="ot">=</span></span>
<span id="cb23-6"><a href="#cb23-6" aria-hidden="true" tabindex="-1"></a> <span class="fu">any</span> isInvalidRow grid</span>
<span id="cb23-7"><a href="#cb23-7" aria-hidden="true" tabindex="-1"></a> <span class="op">||</span> <span class="fu">any</span> isInvalidRow (Data.List.transpose grid)</span>
<span id="cb23-8"><a href="#cb23-8" aria-hidden="true" tabindex="-1"></a> <span class="op">||</span> <span class="fu">any</span> isInvalidRow (subGridsToRows grid)</span>
<span id="cb23-9"><a href="#cb23-9" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb23-10"><a href="#cb23-10" aria-hidden="true" tabindex="-1"></a> isInvalidRow row <span class="ot">=</span></span>
<span id="cb23-11"><a href="#cb23-11" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> fixeds <span class="ot">=</span> [x <span class="op">|</span> <span class="dt">Fixed</span> x <span class="ot"><-</span> row]</span>
<span id="cb23-12"><a href="#cb23-12" aria-hidden="true" tabindex="-1"></a> emptyPossibles <span class="ot">=</span> [x <span class="op">|</span> <span class="dt">Possible</span> x <span class="ot"><-</span> row, <span class="fu">null</span> x]</span>
<span id="cb23-13"><a href="#cb23-13" aria-hidden="true" tabindex="-1"></a> <span class="kw">in</span> hasDups fixeds <span class="op">||</span> <span class="fu">not</span> (<span class="fu">null</span> emptyPossibles)</span>
<span id="cb23-14"><a href="#cb23-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb23-15"><a href="#cb23-15" aria-hidden="true" tabindex="-1"></a> hasDups l <span class="ot">=</span> hasDups' l []</span>
<span id="cb23-16"><a href="#cb23-16" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb23-17"><a href="#cb23-17" aria-hidden="true" tabindex="-1"></a> hasDups' [] _ <span class="ot">=</span> <span class="dt">False</span></span>
<span id="cb23-18"><a href="#cb23-18" aria-hidden="true" tabindex="-1"></a> hasDups' (y<span class="op">:</span>ys) xs</span>
<span id="cb23-19"><a href="#cb23-19" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> y <span class="ot">`elem`</span> xs <span class="ot">=</span> <span class="dt">True</span></span>
<span id="cb23-20"><a href="#cb23-20" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> hasDups' ys (y<span class="op">:</span>xs)</span></code></pre></div>
<p><code>isGridFilled</code> returns whether a grid is filled completely by checking it for any <code>Possible</code> cells. <code>isGridInvalid</code> checks if a grid is invalid because it either has duplicate fixed cells in any block or has any non-fixed cell with no possibilities.</p>
<p>Writing the <code>solve</code> function is almost trivial now:</p>
<div class="sourceCode" id="cb24" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb24-1"><a href="#cb24-1" aria-hidden="true" tabindex="-1"></a><span class="ot">solve ::</span> <span class="dt">Grid</span> <span class="ot">-></span> <span class="dt">Maybe</span> <span class="dt">Grid</span></span>
<span id="cb24-2"><a href="#cb24-2" aria-hidden="true" tabindex="-1"></a>solve grid <span class="ot">=</span> pruneGrid grid <span class="op">>>=</span> solve'</span>
<span id="cb24-3"><a href="#cb24-3" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb24-4"><a href="#cb24-4" aria-hidden="true" tabindex="-1"></a> solve' g</span>
<span id="cb24-5"><a href="#cb24-5" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> isGridInvalid g <span class="ot">=</span> <span class="dt">Nothing</span></span>
<span id="cb24-6"><a href="#cb24-6" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> isGridFilled g <span class="ot">=</span> <span class="dt">Just</span> g</span>
<span id="cb24-7"><a href="#cb24-7" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span></span>
<span id="cb24-8"><a href="#cb24-8" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> (grid1, grid2) <span class="ot">=</span> nextGrids g</span>
<span id="cb24-9"><a href="#cb24-9" aria-hidden="true" tabindex="-1"></a> <span class="kw">in</span> solve grid1 <span class="op"><|></span> solve grid2</span></code></pre></div>
<p>We prune the grid as before and pipe it to the helper function <code>solve'</code>. <code>solve'</code> bails with a <code>Nothing</code> if the grid is invalid, or returns the solved grid if it is filled completely. Otherwise, it finds the next two grids in the search tree and solves them recursively with backtracking by calling the <code>solve</code> function. Backtracking here is implemented by the using the <a href="https://hackage.haskell.org/package/base-4.11.1.0/docs/Control-Applicative.html#g:2" target="_blank" rel="noopener"><code>Alternative</code></a> (<code><|></code>) implementation of the <code>Maybe</code> type<a href="#fn2" class="footnote-ref" id="fnref2" role="doc-noteref"><sup>2</sup></a>. It takes the second branch in the computation if the first branch returns a <code>Nothing</code>.</p>
<p>Whew! That took us long. Let’s put it to the final test now:</p>
<div class="sourceCode" id="cb26" data-lang="ghci"><pre class="sourceCode lhs numberSource"><code class="sourceCode literatehaskell"><span id="cb26-1"><a href="#cb26-1" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid <span class="ot">=</span></span>
<span id="cb26-2"><a href="#cb26-2" aria-hidden="true" tabindex="-1"></a> readGrid "6......1.4.........2...........5.4.7..8...3....1.9....3..4..2...5.1........8.6..."</span>
<span id="cb26-3"><a href="#cb26-3" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGrid grid</span>
<span id="cb26-4"><a href="#cb26-4" aria-hidden="true" tabindex="-1"></a>6 . . . . . . 1 .</span>
<span id="cb26-5"><a href="#cb26-5" aria-hidden="true" tabindex="-1"></a>4 . . . . . . . .</span>
<span id="cb26-6"><a href="#cb26-6" aria-hidden="true" tabindex="-1"></a>. 2 . . . . . . .</span>
<span id="cb26-7"><a href="#cb26-7" aria-hidden="true" tabindex="-1"></a>. . . . 5 . 4 . 7</span>
<span id="cb26-8"><a href="#cb26-8" aria-hidden="true" tabindex="-1"></a>. . 8 . . . 3 . .</span>
<span id="cb26-9"><a href="#cb26-9" aria-hidden="true" tabindex="-1"></a>. . 1 . 9 . . . .</span>
<span id="cb26-10"><a href="#cb26-10" aria-hidden="true" tabindex="-1"></a>3 . . 4 . . 2 . .</span>
<span id="cb26-11"><a href="#cb26-11" aria-hidden="true" tabindex="-1"></a>. 5 . 1 . . . . .</span>
<span id="cb26-12"><a href="#cb26-12" aria-hidden="true" tabindex="-1"></a>. . . 8 . 6 . . .</span>
<span id="cb26-13"><a href="#cb26-13" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="dt">Just</span> grid' <span class="ot">=</span> solve grid</span>
<span id="cb26-14"><a href="#cb26-14" aria-hidden="true" tabindex="-1"></a><span class="ot">></span> <span class="fu">putStr</span> <span class="op">$</span> showGrid grid'</span>
<span id="cb26-15"><a href="#cb26-15" aria-hidden="true" tabindex="-1"></a>6 9 3 7 8 4 5 1 2</span>
<span id="cb26-16"><a href="#cb26-16" aria-hidden="true" tabindex="-1"></a>4 8 7 5 1 2 9 3 6</span>
<span id="cb26-17"><a href="#cb26-17" aria-hidden="true" tabindex="-1"></a>1 2 5 9 6 3 8 7 4</span>
<span id="cb26-18"><a href="#cb26-18" aria-hidden="true" tabindex="-1"></a>9 3 2 6 5 1 4 8 7</span>
<span id="cb26-19"><a href="#cb26-19" aria-hidden="true" tabindex="-1"></a>5 6 8 2 4 7 3 9 1</span>
<span id="cb26-20"><a href="#cb26-20" aria-hidden="true" tabindex="-1"></a>7 4 1 3 9 8 6 2 5</span>
<span id="cb26-21"><a href="#cb26-21" aria-hidden="true" tabindex="-1"></a>3 1 9 4 7 5 2 6 8</span>
<span id="cb26-22"><a href="#cb26-22" aria-hidden="true" tabindex="-1"></a>8 5 6 1 2 9 7 4 3</span>
<span id="cb26-23"><a href="#cb26-23" aria-hidden="true" tabindex="-1"></a>2 7 4 8 3 6 1 5 9</span></code></pre></div>
<p>It works! Let’s put a quick <code>main</code> wrapper around <code>solve</code> to call it from the command line:</p>
<div class="sourceCode" id="cb27" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb27-1"><a href="#cb27-1" aria-hidden="true" tabindex="-1"></a><span class="ot">main ::</span> <span class="dt">IO</span> ()</span>
<span id="cb27-2"><a href="#cb27-2" aria-hidden="true" tabindex="-1"></a>main <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb27-3"><a href="#cb27-3" aria-hidden="true" tabindex="-1"></a> inputs <span class="ot"><-</span> <span class="fu">lines</span> <span class="op"><$></span> <span class="fu">getContents</span></span>
<span id="cb27-4"><a href="#cb27-4" aria-hidden="true" tabindex="-1"></a> Control.Monad.forM_ inputs <span class="op">$</span> \input <span class="ot">-></span></span>
<span id="cb27-5"><a href="#cb27-5" aria-hidden="true" tabindex="-1"></a> <span class="kw">case</span> readGrid input <span class="kw">of</span></span>
<span id="cb27-6"><a href="#cb27-6" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="fu">putStrLn</span> <span class="st">"Invalid input"</span></span>
<span id="cb27-7"><a href="#cb27-7" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> grid <span class="ot">-></span> <span class="kw">case</span> solve grid <span class="kw">of</span></span>
<span id="cb27-8"><a href="#cb27-8" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="fu">putStrLn</span> <span class="st">"No solution found"</span></span>
<span id="cb27-9"><a href="#cb27-9" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> grid' <span class="ot">-></span> <span class="fu">putStrLn</span> <span class="op">$</span> showGrid grid'</span></code></pre></div>
<p>And now, we can invoke it from the command line:</p>
<pre class="plain"><code>$ echo ".......12.5.4............3.7..6..4....1..........8....92....8.....51.7.......3..." | stack exec sudoku
3 6 4 9 7 8 5 1 2
1 5 2 4 3 6 9 7 8
8 7 9 1 2 5 6 3 4
7 3 8 6 5 1 4 2 9
6 9 1 2 4 7 3 8 5
2 4 5 3 8 9 1 6 7
9 2 3 7 6 4 8 5 1
4 8 6 5 1 2 7 9 3
5 1 7 8 9 3 2 4 6</code></pre>
<p>And, we are done.</p>
<p>If you want to play with different puzzles, the file <a href="https://abhinavsarkar.net/files/sudoku17.txt.bz2?mtm_campaign=feed">here</a> lists some of the toughest ones. Let’s run<a href="#fn3" class="footnote-ref" id="fnref3" role="doc-noteref"><sup>3</sup></a> some of them through our program to see how fast it is:</p>
<pre class="plain"><code>$ head -n100 sudoku17.txt | time stack exec sudoku
... output omitted ...
116.70 real 198.09 user 94.46 sys</code></pre>
<p>It took about 117 seconds to solve a hundred puzzles, so, about 1.2 seconds per puzzle. This is pretty slow but we’ll get around to making it faster in the subsequent posts.</p>
<h2 data-track-content data-content-name="conclusion" data-content-piece="fast-sudoku-solver-in-haskell-1" id="conclusion">Conclusion</h2>
<p>In this rather verbose article, we learned how to write a simple Sudoku solver in Haskell step-by-step. In the later parts of this series, we’ll delve into profiling the solution and figuring out better algorithms and data structures to solve Sudoku more efficiently. The code till now is available <a href="https://code.abhinavsarkar.net/abhin4v/hasdoku/src/commit/0ef77341a10fcc25926301ee47b931d92959c0fa?mtm_campaign=feed" target="_blank" rel="noopener">here</a>.</p>
<section id="footnotes" class="footnotes footnotes-end-of-document" role="doc-endnotes">
<hr></hr>
<ol>
<li id="fn1"><p>This exercise was originally done as a part of <a href="https://github.com/pratul/haskell-classes/" target="_blank" rel="noopener">the</a> <a href="https://github.com/ford-prefect/haskell-classes/" target="_blank" rel="noopener">Haskell</a> <a href="https://github.com/bnvinay92/haskell-classes/" target="_blank" rel="noopener">classes</a> I taught at <a href="https://nilenso.com" target="_blank" rel="noopener">nilenso</a>.<a href="#fnref1" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
<li id="fn2"><p><code>Alternative</code> implementation of <code>Maybe</code>:</p>
<div class="sourceCode" id="cb25" data-lang="haskell"><pre class="sourceCode numberSource haskell"><code class="sourceCode haskell"><span id="cb25-1"><a href="#cb25-1" aria-hidden="true" tabindex="-1"></a><span class="kw">instance</span> <span class="dt">Alternative</span> <span class="dt">Maybe</span> <span class="kw">where</span></span>
<span id="cb25-2"><a href="#cb25-2" aria-hidden="true" tabindex="-1"></a> empty <span class="ot">=</span> <span class="dt">Nothing</span></span>
<span id="cb25-3"><a href="#cb25-3" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="op"><|></span> r <span class="ot">=</span> r</span>
<span id="cb25-4"><a href="#cb25-4" aria-hidden="true" tabindex="-1"></a> l <span class="op"><|></span> _ <span class="ot">=</span> l</span></code></pre></div>
<a href="#fnref2" class="footnote-back" role="doc-backlink">↩︎</a></li>
<li id="fn3"><p>All the runs were done on my MacBook Pro from 2014 with 2.2 GHz Intel Core i7 CPU and 16 GB memory.<a href="#fnref3" class="footnote-back" role="doc-backlink">↩︎</a></p></li>
</ol>
</section><p>If you liked this post, please <a href="https://abhinavsarkar.net/posts/fast-sudoku-solver-in-haskell-1/?mtm_campaign=feed#syndications">leave a comment</a>.</p><img referrerpolicy="no-referrer-when-downgrade" src="https://anna.abhinavsarkar.net/matomo.php?idsite=1&rec=1" style="border:0" alt="" />2018-06-28T00:00:00Z<p><a href="https://en.wikipedia.org/wiki/Sudoku" target="_blank" rel="noopener">Sudoku</a> is a number placement puzzle. It consists of a 9x9 grid which is to be filled with digits from 1 to 9. Some of the cells of the grid come pre-filled and the player has to fill the rest.</p>
<p><a href="https://www.haskell.org/" target="_blank" rel="noopener">Haskell</a> is a purely functional programming language. It is a good choice to solve Sudoku given the problem’s <a href="https://en.wikipedia.org/wiki/Combinatorics" target="_blank" rel="noopener">combinatorial</a> nature. The aim of this series of posts is to write a <strong>fast</strong> Sudoku solver in Haskell. We’ll focus on both implementing the solution and making it efficient, step-by-step, starting with a slow but simple solution in this post<a href="#fn1" class="footnote-ref" id="fnref1" role="doc-noteref"><sup>1</sup></a>.</p>
https://abhinavsarkar.net/posts/ps-simple-rest-service-2/Writing a Simple REST Web Service in PureScript—Part 22017-10-01T00:00:00ZAbhinav Sarkarhttps://abhinavsarkar.net/about/abhinav@abhinavsarkar.net<p>To recap, in the <a href="https://abhinavsarkar.net/posts/ps-simple-rest-service/?mtm_campaign=feed">first</a> part of this two-part tutorial, we built a simple JSON <a href="https://en.wikipedia.org/wiki/REST" target="_blank" rel="noopener">REST</a> web service in <a href="http://purescript.org" target="_blank" rel="noopener">PureScript</a> to create, update, get, list and delete users, backed by a Postgres database. In this part we’ll work on the rest of the features. <p>This post was originally published on <a href="https://abhinavsarkar.net/posts/ps-simple-rest-service-2/?mtm_campaign=feed">abhinavsarkar.net</a>.</p><!--more--> The requirements are:</p>
<ol type="1">
<li>validation of API requests.</li>
<li>reading the server and database configs from environment variables.</li>
<li>logging HTTP requests and debugging info.</li>
</ol>
<nav id="toc" class="right-toc"><h3>Contents</h3><ol><li><a href="#bugs">Bugs!</a></li><li><a href="#validation">Validation</a></li><li><a href="#configuration">Configuration</a></li><li><a href="#logging">Logging</a></li><li><a href="#conclusion">Conclusion</a></li></ol></nav>
<p>But first,</p>
<h2 data-track-content data-content-name="bugs" data-content-piece="ps-simple-rest-service-2" id="bugs">Bugs!</h2>
<p>What happens if we hit a URL on our server which does not exist? Let’s fire up the server and test it:</p>
<pre class="plain"><code>$ pulp --watch run</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/random
HTTP/1.1 404 Not Found
Connection: keep-alive
Content-Length: 148
Content-Security-Policy: default-src 'self'
Content-Type: text/html; charset=utf-8
Date: Sat, 30 Sep 2017 08:23:20 GMT
X-Content-Type-Options: nosniff
X-Powered-By: Express
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Error</title>
</head>
<body>
<pre>Cannot GET /v1/random</pre>
</body>
</html></code></pre>
<p>We get back a default HTML response with a 404 status from <a href="https://expressjs.com" target="_blank" rel="noopener">Express</a>. Since we are writing a JSON API, we should return a JSON response in this case too. We add the following code in the <code>src/SimpleService/Server.purs</code> file to add a catch-all route and send a 404 status with a JSON error message:</p>
<div class="sourceCode" id="cb3" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb3-1"><a href="#cb3-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb3-2"><a href="#cb3-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Either</span> (fromRight)</span>
<span id="cb3-3"><a href="#cb3-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.String.Regex</span> (<span class="dt">Regex</span>, regex) <span class="kw">as</span> <span class="dt">Re</span></span>
<span id="cb3-4"><a href="#cb3-4" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.String.Regex.Flags</span> (noFlags) <span class="kw">as</span> <span class="dt">Re</span></span>
<span id="cb3-5"><a href="#cb3-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.App</span> (<span class="dt">App</span>, all, delete, get, http, listenHttp, post, useExternal)</span>
<span id="cb3-6"><a href="#cb3-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Response</span> (sendJson, setStatus)</span>
<span id="cb3-7"><a href="#cb3-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Partial.Unsafe</span> (unsafePartial)</span>
<span id="cb3-8"><a href="#cb3-8" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb3-9"><a href="#cb3-9" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-10"><a href="#cb3-10" aria-hidden="true" tabindex="-1"></a><span class="ot">allRoutePattern ::</span> <span class="dt">Re.Regex</span></span>
<span id="cb3-11"><a href="#cb3-11" aria-hidden="true" tabindex="-1"></a>allRoutePattern <span class="ot">=</span> unsafePartial <span class="op">$</span> fromRight <span class="op">$</span> Re.regex <span class="st">"/.*"</span> Re.noFlags</span>
<span id="cb3-12"><a href="#cb3-12" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-13"><a href="#cb3-13" aria-hidden="true" tabindex="-1"></a><span class="ot">app ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">App</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb3-14"><a href="#cb3-14" aria-hidden="true" tabindex="-1"></a>app pool <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb3-15"><a href="#cb3-15" aria-hidden="true" tabindex="-1"></a> useExternal jsonBodyParser</span>
<span id="cb3-16"><a href="#cb3-16" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-17"><a href="#cb3-17" aria-hidden="true" tabindex="-1"></a> get <span class="st">"/v1/user/:id"</span> <span class="op">$</span> getUser pool</span>
<span id="cb3-18"><a href="#cb3-18" aria-hidden="true" tabindex="-1"></a> delete <span class="st">"/v1/user/:id"</span> <span class="op">$</span> deleteUser pool</span>
<span id="cb3-19"><a href="#cb3-19" aria-hidden="true" tabindex="-1"></a> post <span class="st">"/v1/users"</span> <span class="op">$</span> createUser pool</span>
<span id="cb3-20"><a href="#cb3-20" aria-hidden="true" tabindex="-1"></a> patch <span class="st">"/v1/user/:id"</span> <span class="op">$</span> updateUser pool</span>
<span id="cb3-21"><a href="#cb3-21" aria-hidden="true" tabindex="-1"></a> get <span class="st">"/v1/users"</span> <span class="op">$</span> listUsers pool</span>
<span id="cb3-22"><a href="#cb3-22" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-23"><a href="#cb3-23" aria-hidden="true" tabindex="-1"></a> <span class="fu">all</span> allRoutePattern <span class="kw">do</span></span>
<span id="cb3-24"><a href="#cb3-24" aria-hidden="true" tabindex="-1"></a> setStatus <span class="dv">404</span></span>
<span id="cb3-25"><a href="#cb3-25" aria-hidden="true" tabindex="-1"></a> sendJson {<span class="fu">error</span><span class="op">:</span> <span class="st">"Route not found"</span>}</span>
<span id="cb3-26"><a href="#cb3-26" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb3-27"><a href="#cb3-27" aria-hidden="true" tabindex="-1"></a> patch <span class="ot">=</span> http (<span class="dt">CustomMethod</span> <span class="st">"patch"</span>)</span></code></pre></div>
<p><code>allRoutePattern</code> matches all routes because it uses a <code>"/.*"</code> <a href="https://en.wikipedia.org/wiki/Regular_expression" target="_blank" rel="noopener">regular expression</a>. We place it as the last route to match all the otherwise unrouted requests. Let’s see what is the result:</p>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/random
HTTP/1.1 404 Not Found
Connection: keep-alive
Content-Length: 27
Content-Type: application/json; charset=utf-8
Date: Sat, 30 Sep 2017 08:46:46 GMT
ETag: W/"1b-772e0u4nrE48ogbR0KmKfSvrHUE"
X-Powered-By: Express
{
"error": "Route not found"
}</code></pre>
<p>Now we get a nicely formatted JSON response.</p>
<p>Another scenario is when our application throws some uncaught error. To simulate this, we shut down our postgres database and hit the server for listing users:</p>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/users
HTTP/1.1 500 Internal Server Error
Connection: keep-alive
Content-Length: 372
Content-Security-Policy: default-src 'self'
Content-Type: text/html; charset=utf-8
Date: Sat, 30 Sep 2017 08:53:40 GMT
X-Content-Type-Options: nosniff
X-Powered-By: Express
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Error</title>
</head>
<body>
<pre>Error: connect ECONNREFUSED 127.0.0.1:5432<br> &nbsp; &nbsp;at Object._errnoException (util.js:1026:11)<br> &nbsp; &nbsp;at _exceptionWithHostPort (util.js:1049:20)<br> &nbsp; &nbsp;at TCPConnectWrap.afterConnect [as oncomplete] (net.js:1174:14)</pre>
</body>
</html></code></pre>
<p>We get another default HTML response from Express with a 500 status. Again, in this case we’d like to return a JSON response. We add the following code to the <code>src/SimpleService/Server.purs</code> file:</p>
<div class="sourceCode" id="cb6" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb6-1"><a href="#cb6-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb6-2"><a href="#cb6-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff.Exception</span> (message)</span>
<span id="cb6-3"><a href="#cb6-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.App</span> (<span class="dt">App</span>, all, delete, get, http, listenHttp, post, useExternal, useOnError)</span>
<span id="cb6-4"><a href="#cb6-4" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb6-5"><a href="#cb6-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb6-6"><a href="#cb6-6" aria-hidden="true" tabindex="-1"></a><span class="ot">app ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">App</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb6-7"><a href="#cb6-7" aria-hidden="true" tabindex="-1"></a>app pool <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb6-8"><a href="#cb6-8" aria-hidden="true" tabindex="-1"></a> <span class="co">-- previous code</span></span>
<span id="cb6-9"><a href="#cb6-9" aria-hidden="true" tabindex="-1"></a> useOnError \err <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb6-10"><a href="#cb6-10" aria-hidden="true" tabindex="-1"></a> setStatus <span class="dv">500</span></span>
<span id="cb6-11"><a href="#cb6-11" aria-hidden="true" tabindex="-1"></a> sendJson {<span class="fu">error</span><span class="op">:</span> message err}</span>
<span id="cb6-12"><a href="#cb6-12" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb6-13"><a href="#cb6-13" aria-hidden="true" tabindex="-1"></a> patch <span class="ot">=</span> http (<span class="dt">CustomMethod</span> <span class="st">"patch"</span>)</span></code></pre></div>
<p>We add the <code>useOnError</code> handler which comes with <a href="https://pursuit.purescript.org/packages/purescript-express" target="_blank" rel="noopener"><code>purescript-express</code></a> to return the error message as a JSON response. Back on the command-line:</p>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/users
HTTP/1.1 500 Internal Server Error
Connection: keep-alive
Content-Length: 47
Content-Type: application/json; charset=utf-8
Date: Sat, 30 Sep 2017 09:01:37 GMT
ETag: W/"2f-cJuIW6961YCpo9TWDSZ9VWHLGHE"
X-Powered-By: Express
{
"error": "connect ECONNREFUSED 127.0.0.1:5432"
}</code></pre>
<p>It works! Bugs are fixed now. We proceed to add next features.</p>
<h2 data-track-content data-content-name="validation" data-content-piece="ps-simple-rest-service-2" id="validation">Validation</h2>
<p>Let’s recall the code to update a user from the <code>src/SimpleService/Handler.purs</code> file:</p>
<div class="sourceCode" id="cb8" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb8-1"><a href="#cb8-1" aria-hidden="true" tabindex="-1"></a><span class="ot">updateUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb8-2"><a href="#cb8-2" aria-hidden="true" tabindex="-1"></a>updateUser pool <span class="ot">=</span> getRouteParam <span class="st">"id"</span> <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb8-3"><a href="#cb8-3" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User ID is required"</span> }</span>
<span id="cb8-4"><a href="#cb8-4" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> sUserId <span class="ot">-></span> <span class="kw">case</span> fromString sUserId <span class="kw">of</span></span>
<span id="cb8-5"><a href="#cb8-5" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User ID must be positive: "</span> <span class="op"><></span> sUserId }</span>
<span id="cb8-6"><a href="#cb8-6" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> userId <span class="ot">-></span> getBody <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb8-7"><a href="#cb8-7" aria-hidden="true" tabindex="-1"></a> <span class="dt">Left</span> errs <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> intercalate <span class="st">", "</span> <span class="op">$</span> <span class="fu">map</span> renderForeignError errs}</span>
<span id="cb8-8"><a href="#cb8-8" aria-hidden="true" tabindex="-1"></a> <span class="dt">Right</span> (<span class="dt">UserPatch</span> userPatch) <span class="ot">-></span> <span class="kw">case</span> unNullOrUndefined userPatch<span class="op">.</span>name <span class="kw">of</span></span>
<span id="cb8-9"><a href="#cb8-9" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respondNoContent <span class="dv">204</span></span>
<span id="cb8-10"><a href="#cb8-10" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> userName <span class="ot">-></span> <span class="kw">if</span> userName <span class="op">==</span> <span class="st">""</span></span>
<span id="cb8-11"><a href="#cb8-11" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User name must not be empty"</span> }</span>
<span id="cb8-12"><a href="#cb8-12" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span> <span class="kw">do</span></span>
<span id="cb8-13"><a href="#cb8-13" aria-hidden="true" tabindex="-1"></a> savedUser <span class="ot"><-</span> liftAff <span class="op">$</span> PG.withConnection pool \conn <span class="ot">-></span> PG.withTransaction conn <span class="kw">do</span></span>
<span id="cb8-14"><a href="#cb8-14" aria-hidden="true" tabindex="-1"></a> P.findUser conn userId <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb8-15"><a href="#cb8-15" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="fu">pure</span> <span class="dt">Nothing</span></span>
<span id="cb8-16"><a href="#cb8-16" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> (<span class="dt">User</span> user) <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb8-17"><a href="#cb8-17" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> user' <span class="ot">=</span> <span class="dt">User</span> (user { name <span class="ot">=</span> userName })</span>
<span id="cb8-18"><a href="#cb8-18" aria-hidden="true" tabindex="-1"></a> P.updateUser conn user'</span>
<span id="cb8-19"><a href="#cb8-19" aria-hidden="true" tabindex="-1"></a> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">Just</span> user'</span>
<span id="cb8-20"><a href="#cb8-20" aria-hidden="true" tabindex="-1"></a> <span class="kw">case</span> savedUser <span class="kw">of</span></span>
<span id="cb8-21"><a href="#cb8-21" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">404</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User not found with id: "</span> <span class="op"><></span> sUserId }</span>
<span id="cb8-22"><a href="#cb8-22" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> user <span class="ot">-></span> respond <span class="dv">200</span> (encode user)</span></code></pre></div>
<p>As we can see, the actual request handling logic is obfuscated by the request validation logic for the user id and the user name patch parameters. We also notice that we are using three constructs for validation here: <code>Maybe</code>, <code>Either</code> and <code>if-then-else</code>. However, we can use just <code>Either</code> to subsume all these cases as it can “carry” a failure as well as a success case. <code>Either</code> also comes with a nice monad transformer <a href="https://pursuit.purescript.org/packages/purescript-transformers/3.4.0/docs/Control.Monad.Except.Trans#t:ExceptT" target="_blank" rel="noopener"><code>ExceptT</code></a> which provides the <code>do</code> syntax for failure propagation. So we choose <code>ExceptT</code> as the base construct for our validation framework and write functions to upgrade <code>Maybe</code> and <code>if-then-else</code> to it. We add the following code to the <code>src/SimpleService/Validation.purs</code> file:</p>
<div class="sourceCode" id="cb9" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb9-1"><a href="#cb9-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">SimpleService.Validation</span></span>
<span id="cb9-2"><a href="#cb9-2" aria-hidden="true" tabindex="-1"></a> (<span class="kw">module</span> <span class="dt">MoreExports</span>, <span class="kw">module</span> <span class="dt">SimpleService.Validation</span>) <span class="kw">where</span></span>
<span id="cb9-3"><a href="#cb9-3" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-4"><a href="#cb9-4" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb9-5"><a href="#cb9-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-6"><a href="#cb9-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Except</span> (<span class="dt">ExceptT</span>, except, runExceptT)</span>
<span id="cb9-7"><a href="#cb9-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Either</span> (<span class="dt">Either</span>(..))</span>
<span id="cb9-8"><a href="#cb9-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Maybe</span> (<span class="dt">Maybe</span>(..))</span>
<span id="cb9-9"><a href="#cb9-9" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Handler</span> (<span class="dt">HandlerM</span>, <span class="dt">Handler</span>)</span>
<span id="cb9-10"><a href="#cb9-10" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Response</span> (sendJson, setStatus)</span>
<span id="cb9-11"><a href="#cb9-11" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Types</span> (<span class="dt">EXPRESS</span>)</span>
<span id="cb9-12"><a href="#cb9-12" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Except</span> (except) <span class="kw">as</span> <span class="dt">MoreExports</span></span>
<span id="cb9-13"><a href="#cb9-13" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-14"><a href="#cb9-14" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> <span class="dt">Validation</span> eff a <span class="ot">=</span> <span class="dt">ExceptT</span> <span class="dt">String</span> (<span class="dt">HandlerM</span> (<span class="ot">express ::</span> <span class="dt">EXPRESS</span> <span class="op">|</span> eff)) a</span>
<span id="cb9-15"><a href="#cb9-15" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-16"><a href="#cb9-16" aria-hidden="true" tabindex="-1"></a><span class="ot">exceptMaybe ::</span> <span class="kw">forall</span> e m a<span class="op">.</span> <span class="dt">Applicative</span> m <span class="ot">=></span> e <span class="ot">-></span> <span class="dt">Maybe</span> a <span class="ot">-></span> <span class="dt">ExceptT</span> e m a</span>
<span id="cb9-17"><a href="#cb9-17" aria-hidden="true" tabindex="-1"></a>exceptMaybe e a <span class="ot">=</span> except <span class="op">$</span> <span class="kw">case</span> a <span class="kw">of</span></span>
<span id="cb9-18"><a href="#cb9-18" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> x <span class="ot">-></span> <span class="dt">Right</span> x</span>
<span id="cb9-19"><a href="#cb9-19" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="dt">Left</span> e</span>
<span id="cb9-20"><a href="#cb9-20" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-21"><a href="#cb9-21" aria-hidden="true" tabindex="-1"></a><span class="ot">exceptCond ::</span> <span class="kw">forall</span> e m a<span class="op">.</span> <span class="dt">Applicative</span> m <span class="ot">=></span> e <span class="ot">-></span> (a <span class="ot">-></span> <span class="dt">Boolean</span>) <span class="ot">-></span> a <span class="ot">-></span> <span class="dt">ExceptT</span> e m a</span>
<span id="cb9-22"><a href="#cb9-22" aria-hidden="true" tabindex="-1"></a>exceptCond e cond a <span class="ot">=</span> except <span class="op">$</span> <span class="kw">if</span> cond a <span class="kw">then</span> <span class="dt">Right</span> a <span class="kw">else</span> <span class="dt">Left</span> e</span>
<span id="cb9-23"><a href="#cb9-23" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-24"><a href="#cb9-24" aria-hidden="true" tabindex="-1"></a><span class="ot">withValidation ::</span> <span class="kw">forall</span> eff a<span class="op">.</span> <span class="dt">Validation</span> eff a <span class="ot">-></span> (a <span class="ot">-></span> <span class="dt">Handler</span> eff) <span class="ot">-></span> <span class="dt">Handler</span> eff</span>
<span id="cb9-25"><a href="#cb9-25" aria-hidden="true" tabindex="-1"></a>withValidation action handler <span class="ot">=</span> runExceptT action <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb9-26"><a href="#cb9-26" aria-hidden="true" tabindex="-1"></a> <span class="dt">Left</span> err <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb9-27"><a href="#cb9-27" aria-hidden="true" tabindex="-1"></a> setStatus <span class="dv">422</span></span>
<span id="cb9-28"><a href="#cb9-28" aria-hidden="true" tabindex="-1"></a> sendJson {<span class="fu">error</span><span class="op">:</span> err}</span>
<span id="cb9-29"><a href="#cb9-29" aria-hidden="true" tabindex="-1"></a> <span class="dt">Right</span> x <span class="ot">-></span> handler x</span></code></pre></div>
<p>We re-export <code>except</code> from the <code>Control.Monad.Except</code> module. We also add a <code>withValidation</code> function which runs an <code>ExceptT</code> based validation and either returns an error response with a 422 status in case of a failed validation or runs the given action with the valid value in case of a successful validation.</p>
<p>Using these functions, we now write <code>updateUser</code> in the <code>src/SimpleService/Handler.purs</code> file as:</p>
<div class="sourceCode" id="cb10" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb10-1"><a href="#cb10-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb10-2"><a href="#cb10-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Trans.Class</span> (lift)</span>
<span id="cb10-3"><a href="#cb10-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Bifunctor</span> (lmap)</span>
<span id="cb10-4"><a href="#cb10-4" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foreign</span> (<span class="dt">ForeignError</span>, renderForeignError)</span>
<span id="cb10-5"><a href="#cb10-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.List.NonEmpty</span> (toList)</span>
<span id="cb10-6"><a href="#cb10-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.List.Types</span> (<span class="dt">NonEmptyList</span>)</span>
<span id="cb10-7"><a href="#cb10-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Tuple</span> (<span class="dt">Tuple</span>(..))</span>
<span id="cb10-8"><a href="#cb10-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Validation</span> <span class="kw">as</span> <span class="dt">V</span></span>
<span id="cb10-9"><a href="#cb10-9" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb10-10"><a href="#cb10-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-11"><a href="#cb10-11" aria-hidden="true" tabindex="-1"></a><span class="ot">renderForeignErrors ::</span> <span class="kw">forall</span> a<span class="op">.</span> <span class="dt">Either</span> (<span class="dt">NonEmptyList</span> <span class="dt">ForeignError</span>) a <span class="ot">-></span> <span class="dt">Either</span> <span class="dt">String</span> a</span>
<span id="cb10-12"><a href="#cb10-12" aria-hidden="true" tabindex="-1"></a>renderForeignErrors <span class="ot">=</span> lmap (toList <span class="op">>>></span> <span class="fu">map</span> renderForeignError <span class="op">>>></span> intercalate <span class="st">", "</span>)</span>
<span id="cb10-13"><a href="#cb10-13" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-14"><a href="#cb10-14" aria-hidden="true" tabindex="-1"></a><span class="ot">updateUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb10-15"><a href="#cb10-15" aria-hidden="true" tabindex="-1"></a>updateUser pool <span class="ot">=</span> V.withValidation (<span class="dt">Tuple</span> <span class="op"><$></span> getUserId <span class="op"><*></span> getUserPatch)</span>
<span id="cb10-16"><a href="#cb10-16" aria-hidden="true" tabindex="-1"></a> \(<span class="dt">Tuple</span> userId (<span class="dt">UserPatch</span> userPatch)) <span class="ot">-></span></span>
<span id="cb10-17"><a href="#cb10-17" aria-hidden="true" tabindex="-1"></a> <span class="kw">case</span> unNullOrUndefined userPatch<span class="op">.</span>name <span class="kw">of</span></span>
<span id="cb10-18"><a href="#cb10-18" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respondNoContent <span class="dv">204</span></span>
<span id="cb10-19"><a href="#cb10-19" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> uName <span class="ot">-></span> V.withValidation (getUserName uName) \userName <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb10-20"><a href="#cb10-20" aria-hidden="true" tabindex="-1"></a> savedUser <span class="ot"><-</span> liftAff <span class="op">$</span> PG.withConnection pool \conn <span class="ot">-></span> PG.withTransaction conn <span class="kw">do</span></span>
<span id="cb10-21"><a href="#cb10-21" aria-hidden="true" tabindex="-1"></a> P.findUser conn userId <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb10-22"><a href="#cb10-22" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="fu">pure</span> <span class="dt">Nothing</span></span>
<span id="cb10-23"><a href="#cb10-23" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> (<span class="dt">User</span> user) <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb10-24"><a href="#cb10-24" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> user' <span class="ot">=</span> <span class="dt">User</span> (user { name <span class="ot">=</span> userName })</span>
<span id="cb10-25"><a href="#cb10-25" aria-hidden="true" tabindex="-1"></a> P.updateUser conn user'</span>
<span id="cb10-26"><a href="#cb10-26" aria-hidden="true" tabindex="-1"></a> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">Just</span> user'</span>
<span id="cb10-27"><a href="#cb10-27" aria-hidden="true" tabindex="-1"></a> <span class="kw">case</span> savedUser <span class="kw">of</span></span>
<span id="cb10-28"><a href="#cb10-28" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">404</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User not found with id: "</span> <span class="op"><></span> <span class="fu">show</span> userId }</span>
<span id="cb10-29"><a href="#cb10-29" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> user <span class="ot">-></span> respond <span class="dv">200</span> (encode user)</span>
<span id="cb10-30"><a href="#cb10-30" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb10-31"><a href="#cb10-31" aria-hidden="true" tabindex="-1"></a> getUserId <span class="ot">=</span> lift (getRouteParam <span class="st">"id"</span>)</span>
<span id="cb10-32"><a href="#cb10-32" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> V.exceptMaybe <span class="st">"User ID is required"</span></span>
<span id="cb10-33"><a href="#cb10-33" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> fromString <span class="op">>>></span> V.exceptMaybe <span class="st">"User ID must be positive"</span></span>
<span id="cb10-34"><a href="#cb10-34" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-35"><a href="#cb10-35" aria-hidden="true" tabindex="-1"></a> getUserPatch <span class="ot">=</span> lift getBody <span class="op">>>=</span> V.except <span class="op"><<<</span> renderForeignErrors</span>
<span id="cb10-36"><a href="#cb10-36" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-37"><a href="#cb10-37" aria-hidden="true" tabindex="-1"></a> getUserName <span class="ot">=</span> V.exceptCond <span class="st">"User name must not be empty"</span> (_ <span class="op">==</span> <span class="st">""</span>)</span></code></pre></div>
<p>The validation logic has been extracted out in separate functions now which are composed using <a href="https://pursuit.purescript.org/packages/purescript-prelude/3.0.0/docs/Control.Applicative#t:Applicative" target="_blank" rel="noopener">Applicative</a>. The validation steps are composed using the <code>ExceptT</code> monad. We are now free to express the core logic of the function clearly. We rewrite the <code>src/SimpleService/Handler.purs</code> file using the validations:</p>
<div class="sourceCode" id="cb11" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb11-1"><a href="#cb11-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">SimpleService.Handler</span> <span class="kw">where</span></span>
<span id="cb11-2"><a href="#cb11-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-3"><a href="#cb11-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb11-4"><a href="#cb11-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-5"><a href="#cb11-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Aff.Class</span> (liftAff)</span>
<span id="cb11-6"><a href="#cb11-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Trans.Class</span> (lift)</span>
<span id="cb11-7"><a href="#cb11-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Bifunctor</span> (lmap)</span>
<span id="cb11-8"><a href="#cb11-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Either</span> (<span class="dt">Either</span>)</span>
<span id="cb11-9"><a href="#cb11-9" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foldable</span> (intercalate)</span>
<span id="cb11-10"><a href="#cb11-10" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foreign</span> (<span class="dt">ForeignError</span>, renderForeignError)</span>
<span id="cb11-11"><a href="#cb11-11" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foreign.Class</span> (encode)</span>
<span id="cb11-12"><a href="#cb11-12" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foreign.NullOrUndefined</span> (unNullOrUndefined)</span>
<span id="cb11-13"><a href="#cb11-13" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Int</span> (fromString)</span>
<span id="cb11-14"><a href="#cb11-14" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.List.NonEmpty</span> (toList)</span>
<span id="cb11-15"><a href="#cb11-15" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.List.Types</span> (<span class="dt">NonEmptyList</span>)</span>
<span id="cb11-16"><a href="#cb11-16" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Maybe</span> (<span class="dt">Maybe</span>(..))</span>
<span id="cb11-17"><a href="#cb11-17" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Tuple</span> (<span class="dt">Tuple</span>(..))</span>
<span id="cb11-18"><a href="#cb11-18" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Database.PostgreSQL</span> <span class="kw">as</span> <span class="dt">PG</span></span>
<span id="cb11-19"><a href="#cb11-19" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Handler</span> (<span class="dt">Handler</span>)</span>
<span id="cb11-20"><a href="#cb11-20" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Request</span> (getBody, getRouteParam)</span>
<span id="cb11-21"><a href="#cb11-21" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Response</span> (end, sendJson, setStatus)</span>
<span id="cb11-22"><a href="#cb11-22" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Persistence</span> <span class="kw">as</span> <span class="dt">P</span></span>
<span id="cb11-23"><a href="#cb11-23" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Validation</span> <span class="kw">as</span> <span class="dt">V</span></span>
<span id="cb11-24"><a href="#cb11-24" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Types</span></span>
<span id="cb11-25"><a href="#cb11-25" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-26"><a href="#cb11-26" aria-hidden="true" tabindex="-1"></a><span class="ot">getUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb11-27"><a href="#cb11-27" aria-hidden="true" tabindex="-1"></a>getUser pool <span class="ot">=</span> V.withValidation getUserId \userId <span class="ot">-></span></span>
<span id="cb11-28"><a href="#cb11-28" aria-hidden="true" tabindex="-1"></a> liftAff (PG.withConnection pool <span class="op">$</span> <span class="fu">flip</span> P.findUser userId) <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb11-29"><a href="#cb11-29" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">404</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User not found with id: "</span> <span class="op"><></span> <span class="fu">show</span> userId }</span>
<span id="cb11-30"><a href="#cb11-30" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> user <span class="ot">-></span> respond <span class="dv">200</span> (encode user)</span>
<span id="cb11-31"><a href="#cb11-31" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-32"><a href="#cb11-32" aria-hidden="true" tabindex="-1"></a><span class="ot">deleteUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb11-33"><a href="#cb11-33" aria-hidden="true" tabindex="-1"></a>deleteUser pool <span class="ot">=</span> V.withValidation getUserId \userId <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb11-34"><a href="#cb11-34" aria-hidden="true" tabindex="-1"></a> found <span class="ot"><-</span> liftAff <span class="op">$</span> PG.withConnection pool \conn <span class="ot">-></span> PG.withTransaction conn <span class="kw">do</span></span>
<span id="cb11-35"><a href="#cb11-35" aria-hidden="true" tabindex="-1"></a> P.findUser conn userId <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb11-36"><a href="#cb11-36" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="fu">pure</span> false</span>
<span id="cb11-37"><a href="#cb11-37" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> _ <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb11-38"><a href="#cb11-38" aria-hidden="true" tabindex="-1"></a> P.deleteUser conn userId</span>
<span id="cb11-39"><a href="#cb11-39" aria-hidden="true" tabindex="-1"></a> <span class="fu">pure</span> true</span>
<span id="cb11-40"><a href="#cb11-40" aria-hidden="true" tabindex="-1"></a> <span class="kw">if</span> found</span>
<span id="cb11-41"><a href="#cb11-41" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> respondNoContent <span class="dv">204</span></span>
<span id="cb11-42"><a href="#cb11-42" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span> respond <span class="dv">404</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User not found with id: "</span> <span class="op"><></span> <span class="fu">show</span> userId }</span>
<span id="cb11-43"><a href="#cb11-43" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-44"><a href="#cb11-44" aria-hidden="true" tabindex="-1"></a><span class="ot">createUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb11-45"><a href="#cb11-45" aria-hidden="true" tabindex="-1"></a>createUser pool <span class="ot">=</span> V.withValidation getUser \user<span class="op">@</span>(<span class="dt">User</span> _) <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb11-46"><a href="#cb11-46" aria-hidden="true" tabindex="-1"></a> liftAff (PG.withConnection pool <span class="op">$</span> <span class="fu">flip</span> P.insertUser user)</span>
<span id="cb11-47"><a href="#cb11-47" aria-hidden="true" tabindex="-1"></a> respondNoContent <span class="dv">201</span></span>
<span id="cb11-48"><a href="#cb11-48" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb11-49"><a href="#cb11-49" aria-hidden="true" tabindex="-1"></a> getUser <span class="ot">=</span> lift getBody</span>
<span id="cb11-50"><a href="#cb11-50" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> V.except <span class="op"><<<</span> renderForeignErrors</span>
<span id="cb11-51"><a href="#cb11-51" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> V.exceptCond <span class="st">"User ID must be positive"</span> (\(<span class="dt">User</span> user) <span class="ot">-></span> user<span class="op">.</span><span class="fu">id</span> <span class="op">></span> <span class="dv">0</span>)</span>
<span id="cb11-52"><a href="#cb11-52" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> V.exceptCond <span class="st">"User name must not be empty"</span> (\(<span class="dt">User</span> user) <span class="ot">-></span> user<span class="op">.</span>name <span class="op">/=</span> <span class="st">""</span>)</span>
<span id="cb11-53"><a href="#cb11-53" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-54"><a href="#cb11-54" aria-hidden="true" tabindex="-1"></a><span class="ot">updateUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb11-55"><a href="#cb11-55" aria-hidden="true" tabindex="-1"></a>updateUser pool <span class="ot">=</span> V.withValidation (<span class="dt">Tuple</span> <span class="op"><$></span> getUserId <span class="op"><*></span> getUserPatch)</span>
<span id="cb11-56"><a href="#cb11-56" aria-hidden="true" tabindex="-1"></a> \(<span class="dt">Tuple</span> userId (<span class="dt">UserPatch</span> userPatch)) <span class="ot">-></span></span>
<span id="cb11-57"><a href="#cb11-57" aria-hidden="true" tabindex="-1"></a> <span class="kw">case</span> unNullOrUndefined userPatch<span class="op">.</span>name <span class="kw">of</span></span>
<span id="cb11-58"><a href="#cb11-58" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respondNoContent <span class="dv">204</span></span>
<span id="cb11-59"><a href="#cb11-59" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> uName <span class="ot">-></span> V.withValidation (getUserName uName) \userName <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb11-60"><a href="#cb11-60" aria-hidden="true" tabindex="-1"></a> savedUser <span class="ot"><-</span> liftAff <span class="op">$</span> PG.withConnection pool \conn <span class="ot">-></span> PG.withTransaction conn <span class="kw">do</span></span>
<span id="cb11-61"><a href="#cb11-61" aria-hidden="true" tabindex="-1"></a> P.findUser conn userId <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb11-62"><a href="#cb11-62" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="fu">pure</span> <span class="dt">Nothing</span></span>
<span id="cb11-63"><a href="#cb11-63" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> (<span class="dt">User</span> user) <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb11-64"><a href="#cb11-64" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> user' <span class="ot">=</span> <span class="dt">User</span> (user { name <span class="ot">=</span> userName })</span>
<span id="cb11-65"><a href="#cb11-65" aria-hidden="true" tabindex="-1"></a> P.updateUser conn user'</span>
<span id="cb11-66"><a href="#cb11-66" aria-hidden="true" tabindex="-1"></a> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">Just</span> user'</span>
<span id="cb11-67"><a href="#cb11-67" aria-hidden="true" tabindex="-1"></a> <span class="kw">case</span> savedUser <span class="kw">of</span></span>
<span id="cb11-68"><a href="#cb11-68" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">404</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User not found with id: "</span> <span class="op"><></span> <span class="fu">show</span> userId }</span>
<span id="cb11-69"><a href="#cb11-69" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> user <span class="ot">-></span> respond <span class="dv">200</span> (encode user)</span>
<span id="cb11-70"><a href="#cb11-70" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb11-71"><a href="#cb11-71" aria-hidden="true" tabindex="-1"></a> getUserPatch <span class="ot">=</span> lift getBody <span class="op">>>=</span> V.except <span class="op"><<<</span> renderForeignErrors</span>
<span id="cb11-72"><a href="#cb11-72" aria-hidden="true" tabindex="-1"></a> getUserName <span class="ot">=</span> V.exceptCond <span class="st">"User name must not be empty"</span> (_ <span class="op">/=</span> <span class="st">""</span>)</span>
<span id="cb11-73"><a href="#cb11-73" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-74"><a href="#cb11-74" aria-hidden="true" tabindex="-1"></a><span class="ot">listUsers ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb11-75"><a href="#cb11-75" aria-hidden="true" tabindex="-1"></a>listUsers pool <span class="ot">=</span> liftAff (PG.withConnection pool P.listUsers) <span class="op">>>=</span> encode <span class="op">>>></span> respond <span class="dv">200</span></span>
<span id="cb11-76"><a href="#cb11-76" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-77"><a href="#cb11-77" aria-hidden="true" tabindex="-1"></a><span class="ot">getUserId ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">V.Validation</span> eff <span class="dt">Int</span></span>
<span id="cb11-78"><a href="#cb11-78" aria-hidden="true" tabindex="-1"></a>getUserId <span class="ot">=</span> lift (getRouteParam <span class="st">"id"</span>)</span>
<span id="cb11-79"><a href="#cb11-79" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> V.exceptMaybe <span class="st">"User ID is required"</span></span>
<span id="cb11-80"><a href="#cb11-80" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> fromString <span class="op">>>></span> V.exceptMaybe <span class="st">"User ID must be an integer"</span></span>
<span id="cb11-81"><a href="#cb11-81" aria-hidden="true" tabindex="-1"></a> <span class="op">>>=</span> V.exceptCond <span class="st">"User ID must be positive"</span> (_ <span class="op">></span> <span class="dv">0</span>)</span>
<span id="cb11-82"><a href="#cb11-82" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-83"><a href="#cb11-83" aria-hidden="true" tabindex="-1"></a><span class="ot">renderForeignErrors ::</span> <span class="kw">forall</span> a<span class="op">.</span> <span class="dt">Either</span> (<span class="dt">NonEmptyList</span> <span class="dt">ForeignError</span>) a <span class="ot">-></span> <span class="dt">Either</span> <span class="dt">String</span> a</span>
<span id="cb11-84"><a href="#cb11-84" aria-hidden="true" tabindex="-1"></a>renderForeignErrors <span class="ot">=</span> lmap (toList <span class="op">>>></span> <span class="fu">map</span> renderForeignError <span class="op">>>></span> intercalate <span class="st">", "</span>)</span>
<span id="cb11-85"><a href="#cb11-85" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-86"><a href="#cb11-86" aria-hidden="true" tabindex="-1"></a><span class="ot">respond ::</span> <span class="kw">forall</span> eff a<span class="op">.</span> <span class="dt">Int</span> <span class="ot">-></span> a <span class="ot">-></span> <span class="dt">Handler</span> eff</span>
<span id="cb11-87"><a href="#cb11-87" aria-hidden="true" tabindex="-1"></a>respond status body <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb11-88"><a href="#cb11-88" aria-hidden="true" tabindex="-1"></a> setStatus status</span>
<span id="cb11-89"><a href="#cb11-89" aria-hidden="true" tabindex="-1"></a> sendJson body</span>
<span id="cb11-90"><a href="#cb11-90" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb11-91"><a href="#cb11-91" aria-hidden="true" tabindex="-1"></a><span class="ot">respondNoContent ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">Int</span> <span class="ot">-></span> <span class="dt">Handler</span> eff</span>
<span id="cb11-92"><a href="#cb11-92" aria-hidden="true" tabindex="-1"></a>respondNoContent status <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb11-93"><a href="#cb11-93" aria-hidden="true" tabindex="-1"></a> setStatus status</span>
<span id="cb11-94"><a href="#cb11-94" aria-hidden="true" tabindex="-1"></a> end</span></code></pre></div>
<p>The code is much cleaner now. Let’s try out a few test cases:</p>
<pre class="plain"><code>$ http POST http://localhost:4000/v1/users id:=3 name=roger
HTTP/1.1 201 Created
Connection: keep-alive
Content-Length: 0
Date: Sat, 30 Sep 2017 12:13:37 GMT
X-Powered-By: Express</code></pre>
<pre class="plain"><code>$ http POST http://localhost:4000/v1/users id:=3
HTTP/1.1 422 Unprocessable Entity
Connection: keep-alive
Content-Length: 102
Content-Type: application/json; charset=utf-8
Date: Sat, 30 Sep 2017 12:13:50 GMT
ETag: W/"66-/c4cfoquQZGwtDBUzHjJydJAHJ0"
X-Powered-By: Express
{
"error": "Error at array index 0: (ErrorAtProperty \"name\" (TypeMismatch \"String\" \"Undefined\"))"
}</code></pre>
<pre class="plain"><code>$ http POST http://localhost:4000/v1/users id:=3 name=""
HTTP/1.1 422 Unprocessable Entity
Connection: keep-alive
Content-Length: 39
Content-Type: application/json; charset=utf-8
Date: Sat, 30 Sep 2017 12:14:02 GMT
ETag: W/"27-JQsh12xu/rEFdWy8REF4NMtBUB4"
X-Powered-By: Express
{
"error": "User name must not be empty"
}</code></pre>
<pre class="plain"><code>$ http POST http://localhost:4000/v1/users id:=0 name=roger
HTTP/1.1 422 Unprocessable Entity
Connection: keep-alive
Content-Length: 36
Content-Type: application/json; charset=utf-8
Date: Sat, 30 Sep 2017 12:14:14 GMT
ETag: W/"24-Pvt1L4eGilBmVtaOGHlSReJ413E"
X-Powered-By: Express
{
"error": "User ID must be positive"
}</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/3
HTTP/1.1 200 OK
Connection: keep-alive
Content-Length: 23
Content-Type: application/json; charset=utf-8
Date: Sat, 30 Sep 2017 12:14:28 GMT
ETag: W/"17-1scpiB1FT9DBu9s4I1gNWSjH2go"
X-Powered-By: Express
{
"id": 3,
"name": "roger"
}</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/asdf
HTTP/1.1 422 Unprocessable Entity
Connection: keep-alive
Content-Length: 38
Content-Type: application/json; charset=utf-8
Date: Sat, 30 Sep 2017 12:14:40 GMT
ETag: W/"26-//tvORl1gGDUMwgSaqbEpJhuadI"
X-Powered-By: Express
{
"error": "User ID must be an integer"
}</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/-1
HTTP/1.1 422 Unprocessable Entity
Connection: keep-alive
Content-Length: 36
Content-Type: application/json; charset=utf-8
Date: Sat, 30 Sep 2017 12:14:45 GMT
ETag: W/"24-Pvt1L4eGilBmVtaOGHlSReJ413E"
X-Powered-By: Express
{
"error": "User ID must be positive"
}</code></pre>
<p>It works as expected.</p>
<h2 data-track-content data-content-name="configuration" data-content-piece="ps-simple-rest-service-2" id="configuration">Configuration</h2>
<p>Right now our application configuration resides in the <code>main</code> function:</p>
<div class="sourceCode" id="cb19" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb19-1"><a href="#cb19-1" aria-hidden="true" tabindex="-1"></a>main <span class="ot">=</span> runServer port databaseConfig</span>
<span id="cb19-2"><a href="#cb19-2" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb19-3"><a href="#cb19-3" aria-hidden="true" tabindex="-1"></a> port <span class="ot">=</span> <span class="dv">4000</span></span>
<span id="cb19-4"><a href="#cb19-4" aria-hidden="true" tabindex="-1"></a> databaseConfig <span class="ot">=</span> { user<span class="op">:</span> <span class="st">"abhinav"</span></span>
<span id="cb19-5"><a href="#cb19-5" aria-hidden="true" tabindex="-1"></a> , password<span class="op">:</span> <span class="st">""</span></span>
<span id="cb19-6"><a href="#cb19-6" aria-hidden="true" tabindex="-1"></a> , host<span class="op">:</span> <span class="st">"localhost"</span></span>
<span id="cb19-7"><a href="#cb19-7" aria-hidden="true" tabindex="-1"></a> , port<span class="op">:</span> <span class="dv">5432</span></span>
<span id="cb19-8"><a href="#cb19-8" aria-hidden="true" tabindex="-1"></a> , database<span class="op">:</span> <span class="st">"simple_service"</span></span>
<span id="cb19-9"><a href="#cb19-9" aria-hidden="true" tabindex="-1"></a> , <span class="fu">max</span><span class="op">:</span> <span class="dv">10</span></span>
<span id="cb19-10"><a href="#cb19-10" aria-hidden="true" tabindex="-1"></a> , idleTimeoutMillis<span class="op">:</span> <span class="dv">1000</span></span>
<span id="cb19-11"><a href="#cb19-11" aria-hidden="true" tabindex="-1"></a> }</span></code></pre></div>
<p>We are going to extract it out of the code and read it from the environment variables using the <a href="https://pursuit.purescript.org/packages/purescript-config" target="_blank" rel="noopener"><code>purescript-config</code></a> package. First, we install the required packages using <a href="http://bower.io" target="_blank" rel="noopener">bower</a>.</p>
<pre class="plain"><code>$ bower install --save purescript-node-process purescript-config</code></pre>
<p>Now, we write the following code in the <code>src/SimpleService/Config.purs</code> file:</p>
<div class="sourceCode" id="cb21" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb21-1"><a href="#cb21-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">SimpleService.Config</span> <span class="kw">where</span></span>
<span id="cb21-2"><a href="#cb21-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-3"><a href="#cb21-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Config</span></span>
<span id="cb21-4"><a href="#cb21-4" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb21-5"><a href="#cb21-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-6"><a href="#cb21-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff</span> (<span class="dt">Eff</span>)</span>
<span id="cb21-7"><a href="#cb21-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Config.Node</span> (fromEnv)</span>
<span id="cb21-8"><a href="#cb21-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Either</span> (<span class="dt">Either</span>)</span>
<span id="cb21-9"><a href="#cb21-9" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Set</span> (<span class="dt">Set</span>)</span>
<span id="cb21-10"><a href="#cb21-10" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Database.PostgreSQL</span> <span class="kw">as</span> <span class="dt">PG</span></span>
<span id="cb21-11"><a href="#cb21-11" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Process</span> (<span class="dt">PROCESS</span>)</span>
<span id="cb21-12"><a href="#cb21-12" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-13"><a href="#cb21-13" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> <span class="dt">ServerConfig</span> <span class="ot">=</span></span>
<span id="cb21-14"><a href="#cb21-14" aria-hidden="true" tabindex="-1"></a> {<span class="ot"> port ::</span> <span class="dt">Int</span></span>
<span id="cb21-15"><a href="#cb21-15" aria-hidden="true" tabindex="-1"></a> ,<span class="ot"> databaseConfig ::</span> <span class="dt">PG.PoolConfiguration</span></span>
<span id="cb21-16"><a href="#cb21-16" aria-hidden="true" tabindex="-1"></a> }</span>
<span id="cb21-17"><a href="#cb21-17" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-18"><a href="#cb21-18" aria-hidden="true" tabindex="-1"></a><span class="ot">databaseConfig ::</span> <span class="dt">Config</span> {<span class="ot">name ::</span> <span class="dt">String</span>} <span class="dt">PG.PoolConfiguration</span></span>
<span id="cb21-19"><a href="#cb21-19" aria-hidden="true" tabindex="-1"></a>databaseConfig <span class="ot">=</span></span>
<span id="cb21-20"><a href="#cb21-20" aria-hidden="true" tabindex="-1"></a> { user<span class="op">:</span> _, password<span class="op">:</span> _, host<span class="op">:</span> _, port<span class="op">:</span> _, database<span class="op">:</span> _, <span class="fu">max</span><span class="op">:</span> _, idleTimeoutMillis<span class="op">:</span> _ }</span>
<span id="cb21-21"><a href="#cb21-21" aria-hidden="true" tabindex="-1"></a> <span class="op"><$></span> string {name<span class="op">:</span> <span class="st">"user"</span>}</span>
<span id="cb21-22"><a href="#cb21-22" aria-hidden="true" tabindex="-1"></a> <span class="op"><*></span> string {name<span class="op">:</span> <span class="st">"password"</span>}</span>
<span id="cb21-23"><a href="#cb21-23" aria-hidden="true" tabindex="-1"></a> <span class="op"><*></span> string {name<span class="op">:</span> <span class="st">"host"</span>}</span>
<span id="cb21-24"><a href="#cb21-24" aria-hidden="true" tabindex="-1"></a> <span class="op"><*></span> int {name<span class="op">:</span> <span class="st">"port"</span>}</span>
<span id="cb21-25"><a href="#cb21-25" aria-hidden="true" tabindex="-1"></a> <span class="op"><*></span> string {name<span class="op">:</span> <span class="st">"database"</span>}</span>
<span id="cb21-26"><a href="#cb21-26" aria-hidden="true" tabindex="-1"></a> <span class="op"><*></span> int {name<span class="op">:</span> <span class="st">"pool_size"</span>}</span>
<span id="cb21-27"><a href="#cb21-27" aria-hidden="true" tabindex="-1"></a> <span class="op"><*></span> int {name<span class="op">:</span> <span class="st">"idle_conn_timeout_millis"</span>}</span>
<span id="cb21-28"><a href="#cb21-28" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-29"><a href="#cb21-29" aria-hidden="true" tabindex="-1"></a><span class="ot">portConfig ::</span> <span class="dt">Config</span> {<span class="ot">name ::</span> <span class="dt">String</span>} <span class="dt">Int</span></span>
<span id="cb21-30"><a href="#cb21-30" aria-hidden="true" tabindex="-1"></a>portConfig <span class="ot">=</span> int {name<span class="op">:</span> <span class="st">"port"</span>}</span>
<span id="cb21-31"><a href="#cb21-31" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-32"><a href="#cb21-32" aria-hidden="true" tabindex="-1"></a><span class="ot">serverConfig ::</span> <span class="dt">Config</span> {<span class="ot">name ::</span> <span class="dt">String</span>} <span class="dt">ServerConfig</span></span>
<span id="cb21-33"><a href="#cb21-33" aria-hidden="true" tabindex="-1"></a>serverConfig <span class="ot">=</span></span>
<span id="cb21-34"><a href="#cb21-34" aria-hidden="true" tabindex="-1"></a> { port<span class="op">:</span> _, databaseConfig<span class="op">:</span> _}</span>
<span id="cb21-35"><a href="#cb21-35" aria-hidden="true" tabindex="-1"></a> <span class="op"><$></span> portConfig</span>
<span id="cb21-36"><a href="#cb21-36" aria-hidden="true" tabindex="-1"></a> <span class="op"><*></span> prefix {name<span class="op">:</span> <span class="st">"db"</span>} databaseConfig</span>
<span id="cb21-37"><a href="#cb21-37" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb21-38"><a href="#cb21-38" aria-hidden="true" tabindex="-1"></a><span class="ot">readServerConfig ::</span> <span class="kw">forall</span> eff<span class="op">.</span></span>
<span id="cb21-39"><a href="#cb21-39" aria-hidden="true" tabindex="-1"></a> <span class="dt">Eff</span> (<span class="ot">process ::</span> <span class="dt">PROCESS</span> <span class="op">|</span> eff) (<span class="dt">Either</span> (<span class="dt">Set</span> <span class="dt">String</span>) <span class="dt">ServerConfig</span>)</span>
<span id="cb21-40"><a href="#cb21-40" aria-hidden="true" tabindex="-1"></a>readServerConfig <span class="ot">=</span> fromEnv <span class="st">"SS"</span> serverConfig</span></code></pre></div>
<p>We use the applicative DSL provided in <code>Data.Config</code> module to build a description of our configuration. This description contains the keys and types of the configuration, for consumption by various interpreters. Then we use the <code>fromEnv</code> interpreter to read the config from the environment variables derived from the <code>name</code> fields in the records in the description in the <code>readServerConfig</code> function. We also write a bash script to set those environment variables in the development environment in the <code>setenv.sh</code> file:</p>
<div class="sourceCode" id="cb22" data-lang="bash"><pre class="sourceCode numberSource bash"><code class="sourceCode bash"><span id="cb22-1"><a href="#cb22-1" aria-hidden="true" tabindex="-1"></a><span class="bu">export</span> <span class="va">SS_PORT</span><span class="op">=</span>4000</span>
<span id="cb22-2"><a href="#cb22-2" aria-hidden="true" tabindex="-1"></a><span class="bu">export</span> <span class="va">SS_DB_USER</span><span class="op">=</span><span class="st">"abhinav"</span></span>
<span id="cb22-3"><a href="#cb22-3" aria-hidden="true" tabindex="-1"></a><span class="bu">export</span> <span class="va">SS_DB_PASSWORD</span><span class="op">=</span><span class="st">""</span></span>
<span id="cb22-4"><a href="#cb22-4" aria-hidden="true" tabindex="-1"></a><span class="bu">export</span> <span class="va">SS_DB_HOST</span><span class="op">=</span><span class="st">"localhost"</span></span>
<span id="cb22-5"><a href="#cb22-5" aria-hidden="true" tabindex="-1"></a><span class="bu">export</span> <span class="va">SS_DB_PORT</span><span class="op">=</span>5432</span>
<span id="cb22-6"><a href="#cb22-6" aria-hidden="true" tabindex="-1"></a><span class="bu">export</span> <span class="va">SS_DB_DATABASE</span><span class="op">=</span><span class="st">"simple_service"</span></span>
<span id="cb22-7"><a href="#cb22-7" aria-hidden="true" tabindex="-1"></a><span class="bu">export</span> <span class="va">SS_DB_POOL_SIZE</span><span class="op">=</span>10</span>
<span id="cb22-8"><a href="#cb22-8" aria-hidden="true" tabindex="-1"></a><span class="bu">export</span> <span class="va">SS_DB_IDLE_CONN_TIMEOUT_MILLIS</span><span class="op">=</span>1000</span></code></pre></div>
<p>Now we rewrite our <code>src/Main.purs</code> file to use the <code>readServerConfig</code> function:</p>
<div class="sourceCode" id="cb23" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb23-1"><a href="#cb23-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">Main</span> <span class="kw">where</span></span>
<span id="cb23-2"><a href="#cb23-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb23-3"><a href="#cb23-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb23-4"><a href="#cb23-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb23-5"><a href="#cb23-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff</span> (<span class="dt">Eff</span>)</span>
<span id="cb23-6"><a href="#cb23-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff.Console</span> (<span class="dt">CONSOLE</span>, log)</span>
<span id="cb23-7"><a href="#cb23-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Either</span> (<span class="dt">Either</span>(..))</span>
<span id="cb23-8"><a href="#cb23-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Set</span> (toUnfoldable)</span>
<span id="cb23-9"><a href="#cb23-9" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.String</span> (joinWith)</span>
<span id="cb23-10"><a href="#cb23-10" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Database.PostgreSQL</span> <span class="kw">as</span> <span class="dt">PG</span></span>
<span id="cb23-11"><a href="#cb23-11" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Types</span> (<span class="dt">EXPRESS</span>)</span>
<span id="cb23-12"><a href="#cb23-12" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Process</span> (<span class="dt">PROCESS</span>)</span>
<span id="cb23-13"><a href="#cb23-13" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Process</span> <span class="kw">as</span> <span class="dt">Process</span></span>
<span id="cb23-14"><a href="#cb23-14" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Config</span> (readServerConfig)</span>
<span id="cb23-15"><a href="#cb23-15" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Server</span> (runServer)</span>
<span id="cb23-16"><a href="#cb23-16" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb23-17"><a href="#cb23-17" aria-hidden="true" tabindex="-1"></a><span class="ot">main ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">Eff</span> (<span class="ot"> console ::</span> <span class="dt">CONSOLE</span></span>
<span id="cb23-18"><a href="#cb23-18" aria-hidden="true" tabindex="-1"></a> ,<span class="ot"> express ::</span> <span class="dt">EXPRESS</span></span>
<span id="cb23-19"><a href="#cb23-19" aria-hidden="true" tabindex="-1"></a> ,<span class="ot"> postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span></span>
<span id="cb23-20"><a href="#cb23-20" aria-hidden="true" tabindex="-1"></a> ,<span class="ot"> process ::</span> <span class="dt">PROCESS</span></span>
<span id="cb23-21"><a href="#cb23-21" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> eff ) <span class="dt">Unit</span></span>
<span id="cb23-22"><a href="#cb23-22" aria-hidden="true" tabindex="-1"></a>main <span class="ot">=</span> readServerConfig <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb23-23"><a href="#cb23-23" aria-hidden="true" tabindex="-1"></a> <span class="dt">Left</span> missingKeys <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb23-24"><a href="#cb23-24" aria-hidden="true" tabindex="-1"></a> <span class="fu">log</span> <span class="op">$</span> <span class="st">"Unable to start. Missing Env keys: "</span> <span class="op"><></span> joinWith <span class="st">", "</span> (toUnfoldable missingKeys)</span>
<span id="cb23-25"><a href="#cb23-25" aria-hidden="true" tabindex="-1"></a> Process.exit <span class="dv">1</span></span>
<span id="cb23-26"><a href="#cb23-26" aria-hidden="true" tabindex="-1"></a> <span class="dt">Right</span> { port, databaseConfig } <span class="ot">-></span> runServer port databaseConfig</span></code></pre></div>
<p>If <code>readServerConfig</code> fails, we print the missing keys to the console and exit the process. Else we run the server with the read config.</p>
<p>To test this, we stop the server we ran in the beginning, source the config, and run it again:</p>
<pre class="plain"><code>$ pulp --watch run
* Building project in /Users/abhinav/ps-simple-rest-service
* Build successful.
Server listening on :4000
^C
$ source setenv.sh
$ pulp --watch run
* Building project in /Users/abhinav/ps-simple-rest-service
* Build successful.
Server listening on :4000</code></pre>
<p>It works! We test the failure case by opening another terminal which does not have the environment variables set:</p>
<pre class="plain"><code>$ pulp run
* Building project in /Users/abhinav/ps-simple-rest-service
* Build successful.
Unable to start. Missing Env keys: SS_DB_DATABASE, SS_DB_HOST, SS_DB_IDLE_CONN_TIMEOUT_MILLIS, SS_DB_PASSWORD, SS_DB_POOL_SIZE, SS_DB_PORT, SS_DB_USER, SS_PORT
* ERROR: Subcommand terminated with exit code 1</code></pre>
<p>Up next, we add logging to our application.</p>
<h2 data-track-content data-content-name="logging" data-content-piece="ps-simple-rest-service-2" id="logging">Logging</h2>
<p>For logging, we use the <a href="https://pursuit.purescript.org/packages/purescript-logging" target="_blank" rel="noopener"><code>purescript-logging</code></a> package. We write a logger which logs to <code>stdout</code>; in the <code>src/SimpleService/Logger.purs</code> file:</p>
<div class="sourceCode" id="cb26" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb26-1"><a href="#cb26-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">SimpleService.Logger</span></span>
<span id="cb26-2"><a href="#cb26-2" aria-hidden="true" tabindex="-1"></a> ( debug</span>
<span id="cb26-3"><a href="#cb26-3" aria-hidden="true" tabindex="-1"></a> , info</span>
<span id="cb26-4"><a href="#cb26-4" aria-hidden="true" tabindex="-1"></a> , warn</span>
<span id="cb26-5"><a href="#cb26-5" aria-hidden="true" tabindex="-1"></a> , <span class="fu">error</span></span>
<span id="cb26-6"><a href="#cb26-6" aria-hidden="true" tabindex="-1"></a> ) <span class="kw">where</span></span>
<span id="cb26-7"><a href="#cb26-7" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-8"><a href="#cb26-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb26-9"><a href="#cb26-9" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-10"><a href="#cb26-10" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Logger</span> <span class="kw">as</span> <span class="dt">L</span></span>
<span id="cb26-11"><a href="#cb26-11" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff.Class</span> (class <span class="dt">MonadEff</span>, liftEff)</span>
<span id="cb26-12"><a href="#cb26-12" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff.Console</span> <span class="kw">as</span> <span class="dt">C</span></span>
<span id="cb26-13"><a href="#cb26-13" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff.Now</span> (<span class="dt">NOW</span>, now)</span>
<span id="cb26-14"><a href="#cb26-14" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.DateTime.Instant</span> (toDateTime)</span>
<span id="cb26-15"><a href="#cb26-15" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Either</span> (fromRight)</span>
<span id="cb26-16"><a href="#cb26-16" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Formatter.DateTime</span> (<span class="dt">Formatter</span>, format, parseFormatString)</span>
<span id="cb26-17"><a href="#cb26-17" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Generic.Rep</span> (class <span class="dt">Generic</span>)</span>
<span id="cb26-18"><a href="#cb26-18" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Generic.Rep.Show</span> (genericShow)</span>
<span id="cb26-19"><a href="#cb26-19" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.String</span> (toUpper)</span>
<span id="cb26-20"><a href="#cb26-20" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Partial.Unsafe</span> (unsafePartial)</span>
<span id="cb26-21"><a href="#cb26-21" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-22"><a href="#cb26-22" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">Level</span> <span class="ot">=</span> <span class="dt">Debug</span> <span class="op">|</span> <span class="dt">Info</span> <span class="op">|</span> <span class="dt">Warn</span> <span class="op">|</span> <span class="dt">Error</span></span>
<span id="cb26-23"><a href="#cb26-23" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-24"><a href="#cb26-24" aria-hidden="true" tabindex="-1"></a>derive <span class="kw">instance</span><span class="ot"> eqLevel ::</span> <span class="dt">Eq</span> <span class="dt">Level</span></span>
<span id="cb26-25"><a href="#cb26-25" aria-hidden="true" tabindex="-1"></a>derive <span class="kw">instance</span><span class="ot"> ordLevel ::</span> <span class="dt">Ord</span> <span class="dt">Level</span></span>
<span id="cb26-26"><a href="#cb26-26" aria-hidden="true" tabindex="-1"></a>derive <span class="kw">instance</span><span class="ot"> genericLevel ::</span> <span class="dt">Generic</span> <span class="dt">Level</span> _</span>
<span id="cb26-27"><a href="#cb26-27" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-28"><a href="#cb26-28" aria-hidden="true" tabindex="-1"></a><span class="kw">instance</span><span class="ot"> showLevel ::</span> <span class="dt">Show</span> <span class="dt">Level</span> <span class="kw">where</span></span>
<span id="cb26-29"><a href="#cb26-29" aria-hidden="true" tabindex="-1"></a> <span class="fu">show</span> <span class="ot">=</span> <span class="fu">toUpper</span> <span class="op"><<<</span> genericShow</span>
<span id="cb26-30"><a href="#cb26-30" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-31"><a href="#cb26-31" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> <span class="dt">Entry</span> <span class="ot">=</span></span>
<span id="cb26-32"><a href="#cb26-32" aria-hidden="true" tabindex="-1"></a> {<span class="ot"> level ::</span> <span class="dt">Level</span></span>
<span id="cb26-33"><a href="#cb26-33" aria-hidden="true" tabindex="-1"></a> ,<span class="ot"> message ::</span> <span class="dt">String</span></span>
<span id="cb26-34"><a href="#cb26-34" aria-hidden="true" tabindex="-1"></a> }</span>
<span id="cb26-35"><a href="#cb26-35" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-36"><a href="#cb26-36" aria-hidden="true" tabindex="-1"></a><span class="ot">dtFormatter ::</span> <span class="dt">Formatter</span></span>
<span id="cb26-37"><a href="#cb26-37" aria-hidden="true" tabindex="-1"></a>dtFormatter <span class="ot">=</span> unsafePartial <span class="op">$</span> fromRight <span class="op">$</span> parseFormatString <span class="st">"YYYY-MM-DD HH:mm:ss.SSS"</span></span>
<span id="cb26-38"><a href="#cb26-38" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-39"><a href="#cb26-39" aria-hidden="true" tabindex="-1"></a><span class="ot">logger ::</span> <span class="kw">forall</span> m e<span class="op">.</span> (</span>
<span id="cb26-40"><a href="#cb26-40" aria-hidden="true" tabindex="-1"></a> <span class="dt">MonadEff</span> (<span class="ot">console ::</span> <span class="dt">C.CONSOLE</span>,<span class="ot"> now ::</span> <span class="dt">NOW</span> <span class="op">|</span> e) m) <span class="ot">=></span> <span class="dt">L.Logger</span> m <span class="dt">Entry</span></span>
<span id="cb26-41"><a href="#cb26-41" aria-hidden="true" tabindex="-1"></a>logger <span class="ot">=</span> <span class="dt">L.Logger</span> <span class="op">$</span> \{ level, message } <span class="ot">-></span> liftEff <span class="kw">do</span></span>
<span id="cb26-42"><a href="#cb26-42" aria-hidden="true" tabindex="-1"></a> time <span class="ot"><-</span> toDateTime <span class="op"><$></span> now</span>
<span id="cb26-43"><a href="#cb26-43" aria-hidden="true" tabindex="-1"></a> C.log <span class="op">$</span> <span class="st">"["</span> <span class="op"><></span> format dtFormatter time <span class="op"><></span> <span class="st">"] "</span> <span class="op"><></span> <span class="fu">show</span> level <span class="op"><></span> <span class="st">" "</span> <span class="op"><></span> message</span>
<span id="cb26-44"><a href="#cb26-44" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-45"><a href="#cb26-45" aria-hidden="true" tabindex="-1"></a><span class="fu">log</span><span class="ot"> ::</span> <span class="kw">forall</span> m e<span class="op">.</span></span>
<span id="cb26-46"><a href="#cb26-46" aria-hidden="true" tabindex="-1"></a> <span class="dt">MonadEff</span> (<span class="ot">console ::</span> <span class="dt">C.CONSOLE</span> ,<span class="ot"> now ::</span> <span class="dt">NOW</span> <span class="op">|</span> e) m</span>
<span id="cb26-47"><a href="#cb26-47" aria-hidden="true" tabindex="-1"></a> <span class="ot">=></span> <span class="dt">Entry</span> <span class="ot">-></span> m <span class="dt">Unit</span></span>
<span id="cb26-48"><a href="#cb26-48" aria-hidden="true" tabindex="-1"></a><span class="fu">log</span> entry<span class="op">@</span>{level} <span class="ot">=</span> L.log (L.cfilter (\e <span class="ot">-></span> e<span class="op">.</span>level <span class="op">==</span> level) logger) entry</span>
<span id="cb26-49"><a href="#cb26-49" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-50"><a href="#cb26-50" aria-hidden="true" tabindex="-1"></a><span class="ot">debug ::</span> <span class="kw">forall</span> m e<span class="op">.</span></span>
<span id="cb26-51"><a href="#cb26-51" aria-hidden="true" tabindex="-1"></a> <span class="dt">MonadEff</span> (<span class="ot">console ::</span> <span class="dt">C.CONSOLE</span> ,<span class="ot"> now ::</span> <span class="dt">NOW</span> <span class="op">|</span> e) m <span class="ot">=></span> <span class="dt">String</span> <span class="ot">-></span> m <span class="dt">Unit</span></span>
<span id="cb26-52"><a href="#cb26-52" aria-hidden="true" tabindex="-1"></a>debug message <span class="ot">=</span> <span class="fu">log</span> { level<span class="op">:</span> <span class="dt">Debug</span>, message }</span>
<span id="cb26-53"><a href="#cb26-53" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-54"><a href="#cb26-54" aria-hidden="true" tabindex="-1"></a><span class="ot">info ::</span> <span class="kw">forall</span> m e<span class="op">.</span></span>
<span id="cb26-55"><a href="#cb26-55" aria-hidden="true" tabindex="-1"></a> <span class="dt">MonadEff</span> (<span class="ot">console ::</span> <span class="dt">C.CONSOLE</span> ,<span class="ot"> now ::</span> <span class="dt">NOW</span> <span class="op">|</span> e) m <span class="ot">=></span> <span class="dt">String</span> <span class="ot">-></span> m <span class="dt">Unit</span></span>
<span id="cb26-56"><a href="#cb26-56" aria-hidden="true" tabindex="-1"></a>info message <span class="ot">=</span> <span class="fu">log</span> { level<span class="op">:</span> <span class="dt">Info</span>, message }</span>
<span id="cb26-57"><a href="#cb26-57" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-58"><a href="#cb26-58" aria-hidden="true" tabindex="-1"></a><span class="ot">warn ::</span> <span class="kw">forall</span> m e<span class="op">.</span></span>
<span id="cb26-59"><a href="#cb26-59" aria-hidden="true" tabindex="-1"></a> <span class="dt">MonadEff</span> (<span class="ot">console ::</span> <span class="dt">C.CONSOLE</span> ,<span class="ot"> now ::</span> <span class="dt">NOW</span> <span class="op">|</span> e) m <span class="ot">=></span> <span class="dt">String</span> <span class="ot">-></span> m <span class="dt">Unit</span></span>
<span id="cb26-60"><a href="#cb26-60" aria-hidden="true" tabindex="-1"></a>warn message <span class="ot">=</span> <span class="fu">log</span> { level<span class="op">:</span> <span class="dt">Warn</span>, message }</span>
<span id="cb26-61"><a href="#cb26-61" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-62"><a href="#cb26-62" aria-hidden="true" tabindex="-1"></a><span class="fu">error</span><span class="ot"> ::</span> <span class="kw">forall</span> m e<span class="op">.</span></span>
<span id="cb26-63"><a href="#cb26-63" aria-hidden="true" tabindex="-1"></a> <span class="dt">MonadEff</span> (<span class="ot">console ::</span> <span class="dt">C.CONSOLE</span> ,<span class="ot"> now ::</span> <span class="dt">NOW</span> <span class="op">|</span> e) m <span class="ot">=></span> <span class="dt">String</span> <span class="ot">-></span> m <span class="dt">Unit</span></span>
<span id="cb26-64"><a href="#cb26-64" aria-hidden="true" tabindex="-1"></a><span class="fu">error</span> message <span class="ot">=</span> <span class="fu">log</span> { level<span class="op">:</span> <span class="dt">Error</span>, message }</span></code></pre></div>
<p><code>purescript-logging</code> lets us define our own logging levels and loggers. We define four log levels, and a log entry type with the log level and the message. Then we write the logger which will print the log entry to <code>stdout</code> along with the current time as a well formatted string. We define convenience functions for each log level.</p>
<p>Before we proceed, let’s install the required dependencies.</p>
<pre class="numberSource terminal"><code>$ bower install --save purescript-logging purescript-now purescript-formatters</code></pre>
<p>Now we add a request logger middleware to our server in the <code>src/SimpleService/Server.purs</code> file:</p>
<div class="sourceCode" id="cb28" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb28-1"><a href="#cb28-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb28-2"><a href="#cb28-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff.Console</span> (<span class="dt">CONSOLE</span>)</span>
<span id="cb28-3"><a href="#cb28-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff.Now</span> (<span class="dt">NOW</span>)</span>
<span id="cb28-4"><a href="#cb28-4" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Maybe</span> (maybe)</span>
<span id="cb28-5"><a href="#cb28-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.String</span> (toUpper)</span>
<span id="cb28-6"><a href="#cb28-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.App</span> (<span class="dt">App</span>, all, delete, get, http, listenHttp, post, use, useExternal, useOnError)</span>
<span id="cb28-7"><a href="#cb28-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Handler</span> (<span class="dt">Handler</span>, next)</span>
<span id="cb28-8"><a href="#cb28-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Request</span> (getMethod, getPath)</span>
<span id="cb28-9"><a href="#cb28-9" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Logger</span> <span class="kw">as</span> <span class="dt">Log</span></span>
<span id="cb28-10"><a href="#cb28-10" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb28-11"><a href="#cb28-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb28-12"><a href="#cb28-12" aria-hidden="true" tabindex="-1"></a><span class="ot">requestLogger ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">Handler</span> (<span class="ot">console ::</span> <span class="dt">CONSOLE</span>,<span class="ot"> now ::</span> <span class="dt">NOW</span> <span class="op">|</span> eff)</span>
<span id="cb28-13"><a href="#cb28-13" aria-hidden="true" tabindex="-1"></a>requestLogger <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb28-14"><a href="#cb28-14" aria-hidden="true" tabindex="-1"></a> method <span class="ot"><-</span> getMethod</span>
<span id="cb28-15"><a href="#cb28-15" aria-hidden="true" tabindex="-1"></a> path <span class="ot"><-</span> getPath</span>
<span id="cb28-16"><a href="#cb28-16" aria-hidden="true" tabindex="-1"></a> Log.debug <span class="op">$</span> <span class="st">"HTTP: "</span> <span class="op"><></span> <span class="fu">maybe</span> <span class="st">""</span> <span class="fu">id</span> ((<span class="fu">toUpper</span> <span class="op"><<<</span> <span class="fu">show</span>) <span class="op"><$></span> method) <span class="op"><></span> <span class="st">" "</span> <span class="op"><></span> path</span>
<span id="cb28-17"><a href="#cb28-17" aria-hidden="true" tabindex="-1"></a> next</span>
<span id="cb28-18"><a href="#cb28-18" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb28-19"><a href="#cb28-19" aria-hidden="true" tabindex="-1"></a><span class="ot">app ::</span> <span class="kw">forall</span> eff<span class="op">.</span></span>
<span id="cb28-20"><a href="#cb28-20" aria-hidden="true" tabindex="-1"></a> <span class="dt">PG.Pool</span></span>
<span id="cb28-21"><a href="#cb28-21" aria-hidden="true" tabindex="-1"></a> <span class="ot">-></span> <span class="dt">App</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span>,<span class="ot"> console ::</span> <span class="dt">CONSOLE</span>,<span class="ot"> now ::</span> <span class="dt">NOW</span> <span class="op">|</span> eff)</span>
<span id="cb28-22"><a href="#cb28-22" aria-hidden="true" tabindex="-1"></a>app pool <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb28-23"><a href="#cb28-23" aria-hidden="true" tabindex="-1"></a> useExternal jsonBodyParser</span>
<span id="cb28-24"><a href="#cb28-24" aria-hidden="true" tabindex="-1"></a> use requestLogger</span>
<span id="cb28-25"><a href="#cb28-25" aria-hidden="true" tabindex="-1"></a> <span class="co">-- previous code</span></span></code></pre></div>
<p>We also convert all our previous logging statements which used <code>Console.log</code> to use <code>SimpleService.Logger</code> and add logs in our handlers. We can see logging in effect by restarting the server and hitting it:</p>
<pre class="plain"><code>$ pulp --watch run
* Building project in /Users/abhinav/ps-simple-rest-service
* Build successful.
[2017-09-30 16:02:41.634] INFO Server listening on :4000
[2017-09-30 16:02:43.494] DEBUG HTTP: PATCH /v1/user/3
[2017-09-30 16:02:43.517] DEBUG Updated user: 3
[2017-09-30 16:03:46.615] DEBUG HTTP: DELETE /v1/user/3
[2017-09-30 16:03:46.635] DEBUG Deleted user 3
[2017-09-30 16:05:03.805] DEBUG HTTP: GET /v1/users</code></pre>
<h2 data-track-content data-content-name="conclusion" data-content-piece="ps-simple-rest-service-2" id="conclusion">Conclusion</h2>
<p>In this tutorial we learned how to create a simple JSON REST web service written in PureScript with persistence, validation, configuration and logging. The complete code for this tutorial can be found in <a href="https://github.com/abhin4v/ps-simple-rest-service" target="_blank" rel="noopener">github</a>.</p><p>If you liked this post, please <a href="https://abhinavsarkar.net/posts/ps-simple-rest-service-2/?mtm_campaign=feed#syndications">leave a comment</a>.</p><img referrerpolicy="no-referrer-when-downgrade" src="https://anna.abhinavsarkar.net/matomo.php?idsite=1&rec=1" style="border:0" alt="" />2017-10-01T00:00:00Z<p>To recap, in the <a href="https://abhinavsarkar.net/posts/ps-simple-rest-service/">first</a> part of this two-part tutorial, we built a simple JSON <a href="https://en.wikipedia.org/wiki/REST" target="_blank" rel="noopener">REST</a> web service in <a href="http://purescript.org" target="_blank" rel="noopener">PureScript</a> to create, update, get, list and delete users, backed by a Postgres database. In this part we’ll work on the rest of the features. https://abhinavsarkar.net/posts/ps-simple-rest-service/Writing a Simple REST Web Service in PureScript—Part 12017-09-29T00:00:00ZAbhinav Sarkarhttps://abhinavsarkar.net/about/abhinav@abhinavsarkar.net<p>At <a href="https://nilenso.com" target="_blank" rel="noopener">Nilenso</a>, we’ve been working with a client who has chosen <a href="http://purescript.org" target="_blank" rel="noopener">PureScript</a> as their primary programming language. Since I couldn’t find any canonical documentation on writing a web service in PureScript, I thought I’d jot down the approach that we took.</p>
<p>The aim of this two-part tutorial is to create a simple JSON <a href="https://en.wikipedia.org/wiki/REST" target="_blank" rel="noopener">REST</a> web service written in PureScript, to run on a node.js server. <p>This post was originally published on <a href="https://abhinavsarkar.net/posts/ps-simple-rest-service/?mtm_campaign=feed">abhinavsarkar.net</a>.</p><!--more--> This assumes that you have basic proficiency with PureScript. We have the following requirements:</p>
<ol type="1">
<li>persisting users into a Postgres database.</li>
<li>API endpoints for creating, updating, getting, listing and deleting users.</li>
<li>validation of API requests.</li>
<li>reading the server and database configs from environment variables.</li>
<li>logging HTTP requests and debugging info.</li>
</ol>
<p>In this part we’ll work on setting up the project and on the first two requirements. In the <a href="https://abhinavsarkar.net/posts/ps-simple-rest-service-2/?mtm_campaign=feed">next</a> part we’ll work on the rest of the requirements.</p>
<nav id="toc" class="right-toc"><h3>Contents</h3><ol><li><a href="#setting-up">Setting Up</a></li><li><a href="#types-first">Types First</a></li><li><a href="#persisting-it">Persisting It</a></li><li><a href="#serving-it">Serving It</a><ol><li><a href="#getting-a-user">Getting a User</a></li><li><a href="#deleting-a-user">Deleting a User</a></li><li><a href="#creating-a-user">Creating a User</a></li><li><a href="#updating-a-user">Updating a User</a></li><li><a href="#listing-all-users">Listing all Users</a></li></ol></li><li><a href="#conclusion">Conclusion</a></li></ol></nav>
<h2 data-track-content data-content-name="setting-up" data-content-piece="ps-simple-rest-service" id="setting-up">Setting Up</h2>
<p>We start with installing PureScript and the required tools. This assumes that we have <a href="https://nodejs.org" target="_blank" rel="noopener">node</a> and <a href="https://www.npmjs.com" target="_blank" rel="noopener">npm</a> installed on our machine.</p>
<pre class="plain"><code>$ mkdir -p ~/.local/
$ npm install -g purescript pulp bower --prefix ~/.local/</code></pre>
<p><a href="https://github.com/purescript-contrib/pulp" target="_blank" rel="noopener">Pulp</a> is a build tool for PureScript projects and <a href="http://bower.io" target="_blank" rel="noopener">bower</a> is a package manager used to get PureScript libraries. We’ll have to add <code>~/.local/bin</code> in our <code>$PATH</code> (if it is not already added) to access the binaries installed.</p>
<p>Let’s create a directory for our project and make Pulp initialize it:</p>
<pre class="plain"><code>$ mkdir ps-simple-rest-service
$ cd ps-simple-rest-service
$ pulp init
$ ls
bower.json bower_components src test
$ cat bower.json
{
"name": "ps-simple-rest-service",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
}
}
$ ls bower_components
purescript-console purescript-eff purescript-prelude purescript-psci-support</code></pre>
<p>Pulp creates the basic project structure for us. <code>src</code> directory will contain the source while the <code>test</code> directory will contain the tests. <code>bower.json</code> contains the PureScript libraries as dependencies which are downloaded and installed in the <code>bower_components</code> directory.</p>
<div class="page-break">
</div>
<h2 data-track-content data-content-name="types-first" data-content-piece="ps-simple-rest-service" id="types-first">Types First</h2>
<p>First, we create the types needed in <code>src/SimpleService/Types.purs</code>:</p>
<div class="sourceCode" id="cb3" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb3-1"><a href="#cb3-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">SimpleService.Types</span> <span class="kw">where</span></span>
<span id="cb3-2"><a href="#cb3-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-3"><a href="#cb3-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb3-4"><a href="#cb3-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-5"><a href="#cb3-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foreign.Class</span> (class <span class="dt">Decode</span>, class <span class="dt">Encode</span>)</span>
<span id="cb3-6"><a href="#cb3-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foreign.Generic</span> (defaultOptions, genericDecode, genericEncode)</span>
<span id="cb3-7"><a href="#cb3-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Generic.Rep</span> (class <span class="dt">Generic</span>)</span>
<span id="cb3-8"><a href="#cb3-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Generic.Rep.Show</span> (genericShow)</span>
<span id="cb3-9"><a href="#cb3-9" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-10"><a href="#cb3-10" aria-hidden="true" tabindex="-1"></a><span class="kw">type</span> <span class="dt">UserID</span> <span class="ot">=</span> <span class="dt">Int</span></span>
<span id="cb3-11"><a href="#cb3-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-12"><a href="#cb3-12" aria-hidden="true" tabindex="-1"></a><span class="kw">newtype</span> <span class="dt">User</span> <span class="ot">=</span> <span class="dt">User</span></span>
<span id="cb3-13"><a href="#cb3-13" aria-hidden="true" tabindex="-1"></a> {<span class="ot"> id ::</span> <span class="dt">UserID</span></span>
<span id="cb3-14"><a href="#cb3-14" aria-hidden="true" tabindex="-1"></a> ,<span class="ot"> name ::</span> <span class="dt">String</span></span>
<span id="cb3-15"><a href="#cb3-15" aria-hidden="true" tabindex="-1"></a> }</span>
<span id="cb3-16"><a href="#cb3-16" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-17"><a href="#cb3-17" aria-hidden="true" tabindex="-1"></a>derive <span class="kw">instance</span><span class="ot"> genericUser ::</span> <span class="dt">Generic</span> <span class="dt">User</span> _</span>
<span id="cb3-18"><a href="#cb3-18" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-19"><a href="#cb3-19" aria-hidden="true" tabindex="-1"></a><span class="kw">instance</span><span class="ot"> showUser ::</span> <span class="dt">Show</span> <span class="dt">User</span> <span class="kw">where</span></span>
<span id="cb3-20"><a href="#cb3-20" aria-hidden="true" tabindex="-1"></a> <span class="fu">show</span> <span class="ot">=</span> genericShow</span>
<span id="cb3-21"><a href="#cb3-21" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-22"><a href="#cb3-22" aria-hidden="true" tabindex="-1"></a><span class="kw">instance</span><span class="ot"> decodeUser ::</span> <span class="dt">Decode</span> <span class="dt">User</span> <span class="kw">where</span></span>
<span id="cb3-23"><a href="#cb3-23" aria-hidden="true" tabindex="-1"></a> decode <span class="ot">=</span> genericDecode <span class="op">$</span> defaultOptions { unwrapSingleConstructors <span class="ot">=</span> true }</span>
<span id="cb3-24"><a href="#cb3-24" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb3-25"><a href="#cb3-25" aria-hidden="true" tabindex="-1"></a><span class="kw">instance</span><span class="ot"> encodeUser ::</span> <span class="dt">Encode</span> <span class="dt">User</span> <span class="kw">where</span></span>
<span id="cb3-26"><a href="#cb3-26" aria-hidden="true" tabindex="-1"></a> encode <span class="ot">=</span> genericEncode <span class="op">$</span> defaultOptions { unwrapSingleConstructors <span class="ot">=</span> true }</span></code></pre></div>
<p>We are using the generic support for PureScript types from the <a href="https://pursuit.purescript.org/packages/purescript-generics-rep" target="_blank" rel="noopener"><code>purescript-generics-rep</code></a> and <a href="https://pursuit.purescript.org/packages/purescript-foreign-generic" target="_blank" rel="noopener"><code>purescript-foreign-generic</code></a> libraries to encode and decode the <code>User</code> type to JSON. We install the library by running the following command:</p>
<pre class="plain"><code>$ bower install purescript-foreign-generic --save</code></pre>
<p>Now we can load up the module in the PureScript REPL and try out the JSON conversion features:</p>
<div class="sourceCode" id="cb5" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb5-1"><a href="#cb5-1" aria-hidden="true" tabindex="-1"></a><span class="op">$</span> pulp repl</span>
<span id="cb5-2"><a href="#cb5-2" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="kw">import</span> <span class="dt">SimpleService.Types</span></span>
<span id="cb5-3"><a href="#cb5-3" aria-hidden="true" tabindex="-1"></a><span class="op">></span> user <span class="ot">=</span> <span class="dt">User</span> { <span class="fu">id</span><span class="op">:</span> <span class="dv">1</span>, name<span class="op">:</span> <span class="st">"Abhinav"</span>}</span>
<span id="cb5-4"><a href="#cb5-4" aria-hidden="true" tabindex="-1"></a><span class="op">></span> user</span>
<span id="cb5-5"><a href="#cb5-5" aria-hidden="true" tabindex="-1"></a>(<span class="dt">User</span> { <span class="fu">id</span><span class="op">:</span> <span class="dv">1</span>, name<span class="op">:</span> <span class="st">"Abhinav"</span> })</span>
<span id="cb5-6"><a href="#cb5-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb5-7"><a href="#cb5-7" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="kw">import</span> <span class="dt">Data.Foreign.Generic</span></span>
<span id="cb5-8"><a href="#cb5-8" aria-hidden="true" tabindex="-1"></a><span class="op">></span> userJSON <span class="ot">=</span> encodeJSON user</span>
<span id="cb5-9"><a href="#cb5-9" aria-hidden="true" tabindex="-1"></a><span class="op">></span> userJSON</span>
<span id="cb5-10"><a href="#cb5-10" aria-hidden="true" tabindex="-1"></a><span class="st">"{\"name\":\"Abhinav\",\"id\":1}"</span></span>
<span id="cb5-11"><a href="#cb5-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb5-12"><a href="#cb5-12" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="kw">import</span> <span class="dt">Data.Foreign</span></span>
<span id="cb5-13"><a href="#cb5-13" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="kw">import</span> <span class="dt">Control.Monad.Except.Trans</span></span>
<span id="cb5-14"><a href="#cb5-14" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="kw">import</span> <span class="dt">Data.Identity</span></span>
<span id="cb5-15"><a href="#cb5-15" aria-hidden="true" tabindex="-1"></a><span class="op">></span> dUser <span class="ot">=</span> decodeJSON<span class="ot"> userJSON ::</span> <span class="dt">F</span> <span class="dt">User</span></span>
<span id="cb5-16"><a href="#cb5-16" aria-hidden="true" tabindex="-1"></a><span class="op">></span> eUser <span class="ot">=</span> <span class="kw">let</span> (<span class="dt">Identity</span> eUser) <span class="ot">=</span> runExceptT <span class="op">$</span> dUser <span class="kw">in</span> eUser</span>
<span id="cb5-17"><a href="#cb5-17" aria-hidden="true" tabindex="-1"></a><span class="op">></span> eUser</span>
<span id="cb5-18"><a href="#cb5-18" aria-hidden="true" tabindex="-1"></a>(<span class="dt">Right</span> (<span class="dt">User</span> { <span class="fu">id</span><span class="op">:</span> <span class="dv">1</span>, name<span class="op">:</span> <span class="st">"Abhinav"</span> }))</span></code></pre></div>
<p>We use <code>encodeJSON</code> and <code>decodeJSON</code> functions from the <a href="https://pursuit.purescript.org/packages/purescript-foreign-generic/4.3.0/docs/Data.Foreign.Generic" target="_blank" rel="noopener"><code>Data.Foreign.Generic</code></a> module to encode and decode the <code>User</code> instance to JSON. The return type of <code>decodeJSON</code> is a bit complicated as it needs to return the parsing errors too. In this case, the decoding returns no errors and we get back a <code>Right</code> with the correctly parsed <code>User</code> instance.</p>
<h2 data-track-content data-content-name="persisting-it" data-content-piece="ps-simple-rest-service" id="persisting-it">Persisting It</h2>
<p>Next, we add the support for saving a <code>User</code> instance to a Postgres database. First, we install the required libraries using bower and npm: <a href="https://github.com/brianc/node-postgres" target="_blank" rel="noopener"><code>pg</code></a> for Javascript bindings to call Postgres, <a href="https://pursuit.purescript.org/packages/purescript-aff" target="_blank" rel="noopener"><code>purescript-aff</code></a> for asynchronous processing and <a href="https://pursuit.purescript.org/packages/purescript-postgresql-client" target="_blank" rel="noopener"><code>purescript-postgresql-client</code></a> for PureScript wrapper over <code>pg</code>:</p>
<pre class="plain"><code>$ npm init -y
$ npm install pg@6.4.0 --save
$ bower install purescript-aff --save
$ bower install purescript-postgresql-client --save</code></pre>
<p>Before writing the code, we create the database and the <code>users</code> table using the command-line Postgres client:</p>
<pre class="plain"><code>$ psql postgres
psql (9.5.4)
Type "help" for help.
postgres=# create database simple_service;
CREATE DATABASE
postgres=# \c simple_service
You are now connected to database "simple_service" as user "abhinav".
simple_service=# create table users (id int primary key, name varchar(100) not null);
CREATE TABLE
simple_service=# \d users
Table "public.users"
Column | Type | Modifiers
--------+------------------------+-----------
id | integer | not null
name | character varying(100) | not null
Indexes:
"users_pkey" PRIMARY KEY, btree (id)</code></pre>
<p>Now we add support for converting a <code>User</code> instance to-and-from an SQL row by adding the following code in the <code>src/SimpleService/Types.purs</code> file:</p>
<div class="sourceCode" id="cb8" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb8-1"><a href="#cb8-1" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Array</span> <span class="kw">as</span> <span class="dt">Array</span></span>
<span id="cb8-2"><a href="#cb8-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Either</span> (<span class="dt">Either</span>(..))</span>
<span id="cb8-3"><a href="#cb8-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Database.PostgreSQL</span> (class <span class="dt">FromSQLRow</span>, class <span class="dt">ToSQLRow</span>, fromSQLValue, toSQLValue)</span>
<span id="cb8-4"><a href="#cb8-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb8-5"><a href="#cb8-5" aria-hidden="true" tabindex="-1"></a><span class="co">-- code written earlier</span></span>
<span id="cb8-6"><a href="#cb8-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb8-7"><a href="#cb8-7" aria-hidden="true" tabindex="-1"></a><span class="kw">instance</span><span class="ot"> userFromSQLRow ::</span> <span class="dt">FromSQLRow</span> <span class="dt">User</span> <span class="kw">where</span></span>
<span id="cb8-8"><a href="#cb8-8" aria-hidden="true" tabindex="-1"></a> fromSQLRow [<span class="fu">id</span>, name] <span class="ot">=</span></span>
<span id="cb8-9"><a href="#cb8-9" aria-hidden="true" tabindex="-1"></a> <span class="dt">User</span> <span class="op"><$></span> ({ <span class="fu">id</span><span class="op">:</span> _, name<span class="op">:</span> _} <span class="op"><$></span> fromSQLValue <span class="fu">id</span> <span class="op"><*></span> fromSQLValue name)</span>
<span id="cb8-10"><a href="#cb8-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb8-11"><a href="#cb8-11" aria-hidden="true" tabindex="-1"></a> fromSQLRow xs <span class="ot">=</span> <span class="dt">Left</span> <span class="op">$</span> <span class="st">"Row has "</span> <span class="op"><></span> <span class="fu">show</span> n <span class="op"><></span> <span class="st">" fields, expecting 2."</span></span>
<span id="cb8-12"><a href="#cb8-12" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span> n <span class="ot">=</span> Array.length xs</span>
<span id="cb8-13"><a href="#cb8-13" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb8-14"><a href="#cb8-14" aria-hidden="true" tabindex="-1"></a><span class="kw">instance</span><span class="ot"> userToSQLRow ::</span> <span class="dt">ToSQLRow</span> <span class="dt">User</span> <span class="kw">where</span></span>
<span id="cb8-15"><a href="#cb8-15" aria-hidden="true" tabindex="-1"></a> toSQLRow (<span class="dt">User</span> {<span class="fu">id</span>, name}) <span class="ot">=</span> [toSQLValue <span class="fu">id</span>, toSQLValue name]</span></code></pre></div>
<p>We can try out the persistence support in the REPL:</p>
<div class="sourceCode" id="cb9" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb9-1"><a href="#cb9-1" aria-hidden="true" tabindex="-1"></a><span class="op">$</span> pulp repl</span>
<span id="cb9-2"><a href="#cb9-2" aria-hidden="true" tabindex="-1"></a><span class="dt">PSCi</span>, version <span class="fl">0.11</span><span class="op">.</span><span class="dv">6</span></span>
<span id="cb9-3"><a href="#cb9-3" aria-hidden="true" tabindex="-1"></a><span class="dt">Type</span> <span class="op">:?</span> for help</span>
<span id="cb9-4"><a href="#cb9-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-5"><a href="#cb9-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb9-6"><a href="#cb9-6" aria-hidden="true" tabindex="-1"></a><span class="op">></span></span>
<span id="cb9-7"><a href="#cb9-7" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="kw">import</span> <span class="dt">SimpleService.Types</span></span>
<span id="cb9-8"><a href="#cb9-8" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="kw">import</span> <span class="dt">Control.Monad.Aff</span> (launchAff, liftEff')</span>
<span id="cb9-9"><a href="#cb9-9" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="kw">import</span> <span class="dt">Database.PostgreSQL</span> <span class="kw">as</span> <span class="dt">PG</span></span>
<span id="cb9-10"><a href="#cb9-10" aria-hidden="true" tabindex="-1"></a><span class="op">></span> user <span class="ot">=</span> <span class="dt">User</span> { <span class="fu">id</span><span class="op">:</span> <span class="dv">1</span>, name<span class="op">:</span> <span class="st">"Abhinav"</span> }</span>
<span id="cb9-11"><a href="#cb9-11" aria-hidden="true" tabindex="-1"></a><span class="op">></span> databaseConfig <span class="ot">=</span> {user<span class="op">:</span> <span class="st">"abhinav"</span>, password<span class="op">:</span> <span class="st">""</span>, host<span class="op">:</span> <span class="st">"localhost"</span>, port<span class="op">:</span> <span class="dv">5432</span>, database<span class="op">:</span> <span class="st">"simple_service"</span>, <span class="fu">max</span><span class="op">:</span> <span class="dv">10</span>, idleTimeoutMillis<span class="op">:</span> <span class="dv">1000</span>}</span>
<span id="cb9-12"><a href="#cb9-12" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-13"><a href="#cb9-13" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="op">:</span>paste</span>
<span id="cb9-14"><a href="#cb9-14" aria-hidden="true" tabindex="-1"></a>… void <span class="op">$</span> launchAff <span class="kw">do</span></span>
<span id="cb9-15"><a href="#cb9-15" aria-hidden="true" tabindex="-1"></a>… pool <span class="ot"><-</span> PG.newPool databaseConfig</span>
<span id="cb9-16"><a href="#cb9-16" aria-hidden="true" tabindex="-1"></a>… PG.withConnection pool <span class="op">$</span> \conn <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb9-17"><a href="#cb9-17" aria-hidden="true" tabindex="-1"></a>… PG.execute conn (<span class="dt">PG.Query</span> <span class="st">"insert into users (id, name) values ($1, $2)"</span>) user</span>
<span id="cb9-18"><a href="#cb9-18" aria-hidden="true" tabindex="-1"></a>…</span>
<span id="cb9-19"><a href="#cb9-19" aria-hidden="true" tabindex="-1"></a>unit</span>
<span id="cb9-20"><a href="#cb9-20" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb9-21"><a href="#cb9-21" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="kw">import</span> <span class="dt">Data.Foldable</span> (for_)</span>
<span id="cb9-22"><a href="#cb9-22" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="kw">import</span> <span class="dt">Control.Monad.Eff.Console</span> (logShow)</span>
<span id="cb9-23"><a href="#cb9-23" aria-hidden="true" tabindex="-1"></a><span class="op">></span> <span class="op">:</span>paste</span>
<span id="cb9-24"><a href="#cb9-24" aria-hidden="true" tabindex="-1"></a>… void <span class="op">$</span> launchAff <span class="kw">do</span></span>
<span id="cb9-25"><a href="#cb9-25" aria-hidden="true" tabindex="-1"></a>… pool <span class="ot"><-</span> PG.newPool databaseConfig</span>
<span id="cb9-26"><a href="#cb9-26" aria-hidden="true" tabindex="-1"></a>… PG.withConnection pool <span class="op">$</span> \conn <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb9-27"><a href="#cb9-27" aria-hidden="true" tabindex="-1"></a>…<span class="ot"> users ::</span> <span class="dt">Array</span> <span class="dt">User</span> <span class="ot"><-</span> PG.query conn (<span class="dt">PG.Query</span> <span class="st">"select id, name from users where id = $1"</span>) (<span class="dt">PG.Row1</span> <span class="dv">1</span>)</span>
<span id="cb9-28"><a href="#cb9-28" aria-hidden="true" tabindex="-1"></a>… liftEff' <span class="op">$</span> void <span class="op">$</span> for_ users logShow</span>
<span id="cb9-29"><a href="#cb9-29" aria-hidden="true" tabindex="-1"></a>…</span>
<span id="cb9-30"><a href="#cb9-30" aria-hidden="true" tabindex="-1"></a>unit</span>
<span id="cb9-31"><a href="#cb9-31" aria-hidden="true" tabindex="-1"></a>(<span class="dt">User</span> { <span class="fu">id</span><span class="op">:</span> <span class="dv">1</span>, name<span class="op">:</span> <span class="st">"Abhinav"</span> })</span></code></pre></div>
<p>We create the <code>databaseConfig</code> record with the configs needed to connect to the database. Using the record, we create a new Postgres connection pool (<code>PG.newPool</code>) and get a connection from it (<code>PG.withConnection</code>). We call <code>PG.execute</code> with the connection, the SQL insert query for the users table and the <code>User</code> instance, to insert the user into the table. All of this is done inside <a href="https://pursuit.purescript.org/packages/purescript-aff/3.1.0/docs/Control.Monad.Aff#v:launchAff" target="_blank" rel="noopener"><code>launchAff</code></a> which takes care of sequencing the callbacks correctly to make the asynchronous code look synchronous.</p>
<p>Similarly, in the second part, we query the table using <code>PG.query</code> function by calling it with a connection, the SQL select query and the <code>User</code> ID as the query parameter. It returns an <code>Array</code> of users which we log to the console using the <code>logShow</code> function.</p>
<p>We use this experiment to write the persistence related code in the <code>src/SimpleService/Persistence.purs</code> file:</p>
<div class="sourceCode" id="cb10" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb10-1"><a href="#cb10-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">SimpleService.Persistence</span></span>
<span id="cb10-2"><a href="#cb10-2" aria-hidden="true" tabindex="-1"></a> ( insertUser</span>
<span id="cb10-3"><a href="#cb10-3" aria-hidden="true" tabindex="-1"></a> , findUser</span>
<span id="cb10-4"><a href="#cb10-4" aria-hidden="true" tabindex="-1"></a> , updateUser</span>
<span id="cb10-5"><a href="#cb10-5" aria-hidden="true" tabindex="-1"></a> , deleteUser</span>
<span id="cb10-6"><a href="#cb10-6" aria-hidden="true" tabindex="-1"></a> , listUsers</span>
<span id="cb10-7"><a href="#cb10-7" aria-hidden="true" tabindex="-1"></a> ) <span class="kw">where</span></span>
<span id="cb10-8"><a href="#cb10-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-9"><a href="#cb10-9" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb10-10"><a href="#cb10-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-11"><a href="#cb10-11" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Aff</span> (<span class="dt">Aff</span>)</span>
<span id="cb10-12"><a href="#cb10-12" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Array</span> <span class="kw">as</span> <span class="dt">Array</span></span>
<span id="cb10-13"><a href="#cb10-13" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Maybe</span> (<span class="dt">Maybe</span>)</span>
<span id="cb10-14"><a href="#cb10-14" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Database.PostgreSQL</span> <span class="kw">as</span> <span class="dt">PG</span></span>
<span id="cb10-15"><a href="#cb10-15" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Types</span> (<span class="dt">User</span>(..), <span class="dt">UserID</span>)</span>
<span id="cb10-16"><a href="#cb10-16" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-17"><a href="#cb10-17" aria-hidden="true" tabindex="-1"></a><span class="ot">insertUserQuery ::</span> <span class="dt">String</span></span>
<span id="cb10-18"><a href="#cb10-18" aria-hidden="true" tabindex="-1"></a>insertUserQuery <span class="ot">=</span> <span class="st">"insert into users (id, name) values ($1, $2)"</span></span>
<span id="cb10-19"><a href="#cb10-19" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-20"><a href="#cb10-20" aria-hidden="true" tabindex="-1"></a><span class="ot">findUserQuery ::</span> <span class="dt">String</span></span>
<span id="cb10-21"><a href="#cb10-21" aria-hidden="true" tabindex="-1"></a>findUserQuery <span class="ot">=</span> <span class="st">"select id, name from users where id = $1"</span></span>
<span id="cb10-22"><a href="#cb10-22" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-23"><a href="#cb10-23" aria-hidden="true" tabindex="-1"></a><span class="ot">updateUserQuery ::</span> <span class="dt">String</span></span>
<span id="cb10-24"><a href="#cb10-24" aria-hidden="true" tabindex="-1"></a>updateUserQuery <span class="ot">=</span> <span class="st">"update users set name = $1 where id = $2"</span></span>
<span id="cb10-25"><a href="#cb10-25" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-26"><a href="#cb10-26" aria-hidden="true" tabindex="-1"></a><span class="ot">deleteUserQuery ::</span> <span class="dt">String</span></span>
<span id="cb10-27"><a href="#cb10-27" aria-hidden="true" tabindex="-1"></a>deleteUserQuery <span class="ot">=</span> <span class="st">"delete from users where id = $1"</span></span>
<span id="cb10-28"><a href="#cb10-28" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-29"><a href="#cb10-29" aria-hidden="true" tabindex="-1"></a><span class="ot">listUsersQuery ::</span> <span class="dt">String</span></span>
<span id="cb10-30"><a href="#cb10-30" aria-hidden="true" tabindex="-1"></a>listUsersQuery <span class="ot">=</span> <span class="st">"select id, name from users"</span></span>
<span id="cb10-31"><a href="#cb10-31" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-32"><a href="#cb10-32" aria-hidden="true" tabindex="-1"></a><span class="ot">insertUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Connection</span> <span class="ot">-></span> <span class="dt">User</span></span>
<span id="cb10-33"><a href="#cb10-33" aria-hidden="true" tabindex="-1"></a> <span class="ot">-></span> <span class="dt">Aff</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff) <span class="dt">Unit</span></span>
<span id="cb10-34"><a href="#cb10-34" aria-hidden="true" tabindex="-1"></a>insertUser conn user <span class="ot">=</span></span>
<span id="cb10-35"><a href="#cb10-35" aria-hidden="true" tabindex="-1"></a> PG.execute conn (<span class="dt">PG.Query</span> insertUserQuery) user</span>
<span id="cb10-36"><a href="#cb10-36" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-37"><a href="#cb10-37" aria-hidden="true" tabindex="-1"></a><span class="ot">findUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Connection</span> <span class="ot">-></span> <span class="dt">UserID</span></span>
<span id="cb10-38"><a href="#cb10-38" aria-hidden="true" tabindex="-1"></a> <span class="ot">-></span> <span class="dt">Aff</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff) (<span class="dt">Maybe</span> <span class="dt">User</span>)</span>
<span id="cb10-39"><a href="#cb10-39" aria-hidden="true" tabindex="-1"></a>findUser conn userID <span class="ot">=</span></span>
<span id="cb10-40"><a href="#cb10-40" aria-hidden="true" tabindex="-1"></a> <span class="fu">map</span> Array.head <span class="op">$</span> PG.query conn (<span class="dt">PG.Query</span> findUserQuery) (<span class="dt">PG.Row1</span> userID)</span>
<span id="cb10-41"><a href="#cb10-41" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-42"><a href="#cb10-42" aria-hidden="true" tabindex="-1"></a><span class="ot">updateUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Connection</span> <span class="ot">-></span> <span class="dt">User</span></span>
<span id="cb10-43"><a href="#cb10-43" aria-hidden="true" tabindex="-1"></a> <span class="ot">-></span> <span class="dt">Aff</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff) <span class="dt">Unit</span></span>
<span id="cb10-44"><a href="#cb10-44" aria-hidden="true" tabindex="-1"></a>updateUser conn (<span class="dt">User</span> {<span class="fu">id</span>, name}) <span class="ot">=</span></span>
<span id="cb10-45"><a href="#cb10-45" aria-hidden="true" tabindex="-1"></a> PG.execute conn (<span class="dt">PG.Query</span> updateUserQuery) (<span class="dt">PG.Row2</span> name <span class="fu">id</span>)</span>
<span id="cb10-46"><a href="#cb10-46" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-47"><a href="#cb10-47" aria-hidden="true" tabindex="-1"></a><span class="ot">deleteUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Connection</span> <span class="ot">-></span> <span class="dt">UserID</span></span>
<span id="cb10-48"><a href="#cb10-48" aria-hidden="true" tabindex="-1"></a> <span class="ot">-></span> <span class="dt">Aff</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff) <span class="dt">Unit</span></span>
<span id="cb10-49"><a href="#cb10-49" aria-hidden="true" tabindex="-1"></a>deleteUser conn userID <span class="ot">=</span></span>
<span id="cb10-50"><a href="#cb10-50" aria-hidden="true" tabindex="-1"></a> PG.execute conn (<span class="dt">PG.Query</span> deleteUserQuery) (<span class="dt">PG.Row1</span> userID)</span>
<span id="cb10-51"><a href="#cb10-51" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb10-52"><a href="#cb10-52" aria-hidden="true" tabindex="-1"></a><span class="ot">listUsers ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Connection</span></span>
<span id="cb10-53"><a href="#cb10-53" aria-hidden="true" tabindex="-1"></a> <span class="ot">-></span> <span class="dt">Aff</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff) (<span class="dt">Array</span> <span class="dt">User</span>)</span>
<span id="cb10-54"><a href="#cb10-54" aria-hidden="true" tabindex="-1"></a>listUsers conn <span class="ot">=</span></span>
<span id="cb10-55"><a href="#cb10-55" aria-hidden="true" tabindex="-1"></a> PG.query conn (<span class="dt">PG.Query</span> listUsersQuery) <span class="dt">PG.Row0</span></span></code></pre></div>
<h2 data-track-content data-content-name="serving-it" data-content-piece="ps-simple-rest-service" id="serving-it">Serving It</h2>
<p>We can now write a simple HTTP API over the persistence layer using <a href="https://expressjs.com" target="_blank" rel="noopener">Express</a> to provide CRUD functionality for users. Let’s install Express and <a href="https://pursuit.purescript.org/packages/purescript-express" target="_blank" rel="noopener">purescript-express</a>, the PureScript wrapper over it:</p>
<pre class="plain"><code>$ npm install express --save
$ bower install purescript-express --save</code></pre>
<h3 id="getting-a-user">Getting a User</h3>
<p>We do this top-down. First, we change <code>src/Main.purs</code> to run the HTTP server by providing the server port and database configuration:</p>
<div class="sourceCode" id="cb12" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb12-1"><a href="#cb12-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">Main</span> <span class="kw">where</span></span>
<span id="cb12-2"><a href="#cb12-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb12-3"><a href="#cb12-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb12-4"><a href="#cb12-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb12-5"><a href="#cb12-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff</span> (<span class="dt">Eff</span>)</span>
<span id="cb12-6"><a href="#cb12-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff.Console</span> (<span class="dt">CONSOLE</span>)</span>
<span id="cb12-7"><a href="#cb12-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Database.PostgreSQL</span> <span class="kw">as</span> <span class="dt">PG</span></span>
<span id="cb12-8"><a href="#cb12-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Types</span> (<span class="dt">EXPRESS</span>)</span>
<span id="cb12-9"><a href="#cb12-9" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Server</span> (runServer)</span>
<span id="cb12-10"><a href="#cb12-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb12-11"><a href="#cb12-11" aria-hidden="true" tabindex="-1"></a><span class="ot">main ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">Eff</span> (<span class="ot"> console ::</span> <span class="dt">CONSOLE</span></span>
<span id="cb12-12"><a href="#cb12-12" aria-hidden="true" tabindex="-1"></a> ,<span class="ot"> express ::</span> <span class="dt">EXPRESS</span></span>
<span id="cb12-13"><a href="#cb12-13" aria-hidden="true" tabindex="-1"></a> ,<span class="ot"> postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span></span>
<span id="cb12-14"><a href="#cb12-14" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> eff) <span class="dt">Unit</span></span>
<span id="cb12-15"><a href="#cb12-15" aria-hidden="true" tabindex="-1"></a>main <span class="ot">=</span> runServer port databaseConfig</span>
<span id="cb12-16"><a href="#cb12-16" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb12-17"><a href="#cb12-17" aria-hidden="true" tabindex="-1"></a> port <span class="ot">=</span> <span class="dv">4000</span></span>
<span id="cb12-18"><a href="#cb12-18" aria-hidden="true" tabindex="-1"></a> databaseConfig <span class="ot">=</span> { user<span class="op">:</span> <span class="st">"abhinav"</span></span>
<span id="cb12-19"><a href="#cb12-19" aria-hidden="true" tabindex="-1"></a> , password<span class="op">:</span> <span class="st">""</span></span>
<span id="cb12-20"><a href="#cb12-20" aria-hidden="true" tabindex="-1"></a> , host<span class="op">:</span> <span class="st">"localhost"</span></span>
<span id="cb12-21"><a href="#cb12-21" aria-hidden="true" tabindex="-1"></a> , port<span class="op">:</span> <span class="dv">5432</span></span>
<span id="cb12-22"><a href="#cb12-22" aria-hidden="true" tabindex="-1"></a> , database<span class="op">:</span> <span class="st">"simple_service"</span></span>
<span id="cb12-23"><a href="#cb12-23" aria-hidden="true" tabindex="-1"></a> , <span class="fu">max</span><span class="op">:</span> <span class="dv">10</span></span>
<span id="cb12-24"><a href="#cb12-24" aria-hidden="true" tabindex="-1"></a> , idleTimeoutMillis<span class="op">:</span> <span class="dv">1000</span></span>
<span id="cb12-25"><a href="#cb12-25" aria-hidden="true" tabindex="-1"></a> }</span></code></pre></div>
<p>Next, we wire up the server routes to the handlers in <code>src/SimpleService/Server.purs</code>:</p>
<div class="sourceCode" id="cb13" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb13-1"><a href="#cb13-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">SimpleService.Server</span> (runServer) <span class="kw">where</span></span>
<span id="cb13-2"><a href="#cb13-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb13-3"><a href="#cb13-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb13-4"><a href="#cb13-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb13-5"><a href="#cb13-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Aff</span> (runAff)</span>
<span id="cb13-6"><a href="#cb13-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff</span> (<span class="dt">Eff</span>)</span>
<span id="cb13-7"><a href="#cb13-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff.Class</span> (liftEff)</span>
<span id="cb13-8"><a href="#cb13-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Eff.Console</span> (<span class="dt">CONSOLE</span>, log, logShow)</span>
<span id="cb13-9"><a href="#cb13-9" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Database.PostgreSQL</span> <span class="kw">as</span> <span class="dt">PG</span></span>
<span id="cb13-10"><a href="#cb13-10" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.App</span> (<span class="dt">App</span>, get, listenHttp)</span>
<span id="cb13-11"><a href="#cb13-11" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Types</span> (<span class="dt">EXPRESS</span>)</span>
<span id="cb13-12"><a href="#cb13-12" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Handler</span> (getUser)</span>
<span id="cb13-13"><a href="#cb13-13" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb13-14"><a href="#cb13-14" aria-hidden="true" tabindex="-1"></a><span class="ot">app ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">App</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb13-15"><a href="#cb13-15" aria-hidden="true" tabindex="-1"></a>app pool <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb13-16"><a href="#cb13-16" aria-hidden="true" tabindex="-1"></a> get <span class="st">"/v1/user/:id"</span> <span class="op">$</span> getUser pool</span>
<span id="cb13-17"><a href="#cb13-17" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb13-18"><a href="#cb13-18" aria-hidden="true" tabindex="-1"></a><span class="ot">runServer ::</span> <span class="kw">forall</span> eff<span class="op">.</span></span>
<span id="cb13-19"><a href="#cb13-19" aria-hidden="true" tabindex="-1"></a> <span class="dt">Int</span></span>
<span id="cb13-20"><a href="#cb13-20" aria-hidden="true" tabindex="-1"></a> <span class="ot">-></span> <span class="dt">PG.PoolConfiguration</span></span>
<span id="cb13-21"><a href="#cb13-21" aria-hidden="true" tabindex="-1"></a> <span class="ot">-></span> <span class="dt">Eff</span> (<span class="ot"> express ::</span> <span class="dt">EXPRESS</span></span>
<span id="cb13-22"><a href="#cb13-22" aria-hidden="true" tabindex="-1"></a> ,<span class="ot"> postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span></span>
<span id="cb13-23"><a href="#cb13-23" aria-hidden="true" tabindex="-1"></a> ,<span class="ot"> console ::</span> <span class="dt">CONSOLE</span></span>
<span id="cb13-24"><a href="#cb13-24" aria-hidden="true" tabindex="-1"></a> <span class="op">|</span> eff ) <span class="dt">Unit</span></span>
<span id="cb13-25"><a href="#cb13-25" aria-hidden="true" tabindex="-1"></a>runServer port databaseConfig <span class="ot">=</span> void <span class="op">$</span> runAff logShow <span class="fu">pure</span> <span class="kw">do</span></span>
<span id="cb13-26"><a href="#cb13-26" aria-hidden="true" tabindex="-1"></a> pool <span class="ot"><-</span> PG.newPool databaseConfig</span>
<span id="cb13-27"><a href="#cb13-27" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> app' <span class="ot">=</span> app pool</span>
<span id="cb13-28"><a href="#cb13-28" aria-hidden="true" tabindex="-1"></a> void <span class="op">$</span> liftEff <span class="op">$</span> listenHttp app' port \_ <span class="ot">-></span> <span class="fu">log</span> <span class="op">$</span> <span class="st">"Server listening on :"</span> <span class="op"><></span> <span class="fu">show</span> port</span></code></pre></div>
<p><code>runServer</code> creates a PostgreSQL connection pool and passes it to the <code>app</code> function which creates the Express application, which in turn, binds it to the handler <code>getUser</code>. Then it launches the HTTP server by calling <code>listenHttp</code>.</p>
<p>Finally, we write the actual <code>getUser</code> handler in <code>src/SimpleService/Handler.purs</code>:</p>
<div class="sourceCode" id="cb14" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb14-1"><a href="#cb14-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">SimpleService.Handler</span> <span class="kw">where</span></span>
<span id="cb14-2"><a href="#cb14-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb14-3"><a href="#cb14-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb14-4"><a href="#cb14-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb14-5"><a href="#cb14-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Control.Monad.Aff.Class</span> (liftAff)</span>
<span id="cb14-6"><a href="#cb14-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foreign.Class</span> (encode)</span>
<span id="cb14-7"><a href="#cb14-7" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Int</span> (fromString)</span>
<span id="cb14-8"><a href="#cb14-8" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Maybe</span> (<span class="dt">Maybe</span>(..))</span>
<span id="cb14-9"><a href="#cb14-9" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Database.PostgreSQL</span> <span class="kw">as</span> <span class="dt">PG</span></span>
<span id="cb14-10"><a href="#cb14-10" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Handler</span> (<span class="dt">Handler</span>)</span>
<span id="cb14-11"><a href="#cb14-11" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Request</span> (getRouteParam)</span>
<span id="cb14-12"><a href="#cb14-12" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Response</span> (end, sendJson, setStatus)</span>
<span id="cb14-13"><a href="#cb14-13" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Persistence</span> <span class="kw">as</span> <span class="dt">P</span></span>
<span id="cb14-14"><a href="#cb14-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb14-15"><a href="#cb14-15" aria-hidden="true" tabindex="-1"></a><span class="ot">getUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb14-16"><a href="#cb14-16" aria-hidden="true" tabindex="-1"></a>getUser pool <span class="ot">=</span> getRouteParam <span class="st">"id"</span> <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb14-17"><a href="#cb14-17" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User ID is required"</span> }</span>
<span id="cb14-18"><a href="#cb14-18" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> sUserId <span class="ot">-></span> <span class="kw">case</span> fromString sUserId <span class="kw">of</span></span>
<span id="cb14-19"><a href="#cb14-19" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User ID must be an integer: "</span> <span class="op"><></span> sUserId }</span>
<span id="cb14-20"><a href="#cb14-20" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> userId <span class="ot">-></span> liftAff (PG.withConnection pool <span class="op">$</span> <span class="fu">flip</span> P.findUser userId) <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb14-21"><a href="#cb14-21" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">404</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User not found with id: "</span> <span class="op"><></span> sUserId }</span>
<span id="cb14-22"><a href="#cb14-22" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> user <span class="ot">-></span> respond <span class="dv">200</span> (encode user)</span>
<span id="cb14-23"><a href="#cb14-23" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb14-24"><a href="#cb14-24" aria-hidden="true" tabindex="-1"></a><span class="ot">respond ::</span> <span class="kw">forall</span> eff a<span class="op">.</span> <span class="dt">Int</span> <span class="ot">-></span> a <span class="ot">-></span> <span class="dt">Handler</span> eff</span>
<span id="cb14-25"><a href="#cb14-25" aria-hidden="true" tabindex="-1"></a>respond status body <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb14-26"><a href="#cb14-26" aria-hidden="true" tabindex="-1"></a> setStatus status</span>
<span id="cb14-27"><a href="#cb14-27" aria-hidden="true" tabindex="-1"></a> sendJson body</span>
<span id="cb14-28"><a href="#cb14-28" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb14-29"><a href="#cb14-29" aria-hidden="true" tabindex="-1"></a><span class="ot">respondNoContent ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">Int</span> <span class="ot">-></span> <span class="dt">Handler</span> eff</span>
<span id="cb14-30"><a href="#cb14-30" aria-hidden="true" tabindex="-1"></a>respondNoContent status <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb14-31"><a href="#cb14-31" aria-hidden="true" tabindex="-1"></a> setStatus status</span>
<span id="cb14-32"><a href="#cb14-32" aria-hidden="true" tabindex="-1"></a> end</span></code></pre></div>
<p><code>getUser</code> validates the route parameter for valid user ID, sending error HTTP responses in case of failures. It then calls <code>findUser</code> to find the user and returns appropriate response.</p>
<p>We can test this on the command-line using <a href="https://httpie.org" target="_blank" rel="noopener">HTTPie</a>. We run <code>pulp --watch run</code> in one terminal to start the server with file watching, and test it from another terminal:</p>
<pre class="plain"><code>$ pulp --watch run
* Building project in ps-simple-rest-service
* Build successful.
Server listening on :4000</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/1 # should return the user we created earlier
HTTP/1.1 200 OK
Connection: keep-alive
Content-Length: 25
Content-Type: application/json; charset=utf-8
Date: Sun, 10 Sep 2017 14:32:52 GMT
ETag: W/"19-qmtK9XY+WDrqHTgqtFlV+h+NGOY"
X-Powered-By: Express
{
"id": 1,
"name": "Abhinav"
}</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/s
HTTP/1.1 422 Unprocessable Entity
Connection: keep-alive
Content-Length: 38
Content-Type: application/json; charset=utf-8
Date: Sun, 10 Sep 2017 14:36:04 GMT
ETag: W/"26-//tvORl1gGDUMwgSaqbEpJhuadI"
X-Powered-By: Express
{
"error": "User ID must be an integer: s"
}</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/2
HTTP/1.1 404 Not Found
Connection: keep-alive
Content-Length: 36
Content-Type: application/json; charset=utf-8
Date: Sun, 10 Sep 2017 14:36:11 GMT
ETag: W/"24-IyD5VT4E8/m3kvpwycRBQunI7Uc"
X-Powered-By: Express
{
"error": "User not found with id: 2"
}</code></pre>
<h3 id="deleting-a-user">Deleting a User</h3>
<p><code>deleteUser</code> handler is similar. We add the route in the <code>app</code> function in the <code>src/SimpleService/Server.purs</code> file:</p>
<div class="sourceCode" id="cb19" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb19-1"><a href="#cb19-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb19-2"><a href="#cb19-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.App</span> (<span class="dt">App</span>, delete, get, listenHttp)</span>
<span id="cb19-3"><a href="#cb19-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Handler</span> (deleteUser, getUser)</span>
<span id="cb19-4"><a href="#cb19-4" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb19-5"><a href="#cb19-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb19-6"><a href="#cb19-6" aria-hidden="true" tabindex="-1"></a><span class="ot">app ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">App</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb19-7"><a href="#cb19-7" aria-hidden="true" tabindex="-1"></a>app pool <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb19-8"><a href="#cb19-8" aria-hidden="true" tabindex="-1"></a> get <span class="st">"/v1/user/:id"</span> <span class="op">$</span> getUser pool</span>
<span id="cb19-9"><a href="#cb19-9" aria-hidden="true" tabindex="-1"></a> delete <span class="st">"/v1/user/:id"</span> <span class="op">$</span> deleteUser pool</span>
<span id="cb19-10"><a href="#cb19-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb19-11"><a href="#cb19-11" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span></code></pre></div>
<p>And we add the handler in the <code>src/SimpleService/Handler.purs</code> file:</p>
<div class="sourceCode" id="cb20" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb20-1"><a href="#cb20-1" aria-hidden="true" tabindex="-1"></a><span class="ot">deleteUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb20-2"><a href="#cb20-2" aria-hidden="true" tabindex="-1"></a>deleteUser pool <span class="ot">=</span> getRouteParam <span class="st">"id"</span> <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb20-3"><a href="#cb20-3" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User ID is required"</span> }</span>
<span id="cb20-4"><a href="#cb20-4" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> sUserId <span class="ot">-></span> <span class="kw">case</span> fromString sUserId <span class="kw">of</span></span>
<span id="cb20-5"><a href="#cb20-5" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User ID must be an integer: "</span> <span class="op"><></span> sUserId }</span>
<span id="cb20-6"><a href="#cb20-6" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> userId <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb20-7"><a href="#cb20-7" aria-hidden="true" tabindex="-1"></a> found <span class="ot"><-</span> liftAff <span class="op">$</span> PG.withConnection pool \conn <span class="ot">-></span> PG.withTransaction conn <span class="kw">do</span></span>
<span id="cb20-8"><a href="#cb20-8" aria-hidden="true" tabindex="-1"></a> P.findUser conn userId <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb20-9"><a href="#cb20-9" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="fu">pure</span> false</span>
<span id="cb20-10"><a href="#cb20-10" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> _ <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb20-11"><a href="#cb20-11" aria-hidden="true" tabindex="-1"></a> P.deleteUser conn userId</span>
<span id="cb20-12"><a href="#cb20-12" aria-hidden="true" tabindex="-1"></a> <span class="fu">pure</span> true</span>
<span id="cb20-13"><a href="#cb20-13" aria-hidden="true" tabindex="-1"></a> <span class="kw">if</span> found</span>
<span id="cb20-14"><a href="#cb20-14" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> respondNoContent <span class="dv">204</span></span>
<span id="cb20-15"><a href="#cb20-15" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span> respond <span class="dv">404</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User not found with id: "</span> <span class="op"><></span> sUserId }</span></code></pre></div>
<p>After the usual validations on the route param, <code>deleteUser</code> tries to find the user by the given user ID and if found, it deletes the user. Both the persistence related functions are run inside a single SQL transaction using <code>PG.withTransaction</code> function. <code>deleteUser</code> return 404 status if the user is not found, else it returns 204 status.</p>
<p>Let’s try it out:</p>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/1
HTTP/1.1 200 OK
Connection: keep-alive
Content-Length: 25
Content-Type: application/json; charset=utf-8
Date: Mon, 11 Sep 2017 05:10:50 GMT
ETag: W/"19-GC9FAtbd81t7CtrQgsNuc8HITXU"
X-Powered-By: Express
{
"id": 1,
"name": "Abhinav"
}</code></pre>
<pre class="plain"><code>$ http DELETE http://localhost:4000/v1/user/1
HTTP/1.1 204 No Content
Connection: keep-alive
Date: Mon, 11 Sep 2017 05:10:56 GMT
X-Powered-By: Express</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/1
HTTP/1.1 404 Not Found
Connection: keep-alive
Content-Length: 37
Content-Type: application/json; charset=utf-8
Date: Mon, 11 Sep 2017 05:11:03 GMT
ETag: W/"25-Eoc4ZbEF73CyW8EGh6t2jqI8mLU"
X-Powered-By: Express
{
"error": "User not found with id: 1"
}</code></pre>
<pre class="plain"><code>$ http DELETE http://localhost:4000/v1/user/1
HTTP/1.1 404 Not Found
Connection: keep-alive
Content-Length: 37
Content-Type: application/json; charset=utf-8
Date: Mon, 11 Sep 2017 05:11:05 GMT
ETag: W/"25-Eoc4ZbEF73CyW8EGh6t2jqI8mLU"
X-Powered-By: Express
{
"error": "User not found with id: 1"
}</code></pre>
<div class="page-break">
</div>
<h3 id="creating-a-user">Creating a User</h3>
<p><code>createUser</code> handler is a bit more involved. First, we add an Express middleware to parse the body of the request as JSON. We use <a href="https://github.com/expressjs/body-parser" target="_blank" rel="noopener"><code>body-parser</code></a> for this and access it through PureScript <a href="https://github.com/purescript/documentation/blob/master/guides/FFI.md" target="_blank" rel="noopener">FFI</a>. We create a new file <code>src/SimpleService/Middleware/BodyParser.js</code> with the content:</p>
<div class="sourceCode" id="cb25" data-lang="javascript"><pre class="sourceCode numberSource javascript"><code class="sourceCode javascript"><span id="cb25-1"><a href="#cb25-1" aria-hidden="true" tabindex="-1"></a><span class="st">"use strict"</span><span class="op">;</span></span>
<span id="cb25-2"><a href="#cb25-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb25-3"><a href="#cb25-3" aria-hidden="true" tabindex="-1"></a><span class="kw">var</span> bodyParser <span class="op">=</span> <span class="pp">require</span>(<span class="st">"body-parser"</span>)<span class="op">;</span></span>
<span id="cb25-4"><a href="#cb25-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb25-5"><a href="#cb25-5" aria-hidden="true" tabindex="-1"></a>exports<span class="op">.</span><span class="at">jsonBodyParser</span> <span class="op">=</span> bodyParser<span class="op">.</span><span class="fu">json</span>({</span>
<span id="cb25-6"><a href="#cb25-6" aria-hidden="true" tabindex="-1"></a> <span class="dt">limit</span><span class="op">:</span> <span class="st">"5mb"</span></span>
<span id="cb25-7"><a href="#cb25-7" aria-hidden="true" tabindex="-1"></a>})<span class="op">;</span></span></code></pre></div>
<p>And write a wrapper for it in the file <code>src/SimpleService/Middleware/BodyParser.purs</code> with the content:</p>
<div class="sourceCode" id="cb26" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb26-1"><a href="#cb26-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">SimpleService.Middleware.BodyParser</span> <span class="kw">where</span></span>
<span id="cb26-2"><a href="#cb26-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-3"><a href="#cb26-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Prelude</span></span>
<span id="cb26-4"><a href="#cb26-4" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Function.Uncurried</span> (<span class="dt">Fn3</span>)</span>
<span id="cb26-5"><a href="#cb26-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Types</span> (<span class="dt">ExpressM</span>, <span class="dt">Response</span>, <span class="dt">Request</span>)</span>
<span id="cb26-6"><a href="#cb26-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb26-7"><a href="#cb26-7" aria-hidden="true" tabindex="-1"></a>foreign <span class="kw">import</span> jsonBodyParser ::</span>
<span id="cb26-8"><a href="#cb26-8" aria-hidden="true" tabindex="-1"></a> <span class="kw">forall</span> e<span class="op">.</span> <span class="dt">Fn3</span> <span class="dt">Request</span> <span class="dt">Response</span> (<span class="dt">ExpressM</span> e <span class="dt">Unit</span>) (<span class="dt">ExpressM</span> e <span class="dt">Unit</span>)</span></code></pre></div>
<p>We also install the <code>body-parser</code> npm dependency:</p>
<pre class="plain"><code>$ npm install --save body-parser</code></pre>
<p>Next, we change the <code>app</code> function in the <code>src/SimpleService/Server.purs</code> file to add the middleware and the route:</p>
<div class="sourceCode" id="cb28" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb28-1"><a href="#cb28-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb28-2"><a href="#cb28-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.App</span> (<span class="dt">App</span>, delete, get, listenHttp, post, useExternal)</span>
<span id="cb28-3"><a href="#cb28-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Handler</span> (createUser, deleteUser, getUser)</span>
<span id="cb28-4"><a href="#cb28-4" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Middleware.BodyParser</span> (jsonBodyParser)</span>
<span id="cb28-5"><a href="#cb28-5" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb28-6"><a href="#cb28-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb28-7"><a href="#cb28-7" aria-hidden="true" tabindex="-1"></a><span class="ot">app ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">App</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb28-8"><a href="#cb28-8" aria-hidden="true" tabindex="-1"></a>app pool <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb28-9"><a href="#cb28-9" aria-hidden="true" tabindex="-1"></a> useExternal jsonBodyParser</span>
<span id="cb28-10"><a href="#cb28-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb28-11"><a href="#cb28-11" aria-hidden="true" tabindex="-1"></a> get <span class="st">"/v1/user/:id"</span> <span class="op">$</span> getUser pool</span>
<span id="cb28-12"><a href="#cb28-12" aria-hidden="true" tabindex="-1"></a> delete <span class="st">"/v1/user/:id"</span> <span class="op">$</span> deleteUser pool</span>
<span id="cb28-13"><a href="#cb28-13" aria-hidden="true" tabindex="-1"></a> post <span class="st">"/v1/users"</span> <span class="op">$</span> createUser pool</span></code></pre></div>
<p>And finally, we write the handler in the <code>src/SimpleService/Handler.purs</code> file:</p>
<div class="sourceCode" id="cb29" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb29-1"><a href="#cb29-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb29-2"><a href="#cb29-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Either</span> (<span class="dt">Either</span>(..))</span>
<span id="cb29-3"><a href="#cb29-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foldable</span> (intercalate)</span>
<span id="cb29-4"><a href="#cb29-4" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foreign</span> (renderForeignError)</span>
<span id="cb29-5"><a href="#cb29-5" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Request</span> (getBody, getRouteParam)</span>
<span id="cb29-6"><a href="#cb29-6" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Types</span></span>
<span id="cb29-7"><a href="#cb29-7" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb29-8"><a href="#cb29-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb29-9"><a href="#cb29-9" aria-hidden="true" tabindex="-1"></a><span class="ot">createUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb29-10"><a href="#cb29-10" aria-hidden="true" tabindex="-1"></a>createUser pool <span class="ot">=</span> getBody <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb29-11"><a href="#cb29-11" aria-hidden="true" tabindex="-1"></a> <span class="dt">Left</span> errs <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> intercalate <span class="st">", "</span> <span class="op">$</span> <span class="fu">map</span> renderForeignError errs}</span>
<span id="cb29-12"><a href="#cb29-12" aria-hidden="true" tabindex="-1"></a> <span class="dt">Right</span> u<span class="op">@</span>(<span class="dt">User</span> user) <span class="ot">-></span></span>
<span id="cb29-13"><a href="#cb29-13" aria-hidden="true" tabindex="-1"></a> <span class="kw">if</span> user<span class="op">.</span><span class="fu">id</span> <span class="op"><=</span> <span class="dv">0</span></span>
<span id="cb29-14"><a href="#cb29-14" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User ID must be positive: "</span> <span class="op"><></span> <span class="fu">show</span> user<span class="op">.</span><span class="fu">id</span>}</span>
<span id="cb29-15"><a href="#cb29-15" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span> <span class="kw">if</span> user<span class="op">.</span>name <span class="op">==</span> <span class="st">""</span></span>
<span id="cb29-16"><a href="#cb29-16" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User name must not be empty"</span> }</span>
<span id="cb29-17"><a href="#cb29-17" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span> <span class="kw">do</span></span>
<span id="cb29-18"><a href="#cb29-18" aria-hidden="true" tabindex="-1"></a> liftAff (PG.withConnection pool <span class="op">$</span> <span class="fu">flip</span> P.insertUser u)</span>
<span id="cb29-19"><a href="#cb29-19" aria-hidden="true" tabindex="-1"></a> respondNoContent <span class="dv">201</span></span></code></pre></div>
<p><code>createUser</code> calls <a href="https://pursuit.purescript.org/packages/purescript-express/0.5.2/docs/Node.Express.Request#v:getBody" target="_blank" rel="noopener"><code>getBody</code></a> which has type signature <code>forall e a. (Decode a) => HandlerM (express :: EXPRESS | e) (Either MultipleErrors a)</code>. It returns either a list of parsing errors or a parsed instance, which in our case is a <code>User</code>. In case of errors, we just return the errors rendered as string with a 422 status. If we get a parsed <code>User</code> instance, we do some validations on it, returning appropriate error messages. If all validations pass, we create the user in the database by calling <code>insertUser</code> from the persistence layer and respond with a status 201.</p>
<p>We can try it out:</p>
<pre class="plain"><code>$ http POST http://localhost:4000/v1/users name="abhinav"
HTTP/1.1 422 Unprocessable Entity
Connection: keep-alive
Content-Length: 97
Content-Type: application/json; charset=utf-8
Date: Mon, 11 Sep 2017 05:51:28 GMT
ETag: W/"61-BgsrMukZpImcdwAJEKCZ+70WBb8"
X-Powered-By: Express
{
"error": "Error at array index 0: (ErrorAtProperty \"id\" (TypeMismatch \"Int\" \"Undefined\"))"
}</code></pre>
<pre class="plain"><code>$ http POST http://localhost:4000/v1/users id:=1 name=""
HTTP/1.1 422 Unprocessable Entity
Connection: keep-alive
Content-Length: 39
Content-Type: application/json; charset=utf-8
Date: Mon, 11 Sep 2017 05:51:42 GMT
ETag: W/"27-JQsh12xu/rEFdWy8REF4NMtBUB4"
X-Powered-By: Express
{
"error": "User name must not be empty"
}</code></pre>
<pre class="plain"><code>$ http POST http://localhost:4000/v1/users id:=1 name="abhinav"
HTTP/1.1 201 Created
Connection: keep-alive
Content-Length: 0
Date: Mon, 11 Sep 2017 05:52:23 GMT
X-Powered-By: Express</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/1
HTTP/1.1 200 OK
Connection: keep-alive
Content-Length: 25
Content-Type: application/json; charset=utf-8
Date: Mon, 11 Sep 2017 05:52:30 GMT
ETag: W/"19-GC9FAtbd81t7CtrQgsNuc8HITXU"
X-Powered-By: Express
{
"id": 1,
"name": "abhinav"
}</code></pre>
<p>First try returns a parsing failure because we didn’t provide the <code>id</code> field. Second try is a validation failure because the name was empty. Third try is a success which we confirm by doing a <code>GET</code> request next.</p>
<h3 id="updating-a-user">Updating a User</h3>
<p>We want to allow a user’s name to be updated through the API, but not the user’s ID. So we add a new type to <code>src/SimpleService/Types.purs</code> to represent a possible change in user’s name:</p>
<div class="sourceCode" id="cb34" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb34-1"><a href="#cb34-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb34-2"><a href="#cb34-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foreign.NullOrUndefined</span> (<span class="dt">NullOrUndefined</span>)</span>
<span id="cb34-3"><a href="#cb34-3" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb34-4"><a href="#cb34-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb34-5"><a href="#cb34-5" aria-hidden="true" tabindex="-1"></a><span class="kw">newtype</span> <span class="dt">UserPatch</span> <span class="ot">=</span> <span class="dt">UserPatch</span> {<span class="ot"> name ::</span> <span class="dt">NullOrUndefined</span> <span class="dt">String</span> }</span>
<span id="cb34-6"><a href="#cb34-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb34-7"><a href="#cb34-7" aria-hidden="true" tabindex="-1"></a>derive <span class="kw">instance</span><span class="ot"> genericUserPatch ::</span> <span class="dt">Generic</span> <span class="dt">UserPatch</span> _</span>
<span id="cb34-8"><a href="#cb34-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb34-9"><a href="#cb34-9" aria-hidden="true" tabindex="-1"></a><span class="kw">instance</span><span class="ot"> decodeUserPatch ::</span> <span class="dt">Decode</span> <span class="dt">UserPatch</span> <span class="kw">where</span></span>
<span id="cb34-10"><a href="#cb34-10" aria-hidden="true" tabindex="-1"></a> decode <span class="ot">=</span> genericDecode <span class="op">$</span> defaultOptions { unwrapSingleConstructors <span class="ot">=</span> true }</span></code></pre></div>
<p><a href="https://pursuit.purescript.org/packages/purescript-foreign-generic/4.3.0/docs/Data.Foreign.NullOrUndefined#t:NullOrUndefined" target="_blank" rel="noopener"><code>NullOrUndefined</code></a> is a wrapper over <code>Maybe</code> with added support for Javascript <code>null</code> and <code>undefined</code> values. We define <code>UserPatch</code> as having a possibly null (or undefined) <code>name</code> field.</p>
<p>Now we can add the corresponding handler in <code>src/SimpleService/Handlers.purs</code>:</p>
<div class="sourceCode" id="cb35" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb35-1"><a href="#cb35-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb35-2"><a href="#cb35-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Data.Foreign.NullOrUndefined</span> (unNullOrUndefined)</span>
<span id="cb35-3"><a href="#cb35-3" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb35-4"><a href="#cb35-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb35-5"><a href="#cb35-5" aria-hidden="true" tabindex="-1"></a><span class="ot">updateUser ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb35-6"><a href="#cb35-6" aria-hidden="true" tabindex="-1"></a>updateUser pool <span class="ot">=</span> getRouteParam <span class="st">"id"</span> <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb35-7"><a href="#cb35-7" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User ID is required"</span> }</span>
<span id="cb35-8"><a href="#cb35-8" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> sUserId <span class="ot">-></span> <span class="kw">case</span> fromString sUserId <span class="kw">of</span></span>
<span id="cb35-9"><a href="#cb35-9" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User ID must be positive: "</span> <span class="op"><></span> sUserId }</span>
<span id="cb35-10"><a href="#cb35-10" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> userId <span class="ot">-></span> getBody <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb35-11"><a href="#cb35-11" aria-hidden="true" tabindex="-1"></a> <span class="dt">Left</span> errs <span class="ot">-></span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> intercalate <span class="st">", "</span> <span class="op">$</span> <span class="fu">map</span> renderForeignError errs}</span>
<span id="cb35-12"><a href="#cb35-12" aria-hidden="true" tabindex="-1"></a> <span class="dt">Right</span> (<span class="dt">UserPatch</span> userPatch) <span class="ot">-></span> <span class="kw">case</span> unNullOrUndefined userPatch<span class="op">.</span>name <span class="kw">of</span></span>
<span id="cb35-13"><a href="#cb35-13" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respondNoContent <span class="dv">204</span></span>
<span id="cb35-14"><a href="#cb35-14" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> userName <span class="ot">-></span> <span class="kw">if</span> userName <span class="op">==</span> <span class="st">""</span></span>
<span id="cb35-15"><a href="#cb35-15" aria-hidden="true" tabindex="-1"></a> <span class="kw">then</span> respond <span class="dv">422</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User name must not be empty"</span> }</span>
<span id="cb35-16"><a href="#cb35-16" aria-hidden="true" tabindex="-1"></a> <span class="kw">else</span> <span class="kw">do</span></span>
<span id="cb35-17"><a href="#cb35-17" aria-hidden="true" tabindex="-1"></a> savedUser <span class="ot"><-</span> liftAff <span class="op">$</span> PG.withConnection pool \conn <span class="ot">-></span> PG.withTransaction conn <span class="kw">do</span></span>
<span id="cb35-18"><a href="#cb35-18" aria-hidden="true" tabindex="-1"></a> P.findUser conn userId <span class="op">>>=</span> <span class="kw">case</span> _ <span class="kw">of</span></span>
<span id="cb35-19"><a href="#cb35-19" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="fu">pure</span> <span class="dt">Nothing</span></span>
<span id="cb35-20"><a href="#cb35-20" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> (<span class="dt">User</span> user) <span class="ot">-></span> <span class="kw">do</span></span>
<span id="cb35-21"><a href="#cb35-21" aria-hidden="true" tabindex="-1"></a> <span class="kw">let</span> user' <span class="ot">=</span> <span class="dt">User</span> (user { name <span class="ot">=</span> userName })</span>
<span id="cb35-22"><a href="#cb35-22" aria-hidden="true" tabindex="-1"></a> P.updateUser conn user'</span>
<span id="cb35-23"><a href="#cb35-23" aria-hidden="true" tabindex="-1"></a> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">Just</span> user'</span>
<span id="cb35-24"><a href="#cb35-24" aria-hidden="true" tabindex="-1"></a> <span class="kw">case</span> savedUser <span class="kw">of</span></span>
<span id="cb35-25"><a href="#cb35-25" aria-hidden="true" tabindex="-1"></a> <span class="dt">Nothing</span> <span class="ot">-></span> respond <span class="dv">404</span> { <span class="fu">error</span><span class="op">:</span> <span class="st">"User not found with id: "</span> <span class="op"><></span> sUserId }</span>
<span id="cb35-26"><a href="#cb35-26" aria-hidden="true" tabindex="-1"></a> <span class="dt">Just</span> user <span class="ot">-></span> respond <span class="dv">200</span> (encode user)</span></code></pre></div>
<p>After checking for a valid user ID as before, we get the decoded request body as a <code>UserPatch</code> instance. If the path does not have the <code>name</code> field or has it as <code>null</code>, there is nothing to do and we respond with a 204 status. If the user’s name is present in the patch, we validate it for non-emptiness. Then, within a database transaction, we try to find the user with the given ID, responding with a 404 status if the user is not found. If the user is found, we update the user’s name in the database, and respond with a 200 status and the saved user encoded as the JSON response body.</p>
<p>Finally, we can add the route to our server’s router in <code>src/SimpleService/Server.purs</code> to make the functionality available:</p>
<div class="sourceCode" id="cb36" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb36-1"><a href="#cb36-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb36-2"><a href="#cb36-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.App</span> (<span class="dt">App</span>, delete, get, http, listenHttp, post, useExternal)</span>
<span id="cb36-3"><a href="#cb36-3" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">Node.Express.Types</span> (<span class="dt">EXPRESS</span>, <span class="dt">Method</span>(..))</span>
<span id="cb36-4"><a href="#cb36-4" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Handler</span> (createUser, deleteUser, getUser, updateUser)</span>
<span id="cb36-5"><a href="#cb36-5" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb36-6"><a href="#cb36-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb36-7"><a href="#cb36-7" aria-hidden="true" tabindex="-1"></a><span class="ot">app ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">App</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb36-8"><a href="#cb36-8" aria-hidden="true" tabindex="-1"></a>app pool <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb36-9"><a href="#cb36-9" aria-hidden="true" tabindex="-1"></a> useExternal jsonBodyParser</span>
<span id="cb36-10"><a href="#cb36-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb36-11"><a href="#cb36-11" aria-hidden="true" tabindex="-1"></a> get <span class="st">"/v1/user/:id"</span> <span class="op">$</span> getUser pool</span>
<span id="cb36-12"><a href="#cb36-12" aria-hidden="true" tabindex="-1"></a> delete <span class="st">"/v1/user/:id"</span> <span class="op">$</span> deleteUser pool</span>
<span id="cb36-13"><a href="#cb36-13" aria-hidden="true" tabindex="-1"></a> post <span class="st">"/v1/users"</span> <span class="op">$</span> createUser pool</span>
<span id="cb36-14"><a href="#cb36-14" aria-hidden="true" tabindex="-1"></a> patch <span class="st">"/v1/user/:id"</span> <span class="op">$</span> updateUser pool</span>
<span id="cb36-15"><a href="#cb36-15" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb36-16"><a href="#cb36-16" aria-hidden="true" tabindex="-1"></a> patch <span class="ot">=</span> http (<span class="dt">CustomMethod</span> <span class="st">"patch"</span>)</span></code></pre></div>
<p>We can try it out now:</p>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/1
HTTP/1.1 200 OK
Connection: keep-alive
Content-Length: 26
Content-Type: application/json; charset=utf-8
Date: Fri, 11 Sep 2017 06:41:10 GMT
ETag: W/"1a-hoLBx55zeY8nZFWJh/kM05pXwSA"
X-Powered-By: Express
{
"id": 1,
"name": "abhinav"
}</code></pre>
<pre class="plain"><code>$ http PATCH http://localhost:4000/v1/user/1 name=abhinavsarkar
HTTP/1.1 200 OK
Connection: keep-alive
Content-Length: 31
Content-Type: application/json; charset=utf-8
Date: Fri, 11 Sep 2017 06:41:36 GMT
ETag: W/"1f-EG5i0hq/hYhF0BsuheD9hNXeBpI"
X-Powered-By: Express
{
"id": 1,
"name": "abhinavsarkar"
}</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/user/1
HTTP/1.1 200 OK
Connection: keep-alive
Content-Length: 31
Content-Type: application/json; charset=utf-8
Date: Fri, 11 Sep 2017 06:41:40 GMT
ETag: W/"1f-EG5i0hq/hYhF0BsuheD9hNXeBpI"
X-Powered-By: Express
{
"id": 1,
"name": "abhinavsarkar"
}</code></pre>
<pre class="plain"><code>$ http PATCH http://localhost:4000/v1/user/1
HTTP/1.1 204 No Content
Connection: keep-alive
Date: Fri, 11 Sep 2017 06:42:31 GMT
X-Powered-By: Express</code></pre>
<pre class="plain"><code>$ http PATCH http://localhost:4000/v1/user/1 name=""
HTTP/1.1 422 Unprocessable Entity
Connection: keep-alive
Content-Length: 39
Content-Type: application/json; charset=utf-8
Date: Fri, 11 Sep 2017 06:43:17 GMT
ETag: W/"27-JQsh12xu/rEFdWy8REF4NMtBUB4"
X-Powered-By: Express
{
"error": "User name must not be empty"
}</code></pre>
<div class="page-break">
</div>
<h3 id="listing-all-users">Listing all Users</h3>
<p>Listing all users is quite simple since it doesn’t require us to take any request parameter.</p>
<p>We add the handler to the <code>src/SimpleService/Handler.purs</code> file:</p>
<div class="sourceCode" id="cb42" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb42-1"><a href="#cb42-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb42-2"><a href="#cb42-2" aria-hidden="true" tabindex="-1"></a><span class="ot">listUsers ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">Handler</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb42-3"><a href="#cb42-3" aria-hidden="true" tabindex="-1"></a>listUsers pool <span class="ot">=</span> liftAff (PG.withConnection pool P.listUsers) <span class="op">>>=</span> encode <span class="op">>>></span> respond <span class="dv">200</span></span></code></pre></div>
<p>And the route to the <code>src/SimpleService/Server.purs</code> file:</p>
<div class="sourceCode" id="cb43" data-lang="purescript"><pre class="sourceCode haskell numberSource"><code class="sourceCode haskell"><span id="cb43-1"><a href="#cb43-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb43-2"><a href="#cb43-2" aria-hidden="true" tabindex="-1"></a><span class="kw">import</span> <span class="dt">SimpleService.Handler</span> (createUser, deleteUser, getUser, listUsers, updateUser)</span>
<span id="cb43-3"><a href="#cb43-3" aria-hidden="true" tabindex="-1"></a><span class="co">-- previous code</span></span>
<span id="cb43-4"><a href="#cb43-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb43-5"><a href="#cb43-5" aria-hidden="true" tabindex="-1"></a><span class="ot">app ::</span> <span class="kw">forall</span> eff<span class="op">.</span> <span class="dt">PG.Pool</span> <span class="ot">-></span> <span class="dt">App</span> (<span class="ot">postgreSQL ::</span> <span class="dt">PG.POSTGRESQL</span> <span class="op">|</span> eff)</span>
<span id="cb43-6"><a href="#cb43-6" aria-hidden="true" tabindex="-1"></a>app pool <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb43-7"><a href="#cb43-7" aria-hidden="true" tabindex="-1"></a> useExternal jsonBodyParser</span>
<span id="cb43-8"><a href="#cb43-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb43-9"><a href="#cb43-9" aria-hidden="true" tabindex="-1"></a> get <span class="st">"/v1/user/:id"</span> <span class="op">$</span> getUser pool</span>
<span id="cb43-10"><a href="#cb43-10" aria-hidden="true" tabindex="-1"></a> delete <span class="st">"/v1/user/:id"</span> <span class="op">$</span> deleteUser pool</span>
<span id="cb43-11"><a href="#cb43-11" aria-hidden="true" tabindex="-1"></a> post <span class="st">"/v1/users"</span> <span class="op">$</span> createUser pool</span>
<span id="cb43-12"><a href="#cb43-12" aria-hidden="true" tabindex="-1"></a> patch <span class="st">"/v1/user/:id"</span> <span class="op">$</span> updateUser pool</span>
<span id="cb43-13"><a href="#cb43-13" aria-hidden="true" tabindex="-1"></a> get <span class="st">"/v1/users"</span> <span class="op">$</span> listUsers pool</span>
<span id="cb43-14"><a href="#cb43-14" aria-hidden="true" tabindex="-1"></a> <span class="kw">where</span></span>
<span id="cb43-15"><a href="#cb43-15" aria-hidden="true" tabindex="-1"></a> patch <span class="ot">=</span> http (<span class="dt">CustomMethod</span> <span class="st">"patch"</span>)</span></code></pre></div>
<p>And that’s it. We can test this endpoint:</p>
<pre class="plain"><code>$ http POST http://localhost:4000/v1/users id:=2 name=sarkarabhinav
HTTP/1.1 201 Created
Connection: keep-alive
Content-Length: 0
Date: Fri, 11 Sep 2017 07:06:24 GMT
X-Powered-By: Express</code></pre>
<pre class="plain"><code>$ http GET http://localhost:4000/v1/users
HTTP/1.1 200 OK
Connection: keep-alive
Content-Length: 65
Content-Type: application/json; charset=utf-8
Date: Fri, 11 Sep 2017 07:06:27 GMT
ETag: W/"41-btt9uNdG+9A1RO7SCLOsyMmIyFo"
X-Powered-By: Express
[
{
"id": 1,
"name": "abhinavsarkar"
},
{
"id": 2,
"name": "sarkarabhinav"
}
]</code></pre>
<h2 data-track-content data-content-name="conclusion" data-content-piece="ps-simple-rest-service" id="conclusion">Conclusion</h2>
<p>That concludes the first part of the two-part tutorial. We learned how to set up a PureScript project, how to access a Postgres database and how to create a JSON REST API over the database. The code till the end of this part can be found in <a href="https://github.com/abhin4v/ps-simple-rest-service/tree/9fdfe3a15508a3c29bd4bc96310fcf52b1022678" target="_blank" rel="noopener">github</a>. In the <a href="https://abhinavsarkar.net/posts/ps-simple-rest-service-2/?mtm_campaign=feed">next</a> part, we’ll learn how to do API validation, application configuration and logging.</p><p>If you liked this post, please <a href="https://abhinavsarkar.net/posts/ps-simple-rest-service/?mtm_campaign=feed#syndications">leave a comment</a>.</p><img referrerpolicy="no-referrer-when-downgrade" src="https://anna.abhinavsarkar.net/matomo.php?idsite=1&rec=1" style="border:0" alt="" />2017-09-29T00:00:00Z<p>At <a href="https://nilenso.com" target="_blank" rel="noopener">Nilenso</a>, we’ve been working with a client who has chosen <a href="http://purescript.org" target="_blank" rel="noopener">PureScript</a> as their primary programming language. Since I couldn’t find any canonical documentation on writing a web service in PureScript, I thought I’d jot down the approach that we took.</p>
<p>The aim of this two-part tutorial is to create a simple JSON <a href="https://en.wikipedia.org/wiki/REST" target="_blank" rel="noopener">REST</a> web service written in PureScript, to run on a node.js server.