<?xml version="1.0" encoding="utf-8"?>
<feed xmlns="http://www.w3.org/2005/Atom">
    <title>Andre's Blog</title>
    <link href="http://www.andrevdm.com/atom.xml" rel="self" />
    <link href="http://www.andrevdm.com" />
    <id>http://www.andrevdm.com/atom.xml</id>
    <author>
        <name>Andre Van Der Merwe</name>
        
        <email>blog@andrevdm.com</email>
        
    </author>
    <updated>2025-05-29T00:00:00Z</updated>
    <entry>
    <title>Simple Hindley-Milner in Practice</title>
    <link href="http://www.andrevdm.com/posts/2025-05-29-simple-hm-in-practice.html" />
    <id>http://www.andrevdm.com/posts/2025-05-29-simple-hm-in-practice.html</id>
    <published>2025-05-29T00:00:00Z</published>
    <updated>2025-05-29T00:00:00Z</updated>
    <summary type="html"><![CDATA[<div class="info">
    Posted on May 29, 2025
    
</div>

<div id="post_content" class="post-content">
  <p><a href="$PDF_URL$">📄 Download as PDF</a></p>
<div class="toc">
<ul>
<li>
<a href="#part-1---introduction" id="toc-part-1---introduction">Part
1 - Introduction</a>
<ul>
<li>
<a href="#structure-of-this-document"
id="toc-structure-of-this-document">Structure of this Document</a>
</li>
<li>
<a href="#conventions" id="toc-conventions">Conventions</a>
</li>
<li>
<a href="#scope" id="toc-scope">Scope</a>
</li>
<li>
<a href="#why-lisp" id="toc-why-lisp">Why LISP?</a>
</li>
<li>
<a href="#quick-lisp-primer" id="toc-quick-lisp-primer">Quick Lisp
Primer</a>
</li>
</ul>
</li>
<li>
<a href="#part-2---type-systems" id="toc-part-2---type-systems">Part
2 - Type Systems</a>
<ul>
<li>
<a href="#hindley-milner-type-system"
id="toc-hindley-milner-type-system">Hindley-Milner Type System</a>
</li>
<li>
<a href="#the-type-checker" id="toc-the-type-checker">The Type
Checker</a>
</li>
<li>
<a href="#unification" id="toc-unification">Unification</a>
<ul>
<li>
<a href="#longer-unification-example"
id="toc-longer-unification-example">🧩 Longer unification
Example</a>
</li>
</ul>
</li>
<li>
<a href="#generalisation" id="toc-generalisation">Generalisation</a>
<ul>
<li>
<a href="#instantiation"
id="toc-instantiation">Instantiation</a>
</li>
<li>
<a href="#longer-generalisation-example"
id="toc-longer-generalisation-example">🧩 Longer Generalisation
Example</a>
</li>
<li>
<a href="#infinite-types" id="toc-infinite-types">Infinite
Types</a>
</li>
</ul>
</li>
<li>
<a href="#summary" id="toc-summary">Summary</a>
</li>
</ul>
</li>
<li>
<a href="#part-3---introduction-to-the-code"
id="toc-part-3---introduction-to-the-code">Part 3 - Introduction to the
Code</a>
<ul>
<li>
<a href="#implementation-overview"
id="toc-implementation-overview">Implementation Overview</a>
</li>
<li>
<a href="#compiler-high-level-flow"
id="toc-compiler-high-level-flow">Compiler High Level Flow</a>
</li>
<li>
<a href="#code-conventions" id="toc-code-conventions">Code
Conventions</a>
</li>
<li>
<a href="#monad-transformers"
id="toc-monad-transformers">Monad-Transformers</a>
</li>
</ul>
</li>
<li>
<a href="#part-4---code-walk-through"
id="toc-part-4---code-walk-through">Part 4 - Code Walk-Through</a>
<ul>
<li>
<a href="#parser" id="toc-parser">Parser</a>
<ul>
<li>
<a href="#errors" id="toc-errors">Errors</a>
</li>
</ul>
</li>
<li>
<a href="#resolver" id="toc-resolver">Resolver</a>
</li>
<li>
<a href="#type-checker" id="toc-type-checker">Type Checker</a>
<ul>
<li>
<a href="#type-check-if-expression"
id="toc-type-check-if-expression">Type Check: If Expression</a>
</li>
<li>
<a href="#type-check-do-expression"
id="toc-type-check-do-expression">Type Check: Do Expression</a>
</li>
<li>
<a href="#type-check-lists" id="toc-type-check-lists">Type Check:
Lists</a>
<ul>
<li>
<a href="#non-empty-lists" id="toc-non-empty-lists">Non-empty
Lists</a>
</li>
<li>
<a href="#empty-lists" id="toc-empty-lists">Empty Lists</a>
</li>
</ul>
</li>
<li>
<a href="#type-checking-progress-so-far"
id="toc-type-checking-progress-so-far">Type Checking: Progress So
Far</a>
</li>
<li>
<a href="#generating-fresh-type-variables"
id="toc-generating-fresh-type-variables">Generating Fresh Type
Variables</a>
</li>
<li>
<a href="#occurs-check---preventing-infinite-types"
id="toc-occurs-check---preventing-infinite-types">Occurs Check -
Preventing Infinite Types</a>
</li>
<li>
<a href="#the-substitution-map" id="toc-the-substitution-map">The
Substitution Map</a>
</li>
<li>
<a href="#binding-type-variables---updating-the-substitution-map"
id="toc-binding-type-variables---updating-the-substitution-map">Binding
Type Variables - Updating the Substitution Map</a>
</li>
<li>
<a href="#finding-free-type-variables"
id="toc-finding-free-type-variables">Finding Free Type
Variables</a>
</li>
<li>
<a href="#instantiating-polymorphic-types"
id="toc-instantiating-polymorphic-types">Instantiating Polymorphic
Types</a>
</li>
<li>
<a href="#type-checking-another-progress-check"
id="toc-type-checking-another-progress-check">Type Checking: Another
Progress Check</a>
</li>
<li>
<a href="#generalise" id="toc-generalise">Generalise</a>
</li>
<li>
<a href="#unification-1" id="toc-unification-1">Unification</a>
</li>
<li>
<a href="#type-check-define-expression"
id="toc-type-check-define-expression">🧩 Type Check: Define
Expression</a>
</li>
<li>
<a href="#type-check-function-call"
id="toc-type-check-function-call">🧩 Type Check: Function Call</a>
</li>
<li>
<a href="#type-check-let-expression"
id="toc-type-check-let-expression">🧩 Type Check: Let
Expression</a>
</li>
<li>
<a href="#type-check-lambda-expression"
id="toc-type-check-lambda-expression">🧩 Type Check: Lambda
Expression</a>
</li>
<li>
<a href="#type-check-atom-expression"
id="toc-type-check-atom-expression">🧩 Type Check: Atom
Expression</a>
</li>
<li>
<a href="#limitations-future-work"
id="toc-limitations-future-work">Limitations &amp; Future Work</a>
<ul>
<li>
<a href="#quick-wins" id="toc-quick-wins">Quick Wins</a>
</li>
<li>
<a href="#advanced-features" id="toc-advanced-features">Advanced
Features</a>
</li>
</ul>
</li>
<li>
<a href="#type-checking-summary" id="toc-type-checking-summary">Type
Checking: Summary</a>
</li>
</ul>
</li>
<li>
<a href="#lowering" id="toc-lowering">Lowering</a>
</li>
<li>
<a href="#evaluating" id="toc-evaluating">Evaluating</a>
<ul>
<li>
<a href="#interaction-with-the-external-world"
id="toc-interaction-with-the-external-world">Interaction with the
external world</a>
</li>
<li>
<a href="#primitive-functions"
id="toc-primitive-functions">Primitive Functions</a>
</li>
<li>
<a href="#standard-library" id="toc-standard-library">Standard
Library</a>
</li>
</ul>
</li>
<li>
<a href="#repl" id="toc-repl">REPL</a>
<ul>
<li>
<a href="#startup" id="toc-startup">Startup</a>
</li>
<li>
<a href="#repl-features" id="toc-repl-features">REPL Features</a>
<ul>
<li>
<a href="#commands" id="toc-commands">Commands</a>
</li>
<li>
<a href="#multi-line-mode" id="toc-multi-line-mode">Multi-Line
Mode</a>
</li>
<li>
<a href="#known-types-with-ts" id="toc-known-types-with-ts">Known
Types with <code>:ts</code></a>
</li>
</ul>
</li>
<li>
<a href="#repl-example" id="toc-repl-example">REPL Example</a>
</li>
<li>
<a href="#types-at-runtime" id="toc-types-at-runtime">Types at
Runtime?</a>
</li>
</ul>
</li>
</ul>
</li>
<li>
<a href="#conclusion" id="toc-conclusion">Conclusion</a>
<ul>
<li>
<a href="#further-reading" id="toc-further-reading">Further
Reading</a>
</li>
</ul>
</li>
</ul>
</div>
<h1 id="part-1---introduction">Part 1 - Introduction</h1>
<p>In this post, you’ll learn how to build a lightweight Hindley–Milner type checker in Haskell. No advanced theory is required.
We’ll apply it to a tiny, LISP-inspired language so you can focus on how inference works.</p>
<p>Hindley-Milner inference may seem intimidating, but I believe that it is much more approachable than it first appears.
Each concept is quite understandable. It is just a matter of working through them and building up to the full picture.</p>
<p>Hopefully, you’ll find this post useful if you want to implement a type system of your own, or if you wish to understand how Hindley-Milner works.</p>
<h2 id="structure-of-this-document">Structure of this Document</h2>
<p>This document is structured as follows:</p>
<ol type="1">
<li><a href="#part-1---introduction">Part 1: Introduction and overview.</a></li>
<li><a href="#part-2---type-systems">Part 2: Hindley-Milner type system introduction.</a></li>
<li><a href="#part-3---introduction-to-the-code">Part 3: Introduction to the code.</a></li>
<li><a href="#part-4---code-walk-through">Part 4: Code walk-through.</a></li>
<li><a href="#conclusion">Conclusion.</a></li>
</ol>
<p>The code is available on <a href="https://github.com/andrevdm/hmLispTypeSystem">GitHub</a>.</p>
<h2 id="conventions">Conventions</h2>
<ul>
<li>📝 is used to introduce a new term or concept.</li>
<li>💡 introduces a tip or reminder.</li>
<li>🧩 starts a block that goes into more detail about a specific topic.</li>
</ul>
<h2 id="scope">Scope</h2>
<p>The explanation and code focus on a practical introduction to the Hindley-Milner type system.
This is not meant to be production grade, no consideration given to performance or optimisations for real-world languages.</p>
<p>This post is about implementing a Hindley-Milner type system in Haskell, not about LISP itself.
Many of the features that make LISP interesting are not implemented or discussed in this context. It is just the S-Expression syntax being used.</p>
<p>I believe that it’s often easier to start with a lightweight practical approach, and then decide whether you want to dive into the theory.
I hope that this post will give you enough of a practical understanding of Hindley-Milner type systems that you can then go on to learn more about the theory if you want to.</p>
<p>It should demonstrate that implementing the basics for a small DSL is entirely possible, and not as hard as it may seem at first glance.</p>
<h2 id="why-lisp">Why LISP?</h2>
<p>I’m using a LISP-like language because it is a small language. Using a small subset of LISP means that we can focus on the type system, rather than language itself.</p>
<p>To keep the language minimal, I’m not implementing many of the features of LISP. There are no macros, quoting etc.</p>
<p>Despite this simplicity it is still enough to demonstrate how the type system works. It could also be a starting point for a more complete language if you want to extend it.</p>
<p>If you are interested in seeing a fully-fledged statically typed LISP, take a look at <a href="https://docs.racket-lang.org/ts-guide/">Typed Racket</a>.</p>
<p>For the remainder of this post, I will refer to the language being implemented as “LISP”.</p>
<h2 id="quick-lisp-primer">Quick Lisp Primer</h2>
<p>LISP has a uniform, minimal syntax:</p>
<ul>
<li>Code and data are written as parenthesised lists.</li>
<li>Prefix notation is used: <code>(func arg1 arg2 ...)</code>.</li>
<li>Functions are first-class values.</li>
<li><code>(+ 10 12)</code> results in <code>22</code>.</li>
<li><code>(prn "Hello, World!")</code>
<ul>
<li>same as <code>print("Hello, World!")</code> in Python</li>
<li>or <code>putStrLn "Hello, World!"</code> in Haskell</li>
</ul></li>
</ul>
<p>There are many good resources to learn LISP, so I won’t go into more detail here.</p>
<div class="warning">
<p>⚠️ You do not need to learn LISP to understand this post. The basic concepts of LISP are simple and can be grasped quickly from the context of the code examples.</p>
</div>
<h1 id="part-2---type-systems">Part 2 - Type Systems</h1>
<p>If you are reading this, you are probably already familiar with types and why you might want them, so I won’t cover that here. Instead, we’ll dive straight into how Hindley–Milner inference works.</p>
<p>In short, for the LISP being implemented, we want to ensure that user code is well-typed.</p>
<ul>
<li><code>(+ 10 12)</code> is well-typed.</li>
<li><code>(+ 10 "Hello")</code> is not.</li>
</ul>
<div class="sourceCode" id="cb1"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb1-1"><a href="#cb1-1" aria-hidden="true" tabindex="-1"></a><span class="op">&gt;</span> (<span class="op">+</span> <span class="dv">10</span> <span class="st">&quot;Hello&quot;</span>)</span>
<span id="cb1-2"><a href="#cb1-2" aria-hidden="true" tabindex="-1"></a>Type Error: Unification <span class="kw">mismatch</span></span>
<span id="cb1-3"><a href="#cb1-3" aria-hidden="true" tabindex="-1"></a>expected: Int, but found: String.</span>
<span id="cb1-4"><a href="#cb1-4" aria-hidden="true" tabindex="-1"></a>   <span class="dv">1</span>: (<span class="op">+</span> <span class="dv">10</span> <span class="st">&quot;Hello&quot;</span>)</span>
<span id="cb1-5"><a href="#cb1-5" aria-hidden="true" tabindex="-1"></a>      ^</span>
<span id="cb1-6"><a href="#cb1-6" aria-hidden="true" tabindex="-1"></a>      |</span>
<span id="cb1-7"><a href="#cb1-7" aria-hidden="true" tabindex="-1"></a>      +----------</span></code></pre></div>
<p>You may find that switching between the theory (<a href="#part-2---type-systems">Part 2</a>) and the code (<a href="#part-3---introduction-to-the-code">Part 3</a>) helps you understand the concepts better.</p>
<h2 id="hindley-milner-type-system">Hindley-Milner Type System</h2>
<p>From Wikipedia:</p>
<blockquote>
<p>A classical type system for the lambda calculus with parametric polymorphism.
It deduces types automatically across entire modules, not just local expressions, making it the backbone of ML-style languages.
- <a href="https://en.wikipedia.org/wiki/Hindley%E2%80%93Milner_type_system">Wikipedia</a></p>
</blockquote>
<h2 id="the-type-checker">The Type Checker</h2>
<p><img src="/images/hm_lisp_type_check.png" /></p>
<p>The type checker being discussed here implements the Hindley-Milner type inference algorithm.</p>
<p><strong>What Hindley-Milner Gives You:</strong></p>
<ul>
<li>Type inference – no annotations needed (but supported).</li>
<li>Unification – the workhorse that solves equality between types.</li>
<li>Let-generalisation – automatic polymorphism from monomorphic type bindings.</li>
<li>Principal types – you get the most general type, so your functions remain reusable.</li>
</ul>
<h2 id="unification">Unification</h2>
<div class="note">
<p>📝 <strong>Unification</strong> is the algorithm that, given two type expressions,</p>
<ol type="1">
<li>Determines whether they can be made equal</li>
<li>And if so, constructs the most general substitution for type variables that makes the expressions identical.</li>
</ol>
</div>
<p>For example, calling increment on an integer:</p>
<ul>
<li>Suppose <code>inc</code> is a function with type <code>Int -&gt; Int</code>.</li>
<li>When you write <code>(inc 1)</code>:
<ol type="1">
<li>The type checker sees that <code>inc</code> expects an argument of type <code>Int</code>.</li>
<li>It sees that <code>1</code> is of type <code>Int</code>.</li>
<li>It tries to <strong>unify</strong> the argument type of <code>inc</code> (<code>Int</code>) with the type of <code>1</code> (<code>Int</code>).</li>
<li>Since both are <code>Int</code>, the unification succeeds, and the expression type checks.</li>
</ol></li>
</ul>
<p>Calling increment on a string:</p>
<ul>
<li>If you try <code>(inc "hello")</code>
<ol type="1">
<li>The checker sees that <code>inc</code> expects <code>Int</code>.</li>
<li>It sees <code>"hello"</code> is a <code>String</code>.</li>
<li>Unification of <code>Int</code> with <code>String</code> fails.</li>
<li>A type error is reported.</li>
</ol></li>
</ul>
<p><img src="/images/hm_lisp_unificiation1.svg" /></p>
<div class="note">
<p>📝 A <strong>type variable</strong> is a placeholder that stands for any type. E.g. <code>a</code> or <code>U0</code>.</p>
<p>📝 A <strong>substitution map</strong> tracks which type variables should be replaced by other types or variables, enabling recursive resolution to the final, most specific type during type inference.</p>
</div>
<ul>
<li>The <em>substitution map</em> maps a type variable name (like <code>U0</code>, <code>U1</code>) to another type variable or concrete type.</li>
<li>This can be type variable to type e.g. <code>U0 -&gt; Int</code>, or one type variable to another, e.g. <code>U1 -&gt; U0</code>.</li>
</ul>
<p>During unification, the algorithm uses the substitution map to replace type variables with their mapped types.
(recursively resolving chains like <code>U1 -&gt; U0 -&gt; Int</code>).</p>
<ul>
<li>Lookup <code>U1</code> =&gt; <code>U0</code></li>
<li>Lookup <code>U0</code> =&gt; <code>Int</code></li>
<li>Result: <code>Int</code></li>
</ul>
<div class="warning">
<p>⚠️ The code will prevent infinite types by checking that a type variable never appears within the structure it’s being unified with.
See <a href="#infinite-types">Infinite Types</a> for more details.</p>
</div>
<h3 id="longer-unification-example">🧩 Longer unification Example</h3>
<div class="sourceCode" id="cb2"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb2-1"><a href="#cb2-1" aria-hidden="true" tabindex="-1"></a>(concat3 () () (<span class="kw">list</span> <span class="dv">1</span>))</span></code></pre></div>
<ul>
<li>Assume <code>concat3</code> is <code>concat3 :: [a] -&gt; [a] -&gt; [a] -&gt; [a]</code>.</li>
<li>That is, it takes three lists of the same type and returns a concatenated list of that type.</li>
<li><code>(list 1)</code>: <code>list</code> creates a list, so this function creates a list containing the integer <code>1</code></li>
<li>In this LISP implementation, lists are homogeneous, meaning all elements must be of the same type.</li>
</ul>
<div class="sourceCode" id="cb3"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb3-1"><a href="#cb3-1" aria-hidden="true" tabindex="-1"></a>(concat3</span>
<span id="cb3-2"><a href="#cb3-2" aria-hidden="true" tabindex="-1"></a>   ()        <span class="co">; arg1</span></span>
<span id="cb3-3"><a href="#cb3-3" aria-hidden="true" tabindex="-1"></a>   ()        <span class="co">; arg2</span></span>
<span id="cb3-4"><a href="#cb3-4" aria-hidden="true" tabindex="-1"></a>   (<span class="kw">list</span> <span class="dv">1</span>)  <span class="co">; arg3</span></span>
<span id="cb3-5"><a href="#cb3-5" aria-hidden="true" tabindex="-1"></a>)</span></code></pre></div>
<p>Type checking:</p>
<ol type="1">
<li><dl>
<dt><strong>arg1</strong>: <code>() :: [U1]</code></dt>
<dd>
The first <code>()</code> is inferred as an empty list with element type <code>U1</code> i.e. type <code>[U1]</code>, where <code>U1</code> is a fresh type variable.
</dd>
</dl></li>
<li><dl>
<dt><strong>arg2</strong>: <code>() :: [U2]</code></dt>
<dd>
The second <code>()</code> is also inferred as an empty list of type <code>[U2]</code>, where <code>U2</code> is a another fresh type variable.
</dd>
</dl></li>
<li><dl>
<dt><strong>arg3</strong>: <code>(list 1) :: [Int]</code></dt>
<dd>
arg3: The third argument <code>(list 1)</code> is type-checked and inferred as a list of <code>Int</code>, i.e. <code>[Int]</code>.
</dd>
</dl></li>
</ol>
<div class="tip">
<p>💡 A <strong>fresh type variable</strong> is a new unique type variable that has not been used before in the current type environment.</p>
</div>
<div class="sourceCode" id="cb4"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb4-1"><a href="#cb4-1" aria-hidden="true" tabindex="-1"></a>(concat3</span>
<span id="cb4-2"><a href="#cb4-2" aria-hidden="true" tabindex="-1"></a>   ()        <span class="co">; :: [U1]</span></span>
<span id="cb4-3"><a href="#cb4-3" aria-hidden="true" tabindex="-1"></a>   ()        <span class="co">; :: [U2]</span></span>
<span id="cb4-4"><a href="#cb4-4" aria-hidden="true" tabindex="-1"></a>   (<span class="kw">list</span> <span class="dv">1</span>)  <span class="co">; :: [Int]</span></span>
<span id="cb4-5"><a href="#cb4-5" aria-hidden="true" tabindex="-1"></a>)</span></code></pre></div>
<p>Unification:</p>
<ol type="1">
<li><dl>
<dt>Homogeneous list</dt>
<dd>
All the arguments must be of the same type, so we need to unify <code>U1</code>, <code>U2</code>, and <code>Int</code>.
</dd>
</dl></li>
<li><dl>
<dt>Unify <code>U1 ~ U2</code></dt>
<dd>
This gives us <code>U1 = U2</code> because the types match structurally (They are both fresh type variables and can unify with any type).
</dd>
</dl></li>
<li><dl>
<dt><code>U1 ~ Int</code></dt>
<dd>
Next unify <code>U1</code> with <code>Int</code>, yielding <code>U1 = Int</code>.
</dd>
<dd>
Because <code>U2</code> was already equated to <code>U1</code>, it too becomes <code>Int</code> (through hierarchical lookup).
</dd>
</dl></li>
<li><dl>
<dt>Unify with the function type</dt>
<dd>
<code>concat3</code> has type <code>[a] -&gt; [a] -&gt; [a] -&gt; [a]</code>.
</dd>
<dd>
Unify each argument’s inferred type (<code>[U1]</code>, <code>[U2]</code>, <code>[Int]</code>) with <code>[a]</code>, which after substitution becomes <code>[Int]</code> for all three.
</dd>
<dd>
In other words, solve <code>[a] ~ [U1], [a] ~ [U2], [a] ~ [Int]</code>
</dd>
<dd>
After applying our substitutions (<code>U1 = Int</code>, <code>U2 = Int</code>)
</dd>
<dd>
the signature specializes to <code>[Int] -&gt; [Int] -&gt; [Int] -&gt; [Int]</code>.
</dd>
<dd>
Everything matches
</dd>
</dl></li>
</ol>
<div class="sourceCode" id="cb5"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb5-1"><a href="#cb5-1" aria-hidden="true" tabindex="-1"></a>(concat3     <span class="co">; :: [Int] -&gt; [Int] -&gt; [Int] -&gt; [Int]</span></span>
<span id="cb5-2"><a href="#cb5-2" aria-hidden="true" tabindex="-1"></a>   ()        <span class="co">; :: [Int]</span></span>
<span id="cb5-3"><a href="#cb5-3" aria-hidden="true" tabindex="-1"></a>   ()        <span class="co">; :: [Int]</span></span>
<span id="cb5-4"><a href="#cb5-4" aria-hidden="true" tabindex="-1"></a>   (<span class="kw">list</span> <span class="dv">1</span>)  <span class="co">; :: [Int]</span></span>
<span id="cb5-5"><a href="#cb5-5" aria-hidden="true" tabindex="-1"></a>)            <span class="co">; :: [Int]</span></span></code></pre></div>
<p>✅ And so the unification and type checking succeeds, resulting in the final type of the expression being <code>[Int]</code>.</p>
<h2 id="generalisation">Generalisation</h2>
<div class="note">
<p>📝 <strong>Generalisation</strong> in Hindley-Milner, is the process of turning a monomorphic type into a polymorphic type (forall type) by quantifying its free type variables when binding a value with let.</p>
<p>📝 The <strong>principal type</strong> is sometimes informally called the final inferred type, but technically it refers to the most general type from which all others can be derived by substitution.</p>
</div>
<p>Generalisation is the key to Hindley-Milner’s polymorphism. The type system can determine when a type can be made polymorphic.</p>
<p>If you write a function like <code>(λ (x) x)</code></p>
<ul>
<li>In the <strong>unification</strong> step, the type checker will infer this to have the type <code>U0 -&gt; U0</code>, where <code>U0</code> is a fresh type variable.</li>
<li><strong>Generalisation</strong> will then turn this into a polymorphic type <code>∀ U0. U0 -&gt; U0</code>, meaning it can work with any type.</li>
<li>The <code>forall</code> quantifier <code>∀ U0</code> indicates that <code>U0</code> can be any type, making the function polymorphic.</li>
</ul>
<p>Even though the example is trivial, this mechanism underlies powerful polymorphism in real-world languages like ML and Haskell.</p>
<p>In our checker, we generalise at let-bindings and top-level defines.</p>
<div class="tip">
<p>💡 It may seem as though <code>U0 -&gt; U0</code> should “obviously” be polymorphic. But the type system initially treats <code>U0 -&gt; U0</code> as a monotype.
Meaning <code>U0</code> is a <strong>single unknown type</strong>, <em>not</em> a stand-in for <strong>any type</strong>.</p>
</div>
<ul>
<li>Type inference starts with monotypes by default, because the type checker doesn’t yet know which type variables are local to the expression and which ones can be safely generalised.</li>
<li>This is the safest default: assume nothing is polymorphic until proven otherwise.</li>
<li>And it is why generalisation only happens at <code>let</code> (and define) bindings. It is the point where the type checker can safely say that a value is fully known and can be reused.</li>
</ul>
<h3 id="instantiation">Instantiation</h3>
<div class="note">
<p>📝 <strong>Instantiation</strong>: Replaces all quantified variables in a polymorphic type with fresh type variables.</p>
<p>📝 Instantiation always produces a monotype.</p>
</div>
<ul>
<li>It operates on a <strong>polymorphic type</strong> (i.e., one with a <code>forall</code> quantifier) and replaces each quantified variable with a fresh type variable.</li>
<li>For example, the <em>polytype</em> <code>∀ a b. a -&gt; b -&gt; String</code> is instantiated to the <em>monotype</em> <code>U0 -&gt; U1 -&gt; String</code>, where <code>U0</code> and <code>U1</code> are fresh type variables.</li>
<li>This ensures that each use of a polymorphic value is independent in type inference.</li>
<li>Two type variables cannot be assumed equal just because they share a name in different contexts.</li>
</ul>
<p>Instantiation guarantees that each use of a polymorphic value has its own fresh type variables, preventing unwanted constraints from leaking between uses.</p>
<div class="note">
<p>📝 We instantiate every polymorphic type at <strong>every variable use</strong>.
For example, when you refer to a top‐level identity function or a let‐bound polymorphic value.</p>
</div>
<p>Hindley-Milner’s power comes from its simple, elegant structure. Infer monotypes, generalise at let-bindings, instantiate at use.</p>
<h3 id="longer-generalisation-example">🧩 Longer Generalisation Example</h3>
<div class="sourceCode" id="cb6"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb6-1"><a href="#cb6-1" aria-hidden="true" tabindex="-1"></a>(<span class="kw">let</span> ((<span class="kw">identity</span> (λ (z) z)))</span>
<span id="cb6-2"><a href="#cb6-2" aria-hidden="true" tabindex="-1"></a>  (<span class="kw">let</span> ( (x</span>
<span id="cb6-3"><a href="#cb6-3" aria-hidden="true" tabindex="-1"></a>           (<span class="kw">identity</span> <span class="dv">10</span>))</span>
<span id="cb6-4"><a href="#cb6-4" aria-hidden="true" tabindex="-1"></a>         (y</span>
<span id="cb6-5"><a href="#cb6-5" aria-hidden="true" tabindex="-1"></a>           (<span class="kw">identity</span> <span class="st">&quot;Hello&quot;</span>))</span>
<span id="cb6-6"><a href="#cb6-6" aria-hidden="true" tabindex="-1"></a>       )</span>
<span id="cb6-7"><a href="#cb6-7" aria-hidden="true" tabindex="-1"></a>    (prn y)</span>
<span id="cb6-8"><a href="#cb6-8" aria-hidden="true" tabindex="-1"></a>  )</span>
<span id="cb6-9"><a href="#cb6-9" aria-hidden="true" tabindex="-1"></a>)</span></code></pre></div>
<p>Without generalisation, a single monomorphic binding of identity would lock its type to the first use.
This would make the second call fail.</p>
<p>Here is a look at how generalisation solves this problem.</p>
<ul>
<li>We have a nested <code>let</code> expression.</li>
<li>The outer <code>let</code> binds an <code>identity</code> function.</li>
<li>The inner <code>let</code> binds two variables <code>x</code> and <code>y</code>, both using the <code>identity</code> function.</li>
</ul>
<p>Using what we know from the previous section, we can infer the types step by step.</p>
<div class="sourceCode" id="cb7"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb7-1"><a href="#cb7-1" aria-hidden="true" tabindex="-1"></a>(<span class="kw">let</span> ((<span class="kw">identity</span> (λ (z) z)))      <span class="co">; identity :: U0 -&gt; U0</span></span>
<span id="cb7-2"><a href="#cb7-2" aria-hidden="true" tabindex="-1"></a>  (<span class="kw">let</span> ( (x</span>
<span id="cb7-3"><a href="#cb7-3" aria-hidden="true" tabindex="-1"></a>           (<span class="kw">identity</span> <span class="dv">10</span>))        <span class="co">; 10 :: Int,  identity :: Int -&gt; Int</span></span>
<span id="cb7-4"><a href="#cb7-4" aria-hidden="true" tabindex="-1"></a>         (y</span>
<span id="cb7-5"><a href="#cb7-5" aria-hidden="true" tabindex="-1"></a>           (<span class="kw">identity</span> <span class="st">&quot;Hello&quot;</span>))   <span class="co">; &quot;Hello&quot; :: String, ...</span></span>
<span id="cb7-6"><a href="#cb7-6" aria-hidden="true" tabindex="-1"></a>       )</span>
<span id="cb7-7"><a href="#cb7-7" aria-hidden="true" tabindex="-1"></a>    (prn y)</span>
<span id="cb7-8"><a href="#cb7-8" aria-hidden="true" tabindex="-1"></a>  )</span>
<span id="cb7-9"><a href="#cb7-9" aria-hidden="true" tabindex="-1"></a>)</span></code></pre></div>
<ul>
<li>❌ While unifying <code>x</code> the type checker sees that <code>identity</code> must be <code>Int -&gt; Int</code> because <code>10</code> is an <code>Int</code>.</li>
<li>❌ When checking <code>(identity "Hello")</code>, unification attempts <code>Int ~ String</code> and fails.</li>
</ul>
<p>That is not going to work. This is exactly what generalisation is for.</p>
<p>Instead:</p>
<div class="sourceCode" id="cb8"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb8-1"><a href="#cb8-1" aria-hidden="true" tabindex="-1"></a>(<span class="kw">let</span> ((<span class="kw">identity</span> (λ (z) z)))      <span class="co">; identity :: ∀ U0. U0 -&gt; U0</span></span>
<span id="cb8-2"><a href="#cb8-2" aria-hidden="true" tabindex="-1"></a>  (<span class="kw">let</span> ( (x</span>
<span id="cb8-3"><a href="#cb8-3" aria-hidden="true" tabindex="-1"></a>           (<span class="kw">identity</span> <span class="dv">10</span>))        <span class="co">; 10 :: Int,  identity :: Int -&gt; Int</span></span>
<span id="cb8-4"><a href="#cb8-4" aria-hidden="true" tabindex="-1"></a>         (y</span>
<span id="cb8-5"><a href="#cb8-5" aria-hidden="true" tabindex="-1"></a>           (<span class="kw">identity</span> <span class="st">&quot;Hello&quot;</span>))   <span class="co">; &quot;Hello&quot; :: String, identity :: String -&gt; String</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>    (prn y)</span>
<span id="cb8-8"><a href="#cb8-8" aria-hidden="true" tabindex="-1"></a>  )</span>
<span id="cb8-9"><a href="#cb8-9" aria-hidden="true" tabindex="-1"></a>)</span></code></pre></div>
<ul>
<li>✅ The type checker generalises <code>identity</code> to <code>∀ U0. U0 -&gt; U0</code>.</li>
<li>✅ Now <code>identity</code> can be used with any type, so it can be applied to both <code>10</code> and <code>"Hello"</code> without issue.</li>
</ul>
<h3 id="infinite-types">Infinite Types</h3>
<div class="note">
<p>📝 <strong>Infinite types</strong> are types that are defined in terms of themselves, leading to recursive type definitions that cannot be resolved.</p>
</div>
<p>The Hindley–Milner type checker detects infinite types, using the <strong>occurs</strong> check and rejects them.
Without an occurs check, you could write nonsensical types that make no sense (lead to infinite recursion).</p>
<p>For example:</p>
<div class="sourceCode" id="cb9"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb9-1"><a href="#cb9-1" aria-hidden="true" tabindex="-1"></a>(<span class="kw">let</span> ((x (<span class="kw">list</span> x)))</span>
<span id="cb9-2"><a href="#cb9-2" aria-hidden="true" tabindex="-1"></a>  x)</span></code></pre></div>
<ol type="1">
<li>Infer: In <code>(list x)</code>, if <code>x :: U0</code>, then <code>list x :: [U0]</code>.</li>
<li>Unify: Attempt to solve <code>U0 = [U0]</code>.</li>
<li>Detect: Because <code>U0</code> occurs within <code>[U0]</code>, unification would recurse indefinitely.</li>
</ol>
<h2 id="summary">Summary</h2>
<p>So far you have seen what to expect from a Hindley-Milner type system, and you’ve been introduced to</p>
<ul>
<li>Unification.</li>
<li>The substitution map.</li>
<li>Generalisation.</li>
<li>Instantiation.</li>
<li>Infinite types and the occurs check.</li>
</ul>
<h1 id="part-3---introduction-to-the-code">Part 3 - Introduction to the Code</h1>
<p>With an introduction to the theory handled, let’s look at <a href="https://github.com/andrevdm/hmLispTypeSystem">the code</a> to implement the type system in Haskell.</p>
<h2 id="implementation-overview">Implementation Overview</h2>
<p>As a reminder, here is what this LISP implementation handles:</p>
<ul>
<li>Data types: <code>Int</code>, <code>Bool</code>, <code>String</code>, <code>nil</code>, and lists of these types.</li>
<li>A small set of special forms: <code>lambda</code>, <code>let</code>, <code>define</code>, <code>if</code>, <code>function application</code>.</li>
<li>A small set of primitive functions like <code>+</code>, <code>-</code>, <code>*</code>, <code>and</code>, <code>or</code>, etc.</li>
<li>A tiny standard library.</li>
<li><code>let</code> for defining local variables.</li>
<li><code>define</code> for defining global variables and functions.</li>
</ul>
<h2 id="compiler-high-level-flow">Compiler High Level Flow</h2>
<p>The LISP implementation is quite shallow as discussed, but I’ve also tried to keep it relatively broad.
It could have been only a parser, the type checker and a REPL.
This would miss some interesting parts of actually implementing a type system, so I’ve implemented a few more real-world aspects of the pipeline.</p>
<p>Instead, it looks like this:</p>
<p><img src="/images/hm_lisp_compiler_flow.png" /></p>
<ol type="1">
<li><strong>Parsing</strong>: <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/LispParser.hs">LispParser.hs</a>
<ul>
<li>Converts source code into a simple Abstract Syntax Tree (AST).</li>
<li>No special form recognition. Just simple s-expressions</li>
</ul></li>
<li><strong>Resolver</strong>: <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/Resolver.hs">Resolver.hs</a>
<ul>
<li>Recognizes special forms</li>
<li>Create a more structured AST.</li>
</ul></li>
<li><strong>Type Checking</strong>: <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/TypeChecker.hs">TypeChecker.hs</a>
<ul>
<li>Implements the Hindley-Milner type inference algorithm.</li>
<li>Handles unification, generalisation, and instantiation.</li>
<li>Type checks the resolved AST.</li>
<li>Produces a typed AST with type annotations.</li>
</ul></li>
<li><strong>Lowering</strong>: <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/Eval/Lower.hs">Eval/Lower.hs</a>
<ul>
<li>Converts the typed AST into a lower-level representation.</li>
<li>In this implementation, its effectively just type erasure</li>
</ul></li>
<li><strong>Evaluation</strong>: <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/Eval/Evaluator.hs">Eval/Evaluator.hs</a>
<ul>
<li>Evaluates the lowered AST.</li>
<li>Implements a simple interpreter for the LISP language.</li>
</ul></li>
</ol>
<p>Finally, a REPL (<a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/Repl.hs">Repl.hs</a>) that ties everything together, allowing you to interactively enter LISP code and see the results.</p>
<p>In <a href="#part-4---code-walk-through">Part 4</a> I’ll walk through each of these components in more detail, explaining how they work and fit together.</p>
<h2 id="code-conventions">Code Conventions</h2>
<ul>
<li>I’ve tried to keep the Haskell relatively simple, but what counts as simple is very subjective.</li>
<li>I have a preference for qualified imports, so you’ll see many <code>import xxx as qualified yyy</code> statements.</li>
<li>I am using a custom prelude (<code>Verset</code>) which I prefer because it also encourages qualified imports (not surprisingly, as I created it). Switching to <code>protolude</code> or even the standard prelude should be easy enough.</li>
<li>I’ve used GHC 12.2 but it should work with 9.8 and later.</li>
<li>I’ve tried to add a reasonable amount of code comments. Hopefully you’ll be able to follow the code without too much trouble.</li>
<li><code>pass</code> = <code>pure ()</code></li>
<li>Record fields are made strict using <code>!</code>.</li>
<li>I’m using overloaded-record-dot syntax, so you can use <code>x.field</code> instead of <code>field x</code> for record field access.</li>
<li>Rather than using multiple <code>'</code> (prime) suffixes, I’ll use <code>1</code>, <code>2</code>, etc. So <code>name1 =&gt; name2 =&gt; name3</code> instead of <code>name =&gt; name' =&gt; name''</code>.</li>
</ul>
<h2 id="monad-transformers">Monad-Transformers</h2>
<div class="warning">
<p>⚠️If you are not familiar with monad transformers, do not let this discourage or distract you.</p>
</div>
<p>The type-checker runs in <code>StateT TcState (Except TypeError)</code>.
Think of it as mutable state and early exit in a pure setting. Everything inside is just <code>modify'</code> for state and <code>throwE</code> for errors.
You can safely ignore the plumbing and focus on the core logic.</p>
<p>You could remove the monad transformer entirely, e.g.
- Run entirely in IO, use a TVar for state and throwing actual exceptions for errors.
- Then the type signature would look something like <code>IO (TypeEnv, TypedLispVal)</code>.</p>
<h1 id="part-4---code-walk-through">Part 4 - Code Walk-Through</h1>
<h2 id="parser">Parser</h2>
<p><img src="/images/hm_lisp_parser.png" /></p>
<p>The code for the parser is in <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/LispParser.hs">LispParser.hs</a>.</p>
<div class="sourceCode" id="cb10"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb10-1"><a href="#cb10-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">ParsedLispVal</span></span>
<span id="cb10-2"><a href="#cb10-2" aria-hidden="true" tabindex="-1"></a>  <span class="ot">=</span> <span class="dt">PlNil</span> <span class="op">!</span><span class="dt">Pos</span></span>
<span id="cb10-3"><a href="#cb10-3" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">PlAtom</span> <span class="op">!</span><span class="dt">Pos</span> <span class="dt">Text</span></span>
<span id="cb10-4"><a href="#cb10-4" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">PlInt</span> <span class="op">!</span><span class="dt">Pos</span> <span class="dt">Int</span></span>
<span id="cb10-5"><a href="#cb10-5" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">PlString</span> <span class="op">!</span><span class="dt">Pos</span> <span class="dt">Text</span></span>
<span id="cb10-6"><a href="#cb10-6" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">PlBool</span> <span class="op">!</span><span class="dt">Pos</span> <span class="dt">Bool</span></span>
<span id="cb10-7"><a href="#cb10-7" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">PlList</span> <span class="op">!</span><span class="dt">Pos</span> [<span class="dt">ParsedLispVal</span>]</span>
<span id="cb10-8"><a href="#cb10-8" aria-hidden="true" tabindex="-1"></a>  <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</span></code></pre></div>
<p><img src="/images/hm_lisp_parse1.png" /></p>
<p>The parser is intentionally minimal. It only generates low-level s-expressions.
No form recognition is done here.</p>
<p>For example, the following LISP code:</p>
<div class="sourceCode" id="cb11"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb11-1"><a href="#cb11-1" aria-hidden="true" tabindex="-1"></a>(<span class="kw">if</span> <span class="dv">#t</span> <span class="dv">1</span> <span class="dv">2</span>)</span></code></pre></div>
<p>Would be parsed into the following AST (position elided):</p>
<div class="sourceCode" id="cb12"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb12-1"><a href="#cb12-1" aria-hidden="true" tabindex="-1"></a><span class="dt">PlList</span> (<span class="dt">Pos</span> <span class="op">...</span>) [</span>
<span id="cb12-2"><a href="#cb12-2" aria-hidden="true" tabindex="-1"></a>  <span class="dt">PlAtom</span> (<span class="dt">Pos</span> <span class="op">...</span>) <span class="st">&quot;if&quot;</span>,</span>
<span id="cb12-3"><a href="#cb12-3" aria-hidden="true" tabindex="-1"></a>  <span class="dt">PlBool</span> (<span class="dt">Pos</span> <span class="op">...</span>) <span class="dt">True</span>,</span>
<span id="cb12-4"><a href="#cb12-4" aria-hidden="true" tabindex="-1"></a>  <span class="dt">PlInt</span> (<span class="dt">Pos</span> <span class="op">...</span>) <span class="dv">1</span>,</span>
<span id="cb12-5"><a href="#cb12-5" aria-hidden="true" tabindex="-1"></a>  <span class="dt">PlInt</span> (<span class="dt">Pos</span> <span class="op">...</span>) <span class="dv">2</span></span>
<span id="cb12-6"><a href="#cb12-6" aria-hidden="true" tabindex="-1"></a>]</span></code></pre></div>
<p>At this stage, there is no difference between special forms, lists, definitions, or function applications.
That is all handled in the resolver.</p>
<p>There are tradeoffs here. A simple parser is easy to implement and understand. You might keep the parser simple like this even in a much more complete LISP implementation.</p>
<p>The simpler parser AST may be the homoiconic AST that you’d want the user to see and manipulate (e.g. for macros). But you might alternatively opt to recognise more forms in the parser itself.</p>
<h3 id="errors">Errors</h3>
<p>Even a basic language can benefit from readable error messages.
By tagging each <code>ParsedLispVal</code> with a <code>Pos</code> we can track the exact line and column that the node was parsed from.</p>
<p><code>getSourcePos</code> from <a href="https://hackage.haskell.org/package/megaparsec">megaparsec</a> makes this easy.</p>
<div class="sourceCode" id="cb13"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb13-1"><a href="#cb13-1" aria-hidden="true" tabindex="-1"></a><span class="ot">atPos ::</span> <span class="dt">LispParser</span> <span class="dt">Pos</span></span>
<span id="cb13-2"><a href="#cb13-2" aria-hidden="true" tabindex="-1"></a>atPos <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb13-3"><a href="#cb13-3" aria-hidden="true" tabindex="-1"></a>  p <span class="ot">&lt;-</span> M.getSourcePos</span>
<span id="cb13-4"><a href="#cb13-4" aria-hidden="true" tabindex="-1"></a>  <span class="fu">pure</span> <span class="op">$</span> <span class="dt">Pos</span> (M.unPos <span class="op">$</span> M.sourceLine p) (M.unPos <span class="op">$</span> M.sourceColumn p)</span></code></pre></div>
<p>This allows us to report errors nicely since we know the line and column of the node:</p>
<div class="sourceCode" id="cb14"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb14-1"><a href="#cb14-1" aria-hidden="true" tabindex="-1"></a> Type Error: Unbound variable `z`</span>
<span id="cb14-2"><a href="#cb14-2" aria-hidden="true" tabindex="-1"></a>    <span class="dv">1</span>:   (<span class="kw">let</span></span>
<span id="cb14-3"><a href="#cb14-3" aria-hidden="true" tabindex="-1"></a>    <span class="dv">2</span>:     ((x <span class="dv">1</span>)</span>
<span id="cb14-4"><a href="#cb14-4" aria-hidden="true" tabindex="-1"></a>    <span class="dv">3</span>:      (y z))</span>
<span id="cb14-5"><a href="#cb14-5" aria-hidden="true" tabindex="-1"></a>               ^</span>
<span id="cb14-6"><a href="#cb14-6" aria-hidden="true" tabindex="-1"></a>               |</span>
<span id="cb14-7"><a href="#cb14-7" aria-hidden="true" tabindex="-1"></a>               +----------</span>
<span id="cb14-8"><a href="#cb14-8" aria-hidden="true" tabindex="-1"></a>    <span class="dv">4</span>:      <span class="dv">#t</span>)</span></code></pre></div>
<p>The various error types (for the parser, resolver, type checker and evaluator) all implement the <code>LispError</code> type class.</p>
<div class="sourceCode" id="cb15"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb15-1"><a href="#cb15-1" aria-hidden="true" tabindex="-1"></a><span class="kw">class</span> <span class="dt">LispError</span> a <span class="kw">where</span></span>
<span id="cb15-2"><a href="#cb15-2" aria-hidden="true" tabindex="-1"></a><span class="ot">  showLispError ::</span> a <span class="ot">-&gt;</span> (<span class="dt">Maybe</span> <span class="dt">Pos</span>, <span class="dt">Text</span>, <span class="dt">Text</span>, <span class="dt">Text</span>) <span class="co">-- (position, type, name, error message)</span></span></code></pre></div>
<p>This allows us to format errors in a consistent way, regardless of the exact error type.</p>
<p>The formatting of errors is done in <code>Printer/PrintError.hs</code> using the <a href="https://hackage.haskell.org/package/prettyprinter">prettyprinter</a>
and <a href="https://hackage.haskell.org/package/prettyprinter-ansi-terminal">prettyprinter-ansi-terminal</a> libraries.</p>
<h2 id="resolver">Resolver</h2>
<p><img src="/images/hm_lisp_resolver.png" /></p>
<p>The parser produces raw lists, but we want a structured AST to work with. The resolver walks each <code>ParsedLispVal</code> and generates structured <code>ResolvedLispVal</code> nodes.</p>
<p>The code for the resolver is in <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/Resolver.hs">Resolver.hs</a>.</p>
<div class="sourceCode" id="cb16"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb16-1"><a href="#cb16-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">ResolvedLispVal</span></span>
<span id="cb16-2"><a href="#cb16-2" aria-hidden="true" tabindex="-1"></a>  <span class="ot">=</span> <span class="dt">RlAtom</span> <span class="op">!</span><span class="dt">Pos</span> <span class="dt">Text</span></span>
<span id="cb16-3"><a href="#cb16-3" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlBool</span> <span class="op">!</span><span class="dt">Pos</span> <span class="dt">Bool</span></span>
<span id="cb16-4"><a href="#cb16-4" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlDefine</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">Text</span> <span class="op">!</span><span class="dt">ResolvedLispVal</span></span>
<span id="cb16-5"><a href="#cb16-5" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlDo</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span>[<span class="dt">ResolvedLispVal</span>]</span>
<span id="cb16-6"><a href="#cb16-6" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlFuncCall</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">ResolvedLispVal</span> <span class="op">!</span>[<span class="dt">ResolvedLispVal</span>]</span>
<span id="cb16-7"><a href="#cb16-7" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlIf</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">ResolvedLispVal</span> <span class="op">!</span><span class="dt">ResolvedLispVal</span> <span class="op">!</span><span class="dt">ResolvedLispVal</span></span>
<span id="cb16-8"><a href="#cb16-8" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlInt</span> <span class="op">!</span><span class="dt">Pos</span> <span class="dt">Int</span></span>
<span id="cb16-9"><a href="#cb16-9" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlLambda</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span>[(<span class="dt">Pos</span>, <span class="dt">Text</span>)] <span class="op">!</span>[<span class="dt">ResolvedLispVal</span>]</span>
<span id="cb16-10"><a href="#cb16-10" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlLet</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">L.LetStyle</span> <span class="op">!</span>[((<span class="dt">Pos</span>, <span class="dt">Text</span>), (<span class="dt">Pos</span>, <span class="dt">ResolvedLispVal</span>))] <span class="op">!</span>[<span class="dt">ResolvedLispVal</span>]</span>
<span id="cb16-11"><a href="#cb16-11" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlList</span> <span class="op">!</span><span class="dt">Pos</span> [<span class="dt">ResolvedLispVal</span>]</span>
<span id="cb16-12"><a href="#cb16-12" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlNil</span> <span class="op">!</span><span class="dt">Pos</span></span>
<span id="cb16-13"><a href="#cb16-13" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">RlString</span> <span class="op">!</span><span class="dt">Pos</span> <span class="dt">Text</span></span>
<span id="cb16-14"><a href="#cb16-14" aria-hidden="true" tabindex="-1"></a>  <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</span></code></pre></div>
<p><img src="/images/hm_lisp_resolve1.png" /></p>
<ul>
<li>The resolver is responsible for creating a more structured AST from the parsed s-expressions.</li>
<li>It recognizes special forms, and converts the parsed s-expressions into AST nodes that are easier to work with in the type checker and evaluator.</li>
<li>E.g. it is much simpler to work with a <code>RlIf</code> than just a <code>PlList</code> with an <code>if</code> atom and three arguments that you would then need to check each time.</li>
</ul>
<p>The main resolver function is <code>resolveImpl</code>, and it looks like this:</p>
<div class="sourceCode" id="cb17"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb17-1"><a href="#cb17-1" aria-hidden="true" tabindex="-1"></a><span class="ot">resolveImpl ::</span> <span class="dt">Bool</span> <span class="ot">-&gt;</span> <span class="dt">P.ParsedLispVal</span> <span class="ot">-&gt;</span> <span class="dt">Either</span> <span class="dt">ResolverError</span> <span class="dt">ResolvedLispVal</span></span>
<span id="cb17-2"><a href="#cb17-2" aria-hidden="true" tabindex="-1"></a>resolveImpl isTopLevel lv <span class="ot">=</span></span>
<span id="cb17-3"><a href="#cb17-3" aria-hidden="true" tabindex="-1"></a>  <span class="kw">case</span> lv <span class="kw">of</span></span>
<span id="cb17-4"><a href="#cb17-4" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- No change</span></span>
<span id="cb17-5"><a href="#cb17-5" aria-hidden="true" tabindex="-1"></a>    <span class="dt">P.PlNil</span> p <span class="ot">-&gt;</span> <span class="dt">Right</span> <span class="op">$</span> <span class="dt">RlNil</span> p</span>
<span id="cb17-6"><a href="#cb17-6" aria-hidden="true" tabindex="-1"></a>    <span class="dt">P.PlInt</span> p v <span class="ot">-&gt;</span> <span class="dt">Right</span> <span class="op">$</span> <span class="dt">RlInt</span> p v</span>
<span id="cb17-7"><a href="#cb17-7" aria-hidden="true" tabindex="-1"></a>    <span class="dt">P.PlString</span> p v <span class="ot">-&gt;</span> <span class="dt">Right</span> <span class="op">$</span> <span class="dt">RlString</span> p v</span>
<span id="cb17-8"><a href="#cb17-8" aria-hidden="true" tabindex="-1"></a>    <span class="dt">P.PlBool</span> p v <span class="ot">-&gt;</span> <span class="dt">Right</span> <span class="op">$</span> <span class="dt">RlBool</span> p v</span>
<span id="cb17-9"><a href="#cb17-9" aria-hidden="true" tabindex="-1"></a>    <span class="dt">P.PlAtom</span> p v <span class="ot">-&gt;</span> <span class="dt">Right</span> <span class="op">$</span> <span class="dt">RlAtom</span> p v</span>
<span id="cb17-10"><a href="#cb17-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb17-11"><a href="#cb17-11" aria-hidden="true" tabindex="-1"></a>    <span class="dt">P.PlList</span> p allVs <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb17-12"><a href="#cb17-12" aria-hidden="true" tabindex="-1"></a>      <span class="kw">case</span> allVs <span class="kw">of</span></span>
<span id="cb17-13"><a href="#cb17-13" aria-hidden="true" tabindex="-1"></a>        (h<span class="op">:</span> vs) <span class="ot">-&gt;</span></span>
<span id="cb17-14"><a href="#cb17-14" aria-hidden="true" tabindex="-1"></a>          <span class="kw">case</span> h <span class="kw">of</span></span>
<span id="cb17-15"><a href="#cb17-15" aria-hidden="true" tabindex="-1"></a>            <span class="dt">P.PlAtom</span> _ <span class="st">&quot;let&quot;</span> <span class="ot">-&gt;</span> resolveLet p <span class="dt">L.LetParallel</span> vs</span>
<span id="cb17-16"><a href="#cb17-16" aria-hidden="true" tabindex="-1"></a>            <span class="dt">P.PlAtom</span> _ <span class="st">&quot;lambda&quot;</span> <span class="ot">-&gt;</span> resolveLambda p vs</span>
<span id="cb17-17"><a href="#cb17-17" aria-hidden="true" tabindex="-1"></a>            <span class="dt">P.PlAtom</span> _ <span class="st">&quot;λ&quot;</span> <span class="ot">-&gt;</span> resolveLambda p vs</span>
<span id="cb17-18"><a href="#cb17-18" aria-hidden="true" tabindex="-1"></a>            <span class="dt">P.PlAtom</span> _ <span class="st">&quot;if&quot;</span> <span class="ot">-&gt;</span> resolveIf p vs</span>
<span id="cb17-19"><a href="#cb17-19" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb17-20"><a href="#cb17-20" aria-hidden="true" tabindex="-1"></a>            <span class="dt">P.PlAtom</span> _ <span class="st">&quot;define&quot;</span> <span class="ot">-&gt;</span></span>
<span id="cb17-21"><a href="#cb17-21" aria-hidden="true" tabindex="-1"></a>              <span class="kw">if</span> isTopLevel</span>
<span id="cb17-22"><a href="#cb17-22" aria-hidden="true" tabindex="-1"></a>                <span class="kw">then</span> resolveDefine p vs</span>
<span id="cb17-23"><a href="#cb17-23" aria-hidden="true" tabindex="-1"></a>                <span class="kw">else</span> <span class="dt">Left</span> <span class="op">.</span> <span class="dt">ReResolverError</span> (<span class="dt">Just</span> p) <span class="op">$</span> <span class="st">&quot;define can only be used at top level&quot;</span></span>
<span id="cb17-24"><a href="#cb17-24" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb17-25"><a href="#cb17-25" aria-hidden="true" tabindex="-1"></a>            <span class="co">-- (list 1 2 3) =&gt; (1 2 3)</span></span>
<span id="cb17-26"><a href="#cb17-26" aria-hidden="true" tabindex="-1"></a>            <span class="dt">P.PlAtom</span> _ <span class="st">&quot;list&quot;</span> <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb17-27"><a href="#cb17-27" aria-hidden="true" tabindex="-1"></a>              vs&#39; <span class="ot">&lt;-</span> <span class="fu">traverse</span> (resolveImpl <span class="dt">False</span>) vs</span>
<span id="cb17-28"><a href="#cb17-28" aria-hidden="true" tabindex="-1"></a>              <span class="dt">Right</span> <span class="op">$</span> <span class="dt">RlList</span> p vs&#39;</span>
<span id="cb17-29"><a href="#cb17-29" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb17-30"><a href="#cb17-30" aria-hidden="true" tabindex="-1"></a>            <span class="dt">P.PlAtom</span> _ <span class="st">&quot;do&quot;</span> <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb17-31"><a href="#cb17-31" aria-hidden="true" tabindex="-1"></a>              vs&#39; <span class="ot">&lt;-</span> <span class="fu">traverse</span> (resolveImpl <span class="dt">False</span>) vs</span>
<span id="cb17-32"><a href="#cb17-32" aria-hidden="true" tabindex="-1"></a>              <span class="dt">Right</span> <span class="op">$</span> <span class="dt">RlDo</span> p vs&#39;</span>
<span id="cb17-33"><a href="#cb17-33" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb17-34"><a href="#cb17-34" aria-hidden="true" tabindex="-1"></a>            <span class="co">-- Everything else is a function call</span></span>
<span id="cb17-35"><a href="#cb17-35" aria-hidden="true" tabindex="-1"></a>            _ <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb17-36"><a href="#cb17-36" aria-hidden="true" tabindex="-1"></a>              f <span class="ot">&lt;-</span> resolveImpl <span class="dt">False</span> h</span>
<span id="cb17-37"><a href="#cb17-37" aria-hidden="true" tabindex="-1"></a>              args <span class="ot">&lt;-</span> <span class="fu">traverse</span> (resolveImpl <span class="dt">False</span>) vs</span>
<span id="cb17-38"><a href="#cb17-38" aria-hidden="true" tabindex="-1"></a>              <span class="dt">Right</span> <span class="op">$</span> <span class="dt">RlFuncCall</span> p f args</span>
<span id="cb17-39"><a href="#cb17-39" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb17-40"><a href="#cb17-40" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb17-41"><a href="#cb17-41" aria-hidden="true" tabindex="-1"></a>        [] <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb17-42"><a href="#cb17-42" aria-hidden="true" tabindex="-1"></a>          <span class="co">-- Empty list is empty list not nil</span></span>
<span id="cb17-43"><a href="#cb17-43" aria-hidden="true" tabindex="-1"></a>          <span class="dt">Right</span> <span class="op">$</span> <span class="dt">RlList</span> p []</span></code></pre></div>
<p>A few things to note here:</p>
<ul>
<li>It recognizes the <code>let</code>, <code>lambda</code>, <code>if</code>, <code>define</code>, and <code>do</code>, special forms as well as function application.</li>
<li>The resolver is recursive, it walks the parsed AST and resolves each node recursively.</li>
<li>We need to track whether we are at the top-level or not, because <code>define</code> can only be used at the top-level.</li>
<li>Lambda can be written as <code>lambda</code> or <code>λ</code>.</li>
<li>There is no type-checking here.</li>
<li>Unlike many (most?) LISP implementations we don’t substitute <code>nil</code> for empty lists or vice versa.</li>
</ul>
<p>Let’s look at <code>resolveDefine</code> to see how that works.</p>
<div class="sourceCode" id="cb18"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb18-1"><a href="#cb18-1" aria-hidden="true" tabindex="-1"></a><span class="ot">resolveDefine ::</span> <span class="dt">Pos</span> <span class="ot">-&gt;</span> [<span class="dt">P.ParsedLispVal</span>] <span class="ot">-&gt;</span> <span class="dt">Either</span> <span class="dt">ResolverError</span> <span class="dt">ResolvedLispVal</span></span>
<span id="cb18-2"><a href="#cb18-2" aria-hidden="true" tabindex="-1"></a>resolveDefine pos vs&#39; <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb18-3"><a href="#cb18-3" aria-hidden="true" tabindex="-1"></a>  <span class="kw">let</span> err <span class="ot">=</span> <span class="st">&quot;expected define in form (define name expr)\n&quot;</span></span>
<span id="cb18-4"><a href="#cb18-4" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb18-5"><a href="#cb18-5" aria-hidden="true" tabindex="-1"></a>  <span class="kw">case</span> vs&#39; <span class="kw">of</span></span>
<span id="cb18-6"><a href="#cb18-6" aria-hidden="true" tabindex="-1"></a>     [name1, val1] <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb18-7"><a href="#cb18-7" aria-hidden="true" tabindex="-1"></a>        name2 <span class="ot">&lt;-</span> as&#39; asAtom <span class="st">&quot;atom&quot;</span> name1 <span class="op">$</span> <span class="dt">Just</span> (err <span class="op">&lt;&gt;</span> <span class="st">&quot;expected atom for name of define&quot;</span>)</span>
<span id="cb18-8"><a href="#cb18-8" aria-hidden="true" tabindex="-1"></a>        val2 <span class="ot">&lt;-</span> resolveImpl <span class="dt">False</span> val1</span>
<span id="cb18-9"><a href="#cb18-9" aria-hidden="true" tabindex="-1"></a>        <span class="fu">pure</span> <span class="op">$</span> <span class="dt">RlDefine</span> pos name2 val2</span>
<span id="cb18-10"><a href="#cb18-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb18-11"><a href="#cb18-11" aria-hidden="true" tabindex="-1"></a>     _ <span class="ot">-&gt;</span></span>
<span id="cb18-12"><a href="#cb18-12" aria-hidden="true" tabindex="-1"></a>       <span class="dt">Left</span> <span class="op">.</span> <span class="dt">ReResolverError</span> (<span class="dt">Just</span> pos) <span class="op">$</span> err <span class="op">&lt;&gt;</span> <span class="st">&quot;Invalid number of arguments for define&quot;</span></span>
<span id="cb18-13"><a href="#cb18-13" aria-hidden="true" tabindex="-1"></a></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><span class="ot">asAtom ::</span> <span class="dt">P.ParsedLispVal</span> <span class="ot">-&gt;</span> <span class="dt">Maybe</span> <span class="dt">Text</span></span>
<span id="cb18-16"><a href="#cb18-16" aria-hidden="true" tabindex="-1"></a>asAtom (<span class="dt">P.PlAtom</span> _ a) <span class="ot">=</span> <span class="dt">Just</span> a</span>
<span id="cb18-17"><a href="#cb18-17" aria-hidden="true" tabindex="-1"></a>asAtom _ <span class="ot">=</span> <span class="dt">Nothing</span></span>
<span id="cb18-18"><a href="#cb18-18" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb18-19"><a href="#cb18-19" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb18-20"><a href="#cb18-20" aria-hidden="true" tabindex="-1"></a><span class="ot">as&#39; ::</span> (<span class="dt">P.ParsedLispVal</span> <span class="ot">-&gt;</span> <span class="dt">Maybe</span> a) <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">P.ParsedLispVal</span> <span class="ot">-&gt;</span> <span class="dt">Maybe</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">Either</span> <span class="dt">ResolverError</span> a</span>
<span id="cb18-21"><a href="#cb18-21" aria-hidden="true" tabindex="-1"></a>as&#39; f n v e&#39; <span class="ot">=</span></span>
<span id="cb18-22"><a href="#cb18-22" aria-hidden="true" tabindex="-1"></a>  <span class="kw">case</span> f v <span class="kw">of</span></span>
<span id="cb18-23"><a href="#cb18-23" aria-hidden="true" tabindex="-1"></a>    <span class="dt">Just</span> v&#39; <span class="ot">-&gt;</span> <span class="dt">Right</span> v&#39;</span>
<span id="cb18-24"><a href="#cb18-24" aria-hidden="true" tabindex="-1"></a>    <span class="dt">Nothing</span> <span class="ot">-&gt;</span></span>
<span id="cb18-25"><a href="#cb18-25" aria-hidden="true" tabindex="-1"></a>      <span class="kw">let</span> e <span class="ot">=</span> <span class="fu">maybe</span> <span class="st">&quot;&quot;</span> (<span class="st">&quot;\n&quot;</span> <span class="op">&lt;&gt;</span>) e&#39; <span class="kw">in</span></span>
<span id="cb18-26"><a href="#cb18-26" aria-hidden="true" tabindex="-1"></a>      <span class="dt">Left</span> <span class="op">$</span> <span class="dt">ReResolverError</span> (<span class="dt">Just</span> <span class="op">$</span> P.getPos v) <span class="op">$</span> <span class="st">&quot;Expected &quot;</span> <span class="op">&lt;&gt;</span> n <span class="op">&lt;&gt;</span> <span class="st">&quot;, but got &quot;</span> <span class="op">&lt;&gt;</span> P.nameOf v <span class="op">&lt;&gt;</span> e</span></code></pre></div>
<p>The resolve functions are all fairly similar. They need to check the s-expression and see if it matches the expected form.</p>
<ul>
<li>The various <code>asXXX</code> functions are used to match the expected type of the node.</li>
<li>The <code>as'</code> function wraps an <code>asXXX</code> call, and converts a mismatch (<code>Nothing</code>) into an error (<code>ResolverError</code>).</li>
<li>The <code>as'</code> function return an <code>Either</code> type. Using <code>as'</code> means that an error will short-circuit the resolution and return immediately.</li>
<li><code>P.nameOf</code> is the <code>nameOf</code> function imported from the <code>LispParser</code> module. It gets a human-readable name for the node.</li>
<li><code>let</code> only supports parallel bindings. No sequential or recursive bindings here.</li>
</ul>
<p>With every <code>ParsedLispVal</code> now a <code>ResolvedLispVal</code>, complete with structure and positions, we’re ready to feed these into our type checker.</p>
<h2 id="type-checker">Type Checker</h2>
<p><img src="/images/hm_lisp_type_check.png" /></p>
<p>The type checker traverses the <code>ResolvedLispVal</code> tree, threading an environment and substitution state through unification, generalisation, and instantiation to produce a fully typed AST.</p>
<p>The code for the type checker is in <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/TypeChecker.hs">TypeChecker.hs</a>.</p>
<div class="sourceCode" id="cb19"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb19-1"><a href="#cb19-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">TypedLispVal</span></span>
<span id="cb19-2"><a href="#cb19-2" aria-hidden="true" tabindex="-1"></a>  <span class="ot">=</span> <span class="dt">TvAtom</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">L.LispType</span> <span class="op">!</span><span class="dt">Text</span></span>
<span id="cb19-3"><a href="#cb19-3" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvBool</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">Bool</span></span>
<span id="cb19-4"><a href="#cb19-4" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvDefine</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">L.PolyType</span> <span class="op">!</span><span class="dt">Text</span> <span class="op">!</span><span class="dt">TypedLispVal</span></span>
<span id="cb19-5"><a href="#cb19-5" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvDo</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">L.LispType</span> <span class="op">!</span>[<span class="dt">TypedLispVal</span>]</span>
<span id="cb19-6"><a href="#cb19-6" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvFuncCall</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">L.LispType</span> <span class="op">!</span><span class="dt">TypedLispVal</span> <span class="op">!</span>[<span class="dt">TypedLispVal</span>]  <span class="co">-- ^ TvFuncCall pos returnType functionVal argVals</span></span>
<span id="cb19-7"><a href="#cb19-7" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvIf</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">L.LispType</span> <span class="op">!</span><span class="dt">TypedLispVal</span> <span class="op">!</span><span class="dt">TypedLispVal</span> <span class="op">!</span><span class="dt">TypedLispVal</span></span>
<span id="cb19-8"><a href="#cb19-8" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvInt</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">Int</span></span>
<span id="cb19-9"><a href="#cb19-9" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvLambda</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">L.LispType</span> <span class="op">!</span>[(<span class="dt">Pos</span>, <span class="dt">Text</span>)] <span class="op">!</span>[<span class="dt">TypedLispVal</span>]</span>
<span id="cb19-10"><a href="#cb19-10" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvLet</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">L.LispType</span> <span class="op">!</span><span class="dt">L.LetStyle</span> <span class="op">!</span>[(<span class="dt">Pos</span>, <span class="dt">Text</span>, <span class="dt">TypedLispVal</span>)] <span class="op">!</span>[<span class="dt">TypedLispVal</span>]</span>
<span id="cb19-11"><a href="#cb19-11" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvList</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">L.LispType</span> <span class="op">!</span>[<span class="dt">TypedLispVal</span>]</span>
<span id="cb19-12"><a href="#cb19-12" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvNil</span> <span class="op">!</span><span class="dt">Pos</span></span>
<span id="cb19-13"><a href="#cb19-13" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">TvString</span> <span class="op">!</span><span class="dt">Pos</span> <span class="op">!</span><span class="dt">Text</span></span>
<span id="cb19-14"><a href="#cb19-14" aria-hidden="true" tabindex="-1"></a>  <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</span>
<span id="cb19-15"><a href="#cb19-15" aria-hidden="true" tabindex="-1"></a></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="kw">data</span> <span class="dt">TcState</span> <span class="ot">=</span> <span class="dt">TcState</span></span>
<span id="cb19-18"><a href="#cb19-18" aria-hidden="true" tabindex="-1"></a>  {<span class="ot"> tsTypeVarCounter ::</span> <span class="op">!</span><span class="dt">Int</span></span>
<span id="cb19-19"><a href="#cb19-19" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> tsSubst ::</span> <span class="op">!</span>(<span class="dt">Map</span> <span class="dt">Text</span> <span class="dt">L.LispType</span>)</span>
<span id="cb19-20"><a href="#cb19-20" aria-hidden="true" tabindex="-1"></a>  }</span></code></pre></div>
<ul>
<li><code>TypedLispVal</code> is the type of the AST after type checking. It is very similar to <code>ResolvedLispVal</code>, just with type information added.</li>
<li><dl>
<dt>Primitive types like <code>Int</code>, <code>Bool</code>, <code>String</code>, and <code>nil</code> are not annotated with their type, since this is obvious from their constructor.</dt>
<dd>
<code>TvInt {}</code> is <code>TyInt</code> etc.
</dd>
</dl></li>
</ul>
<p>The main type checking function is <code>typeCheckVal'</code> in <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/TypeChecker.hs">TypeChecker.hs</a>, which looks like this:</p>
<div class="sourceCode" id="cb20"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb20-1"><a href="#cb20-1" aria-hidden="true" tabindex="-1"></a>typeCheckVal&#39;</span>
<span id="cb20-2"><a href="#cb20-2" aria-hidden="true" tabindex="-1"></a><span class="ot">  ::</span> <span class="dt">TypeEnv</span></span>
<span id="cb20-3"><a href="#cb20-3" aria-hidden="true" tabindex="-1"></a>  <span class="ot">-&gt;</span> <span class="dt">R.ResolvedLispVal</span></span>
<span id="cb20-4"><a href="#cb20-4" aria-hidden="true" tabindex="-1"></a>  <span class="ot">-&gt;</span> <span class="dt">StateT</span> <span class="dt">TcState</span> (<span class="dt">Except</span> <span class="dt">TypeError</span>) (<span class="dt">TypeEnv</span>, <span class="dt">TypedLispVal</span>)</span>
<span id="cb20-5"><a href="#cb20-5" aria-hidden="true" tabindex="-1"></a>typeCheckVal&#39; env1 rv <span class="ot">=</span> <span class="kw">do</span></span></code></pre></div>
<p>It takes an initial type environment and a <code>ResolvedLispVal</code>, and returns a new type environment and a <code>TypedLispVal</code> on success.</p>
<div class="sourceCode" id="cb21"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb21-1"><a href="#cb21-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">TypeEnv</span> <span class="ot">=</span> <span class="dt">TypeEnv</span></span>
<span id="cb21-2"><a href="#cb21-2" aria-hidden="true" tabindex="-1"></a>  {<span class="ot"> teTypes ::</span> <span class="op">!</span>(<span class="dt">Map.Map</span> <span class="dt">Text</span> <span class="dt">L.PolyType</span>)</span>
<span id="cb21-3"><a href="#cb21-3" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> teParent ::</span> <span class="op">!</span>(<span class="dt">Maybe</span> <span class="dt">TypeEnv</span>)</span>
<span id="cb21-4"><a href="#cb21-4" aria-hidden="true" tabindex="-1"></a>  }</span></code></pre></div>
<p>Here is the top of <code>typeCheckVal'</code></p>
<div class="sourceCode" id="cb22"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb22-1"><a href="#cb22-1" aria-hidden="true" tabindex="-1"></a>typeCheckVal&#39;</span>
<span id="cb22-2"><a href="#cb22-2" aria-hidden="true" tabindex="-1"></a><span class="ot">  ::</span> <span class="dt">TypeEnv</span></span>
<span id="cb22-3"><a href="#cb22-3" aria-hidden="true" tabindex="-1"></a>  <span class="ot">-&gt;</span> <span class="dt">R.ResolvedLispVal</span></span>
<span id="cb22-4"><a href="#cb22-4" aria-hidden="true" tabindex="-1"></a>  <span class="ot">-&gt;</span> <span class="dt">StateT</span> <span class="dt">TcState</span> (<span class="dt">Except</span> <span class="dt">TypeError</span>) (<span class="dt">TypeEnv</span>, <span class="dt">TypedLispVal</span>)</span>
<span id="cb22-5"><a href="#cb22-5" aria-hidden="true" tabindex="-1"></a>typeCheckVal&#39; env1 rv <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb22-6"><a href="#cb22-6" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Type check</span></span>
<span id="cb22-7"><a href="#cb22-7" aria-hidden="true" tabindex="-1"></a>  (envFinal, topT1) <span class="ot">&lt;-</span> go</span>
<span id="cb22-8"><a href="#cb22-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb22-9"><a href="#cb22-9" aria-hidden="true" tabindex="-1"></a>  topFinal <span class="ot">&lt;-</span> applyValSubstitutions topT1</span>
<span id="cb22-10"><a href="#cb22-10" aria-hidden="true" tabindex="-1"></a>  <span class="fu">pure</span> (envFinal, topFinal)</span>
<span id="cb22-11"><a href="#cb22-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb22-12"><a href="#cb22-12" aria-hidden="true" tabindex="-1"></a>  <span class="kw">where</span></span>
<span id="cb22-13"><a href="#cb22-13" aria-hidden="true" tabindex="-1"></a>    go <span class="ot">=</span></span>
<span id="cb22-14"><a href="#cb22-14" aria-hidden="true" tabindex="-1"></a>      <span class="kw">case</span> rv <span class="kw">of</span></span>
<span id="cb22-15"><a href="#cb22-15" aria-hidden="true" tabindex="-1"></a>        <span class="co">-- Simple cases, no extra type checking needed</span></span>
<span id="cb22-16"><a href="#cb22-16" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlNil</span> p <span class="ot">-&gt;</span> <span class="fu">pure</span> (env1, <span class="dt">TvNil</span> p)</span>
<span id="cb22-17"><a href="#cb22-17" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlInt</span> p v <span class="ot">-&gt;</span> <span class="fu">pure</span> (env1, <span class="dt">TvInt</span> p v)</span>
<span id="cb22-18"><a href="#cb22-18" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlString</span> p v <span class="ot">-&gt;</span> <span class="fu">pure</span> (env1, <span class="dt">TvString</span> p v)</span>
<span id="cb22-19"><a href="#cb22-19" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlBool</span> p v <span class="ot">-&gt;</span> <span class="fu">pure</span> (env1, <span class="dt">TvBool</span> p v)</span>
<span id="cb22-20"><a href="#cb22-20" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb22-21"><a href="#cb22-21" aria-hidden="true" tabindex="-1"></a>        <span class="co">-- Type check the more complex cases</span></span>
<span id="cb22-22"><a href="#cb22-22" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlAtom</span> p v <span class="ot">-&gt;</span> typeCheckAtom p v</span>
<span id="cb22-23"><a href="#cb22-23" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlDefine</span> p name val <span class="ot">-&gt;</span> typeCheckDefine p name val</span>
<span id="cb22-24"><a href="#cb22-24" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlDo</span> p vs <span class="ot">-&gt;</span> typeCheckDo p vs</span>
<span id="cb22-25"><a href="#cb22-25" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlFuncCall</span> p f as <span class="ot">-&gt;</span> typeCheckFuncCall p f as</span>
<span id="cb22-26"><a href="#cb22-26" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlIf</span> p cond then&#39; else&#39; <span class="ot">-&gt;</span> typeCheckIf p cond then&#39; else&#39;</span>
<span id="cb22-27"><a href="#cb22-27" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlLambda</span> p bindings body <span class="ot">-&gt;</span> typeCheckLambda p bindings body</span>
<span id="cb22-28"><a href="#cb22-28" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlLet</span> p style bindings body <span class="ot">-&gt;</span> typeCheckLet p style bindings body</span>
<span id="cb22-29"><a href="#cb22-29" aria-hidden="true" tabindex="-1"></a>        <span class="dt">R.RlList</span> p vs <span class="ot">-&gt;</span> typeCheckList p vs</span></code></pre></div>
<ul>
<li>The functions returns a <code>TypedLispVal</code> i.e. the result of type checking the <code>ResolvedLispVal</code>.</li>
<li>It also returns the <code>TypeEnv</code>, which is the type environment after type checking. E.g. it is updated by a <code>(defined ...)</code> form</li>
<li>For the simple cases like <code>TvInt</code> it simply returns the corresponding <code>TypedLispVal</code></li>
</ul>
<p>Now, let us look at how those typeCheckXXX calls are implemented.</p>
<h3 id="type-check-if-expression">Type Check: If Expression</h3>
<div class="sourceCode" id="cb23"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb23-1"><a href="#cb23-1" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- (if cond then else)</span></span>
<span id="cb23-2"><a href="#cb23-2" aria-hidden="true" tabindex="-1"></a>    typeCheckIf pos cond1 then1 else1 <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb23-3"><a href="#cb23-3" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- Type check the `condition`, `then`, and `else` expressions.</span></span>
<span id="cb23-4"><a href="#cb23-4" aria-hidden="true" tabindex="-1"></a>      (env2, cond2) <span class="ot">&lt;-</span> typeCheckVal&#39; env1 cond1</span>
<span id="cb23-5"><a href="#cb23-5" aria-hidden="true" tabindex="-1"></a>      (env3, then2) <span class="ot">&lt;-</span> typeCheckVal&#39; env2 then1</span>
<span id="cb23-6"><a href="#cb23-6" aria-hidden="true" tabindex="-1"></a>      (env4, else2) <span class="ot">&lt;-</span> typeCheckVal&#39; env3 else1</span>
<span id="cb23-7"><a href="#cb23-7" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb23-8"><a href="#cb23-8" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- Check that the condition is a boolean.</span></span>
<span id="cb23-9"><a href="#cb23-9" aria-hidden="true" tabindex="-1"></a>      unify (L.getPos cond2, getValType cond2) (pos, <span class="dt">L.TyBool</span>)</span>
<span id="cb23-10"><a href="#cb23-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb23-11"><a href="#cb23-11" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- Unify the types of the then and else branches.</span></span>
<span id="cb23-12"><a href="#cb23-12" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- I.e. the then and else branches must have the same result type.</span></span>
<span id="cb23-13"><a href="#cb23-13" aria-hidden="true" tabindex="-1"></a>      unify (L.getPos then2, getValType then2) (L.getPos else2, getValType else2)</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>      <span class="co">-- Get the final type of the body of the if expression.</span></span>
<span id="cb23-16"><a href="#cb23-16" aria-hidden="true" tabindex="-1"></a>      <span class="kw">let</span> finalType <span class="ot">=</span> getValType then2</span>
<span id="cb23-17"><a href="#cb23-17" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb23-18"><a href="#cb23-18" aria-hidden="true" tabindex="-1"></a>      <span class="fu">pure</span> (env4, <span class="dt">TvIf</span> pos finalType cond2 then2 else2)</span></code></pre></div>
<p>Looking at that superficially, it is not that complicated.</p>
<ul>
<li>Type check the <code>condition</code>, <code>then</code>, and <code>else</code> expressions.</li>
<li>Check (<strong>unify</strong>) that the condition is a boolean.</li>
<li>Check (<strong>unify</strong>) that the types of the <code>then</code> and <code>else</code> branches are the same. I.e. that the final expression in each has the same type.</li>
<li>Get that final type and make it the type of the <code>TvIf</code> expression.</li>
</ul>
<p>The <code>unify</code> function will be discussed in more detail below.</p>
<p>For now:</p>
<div class="tip">
<p>💡 <strong>Unification</strong> is the algorithm that, given two type expressions,</p>
<ol type="1">
<li>Determines whether they can be made equal</li>
<li>And if so, constructs the most general substitution for type variables that makes the expressions identical.</li>
</ol>
</div>
<div class="sourceCode" id="cb24"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb24-1"><a href="#cb24-1" aria-hidden="true" tabindex="-1"></a>unify</span>
<span id="cb24-2"><a href="#cb24-2" aria-hidden="true" tabindex="-1"></a><span class="ot">  ::</span> (<span class="dt">Pos</span>, <span class="dt">L.LispType</span>)</span>
<span id="cb24-3"><a href="#cb24-3" aria-hidden="true" tabindex="-1"></a>  <span class="ot">-&gt;</span> (<span class="dt">Pos</span>, <span class="dt">L.LispType</span>)</span>
<span id="cb24-4"><a href="#cb24-4" aria-hidden="true" tabindex="-1"></a>  <span class="ot">-&gt;</span> <span class="dt">StateT</span> <span class="dt">TcState</span> (<span class="dt">ExceptT</span> <span class="dt">TypeError</span> <span class="dt">Identity</span>) ()</span></code></pre></div>
<p>So for the <code>if</code> expression that was roughly</p>
<ol type="1">
<li>Type-check all the child expressions.</li>
<li>Unify child expressions to ensure the meet expectations</li>
<li>Get the final type of the expression.</li>
<li>Construct the <code>TvIf</code>.</li>
</ol>
<h3 id="type-check-do-expression">Type Check: Do Expression</h3>
<div class="sourceCode" id="cb25"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb25-1"><a href="#cb25-1" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- (do ...)</span></span>
<span id="cb25-2"><a href="#cb25-2" aria-hidden="true" tabindex="-1"></a>    typeCheckDo pos vs <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb25-3"><a href="#cb25-3" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- Type check all expressions in the do block.</span></span>
<span id="cb25-4"><a href="#cb25-4" aria-hidden="true" tabindex="-1"></a>      (env2, vs2) <span class="ot">&lt;-</span> foldTypeCheckVals env1 vs</span>
<span id="cb25-5"><a href="#cb25-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb25-6"><a href="#cb25-6" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- The type of the block is the type of the last expression or nil if empty.</span></span>
<span id="cb25-7"><a href="#cb25-7" aria-hidden="true" tabindex="-1"></a>      <span class="kw">let</span> lastType <span class="ot">=</span> <span class="kw">case</span> lastMay vs2 <span class="kw">of</span></span>
<span id="cb25-8"><a href="#cb25-8" aria-hidden="true" tabindex="-1"></a>            <span class="dt">Nothing</span> <span class="ot">-&gt;</span> <span class="dt">L.TyNil</span></span>
<span id="cb25-9"><a href="#cb25-9" aria-hidden="true" tabindex="-1"></a>            <span class="dt">Just</span> x <span class="ot">-&gt;</span> getValType x</span>
<span id="cb25-10"><a href="#cb25-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb25-11"><a href="#cb25-11" aria-hidden="true" tabindex="-1"></a>      <span class="fu">pure</span> (env2, <span class="dt">TvDo</span> pos lastType vs2)</span></code></pre></div>
<div class="sourceCode" id="cb26"><pre class="sourceCode sql"><code class="sourceCode sql"><span id="cb26-1"><a href="#cb26-1" aria-hidden="true" tabindex="-1"></a>TvDo pos lastType vs2</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="op">+</span><span class="co">------- typed children</span></span>
<span id="cb26-4"><a href="#cb26-4" aria-hidden="true" tabindex="-1"></a>  |   |      <span class="op">+</span><span class="co">------------- result type of the block</span></span>
<span id="cb26-5"><a href="#cb26-5" aria-hidden="true" tabindex="-1"></a>  |   <span class="op">+</span><span class="co">-------------------- source position</span></span>
<span id="cb26-6"><a href="#cb26-6" aria-hidden="true" tabindex="-1"></a>  <span class="op">+</span><span class="co">------------------------ “do” node</span></span></code></pre></div>
<p>This is very similar to the <code>if</code> expression.</p>
<ol type="1">
<li>Type check child expressions.</li>
<li>Get the type of the body (last expression).</li>
<li>Construct the <code>TvDo</code>.</li>
</ol>
<h3 id="type-check-lists">Type Check: Lists</h3>
<div class="sourceCode" id="cb27"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb27-1"><a href="#cb27-1" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- (list v...)</span></span>
<span id="cb27-2"><a href="#cb27-2" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- Type check a list of values.</span></span>
<span id="cb27-3"><a href="#cb27-3" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- In this implementation, lists are always homogeneous (all elements must have the same type).</span></span>
<span id="cb27-4"><a href="#cb27-4" aria-hidden="true" tabindex="-1"></a>    typeCheckList pos vs <span class="ot">=</span></span>
<span id="cb27-5"><a href="#cb27-5" aria-hidden="true" tabindex="-1"></a>      <span class="kw">case</span> vs <span class="kw">of</span></span>
<span id="cb27-6"><a href="#cb27-6" aria-hidden="true" tabindex="-1"></a>        <span class="co">-- An empty list can have any element type. Create a fresh type variable for the element type.</span></span>
<span id="cb27-7"><a href="#cb27-7" aria-hidden="true" tabindex="-1"></a>        <span class="co">-- Note that nil and the empty list `()` are not synonymous in this system (in most lisps they are).</span></span>
<span id="cb27-8"><a href="#cb27-8" aria-hidden="true" tabindex="-1"></a>        [] <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb27-9"><a href="#cb27-9" aria-hidden="true" tabindex="-1"></a>          u <span class="ot">&lt;-</span> nextTypeVar</span>
<span id="cb27-10"><a href="#cb27-10" aria-hidden="true" tabindex="-1"></a>          <span class="fu">pure</span> (env1, <span class="dt">TvList</span> pos (<span class="dt">L.TyList</span> <span class="op">$</span> <span class="dt">L.TyVar</span> u) [])</span>
<span id="cb27-11"><a href="#cb27-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb27-12"><a href="#cb27-12" aria-hidden="true" tabindex="-1"></a>        <span class="co">-- Lists at this point are just vectors of values, never function calls.</span></span>
<span id="cb27-13"><a href="#cb27-13" aria-hidden="true" tabindex="-1"></a>        <span class="co">-- The only requirement is that all elements have the same type.</span></span>
<span id="cb27-14"><a href="#cb27-14" aria-hidden="true" tabindex="-1"></a>        (h<span class="op">:</span>t) <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb27-15"><a href="#cb27-15" aria-hidden="true" tabindex="-1"></a>          <span class="co">-- Type check the head element to get its type.</span></span>
<span id="cb27-16"><a href="#cb27-16" aria-hidden="true" tabindex="-1"></a>          (env2, headVal) <span class="ot">&lt;-</span> typeCheckVal&#39; env1 h</span>
<span id="cb27-17"><a href="#cb27-17" aria-hidden="true" tabindex="-1"></a>          <span class="co">-- Type check the tail elements to get their types.</span></span>
<span id="cb27-18"><a href="#cb27-18" aria-hidden="true" tabindex="-1"></a>          (env3, tailVals) <span class="ot">&lt;-</span> foldTypeCheckVals env2 t</span>
<span id="cb27-19"><a href="#cb27-19" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb27-20"><a href="#cb27-20" aria-hidden="true" tabindex="-1"></a>          <span class="kw">let</span></span>
<span id="cb27-21"><a href="#cb27-21" aria-hidden="true" tabindex="-1"></a>              <span class="co">-- Type and position of the first element.</span></span>
<span id="cb27-22"><a href="#cb27-22" aria-hidden="true" tabindex="-1"></a>              headType <span class="ot">=</span> (L.getPos headVal, getValType headVal)</span>
<span id="cb27-23"><a href="#cb27-23" aria-hidden="true" tabindex="-1"></a>              <span class="co">-- Type and position the tail elements.</span></span>
<span id="cb27-24"><a href="#cb27-24" aria-hidden="true" tabindex="-1"></a>              tailTypes <span class="ot">=</span> tailVals <span class="op">&lt;&amp;&gt;</span> \v <span class="ot">-&gt;</span> (L.getPos v, getValType v)</span>
<span id="cb27-25"><a href="#cb27-25" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb27-26"><a href="#cb27-26" aria-hidden="true" tabindex="-1"></a>          <span class="co">-- Unify the type of each tail element with the head element&#39;s type,</span></span>
<span id="cb27-27"><a href="#cb27-27" aria-hidden="true" tabindex="-1"></a>          <span class="co">-- to ensure all elements in the list have the same type.</span></span>
<span id="cb27-28"><a href="#cb27-28" aria-hidden="true" tabindex="-1"></a>          forM_ tailTypes <span class="op">$</span> \tt <span class="ot">-&gt;</span> unify headType tt</span>
<span id="cb27-29"><a href="#cb27-29" aria-hidden="true" tabindex="-1"></a>          <span class="co">-- If no type mismatch is found, the list is homogeneous.</span></span>
<span id="cb27-30"><a href="#cb27-30" aria-hidden="true" tabindex="-1"></a>          <span class="fu">pure</span> (env3, <span class="dt">TvList</span> pos (<span class="dt">L.TyList</span> <span class="op">$</span> <span class="fu">snd</span> headType) (headVal <span class="op">:</span> tailVals))</span></code></pre></div>
<p>A bit more happening there, but still nothing too complicated.</p>
<ul>
<li>Infer before unify.</li>
<li>Unify takes a <code>Pos</code> and a <code>L.LispType</code>, so it can report errors with the position of any type mismatch.</li>
</ul>
<div class="sourceCode" id="cb28"><pre class="sourceCode sql"><code class="sourceCode sql"><span id="cb28-1"><a href="#cb28-1" aria-hidden="true" tabindex="-1"></a>TvList pos                      <span class="co">-- the list node</span></span>
<span id="cb28-2"><a href="#cb28-2" aria-hidden="true" tabindex="-1"></a>       (TyList $ snd headType)  <span class="co">-- type of the homogeneous list</span></span>
<span id="cb28-3"><a href="#cb28-3" aria-hidden="true" tabindex="-1"></a>       (headVal : tailVals)     <span class="co">-- the typed list elements</span></span></code></pre></div>
<div class="tip">
<p>💡 Remember that lists are homogeneous in this implementation.</p>
</div>
<h4 id="non-empty-lists">Non-empty Lists</h4>
<p>For non-empty lists, the code looks similar to the <code>if</code> expression’s code.</p>
<ol type="1">
<li>Infer the head’s type by checking the first element.</li>
<li>Infer each tail element’s type with <code>foldTypeCheckVals</code>.</li>
<li>Unify each tail’s type with the head’s to enforce homogeneity.</li>
<li>Construct a <code>TvList pos (TyList headType) [headVal …]</code> node.</li>
</ol>
<h4 id="empty-lists">Empty Lists</h4>
<p>When the type checker first sees an empty list it can’t know what the final concrete type will be.
So we say that the empty list can be of any type, i.e. in Haskell we say it has the type <code>[a]</code>.
<code>a</code> will be unified later when the list is used.</p>
<p>As noted in the code, the empty list is not the same as <code>nil</code> in this implementation.</p>
<h3 id="type-checking-progress-so-far">Type Checking: Progress So Far</h3>
<p>In the examples above, you will have seen at a high level how some of the LISP forms are type-checked.
You many want to go back and forth between the code and the theory in <a href="#part-2---type-systems">Part 2</a> to get a better feel for what its trying to achieve.</p>
<p>Next we’ll look at some important helper functions before moving on to the core type-checking code.</p>
<h3 id="generating-fresh-type-variables">Generating Fresh Type Variables</h3>
<div class="tip">
<p>💡 A <strong>fresh type variable</strong> is a new unique type variable that has not been used before in the current type environment.</p>
</div>
<p>From the <a href="#unification">unification section</a> above, we saw that the type checker needs to be able to generate fresh type variables.
Let look at the implementation of that in the type checker.</p>
<p>The type checker carries its state in <code>TcState</code></p>
<div class="sourceCode" id="cb29"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb29-1"><a href="#cb29-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">TcState</span> <span class="ot">=</span> <span class="dt">TcState</span></span>
<span id="cb29-2"><a href="#cb29-2" aria-hidden="true" tabindex="-1"></a>  {<span class="ot"> tsTypeVarCounter ::</span> <span class="op">!</span><span class="dt">Int</span></span>
<span id="cb29-3"><a href="#cb29-3" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> tsSubst ::</span> <span class="op">!</span>(<span class="dt">Map</span> <span class="dt">Text</span> <span class="dt">L.LispType</span>)</span>
<span id="cb29-4"><a href="#cb29-4" aria-hidden="true" tabindex="-1"></a>  }</span></code></pre></div>
<ul>
<li><code>tsTypeVarCounter</code> is used to generate fresh type variables.</li>
<li><code>tsSubst</code> is the substitution map.</li>
</ul>
<p>Generating a fresh type variable is done in the <code>nextTypeVar</code> function, which looks like this:</p>
<div class="sourceCode" id="cb30"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb30-1"><a href="#cb30-1" aria-hidden="true" tabindex="-1"></a><span class="ot">typeVarPrefix ::</span> <span class="dt">Text</span></span>
<span id="cb30-2"><a href="#cb30-2" aria-hidden="true" tabindex="-1"></a>typeVarPrefix <span class="ot">=</span> <span class="st">&quot;U&quot;</span></span>
<span id="cb30-3"><a href="#cb30-3" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb30-4"><a href="#cb30-4" aria-hidden="true" tabindex="-1"></a><span class="ot">nextTypeVar ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">StateT</span> <span class="dt">TcState</span> m <span class="dt">Text</span></span>
<span id="cb30-5"><a href="#cb30-5" aria-hidden="true" tabindex="-1"></a>nextTypeVar <span class="ot">=</span></span>
<span id="cb30-6"><a href="#cb30-6" aria-hidden="true" tabindex="-1"></a>  state <span class="op">$</span> \st <span class="ot">-&gt;</span></span>
<span id="cb30-7"><a href="#cb30-7" aria-hidden="true" tabindex="-1"></a>    <span class="kw">let</span> c&#39; <span class="ot">=</span> tsTypeVarCounter st <span class="op">+</span> <span class="dv">1</span></span>
<span id="cb30-8"><a href="#cb30-8" aria-hidden="true" tabindex="-1"></a>        name <span class="ot">=</span> typeVarPrefix <span class="op">&lt;&gt;</span> <span class="fu">show</span> c&#39;</span>
<span id="cb30-9"><a href="#cb30-9" aria-hidden="true" tabindex="-1"></a>        st&#39; <span class="ot">=</span> st { tsTypeVarCounter <span class="ot">=</span> c&#39; }</span>
<span id="cb30-10"><a href="#cb30-10" aria-hidden="true" tabindex="-1"></a>    <span class="kw">in</span> (name, st&#39;)</span></code></pre></div>
<p>It generates a fresh type variable by incrementing the counter and returning a new type variable name.
Since there is only one <code>TcState</code> for the entire type-checking process, this ensures that all generated type variables are unique.</p>
<p>I’m using <code>U</code> as the prefix for type variables. This is entirely arbitrary as the name will always be unique thanks to substitution.</p>
<h3 id="occurs-check---preventing-infinite-types">Occurs Check - Preventing Infinite Types</h3>
<div class="tip">
<p>💡 <strong>Infinite types</strong> are types that are defined in terms of themselves, leading to recursive type definitions that cannot be resolved.</p>
</div>
<div class="sourceCode" id="cb31"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb31-1"><a href="#cb31-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- | Check if a type variable occurs in a type</span></span>
<span id="cb31-2"><a href="#cb31-2" aria-hidden="true" tabindex="-1"></a><span class="co">-- This is used to prevent infinite types</span></span>
<span id="cb31-3"><a href="#cb31-3" aria-hidden="true" tabindex="-1"></a><span class="co">-- For example, if you this haskell type is infinite: a = [a]</span></span>
<span id="cb31-4"><a href="#cb31-4" aria-hidden="true" tabindex="-1"></a><span class="ot">occurs ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">L.LispType</span> <span class="ot">-&gt;</span> <span class="dt">Bool</span></span>
<span id="cb31-5"><a href="#cb31-5" aria-hidden="true" tabindex="-1"></a>occurs name lt <span class="ot">=</span></span>
<span id="cb31-6"><a href="#cb31-6" aria-hidden="true" tabindex="-1"></a>  <span class="kw">case</span> lt <span class="kw">of</span></span>
<span id="cb31-7"><a href="#cb31-7" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyNil</span> <span class="ot">-&gt;</span> <span class="dt">False</span></span>
<span id="cb31-8"><a href="#cb31-8" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyInt</span> <span class="ot">-&gt;</span> <span class="dt">False</span></span>
<span id="cb31-9"><a href="#cb31-9" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyString</span> <span class="ot">-&gt;</span> <span class="dt">False</span></span>
<span id="cb31-10"><a href="#cb31-10" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyBool</span> <span class="ot">-&gt;</span> <span class="dt">False</span></span>
<span id="cb31-11"><a href="#cb31-11" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyVar</span> v <span class="ot">-&gt;</span> v <span class="op">==</span> name</span>
<span id="cb31-12"><a href="#cb31-12" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyList</span> vs <span class="ot">-&gt;</span> occurs name vs</span>
<span id="cb31-13"><a href="#cb31-13" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyFunc</span> fnArgsType1 fnRetType1 <span class="ot">-&gt;</span></span>
<span id="cb31-14"><a href="#cb31-14" aria-hidden="true" tabindex="-1"></a>      <span class="fu">any</span> (occurs name) (fnArgsType1 <span class="op">&lt;&gt;</span> [fnRetType1])</span></code></pre></div>
<ul>
<li>Recursively checks if a type variable already occurs in a type.</li>
<li>From above, we saw that bindVar calls occur before binding. Then throwing an infinite‐type error if it returns True.</li>
</ul>
<h3 id="the-substitution-map">The Substitution Map</h3>
<div class="tip">
<p>💡 A <strong>substitution map</strong> tracks which type variables should be replaced by other types or variables, enabling recursive resolution to the final, most specific type during type inference.</p>
</div>
<p>After the <a href="#unification">unification section</a> process binds e.g. <code>U1 = Int</code> and <code>U2 = U1</code>, we need to walk every type and replace <code>U2 -&gt; U1 -&gt; Int</code>.
The substitution map is where we store the information to track which type variables have been unified with which types.</p>
<p>The substitution map is stored in the <code>tsSubst</code> of <code>TcState</code>.</p>
<p>The <code>applySubstitutions</code> function and variants are used to apply the substitutions to types and values.</p>
<div class="sourceCode" id="cb32"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb32-1"><a href="#cb32-1" aria-hidden="true" tabindex="-1"></a><span class="ot">applySubstitutions ::</span> <span class="dt">L.LispType</span> <span class="ot">-&gt;</span> <span class="dt">StateT</span> <span class="dt">TcState</span> (<span class="dt">Except</span> <span class="dt">TypeError</span>) <span class="dt">L.LispType</span></span>
<span id="cb32-2"><a href="#cb32-2" aria-hidden="true" tabindex="-1"></a>applySubstitutions lt <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb32-3"><a href="#cb32-3" aria-hidden="true" tabindex="-1"></a>  <span class="kw">case</span> lt <span class="kw">of</span></span>
<span id="cb32-4"><a href="#cb32-4" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyNil</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> lt</span>
<span id="cb32-5"><a href="#cb32-5" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyInt</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> lt</span>
<span id="cb32-6"><a href="#cb32-6" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyString</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> lt</span>
<span id="cb32-7"><a href="#cb32-7" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyBool</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> lt</span>
<span id="cb32-8"><a href="#cb32-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb32-9"><a href="#cb32-9" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyList</span> lt1 <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb32-10"><a href="#cb32-10" aria-hidden="true" tabindex="-1"></a>      lt2 <span class="ot">&lt;-</span> applySubstitutions lt1</span>
<span id="cb32-11"><a href="#cb32-11" aria-hidden="true" tabindex="-1"></a>      <span class="fu">pure</span> <span class="op">$</span> <span class="dt">L.TyList</span> lt2</span>
<span id="cb32-12"><a href="#cb32-12" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb32-13"><a href="#cb32-13" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyFunc</span> targs tret <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb32-14"><a href="#cb32-14" aria-hidden="true" tabindex="-1"></a>      targs2 <span class="ot">&lt;-</span> <span class="fu">traverse</span> applySubstitutions targs</span>
<span id="cb32-15"><a href="#cb32-15" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb32-16"><a href="#cb32-16" aria-hidden="true" tabindex="-1"></a>      tret2 <span class="ot">&lt;-</span> applySubstitutions tret</span>
<span id="cb32-17"><a href="#cb32-17" aria-hidden="true" tabindex="-1"></a>      <span class="fu">pure</span> <span class="op">$</span> <span class="dt">L.TyFunc</span> targs2 tret2</span>
<span id="cb32-18"><a href="#cb32-18" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb32-19"><a href="#cb32-19" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.TyVar</span> v <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb32-20"><a href="#cb32-20" aria-hidden="true" tabindex="-1"></a>      st <span class="ot">&lt;-</span> get</span>
<span id="cb32-21"><a href="#cb32-21" aria-hidden="true" tabindex="-1"></a>      <span class="kw">case</span> Map.lookup v st<span class="op">.</span>tsSubst <span class="kw">of</span></span>
<span id="cb32-22"><a href="#cb32-22" aria-hidden="true" tabindex="-1"></a>        <span class="dt">Just</span> lt2 <span class="ot">-&gt;</span> applySubstitutions lt2</span>
<span id="cb32-23"><a href="#cb32-23" aria-hidden="true" tabindex="-1"></a>        <span class="dt">Nothing</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> lt</span></code></pre></div>
<ul>
<li><code>Nil</code>, <code>Int</code>, <code>String</code>, and <code>Bool</code> have no substitutions, so they are returned as is.</li>
<li>For lists, functions and other complex types, it recursively applies substitutions to their components and child components.</li>
<li><code>TyVar</code> is the interesting case
<ul>
<li>Look up the type variable in the substitution map.</li>
<li>If it exists:
<ul>
<li>apply substitutions to the found type. I.e. recursively apply substitutions to the type.</li>
<li>This is how we resolved <code>U2 ~ U1 ~ Int</code> above.</li>
</ul></li>
<li>If it does not exist in the substitution map, it is returned as is.
<ul>
<li>Remember that in the recursive case, this means that all available substitutions have been applied to the type variable.</li>
</ul></li>
</ul></li>
</ul>
<p>You can look at the <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/TypeChecker.hs">code</a> to see</p>
<ul>
<li><code>applyPolyTypeSubstitutions</code>: calls <code>applySubstitutions</code> on child components of <code>PolyType</code></li>
<li><code>applyValSubstitutions</code>: calls <code>applySubstitutions</code> on child components of a <code>TypedLispVal</code></li>
</ul>
<h3 id="binding-type-variables---updating-the-substitution-map">Binding Type Variables - Updating the Substitution Map</h3>
<div class="tip">
<p>💡 <strong>Binding a type variable</strong> means associating a type variable with a specific type, allowing the type checker to resolve that variable to the bound type during type inference.</p>
<p>Unification is both a lookup and a binding operation.</p>
</div>
<p>You’ll see <code>bindVar</code> invoked in the <code>unify</code> function’s <code>TyVar</code> cases.
This is where two types unify a variable to a concrete type (or another variable).</p>
<div class="sourceCode" id="cb33"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb33-1"><a href="#cb33-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- | Bind a variable to a type</span></span>
<span id="cb33-2"><a href="#cb33-2" aria-hidden="true" tabindex="-1"></a><span class="co">-- This is done during type unification as part of the type inference process.</span></span>
<span id="cb33-3"><a href="#cb33-3" aria-hidden="true" tabindex="-1"></a><span class="ot">bindVar ::</span> <span class="dt">Pos</span> <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">L.LispType</span> <span class="ot">-&gt;</span> <span class="dt">StateT</span> <span class="dt">TcState</span> (<span class="dt">Except</span> <span class="dt">TypeError</span>) ()</span>
<span id="cb33-4"><a href="#cb33-4" aria-hidden="true" tabindex="-1"></a>bindVar pos name lt</span>
<span id="cb33-5"><a href="#cb33-5" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- If trying to bind a type variable to itself, do nothing.</span></span>
<span id="cb33-6"><a href="#cb33-6" aria-hidden="true" tabindex="-1"></a>  <span class="co">--  E.g. `U1 = U1`</span></span>
<span id="cb33-7"><a href="#cb33-7" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> getTVarName lt <span class="op">==</span> <span class="dt">Just</span> name <span class="ot">=</span> <span class="fu">pure</span> ()</span>
<span id="cb33-8"><a href="#cb33-8" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Prevent infinite types. See `occurs`</span></span>
<span id="cb33-9"><a href="#cb33-9" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> occurs name lt <span class="ot">=</span> lift <span class="op">.</span> throwE <span class="op">$</span> <span class="dt">TcInfiniteType</span> pos name lt</span>
<span id="cb33-10"><a href="#cb33-10" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Record the substitution</span></span>
<span id="cb33-11"><a href="#cb33-11" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- i.e. record that `name` is now bound to `lt`</span></span>
<span id="cb33-12"><a href="#cb33-12" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="fu">otherwise</span> <span class="ot">=</span> modify&#39; <span class="op">$</span> \st <span class="ot">-&gt;</span> st { tsSubst <span class="ot">=</span> Map.insert name lt st<span class="op">.</span>tsSubst }</span>
<span id="cb33-13"><a href="#cb33-13" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb33-14"><a href="#cb33-14" aria-hidden="true" tabindex="-1"></a>  <span class="kw">where</span></span>
<span id="cb33-15"><a href="#cb33-15" aria-hidden="true" tabindex="-1"></a><span class="ot">    getTVarName ::</span> <span class="dt">L.LispType</span> <span class="ot">-&gt;</span> <span class="dt">Maybe</span> <span class="dt">Text</span></span>
<span id="cb33-16"><a href="#cb33-16" aria-hidden="true" tabindex="-1"></a>    getTVarName (<span class="dt">L.TyVar</span> v) <span class="ot">=</span> <span class="dt">Just</span> v</span>
<span id="cb33-17"><a href="#cb33-17" aria-hidden="true" tabindex="-1"></a>    getTVarName _ <span class="ot">=</span> <span class="dt">Nothing</span></span></code></pre></div>
<ul>
<li><code>bindVar</code> is used to bind a type variable to a type.</li>
<li>Check if being a variable to itself.</li>
<li>Check for infinite types using <code>occurs</code> (see above).</li>
<li>Otherwise, it updates the substitution map in <code>TcState</code> using <code>StateT</code>’s <code>modify'</code> to record that the type variable is now bound to the type.</li>
</ul>
<h3 id="finding-free-type-variables">Finding Free Type Variables</h3>
<p>To generalise a type we quantify variables that are not already in scope.
Getting free type variables in a type and in the environment is the first step.</p>
<p>In the unification process above, it was said:</p>
<blockquote>
<p>Generalisation picks the type variables in the inferred type that are not already “in scope” in the environment</p>
</blockquote>
<p>In the code this is done by <code>freeTypeVars</code> and variants.</p>
<div class="sourceCode" id="cb34"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb34-1"><a href="#cb34-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- | A free type variable in a type is a type variable that is not bound by a forall in that type,</span></span>
<span id="cb34-2"><a href="#cb34-2" aria-hidden="true" tabindex="-1"></a><span class="co">-- nor already assigned a meaning in the current environment.</span></span>
<span id="cb34-3"><a href="#cb34-3" aria-hidden="true" tabindex="-1"></a><span class="ot">freeTypeVars ::</span> <span class="dt">L.LispType</span> <span class="ot">-&gt;</span> <span class="dt">Set</span> <span class="dt">Text</span></span>
<span id="cb34-4"><a href="#cb34-4" aria-hidden="true" tabindex="-1"></a>freeTypeVars (<span class="dt">L.TyVar</span> v) <span class="ot">=</span> Set.singleton v</span>
<span id="cb34-5"><a href="#cb34-5" aria-hidden="true" tabindex="-1"></a>freeTypeVars (<span class="dt">L.TyList</span> t) <span class="ot">=</span> freeTypeVars t</span>
<span id="cb34-6"><a href="#cb34-6" aria-hidden="true" tabindex="-1"></a>freeTypeVars (<span class="dt">L.TyFunc</span> args ret) <span class="ot">=</span> Set.unions <span class="op">$</span> freeTypeVars ret <span class="op">:</span> (freeTypeVars <span class="op">&lt;$&gt;</span> args)</span>
<span id="cb34-7"><a href="#cb34-7" aria-hidden="true" tabindex="-1"></a>freeTypeVars <span class="dt">L.TyNil</span> <span class="ot">=</span> Set.empty</span>
<span id="cb34-8"><a href="#cb34-8" aria-hidden="true" tabindex="-1"></a>freeTypeVars <span class="dt">L.TyInt</span> <span class="ot">=</span> Set.empty</span>
<span id="cb34-9"><a href="#cb34-9" aria-hidden="true" tabindex="-1"></a>freeTypeVars <span class="dt">L.TyString</span> <span class="ot">=</span> Set.empty</span>
<span id="cb34-10"><a href="#cb34-10" aria-hidden="true" tabindex="-1"></a>freeTypeVars <span class="dt">L.TyBool</span> <span class="ot">=</span> Set.empty</span></code></pre></div>
<ul>
<li>This uses <code>Set</code> from the <code>containers</code> package to track free type variables.</li>
<li>Unsurprisingly, sets make set logic easy.</li>
<li>Here we use <code>union :: Set a -&gt; Set a -&gt; Set a</code> to combine two sets</li>
<li>And <code>unions :: [Set a] -&gt; Set a</code> to combine multiple sets.</li>
</ul>
<p>Let’s look at the <code>TyFunc</code> case</p>
<p><code>freeTypeVars (L.TyFunc args ret) = Set.unions (freeTypeVars ret : (freeTypeVars &lt;$&gt; args))</code></p>
<ul>
<li><code>freeTypeVars ret</code> - finds the free variables in the return type.</li>
<li><code>freeTypeVars &lt;$&gt; args</code> - create a list of the free variables from each argument type.</li>
<li><code>freeTypeVars ret</code> : … - prepends the return type’s free variables to the argument types’ free variables, making a list of sets.</li>
<li><code>Set.unions ...</code> - combines all those sets into one set, containing all free variables from the whole function type.</li>
</ul>
<div class="sourceCode" id="cb35"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb35-1"><a href="#cb35-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- | For PtMono, the free variables are just those of the underlying monotype.</span></span>
<span id="cb35-2"><a href="#cb35-2" aria-hidden="true" tabindex="-1"></a><span class="co">-- For PtForall vs t, the free variables are those in t excluding the ones quantified in vs.</span></span>
<span id="cb35-3"><a href="#cb35-3" aria-hidden="true" tabindex="-1"></a><span class="ot">freeTypeVarsInPoly ::</span> <span class="dt">L.PolyType</span> <span class="ot">-&gt;</span> <span class="dt">Set</span> <span class="dt">Text</span></span>
<span id="cb35-4"><a href="#cb35-4" aria-hidden="true" tabindex="-1"></a>freeTypeVarsInPoly (<span class="dt">L.PtMono</span> t) <span class="ot">=</span> freeTypeVars t</span>
<span id="cb35-5"><a href="#cb35-5" aria-hidden="true" tabindex="-1"></a>freeTypeVarsInPoly (<span class="dt">L.PtForall</span> vs t) <span class="ot">=</span> freeTypeVars t <span class="ot">`Set.difference`</span> Set.fromList vs</span></code></pre></div>
<p>The <code>PtForall</code> case is interesting, as it excludes the type variables that are quantified in the <code>vs</code> list.</p>
<ul>
<li>In other words, it finds the free type variables in a polymorphic type, excluding those that are bound by the <code>forall</code> quantifier.</li>
</ul>
<p>Finally <code>freeTypeVarsEnv</code> is used to find free type variables in the environment.</p>
<div class="sourceCode" id="cb36"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb36-1"><a href="#cb36-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- | traverses the environment hierarchy and accumulates free type variables</span></span>
<span id="cb36-2"><a href="#cb36-2" aria-hidden="true" tabindex="-1"></a><span class="ot">freeTypeVarsEnv ::</span> <span class="dt">TypeEnv</span> <span class="ot">-&gt;</span> <span class="dt">Set</span> <span class="dt">Text</span></span>
<span id="cb36-3"><a href="#cb36-3" aria-hidden="true" tabindex="-1"></a>freeTypeVarsEnv env <span class="ot">=</span></span>
<span id="cb36-4"><a href="#cb36-4" aria-hidden="true" tabindex="-1"></a>  <span class="kw">let</span></span>
<span id="cb36-5"><a href="#cb36-5" aria-hidden="true" tabindex="-1"></a>    freeParents <span class="ot">=</span> fromMaybe <span class="fu">mempty</span> (freeTypeVarsEnv <span class="op">&lt;$&gt;</span> env<span class="op">.</span>teParent)</span>
<span id="cb36-6"><a href="#cb36-6" aria-hidden="true" tabindex="-1"></a>    freeInThis <span class="ot">=</span> freeTypeVarsInPoly <span class="op">&lt;$&gt;</span> (Map.elems env<span class="op">.</span>teTypes)</span>
<span id="cb36-7"><a href="#cb36-7" aria-hidden="true" tabindex="-1"></a>  <span class="kw">in</span></span>
<span id="cb36-8"><a href="#cb36-8" aria-hidden="true" tabindex="-1"></a>  Set.unions (freeParents <span class="op">:</span> freeInThis)</span></code></pre></div>
<p>To get the free type variables for the whole environment, you:</p>
<ul>
<li>Collect all free type variables in the parent environment (if there is one).
<ul>
<li>This is done recursively.</li>
<li>So it will traverse the entire environment hierarchy upwards.</li>
<li>Note that the fmap here (<code>&lt;$&gt;</code>) is mapping over the <code>Maybe</code> type, so it gets a <code>Maybe (Set Text)</code> and the <code>fromMaybe</code> handles the <code>Nothing</code> case.</li>
</ul></li>
<li>Collect all free type variables in the current environment.
<ul>
<li>Map <code>freeTypeVarsInPoly</code> over each of the values in the environment’s type map.</li>
</ul></li>
<li>Take the union of these sets to get all the free type variables in scope.</li>
</ul>
<p>Note that although <code>Set.unions</code> and recursive environment traversals are fine for small programs, larger codebases might require caching or a more incremental approach.</p>
<h3 id="instantiating-polymorphic-types">Instantiating Polymorphic Types</h3>
<div class="tip">
<p>💡 <strong>Instantiating a polymorphic type</strong> means replacing each quantified variable in a polymorphic type with a fresh type variable.</p>
</div>
<p>For example</p>
<ul>
<li><code>∀ a b. a -&gt; b -&gt; a</code> becomes <code>U0 -&gt; U1 -&gt; U0</code></li>
<li>Where <code>U0</code> and <code>U1</code> are fresh type variables.</li>
<li>Instantiation always produces a monotype.</li>
</ul>
<p>This must be done recursively so that all nested polymorphic types are instantiated.</p>
<p>It must also be done recursively for monomorphic types. If we supported more complex types, you could have a monomorphic type that contains polymorphic.
(<em>E.g. in Haskell a monomorphic record with a polymorphic field type</em>).</p>
<div class="sourceCode" id="cb37"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb37-1"><a href="#cb37-1" aria-hidden="true" tabindex="-1"></a><span class="ot">instantiate ::</span> <span class="dt">Pos</span> <span class="ot">-&gt;</span> <span class="dt">L.PolyType</span> <span class="ot">-&gt;</span> <span class="dt">StateT</span> <span class="dt">TcState</span> (<span class="dt">Except</span> <span class="dt">TypeError</span>) <span class="dt">L.LispType</span></span>
<span id="cb37-2"><a href="#cb37-2" aria-hidden="true" tabindex="-1"></a>instantiate _pos pt1 <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb37-3"><a href="#cb37-3" aria-hidden="true" tabindex="-1"></a>  <span class="kw">case</span> pt1 <span class="kw">of</span></span>
<span id="cb37-4"><a href="#cb37-4" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.PtMono</span> lt1 <span class="ot">-&gt;</span></span>
<span id="cb37-5"><a href="#cb37-5" aria-hidden="true" tabindex="-1"></a>      instantiate&#39; Map.empty lt1</span>
<span id="cb37-6"><a href="#cb37-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb37-7"><a href="#cb37-7" aria-hidden="true" tabindex="-1"></a>    <span class="dt">L.PtForall</span> vars1 lt1 <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb37-8"><a href="#cb37-8" aria-hidden="true" tabindex="-1"></a>      isubsts1 <span class="ot">&lt;-</span> for vars1 <span class="op">$</span> \v <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb37-9"><a href="#cb37-9" aria-hidden="true" tabindex="-1"></a>        c <span class="ot">&lt;-</span> nextTypeVar</span>
<span id="cb37-10"><a href="#cb37-10" aria-hidden="true" tabindex="-1"></a>        <span class="fu">pure</span> (v, c)</span>
<span id="cb37-11"><a href="#cb37-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb37-12"><a href="#cb37-12" aria-hidden="true" tabindex="-1"></a>      <span class="kw">let</span> isubsts2 <span class="ot">=</span> Map.fromList isubsts1</span>
<span id="cb37-13"><a href="#cb37-13" aria-hidden="true" tabindex="-1"></a>      instantiate&#39; isubsts2 lt1</span>
<span id="cb37-14"><a href="#cb37-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb37-15"><a href="#cb37-15" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb37-16"><a href="#cb37-16" aria-hidden="true" tabindex="-1"></a>  <span class="kw">where</span></span>
<span id="cb37-17"><a href="#cb37-17" aria-hidden="true" tabindex="-1"></a><span class="ot">    instantiate&#39; ::</span> <span class="dt">Map</span> <span class="dt">Text</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">L.LispType</span> <span class="ot">-&gt;</span> <span class="dt">StateT</span> <span class="dt">TcState</span> (<span class="dt">Except</span> <span class="dt">TypeError</span>) <span class="dt">L.LispType</span></span>
<span id="cb37-18"><a href="#cb37-18" aria-hidden="true" tabindex="-1"></a>    instantiate&#39; isubst lt1 <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb37-19"><a href="#cb37-19" aria-hidden="true" tabindex="-1"></a>      <span class="kw">case</span> lt1 <span class="kw">of</span></span>
<span id="cb37-20"><a href="#cb37-20" aria-hidden="true" tabindex="-1"></a>        <span class="dt">L.TyNil</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> lt1</span>
<span id="cb37-21"><a href="#cb37-21" aria-hidden="true" tabindex="-1"></a>        <span class="dt">L.TyInt</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> lt1</span>
<span id="cb37-22"><a href="#cb37-22" aria-hidden="true" tabindex="-1"></a>        <span class="dt">L.TyString</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> lt1</span>
<span id="cb37-23"><a href="#cb37-23" aria-hidden="true" tabindex="-1"></a>        <span class="dt">L.TyBool</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> lt1</span>
<span id="cb37-24"><a href="#cb37-24" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb37-25"><a href="#cb37-25" aria-hidden="true" tabindex="-1"></a>        <span class="dt">L.TyList</span> lt2 <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb37-26"><a href="#cb37-26" aria-hidden="true" tabindex="-1"></a>          lt3 <span class="ot">&lt;-</span> instantiate&#39; isubst lt2</span>
<span id="cb37-27"><a href="#cb37-27" aria-hidden="true" tabindex="-1"></a>          <span class="fu">pure</span> <span class="op">$</span> <span class="dt">L.TyList</span> lt3</span>
<span id="cb37-28"><a href="#cb37-28" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb37-29"><a href="#cb37-29" aria-hidden="true" tabindex="-1"></a>        <span class="dt">L.TyVar</span> v <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb37-30"><a href="#cb37-30" aria-hidden="true" tabindex="-1"></a>          <span class="kw">case</span> Map.lookup v isubst <span class="kw">of</span></span>
<span id="cb37-31"><a href="#cb37-31" aria-hidden="true" tabindex="-1"></a>            <span class="dt">Just</span> v2 <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">L.TyVar</span> v2</span>
<span id="cb37-32"><a href="#cb37-32" aria-hidden="true" tabindex="-1"></a>            <span class="dt">Nothing</span> <span class="ot">-&gt;</span></span>
<span id="cb37-33"><a href="#cb37-33" aria-hidden="true" tabindex="-1"></a>              <span class="co">-- No substitution found, so return the original type variable</span></span>
<span id="cb37-34"><a href="#cb37-34" aria-hidden="true" tabindex="-1"></a>              <span class="fu">pure</span> <span class="op">$</span> <span class="dt">L.TyVar</span> v</span>
<span id="cb37-35"><a href="#cb37-35" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb37-36"><a href="#cb37-36" aria-hidden="true" tabindex="-1"></a>        <span class="dt">L.TyFunc</span> targs tret <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb37-37"><a href="#cb37-37" aria-hidden="true" tabindex="-1"></a>          targs2 <span class="ot">&lt;-</span> <span class="fu">traverse</span> (instantiate&#39; isubst) targs</span>
<span id="cb37-38"><a href="#cb37-38" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb37-39"><a href="#cb37-39" aria-hidden="true" tabindex="-1"></a>          tret2 <span class="ot">&lt;-</span> instantiate&#39; isubst tret</span>
<span id="cb37-40"><a href="#cb37-40" aria-hidden="true" tabindex="-1"></a>          <span class="fu">pure</span> <span class="op">$</span> <span class="dt">L.TyFunc</span> targs2 tret2</span></code></pre></div>
<h3 id="type-checking-another-progress-check">Type Checking: Another Progress Check</h3>
<p>You have now seen all the building blocks required for us to move on to <code>generalisation</code> and <code>unify</code>.
With all the pieces in place, they should be reasonably understandable.</p>
<h3 id="generalise">Generalise</h3>
<div class="tip">
<p>💡 <strong>Generalisation</strong> in Hindley-Milner, is the process of turning a monomorphic into a polymorphic type.</p>
</div>
<div class="sourceCode" id="cb38"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb38-1"><a href="#cb38-1" aria-hidden="true" tabindex="-1"></a><span class="ot">generalise ::</span> <span class="dt">TypeEnv</span> <span class="ot">-&gt;</span> <span class="dt">L.LispType</span> <span class="ot">-&gt;</span> <span class="dt">L.PolyType</span></span>
<span id="cb38-2"><a href="#cb38-2" aria-hidden="true" tabindex="-1"></a>generalise env t <span class="ot">=</span></span>
<span id="cb38-3"><a href="#cb38-3" aria-hidden="true" tabindex="-1"></a>  <span class="kw">let</span></span>
<span id="cb38-4"><a href="#cb38-4" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- 1. Collect all free type variables appearing in the environment.</span></span>
<span id="cb38-5"><a href="#cb38-5" aria-hidden="true" tabindex="-1"></a>      envVars <span class="ot">=</span> freeTypeVarsEnv env</span>
<span id="cb38-6"><a href="#cb38-6" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- 2. Collect all free type variables in the type being generalised.</span></span>
<span id="cb38-7"><a href="#cb38-7" aria-hidden="true" tabindex="-1"></a>      typeVars <span class="ot">=</span> freeTypeVars t</span>
<span id="cb38-8"><a href="#cb38-8" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- 3. Find variables that appear in the type, but not in the environment.</span></span>
<span id="cb38-9"><a href="#cb38-9" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- These are the variables that can be generalised (quantified over).</span></span>
<span id="cb38-10"><a href="#cb38-10" aria-hidden="true" tabindex="-1"></a>      toGen <span class="ot">=</span> Set.toList (typeVars <span class="ot">`Set.difference`</span> envVars)</span>
<span id="cb38-11"><a href="#cb38-11" aria-hidden="true" tabindex="-1"></a>  <span class="kw">in</span></span>
<span id="cb38-12"><a href="#cb38-12" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- 4. If there are no variables to generalise, return a monomorphic type.</span></span>
<span id="cb38-13"><a href="#cb38-13" aria-hidden="true" tabindex="-1"></a>  <span class="kw">if</span> <span class="fu">null</span> toGen</span>
<span id="cb38-14"><a href="#cb38-14" aria-hidden="true" tabindex="-1"></a>    <span class="kw">then</span> <span class="dt">L.PtMono</span> t</span>
<span id="cb38-15"><a href="#cb38-15" aria-hidden="true" tabindex="-1"></a>    <span class="kw">else</span> <span class="dt">L.PtForall</span> toGen t</span></code></pre></div>
<ul>
<li>The comments in the code explain the steps pretty well.</li>
</ul>
<p>Paraphrasing from above</p>
<ul>
<li>Generalisation picks the type variables in the inferred type that are not already “in scope” in the environment</li>
<li>(free in type) - (free in type environment)</li>
</ul>
<h3 id="unification-1">Unification</h3>
<div class="tip">
<p>💡 <strong>Unification</strong> is the algorithm that, given two type expressions,</p>
<ol type="1">
<li>Determines whether they can be made equal</li>
<li>And if so, constructs the most general substitution for type variables that makes the expressions identical.</li>
</ol>
</div>
<p>Finally, we get to the unification function, which is the core of the type inference algorithm.</p>
<div class="sourceCode" id="cb39"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb39-1"><a href="#cb39-1" aria-hidden="true" tabindex="-1"></a>unify</span>
<span id="cb39-2"><a href="#cb39-2" aria-hidden="true" tabindex="-1"></a><span class="ot">  ::</span> (<span class="dt">Pos</span>, <span class="dt">L.LispType</span>)</span>
<span id="cb39-3"><a href="#cb39-3" aria-hidden="true" tabindex="-1"></a>  <span class="ot">-&gt;</span> (<span class="dt">Pos</span>, <span class="dt">L.LispType</span>)</span>
<span id="cb39-4"><a href="#cb39-4" aria-hidden="true" tabindex="-1"></a>  <span class="ot">-&gt;</span> <span class="dt">StateT</span> <span class="dt">TcState</span> (<span class="dt">ExceptT</span> <span class="dt">TypeError</span> <span class="dt">Identity</span>) ()</span>
<span id="cb39-5"><a href="#cb39-5" aria-hidden="true" tabindex="-1"></a>unify (lhsPos, lhs1) (rhsPos, rhs1) <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb39-6"><a href="#cb39-6" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- 1) Substitute</span></span>
<span id="cb39-7"><a href="#cb39-7" aria-hidden="true" tabindex="-1"></a>  lhs2 <span class="ot">&lt;-</span> applySubstitutions lhs1</span>
<span id="cb39-8"><a href="#cb39-8" aria-hidden="true" tabindex="-1"></a>  rhs2 <span class="ot">&lt;-</span> applySubstitutions rhs1</span>
<span id="cb39-9"><a href="#cb39-9" aria-hidden="true" tabindex="-1"></a>  unify&#39; lhs2 rhs2</span>
<span id="cb39-10"><a href="#cb39-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb39-11"><a href="#cb39-11" aria-hidden="true" tabindex="-1"></a>  <span class="kw">where</span></span>
<span id="cb39-12"><a href="#cb39-12" aria-hidden="true" tabindex="-1"></a><span class="ot">    unify&#39; ::</span> <span class="dt">L.LispType</span> <span class="ot">-&gt;</span> <span class="dt">L.LispType</span> <span class="ot">-&gt;</span> <span class="dt">StateT</span> <span class="dt">TcState</span> (<span class="dt">Except</span> <span class="dt">TypeError</span>) ()</span>
<span id="cb39-13"><a href="#cb39-13" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb39-14"><a href="#cb39-14" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- 2) Equal?</span></span>
<span id="cb39-15"><a href="#cb39-15" aria-hidden="true" tabindex="-1"></a>    unify&#39; l r <span class="op">|</span> l <span class="op">==</span> r <span class="ot">=</span> <span class="fu">pure</span> ()</span>
<span id="cb39-16"><a href="#cb39-16" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb39-17"><a href="#cb39-17" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- 3) Type variable?</span></span>
<span id="cb39-18"><a href="#cb39-18" aria-hidden="true" tabindex="-1"></a>    unify&#39; (<span class="dt">L.TyVar</span> name) r <span class="ot">=</span> bindVar lhsPos name r</span>
<span id="cb39-19"><a href="#cb39-19" aria-hidden="true" tabindex="-1"></a>    unify&#39; l (<span class="dt">L.TyVar</span> name) <span class="ot">=</span> bindVar rhsPos name l</span>
<span id="cb39-20"><a href="#cb39-20" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb39-21"><a href="#cb39-21" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- 4) Lists?</span></span>
<span id="cb39-22"><a href="#cb39-22" aria-hidden="true" tabindex="-1"></a>    unify&#39; (<span class="dt">L.TyList</span> a1) (<span class="dt">L.TyList</span> b1) <span class="ot">=</span> unify&#39; a1 b1</span>
<span id="cb39-23"><a href="#cb39-23" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb39-24"><a href="#cb39-24" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- 5) Functions?</span></span>
<span id="cb39-25"><a href="#cb39-25" aria-hidden="true" tabindex="-1"></a>    unify&#39; (<span class="dt">L.TyFunc</span> fnArgsType1 fnRetType1) (<span class="dt">L.TyFunc</span> fnArgsType2 fnRetType2) <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb39-26"><a href="#cb39-26" aria-hidden="true" tabindex="-1"></a>      unless (<span class="fu">length</span> fnArgsType1 <span class="op">==</span> <span class="fu">length</span> fnArgsType2) <span class="op">$</span> <span class="kw">do</span></span>
<span id="cb39-27"><a href="#cb39-27" aria-hidden="true" tabindex="-1"></a>        lift <span class="op">.</span> throwE <span class="op">$</span> <span class="dt">TcArityError</span> (<span class="dt">Just</span> <span class="op">$</span> lhsPos) (<span class="fu">length</span> fnArgsType1) (<span class="fu">length</span> fnArgsType2)</span>
<span id="cb39-28"><a href="#cb39-28" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb39-29"><a href="#cb39-29" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- unify the argument types</span></span>
<span id="cb39-30"><a href="#cb39-30" aria-hidden="true" tabindex="-1"></a>      zipWithM_ (\a1 a2 <span class="ot">-&gt;</span> unify (lhsPos, a1) (rhsPos, a2)) fnArgsType1 fnArgsType2</span>
<span id="cb39-31"><a href="#cb39-31" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- unify the return types</span></span>
<span id="cb39-32"><a href="#cb39-32" aria-hidden="true" tabindex="-1"></a>      unify (lhsPos, fnRetType1) (rhsPos, fnRetType2)</span>
<span id="cb39-33"><a href="#cb39-33" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb39-34"><a href="#cb39-34" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- 6) Mismatch</span></span>
<span id="cb39-35"><a href="#cb39-35" aria-hidden="true" tabindex="-1"></a>    unify&#39; l r <span class="ot">=</span> lift <span class="op">.</span> throwE <span class="op">$</span> <span class="dt">TcTypeMismatch</span> <span class="st">&quot;Unification mismatch&quot;</span> lhsPos (<span class="dt">L.PtMono</span> l) (<span class="dt">Just</span> rhsPos) (<span class="dt">L.PtMono</span> r)</span></code></pre></div>
<p>Main steps</p>
<ol type="1">
<li>Apply all substitutions to both types. (see <code>applySubstitutions</code>)</li>
<li>If they are equal, do nothing</li>
<li>If one is a type variable, bind it to the other type (unless this creates an infinite type)</li>
<li>If both are lists, unify their elements</li>
<li>If both are functions, unify their argument types and return types</li>
<li>Otherwise, throw a type mismatch error</li>
</ol>
<p>With all the leg work done, the unification algorithm is concise and straightforward.</p>
<p>We can now look at a couple of the more complex cases from <code>typeCheckVal'</code> to see how they use unification and generalisation.</p>
<h3 id="type-check-define-expression">🧩 Type Check: Define Expression</h3>
<div class="sourceCode" id="cb40"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb40-1"><a href="#cb40-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- (define name val)</span></span>
<span id="cb40-2"><a href="#cb40-2" aria-hidden="true" tabindex="-1"></a>typeCheckDefine pos name val1 <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb40-3"><a href="#cb40-3" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Type check the value being defined.</span></span>
<span id="cb40-4"><a href="#cb40-4" aria-hidden="true" tabindex="-1"></a>  (_env2, val2) <span class="ot">&lt;-</span> typeCheckVal&#39; env1 val1</span>
<span id="cb40-5"><a href="#cb40-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb40-6"><a href="#cb40-6" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Apply substitutions before generalising. This gets the final (possibly concrete) type of the value.</span></span>
<span id="cb40-7"><a href="#cb40-7" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- This step resolves all type variables to their current bindings.</span></span>
<span id="cb40-8"><a href="#cb40-8" aria-hidden="true" tabindex="-1"></a>  tFinal <span class="ot">&lt;-</span> applySubstitutions (getValType val2)</span>
<span id="cb40-9"><a href="#cb40-9" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb40-10"><a href="#cb40-10" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Generalise the type of the value to create a polymorphic type if possible.</span></span>
<span id="cb40-11"><a href="#cb40-11" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- See `generalise` for details.</span></span>
<span id="cb40-12"><a href="#cb40-12" aria-hidden="true" tabindex="-1"></a>  <span class="kw">let</span> pt <span class="ot">=</span> generalise env1 tFinal</span>
<span id="cb40-13"><a href="#cb40-13" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb40-14"><a href="#cb40-14" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Update the *current* environment with the new binding.</span></span>
<span id="cb40-15"><a href="#cb40-15" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Note: this does not create a new env layer, it is an in-place update.</span></span>
<span id="cb40-16"><a href="#cb40-16" aria-hidden="true" tabindex="-1"></a>  <span class="kw">let</span> env3 <span class="ot">=</span> env1 { teTypes <span class="ot">=</span> Map.insert name pt env1<span class="op">.</span>teTypes }</span>
<span id="cb40-17"><a href="#cb40-17" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb40-18"><a href="#cb40-18" aria-hidden="true" tabindex="-1"></a>  <span class="fu">pure</span> (env3, <span class="dt">TvDefine</span> pos pt name val2)</span></code></pre></div>
<ul>
<li>The resolver already restricted <code>define</code>s to the top-level. No need to check again.</li>
<li>Type-check the value being defined.</li>
<li>Substitute</li>
<li>Generalise. We generalise for <code>define</code> and for <code>let</code> bindings.</li>
<li>In-place environment update with the new binding.</li>
</ul>
<h3 id="type-check-function-call">🧩 Type Check: Function Call</h3>
<p>To type an application like <code>(+ 1 2)</code>, we infer the function’s type, infer each argument’s type, and then unify against a fresh type-var return type.</p>
<div class="sourceCode" id="cb41"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb41-1"><a href="#cb41-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- (func args...)</span></span>
<span id="cb41-2"><a href="#cb41-2" aria-hidden="true" tabindex="-1"></a><span class="co">-- Type check a function call (application).</span></span>
<span id="cb41-3"><a href="#cb41-3" aria-hidden="true" tabindex="-1"></a><span class="co">-- Note that this is for when a function is called, not when it is defined.</span></span>
<span id="cb41-4"><a href="#cb41-4" aria-hidden="true" tabindex="-1"></a>typeCheckFuncCall pos funcVal&#39; args&#39; <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb41-5"><a href="#cb41-5" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Type check the function being called and all argument expressions.</span></span>
<span id="cb41-6"><a href="#cb41-6" aria-hidden="true" tabindex="-1"></a>  (_, funcVal) <span class="ot">&lt;-</span> typeCheckVal&#39; env1 funcVal&#39;</span>
<span id="cb41-7"><a href="#cb41-7" aria-hidden="true" tabindex="-1"></a>  (_, argVals) <span class="ot">&lt;-</span> foldTypeCheckVals env1 args&#39;</span>
<span id="cb41-8"><a href="#cb41-8" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Collect the types of all the arguments.</span></span>
<span id="cb41-9"><a href="#cb41-9" aria-hidden="true" tabindex="-1"></a>  <span class="kw">let</span> argTypes <span class="ot">=</span> getValType <span class="op">&lt;$&gt;</span> argVals</span>
<span id="cb41-10"><a href="#cb41-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb41-11"><a href="#cb41-11" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Create a fresh type variable for the return type.</span></span>
<span id="cb41-12"><a href="#cb41-12" aria-hidden="true" tabindex="-1"></a>  retType <span class="ot">&lt;-</span> <span class="dt">L.TyVar</span> <span class="op">&lt;$&gt;</span> nextTypeVar</span>
<span id="cb41-13"><a href="#cb41-13" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb41-14"><a href="#cb41-14" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Unify the type of the function value with a function type: (argTypes -&gt; retType).</span></span>
<span id="cb41-15"><a href="#cb41-15" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- This means the value being called must be a function taking the argument types and returning the return type.</span></span>
<span id="cb41-16"><a href="#cb41-16" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- I.e. the value being called is a function whose type unifies with a function type constructed from the argument</span></span>
<span id="cb41-17"><a href="#cb41-17" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- types and a fresh return type variable.</span></span>
<span id="cb41-18"><a href="#cb41-18" aria-hidden="true" tabindex="-1"></a>  unify (L.getPos funcVal, getValType funcVal) (pos, <span class="dt">L.TyFunc</span> argTypes retType)</span>
<span id="cb41-19"><a href="#cb41-19" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb41-20"><a href="#cb41-20" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- After unification, apply substitutions to get the final (possibly concrete) return type.</span></span>
<span id="cb41-21"><a href="#cb41-21" aria-hidden="true" tabindex="-1"></a>  retTypeSubst <span class="ot">&lt;-</span> applySubstitutions retType</span>
<span id="cb41-22"><a href="#cb41-22" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb41-23"><a href="#cb41-23" aria-hidden="true" tabindex="-1"></a>  <span class="fu">pure</span> (env1, <span class="dt">TvFuncCall</span> pos retTypeSubst funcVal argVals)</span></code></pre></div>
<ul>
<li>This is for function application, not function definition. E.g. <code>(+ 1 2)</code>.</li>
<li>There are no explicit types, so the return type always starts as a fresh type variable.</li>
<li><code>unify</code> is called to ensure that the thing being called is a function with the expected argument types and return type.</li>
<li>Don’t forget to apply substitutions to the return type after unification.</li>
</ul>
<h3 id="type-check-let-expression">🧩 Type Check: Let Expression</h3>
<p>A <code>let</code> introduces local bindings whose definitions may themselves be polymorphic.
To support polymorphism, we must type‐check each binding, generalise its monotype,
and put all new ones into a fresh environment before checking the body.</p>
<div class="sourceCode" id="cb42"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb42-1"><a href="#cb42-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- (let ( (n1 v1) (n2 v2)...) body...)</span></span>
<span id="cb42-2"><a href="#cb42-2" aria-hidden="true" tabindex="-1"></a>typeCheckLet pos style bindings1 body1 <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb42-3"><a href="#cb42-3" aria-hidden="true" tabindex="-1"></a>  (bindings2&#39;, env2&#39;) <span class="ot">&lt;-</span></span>
<span id="cb42-4"><a href="#cb42-4" aria-hidden="true" tabindex="-1"></a>    <span class="kw">case</span> style <span class="kw">of</span></span>
<span id="cb42-5"><a href="#cb42-5" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- Parallel let bindings:</span></span>
<span id="cb42-6"><a href="#cb42-6" aria-hidden="true" tabindex="-1"></a>      <span class="co">--  * All bindings are evaluated in the same outer environment.</span></span>
<span id="cb42-7"><a href="#cb42-7" aria-hidden="true" tabindex="-1"></a>      <span class="co">--  * No binding can refer to any other binding in the same let.</span></span>
<span id="cb42-8"><a href="#cb42-8" aria-hidden="true" tabindex="-1"></a>      <span class="co">--  * Only the body sees all new bindings.</span></span>
<span id="cb42-9"><a href="#cb42-9" aria-hidden="true" tabindex="-1"></a>      <span class="co">--</span></span>
<span id="cb42-10"><a href="#cb42-10" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- Sequential let bindings, where a binding may refer to a previous binding,</span></span>
<span id="cb42-11"><a href="#cb42-11" aria-hidden="true" tabindex="-1"></a>      <span class="co">-- are not supported, but should be easy to add.</span></span>
<span id="cb42-12"><a href="#cb42-12" aria-hidden="true" tabindex="-1"></a>      <span class="dt">L.LetParallel</span> <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb42-13"><a href="#cb42-13" aria-hidden="true" tabindex="-1"></a>        <span class="co">-- Type check each binding in the let form.</span></span>
<span id="cb42-14"><a href="#cb42-14" aria-hidden="true" tabindex="-1"></a>        ls <span class="ot">&lt;-</span> <span class="fu">traverse</span> typeCheckLetBinding bindings1</span>
<span id="cb42-15"><a href="#cb42-15" aria-hidden="true" tabindex="-1"></a>        <span class="kw">let</span> bindings2 <span class="ot">=</span> ls <span class="op">&lt;&amp;&gt;</span> \(_, p, name, val) <span class="ot">-&gt;</span> (p, name, val)</span>
<span id="cb42-16"><a href="#cb42-16" aria-hidden="true" tabindex="-1"></a>            <span class="co">-- Generalise the types of the bindings to allow polymorphism.</span></span>
<span id="cb42-17"><a href="#cb42-17" aria-hidden="true" tabindex="-1"></a>            bindings3 <span class="ot">=</span> bindings2 <span class="op">&lt;&amp;&gt;</span> \(_, name, val) <span class="ot">-&gt;</span> (name, generalise env1 <span class="op">$</span> getValType val)</span>
<span id="cb42-18"><a href="#cb42-18" aria-hidden="true" tabindex="-1"></a>            <span class="co">-- Create a new environment layer for the let body, containing the new bindings as local variables.</span></span>
<span id="cb42-19"><a href="#cb42-19" aria-hidden="true" tabindex="-1"></a>            env2 <span class="ot">=</span> <span class="dt">TypeEnv</span></span>
<span id="cb42-20"><a href="#cb42-20" aria-hidden="true" tabindex="-1"></a>               { teParent <span class="ot">=</span> <span class="dt">Just</span> env1</span>
<span id="cb42-21"><a href="#cb42-21" aria-hidden="true" tabindex="-1"></a>               , teTypes <span class="ot">=</span> Map.fromList bindings3</span>
<span id="cb42-22"><a href="#cb42-22" aria-hidden="true" tabindex="-1"></a>               }</span>
<span id="cb42-23"><a href="#cb42-23" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb42-24"><a href="#cb42-24" aria-hidden="true" tabindex="-1"></a>        <span class="fu">pure</span> (bindings2, env2)</span></code></pre></div>
<ul>
<li>In LISP, there are several styles of <code>let</code> bindings.
<ul>
<li><strong>parallel</strong>: all bindings are evaluated in the same outer environment.</li>
<li><strong>sequential</strong>: bindings are evaluated one after the other, and can refer to previous bindings.</li>
<li><strong>recursive</strong>: bindings are evaluated in the same environment but can refer to each other.</li>
</ul></li>
<li>This implementation only supports <strong>parallel</strong> <code>let</code> bindings, but it should be easy to add the others.</li>
<li>Generalise and create a new environment layer for the body of the <code>let</code> expression.</li>
</ul>
<h3 id="type-check-lambda-expression">🧩 Type Check: Lambda Expression</h3>
<p>To type-check <code>(λ (x y) ...)</code>, we assign each parameter a fresh type variable, extend the environment with those bindings, type‐check the body, and then assemble a function type from the parameter and return types.</p>
<div class="sourceCode" id="cb43"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb43-1"><a href="#cb43-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- (λ (param1 param2 ...) body..)</span></span>
<span id="cb43-2"><a href="#cb43-2" aria-hidden="true" tabindex="-1"></a>typeCheckLambda pos params1 body1 <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb43-3"><a href="#cb43-3" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Create new (fresh) monomorphic type variables for each of the parameters.</span></span>
<span id="cb43-4"><a href="#cb43-4" aria-hidden="true" tabindex="-1"></a>  params2 <span class="ot">&lt;-</span> for params1 <span class="op">$</span> \(p, name) <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb43-5"><a href="#cb43-5" aria-hidden="true" tabindex="-1"></a>    u <span class="ot">&lt;-</span> nextTypeVar</span>
<span id="cb43-6"><a href="#cb43-6" aria-hidden="true" tabindex="-1"></a>    <span class="fu">pure</span> (p, name, <span class="dt">L.PtMono</span> <span class="op">$</span> <span class="dt">L.TyVar</span> u)</span>
<span id="cb43-7"><a href="#cb43-7" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb43-8"><a href="#cb43-8" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Create a new environment layer for this function.</span></span>
<span id="cb43-9"><a href="#cb43-9" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- containing the parameter bindings as local variables.</span></span>
<span id="cb43-10"><a href="#cb43-10" aria-hidden="true" tabindex="-1"></a>  <span class="kw">let</span> env2 <span class="ot">=</span> <span class="dt">TypeEnv</span></span>
<span id="cb43-11"><a href="#cb43-11" aria-hidden="true" tabindex="-1"></a>        { teParent <span class="ot">=</span> <span class="dt">Just</span> env1</span>
<span id="cb43-12"><a href="#cb43-12" aria-hidden="true" tabindex="-1"></a>        , teTypes <span class="ot">=</span> Map.fromList <span class="op">$</span> params2 <span class="op">&lt;&amp;&gt;</span> \(_, name, pt) <span class="ot">-&gt;</span> (name, pt)</span>
<span id="cb43-13"><a href="#cb43-13" aria-hidden="true" tabindex="-1"></a>        }</span>
<span id="cb43-14"><a href="#cb43-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb43-15"><a href="#cb43-15" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Type check the lambda body in the new environment.</span></span>
<span id="cb43-16"><a href="#cb43-16" aria-hidden="true" tabindex="-1"></a>  (_tenv2, body2) <span class="ot">&lt;-</span> foldTypeCheckVals env2 body1</span>
<span id="cb43-17"><a href="#cb43-17" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb43-18"><a href="#cb43-18" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Apply substitutions to each parameter type to resolve any type variables.</span></span>
<span id="cb43-19"><a href="#cb43-19" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Use `getMonoType` to extract the monomorphic type from a PolyType.</span></span>
<span id="cb43-20"><a href="#cb43-20" aria-hidden="true" tabindex="-1"></a>  <span class="co">--  This is required here because we only ever bind parameters to monotypes,</span></span>
<span id="cb43-21"><a href="#cb43-21" aria-hidden="true" tabindex="-1"></a>  <span class="co">--  so it is safe to extract without ambiguity.</span></span>
<span id="cb43-22"><a href="#cb43-22" aria-hidden="true" tabindex="-1"></a>  params3 <span class="ot">&lt;-</span> for params2 <span class="op">$</span> \(_p, _name, pt) <span class="ot">-&gt;</span></span>
<span id="cb43-23"><a href="#cb43-23" aria-hidden="true" tabindex="-1"></a>    applySubstitutions (getMonoType pt)</span>
<span id="cb43-24"><a href="#cb43-24" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb43-25"><a href="#cb43-25" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Get the return type of the lambda by looking at the last expression in the body.</span></span>
<span id="cb43-26"><a href="#cb43-26" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Apply substitutions to get the fully resolved type.</span></span>
<span id="cb43-27"><a href="#cb43-27" aria-hidden="true" tabindex="-1"></a>  retType <span class="ot">&lt;-</span> <span class="kw">case</span> lastMay body2 <span class="kw">of</span></span>
<span id="cb43-28"><a href="#cb43-28" aria-hidden="true" tabindex="-1"></a>    <span class="dt">Nothing</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="dt">L.TyNil</span></span>
<span id="cb43-29"><a href="#cb43-29" aria-hidden="true" tabindex="-1"></a>    <span class="dt">Just</span> l <span class="ot">-&gt;</span> applySubstitutions (getValType l)</span>
<span id="cb43-30"><a href="#cb43-30" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb43-31"><a href="#cb43-31" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Construct the final function type for the lambda.</span></span>
<span id="cb43-32"><a href="#cb43-32" aria-hidden="true" tabindex="-1"></a>  <span class="kw">let</span> lambdaType <span class="ot">=</span> <span class="dt">L.TyFunc</span> params3 retType</span>
<span id="cb43-33"><a href="#cb43-33" aria-hidden="true" tabindex="-1"></a>  <span class="fu">pure</span> (env1, <span class="dt">TvLambda</span> pos lambdaType params1 body2)</span></code></pre></div>
<ul>
<li>There are no explicit types in the lambda expression, so we create fresh type variables for each parameter and return type.</li>
<li>A lambda captures its environment, so we create a new environment layer for the lambda body.</li>
<li>The body is type-checked in this new environment.</li>
<li>Get the return type and apply substitutions to resolve any type variables.</li>
</ul>
<p>The way that this implementation handles the type environment naturally supports lexical scoping and variable capture which are the foundations of closures in functional languages.</p>
<p>When type-checking a lambda, we construct a new <code>TypeEnv</code> (<code>env2</code>) that contains just the lambda’s parameters. <code>teParent = Just env1</code> then links it to the parent scope.
<code>env1</code> is the environment at the point <strong>where the lambda is defined</strong>.
That is we return <code>(env1, TvLambda...)</code>, not <code>(env2, ...)</code>. The new bindings are scoped only within the lambda body, preserving the outer environment unmodified.</p>
<p>This mirrors how most functional languages implement closures.</p>
<div class="note">
<p>📝 Lambdas capture the environment where they are defined, not where they are called from.</p>
</div>
<h3 id="type-check-atom-expression">🧩 Type Check: Atom Expression</h3>
<p>Atoms are our only form of name lookup.
We fetch their polymorphic type from the environment and instantiate them to fresh monotypes for use.</p>
<div class="sourceCode" id="cb44"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb44-1"><a href="#cb44-1" aria-hidden="true" tabindex="-1"></a>typeCheckAtom pos v <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb44-2"><a href="#cb44-2" aria-hidden="true" tabindex="-1"></a>  <span class="co">-- Try to look up the variable in the type environment.</span></span>
<span id="cb44-3"><a href="#cb44-3" aria-hidden="true" tabindex="-1"></a>  <span class="kw">case</span> tlookup v env1 <span class="kw">of</span></span>
<span id="cb44-4"><a href="#cb44-4" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- If found, instantiate the value (see `instantiate`).</span></span>
<span id="cb44-5"><a href="#cb44-5" aria-hidden="true" tabindex="-1"></a>    <span class="dt">Just</span> pt <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb44-6"><a href="#cb44-6" aria-hidden="true" tabindex="-1"></a>      lt <span class="ot">&lt;-</span> instantiate pos pt</span>
<span id="cb44-7"><a href="#cb44-7" aria-hidden="true" tabindex="-1"></a>      <span class="fu">pure</span> (env1, <span class="dt">TvAtom</span> pos lt v)</span>
<span id="cb44-8"><a href="#cb44-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb44-9"><a href="#cb44-9" aria-hidden="true" tabindex="-1"></a>    <span class="co">-- If not found, throw an unbound type variable error.</span></span>
<span id="cb44-10"><a href="#cb44-10" aria-hidden="true" tabindex="-1"></a>    <span class="dt">Nothing</span> <span class="ot">-&gt;</span> lift <span class="op">.</span> throwE <span class="op">$</span> <span class="dt">TcUnboundVariable</span> pos v</span>
<span id="cb44-11"><a href="#cb44-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb44-12"><a href="#cb44-12" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb44-13"><a href="#cb44-13" aria-hidden="true" tabindex="-1"></a><span class="ot">tlookup ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">TypeEnv</span> <span class="ot">-&gt;</span> <span class="dt">Maybe</span> <span class="dt">L.PolyType</span></span>
<span id="cb44-14"><a href="#cb44-14" aria-hidden="true" tabindex="-1"></a>tlookup name env <span class="ot">=</span></span>
<span id="cb44-15"><a href="#cb44-15" aria-hidden="true" tabindex="-1"></a>  <span class="kw">case</span> Map.lookup name env<span class="op">.</span>teTypes <span class="kw">of</span></span>
<span id="cb44-16"><a href="#cb44-16" aria-hidden="true" tabindex="-1"></a>    <span class="dt">Just</span> v <span class="ot">-&gt;</span> <span class="dt">Just</span> v</span>
<span id="cb44-17"><a href="#cb44-17" aria-hidden="true" tabindex="-1"></a>    <span class="dt">Nothing</span> <span class="ot">-&gt;</span> <span class="kw">case</span> env<span class="op">.</span>teParent <span class="kw">of</span></span>
<span id="cb44-18"><a href="#cb44-18" aria-hidden="true" tabindex="-1"></a>      <span class="dt">Nothing</span> <span class="ot">-&gt;</span> <span class="dt">Nothing</span></span>
<span id="cb44-19"><a href="#cb44-19" aria-hidden="true" tabindex="-1"></a>      <span class="dt">Just</span> parent <span class="ot">-&gt;</span> tlookup name parent</span></code></pre></div>
<ul>
<li><code>tlookup</code> is a utility function that looks recursively up a variable in the current type environment or it’s parents etc.</li>
<li>Instantiate if found otherwise throw an unbound variable error.</li>
</ul>
<h3 id="limitations-future-work">Limitations &amp; Future Work</h3>
<h4 id="quick-wins">Quick Wins</h4>
<ul>
<li><dl>
<dt><strong>Type signatures for let and define</strong></dt>
<dd>
Useful for documentation and guiding inference
</dd>
<dd>
Would require parsing an extra annotation form and a simple unify call in the resolver.
</dd>
</dl></li>
<li><dl>
<dt><strong>Sequential let bindings</strong></dt>
<dd>
Evaluate bindings one by one, each seeing previous ones
</dd>
<dd>
Easy to implement by threading the environment through each binding in order.
</dd>
<dd>
The <code>LetType</code> sum type and case statements are already in place.
</dd>
</dl></li>
<li><dl>
<dt><strong>Floating point type support</strong></dt>
<dd>
Adds <code>TyDouble</code>
</dd>
<dd>
Could be handled either by overloading or numeric promotion.
</dd>
</dl></li>
</ul>
<h4 id="advanced-features">Advanced Features</h4>
<ul>
<li>Recursive let and mutual recursion</li>
<li>User‐defined algebraic data types</li>
<li><dl>
<dt>Type classes and constraints</dt>
<dd>
Another way to deal with <code>double</code> vs <code>int</code>.
</dd>
</dl></li>
<li><dl>
<dt>Performance optimisations</dt>
<dd>
Current substitution and environment operations are naive
</dd>
<dd>
Large programs would benefit from incremental or cached substitution and more efficient environment lookups.
</dd>
</dl></li>
<li>Improved error messages</li>
</ul>
<h3 id="type-checking-summary">Type Checking: Summary</h3>
<p>In just a few hundred lines, we have built a complete Hindley-Milner pipeline in <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/TypeChecker.hs">TypeChecker.hs</a>.
From parser through evaluator for a minimal Lisp.</p>
<p>We support unification, generalisation, instantiation, polymorphic let bindings, and fresh-variable generation.
The code is modular and clear, making it easy to extend.</p>
<h2 id="lowering">Lowering</h2>
<p><img src="/images/hm_lisp_lower.png" /></p>
<div class="tip">
<p>💡 Lowering is the process of transforming a complex AST into a simpler form</p>
</div>
<p>Real-world compilers often perform optimisations, desugaring, etc during lowering. In our pipeline, lowering simply erases all type and position annotations.</p>
<p>Including a lowering phase mirrors a full compiler architecture and sets the stage for REPL features such as runtime type queries.</p>
<p>Since the AST has already passed every type check, removing annotations <strong>cannot introduce runtime errors</strong>.</p>
<p>In GHC, types are erased before code generation, our lowering step follows the same approach.</p>
<p>With annotations removed, the resulting <code>EvalVar</code> nodes become the input to our interpreter (see the <code>EvalVar</code> type in the <a href="#evaluator">Evaluator</a> next section.).</p>
<div class="sourceCode" id="cb45"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb45-1"><a href="#cb45-1" aria-hidden="true" tabindex="-1"></a><span class="co">-- | Lower a typed value to &#39;EvalVar m&#39;.</span></span>
<span id="cb45-2"><a href="#cb45-2" aria-hidden="true" tabindex="-1"></a><span class="co">-- In this implementation, lowering does little other than type erasure.</span></span>
<span id="cb45-3"><a href="#cb45-3" aria-hidden="true" tabindex="-1"></a><span class="co">-- In a more complex implementation, lowering could also perform optimisations or additional transformations.</span></span>
<span id="cb45-4"><a href="#cb45-4" aria-hidden="true" tabindex="-1"></a><span class="co">-- Compling to bytecode or transpiling to another language would typically operate on lowered representation.</span></span>
<span id="cb45-5"><a href="#cb45-5" aria-hidden="true" tabindex="-1"></a><span class="ot">lowerToEvalVar&#39; ::</span> <span class="dt">T.TypedLispVal</span> <span class="ot">-&gt;</span> <span class="dt">Except</span> <span class="dt">E.EvalError</span> (<span class="dt">EvalVar</span> m)</span>
<span id="cb45-6"><a href="#cb45-6" aria-hidden="true" tabindex="-1"></a>lowerToEvalVar&#39; tv <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb45-7"><a href="#cb45-7" aria-hidden="true" tabindex="-1"></a>  <span class="kw">case</span> tv <span class="kw">of</span></span>
<span id="cb45-8"><a href="#cb45-8" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvNil</span> _ <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="dt">EvNil</span></span>
<span id="cb45-9"><a href="#cb45-9" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvInt</span> _ v <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvInt</span> v</span>
<span id="cb45-10"><a href="#cb45-10" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvBool</span> _ v <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvBool</span> v</span>
<span id="cb45-11"><a href="#cb45-11" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvString</span> _ v <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvString</span> v</span>
<span id="cb45-12"><a href="#cb45-12" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvAtom</span> _ _ a <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvVar</span> a</span>
<span id="cb45-13"><a href="#cb45-13" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-14"><a href="#cb45-14" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvList</span> _ _ vs <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb45-15"><a href="#cb45-15" aria-hidden="true" tabindex="-1"></a>      <span class="kw">case</span> lowerToEvalVar vs <span class="kw">of</span></span>
<span id="cb45-16"><a href="#cb45-16" aria-hidden="true" tabindex="-1"></a>        <span class="dt">Left</span> err <span class="ot">-&gt;</span> throwE err</span>
<span id="cb45-17"><a href="#cb45-17" aria-hidden="true" tabindex="-1"></a>        <span class="dt">Right</span> vs&#39; <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvList</span> vs&#39;</span>
<span id="cb45-18"><a href="#cb45-18" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-19"><a href="#cb45-19" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-20"><a href="#cb45-20" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvFuncCall</span> _p _t fv&#39; argvs&#39; <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb45-21"><a href="#cb45-21" aria-hidden="true" tabindex="-1"></a>      fv <span class="ot">&lt;-</span> lowerToEvalVar&#39; fv&#39;</span>
<span id="cb45-22"><a href="#cb45-22" aria-hidden="true" tabindex="-1"></a>      argvs <span class="ot">&lt;-</span> <span class="fu">traverse</span> lowerToEvalVar&#39; argvs&#39;</span>
<span id="cb45-23"><a href="#cb45-23" aria-hidden="true" tabindex="-1"></a>      <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvFuncCall</span> fv argvs</span>
<span id="cb45-24"><a href="#cb45-24" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-25"><a href="#cb45-25" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvDo</span> _ _ vs <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb45-26"><a href="#cb45-26" aria-hidden="true" tabindex="-1"></a>      <span class="kw">case</span> lowerToEvalVar vs <span class="kw">of</span></span>
<span id="cb45-27"><a href="#cb45-27" aria-hidden="true" tabindex="-1"></a>        <span class="dt">Left</span> err <span class="ot">-&gt;</span> throwE err</span>
<span id="cb45-28"><a href="#cb45-28" aria-hidden="true" tabindex="-1"></a>        <span class="dt">Right</span> vs&#39; <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvDo</span> vs&#39;</span>
<span id="cb45-29"><a href="#cb45-29" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-30"><a href="#cb45-30" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvLet</span> _ _ style bindings1 body1 <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb45-31"><a href="#cb45-31" aria-hidden="true" tabindex="-1"></a>      bindings2 <span class="ot">&lt;-</span> for bindings1 <span class="op">$</span> \(_, n, v) <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb45-32"><a href="#cb45-32" aria-hidden="true" tabindex="-1"></a>        v2 <span class="ot">&lt;-</span> lowerToEvalVar&#39; v</span>
<span id="cb45-33"><a href="#cb45-33" aria-hidden="true" tabindex="-1"></a>        <span class="fu">pure</span> (n, v2)</span>
<span id="cb45-34"><a href="#cb45-34" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-35"><a href="#cb45-35" aria-hidden="true" tabindex="-1"></a>      body2 <span class="ot">&lt;-</span></span>
<span id="cb45-36"><a href="#cb45-36" aria-hidden="true" tabindex="-1"></a>        <span class="kw">case</span> lowerToEvalVar body1 <span class="kw">of</span></span>
<span id="cb45-37"><a href="#cb45-37" aria-hidden="true" tabindex="-1"></a>          <span class="dt">Left</span> err <span class="ot">-&gt;</span> throwE err</span>
<span id="cb45-38"><a href="#cb45-38" aria-hidden="true" tabindex="-1"></a>          <span class="dt">Right</span> body&#39; <span class="ot">-&gt;</span> <span class="fu">pure</span> body&#39;</span>
<span id="cb45-39"><a href="#cb45-39" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-40"><a href="#cb45-40" aria-hidden="true" tabindex="-1"></a>      <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvLet</span> style bindings2 body2</span>
<span id="cb45-41"><a href="#cb45-41" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-42"><a href="#cb45-42" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvLambda</span> _pos _typ args body1 <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb45-43"><a href="#cb45-43" aria-hidden="true" tabindex="-1"></a>      body2 <span class="ot">&lt;-</span> <span class="fu">traverse</span> lowerToEvalVar&#39; body1</span>
<span id="cb45-44"><a href="#cb45-44" aria-hidden="true" tabindex="-1"></a>      <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvLambdaForm</span> (<span class="fu">snd</span> <span class="op">&lt;$&gt;</span> args) body2</span>
<span id="cb45-45"><a href="#cb45-45" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-46"><a href="#cb45-46" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvIf</span> _pos _typ cond then&#39; else&#39; <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb45-47"><a href="#cb45-47" aria-hidden="true" tabindex="-1"></a>      cond2 <span class="ot">&lt;-</span> lowerToEvalVar&#39; cond</span>
<span id="cb45-48"><a href="#cb45-48" aria-hidden="true" tabindex="-1"></a>      then2 <span class="ot">&lt;-</span> lowerToEvalVar&#39; then&#39;</span>
<span id="cb45-49"><a href="#cb45-49" aria-hidden="true" tabindex="-1"></a>      else2 <span class="ot">&lt;-</span> lowerToEvalVar&#39; else&#39;</span>
<span id="cb45-50"><a href="#cb45-50" aria-hidden="true" tabindex="-1"></a>      <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvIf</span> cond2 then2 else2</span>
<span id="cb45-51"><a href="#cb45-51" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-52"><a href="#cb45-52" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb45-53"><a href="#cb45-53" aria-hidden="true" tabindex="-1"></a>    <span class="dt">T.TvDefine</span> _pos _typ n v <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb45-54"><a href="#cb45-54" aria-hidden="true" tabindex="-1"></a>      v2 <span class="ot">&lt;-</span> lowerToEvalVar&#39; v</span>
<span id="cb45-55"><a href="#cb45-55" aria-hidden="true" tabindex="-1"></a>      <span class="fu">pure</span> <span class="op">$</span> <span class="dt">EvDefine</span> n v2</span></code></pre></div>
<h2 id="evaluating">Evaluating</h2>
<p><img src="/images/hm_lisp_eval.png" /></p>
<p>Having erased types, our evaluator walks the EvalVar tree, executing primitives and user-defined functions.
We know that the code is well-typed, so we can safely evaluate it without worrying about type errors.</p>
<p>Here is the lowered AST</p>
<div class="sourceCode" id="cb46"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb46-1"><a href="#cb46-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">EvalVar</span> m</span>
<span id="cb46-2"><a href="#cb46-2" aria-hidden="true" tabindex="-1"></a>  <span class="ot">=</span> <span class="dt">EvBool</span> <span class="op">!</span><span class="dt">Bool</span></span>
<span id="cb46-3"><a href="#cb46-3" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvDefine</span> <span class="op">!</span><span class="dt">Text</span> <span class="op">!</span>(<span class="dt">EvalVar</span> m)</span>
<span id="cb46-4"><a href="#cb46-4" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvDo</span> <span class="op">!</span>[<span class="dt">EvalVar</span> m]</span>
<span id="cb46-5"><a href="#cb46-5" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvFuncCall</span> <span class="op">!</span>(<span class="dt">EvalVar</span> m) <span class="op">!</span>[(<span class="dt">EvalVar</span> m)]</span>
<span id="cb46-6"><a href="#cb46-6" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvFunction</span> <span class="op">!</span>(<span class="dt">EvFunc</span> m)</span>
<span id="cb46-7"><a href="#cb46-7" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvIf</span> <span class="op">!</span>(<span class="dt">EvalVar</span> m) <span class="op">!</span>(<span class="dt">EvalVar</span> m) <span class="op">!</span>(<span class="dt">EvalVar</span> m)</span>
<span id="cb46-8"><a href="#cb46-8" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvInt</span> <span class="op">!</span><span class="dt">Int</span></span>
<span id="cb46-9"><a href="#cb46-9" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvLambdaForm</span> <span class="op">!</span>[<span class="dt">Text</span>] <span class="op">!</span>[<span class="dt">EvalVar</span> m]</span>
<span id="cb46-10"><a href="#cb46-10" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvLet</span> <span class="dt">L.LetStyle</span> <span class="op">!</span>[(<span class="dt">Text</span>, <span class="dt">EvalVar</span> m)] <span class="op">!</span>[<span class="dt">EvalVar</span> m]</span>
<span id="cb46-11"><a href="#cb46-11" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvList</span> <span class="op">!</span>[<span class="dt">EvalVar</span> m]</span>
<span id="cb46-12"><a href="#cb46-12" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvNil</span></span>
<span id="cb46-13"><a href="#cb46-13" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvString</span> <span class="op">!</span><span class="dt">Text</span></span>
<span id="cb46-14"><a href="#cb46-14" aria-hidden="true" tabindex="-1"></a>  <span class="op">|</span> <span class="dt">EvVar</span> <span class="op">!</span><span class="dt">Text</span></span>
<span id="cb46-15"><a href="#cb46-15" aria-hidden="true" tabindex="-1"></a>  <span class="kw">deriving</span> (<span class="dt">Eq</span>, <span class="dt">Show</span>)</span>
<span id="cb46-16"><a href="#cb46-16" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb46-17"><a href="#cb46-17" aria-hidden="true" tabindex="-1"></a><span class="kw">newtype</span> <span class="dt">EvFunc</span> m <span class="ot">=</span> <span class="dt">EvFunc</span> ([<span class="dt">EvalVar</span> m] <span class="ot">-&gt;</span> <span class="dt">EvalEnv</span> m <span class="ot">-&gt;</span> <span class="dt">ExceptT</span> <span class="dt">EvalError</span> m (<span class="dt">EvalVar</span> m))</span></code></pre></div>
<p>This is very similar to <code>TypedLispVal</code>, but without the type information and positions.
Unlike previous types, it is parameterised by a monad <code>m</code>. All the types in the evaluator and the evaluator itself follow this pattern.</p>
<p>The core evaluator remains pure, all IO is delegated to an <code>EvalIO m</code> record. By abstracting over m, we can run in IO or swap in a pure test runner.</p>
<div class="sourceCode" id="cb47"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb47-1"><a href="#cb47-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">EvalEnv</span> m <span class="ot">=</span> <span class="dt">EvalEnv</span></span>
<span id="cb47-2"><a href="#cb47-2" aria-hidden="true" tabindex="-1"></a>  {<span class="ot"> eeParent ::</span> <span class="op">!</span>(<span class="dt">Maybe</span> (<span class="dt">EvalEnv</span> m))</span>
<span id="cb47-3"><a href="#cb47-3" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> eeVars ::</span> <span class="op">!</span>(<span class="dt">Map</span> <span class="dt">Text</span> (<span class="dt">EvalVar</span> m))</span>
<span id="cb47-4"><a href="#cb47-4" aria-hidden="true" tabindex="-1"></a>  } <span class="kw">deriving</span> (<span class="dt">Eq</span>, <span class="dt">Show</span>)</span></code></pre></div>
<p><code>EvFunc</code> is newtype wrapper for a function type. That is a function that can be applied.
<code>EvalEnv</code> is the environment that the function is evaluated in, it contains the variable bindings and other state needed for evaluation. <code>EvalEnv</code> is hierarchical, i.e. a stack of environments.</p>
<h3 id="interaction-with-the-external-world">Interaction with the external world</h3>
<p>The evaluator itself is pure, it has no direct way to perform and side effects.
Instead it uses <code>EvalIO m</code> which provides a way to interact with the external world, assuming <code>m</code> is an <code>IO</code>-like monad.</p>
<div class="sourceCode" id="cb48"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb48-1"><a href="#cb48-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">EvalIO</span> m <span class="ot">=</span> <span class="dt">EvalIO</span></span>
<span id="cb48-2"><a href="#cb48-2" aria-hidden="true" tabindex="-1"></a>  {<span class="ot"> eiPrnLn ::</span> <span class="op">!</span>(<span class="kw">forall</span> s<span class="op">.</span> (<span class="dt">Show</span> s) <span class="ot">=&gt;</span> s <span class="ot">-&gt;</span> m ())</span>
<span id="cb48-3"><a href="#cb48-3" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> eiPrnTextLn ::</span> <span class="op">!</span>(<span class="dt">Text</span> <span class="ot">-&gt;</span> m ())</span>
<span id="cb48-4"><a href="#cb48-4" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> eiPrnErrorInCode ::</span> <span class="op">!</span>(<span class="kw">forall</span> e<span class="op">.</span> (<span class="dt">L.LispError</span> e) <span class="ot">=&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> e <span class="ot">-&gt;</span> m ())</span>
<span id="cb48-5"><a href="#cb48-5" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> eiLog ::</span> <span class="op">!</span>(<span class="dt">Lg.Logger</span> m)</span>
<span id="cb48-6"><a href="#cb48-6" aria-hidden="true" tabindex="-1"></a>  }</span></code></pre></div>
<p>Of course you could also implement <code>EvalIO</code> without using <code>IO</code> e.g. if you wanted to use it from a pure context.</p>
<h3 id="primitive-functions">Primitive Functions</h3>
<p>Primitive functions provide built-in operations implemented in Haskell but whose types are checked in our HM engine.</p>
<p><a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/PrimFns.hs">PrimFns.hs</a> contains the primitive function’s implementation.
It is very small and incomplete but does demonstrate how the host language can provide functions to the LISP language.</p>
<p>E.g.</p>
<div class="sourceCode" id="cb49"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb49-1"><a href="#cb49-1" aria-hidden="true" tabindex="-1"></a><span class="kw">newtype</span> <span class="dt">PrimitiveFunctions</span> m <span class="ot">=</span> <span class="dt">PrimitiveFunctions</span> (<span class="dt">Map</span> <span class="dt">Text</span> (<span class="dt">EvFunc</span> m, <span class="dt">L.PolyType</span>))</span>
<span id="cb49-2"><a href="#cb49-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb49-3"><a href="#cb49-3" aria-hidden="true" tabindex="-1"></a>getPrimitiveFunctions</span>
<span id="cb49-4"><a href="#cb49-4" aria-hidden="true" tabindex="-1"></a><span class="ot">  ::</span> <span class="kw">forall</span> m<span class="op">.</span></span>
<span id="cb49-5"><a href="#cb49-5" aria-hidden="true" tabindex="-1"></a>     (<span class="dt">Monad</span> m)</span>
<span id="cb49-6"><a href="#cb49-6" aria-hidden="true" tabindex="-1"></a>  <span class="ot">=&gt;</span> <span class="dt">E.EvalIO</span> m</span>
<span id="cb49-7"><a href="#cb49-7" aria-hidden="true" tabindex="-1"></a>  <span class="ot">-&gt;</span> m (<span class="dt">E.PrimitiveFunctions</span> m)</span>
<span id="cb49-8"><a href="#cb49-8" aria-hidden="true" tabindex="-1"></a>getPrimitiveFunctions eio <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb49-9"><a href="#cb49-9" aria-hidden="true" tabindex="-1"></a>  <span class="kw">let</span> intIntInt <span class="ot">=</span> <span class="dt">L.PtMono</span> <span class="op">$</span> <span class="dt">L.TyFunc</span> [<span class="dt">L.TyInt</span>, <span class="dt">L.TyInt</span>] <span class="dt">L.TyInt</span></span>
<span id="cb49-10"><a href="#cb49-10" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb49-11"><a href="#cb49-11" aria-hidden="true" tabindex="-1"></a>  <span class="fu">pure</span> <span class="op">.</span> <span class="dt">E.PrimitiveFunctions</span> <span class="op">.</span> Map.fromList <span class="op">$</span></span>
<span id="cb49-12"><a href="#cb49-12" aria-hidden="true" tabindex="-1"></a>    [ (<span class="st">&quot;+&quot;</span>, (<span class="dt">E.EvFunc</span> <span class="op">$</span> eMathsBin (<span class="op">+</span>), intIntInt))</span>
<span id="cb49-13"><a href="#cb49-13" aria-hidden="true" tabindex="-1"></a>    , (<span class="st">&quot;-&quot;</span>, (<span class="dt">E.EvFunc</span> <span class="op">$</span> eMathsBin (<span class="op">-</span>), intIntInt))</span>
<span id="cb49-14"><a href="#cb49-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb49-15"><a href="#cb49-15" aria-hidden="true" tabindex="-1"></a>    , ( <span class="st">&quot;prn&quot;</span></span>
<span id="cb49-16"><a href="#cb49-16" aria-hidden="true" tabindex="-1"></a>      , ( <span class="dt">E.EvFunc</span> ePrn</span>
<span id="cb49-17"><a href="#cb49-17" aria-hidden="true" tabindex="-1"></a>        , <span class="dt">L.PtMono</span> <span class="op">$</span> <span class="dt">L.TyFunc</span> [<span class="dt">L.TyString</span>] <span class="dt">L.TyNil</span></span>
<span id="cb49-18"><a href="#cb49-18" aria-hidden="true" tabindex="-1"></a>        )</span>
<span id="cb49-19"><a href="#cb49-19" aria-hidden="true" tabindex="-1"></a>      )</span>
<span id="cb49-20"><a href="#cb49-20" aria-hidden="true" tabindex="-1"></a>    ]</span>
<span id="cb49-21"><a href="#cb49-21" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb49-22"><a href="#cb49-22" aria-hidden="true" tabindex="-1"></a>  <span class="kw">where</span></span>
<span id="cb49-23"><a href="#cb49-23" aria-hidden="true" tabindex="-1"></a><span class="ot">    ePrn ::</span> [<span class="dt">E.EvalVar</span> m] <span class="ot">-&gt;</span> <span class="dt">E.EvalEnv</span> m <span class="ot">-&gt;</span> <span class="dt">ExceptT</span> <span class="dt">E.EvalError</span> m (<span class="dt">E.EvalVar</span> m)</span>
<span id="cb49-24"><a href="#cb49-24" aria-hidden="true" tabindex="-1"></a>    ePrn args _eenv <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb49-25"><a href="#cb49-25" aria-hidden="true" tabindex="-1"></a>      <span class="kw">case</span> args <span class="kw">of</span></span>
<span id="cb49-26"><a href="#cb49-26" aria-hidden="true" tabindex="-1"></a>        [v] <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb49-27"><a href="#cb49-27" aria-hidden="true" tabindex="-1"></a>          s <span class="ot">&lt;-</span> E.as&#39; E.asString <span class="st">&quot;string&quot;</span> <span class="op">$</span> v</span>
<span id="cb49-28"><a href="#cb49-28" aria-hidden="true" tabindex="-1"></a>          lift <span class="op">.</span> E.eiPrnTextLn eio <span class="op">$</span> s</span>
<span id="cb49-29"><a href="#cb49-29" aria-hidden="true" tabindex="-1"></a>          <span class="fu">pure</span> <span class="dt">E.EvNil</span></span>
<span id="cb49-30"><a href="#cb49-30" aria-hidden="true" tabindex="-1"></a>        _ <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb49-31"><a href="#cb49-31" aria-hidden="true" tabindex="-1"></a>          throwE <span class="op">.</span> <span class="dt">E.EeRuntimeError</span> <span class="dt">Nothing</span> <span class="op">$</span> <span class="st">&quot;prn: wrong number of arguments calling prn: expected 1 argument, got: &quot;</span> <span class="op">&lt;&gt;</span> <span class="fu">show</span> (<span class="fu">length</span> args)</span>
<span id="cb49-32"><a href="#cb49-32" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb49-33"><a href="#cb49-33" aria-hidden="true" tabindex="-1"></a><span class="ot">    eMathsBin ::</span> (<span class="dt">Int</span> <span class="ot">-&gt;</span> <span class="dt">Int</span> <span class="ot">-&gt;</span> <span class="dt">Int</span>) <span class="ot">-&gt;</span> [<span class="dt">E.EvalVar</span> m] <span class="ot">-&gt;</span> <span class="dt">E.EvalEnv</span> m <span class="ot">-&gt;</span> <span class="dt">ExceptT</span> <span class="dt">E.EvalError</span> m (<span class="dt">E.EvalVar</span> m)</span>
<span id="cb49-34"><a href="#cb49-34" aria-hidden="true" tabindex="-1"></a>    eMathsBin op args _eenv <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb49-35"><a href="#cb49-35" aria-hidden="true" tabindex="-1"></a>      <span class="kw">case</span> args <span class="kw">of</span></span>
<span id="cb49-36"><a href="#cb49-36" aria-hidden="true" tabindex="-1"></a>        [v1, v2] <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb49-37"><a href="#cb49-37" aria-hidden="true" tabindex="-1"></a>          i1 <span class="ot">&lt;-</span> E.as&#39; E.asInt <span class="st">&quot;int&quot;</span> <span class="op">$</span> v1</span>
<span id="cb49-38"><a href="#cb49-38" aria-hidden="true" tabindex="-1"></a>          i2 <span class="ot">&lt;-</span> E.as&#39; E.asInt <span class="st">&quot;int&quot;</span> <span class="op">$</span> v2</span>
<span id="cb49-39"><a href="#cb49-39" aria-hidden="true" tabindex="-1"></a>          <span class="fu">pure</span> <span class="op">.</span> <span class="dt">E.EvInt</span> <span class="op">$</span> op i1 i2</span>
<span id="cb49-40"><a href="#cb49-40" aria-hidden="true" tabindex="-1"></a>        _ <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb49-41"><a href="#cb49-41" aria-hidden="true" tabindex="-1"></a>          throwE <span class="op">.</span> <span class="dt">E.EeRuntimeError</span> <span class="dt">Nothing</span> <span class="op">$</span> <span class="st">&quot;Wrong number of arguments calling integer binary function: expected 2 arguments, got: &quot;</span> <span class="op">&lt;&gt;</span> <span class="fu">show</span> (<span class="fu">length</span> args)</span></code></pre></div>
<p><code>getPrimitiveFunctions</code> returns a map of primitive functions and their types.
The types are used during type checking to ensure that the arguments passed to the functions are of the correct type.
The evaluator will get only the <code>EvFunc</code> from the <code>(EvFunc m, L.PolyType)</code> pair for use in evaluation.</p>
<p>Typically you’d want to have as few primitive functions as possible. Then you’d provide a standard library of functions written in the target language.</p>
<h3 id="standard-library">Standard Library</h3>
<p>The REPL loads a small LISP standard library at startup.</p>
<div class="sourceCode" id="cb50"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb50-1"><a href="#cb50-1" aria-hidden="true" tabindex="-1"></a><span class="co">; identity function</span></span>
<span id="cb50-2"><a href="#cb50-2" aria-hidden="true" tabindex="-1"></a>(define <span class="kw">identity</span> (λ (x) x))</span>
<span id="cb50-3"><a href="#cb50-3" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb50-4"><a href="#cb50-4" aria-hidden="true" tabindex="-1"></a><span class="co">; create a list with two elements</span></span>
<span id="cb50-5"><a href="#cb50-5" aria-hidden="true" tabindex="-1"></a>(define pair (λ (x y) (<span class="kw">list</span> x y)))</span>
<span id="cb50-6"><a href="#cb50-6" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb50-7"><a href="#cb50-7" aria-hidden="true" tabindex="-1"></a><span class="co">; square a number</span></span>
<span id="cb50-8"><a href="#cb50-8" aria-hidden="true" tabindex="-1"></a>(define square (λ (x) (<span class="op">*</span> x x)))</span></code></pre></div>
<h2 id="repl">REPL</h2>
<p><img src="/images/hm_lisp_repl.png" /></p>
<p>The REPL ties together parsing, type checking, lowering, and evaluation into an interactive loop.
It is implemented in <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/Repl.hs">Repl.hs</a> using the
<a href="https://hackage.haskell.org/package/haskeline">haskline</a> library for line editing, history, and simple completion</p>
<p>The REPL is not the focus of this post, so I won’t go into too much detail here.</p>
<h3 id="startup">Startup</h3>
<p>On launch, the REPL:</p>
<ul>
<li>Loads <code>stdLib.lisp</code> (the standard library).</li>
<li>Initializes the parser, type checker, evaluator, and environment with primitives.</li>
<li>Enters a loop reading user input.</li>
</ul>
<div class="warning">
<p>⚠️ In this prototype, <code>stdLib.lisp</code> must reside in the current directory.</p>
</div>
<h3 id="repl-features">REPL Features</h3>
<h4 id="commands">Commands</h4>
<ul>
<li><dl>
<dt>Expression Evaluation</dt>
<dd>
Typing any valid Lisp expression parses, type-checks, and evaluates it, printing the result.
</dd>
</dl></li>
<li><dl>
<dt><code>:t &lt;expr&gt;</code></dt>
<dd>
Show the inferred type of <code>&lt;expr&gt;</code> after evaluating it.
</dd>
</dl></li>
<li><dl>
<dt><code>:ts</code></dt>
<dd>
List all known top-level names and their types (primitives, library definitions, and user defines).
</dd>
</dl></li>
<li><dl>
<dt><code>+t &lt;expr&gt;</code></dt>
<dd>
Toggle printing of types after evaluation.
</dd>
<dd>
This is on by default, but can be toggled with <code>+t</code>.
</dd>
</dl></li>
<li><dl>
<dt><code>:quit</code> or <code>Ctrl-D</code></dt>
<dd>
Exit the REPL.
</dd>
</dl></li>
<li><dl>
<dt><code>+m</code></dt>
<dd>
Toggle multi-line mode. End a block with a line containing only ..
</dd>
</dl></li>
</ul>
<h4 id="multi-line-mode">Multi-Line Mode</h4>
<p>When multi-line mode is on, you can enter a block over several lines:</p>
<div class="sourceCode" id="cb51"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb51-1"><a href="#cb51-1" aria-hidden="true" tabindex="-1"></a><span class="op">&gt;</span> +m</span>
<span id="cb51-2"><a href="#cb51-2" aria-hidden="true" tabindex="-1"></a>Multiline <span class="op">=</span> on.</span>
<span id="cb51-3"><a href="#cb51-3" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb51-4"><a href="#cb51-4" aria-hidden="true" tabindex="-1"></a>&gt;&gt;&gt; (<span class="kw">let</span></span>
<span id="cb51-5"><a href="#cb51-5" aria-hidden="true" tabindex="-1"></a>...    ( (x <span class="dv">10</span>)</span>
<span id="cb51-6"><a href="#cb51-6" aria-hidden="true" tabindex="-1"></a>...      (y <span class="dv">20</span>)</span>
<span id="cb51-7"><a href="#cb51-7" aria-hidden="true" tabindex="-1"></a>...    )</span>
<span id="cb51-8"><a href="#cb51-8" aria-hidden="true" tabindex="-1"></a>...    (<span class="op">*</span> x y)</span>
<span id="cb51-9"><a href="#cb51-9" aria-hidden="true" tabindex="-1"></a>... )</span>
<span id="cb51-10"><a href="#cb51-10" aria-hidden="true" tabindex="-1"></a>... .</span>
<span id="cb51-11"><a href="#cb51-11" aria-hidden="true" tabindex="-1"></a><span class="dv">200</span></span></code></pre></div>
<h4 id="known-types-with-ts">Known Types with <code>:ts</code></h4>
<p><code>:ts</code> shows all known types, which is useful for debugging and understanding the types in the program.</p>
<div class="sourceCode" id="cb52"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb52-1"><a href="#cb52-1" aria-hidden="true" tabindex="-1"></a><span class="op">&gt;</span> :ts</span>
<span id="cb52-2"><a href="#cb52-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb52-3"><a href="#cb52-3" aria-hidden="true" tabindex="-1"></a>   <span class="op">*</span> (: Int -&gt; Int -&gt; Int)</span>
<span id="cb52-4"><a href="#cb52-4" aria-hidden="true" tabindex="-1"></a>   <span class="op">+</span> (: Int -&gt; Int -&gt; Int)</span>
<span id="cb52-5"><a href="#cb52-5" aria-hidden="true" tabindex="-1"></a>   <span class="op">-</span> (: Int -&gt; Int -&gt; Int)</span>
<span id="cb52-6"><a href="#cb52-6" aria-hidden="true" tabindex="-1"></a>   <span class="op">/</span> (: Int -&gt; Int -&gt; Int)</span>
<span id="cb52-7"><a href="#cb52-7" aria-hidden="true" tabindex="-1"></a>   <span class="op">&lt;</span> (: Int -&gt; Int -&gt; Bool)</span>
<span id="cb52-8"><a href="#cb52-8" aria-hidden="true" tabindex="-1"></a>   <span class="op">&gt;</span> (: Int -&gt; Int -&gt; Bool)</span>
<span id="cb52-9"><a href="#cb52-9" aria-hidden="true" tabindex="-1"></a>   <span class="kw">and</span> (: Bool -&gt; Bool -&gt; Bool)</span>
<span id="cb52-10"><a href="#cb52-10" aria-hidden="true" tabindex="-1"></a>   eq_bool (: Bool -&gt; Bool -&gt; Bool)</span>
<span id="cb52-11"><a href="#cb52-11" aria-hidden="true" tabindex="-1"></a>   eq_int (: Int -&gt; Int -&gt; Bool)</span>
<span id="cb52-12"><a href="#cb52-12" aria-hidden="true" tabindex="-1"></a>   eq_string (: String -&gt; String -&gt; Bool)</span>
<span id="cb52-13"><a href="#cb52-13" aria-hidden="true" tabindex="-1"></a>   <span class="kw">identity</span> (∀ [U0] (: U0 -&gt; U0))</span>
<span id="cb52-14"><a href="#cb52-14" aria-hidden="true" tabindex="-1"></a>   <span class="kw">not</span> (: Bool -&gt; Bool)</span>
<span id="cb52-15"><a href="#cb52-15" aria-hidden="true" tabindex="-1"></a>   <span class="kw">or</span> (: Bool -&gt; Bool -&gt; Bool)</span>
<span id="cb52-16"><a href="#cb52-16" aria-hidden="true" tabindex="-1"></a>   pair (∀ [U2] (: U2 -&gt; U2 -&gt; (List U2)))</span>
<span id="cb52-17"><a href="#cb52-17" aria-hidden="true" tabindex="-1"></a>   prn (: String -&gt; Nil)</span>
<span id="cb52-18"><a href="#cb52-18" aria-hidden="true" tabindex="-1"></a>   square (: Int -&gt; Int)</span></code></pre></div>
<h3 id="repl-example">REPL Example</h3>
<div class="sourceCode" id="cb53"><pre class="sourceCode lisp"><code class="sourceCode commonlisp"><span id="cb53-1"><a href="#cb53-1" aria-hidden="true" tabindex="-1"></a><span class="op">&gt;</span> (define <span class="kw">identity</span> (λ (x) x))</span>
<span id="cb53-2"><a href="#cb53-2" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb53-3"><a href="#cb53-3" aria-hidden="true" tabindex="-1"></a><span class="op">&gt;</span> :t <span class="kw">identity</span></span>
<span id="cb53-4"><a href="#cb53-4" aria-hidden="true" tabindex="-1"></a><span class="kw">identity</span> : ∀ [U0]. U0 -&gt; U0</span>
<span id="cb53-5"><a href="#cb53-5" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb53-6"><a href="#cb53-6" aria-hidden="true" tabindex="-1"></a><span class="op">&gt;</span> (<span class="kw">identity</span> <span class="dv">123</span>)</span>
<span id="cb53-7"><a href="#cb53-7" aria-hidden="true" tabindex="-1"></a><span class="dv">123</span></span>
<span id="cb53-8"><a href="#cb53-8" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb53-9"><a href="#cb53-9" aria-hidden="true" tabindex="-1"></a><span class="op">&gt;</span> (<span class="kw">identity</span> <span class="st">&quot;hello&quot;</span>)</span>
<span id="cb53-10"><a href="#cb53-10" aria-hidden="true" tabindex="-1"></a><span class="st">&quot;hello&quot;</span></span>
<span id="cb53-11"><a href="#cb53-11" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb53-12"><a href="#cb53-12" aria-hidden="true" tabindex="-1"></a><span class="op">&gt;</span> (<span class="kw">identity</span> (<span class="kw">list</span> <span class="dv">1</span> <span class="dv">2</span> <span class="dv">3</span>))</span>
<span id="cb53-13"><a href="#cb53-13" aria-hidden="true" tabindex="-1"></a>(<span class="dv">1</span> <span class="dv">2</span> <span class="dv">3</span>)</span>
<span id="cb53-14"><a href="#cb53-14" aria-hidden="true" tabindex="-1"></a></span>
<span id="cb53-15"><a href="#cb53-15" aria-hidden="true" tabindex="-1"></a><span class="op">&gt;</span> ((λ (x) (<span class="op">+</span> x x)) <span class="dv">10</span>)</span>
<span id="cb53-16"><a href="#cb53-16" aria-hidden="true" tabindex="-1"></a><span class="dv">20</span></span></code></pre></div>
<h3 id="types-at-runtime">Types at Runtime?</h3>
<p>Since <a href="#lowering">Lowering</a> erases types from the AST, you might wonder how the REPL is able to show types (for <code>:t</code> and <code>:ts</code>).
The answer is that <a href="https://github.com/andrevdm/hmLispTypeSystem/blob/blog/src/Eval/Evaluator.hs">evaluation</a> returns both a value and a type environment.
The REPL retains this and is then able to display type information even after erasure.</p>
<div class="sourceCode" id="cb54"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb54-1"><a href="#cb54-1" aria-hidden="true" tabindex="-1"></a>m (<span class="dt">Either</span> <span class="dt">EvalError</span> (<span class="dt">T.TypeEnv</span>, <span class="dt">T.TypedLispVal</span>, <span class="dt">EvalEnv</span> m, <span class="dt">EvalVar</span> m))</span></code></pre></div>
<p>The REPL stores (and updates) this in its state</p>
<div class="sourceCode" id="cb55"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb55-1"><a href="#cb55-1" aria-hidden="true" tabindex="-1"></a><span class="kw">data</span> <span class="dt">REnv</span> <span class="ot">=</span> <span class="dt">REnv</span></span>
<span id="cb55-2"><a href="#cb55-2" aria-hidden="true" tabindex="-1"></a>  {<span class="ot"> ePrintType ::</span> <span class="op">!</span><span class="dt">Bool</span></span>
<span id="cb55-3"><a href="#cb55-3" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> eEvalEnv ::</span> <span class="op">!</span>(<span class="dt">Maybe</span> (<span class="dt">E.EvalEnv</span> <span class="dt">IO</span>))</span>
<span id="cb55-4"><a href="#cb55-4" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> eEio ::</span> <span class="op">!</span>(<span class="dt">E.EvalIO</span> <span class="dt">IO</span>)</span>
<span id="cb55-5"><a href="#cb55-5" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> ePrimFns ::</span> <span class="op">!</span>(<span class="dt">E.PrimitiveFunctions</span> <span class="dt">IO</span>)</span>
<span id="cb55-6"><a href="#cb55-6" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> eTypeEnv ::</span> <span class="op">!</span>(<span class="dt">T.TypeEnv</span>)   ; <span class="op">&lt;&lt;-----------</span> <span class="dt">HERE</span></span>
<span id="cb55-7"><a href="#cb55-7" aria-hidden="true" tabindex="-1"></a>  ,<span class="ot"> eMultiLine ::</span> <span class="op">!</span><span class="dt">Bool</span></span>
<span id="cb55-8"><a href="#cb55-8" aria-hidden="true" tabindex="-1"></a>  }</span></code></pre></div>
<p>This approach separates runtime execution (<code>EvalVar</code>) from type bookkeeping, while still allowing full type introspection in the interactive REPL.</p>
<h1 id="conclusion">Conclusion</h1>
<ul>
<li>In this post, we walked through a Hindley–Milner type system implementation in Haskell for a minimal Lisp.</li>
<li>You saw the core theory of unification, generalisation, instantiation, and principal types.</li>
<li>You also explored a working code pipeline, from parsing and resolution through type checking, lowering, and evaluation.</li>
<li>A key takeaway is that HM-style inference need not be daunting to implement.</li>
<li>Although minimal, this example provides a solid foundation for further extensions.</li>
</ul>
<p>I hope you’ve found this walk-through both practical and inspiring.</p>
<p>Please feel free to clone the <a href="https://github.com/andrevdm/hmLispTypeSystem">GitHub repo</a>, experiment with the code, and share your improvements or questions.</p>
<h2 id="further-reading">Further Reading</h2>
<ul>
<li><dl>
<dt><strong>The Typed Racket Guide</strong></dt>
<dd>
<a href="https://docs.racket-lang.org/ts-guide/">Typed Racket</a>
</dd>
</dl></li>
<li><dl>
<dt><strong>Robert Nystrom</strong></dt>
<dd>
<a href="https://craftinginterpreters.com/">Crafting Interpreters</a>
</dd>
</dl></li>
<li><dl>
<dt><strong>Wikipedia</strong>:</dt>
<dd>
<a href="https://en.wikipedia.org/wiki/Hindley%E2%80%93Milner_type_system">Hindley–Milner type system</a>
</dd>
</dl></li>
<li><dl>
<dt><strong>Jeremy Siek</strong></dt>
<dd>
<a href="https://siek.blogspot.com/2012/07/crash-course-on-notation-in-programming.html">Crash Course on Notation in Programming Language Theory</a>
</dd>
</dl></li>
<li><dl>
<dt><strong>Pierce, Benjamin C.</strong> (2002). <em>Types and Programming Languages</em>. MIT Press.</dt>
<dd>
<a href="https://www.cis.upenn.edu/~bcpierce/tapl/">Types and Programming Languages</a>
</dd>
</dl></li>
<li><dl>
<dt><strong>Milner, R.</strong> (1978). <em>A theory of type polymorphism in programming</em>.</dt>
<dd>
<a href="https://www.sciencedirect.com/science/article/pii/0022000078900144">Journal of Computer and System Sciences, 17(3), 348-375.</a>
</dd>
</dl></li>
<li><dl>
<dt><strong>Damas, L. &amp; Milner, R.</strong> (1982). <em>Principal type-schemes for functional programs</em>.</dt>
<dd>
<a href="https://dl.acm.org/doi/10.1145/582153.582176">Principal type-schemes for functional programs</a>
</dd>
</dl></li>
</ul>
</div>
]]></summary>
</entry>
<entry>
    <title>Bollama - Simple Ollama TUI</title>
    <link href="http://www.andrevdm.com/posts/2025-05-27-bollama-tui-for-ollama.html" />
    <id>http://www.andrevdm.com/posts/2025-05-27-bollama-tui-for-ollama.html</id>
    <published>2025-05-27T00:00:00Z</published>
    <updated>2025-05-27T00:00:00Z</updated>
    <summary type="html"><![CDATA[<div class="info">
    Posted on May 27, 2025
    
</div>

<div id="post_content" class="post-content">
  <h2 id="bollama-small-simple-maybe-useful">Bollama – small, simple, maybe useful</h2>
<p>I’ve been using Ollama for a bit and testing some local models to see how they work for various use cases.
To make this easier, I created a small terminal UI called Bollama.</p>
<p>It’s nothing fancy and mostly built for myself to quickly test local models without needing to spin up a full UI or get lost in the CLI.</p>
<p>It supports</p>
<ul>
<li>chat.</li>
<li>shows locally installed models .</li>
<li>showing and stopping running models.</li>
</ul>
<p>If you’re just trying to evaluate a few local models, it might come in handy.</p>
<p>⚠️ It is not heavily supported. I’m not trying to compete with the bigger tools. It does what I need, and I figured maybe someone else might find it useful.</p>
<h2 id="what-makes-it-different">🧪 What makes it different?</h2>
<p>Bollama is intentionally simple and aimed at quick evaluation of local models.
I found other tools to be a bit heavy weigh or have the wrong focus for this.</p>
<h2 id="installation">📦 Installation</h2>
<p>🛠️ There are <a href="https://github.com/andrevdm/bollama/releases/">prebuilt binaries</a> for Linux and Windows.</p>
<p>Alternatively, if you have Haskell, you can build it from source using <code>cabal build</code>.</p>
<h2 id="source-code">Source Code</h2>
<p>The source code is on <a href="https://github.com/andrevdm/bollama">Github</a>.</p>
<p>It MIT licensed, feel free to use it as you like.</p>
<p>It is written is written in Haskell and uses</p>
<ul>
<li>The incredible <a href="https://github.com/jtdaugherty/brick/blob/master/README.md">brick library</a> for the terminal UI.</li>
<li>The <a href="https://github.com/tusharad/ollama-haskell">ollama-hs</a> library for Ollama API calls.</li>
</ul>
<h2 id="usage-and-screenshots">Usage and Screenshots</h2>
<p>See the README on <a href="https://github.com/andrevdm/bollama">Github</a> for usage instructions and more details.</p>
<p><img src="/images/bollama_4_chat_01_main.png" /></p>
</div>
]]></summary>
</entry>
<entry>
    <title>bhoogle - Building a simple hoogle GUI with brick  (Updated for brick 1.1)</title>
    <link href="http://www.andrevdm.com/posts/2022-09-07-bhoogle.html" />
    <id>http://www.andrevdm.com/posts/2022-09-07-bhoogle.html</id>
    <published>2022-09-07T00:00:00Z</published>
    <updated>2022-09-07T00:00:00Z</updated>
    <summary type="html"><![CDATA[<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
        <title>Andre's Blog</title>
        <link rel="stylesheet" type="text/css" href="../css/default.css" />
        <link rel="stylesheet" type="text/css" href="../css/syntax.css" />
    </head>
    <body>
      <div id="bodyInner">
        <div id="header">
            <div id="logo">
                <a href="../">Blog</a>
            </div>
            <div id="navigation">
                <a href="../">Home</a>
                <a href="../contact.html">Contact</a>
                <!-- <a href="/about.html">About</a> -->
            </div>
        </div>

        <div id="content">
            <h1><a href="#top">bhoogle - Building a simple hoogle GUI with brick  (Updated for brick 1.1)</a></h1>

            <div class="info">
    Posted on September  7, 2022

</div>

<h1 id="overview">Overview</h1>
<p>bhoogle is a simple hoogle terminal GUI written using <a href="https://hackage.haskell.org/package/brick">brick</a>. This post is the annotated source code that should give you an idea of how to use brick and how easy brick makes building terminal UIs.</p>
<p>This post is a simple upgrade from the [original 2018 version)[http://www.andrevdm.com/posts/2018-01-15-bhoogle.html] to brick version 1.1 If you are upgrading an existing project then looking at the upgrade diff may be useful</p>
<ul>
<li><a href="https://github.com/andrevdm/bhoogle/commit/bf125b4253ff48d801291b0e7fa5368b089e85e4">Diff for Brick 1.1 for blog version</a></li>
<li><a href="https://github.com/andrevdm/bhoogle/commit/2c4159d264d2fa112b0a7814ae36df97ad0c74c2">Diff for Brick 1.1 for full app</a></li>
</ul>
<h2 id="bhoogle">bhoogle</h2>
<p><img src="../images/bhoogle.png" /></p>
<p>bhoogle is possibly useful as a local hoogle UI as well as a demo app. You can get the full code from <a href="https://github.com/andrevdm/bhoogle">github</a>.</p>
<h3 id="setup">Setup</h3>
<p>You will need an existing local hoogle database. If you do not already have one or are unsure, then do this</p>
<ol type="1">
<li>Install hoogle (e.g. <code>cabal install hoogle</code>)</li>
<li>Generate the default database (<code>hoogle generate</code>)</li>
</ol>
<h3 id="build">Build</h3>
<p>You can then <a href="https://github.com/andrevdm/bhoogle">clone the code</a></p>
<h3 id="usage">Usage</h3>
<ol type="1">
<li>Enter a type search in the “type” edit box</li>
<li>Press <strong>enter</strong> to search: focus goes directly to the results list</li>
<li>Or press <strong>tab</strong> to search and focus will go to the “text” edit box</li>
<li>You can then filter the results by typing in the “text” edit box, any result containing the sub-string typed will be shown</li>
<li>Navigate the results by using <strong>arrow</strong> or vi (<strong>hjkl</strong>) keys</li>
<li>Pressing <strong>‘s’</strong> in the results list will toggle the sort order</li>
<li><strong>Escape</strong> to exit</li>
<li>Search-ahead is enable for any type search longer than three characters</li>
</ol>
<h1 id="brick">Brick</h1>
<p>There are a few conventions to get used to when building a brick UI, but I don’t think it should take you too long to get the hang of things.</p>
<p>The <a href="https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst">brick user guide</a> and documentation are fantastic. Brick comes with multiple example apps that show controls and features being used. There are also third party tutorials e.g. <a href="https://github.com/jtdaugherty/brick/blob/master/docs/samtay-tutorial.md">Samuel Tay’s brick tutorial</a></p>
<h1 id="bhoogle-0.1.1.1-source">bhoogle 0.1.1.1 source</h1>
<p>If you have looked at the user guide or Samuel Tay’s tutorial you’ll already have some idea of the fundamental concepts. Below is the annotated source for bhoogle. As always feel free to email or contact me on <a href="https://twitter.com/andrevdm">twitter</a> if anything is unclear and I’ll do my best to assist.</p>
<div class="sourceCode" id="cb1"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb1-1"><a href="#cb1-1"></a><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></span>
<span id="cb1-2"><a href="#cb1-2"></a><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></span>
<span id="cb1-3"><a href="#cb1-3"></a><span class="ot">{-# LANGUAGE TemplateHaskell #-}</span></span>
<span id="cb1-4"><a href="#cb1-4"></a></span>
<span id="cb1-5"><a href="#cb1-5"></a><span class="kw">module</span> <span class="dt">Main</span> <span class="kw">where</span></span>
<span id="cb1-6"><a href="#cb1-6"></a></span>
<span id="cb1-7"><a href="#cb1-7"></a><span class="kw">import</span>           <span class="dt">Protolude</span></span>
<span id="cb1-8"><a href="#cb1-8"></a><span class="kw">import</span>           <span class="dt">Control.Lens</span> ((^.), (.~), (%~))</span>
<span id="cb1-9"><a href="#cb1-9"></a><span class="kw">import</span>           <span class="dt">Control.Lens.TH</span> (makeLenses)</span>
<span id="cb1-10"><a href="#cb1-10"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.List</span> <span class="kw">as</span> <span class="dt">Lst</span></span>
<span id="cb1-11"><a href="#cb1-11"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Time</span> <span class="kw">as</span> <span class="dt">Tm</span></span>
<span id="cb1-12"><a href="#cb1-12"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Text</span> <span class="kw">as</span> <span class="dt">Txt</span></span>
<span id="cb1-13"><a href="#cb1-13"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Vector</span> <span class="kw">as</span> <span class="dt">Vec</span></span>
<span id="cb1-14"><a href="#cb1-14"></a><span class="kw">import</span>           <span class="dt">Brick</span> ((&lt;+&gt;), (&lt;=&gt;))</span>
<span id="cb1-15"><a href="#cb1-15"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick</span> <span class="kw">as</span> <span class="dt">B</span></span>
<span id="cb1-16"><a href="#cb1-16"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.BChan</span> <span class="kw">as</span> <span class="dt">BCh</span></span>
<span id="cb1-17"><a href="#cb1-17"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.Focus</span> <span class="kw">as</span> <span class="dt">BF</span></span>
<span id="cb1-18"><a href="#cb1-18"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.AttrMap</span> <span class="kw">as</span> <span class="dt">BA</span></span>
<span id="cb1-19"><a href="#cb1-19"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.Widgets.List</span> <span class="kw">as</span> <span class="dt">BL</span></span>
<span id="cb1-20"><a href="#cb1-20"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.Widgets.Edit</span> <span class="kw">as</span> <span class="dt">BE</span></span>
<span id="cb1-21"><a href="#cb1-21"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.Widgets.Border</span> <span class="kw">as</span> <span class="dt">BB</span></span>
<span id="cb1-22"><a href="#cb1-22"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.Widgets.Border.Style</span> <span class="kw">as</span> <span class="dt">BBS</span></span>
<span id="cb1-23"><a href="#cb1-23"></a><span class="kw">import</span>           <span class="dt">Control.Concurrent</span> (threadDelay, forkIO)</span>
<span id="cb1-24"><a href="#cb1-24"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Graphics.Vty</span> <span class="kw">as</span> <span class="dt">V</span></span>
<span id="cb1-25"><a href="#cb1-25"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Graphics.Vty.Input.Events</span> <span class="kw">as</span> <span class="dt">K</span></span>
<span id="cb1-26"><a href="#cb1-26"></a></span>
<span id="cb1-27"><a href="#cb1-27"></a><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Hoogle</span> <span class="kw">as</span> <span class="dt">H</span></span></code></pre></div>
<p>Import all the modules we’ll need. I’m using <a href="https://github.com/sdiehl/protolude">protolude</a> as my custom prelude, changing to one of the others e.g. <a href="https://hackage.haskell.org/package/classy-prelude">classy</a> should be pretty simple if you prefer that.</p>
<p>I’m also using lens. The brick examples use lens so its worth getting used to. However I’m only using three of the simpler lenses, so if you don’t like lens or template haskell it should be easy enough to remove them.</p>
<div class="sourceCode" id="cb2"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb2-1"><a href="#cb2-1"></a><span class="co">-- | Events that can be sent</span></span>
<span id="cb2-2"><a href="#cb2-2"></a><span class="co">-- | Here there is just one event for updating the time</span></span>
<span id="cb2-3"><a href="#cb2-3"></a><span class="kw">newtype</span> <span class="dt">Event</span> <span class="ot">=</span> <span class="dt">EventUpdateTime</span> <span class="dt">Tm.LocalTime</span></span>
<span id="cb2-4"><a href="#cb2-4"></a></span>
<span id="cb2-5"><a href="#cb2-5"></a><span class="co">-- | Names use to identify each of the controls</span></span>
<span id="cb2-6"><a href="#cb2-6"></a><span class="kw">data</span> <span class="dt">Name</span> <span class="ot">=</span> <span class="dt">TypeSearch</span></span>
<span id="cb2-7"><a href="#cb2-7"></a>          <span class="op">|</span> <span class="dt">TextSearch</span></span>
<span id="cb2-8"><a href="#cb2-8"></a>          <span class="op">|</span> <span class="dt">ListResults</span></span>
<span id="cb2-9"><a href="#cb2-9"></a>          <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>, <span class="dt">Ord</span>)</span></code></pre></div>
<p>Next we need to define the type of custom events that our brick application can handle and a sum type defining the “name” for each control we want to use.</p>
<p>In this example there is only a single event <strong>EventUpdateTime</strong>. It is sent once a second with the current time. This gets displayed by brick in the top right corner</p>
<p>There are three controls</p>
<ol type="1">
<li>The edit box for the type to search for</li>
<li>The edit box for the substring search</li>
<li>The results listbox</li>
</ol>
<div class="sourceCode" id="cb3"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb3-1"><a href="#cb3-1"></a><span class="co">-- | Sort order</span></span>
<span id="cb3-2"><a href="#cb3-2"></a><span class="kw">data</span> <span class="dt">SortBy</span> <span class="ot">=</span> <span class="dt">SortNone</span></span>
<span id="cb3-3"><a href="#cb3-3"></a>            <span class="op">|</span> <span class="dt">SortAsc</span></span>
<span id="cb3-4"><a href="#cb3-4"></a>            <span class="op">|</span> <span class="dt">SortDec</span></span>
<span id="cb3-5"><a href="#cb3-5"></a>            <span class="kw">deriving</span> (<span class="dt">Eq</span>)</span>
<span id="cb3-6"><a href="#cb3-6"></a></span>
<span id="cb3-7"><a href="#cb3-7"></a></span>
<span id="cb3-8"><a href="#cb3-8"></a><span class="co">-- | State of the brick app. Contains the controls and any other required state</span></span>
<span id="cb3-9"><a href="#cb3-9"></a><span class="kw">data</span> <span class="dt">BrickState</span> <span class="ot">=</span> <span class="dt">BrickState</span> {<span class="ot"> _stEditType ::</span> <span class="op">!</span>(<span class="dt">BE.Editor</span> <span class="dt">Text</span> <span class="dt">Name</span>) <span class="co">-- ^ Editor for the type to search for</span></span>
<span id="cb3-10"><a href="#cb3-10"></a>     ,<span class="ot"> _stEditText ::</span> <span class="op">!</span>(<span class="dt">BE.Editor</span> <span class="dt">Text</span> <span class="dt">Name</span>)      <span class="co">-- ^ Editor for a text search in the results</span></span>
<span id="cb3-11"><a href="#cb3-11"></a>     ,<span class="ot"> _stResultsList ::</span> <span class="op">!</span>(<span class="dt">BL.List</span> <span class="dt">Name</span> <span class="dt">H.Target</span>) <span class="co">-- ^ List for the search results</span></span>
<span id="cb3-12"><a href="#cb3-12"></a>     ,<span class="ot"> _stFocus ::</span> <span class="op">!</span>(<span class="dt">BF.FocusRing</span> <span class="dt">Name</span>)           <span class="co">-- ^ Focus ring - a circular list of focusable controls</span></span>
<span id="cb3-13"><a href="#cb3-13"></a>     ,<span class="ot"> _stTime ::</span> <span class="op">!</span><span class="dt">Tm.LocalTime</span>                   <span class="co">-- ^ The current time</span></span>
<span id="cb3-14"><a href="#cb3-14"></a>     ,<span class="ot"> _stResults ::</span> [<span class="dt">H.Target</span>]                   <span class="co">-- ^ The last set of search results from hoohle</span></span>
<span id="cb3-15"><a href="#cb3-15"></a>     ,<span class="ot"> _stSortResults ::</span> <span class="dt">SortBy</span>                   <span class="co">-- ^ Current sort order for the results</span></span>
<span id="cb3-16"><a href="#cb3-16"></a>     }</span>
<span id="cb3-17"><a href="#cb3-17"></a></span>
<span id="cb3-18"><a href="#cb3-18"></a>makeLenses '<span class="dt">'BrickState</span></span></code></pre></div>
<p><strong>BrickState</strong> contains the current state of the brick application. Any event e.g. the custom update time event, or any key press event can result in the state being updated. There is a separate draw function that renders the state.</p>
<p>I.e. one part of the code deals with events, roughly <code>state -&gt; event -&gt; state</code> and another handles the drawing <code>state -&gt; GUI</code></p>
<p>Here the state contains</p>
<ol type="1">
<li>The three controls mentioned above (two edit + one listbox)</li>
<li>A focus ring. (A <a href="https://hackage.haskell.org/package/brick-0.33/docs/Brick-Focus.html">focus ring</a> is a circular list of control names that helps your code keep track of which control has the current focus).</li>
<li>The last updated current time</li>
<li>The last search result</li>
<li>The current sort order, so that it can be toggled between ascending and descending</li>
</ol>
<div class="sourceCode" id="cb4"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb4-1"><a href="#cb4-1"></a><span class="co">-- | Defines how the brick application will work / handle events</span></span>
<span id="cb4-2"><a href="#cb4-2"></a><span class="ot">app ::</span> <span class="dt">B.App</span> <span class="dt">BrickState</span> <span class="dt">Event</span> <span class="dt">Name</span></span>
<span id="cb4-3"><a href="#cb4-3"></a>app <span class="ot">=</span> <span class="dt">B.App</span> { B.appDraw <span class="ot">=</span> drawUI</span>
<span id="cb4-4"><a href="#cb4-4"></a>            , B.appChooseCursor <span class="ot">=</span> B.showFirstCursor</span>
<span id="cb4-5"><a href="#cb4-5"></a>            , B.appHandleEvent <span class="ot">=</span> handleEvent</span>
<span id="cb4-6"><a href="#cb4-6"></a>            , B.appStartEvent <span class="ot">=</span> pass</span>
<span id="cb4-7"><a href="#cb4-7"></a>            , B.appAttrMap <span class="ot">=</span> <span class="fu">const</span> theMap</span>
<span id="cb4-8"><a href="#cb4-8"></a>            }</span></code></pre></div>
<p>The <strong>App</strong> type defines how the brick app operates, but defining how events are handled (<code>appHandleEvent</code>) and how the GUI is drawn (<code>appDraw</code>)</p>
<div class="sourceCode" id="cb5"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb5-1"><a href="#cb5-1"></a><span class="ot">main ::</span> <span class="dt">IO</span> ()</span>
<span id="cb5-2"><a href="#cb5-2"></a>main <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb5-3"><a href="#cb5-3"></a>  chan <span class="ot">&lt;-</span> BCh.newBChan <span class="dv">5</span> <span class="co">-- ^ create a bounded channel for events</span></span>
<span id="cb5-4"><a href="#cb5-4"></a></span>
<span id="cb5-5"><a href="#cb5-5"></a>  <span class="co">-- Send a tick event every 1 seconds with the current time</span></span>
<span id="cb5-6"><a href="#cb5-6"></a>  <span class="co">-- Brick will send this to our event handler which can then update the stTime field</span></span>
<span id="cb5-7"><a href="#cb5-7"></a>  void <span class="op">.</span> forkIO <span class="op">$</span> forever <span class="op">$</span> <span class="kw">do</span></span>
<span id="cb5-8"><a href="#cb5-8"></a>    t <span class="ot">&lt;-</span> getTime </span>
<span id="cb5-9"><a href="#cb5-9"></a>    BCh.writeBChan chan <span class="op">$</span> <span class="dt">EventUpdateTime</span> t</span>
<span id="cb5-10"><a href="#cb5-10"></a>    threadDelay <span class="op">$</span> <span class="dv">1</span> <span class="op">*</span> <span class="dv">1000000</span></span>
<span id="cb5-11"><a href="#cb5-11"></a></span>
<span id="cb5-12"><a href="#cb5-12"></a>  <span class="co">-- Initial current time value</span></span>
<span id="cb5-13"><a href="#cb5-13"></a>  t <span class="ot">&lt;-</span> getTime</span>
<span id="cb5-14"><a href="#cb5-14"></a></span>
<span id="cb5-15"><a href="#cb5-15"></a>  <span class="co">-- Construct the initial state values</span></span>
<span id="cb5-16"><a href="#cb5-16"></a>  <span class="kw">let</span> st <span class="ot">=</span> <span class="dt">BrickState</span> { _stEditType <span class="ot">=</span> BE.editor <span class="dt">TypeSearch</span> (<span class="dt">Just</span> <span class="dv">1</span>) <span class="st">&quot;&quot;</span></span>
<span id="cb5-17"><a href="#cb5-17"></a>                      , _stEditText <span class="ot">=</span> BE.editor <span class="dt">TextSearch</span> (<span class="dt">Just</span> <span class="dv">1</span>) <span class="st">&quot;&quot;</span></span>
<span id="cb5-18"><a href="#cb5-18"></a>                      , _stResultsList <span class="ot">=</span> BL.list <span class="dt">ListResults</span> Vec.empty <span class="dv">1</span></span>
<span id="cb5-19"><a href="#cb5-19"></a>                      , _stTime <span class="ot">=</span> t</span>
<span id="cb5-20"><a href="#cb5-20"></a>                      , _stFocus <span class="ot">=</span> BF.focusRing [<span class="dt">TypeSearch</span>, <span class="dt">TextSearch</span>, <span class="dt">ListResults</span>]</span>
<span id="cb5-21"><a href="#cb5-21"></a>                      , _stResults <span class="ot">=</span> []</span>
<span id="cb5-22"><a href="#cb5-22"></a>                      , _stSortResults <span class="ot">=</span> <span class="dt">SortNone</span></span>
<span id="cb5-23"><a href="#cb5-23"></a>                      }</span>
<span id="cb5-24"><a href="#cb5-24"></a>          </span>
<span id="cb5-25"><a href="#cb5-25"></a>  <span class="co">-- And run brick</span></span>
<span id="cb5-26"><a href="#cb5-26"></a>  <span class="kw">let</span> vtyBuilder <span class="ot">=</span> V.mkVty V.defaultConfig</span>
<span id="cb5-27"><a href="#cb5-27"></a>  initialVty <span class="ot">&lt;-</span> vtyBuilder</span>
<span id="cb5-28"><a href="#cb5-28"></a></span>
<span id="cb5-29"><a href="#cb5-29"></a>  void <span class="op">$</span> B.customMain initialVty vtyBuilder (<span class="dt">Just</span> chan) app st</span>
<span id="cb5-30"><a href="#cb5-30"></a></span>
<span id="cb5-31"><a href="#cb5-31"></a>  <span class="kw">where</span></span>
<span id="cb5-32"><a href="#cb5-32"></a>    <span class="co">-- | Get the local time</span></span>
<span id="cb5-33"><a href="#cb5-33"></a>    getTime <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb5-34"><a href="#cb5-34"></a>      t <span class="ot">&lt;-</span> Tm.getCurrentTime</span>
<span id="cb5-35"><a href="#cb5-35"></a>      tz <span class="ot">&lt;-</span> Tm.getCurrentTimeZone</span>
<span id="cb5-36"><a href="#cb5-36"></a>      <span class="fu">pure</span> <span class="op">$</span> Tm.utcToLocalTime tz t</span></code></pre></div>
<p>In <strong>main</strong> some setup is preformed and then brick is started by calling <code>customMain</code>.</p>
<p>For bhoogle the steps are</p>
<ol type="1">
<li>Construct the channel for brick events (passed to <code>customMain</code>)</li>
<li>Create a new thread to send the current time every second</li>
<li>Construct an initial state, with empty controls and search results</li>
<li><code>B.customMain</code> to run brick</li>
</ol>
<div class="sourceCode" id="cb6"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb6-1"><a href="#cb6-1"></a><span class="co">-- | Main even handler for brick events</span></span>
<span id="cb6-2"><a href="#cb6-2"></a><span class="ot">handleEvent ::</span> <span class="dt">B.BrickEvent</span> <span class="dt">Name</span> <span class="dt">Event</span> <span class="ot">-&gt;</span> <span class="dt">B.EventM</span> <span class="dt">Name</span> <span class="dt">BrickState</span> ()</span>
<span id="cb6-3"><a href="#cb6-3"></a>handleEvent ev <span class="ot">=</span></span>
<span id="cb6-4"><a href="#cb6-4"></a>  <span class="kw">case</span> ev <span class="kw">of</span></span>
<span id="cb6-5"><a href="#cb6-5"></a>    (<span class="dt">B.AppEvent</span> (<span class="dt">EventUpdateTime</span> time)) <span class="ot">-&gt;</span></span>
<span id="cb6-6"><a href="#cb6-6"></a>      <span class="co">-- Update the time in the state</span></span>
<span id="cb6-7"><a href="#cb6-7"></a>      modify <span class="op">$</span> \st <span class="ot">-&gt;</span> st <span class="op">&amp;</span> stTime <span class="op">.~</span> time</span></code></pre></div>
<p><strong>handleEvent</strong> gets all the brick events, updates the state and decides how to continue.</p>
<p>Here the code matches the custom (<strong>B.AppEvent</strong>) event looking for our update time event (<strong>EventUpdateTime</strong>) and then updates the state with the current time. Note that the UI is not changed in any way here, we are just altering the current state.</p>
<div class="sourceCode" id="cb7"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb7-1"><a href="#cb7-1"></a>    <span class="co">-- Handle keyboard events</span></span>
<span id="cb7-2"><a href="#cb7-2"></a>    <span class="co">--   k is the key</span></span>
<span id="cb7-3"><a href="#cb7-3"></a>    <span class="co">--   ms are the modifier keys</span></span>
<span id="cb7-4"><a href="#cb7-4"></a>    (<span class="dt">B.VtyEvent</span> ve<span class="op">@</span>(<span class="dt">V.EvKey</span> k ms)) <span class="ot">-&gt;</span></span>
<span id="cb7-5"><a href="#cb7-5"></a>      <span class="kw">case</span> (k, ms) <span class="kw">of</span></span>
<span id="cb7-6"><a href="#cb7-6"></a>        <span class="co">-- Escape quits the app, no matter what control has focus</span></span>
<span id="cb7-7"><a href="#cb7-7"></a>        (<span class="dt">K.KEsc</span>, []) <span class="ot">-&gt;</span> B.halt</span>
<span id="cb7-8"><a href="#cb7-8"></a></span>
<span id="cb7-9"><a href="#cb7-9"></a></span>
<span id="cb7-10"><a href="#cb7-10"></a><span class="dt">Then</span> the code matches <span class="fu">any</span> keyboard event (<span class="op">**</span><span class="dt">B.VtyEvent</span><span class="op">**</span>) here matching on the escape key (<span class="op">**</span><span class="dt">K.KEsc</span><span class="op">**</span>)<span class="op">.</span> <span class="dt">So</span> when the user clicks the escape key this handler will call <span class="ot">```B.halt```</span> which will terminate the app<span class="op">.</span> <span class="dt">As</span> this is done at the top level, this means that no matter which control has the focus, escape will exit<span class="op">.</span></span>
<span id="cb7-11"><a href="#cb7-11"></a></span>
<span id="cb7-12"><a href="#cb7-12"></a></span>
<span id="cb7-13"><a href="#cb7-13"></a><span class="ot">```haskell</span></span>
<span id="cb7-14"><a href="#cb7-14"></a><span class="ot">        _ -&gt; do</span></span>
<span id="cb7-15"><a href="#cb7-15"></a><span class="ot">          st' &lt;- get</span></span>
<span id="cb7-16"><a href="#cb7-16"></a></span>
<span id="cb7-17"><a href="#cb7-17"></a><span class="ot">          -- How to interpret the key press depends on which control is focused</span></span>
<span id="cb7-18"><a href="#cb7-18"></a><span class="ot">          case BF.focusGetCurrent $ st' ^. stFocus of</span></span></code></pre></div>
<p>For the rest of the key press logic, what bhoogle does depends on which control has the focus. <code>BF.focusGetCurrent</code> is used to get that from the state’s focus ring.</p>
<div class="sourceCode" id="cb8"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb8-1"><a href="#cb8-1"></a>            <span class="dt">Just</span> <span class="dt">TypeSearch</span> <span class="ot">-&gt;</span></span>
<span id="cb8-2"><a href="#cb8-2"></a>              <span class="kw">case</span> k <span class="kw">of</span></span>
<span id="cb8-3"><a href="#cb8-3"></a>                <span class="dt">K.KChar</span> <span class="ch">'\t'</span> <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb8-4"><a href="#cb8-4"></a>                  <span class="co">-- Search, clear sort order, focus next</span></span>
<span id="cb8-5"><a href="#cb8-5"></a>                  found <span class="ot">&lt;-</span> liftIO <span class="op">$</span> doSearch st'</span>
<span id="cb8-6"><a href="#cb8-6"></a>                  modify <span class="op">$</span> \st <span class="ot">-&gt;</span> filterResults <span class="op">$</span> st <span class="op">&amp;</span> stFocus <span class="op">%~</span> BF.focusNext</span>
<span id="cb8-7"><a href="#cb8-7"></a>                                                  <span class="op">&amp;</span> stResults <span class="op">.~</span> found</span>
<span id="cb8-8"><a href="#cb8-8"></a>                                                  <span class="op">&amp;</span> stSortResults <span class="op">.~</span> <span class="dt">SortNone</span></span>
<span id="cb8-9"><a href="#cb8-9"></a></span>
<span id="cb8-10"><a href="#cb8-10"></a>                <span class="dt">K.KBackTab</span> <span class="ot">-&gt;</span><span class="kw">do</span></span>
<span id="cb8-11"><a href="#cb8-11"></a>                  <span class="co">-- Search, clear sort order, focus prev</span></span>
<span id="cb8-12"><a href="#cb8-12"></a>                  found <span class="ot">&lt;-</span> liftIO <span class="op">$</span> doSearch st'</span>
<span id="cb8-13"><a href="#cb8-13"></a>                  modify <span class="op">$</span> \st <span class="ot">-&gt;</span> filterResults <span class="op">$</span> st <span class="op">&amp;</span> stFocus <span class="op">%~</span> BF.focusPrev</span>
<span id="cb8-14"><a href="#cb8-14"></a>                                                   <span class="op">&amp;</span> stResults <span class="op">.~</span> found</span>
<span id="cb8-15"><a href="#cb8-15"></a>                                                   <span class="op">&amp;</span> stSortResults <span class="op">.~</span> <span class="dt">SortNone</span></span></code></pre></div>
<p>If the user is typing in the “type” edit box and tabs out (either tab or shift-tab) then</p>
<ol type="1">
<li>Perform the search (see <strong>doSearch</strong> below)</li>
<li>Update the current set of results</li>
<li>Reset the sort order, default to the order that hoogle uses</li>
<li>Move the focus to the next/previous control</li>
</ol>
<div class="sourceCode" id="cb9"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb9-1"><a href="#cb9-1"></a>                <span class="dt">K.KEnter</span> <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb9-2"><a href="#cb9-2"></a>                  <span class="co">-- Search, clear sort order, focus on results</span></span>
<span id="cb9-3"><a href="#cb9-3"></a>                  <span class="co">--  This makes it faster if you want to search and navigate results without tabing through the text search box</span></span>
<span id="cb9-4"><a href="#cb9-4"></a>                  found <span class="ot">&lt;-</span> liftIO <span class="op">$</span> doSearch st'</span>
<span id="cb9-5"><a href="#cb9-5"></a>                  modify <span class="op">$</span> \st <span class="ot">-&gt;</span> filterResults <span class="op">$</span> st <span class="op">&amp;</span> stResults <span class="op">.~</span> found</span>
<span id="cb9-6"><a href="#cb9-6"></a>                                                  <span class="op">&amp;</span> stSortResults <span class="op">.~</span> <span class="dt">SortNone</span></span>
<span id="cb9-7"><a href="#cb9-7"></a>                                                  <span class="op">&amp;</span> stFocus <span class="op">%~</span> BF.focusSetCurrent <span class="dt">ListResults</span></span></code></pre></div>
<p>If the user presses <strong>enter</strong> while in the type search edit box, then</p>
<ol type="1">
<li>Perform the search (see <strong>doSearch</strong> below)</li>
<li>Update the current set of results</li>
<li>Reset the sort order, default to the order that hoogle uses</li>
<li>Move the focus directly to the results lisbox so they can navigate and see the current item’s details &amp; help text</li>
</ol>
<div class="sourceCode" id="cb10"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb10-1"><a href="#cb10-1"></a>                _ <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb10-2"><a href="#cb10-2"></a>                  <span class="co">-- Let the editor handle all other events</span></span>
<span id="cb10-3"><a href="#cb10-3"></a>                  B.zoom stEditType <span class="op">$</span> BE.handleEditorEvent ev</span>
<span id="cb10-4"><a href="#cb10-4"></a>                  st <span class="ot">&lt;-</span> get</span>
<span id="cb10-5"><a href="#cb10-5"></a>                  st2 <span class="ot">&lt;-</span> liftIO <span class="op">$</span> searchAhead doSearch st</span>
<span id="cb10-6"><a href="#cb10-6"></a>                  put st2</span>
<span id="cb10-7"><a href="#cb10-7"></a></span>
<span id="cb10-8"><a href="#cb10-8"></a><span class="dt">For</span> <span class="fu">all</span> other key events for the <span class="kw">type</span> search, <span class="kw">let</span> the editor control handle the key press<span class="op">.</span> <span class="dt">This</span> gives us editing, navigation etc for free<span class="op">.</span></span>
<span id="cb10-9"><a href="#cb10-9"></a></span>
<span id="cb10-10"><a href="#cb10-10"></a></span>
<span id="cb10-11"><a href="#cb10-11"></a><span class="ot">```haskell</span></span>
<span id="cb10-12"><a href="#cb10-12"></a><span class="ot">            Just TextSearch -&gt;</span></span>
<span id="cb10-13"><a href="#cb10-13"></a><span class="ot">              case k of</span></span>
<span id="cb10-14"><a href="#cb10-14"></a><span class="ot">                K.KChar '\t' -&gt; modify $ \st -&gt; st &amp; stFocus %~ BF.focusNext -- Focus next</span></span>
<span id="cb10-15"><a href="#cb10-15"></a><span class="ot">                K.KBackTab -&gt; modify $ \st -&gt; st &amp; stFocus %~ BF.focusPrev   -- Focus previous</span></span>
<span id="cb10-16"><a href="#cb10-16"></a><span class="ot">                _ -&gt; do</span></span>
<span id="cb10-17"><a href="#cb10-17"></a><span class="ot">                  -- Let the editor handle all other events</span></span>
<span id="cb10-18"><a href="#cb10-18"></a><span class="ot">                  B.zoom stEditText $ BE.handleEditorEvent ev</span></span>
<span id="cb10-19"><a href="#cb10-19"></a><span class="ot">                  modify filterResults</span></span>
<span id="cb10-20"><a href="#cb10-20"></a></span>
<span id="cb10-21"><a href="#cb10-21"></a><span class="ot">For the text edit box</span></span>
<span id="cb10-22"><a href="#cb10-22"></a></span>
<span id="cb10-23"><a href="#cb10-23"></a><span class="ot"> 1. Change focus on tab / shift-tab</span></span>
<span id="cb10-24"><a href="#cb10-24"></a><span class="ot"> 1. For all other keys</span></span>
<span id="cb10-25"><a href="#cb10-25"></a><span class="ot">    1. Let the editor handle the key press</span></span>
<span id="cb10-26"><a href="#cb10-26"></a><span class="ot">    1. Filter the hoogle results</span></span>
<span id="cb10-27"><a href="#cb10-27"></a></span>
<span id="cb10-28"><a href="#cb10-28"></a></span>
<span id="cb10-29"><a href="#cb10-29"></a><span class="ot">```</span>haskell</span>
<span id="cb10-30"><a href="#cb10-30"></a>            <span class="dt">Just</span> <span class="dt">ListResults</span> <span class="ot">-&gt;</span></span>
<span id="cb10-31"><a href="#cb10-31"></a>              <span class="kw">case</span> k <span class="kw">of</span></span>
<span id="cb10-32"><a href="#cb10-32"></a>                <span class="dt">K.KChar</span> <span class="ch">'\t'</span> <span class="ot">-&gt;</span> modify <span class="op">$</span> \st <span class="ot">-&gt;</span> st <span class="op">&amp;</span> stFocus <span class="op">%~</span> BF.focusNext <span class="co">-- Focus next</span></span>
<span id="cb10-33"><a href="#cb10-33"></a>                <span class="dt">K.KBackTab</span> <span class="ot">-&gt;</span> modify <span class="op">$</span> \st <span class="ot">-&gt;</span> st <span class="op">&amp;</span> stFocus <span class="op">%~</span> BF.focusPrev   <span class="co">-- Focus previous</span></span>
<span id="cb10-34"><a href="#cb10-34"></a>                <span class="dt">K.KChar</span> <span class="ch">'s'</span> <span class="ot">-&gt;</span></span>
<span id="cb10-35"><a href="#cb10-35"></a>                  <span class="co">-- Toggle the search order between ascending and descending, use asc if sort order was 'none'</span></span>
<span id="cb10-36"><a href="#cb10-36"></a>                  <span class="kw">let</span> sortDir <span class="ot">=</span> <span class="kw">if</span> (st' <span class="op">^.</span> stSortResults) <span class="op">==</span> <span class="dt">SortAsc</span> <span class="kw">then</span> <span class="dt">SortDec</span> <span class="kw">else</span> <span class="dt">SortAsc</span> <span class="kw">in</span></span>
<span id="cb10-37"><a href="#cb10-37"></a>                  <span class="kw">let</span> sorter <span class="ot">=</span> <span class="kw">if</span> sortDir <span class="op">==</span> <span class="dt">SortDec</span> <span class="kw">then</span> Lst.sortBy (<span class="fu">flip</span> compareType) <span class="kw">else</span> Lst.sortBy compareType <span class="kw">in</span></span>
<span id="cb10-38"><a href="#cb10-38"></a>                  modify <span class="op">$</span> \st <span class="ot">-&gt;</span> filterResults <span class="op">$</span> st <span class="op">&amp;</span> stResults <span class="op">%~</span> sorter</span>
<span id="cb10-39"><a href="#cb10-39"></a>                                                  <span class="op">&amp;</span> stSortResults <span class="op">.~</span> sortDir</span>
<span id="cb10-40"><a href="#cb10-40"></a></span>
<span id="cb10-41"><a href="#cb10-41"></a>                _ <span class="ot">-&gt;</span> <span class="kw">do</span></span>
<span id="cb10-42"><a href="#cb10-42"></a>                  <span class="co">-- Let the list handle all other events</span></span>
<span id="cb10-43"><a href="#cb10-43"></a>                  <span class="co">-- Using handleListEventVi which adds vi-style keybindings for navigation</span></span>
<span id="cb10-44"><a href="#cb10-44"></a>                  <span class="co">--  and the standard handleListEvent as a fallback for all other events</span></span>
<span id="cb10-45"><a href="#cb10-45"></a>                  B.zoom stResultsList <span class="op">$</span> BL.handleListEventVi BL.handleListEvent ve</span>
<span id="cb10-46"><a href="#cb10-46"></a></span>
<span id="cb10-47"><a href="#cb10-47"></a>            _ <span class="ot">-&gt;</span> pass</span>
<span id="cb10-48"><a href="#cb10-48"></a></span>
<span id="cb10-49"><a href="#cb10-49"></a>    _ <span class="ot">-&gt;</span> pass</span>
<span id="cb10-50"><a href="#cb10-50"></a></span>
<span id="cb10-51"><a href="#cb10-51"></a> <span class="op">-</span> <span class="dt">Handle</span> tab <span class="op">/</span> shift<span class="op">-</span>tab</span>
<span id="cb10-52"><a href="#cb10-52"></a> <span class="op">-</span> <span class="dt">Pressing</span> the <span class="op">**</span><span class="ch">'s'</span><span class="op">**</span> key will <span class="fu">sort</span> the results<span class="op">.</span> <span class="dt">Pressing</span> it again toggles the direction, so keep track <span class="kw">of</span> which order was used <span class="fu">last</span><span class="op">.</span></span>
<span id="cb10-53"><a href="#cb10-53"></a> <span class="op">-</span> <span class="dt">For</span> <span class="fu">all</span> other keys use <span class="ot">```BL.handleListEventVi BL.handleListEvent```</span> which gives us vi style navigation <span class="fu">and</span> uses the standard <span class="op">**</span>handleListEvent<span class="op">**</span> as the fallback, so that <span class="fu">all</span> the normal navigation (arrows) also work<span class="op">.</span></span>
<span id="cb10-54"><a href="#cb10-54"></a></span>
<span id="cb10-55"><a href="#cb10-55"></a></span>
<span id="cb10-56"><a href="#cb10-56"></a><span class="ot">```haskell</span></span>
<span id="cb10-57"><a href="#cb10-57"></a><span class="ot">  where</span></span>
<span id="cb10-58"><a href="#cb10-58"></a><span class="ot">    doSearch :: BrickState -&gt; IO [H.Target]</span></span>
<span id="cb10-59"><a href="#cb10-59"></a><span class="ot">    doSearch st' = </span></span>
<span id="cb10-60"><a href="#cb10-60"></a><span class="ot">      liftIO $ searchHoogle (Txt.strip . Txt.concat $ BE.getEditContents (st' ^. stEditType))</span></span></code></pre></div>
<p>And finally for <strong>handleEvent</strong> the <strong>doSearch</strong> function which calls the <strong>searchHoogle</strong> function (below) to search on the text from the type editbox.</p>
<div class="sourceCode" id="cb11"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb11-1"><a href="#cb11-1"></a><span class="co">-- | Search ahead for type strings longer than 3 chars.</span></span>
<span id="cb11-2"><a href="#cb11-2"></a><span class="ot">searchAhead ::</span> (<span class="dt">BrickState</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> [<span class="dt">H.Target</span>]) <span class="ot">-&gt;</span> <span class="dt">BrickState</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">BrickState</span></span>
<span id="cb11-3"><a href="#cb11-3"></a>searchAhead search st <span class="ot">=</span></span>
<span id="cb11-4"><a href="#cb11-4"></a>  <span class="kw">let</span> searchText <span class="ot">=</span> Txt.strip <span class="op">.</span> Txt.concat <span class="op">.</span> BE.getEditContents <span class="op">$</span> st <span class="op">^.</span> stEditType <span class="kw">in</span></span>
<span id="cb11-5"><a href="#cb11-5"></a></span>
<span id="cb11-6"><a href="#cb11-6"></a>  <span class="kw">if</span> Txt.length searchText <span class="op">&gt;</span> <span class="dv">3</span></span>
<span id="cb11-7"><a href="#cb11-7"></a>  <span class="kw">then</span> <span class="kw">do</span></span>
<span id="cb11-8"><a href="#cb11-8"></a>    <span class="co">-- Search</span></span>
<span id="cb11-9"><a href="#cb11-9"></a>    found <span class="ot">&lt;-</span> search st</span>
<span id="cb11-10"><a href="#cb11-10"></a>    <span class="fu">pure</span> <span class="op">.</span> filterResults <span class="op">$</span> st <span class="op">&amp;</span> stResults <span class="op">.~</span> found</span>
<span id="cb11-11"><a href="#cb11-11"></a>                              <span class="op">&amp;</span> stSortResults <span class="op">.~</span> <span class="dt">SortNone</span></span>
<span id="cb11-12"><a href="#cb11-12"></a>  <span class="kw">else</span></span>
<span id="cb11-13"><a href="#cb11-13"></a>    <span class="co">-- Just clear</span></span>
<span id="cb11-14"><a href="#cb11-14"></a>    <span class="fu">pure</span> <span class="op">$</span> st <span class="op">&amp;</span> stResults <span class="op">.~</span> []</span>
<span id="cb11-15"><a href="#cb11-15"></a>              <span class="op">&amp;</span> stResultsList <span class="op">%~</span> BL.listClear</span></code></pre></div>
<p><strong>searchAhead</strong> is a helper function that searches hoogle as the user types. As long as there are more than three characters being searched for. Without this limit hoogle seems a bit slow on my machine because of the large number of results.</p>
<div class="sourceCode" id="cb12"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb12-1"><a href="#cb12-1"></a><span class="co">-- | Filter the results from hoogle using the search text</span></span>
<span id="cb12-2"><a href="#cb12-2"></a><span class="ot">filterResults ::</span> <span class="dt">BrickState</span> <span class="ot">-&gt;</span> <span class="dt">BrickState</span></span>
<span id="cb12-3"><a href="#cb12-3"></a>filterResults st <span class="ot">=</span></span>
<span id="cb12-4"><a href="#cb12-4"></a>  <span class="kw">let</span> allResults <span class="ot">=</span> st <span class="op">^.</span> stResults <span class="kw">in</span></span>
<span id="cb12-5"><a href="#cb12-5"></a>  <span class="kw">let</span> filterText <span class="ot">=</span> Txt.toLower <span class="op">.</span> Txt.strip <span class="op">.</span> Txt.concat <span class="op">.</span> BE.getEditContents <span class="op">$</span> st <span class="op">^.</span> stEditText <span class="kw">in</span></span>
<span id="cb12-6"><a href="#cb12-6"></a></span>
<span id="cb12-7"><a href="#cb12-7"></a>  <span class="kw">let</span> results <span class="ot">=</span></span>
<span id="cb12-8"><a href="#cb12-8"></a>        <span class="kw">if</span> Txt.null filterText</span>
<span id="cb12-9"><a href="#cb12-9"></a>        <span class="kw">then</span> allResults</span>
<span id="cb12-10"><a href="#cb12-10"></a>        <span class="kw">else</span> <span class="fu">filter</span> (\t <span class="ot">-&gt;</span> Txt.isInfixOf filterText <span class="op">.</span> Txt.toLower <span class="op">$</span> formatResult t) allResults</span>
<span id="cb12-11"><a href="#cb12-11"></a>  <span class="kw">in</span></span>
<span id="cb12-12"><a href="#cb12-12"></a>  st <span class="op">&amp;</span> stResultsList <span class="op">.~</span> BL.list <span class="dt">ListResults</span> (Vec.fromList results) <span class="dv">1</span></span></code></pre></div>
<p>Filter the hoogle results by doing a sub-string search if the user has entered one</p>
<div class="sourceCode" id="cb13"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb13-1"><a href="#cb13-1"></a><span class="co">-- | Draw the UI</span></span>
<span id="cb13-2"><a href="#cb13-2"></a><span class="ot">drawUI ::</span> <span class="dt">BrickState</span> <span class="ot">-&gt;</span> [<span class="dt">B.Widget</span> <span class="dt">Name</span>]</span>
<span id="cb13-3"><a href="#cb13-3"></a>drawUI st <span class="ot">=</span></span>
<span id="cb13-4"><a href="#cb13-4"></a>  [B.padAll <span class="dv">1</span> contentBlock] </span>
<span id="cb13-5"><a href="#cb13-5"></a></span>
<span id="cb13-6"><a href="#cb13-6"></a>  <span class="kw">where</span></span>
<span id="cb13-7"><a href="#cb13-7"></a>    contentBlock <span class="ot">=</span></span>
<span id="cb13-8"><a href="#cb13-8"></a>      (B.withBorderStyle BBS.unicode <span class="op">$</span> BB.border searchBlock)</span>
<span id="cb13-9"><a href="#cb13-9"></a>      <span class="op">&lt;=&gt;</span></span>
<span id="cb13-10"><a href="#cb13-10"></a>      B.padTop (<span class="dt">B.Pad</span> <span class="dv">1</span>) resultsBlock</span>
<span id="cb13-11"><a href="#cb13-11"></a>      </span>
<span id="cb13-12"><a href="#cb13-12"></a>    resultsBlock <span class="ot">=</span></span>
<span id="cb13-13"><a href="#cb13-13"></a>      <span class="kw">let</span> total <span class="ot">=</span> <span class="fu">show</span> <span class="op">.</span> <span class="fu">length</span> <span class="op">$</span> st <span class="op">^.</span> stResults <span class="kw">in</span></span>
<span id="cb13-14"><a href="#cb13-14"></a>      <span class="kw">let</span> showing <span class="ot">=</span> <span class="fu">show</span> <span class="op">.</span> <span class="fu">length</span> <span class="op">$</span> st <span class="op">^.</span> stResultsList <span class="op">^.</span> BL.listElementsL <span class="kw">in</span></span>
<span id="cb13-15"><a href="#cb13-15"></a>      (B.withAttr (B.attrName <span class="st">&quot;infoTitle&quot;</span>) <span class="op">$</span> B.txt <span class="st">&quot;Results: &quot;</span>) <span class="op">&lt;+&gt;</span> B.txt (showing <span class="op">&lt;&gt;</span> <span class="st">&quot;/&quot;</span> <span class="op">&lt;&gt;</span> total)</span>
<span id="cb13-16"><a href="#cb13-16"></a>      <span class="op">&lt;=&gt;</span></span>
<span id="cb13-17"><a href="#cb13-17"></a>      (B.padTop (<span class="dt">B.Pad</span> <span class="dv">1</span>) <span class="op">$</span></span>
<span id="cb13-18"><a href="#cb13-18"></a>       resultsContent <span class="op">&lt;+&gt;</span> resultsDetail</span>
<span id="cb13-19"><a href="#cb13-19"></a>      )</span>
<span id="cb13-20"><a href="#cb13-20"></a></span>
<span id="cb13-21"><a href="#cb13-21"></a>    resultsContent <span class="ot">=</span></span>
<span id="cb13-22"><a href="#cb13-22"></a>      BL.renderList (\_ e <span class="ot">-&gt;</span> B.txt <span class="op">$</span> formatResult e) <span class="dt">False</span> (st <span class="op">^.</span> stResultsList)</span>
<span id="cb13-23"><a href="#cb13-23"></a></span>
<span id="cb13-24"><a href="#cb13-24"></a>    resultsDetail <span class="ot">=</span></span>
<span id="cb13-25"><a href="#cb13-25"></a>      B.padLeft (<span class="dt">B.Pad</span> <span class="dv">1</span>) <span class="op">$</span></span>
<span id="cb13-26"><a href="#cb13-26"></a>      B.hLimit <span class="dv">60</span> <span class="op">$</span></span>
<span id="cb13-27"><a href="#cb13-27"></a>      vtitle <span class="st">&quot;package:&quot;</span></span>
<span id="cb13-28"><a href="#cb13-28"></a>      <span class="op">&lt;=&gt;</span></span>
<span id="cb13-29"><a href="#cb13-29"></a>      B.padLeft (<span class="dt">B.Pad</span> <span class="dv">2</span>) (B.txt <span class="op">$</span> getSelectedDetail (\t <span class="ot">-&gt;</span> <span class="fu">maybe</span> <span class="st">&quot;&quot;</span> (Txt.pack <span class="op">.</span> <span class="fu">fst</span>) (H.targetPackage t)))</span>
<span id="cb13-30"><a href="#cb13-30"></a>      <span class="op">&lt;=&gt;</span></span>
<span id="cb13-31"><a href="#cb13-31"></a>      vtitle <span class="st">&quot;module:&quot;</span></span>
<span id="cb13-32"><a href="#cb13-32"></a>      <span class="op">&lt;=&gt;</span></span>
<span id="cb13-33"><a href="#cb13-33"></a>      B.padLeft (<span class="dt">B.Pad</span> <span class="dv">2</span>) (B.txt <span class="op">$</span> getSelectedDetail (\t <span class="ot">-&gt;</span> <span class="fu">maybe</span> <span class="st">&quot;&quot;</span> (Txt.pack <span class="op">.</span> <span class="fu">fst</span>) (H.targetModule t)))</span>
<span id="cb13-34"><a href="#cb13-34"></a>      <span class="op">&lt;=&gt;</span></span>
<span id="cb13-35"><a href="#cb13-35"></a>      vtitle <span class="st">&quot;docs:&quot;</span></span>
<span id="cb13-36"><a href="#cb13-36"></a>      <span class="op">&lt;=&gt;</span></span>
<span id="cb13-37"><a href="#cb13-37"></a>      B.padLeft (<span class="dt">B.Pad</span> <span class="dv">2</span>) (B.txt <span class="op">$</span> getSelectedDetail (Txt.pack <span class="op">.</span> clean <span class="op">.</span> H.targetDocs))</span>
<span id="cb13-38"><a href="#cb13-38"></a>      <span class="op">&lt;=&gt;</span></span>
<span id="cb13-39"><a href="#cb13-39"></a>      B.fill <span class="ch">' '</span></span>
<span id="cb13-40"><a href="#cb13-40"></a>  </span>
<span id="cb13-41"><a href="#cb13-41"></a>    searchBlock <span class="ot">=</span></span>
<span id="cb13-42"><a href="#cb13-42"></a>      ((htitle <span class="st">&quot;Type: &quot;</span> <span class="op">&lt;+&gt;</span> editor <span class="dt">TypeSearch</span> (st <span class="op">^.</span> stEditType)) <span class="op">&lt;+&gt;</span> time (st <span class="op">^.</span> stTime))</span>
<span id="cb13-43"><a href="#cb13-43"></a>      <span class="op">&lt;=&gt;</span></span>
<span id="cb13-44"><a href="#cb13-44"></a>      (htitle <span class="st">&quot;Text: &quot;</span> <span class="op">&lt;+&gt;</span> editor <span class="dt">TextSearch</span> (st <span class="op">^.</span> stEditText))</span>
<span id="cb13-45"><a href="#cb13-45"></a></span>
<span id="cb13-46"><a href="#cb13-46"></a>    htitle t <span class="ot">=</span></span>
<span id="cb13-47"><a href="#cb13-47"></a>      B.hLimit <span class="dv">20</span> <span class="op">$</span></span>
<span id="cb13-48"><a href="#cb13-48"></a>      B.withAttr (B.attrName <span class="st">&quot;infoTitle&quot;</span>) <span class="op">$</span></span>
<span id="cb13-49"><a href="#cb13-49"></a>      B.txt t</span>
<span id="cb13-50"><a href="#cb13-50"></a>      </span>
<span id="cb13-51"><a href="#cb13-51"></a>    vtitle t <span class="ot">=</span></span>
<span id="cb13-52"><a href="#cb13-52"></a>      B.withAttr (B.attrName <span class="st">&quot;infoTitle&quot;</span>) <span class="op">$</span></span>
<span id="cb13-53"><a href="#cb13-53"></a>      B.txt t</span>
<span id="cb13-54"><a href="#cb13-54"></a></span>
<span id="cb13-55"><a href="#cb13-55"></a>    editor n e <span class="ot">=</span></span>
<span id="cb13-56"><a href="#cb13-56"></a>      B.vLimit <span class="dv">1</span> <span class="op">$</span></span>
<span id="cb13-57"><a href="#cb13-57"></a>      BE.renderEditor (B.txt <span class="op">.</span> Txt.unlines) (BF.focusGetCurrent (st <span class="op">^.</span> stFocus) <span class="op">==</span> <span class="dt">Just</span> n) e</span>
<span id="cb13-58"><a href="#cb13-58"></a></span>
<span id="cb13-59"><a href="#cb13-59"></a>    time t <span class="ot">=</span></span>
<span id="cb13-60"><a href="#cb13-60"></a>      B.padLeft (<span class="dt">B.Pad</span> <span class="dv">1</span>) <span class="op">$</span></span>
<span id="cb13-61"><a href="#cb13-61"></a>      B.hLimit <span class="dv">20</span> <span class="op">$</span></span>
<span id="cb13-62"><a href="#cb13-62"></a>      B.withAttr (B.attrName <span class="st">&quot;time&quot;</span>) <span class="op">$</span></span>
<span id="cb13-63"><a href="#cb13-63"></a>      B.str (Tm.formatTime Tm.defaultTimeLocale <span class="st">&quot;%H-%M-%S&quot;</span> t)</span>
<span id="cb13-64"><a href="#cb13-64"></a></span>
<span id="cb13-65"><a href="#cb13-65"></a>    getSelectedDetail fn <span class="ot">=</span></span>
<span id="cb13-66"><a href="#cb13-66"></a>      <span class="kw">case</span> BL.listSelectedElement <span class="op">$</span> st <span class="op">^.</span> stResultsList <span class="kw">of</span></span>
<span id="cb13-67"><a href="#cb13-67"></a>        <span class="dt">Nothing</span> <span class="ot">-&gt;</span> <span class="st">&quot;&quot;</span></span>
<span id="cb13-68"><a href="#cb13-68"></a>        <span class="dt">Just</span> (_, e) <span class="ot">-&gt;</span> fn e</span></code></pre></div>
<p><strong>drawUI</strong> renders the state and creates the GUI. At first this may take some getting used to, but you will soon be able to see the GUI structure from the code.</p>
<ul>
<li><p><code>&lt;=&gt;</code> means horizontal break, i.e. next “line”</p></li>
<li><p><code>&lt;+&gt;</code> means “next to”</p></li>
<li><p>I often end up formatting code slightly differently to how I would in the other functions to better communicate the structure</p></li>
<li><p>Create small GUI fragments/“controls” and combine them with <code>&lt;+&gt;</code> and <code>&lt;=&gt;</code></p>
<p>For example <strong>htitle</strong> creates a “title” by</p>
<ul>
<li>Limiting the max width to 20</li>
<li>Setting the attribute to <strong>infoTitle</strong></li>
<li>Displaying the text using <code>B.txt</code> (<code>B.txt</code> displays a Text, <code>B.str</code> displays a string/[char])</li>
</ul></li>
<li><p><code>B.fill ' '</code> is used to get brick to fill to the maximum width (here 60) rather that having the right detail pain growing/shrinking as the data changes.</p></li>
</ul>
<div class="sourceCode" id="cb14"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb14-1"><a href="#cb14-1"></a><span class="ot">theMap ::</span> <span class="dt">BA.AttrMap</span></span>
<span id="cb14-2"><a href="#cb14-2"></a>theMap <span class="ot">=</span> BA.attrMap V.defAttr [ (BE.editAttr        , V.black <span class="ot">`B.on`</span> V.cyan)</span>
<span id="cb14-3"><a href="#cb14-3"></a>                              , (BE.editFocusedAttr , V.black <span class="ot">`B.on`</span> V.yellow)</span>
<span id="cb14-4"><a href="#cb14-4"></a>                              , (BL.listAttr        , V.white <span class="ot">`B.on`</span> V.blue)</span>
<span id="cb14-5"><a href="#cb14-5"></a>                              , (BL.listSelectedAttr, V.blue <span class="ot">`B.on`</span> V.white)</span>
<span id="cb14-6"><a href="#cb14-6"></a>                              , (B.attrName <span class="st">&quot;infoTitle&quot;</span>, B.fg V.cyan)</span>
<span id="cb14-7"><a href="#cb14-7"></a>                              , (B.attrName <span class="st">&quot;time&quot;</span>     , B.fg V.yellow)</span>
<span id="cb14-8"><a href="#cb14-8"></a>                              ]</span></code></pre></div>
<p>The attribute map is where attributes for the controls and custom attributes are defined. This makes it easy to change how the GUI looks. There is even support <a href="https://hackage.haskell.org/package/brick-0.33/docs/Brick-Themes.html">for themes</a>.</p>
<div class="sourceCode" id="cb15"><pre class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb15-1"><a href="#cb15-1"></a><span class="co">----------------------------------------------------------------------------------------------</span></span>
<span id="cb15-2"><a href="#cb15-2"></a><span class="co">-- | Compare two hoogle results for sorting</span></span>
<span id="cb15-3"><a href="#cb15-3"></a><span class="ot">compareType ::</span> <span class="dt">H.Target</span> <span class="ot">-&gt;</span> <span class="dt">H.Target</span> <span class="ot">-&gt;</span> <span class="dt">Ordering</span></span>
<span id="cb15-4"><a href="#cb15-4"></a>compareType a b <span class="ot">=</span></span>
<span id="cb15-5"><a href="#cb15-5"></a>  <span class="fu">compare</span> (formatResult a) (formatResult b)</span>
<span id="cb15-6"><a href="#cb15-6"></a></span>
<span id="cb15-7"><a href="#cb15-7"></a>  </span>
<span id="cb15-8"><a href="#cb15-8"></a><span class="co">-- | Search hoogle using the default hoogle database</span></span>
<span id="cb15-9"><a href="#cb15-9"></a><span class="ot">searchHoogle ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> [<span class="dt">H.Target</span>]</span>
<span id="cb15-10"><a href="#cb15-10"></a>searchHoogle f <span class="ot">=</span> <span class="kw">do</span></span>
<span id="cb15-11"><a href="#cb15-11"></a>  d <span class="ot">&lt;-</span> H.defaultDatabaseLocation </span>
<span id="cb15-12"><a href="#cb15-12"></a>  H.withDatabase d (\x <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="op">$</span> H.searchDatabase x (Txt.unpack f))</span>
<span id="cb15-13"><a href="#cb15-13"></a>  </span>
<span id="cb15-14"><a href="#cb15-14"></a></span>
<span id="cb15-15"><a href="#cb15-15"></a><span class="co">-- | Format the hoogle results so they roughly match what the terminal app would show</span></span>
<span id="cb15-16"><a href="#cb15-16"></a><span class="ot">formatResult ::</span> <span class="dt">H.Target</span> <span class="ot">-&gt;</span> <span class="dt">Text</span></span>
<span id="cb15-17"><a href="#cb15-17"></a>formatResult t <span class="ot">=</span></span>
<span id="cb15-18"><a href="#cb15-18"></a>  <span class="kw">let</span> typ <span class="ot">=</span> clean <span class="op">$</span> H.targetItem t <span class="kw">in</span></span>
<span id="cb15-19"><a href="#cb15-19"></a>  <span class="kw">let</span> m <span class="ot">=</span> (clean <span class="op">.</span> <span class="fu">fst</span>) <span class="op">&lt;$&gt;</span> H.targetModule t <span class="kw">in</span></span>
<span id="cb15-20"><a href="#cb15-20"></a>  Txt.pack <span class="op">$</span> fromMaybe <span class="st">&quot;&quot;</span> m <span class="op">&lt;&gt;</span> <span class="st">&quot; :: &quot;</span> <span class="op">&lt;&gt;</span> typ</span>
<span id="cb15-21"><a href="#cb15-21"></a>  </span>
<span id="cb15-22"><a href="#cb15-22"></a></span>
<span id="cb15-23"><a href="#cb15-23"></a><span class="ot">clean ::</span> [<span class="dt">Char</span>] <span class="ot">-&gt;</span> [<span class="dt">Char</span>]</span>
<span id="cb15-24"><a href="#cb15-24"></a>clean <span class="ot">=</span> unescapeHTML <span class="op">.</span> stripTags</span>
<span id="cb15-25"><a href="#cb15-25"></a></span>
<span id="cb15-26"><a href="#cb15-26"></a></span>
<span id="cb15-27"><a href="#cb15-27"></a><span class="co">-- | From hoogle source: https://hackage.haskell.org/package/hoogle-5.0.16/docs/src/General-Util.html</span></span>
<span id="cb15-28"><a href="#cb15-28"></a><span class="ot">unescapeHTML ::</span> [<span class="dt">Char</span>] <span class="ot">-&gt;</span> [<span class="dt">Char</span>]</span>
<span id="cb15-29"><a href="#cb15-29"></a>unescapeHTML (<span class="ch">'&amp;'</span><span class="op">:</span>xs)</span>
<span id="cb15-30"><a href="#cb15-30"></a>    <span class="op">|</span> <span class="dt">Just</span> x <span class="ot">&lt;-</span> Lst.stripPrefix <span class="st">&quot;lt;&quot;</span> xs <span class="ot">=</span> <span class="ch">'&lt;'</span> <span class="op">:</span> unescapeHTML x</span>
<span id="cb15-31"><a href="#cb15-31"></a>    <span class="op">|</span> <span class="dt">Just</span> x <span class="ot">&lt;-</span> Lst.stripPrefix <span class="st">&quot;gt;&quot;</span> xs <span class="ot">=</span> <span class="ch">'&gt;'</span> <span class="op">:</span> unescapeHTML x</span>
<span id="cb15-32"><a href="#cb15-32"></a>    <span class="op">|</span> <span class="dt">Just</span> x <span class="ot">&lt;-</span> Lst.stripPrefix <span class="st">&quot;amp;&quot;</span> xs <span class="ot">=</span> <span class="ch">'&amp;'</span> <span class="op">:</span> unescapeHTML x</span>
<span id="cb15-33"><a href="#cb15-33"></a>    <span class="op">|</span> <span class="dt">Just</span> x <span class="ot">&lt;-</span> Lst.stripPrefix <span class="st">&quot;quot;&quot;</span> xs <span class="ot">=</span> <span class="ch">'\&quot;'</span> <span class="op">:</span> unescapeHTML x</span>
<span id="cb15-34"><a href="#cb15-34"></a>unescapeHTML (x<span class="op">:</span>xs) <span class="ot">=</span> x <span class="op">:</span> unescapeHTML xs</span>
<span id="cb15-35"><a href="#cb15-35"></a>unescapeHTML [] <span class="ot">=</span> []</span>
<span id="cb15-36"><a href="#cb15-36"></a>  </span>
<span id="cb15-37"><a href="#cb15-37"></a></span>
<span id="cb15-38"><a href="#cb15-38"></a><span class="co">-- | From hakyll source: https://hackage.haskell.org/package/hakyll-4.1.2.1/docs/src/Hakyll-Web-Html.html#stripTags</span></span>
<span id="cb15-39"><a href="#cb15-39"></a><span class="ot">stripTags ::</span> [<span class="dt">Char</span>] <span class="ot">-&gt;</span> [<span class="dt">Char</span>]</span>
<span id="cb15-40"><a href="#cb15-40"></a>stripTags []         <span class="ot">=</span> []</span>
<span id="cb15-41"><a href="#cb15-41"></a>stripTags (<span class="ch">'&lt;'</span> <span class="op">:</span> xs) <span class="ot">=</span> stripTags <span class="op">$</span> <span class="fu">drop</span> <span class="dv">1</span> <span class="op">$</span> <span class="fu">dropWhile</span> (<span class="op">/=</span> <span class="ch">'&gt;'</span>) xs</span>
<span id="cb15-42"><a href="#cb15-42"></a>stripTags (x <span class="op">:</span> xs)   <span class="ot">=</span> x <span class="op">:</span> stripTags xs</span></code></pre></div>
<p>The remainder of the code is non-brick code for searching and formatting hoogle results</p>
<ul>
<li><strong>compareType</strong> compares two results by formatting them first and then comparing the resulting text</li>
<li><strong>searchHoogle</strong> searches hoogle using the default database</li>
<li><strong>formatResults</strong> formats the hoogle results</li>
<li><strong>unescapeHTML</strong> and <strong>stripTags</strong> are used to get plain text from the HTML. Note that this code comes from the <a href="https://hackage.haskell.org/package/hakyll-4.1.2.1/docs/src/Hakyll-Web-Html.html#stripTags">hakyll</a> and <a href="https://hackage.haskell.org/package/hoogle-5.0.16/docs/src/General-Util.html">hoogle</a> source code</li>
</ul>
<h1 id="section"></h1>
<p>Hopefully this example helps you get started with brick and demonstrates how easy brick makes creating terminal UIs</p>
<h1 id="links">Links</h1>
<ul>
<li><a href="https://github.com/andrevdm/bhoogle/tree/blog">Code on github</a></li>
<li><a href="https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst">Brick user guide</a></li>
<li><a href="https://hackage.haskell.org/package/bhoogle">Latest version on hackage</a> - NB code does not match the annotated source above</li>
<li><a href="https://github.com/andrevdm/bhoogle">Latest version on github</a> - NB code does not match the annotated source above</li>
</ul>


        </div>
        <div id="footer">
            Site proudly generated by
            <a href="http://jaspervdj.be/hakyll">Hakyll</a>
        </div>
        </div>

        <script>
          (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
          (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
          m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
          })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

          ga('create', 'UA-78428674-1', 'auto');
          ga('send', 'pageview');
        </script>
    </body>
</html>
]]></summary>
</entry>
<entry>
    <title>Parsing and generating ABIF files (DNA chromatograms)</title>
    <link href="http://www.andrevdm.com/posts/2019-01-09-abif-chromatograms.html" />
    <id>http://www.andrevdm.com/posts/2019-01-09-abif-chromatograms.html</id>
    <published>2019-01-09T00:00:00Z</published>
    <updated>2019-01-09T00:00:00Z</updated>
    <summary type="html"><![CDATA[<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
        <title>Andre's Blog</title>
        <link rel="stylesheet" type="text/css" href="../css/default.css" />
        <link rel="stylesheet" type="text/css" href="../css/syntax.css" />
    </head>
    <body>
      <div id="bodyInner">
        <div id="header">
            <div id="logo">
                <a href="../">Blog</a>
            </div>
            <div id="navigation">
                <a href="../">Home</a>
                <a href="../contact.html">Contact</a>
                <!-- <a href="/about.html">About</a> -->
            </div>
        </div>

        <div id="content">
            <h1><a href="#top">Parsing and generating ABIF files (DNA chromatograms)</a></h1>

            <div class="info">
    Posted on January  9, 2019

</div>

<h1 id="introduction">Introduction</h1>
<p><a href="https://github.com/hyraxbio/hyraxAbif">Hyrax ABIF</a> is a Haskell package, that I created at <a href="https://hyraxbio.co.za">HyraxBio</a> to test our bioinformatics software pipeline. We have released the <a href="https://hackage.haskell.org/package/hyraxAbif">HyraxAbif package</a> as open source (BSD3 licence) in the hopes that it will be useful to others.</p>
<p>In this post I’ll show how the package can be used as a standalone tool as well as looking at how the Haskell code works. <em>Skip directly to the usage / ABIF format / Haskell sections if that is all you are interested in reading about</em>.</p>
<h1 id="licence">Licence</h1>
<p>See the <a href="https://github.com/hyraxbio/hyraxAbif/blob/master/LICENSE">LICENCE</a> file. Please note that this package is distributed <em>without warranties or conditions of any kind</em>.</p>
<h1 id="chromatograms-some-basic-biology">Chromatograms &amp; some basic biology</h1>
<h2 id="chromatograms">Chromatograms</h2>
<p>Part of what we do at HyraxBio is analyze DNA sequences to determine drug resistance for various pathogens. The first step in this process getting DNA data from a sequencing machine. The mechanics of sequencing are pretty complex. Fortunately for us we start with the data already sequenced which means that all the “wet-work” is done and we can analyse and interpret the results as data, i.e. bioinformatics.</p>
<p>DNA is made up of four bases <code>A</code>, <code>C</code>, <code>G</code> and <code>T</code> (adenine, cytosine, guanine, and thymine respectively). A sequencing machine takes DNA strands and determines the sequences of bases that are present. There is a fair amount of complexity here. You can’t simply grab a strand of DNA and read it in its entirety and certainly not with 100% accuracy (because biology). Rather the DNA is amplified and a consensus of reads for each position in the DNA strand is calculated. There can be both (many) variations of the same virus (mutations) as well as errors in the reading process itself. So each position is calculated based on which of the bases have the strongest signal per position.</p>
<p>ABIF files are generated by these sequencing machines by using chemical reactions that release a tiny amount of coloured light when a reagent reacts with one of the bases. Each base results in a different colour which enables the machine to detect which base is present DNA. The details behind this are fascinating see e.g. <a href="https://en.wikipedia.org/wiki/DNA_sequencing">wikipedia</a> for more detail if you are interested.</p>
<p>Below is a section of a chromatogram showing a wave for each of the four bases.</p>
<p><img src="../images/abif_chromatogram_bases.png" /></p>
<p>This is a perfect chromatogram, there are often multiple possibilities per position of different intensity. In the image below you can see that the second and third positions have more than one possible base, this is called a mix.</p>
<p><img src="../images/abif_chromatogram_no_label.png" /></p>
<p>Even that is an unnaturally clean chromatogram. In reality they often look more like this, and take complicated base calling software and/or trained lab workers (or overworked PHD students) to decide on what base is actually represented.</p>
<p><img src="../images/abif_chromatogram_real.png" /></p>
<p>The chromatogram data in ABIF format is fed into base calling software like <a href="http://www.phrap.com/phred/">PHRED</a> and/or <a href="https://pssm.cfenet.ubc.ca/wiki">recall</a> which analyze the chromatogram and decide on which base to call per position. The result being a string of bases (A/C/G/T).</p>
<h2 id="why-we-created-hyraxabif">Why we created hyraxAbif</h2>
<p>Testing a full bioinformatics pipeline is critical to ensuring that every step works correctly and results in high quality outputs. The problem is that we could find no practical existing way to generate our own chromatograms (ABIFs). It is possible to use a set of existing ABIF files but this has two major problems</p>
<ul>
<li>These are DNA sequences from real people so there are confidentiality issues</li>
<li>More practically, we needed very specific input data to test decisions further down the pipeline and finding real data with the exact mutations and no others is not realistic.</li>
</ul>
<p>HyraxABIF was created to resolve this. It lets us easily create chromatograms from a DNA sequence and thus do all the testing we need to.</p>
<h2 id="a-bit-more-biology">A bit more biology</h2>
<p><img src="../images/abif_chromatogram_hyrax.png" /></p>
<p>The image above has a bit more detail, it shows the bases including ambiguous ones as well as the amino acids.</p>
<h3 id="ambiguous-bases">Ambiguous bases</h3>
<p>As discussed above there could be multiple possibilities per position. The IUPAC ambiguity codes (see <a href="https://en.wikipedia.org/wiki/Nucleic_acid_notation">wikipedia</a> ) or <a href="https://www.bioinformatics.org/sms/iupac.html">bioinformatics.org</a> are a way of encoding the ambiguity in a single letter. For example a <code>Y</code> IUPAC code means that the base is either a <code>C</code> or a <code>T</code>.</p>
<h3 id="amino-acids">Amino acids</h3>
<p>Each group of three nucleotide bases is called a codon and encodes for a single amino acid (in coding regions…). The chromatogram also shows the amino acid per codon. This is not important to know for this post but may help if you see other pictures of other chromatograms as this will usually be show.</p>
<h1 id="using-the-application">Using the application</h1>
<p>HyraxAbif’s primary goal was for generating chromatograms from an input DNA sequence. It can be installed from <a href="https://hackage.haskell.org/package/hyraxAbif">hackage with cabal</a>, from stack, or by cloning the <a href="https://github.com/hyraxbio/hyraxAbif">git repo</a>.</p>
<h2 id="generating-a-simple-abif">Generating a simple ABIF</h2>
<p>The input for generating a chromatogram is a simplified <a href="https://en.wikipedia.org/wiki/FASTA_format">FASTA format file</a>. These files look like this</p>
<pre class="text"><code>&gt; 1
ACTG</code></pre>
<p>The first line is the weight (more on this later), the second is the DNA sequence. Given this input file you would run</p>
<p><code>hyraxAbif-exe gen inputDir/ outputDir/</code></p>
<p>and you would end up with a ABIF file and a chromatogram like this</p>
<p><img src="../images/abif_chromatogram_bases.png" /></p>
<p>For many scenarios this is all you’ll need. You create a folder of FASTA input files and get a folder of generated corresponding ABIF files.</p>
<h3 id="generating-more-complex-chromatograms">Generating more complex chromatograms</h3>
<p>You can also generate chromatograms with mixes. The first line has the weight for the sequence, and each FASTA file can contain multiple reads.</p>
<pre class="text"><code>&gt; weight
read
&gt; weight
read</code></pre>
<ul>
<li>The weight is a numeric value between 0 and 1 that specifies the weight of the current read i.e. the intensity of the peak.</li>
<li>No other header/name is allowed (no quality data / naming etc)</li>
<li>The read is the set of input nucleotides, <a href="https://www.bioinformatics.org/sms/iupac.html">IUPAC</a> ambiguity codes are supported (MRWSYKVHDBNX).</li>
<li>A read can be single or multi-line</li>
<li>Weights for each position are summed to a maximum of 1.0 per nucleotide</li>
<li>You can use _ as a “blank” nucleotide, in which case only the nucleotides from other reads will be considered</li>
<li>Reads need not be the same length</li>
</ul>
<p>For example</p>
<pre class="text"><code>&gt; 0.5
ACG
&gt; 0.3
AAAA
&gt; 1
__AC</code></pre>
<p>Results in the following weighted nucleotide per position</p>
<table>
<thead>
<tr class="header">
<th>position</th>
<th>A</th>
<th>C</th>
<th>G</th>
<th>T</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td>0</td>
<td>0.5 + 0.3 = 0.8</td>
<td>0</td>
<td>0</td>
<td>0</td>
</tr>
<tr class="even">
<td>1</td>
<td>0.3</td>
<td>0.5</td>
<td>0</td>
<td>0</td>
</tr>
<tr class="odd">
<td>2</td>
<td>0.3 + 1 = 1.0</td>
<td>0</td>
<td>0.5</td>
<td>0</td>
</tr>
<tr class="even">
<td>3</td>
<td>0.3</td>
<td>1</td>
<td>0</td>
<td>0</td>
</tr>
</tbody>
</table>
<p><em>Note that 0.3 + 1.0 = 1.0 because the max value is 1.0</em></p>
<p>And this sample</p>
<pre class="text"><code>&gt; 1
ACAG
&gt; 0.3
_GT
&gt; 0.2
_G</code></pre>
<p>results in this chromatogram</p>
<p><img src="../images/abif_chromatogram_mix.png" /></p>
<p>The <a href="https://www.bioinformatics.org/sms/iupac.html">IUPAC</a> codes here are</p>
<ul>
<li><code>S</code> = <code>G</code> or <code>C</code></li>
<li><code>W</code> = <code>A</code> or <code>T</code></li>
</ul>
<h3 id="reverse-reads">Reverse reads</h3>
<p>A weighted FASTA can represent a reverse read. To do this add a <code>R</code> suffix to the weight. The data you enter should be entered as if it was a forward read. This data will be complemented and reversed before writing to the ABIF</p>
<pre class="text"><code>&gt; 0.9R
ACAG</code></pre>
<p>which results in the sequence <code>TGTC</code></p>
<h2 id="dumping-an-existing-abif-file">Dumping an existing ABIF file</h2>
<p>You can also dump an existing ABIF file</p>
<p><code>hyraxAbif-exe dump sample.abif</code></p>
<p>This prints two views of the file. First a detail view, partially show below</p>
<p><img src="../images/abif_dump_top.png" /></p>
<p>and then a summary</p>
<p><img src="../images/abif_dump_bottom.png" /></p>
<p>For certain types of data (e.g. strings) the parsed value is displayed.</p>
<h1 id="the-abif-file-format">The ABIF file format</h1>
<p>The ABIF format is <a href="http://www6.appliedbiosystems.com/support/software_community/ABIF_File_Format.pdf">documented here</a>. As you can see from the spec the ABIF format <em>was modeled after the TIFF format</em>. This means that there is a directory of entries and each entry has a data type.</p>
<p>The spec is quite thorough and explains the layout well. If you are wanting to understand the format it is your best starting point. The spec, however, only goes into detail on the ABIF structure. It does not go into much detail on how the chromatogram data itself is stored, I’ll cover that here.</p>
<p>In the file after the ABIF header and version number is the root directory entry. This entry points to the first of the data directory entries that can be located at any other location in the file.</p>
<p>Each directory entry has an offset to the location of its data in the file, the data size, the element size and number of entries. See the spec or the discussion of the Haskell code below for more details on each field.</p>
<p>Note that for data with a size of four bytes or less, the data is stored in the offset field itself.</p>
<p><img src="../images/abif_directory.png" /></p>
<h2 id="important-abif-directory-entries">Important ABIF directory entries</h2>
<p>Towards the end of the spec are examples of the layout of ABIF files for a few sequencing machines. Lets take a look at some of these for the 3500 layout.</p>
<h3 id="chromatogram-traces">Chromatogram traces</h3>
<table>
<colgroup>
<col style="width: 3%" />
<col style="width: 7%" />
<col style="width: 88%" />
</colgroup>
<thead>
<tr class="header">
<th>Type</th>
<th>Tag Number</th>
<th>Contains</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td>DATA</td>
<td>1 - 4</td>
<td>The raw data per base (channel). The order of the bases is specified by the FWO_ entry</td>
</tr>
<tr class="even">
<td>DATA</td>
<td>5</td>
<td>Short Array holding measured volts/10 (EP voltage) during run</td>
</tr>
<tr class="odd">
<td>DATA</td>
<td>6</td>
<td>Short Array holding measured milliAmps trace (EP current) during run</td>
</tr>
<tr class="even">
<td>DATA</td>
<td>7</td>
<td>Short Array holding measured milliWatts trace (Laser EP Power) during</td>
</tr>
<tr class="odd">
<td>DATA</td>
<td>8</td>
<td>Short Array holding measured oven Temperature (polymer temperature) trace during run</td>
</tr>
<tr class="even">
<td>DATA</td>
<td>9 - 12</td>
<td>Short Array holding analyzed color data</td>
</tr>
</tbody>
</table>
<p>This is a pretty intimidating set of values we thought we would have to generate from a FASTA input, just for the traces. Fortunately through trial and error we were able to see that only a small subset of the entries were required for the base calling software we were using (PHRED + Recall). All we needed to generate were the data sections 9 to 12, i.e. one per base, the <em>analyzed colour data</em>.</p>
<p>The four DATA sections we need to generate (entries 9 through 12) contain an array of shorts. Each short represents the intensity of the light for that base at a given point. Each of these DATA sections have the wave of the light intensity over time. The <strong>FWO_</strong> directory entry specifies which base each DATA entry represents. We always generate it in the 3500 format, so the order is <code>9=G</code>, <code>10=A</code>, <code>11=T</code>, <code>12=C</code>.</p>
<h3 id="peak-location">Peak location</h3>
<p>The traces above are just the wave form, the <strong>PLOC</strong> entry specifies the location of each peak. This is the location, across all four DATA entries, where the peak of the waves should be found. There is a single <strong>PLOC</strong> entry for all four <strong>DATA</strong> entries.</p>
<p><img src="../images/abif_peaks.png" /></p>
<h3 id="other-required-entries">Other required entries</h3>
<p>The other required entries are easy to generate, they are things like the base order (FWO_), file name (PDMF) and called based (PBAS). See the Haskell code discussion below to see them all.</p>
<h3 id="generating-the-waveforms">Generating the waveforms</h3>
<p>Given a base, we then need to create a wave and a single peak location entry. The data we use for each wave is this array of shorts <code>[0, 0, 128, 512, 1024, 1024, 512, 128, 0, 0]</code> which creates a wave like this.</p>
<p><img src="../images/abif_wave.png" /></p>
<p>The peak is the middle of the wave, nice and simple.</p>
<p>Again see the code discussion for more details in this.</p>
<h1 id="using-the-code-some-basic-examples">Using the code, some basic examples</h1>
<h2 id="reading-and-printing-the-abif-structure">Reading and printing the ABIF structure</h2>
<div class="sourceCode" id="cb6"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb6-1" title="1"><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></a>
<a class="sourceLine" id="cb6-2" title="2"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></a>
<a class="sourceLine" id="cb6-3" title="3"></a>
<a class="sourceLine" id="cb6-4" title="4"><span class="kw">module</span> <span class="dt">Examples.ReadAb1</span> <span class="kw">where</span></a>
<a class="sourceLine" id="cb6-5" title="5"></a>
<a class="sourceLine" id="cb6-6" title="6"><span class="kw">import</span>           <span class="dt">Protolude</span></a>
<a class="sourceLine" id="cb6-7" title="7"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Hyrax.Abif.Read</span> <span class="kw">as</span> <span class="dt">H</span></a>
<a class="sourceLine" id="cb6-8" title="8"></a>
<a class="sourceLine" id="cb6-9" title="9"><span class="co">-- | Read and print a ABIF file</span></a>
<a class="sourceLine" id="cb6-10" title="10"><span class="ot">readAbif ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb6-11" title="11">readAbif <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb6-12" title="12">  abif' <span class="ot">&lt;-</span> H.readAbif <span class="st">&quot;example.ab1&quot;</span></a>
<a class="sourceLine" id="cb6-13" title="13"></a>
<a class="sourceLine" id="cb6-14" title="14">  <span class="kw">case</span> abif' <span class="kw">of</span></a>
<a class="sourceLine" id="cb6-15" title="15">    <span class="dt">Left</span> e <span class="ot">-&gt;</span> <span class="fu">putStrLn</span> <span class="fu">$</span> <span class="st">&quot;error reading ABIF: &quot;</span> <span class="fu">&lt;&gt;</span> e</a>
<a class="sourceLine" id="cb6-16" title="16">    <span class="dt">Right</span> abif <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb6-17" title="17">      <span class="co">-- Print after removing the data, to make it readable</span></a>
<a class="sourceLine" id="cb6-18" title="18">      <span class="fu">print</span> <span class="fu">$</span> H.clearAbif abif</a></code></pre></div>
<ol type="1">
<li><code>readAbif</code> tries to parse an ABIF file, it returns an <code>Either Text Abif</code></li>
<li>Check if the file was parsed successfully</li>
<li>If not (<strong>Left</strong>) then print the error</li>
<li>If successful (<strong>Right</strong>) then
<ol type="1">
<li><code>clearAbif</code> removes all the raw data. If you don’t do this then all the massive byte arrays will get printed too</li>
<li><code>print</code> the result.</li>
</ol></li>
</ol>
<p>The functions are all commented and visible on <a href="https://hackage.haskell.org/package/hyraxAbif">hackage</a>.</p>
<h2 id="adding-a-comment-to-an-existing-abif">Adding a comment to an existing ABIF</h2>
<div class="sourceCode" id="cb7"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb7-1" title="1"><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></a>
<a class="sourceLine" id="cb7-2" title="2"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></a>
<a class="sourceLine" id="cb7-3" title="3"></a>
<a class="sourceLine" id="cb7-4" title="4"><span class="kw">module</span> <span class="dt">Examples.AddComment</span> <span class="kw">where</span></a>
<a class="sourceLine" id="cb7-5" title="5"></a>
<a class="sourceLine" id="cb7-6" title="6"><span class="kw">import</span>           <span class="dt">Protolude</span></a>
<a class="sourceLine" id="cb7-7" title="7"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Hyrax.Abif.Read</span> <span class="kw">as</span> <span class="dt">H</span></a>
<a class="sourceLine" id="cb7-8" title="8"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Hyrax.Abif.Write</span> <span class="kw">as</span> <span class="dt">H</span></a>
<a class="sourceLine" id="cb7-9" title="9"></a>
<a class="sourceLine" id="cb7-10" title="10"><span class="co">-- | Add a comment to an existing AB1 file</span></a>
<a class="sourceLine" id="cb7-11" title="11"><span class="ot">addComment ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb7-12" title="12">addComment <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-13" title="13">  abif' <span class="ot">&lt;-</span> H.readAbif <span class="st">&quot;example.ab1&quot;</span></a>
<a class="sourceLine" id="cb7-14" title="14"></a>
<a class="sourceLine" id="cb7-15" title="15">  <span class="kw">case</span> abif' <span class="kw">of</span></a>
<a class="sourceLine" id="cb7-16" title="16">    <span class="dt">Left</span> e <span class="ot">-&gt;</span> <span class="fu">putStrLn</span> <span class="fu">$</span> <span class="st">&quot;error reading ABIF: &quot;</span> <span class="fu">&lt;&gt;</span> e</a>
<a class="sourceLine" id="cb7-17" title="17">    <span class="dt">Right</span> abif <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-18" title="18">      <span class="kw">let</span> modified <span class="fu">=</span> H.addDirectory abif <span class="fu">$</span> H.mkComment <span class="st">&quot;new comment&quot;</span></a>
<a class="sourceLine" id="cb7-19" title="19">      H.writeAbif <span class="st">&quot;example.modified.ab1&quot;</span> modified</a></code></pre></div>
<p>Only the <strong>Right</strong> case is different than the previous example</p>
<ol type="1">
<li><code>addDirectory</code> is called to add a new comment directory entry that is created by <code>mkComment</code></li>
<li><code>writeAbif</code> writes the updated file to disk</li>
</ol>
<h2 id="more-examples">More examples</h2>
<p>The <code>Examples</code> directory contains more examples. You can also look at the <code>Generate</code> and <code>Main</code> modules to see how the code is used.</p>
<h1 id="understanding-the-code">Understanding the code</h1>
<h2 id="data.binary">Data.Binary</h2>
<p><a href="http://hackage.haskell.org/package/binary">Data.Binary</a> is used to read and write the raw bytes in the ABIF files.</p>
<h3 id="writing">Writing</h3>
<p>Below is an example of writing two Int8 and an Int32 value.</p>
<div class="sourceCode" id="cb8"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb8-1" title="1"><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></a>
<a class="sourceLine" id="cb8-2" title="2"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></a>
<a class="sourceLine" id="cb8-3" title="3"></a>
<a class="sourceLine" id="cb8-4" title="4"><span class="kw">module</span> <span class="dt">Main</span> <span class="kw">where</span></a>
<a class="sourceLine" id="cb8-5" title="5"><span class="kw">import</span> <span class="dt">Protolude</span></a>
<a class="sourceLine" id="cb8-6" title="6"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Binary.Put</span> <span class="kw">as</span> <span class="dt">B</span></a>
<a class="sourceLine" id="cb8-7" title="7"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.ByteString.Lazy</span> <span class="kw">as</span> <span class="dt">BSL</span></a>
<a class="sourceLine" id="cb8-8" title="8"></a>
<a class="sourceLine" id="cb8-9" title="9"></a>
<a class="sourceLine" id="cb8-10" title="10"><span class="ot">main ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb8-11" title="11">main <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb8-12" title="12">  <span class="kw">let</span> outData <span class="fu">=</span> B.runPut testWrite</a>
<a class="sourceLine" id="cb8-13" title="13">  BSL.writeFile <span class="st">&quot;test.dat&quot;</span> outData</a>
<a class="sourceLine" id="cb8-14" title="14"></a>
<a class="sourceLine" id="cb8-15" title="15">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb8-16" title="16"><span class="ot">    testWrite ::</span> <span class="dt">B.PutM</span> ()</a>
<a class="sourceLine" id="cb8-17" title="17">    testWrite <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb8-18" title="18">      B.putInt8 <span class="dv">1</span></a>
<a class="sourceLine" id="cb8-19" title="19">      B.putInt8 <span class="dv">2</span></a>
<a class="sourceLine" id="cb8-20" title="20">      B.putInt32be <span class="dv">3</span></a></code></pre></div>
<p><code>runPut</code> “runs” the <code>PutM</code> monad. <code>testWrite</code> can then simply call the <code>put*</code> functions to write the data in whatever format is required.</p>
<p>This creates a file that looks like this</p>
<p><img src="../images/abif_binary_file.png" /></p>
<h3 id="reading">Reading</h3>
<p>Reading the data from the file looks like this</p>
<div class="sourceCode" id="cb9"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb9-1" title="1"><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></a>
<a class="sourceLine" id="cb9-2" title="2"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></a>
<a class="sourceLine" id="cb9-3" title="3"></a>
<a class="sourceLine" id="cb9-4" title="4"><span class="kw">module</span> <span class="dt">Main</span> <span class="kw">where</span></a>
<a class="sourceLine" id="cb9-5" title="5"><span class="kw">import</span> <span class="dt">Protolude</span></a>
<a class="sourceLine" id="cb9-6" title="6"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Binary.Get</span> <span class="kw">as</span> <span class="dt">B</span></a>
<a class="sourceLine" id="cb9-7" title="7"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.ByteString.Lazy</span> <span class="kw">as</span> <span class="dt">BSL</span></a>
<a class="sourceLine" id="cb9-8" title="8"></a>
<a class="sourceLine" id="cb9-9" title="9"></a>
<a class="sourceLine" id="cb9-10" title="10"><span class="ot">main ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb9-11" title="11">main <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb9-12" title="12">  inData <span class="ot">&lt;-</span> BSL.readFile <span class="st">&quot;test.dat&quot;</span></a>
<a class="sourceLine" id="cb9-13" title="13">  <span class="kw">let</span> <span class="fu">read</span> <span class="fu">=</span> B.runGet testRead inData</a>
<a class="sourceLine" id="cb9-14" title="14">  <span class="fu">print</span> <span class="fu">read</span></a>
<a class="sourceLine" id="cb9-15" title="15"></a>
<a class="sourceLine" id="cb9-16" title="16">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb9-17" title="17"><span class="ot">    testRead ::</span> <span class="dt">B.Get</span> (<span class="dt">Int8</span>, <span class="dt">Int8</span>, <span class="dt">Int32</span>)</a>
<a class="sourceLine" id="cb9-18" title="18">    testRead <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb9-19" title="19">      a <span class="ot">&lt;-</span> B.getInt8</a>
<a class="sourceLine" id="cb9-20" title="20">      b <span class="ot">&lt;-</span> B.getInt8</a>
<a class="sourceLine" id="cb9-21" title="21">      c <span class="ot">&lt;-</span> B.getInt32be</a>
<a class="sourceLine" id="cb9-22" title="22">      <span class="fu">pure</span> (a, b, c)</a></code></pre></div>
<p><code>runGet</code> is given the ByteString from the file and <code>testRead</code> gets the values in the appropriate format.</p>
<p>If you prefer applicatives you could instead have written <code>testGet</code> as</p>
<div class="sourceCode" id="cb10"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb10-1" title="1">(,,) <span class="fu">&lt;$&gt;</span> B.getInt8 <span class="fu">&lt;*&gt;</span> B.getInt8 <span class="fu">&lt;*&gt;</span> B.getInt32be</a></code></pre></div>
<p>and <code>testWrite</code> as</p>
<div class="sourceCode" id="cb11"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb11-1" title="1">B.putInt8 <span class="dv">1</span> <span class="fu">*&gt;</span> B.putInt8 <span class="dv">2</span> <span class="fu">*&gt;</span> B.putInt32be <span class="dv">3</span></a></code></pre></div>
<h2 id="abif-types">ABIF Types</h2>
<p><strong>Hyrax.Abif</strong> contains the core types for the package</p>
<h6 id="srchyraxabif.hs-22-to-32">src/Hyrax/Abif.hs (22 to 32)</h6>
<div class="sourceCode" id="cb12"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb12-1" title="1"><span class="kw">module</span> <span class="dt">Hyrax.Abif</span></a>
<a class="sourceLine" id="cb12-2" title="2">    ( <span class="dt">Abif</span> (<span class="fu">..</span>)</a>
<a class="sourceLine" id="cb12-3" title="3">    , <span class="dt">Header</span> (<span class="fu">..</span>)</a>
<a class="sourceLine" id="cb12-4" title="4">    , <span class="dt">Directory</span> (<span class="fu">..</span>)</a>
<a class="sourceLine" id="cb12-5" title="5">    , <span class="dt">ElemType</span> (<span class="fu">..</span>)</a>
<a class="sourceLine" id="cb12-6" title="6">    , getElemType</a>
<a class="sourceLine" id="cb12-7" title="7">    , describeElemType</a>
<a class="sourceLine" id="cb12-8" title="8">    ) <span class="kw">where</span></a>
<a class="sourceLine" id="cb12-9" title="9"></a>
<a class="sourceLine" id="cb12-10" title="10"><span class="kw">import</span>           <span class="dt">Protolude</span></a>
<a class="sourceLine" id="cb12-11" title="11"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.ByteString.Lazy</span> <span class="kw">as</span> <span class="dt">BSL</span></a></code></pre></div>
<h6 id="srchyraxabif.hs-37-to-64">src/Hyrax/Abif.hs (37 to 64)</h6>
<div class="sourceCode" id="cb13"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb13-1" title="1"><span class="co">-- | A single ABIF</span></a>
<a class="sourceLine" id="cb13-2" title="2"><span class="kw">data</span> <span class="dt">Abif</span> <span class="fu">=</span> <span class="dt">Abif</span> {<span class="ot"> aHeader ::</span> <span class="fu">!</span><span class="dt">Header</span></a>
<a class="sourceLine" id="cb13-3" title="3">                 ,<span class="ot"> aRootDir ::</span> <span class="fu">!</span><span class="dt">Directory</span></a>
<a class="sourceLine" id="cb13-4" title="4">                 ,<span class="ot"> aDirs ::</span> <span class="fu">!</span>[<span class="dt">Directory</span>]</a>
<a class="sourceLine" id="cb13-5" title="5">                 } <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</a>
<a class="sourceLine" id="cb13-6" title="6"></a>
<a class="sourceLine" id="cb13-7" title="7"></a>
<a class="sourceLine" id="cb13-8" title="8"><span class="co">-- | ABIF header</span></a>
<a class="sourceLine" id="cb13-9" title="9"><span class="kw">data</span> <span class="dt">Header</span> <span class="fu">=</span> <span class="dt">Header</span> {<span class="ot"> hName ::</span> <span class="fu">!</span><span class="dt">Text</span></a>
<a class="sourceLine" id="cb13-10" title="10">                     ,<span class="ot"> hVersion ::</span> <span class="fu">!</span><span class="dt">Int</span></a>
<a class="sourceLine" id="cb13-11" title="11">                     } <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</a>
<a class="sourceLine" id="cb13-12" title="12"></a>
<a class="sourceLine" id="cb13-13" title="13"><span class="co">-- | ABIF directory entry.</span></a>
<a class="sourceLine" id="cb13-14" title="14"><span class="co">-- The 'dData' field contains the data for the entry</span></a>
<a class="sourceLine" id="cb13-15" title="15"><span class="kw">data</span> <span class="dt">Directory</span> <span class="fu">=</span> <span class="dt">Directory</span> {<span class="ot"> dTagName ::</span> <span class="fu">!</span><span class="dt">Text</span>        <span class="co">-- ^ Tag name</span></a>
<a class="sourceLine" id="cb13-16" title="16">                           ,<span class="ot"> dTagNum ::</span> <span class="fu">!</span><span class="dt">Int</span>          <span class="co">-- ^ Tag number, see e.g. how DATA entries use this</span></a>
<a class="sourceLine" id="cb13-17" title="17">                           ,<span class="ot"> dElemType ::</span> <span class="fu">!</span><span class="dt">ElemType</span>   <span class="co">-- ^ Type of an element</span></a>
<a class="sourceLine" id="cb13-18" title="18">                           ,<span class="ot"> dElemTypeCode ::</span> <span class="fu">!</span><span class="dt">Int</span>    <span class="co">-- ^ Integer value of 'dElemType'</span></a>
<a class="sourceLine" id="cb13-19" title="19">                           ,<span class="ot"> dElemTypeDesc ::</span> <span class="fu">!</span><span class="dt">Text</span>   <span class="co">-- ^ Description of 'dElemType'</span></a>
<a class="sourceLine" id="cb13-20" title="20">                           ,<span class="ot"> dElemSize ::</span> <span class="fu">!</span><span class="dt">Int</span>        <span class="co">-- ^ Size in bytes of each element</span></a>
<a class="sourceLine" id="cb13-21" title="21">                           ,<span class="ot"> dElemNum ::</span> <span class="fu">!</span><span class="dt">Int</span>         <span class="co">-- ^ Number of elements in the data. See the spec per data type. E.g. for a string this is the number of characters</span></a>
<a class="sourceLine" id="cb13-22" title="22">                           ,<span class="ot"> dDataSize ::</span> <span class="fu">!</span><span class="dt">Int</span>        <span class="co">-- ^ Number of bytes in the data</span></a>
<a class="sourceLine" id="cb13-23" title="23">                           ,<span class="ot"> dDataOffset ::</span> <span class="fu">!</span><span class="dt">Int</span>      <span class="co">-- ^ Offset of this directory entry's data in the file. For data that is four</span></a>
<a class="sourceLine" id="cb13-24" title="24">                                                      <span class="co">--    bytes or less, the data itself is stored in this field.</span></a>
<a class="sourceLine" id="cb13-25" title="25">                                                      <span class="co">--    This value will be recalculated when writing an ABIF so you do not need to manually set it.</span></a>
<a class="sourceLine" id="cb13-26" title="26">                           ,<span class="ot"> dData ::</span> <span class="fu">!</span><span class="dt">BSL.ByteString</span> <span class="co">-- ^ The entry's data</span></a>
<a class="sourceLine" id="cb13-27" title="27">                           ,<span class="ot"> dDataDebug ::</span> <span class="fu">!</span>[<span class="dt">Text</span>]    <span class="co">-- ^ Optinal debug data, populated by 'Hyrax.Abif.Read.getDebug' when a ABIF is parsed</span></a>
<a class="sourceLine" id="cb13-28" title="28">                           } <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</a></code></pre></div>
<p>These three types make up most of what we need to represent an ABIF. A few things to notice</p>
<ul>
<li>The root directory in the <code>Abif</code> type will point to the array of <code>Directory</code> entries</li>
<li><code>dElemTypeCode</code> is the integer value read from the file (see the spec for the codes). <code>dElemType</code> and <code>dElemTypeDesc</code> are interpreted values from this</li>
<li><code>dElemSize</code> and <code>dElemOffset</code> are read from the file, but are automatically calculated when writing (see the Hyrax.Abif.Write section below)</li>
<li><code>dData</code> is the actual raw data read from the file, or data to be written to an ABIF file</li>
<li><code>dDataDebug</code> is populated while reading the file and used during dumping to give human readable info about the file being inspected.</li>
</ul>
<h3 id="element-types">Element types</h3>
<p>The remaining code is the definition of <code>ElemType</code> and functions for interpreting the raw element type integer value. Note that the spec defines a number of unsupported data types, these are included here.</p>
<h2 id="hyrax.abif.read">Hyrax.Abif.Read</h2>
<h3 id="starting-the-read">Starting the read</h3>
<p><code>readAbif</code> calls <code>getAbif</code> to parse the data</p>
<h6 id="srchyraxabifread.hs-51-to-53">src/Hyrax/Abif/Read.hs (51 to 53)</h6>
<div class="sourceCode" id="cb14"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb14-1" title="1"><span class="co">-- | Read and parse an AB1 file</span></a>
<a class="sourceLine" id="cb14-2" title="2"><span class="ot">readAbif ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> (<span class="dt">Either</span> <span class="dt">Text</span> <span class="dt">Abif</span>)</a>
<a class="sourceLine" id="cb14-3" title="3">readAbif path <span class="fu">=</span> getAbif <span class="fu">&lt;$&gt;</span> BSL.readFile path</a></code></pre></div>
<p><code>getAbif</code> starts the parsing of the <code>Abif</code> data structure.</p>
<h6 id="srchyraxabifread.hs-58-to-75">src/Hyrax/Abif/Read.hs (58 to 75)</h6>
<div class="sourceCode" id="cb15"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb15-1" title="1"><span class="co">-- | Parse an AB1 from a 'ByteString'</span></a>
<a class="sourceLine" id="cb15-2" title="2"><span class="ot">getAbif ::</span> <span class="dt">BSL.ByteString</span> <span class="ot">-&gt;</span> <span class="dt">Either</span> <span class="dt">Text</span> <span class="dt">Abif</span></a>
<a class="sourceLine" id="cb15-3" title="3">getAbif bs <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb15-4" title="4">  (header, rootDir) <span class="ot">&lt;-</span> <span class="kw">case</span> B.runGetOrFail (getRoot bs) bs <span class="kw">of</span></a>
<a class="sourceLine" id="cb15-5" title="5">                         <span class="dt">Right</span> (_, _, x) <span class="ot">-&gt;</span> <span class="fu">pure</span> x</a>
<a class="sourceLine" id="cb15-6" title="6">                         <span class="dt">Left</span> (_, _, e) <span class="ot">-&gt;</span> <span class="dt">Left</span> (<span class="st">&quot;Error reading root: &quot;</span> <span class="fu">&lt;&gt;</span> Txt.pack e)</a>
<a class="sourceLine" id="cb15-7" title="7"></a>
<a class="sourceLine" id="cb15-8" title="8">  <span class="kw">let</span> dirBytes <span class="fu">=</span> BSL.drop (<span class="fu">fromIntegral</span> <span class="fu">$</span> dDataOffset rootDir) bs</a>
<a class="sourceLine" id="cb15-9" title="9">  </a>
<a class="sourceLine" id="cb15-10" title="10">  ds <span class="ot">&lt;-</span> <span class="kw">case</span> B.runGetOrFail (getDirectories bs [] <span class="fu">$</span> dElemNum rootDir) dirBytes <span class="kw">of</span></a>
<a class="sourceLine" id="cb15-11" title="11">          <span class="dt">Right</span> (_, _, x) <span class="ot">-&gt;</span> <span class="fu">pure</span> x</a>
<a class="sourceLine" id="cb15-12" title="12">          <span class="dt">Left</span> (_, _, e) <span class="ot">-&gt;</span> <span class="dt">Left</span> (<span class="st">&quot;Error reading &quot;</span></a>
<a class="sourceLine" id="cb15-13" title="13">                                  <span class="fu">&lt;&gt;</span> <span class="fu">show</span> (dElemNum rootDir)</a>
<a class="sourceLine" id="cb15-14" title="14">                                  <span class="fu">&lt;&gt;</span> <span class="st">&quot; directories (at &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> (dDataOffset rootDir) <span class="fu">&lt;&gt;</span> <span class="st">&quot;): &quot;</span></a>
<a class="sourceLine" id="cb15-15" title="15">                                  <span class="fu">&lt;&gt;</span> Txt.pack e</a>
<a class="sourceLine" id="cb15-16" title="16">                                 )</a>
<a class="sourceLine" id="cb15-17" title="17">  </a>
<a class="sourceLine" id="cb15-18" title="18">  <span class="fu">pure</span> <span class="fu">$</span> <span class="dt">Abif</span> header rootDir ds</a></code></pre></div>
<ul>
<li>The <code>Either</code> monad is used so any <code>Left</code> value will short-circuit out of the function and return the <code>Left</code> value immediately.</li>
<li><code>Data.Binary.runGetOrFail</code> returns a <code>Left</code> if the get operation fails. Much better than getting an exception as you would with <code>runGet</code></li>
<li>The first step is to read the header and the root directory</li>
<li>Then the ABIF directory entries are read. These directories are found at the offset specified in the root directory. The code “goes” to this offset by dropping the number of bytes from the read data.</li>
<li><code>getDirectories</code> reads the number of directory entries specified by the root entry.</li>
</ul>
<p><code>getRoot</code> gets the header and root directory (see next section)</p>
<h6 id="srchyraxabifread.hs-218-to-223">src/Hyrax/Abif/Read.hs (218 to 223)</h6>
<div class="sourceCode" id="cb16"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb16-1" title="1"><span class="co">-- | Parse the root ('Header' and 'Directory')</span></a>
<a class="sourceLine" id="cb16-2" title="2"><span class="ot">getRoot ::</span> <span class="dt">BSL.ByteString</span> <span class="ot">-&gt;</span> <span class="dt">B.Get</span> (<span class="dt">Header</span>, <span class="dt">Directory</span>)</a>
<a class="sourceLine" id="cb16-3" title="3">getRoot bs <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb16-4" title="4">  h <span class="ot">&lt;-</span> getHeader</a>
<a class="sourceLine" id="cb16-5" title="5">  rd <span class="ot">&lt;-</span> getDirectory bs</a>
<a class="sourceLine" id="cb16-6" title="6">  <span class="fu">pure</span> (h, rd)</a></code></pre></div>
<p><code>getHeader</code> gets the “ABIF” magic string and version number. Similar to the read example above.</p>
<h6 id="srchyraxabifread.hs-209-to-213">src/Hyrax/Abif/Read.hs (209 to 213)</h6>
<div class="sourceCode" id="cb17"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb17-1" title="1"><span class="co">-- | Parse the ABIF 'Header'</span></a>
<a class="sourceLine" id="cb17-2" title="2"><span class="ot">getHeader ::</span> <span class="dt">B.Get</span> <span class="dt">Header</span></a>
<a class="sourceLine" id="cb17-3" title="3">getHeader <span class="fu">=</span> </a>
<a class="sourceLine" id="cb17-4" title="4">  <span class="dt">Header</span> <span class="fu">&lt;$&gt;</span> (TxtE.decodeUtf8 <span class="fu">&lt;$&gt;</span> B.getByteString <span class="dv">4</span>)</a>
<a class="sourceLine" id="cb17-5" title="5">         <span class="fu">&lt;*&gt;</span> (<span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> B.getInt16be)</a></code></pre></div>
<h3 id="reading-directories">Reading directories</h3>
<p><code>getDirectories</code> is given the number of directories to read. It tries to read a single <code>Directory</code> by calling <code>getDirectory</code> and then recursively calls itself until done.</p>
<h6 id="srchyraxabifread.hs-272-to-279">src/Hyrax/Abif/Read.hs (272 to 279)</h6>
<div class="sourceCode" id="cb18"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb18-1" title="1"><span class="co">-- | Parse all the directoy entries</span></a>
<a class="sourceLine" id="cb18-2" title="2"><span class="ot">getDirectories ::</span> <span class="dt">BSL.ByteString</span> <span class="ot">-&gt;</span> [<span class="dt">Directory</span>] <span class="ot">-&gt;</span> <span class="dt">Int</span> <span class="ot">-&gt;</span> <span class="dt">B.Get</span> [<span class="dt">Directory</span>]</a>
<a class="sourceLine" id="cb18-3" title="3">getDirectories _ acc <span class="dv">0</span> <span class="fu">=</span> <span class="fu">pure</span> acc</a>
<a class="sourceLine" id="cb18-4" title="4">getDirectories bs acc more <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb18-5" title="5">  d <span class="ot">&lt;-</span> getDirectory bs</a>
<a class="sourceLine" id="cb18-6" title="6">  B.skip <span class="dv">4</span> <span class="co">-- Skip the reserved field</span></a>
<a class="sourceLine" id="cb18-7" title="7">  getDirectories bs (acc <span class="fu">&lt;&gt;</span> [d]) (more <span class="fu">-</span> <span class="dv">1</span>)</a>
<a class="sourceLine" id="cb18-8" title="8"></a></code></pre></div>
<p>Reading and individual directory is done by <code>getDirectory</code>.</p>
<ul>
<li>Read the values and convert into appropriate types (e.g. Int8 to Int)</li>
<li>If the data is four bytes or less then the offset field contains the data</li>
<li>If the data is larger than four bytes, go to the offset and read the entire chunk as a <code>ByteString</code>.</li>
<li>Create a <code>Abif</code> value</li>
</ul>
<h6 id="srchyraxabifread.hs-228-to-267">src/Hyrax/Abif/Read.hs (228 to 267)</h6>
<div class="sourceCode" id="cb19"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb19-1" title="1"><span class="co">-- | Parse a single 'Directory' entry and read its data</span></a>
<a class="sourceLine" id="cb19-2" title="2"><span class="ot">getDirectory ::</span> <span class="dt">BSL.ByteString</span> <span class="ot">-&gt;</span> <span class="dt">B.Get</span> <span class="dt">Directory</span></a>
<a class="sourceLine" id="cb19-3" title="3">getDirectory bs <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb19-4" title="4">  tagName <span class="ot">&lt;-</span> TxtE.decodeUtf8 <span class="fu">&lt;$&gt;</span> B.getByteString <span class="dv">4</span></a>
<a class="sourceLine" id="cb19-5" title="5">  tagNum <span class="ot">&lt;-</span> <span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> B.getInt32be</a>
<a class="sourceLine" id="cb19-6" title="6">  typeCode <span class="ot">&lt;-</span> <span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> B.getInt16be</a>
<a class="sourceLine" id="cb19-7" title="7">  elemSize <span class="ot">&lt;-</span> <span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> B.getInt16be</a>
<a class="sourceLine" id="cb19-8" title="8">  elemNum <span class="ot">&lt;-</span> <span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> B.getInt32be</a>
<a class="sourceLine" id="cb19-9" title="9">  dataSize <span class="ot">&lt;-</span> <span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> B.getInt32be</a>
<a class="sourceLine" id="cb19-10" title="10">  offsetDataBytes <span class="ot">&lt;-</span> B.lookAhead <span class="fu">$</span> B.getLazyByteString <span class="dv">4</span></a>
<a class="sourceLine" id="cb19-11" title="11">  dataOffset <span class="ot">&lt;-</span> <span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> B.getInt32be</a>
<a class="sourceLine" id="cb19-12" title="12"></a>
<a class="sourceLine" id="cb19-13" title="13">  <span class="co">-- Read the data</span></a>
<a class="sourceLine" id="cb19-14" title="14">  <span class="co">--  Data that is 4 bytes or less is stored in the offset field</span></a>
<a class="sourceLine" id="cb19-15" title="15">  dataBytes <span class="ot">&lt;-</span> <span class="kw">if</span> dataSize <span class="fu">&lt;=</span> <span class="dv">4</span></a>
<a class="sourceLine" id="cb19-16" title="16">                    <span class="kw">then</span> <span class="fu">pure</span> <span class="fu">$</span> BSL.take (<span class="fu">fromIntegral</span> dataSize) offsetDataBytes</a>
<a class="sourceLine" id="cb19-17" title="17">                    <span class="kw">else</span> <span class="kw">case</span> B.runGetOrFail (B.getLazyByteString <span class="fu">$</span> <span class="fu">fromIntegral</span> dataSize) <span class="fu">$</span> BSL.drop (<span class="fu">fromIntegral</span> dataOffset) bs <span class="kw">of</span></a>
<a class="sourceLine" id="cb19-18" title="18">                           <span class="dt">Right</span> (_, _, x) <span class="ot">-&gt;</span> <span class="fu">pure</span> x</a>
<a class="sourceLine" id="cb19-19" title="19">                           <span class="dt">Left</span> (_, _, e) <span class="ot">-&gt;</span> <span class="fu">fail</span> <span class="fu">$</span> <span class="st">&quot;error reading data (&quot;</span></a>
<a class="sourceLine" id="cb19-20" title="20">                                                    <span class="fu">&lt;&gt;</span> <span class="fu">show</span> dataSize</a>
<a class="sourceLine" id="cb19-21" title="21">                                                    <span class="fu">&lt;&gt;</span> <span class="st">&quot; bytes starting at &quot;</span></a>
<a class="sourceLine" id="cb19-22" title="22">                                                    <span class="fu">&lt;&gt;</span> <span class="fu">show</span> dataOffset</a>
<a class="sourceLine" id="cb19-23" title="23">                                                    <span class="fu">&lt;&gt;</span> <span class="st">&quot;) for directory entry '&quot;</span></a>
<a class="sourceLine" id="cb19-24" title="24">                                                    <span class="fu">&lt;&gt;</span> Txt.unpack tagName</a>
<a class="sourceLine" id="cb19-25" title="25">                                                    <span class="fu">&lt;&gt;</span> <span class="st">&quot;': &quot;</span></a>
<a class="sourceLine" id="cb19-26" title="26">                                                    <span class="fu">&lt;&gt;</span> e</a>
<a class="sourceLine" id="cb19-27" title="27"></a>
<a class="sourceLine" id="cb19-28" title="28">  <span class="kw">let</span> (elemType, elemCode) <span class="fu">=</span> describeElemType typeCode</a>
<a class="sourceLine" id="cb19-29" title="29">  <span class="fu">pure</span> <span class="dt">Directory</span> { dTagName <span class="fu">=</span> tagName </a>
<a class="sourceLine" id="cb19-30" title="30">                 , dTagNum <span class="fu">=</span> tagNum </a>
<a class="sourceLine" id="cb19-31" title="31">                 , dElemTypeCode <span class="fu">=</span> typeCode </a>
<a class="sourceLine" id="cb19-32" title="32">                 , dElemTypeDesc <span class="fu">=</span> elemCode </a>
<a class="sourceLine" id="cb19-33" title="33">                 , dElemType <span class="fu">=</span> elemType </a>
<a class="sourceLine" id="cb19-34" title="34">                 , dElemSize <span class="fu">=</span> elemSize </a>
<a class="sourceLine" id="cb19-35" title="35">                 , dElemNum <span class="fu">=</span> elemNum </a>
<a class="sourceLine" id="cb19-36" title="36">                 , dDataSize <span class="fu">=</span> dataSize </a>
<a class="sourceLine" id="cb19-37" title="37">                 , dDataOffset <span class="fu">=</span> dataOffset </a>
<a class="sourceLine" id="cb19-38" title="38">                 , dData <span class="fu">=</span> dataBytes </a>
<a class="sourceLine" id="cb19-39" title="39">                 , dDataDebug <span class="fu">=</span> []</a>
<a class="sourceLine" id="cb19-40" title="40">                 } </a></code></pre></div>
<h3 id="reading-strings">Reading strings</h3>
<ul>
<li>A <code>PString</code> is prefixed with an <code>Int8</code> size. So read the size and then the string</li>
<li>A <code>CString</code> is null terminated, so read all the data for the length of the string (from the directory entry) and drop the final null character.</li>
</ul>
<h6 id="srchyraxabifread.hs-194-to-204">src/Hyrax/Abif/Read.hs (194 to 204)</h6>
<div class="sourceCode" id="cb20"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb20-1" title="1"><span class="co">-- | Parse a 'ElemPString'</span></a>
<a class="sourceLine" id="cb20-2" title="2"><span class="ot">getPString ::</span> <span class="dt">B.Get</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb20-3" title="3">getPString <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb20-4" title="4">  sz <span class="ot">&lt;-</span> <span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> B.getInt8</a>
<a class="sourceLine" id="cb20-5" title="5">  TxtE.decodeUtf8 <span class="fu">&lt;$&gt;</span> B.label (<span class="st">&quot;PString length=&quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> sz <span class="fu">&lt;&gt;</span> <span class="st">&quot;.&quot;</span>) (B.getByteString sz)</a>
<a class="sourceLine" id="cb20-6" title="6"></a>
<a class="sourceLine" id="cb20-7" title="7"></a>
<a class="sourceLine" id="cb20-8" title="8"><span class="co">-- | Parse a 'ElemCString'</span></a>
<a class="sourceLine" id="cb20-9" title="9"><span class="ot">getCString ::</span> <span class="dt">Int</span> <span class="ot">-&gt;</span> <span class="dt">B.Get</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb20-10" title="10">getCString sz <span class="fu">=</span> </a>
<a class="sourceLine" id="cb20-11" title="11">  TxtE.decodeUtf8 <span class="fu">&lt;$&gt;</span> B.getByteString (sz <span class="fu">-</span> <span class="dv">1</span>)</a></code></pre></div>
<h3 id="debug-info">Debug info</h3>
<p>getDebug adds human readable information for some types, e.g. for strings. This lets us print the <code>Abif</code> structure to the console with some useful data. Only a portion of <code>getDebug</code> is show here as it is a little repetitive. However it is a good function to look at to see more examples of reading the raw data.</p>
<h6 id="srchyraxabifread.hs-94-to-112">src/Hyrax/Abif/Read.hs (94 to 112)</h6>
<div class="sourceCode" id="cb21"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb21-1" title="1"><span class="co">-- | Populate the directory entry with debug data (into 'dDataDebug').</span></a>
<a class="sourceLine" id="cb21-2" title="2"><span class="co">-- This is done for selected types only, e.g. for strings so that printing the structure will display</span></a>
<a class="sourceLine" id="cb21-3" title="3"><span class="co">-- readable/meaningfull info</span></a>
<a class="sourceLine" id="cb21-4" title="4"><span class="ot">getDebug ::</span> <span class="dt">Directory</span> <span class="ot">-&gt;</span> <span class="dt">Directory</span></a>
<a class="sourceLine" id="cb21-5" title="5">getDebug d <span class="fu">=</span></a>
<a class="sourceLine" id="cb21-6" title="6">  <span class="kw">let</span> bsAtOffset <span class="fu">=</span> dData d <span class="kw">in</span></a>
<a class="sourceLine" id="cb21-7" title="7">  </a>
<a class="sourceLine" id="cb21-8" title="8">  <span class="kw">case</span> dElemType d <span class="kw">of</span></a>
<a class="sourceLine" id="cb21-9" title="9">    <span class="co">-- Strings have a count = number of chars, not number of &quot;strings&quot;</span></a>
<a class="sourceLine" id="cb21-10" title="10">    <span class="dt">ElemPString</span> <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb21-11" title="11">      <span class="kw">if</span> dDataSize d <span class="fu">&lt;=</span> <span class="dv">4</span></a>
<a class="sourceLine" id="cb21-12" title="12">      <span class="kw">then</span> d { dDataDebug <span class="fu">=</span> [TxtE.decodeUtf8 <span class="fu">.</span> BSL.toStrict <span class="fu">.</span> BSL.drop <span class="dv">1</span> <span class="fu">.</span> BSL.take (<span class="fu">fromIntegral</span> <span class="fu">$</span> dDataSize d) <span class="fu">$</span> dData d] }</a>
<a class="sourceLine" id="cb21-13" title="13">      <span class="kw">else</span> d { dDataDebug <span class="fu">=</span> [B.runGet (lbl getPString) bsAtOffset] }</a>
<a class="sourceLine" id="cb21-14" title="14"></a>
<a class="sourceLine" id="cb21-15" title="15">    <span class="co">-- Strings have a count = number of chars, not number of &quot;strings&quot;</span></a>
<a class="sourceLine" id="cb21-16" title="16">    <span class="dt">ElemCString</span> <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb21-17" title="17">      <span class="kw">if</span> dDataSize d <span class="fu">&lt;=</span> <span class="dv">4</span></a>
<a class="sourceLine" id="cb21-18" title="18">      <span class="kw">then</span> d { dDataDebug <span class="fu">=</span> [TxtE.decodeUtf8 <span class="fu">.</span> BSL.toStrict <span class="fu">.</span> BSL.take (<span class="fu">fromIntegral</span> <span class="fu">$</span> dDataSize d <span class="fu">-</span> <span class="dv">1</span>) <span class="fu">$</span> dData d] }</a>
<a class="sourceLine" id="cb21-19" title="19">      <span class="kw">else</span> d { dDataDebug <span class="fu">=</span> [B.runGet (lbl <span class="fu">.</span> getCString <span class="fu">$</span> dDataSize d) bsAtOffset] }</a></code></pre></div>
<p>When printing the structure it does not make sense to print all the raw data too. So the <code>clear*</code> functions remove that before printing</p>
<h6 id="srchyraxabifread.hs-80-to-89">src/Hyrax/Abif/Read.hs (80 to 89)</h6>
<div class="sourceCode" id="cb22"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb22-1" title="1"><span class="co">-- | Removes all data from the ABIF's directories</span></a>
<a class="sourceLine" id="cb22-2" title="2"><span class="ot">clearAbif ::</span> <span class="dt">Abif</span> <span class="ot">-&gt;</span> <span class="dt">Abif</span></a>
<a class="sourceLine" id="cb22-3" title="3">clearAbif a <span class="fu">=</span> a { aRootDir <span class="fu">=</span> clear <span class="fu">$</span> aRootDir a</a>
<a class="sourceLine" id="cb22-4" title="4">                , aDirs <span class="fu">=</span> clear <span class="fu">&lt;$&gt;</span> aDirs a</a>
<a class="sourceLine" id="cb22-5" title="5">                }</a>
<a class="sourceLine" id="cb22-6" title="6"></a>
<a class="sourceLine" id="cb22-7" title="7"></a>
<a class="sourceLine" id="cb22-8" title="8"><span class="co">-- | Removes all data from a directory entry. This will probably only be useful when trying to show an ABIF value</span></a>
<a class="sourceLine" id="cb22-9" title="9"><span class="ot">clear ::</span> <span class="dt">Directory</span> <span class="ot">-&gt;</span> <span class="dt">Directory</span></a>
<a class="sourceLine" id="cb22-10" title="10">clear d <span class="fu">=</span> d { dData <span class="fu">=</span> <span class="st">&quot;&quot;</span> }</a></code></pre></div>
<h2 id="hyrax.abif.write">Hyrax.Abif.Write</h2>
<p>As with the read functions there are two write functions for writing to <code>ByteString</code> or to a file.</p>
<h6 id="srchyraxabifwrite.hs-54-to-64">src/Hyrax/Abif/Write.hs (54 to 64)</h6>
<div class="sourceCode" id="cb23"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb23-1" title="1"><span class="co">-- | Write an 'Abif' to a 'ByteString'</span></a>
<a class="sourceLine" id="cb23-2" title="2"><span class="ot">createAbifBytes ::</span> <span class="dt">Abif</span> <span class="ot">-&gt;</span> <span class="dt">BSL.ByteString</span></a>
<a class="sourceLine" id="cb23-3" title="3">createAbifBytes ab1 <span class="fu">=</span></a>
<a class="sourceLine" id="cb23-4" title="4">  B.runPut (putAbif ab1)</a>
<a class="sourceLine" id="cb23-5" title="5"></a>
<a class="sourceLine" id="cb23-6" title="6">  </a>
<a class="sourceLine" id="cb23-7" title="7"><span class="co">-- | Write an 'Abif' to a file</span></a>
<a class="sourceLine" id="cb23-8" title="8"><span class="ot">writeAbif ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">Abif</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb23-9" title="9">writeAbif destPath ab1 <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb23-10" title="10">  <span class="kw">let</span> b <span class="fu">=</span> createAbifBytes ab1</a>
<a class="sourceLine" id="cb23-11" title="11">  BS.writeFile destPath <span class="fu">$</span> BSL.toStrict b</a></code></pre></div>
<p>Writing the ABIF data is relatively simple since each directory entry already contains the <code>ByteString</code> raw data. <code>putAbif</code> does need to recalculate the data size though</p>
<h6 id="srchyraxabifwrite.hs-69-to-98">src/Hyrax/Abif/Write.hs (69 to 98)</h6>
<div class="sourceCode" id="cb24"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb24-1" title="1"><span class="co">-- | Create the 'Abif' using &quot;Data.Binary&quot;</span></a>
<a class="sourceLine" id="cb24-2" title="2"><span class="ot">putAbif ::</span> <span class="dt">Abif</span> <span class="ot">-&gt;</span> <span class="dt">B.Put</span></a>
<a class="sourceLine" id="cb24-3" title="3">putAbif (<span class="dt">Abif</span> header root dirs) <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb24-4" title="4">  <span class="co">-- Total data size</span></a>
<a class="sourceLine" id="cb24-5" title="5">  <span class="kw">let</span> dataSize <span class="fu">=</span> foldl' (\acc i <span class="ot">-&gt;</span> <span class="kw">if</span> i <span class="fu">&gt;</span> <span class="dv">4</span> <span class="kw">then</span> acc <span class="fu">+</span> i <span class="kw">else</span> acc) <span class="dv">0</span> <span class="fu">$</span> dDataSize <span class="fu">&lt;$&gt;</span> dirs</a>
<a class="sourceLine" id="cb24-6" title="6">  </a>
<a class="sourceLine" id="cb24-7" title="7">  <span class="co">-- Write the header</span></a>
<a class="sourceLine" id="cb24-8" title="8">  putHeader header</a>
<a class="sourceLine" id="cb24-9" title="9"></a>
<a class="sourceLine" id="cb24-10" title="10">  <span class="co">-- Data starts at offset 128</span></a>
<a class="sourceLine" id="cb24-11" title="11">  <span class="kw">let</span> startDataOffset <span class="fu">=</span> <span class="dv">128</span></a>
<a class="sourceLine" id="cb24-12" title="12">  <span class="co">-- Write the root directory entry</span></a>
<a class="sourceLine" id="cb24-13" title="13">  putDirectory (startDataOffset <span class="fu">+</span> dataSize) <span class="fu">$</span> root { dDataSize <span class="fu">=</span> <span class="dv">28</span> <span class="fu">*</span> <span class="fu">length</span> dirs</a>
<a class="sourceLine" id="cb24-14" title="14">                                                   , dElemNum <span class="fu">=</span> <span class="fu">length</span> dirs</a>
<a class="sourceLine" id="cb24-15" title="15">                                                   }</a>
<a class="sourceLine" id="cb24-16" title="16"></a>
<a class="sourceLine" id="cb24-17" title="17">  <span class="co">-- Write 47 zero Int16 values as required by the spec</span></a>
<a class="sourceLine" id="cb24-18" title="18">  traverse_ B.putInt16be <span class="fu">$</span> <span class="fu">replicate</span> <span class="dv">47</span> <span class="dv">0</span></a>
<a class="sourceLine" id="cb24-19" title="19">  <span class="co">-- Write the data, for all data larger than four bytes. Data four bytes or less is stored</span></a>
<a class="sourceLine" id="cb24-20" title="20">  <span class="co">--  in the offset field</span></a>
<a class="sourceLine" id="cb24-21" title="21">  traverse_ (B.putLazyByteString <span class="fu">.</span> dData) <span class="fu">$</span> <span class="fu">filter</span> (\d <span class="ot">-&gt;</span> dDataSize d <span class="fu">&gt;</span> <span class="dv">4</span>) dirs</a>
<a class="sourceLine" id="cb24-22" title="22">  <span class="co">-- Write the directory entries. </span></a>
<a class="sourceLine" id="cb24-23" title="23">  foldM_ writeDir startDataOffset dirs</a>
<a class="sourceLine" id="cb24-24" title="24"></a>
<a class="sourceLine" id="cb24-25" title="25">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb24-26" title="26">    writeDir offset dir <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb24-27" title="27">      putDirectory offset dir</a>
<a class="sourceLine" id="cb24-28" title="28">      <span class="fu">pure</span> <span class="fu">$</span> <span class="kw">if</span> dDataSize dir <span class="fu">&gt;</span> <span class="dv">4</span></a>
<a class="sourceLine" id="cb24-29" title="29">             <span class="kw">then</span> offset <span class="fu">+</span> dDataSize dir</a>
<a class="sourceLine" id="cb24-30" title="30">             <span class="kw">else</span> offset</a></code></pre></div>
<ul>
<li>The total data size is calculated. It is the sum of all the non-root directory entries where the data is not stored in the offset field (i.e. where data size &gt; 4 bytes)</li>
<li>The data will starting being written at offset 128, i.e. immediately after the header and root directory entry</li>
<li>Add the root directory</li>
<li>Write the 47 zeros required by the spec</li>
<li>Write all the data from each of the directory entries</li>
<li>Write the directory entries, incrementing the offset for each entry with data &gt; 4 bytes</li>
</ul>
<h3 id="header">Header</h3>
<p>Writing the header is pretty simple, write the magic string and version number.</p>
<h6 id="srchyraxabifwrite.hs-117-to-121">src/Hyrax/Abif/Write.hs (117 to 121)</h6>
<div class="sourceCode" id="cb25"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb25-1" title="1"><span class="co">-- | Write a 'Header'</span></a>
<a class="sourceLine" id="cb25-2" title="2"><span class="ot">putHeader ::</span> <span class="dt">Header</span> <span class="ot">-&gt;</span> <span class="dt">B.Put</span></a>
<a class="sourceLine" id="cb25-3" title="3">putHeader h <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb25-4" title="4">  putTextStr <span class="fu">$</span> hName h</a>
<a class="sourceLine" id="cb25-5" title="5">  B.putInt16be <span class="fu">.</span> <span class="fu">fromIntegral</span> <span class="fu">$</span> hVersion h</a></code></pre></div>
<h3 id="strings">Strings</h3>
<p>There are two functions for writing <code>Text</code> values</p>
<h6 id="srchyraxabifwrite.hs-103-to-112">src/Hyrax/Abif/Write.hs (103 to 112)</h6>
<div class="sourceCode" id="cb26"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb26-1" title="1"><span class="co">-- | Write 'Text'</span></a>
<a class="sourceLine" id="cb26-2" title="2"><span class="ot">putTextStr ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">B.Put</span></a>
<a class="sourceLine" id="cb26-3" title="3">putTextStr t <span class="fu">=</span> B.putByteString <span class="fu">$</span> TxtE.encodeUtf8 t</a>
<a class="sourceLine" id="cb26-4" title="4"></a>
<a class="sourceLine" id="cb26-5" title="5"></a>
<a class="sourceLine" id="cb26-6" title="6"><span class="co">-- | Write a 'ElemPString'</span></a>
<a class="sourceLine" id="cb26-7" title="7"><span class="ot">putPStr ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">B.Put</span></a>
<a class="sourceLine" id="cb26-8" title="8">putPStr t <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb26-9" title="9">  B.putInt8 <span class="fu">.</span> <span class="fu">fromIntegral</span> <span class="fu">$</span> Txt.length t</a>
<a class="sourceLine" id="cb26-10" title="10">  B.putByteString <span class="fu">$</span> TxtE.encodeUtf8 t</a></code></pre></div>
<h3 id="directory">Directory</h3>
<p>When writing a directory there a few things to take care of</p>
<ul>
<li>Ensure that the directory name is exactly 4 bytes long</li>
<li>Write the offset for data &gt; 4 bytes</li>
<li>Write the data to the offset field if it is &lt;= 4 bytes, ensure it is exactly 4 bytes long on disk</li>
<li>Append the reserved zero value</li>
</ul>
<h6 id="srchyraxabifwrite.hs-126-to-142">src/Hyrax/Abif/Write.hs (126 to 142)</h6>
<div class="sourceCode" id="cb27"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb27-1" title="1"><span class="co">-- | Write a 'Directory'</span></a>
<a class="sourceLine" id="cb27-2" title="2"><span class="ot">putDirectory ::</span> <span class="dt">Int</span> <span class="ot">-&gt;</span> <span class="dt">Directory</span> <span class="ot">-&gt;</span> <span class="dt">B.Put</span></a>
<a class="sourceLine" id="cb27-3" title="3">putDirectory dirOffset d <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb27-4" title="4">  <span class="kw">let</span> name <span class="fu">=</span> Txt.justifyLeft <span class="dv">4</span> <span class="ch">' '</span> <span class="fu">.</span> Txt.take <span class="dv">4</span> <span class="fu">$</span> dTagName d</a>
<a class="sourceLine" id="cb27-5" title="5">  putTextStr name</a>
<a class="sourceLine" id="cb27-6" title="6">  B.putInt32be <span class="fu">.</span> <span class="fu">fromIntegral</span> <span class="fu">$</span> dTagNum d</a>
<a class="sourceLine" id="cb27-7" title="7">  B.putInt16be <span class="fu">.</span> <span class="fu">fromIntegral</span> <span class="fu">$</span> dElemTypeCode d</a>
<a class="sourceLine" id="cb27-8" title="8">  B.putInt16be <span class="fu">.</span> <span class="fu">fromIntegral</span> <span class="fu">$</span> dElemSize d</a>
<a class="sourceLine" id="cb27-9" title="9">  B.putInt32be <span class="fu">.</span> <span class="fu">fromIntegral</span> <span class="fu">$</span> dElemNum d</a>
<a class="sourceLine" id="cb27-10" title="10">  B.putInt32be <span class="fu">.</span> <span class="fu">fromIntegral</span> <span class="fu">$</span> dDataSize d</a>
<a class="sourceLine" id="cb27-11" title="11"></a>
<a class="sourceLine" id="cb27-12" title="12">  <span class="co">-- data with a size &gt;= 4 are written in the offset</span></a>
<a class="sourceLine" id="cb27-13" title="13">  <span class="kw">if</span> dDataSize d <span class="fu">&gt;</span> <span class="dv">4</span></a>
<a class="sourceLine" id="cb27-14" title="14">    <span class="kw">then</span> B.putInt32be <span class="fu">.</span> <span class="fu">fromIntegral</span> <span class="fu">$</span> dirOffset</a>
<a class="sourceLine" id="cb27-15" title="15">    <span class="kw">else</span> B.putLazyByteString <span class="fu">.</span> BSL.take <span class="dv">4</span> <span class="fu">$</span> dData d <span class="fu">&lt;&gt;</span> <span class="st">&quot;\0\0\0\0&quot;</span></a>
<a class="sourceLine" id="cb27-16" title="16"></a>
<a class="sourceLine" id="cb27-17" title="17">  B.putInt32be <span class="dv">0</span> <span class="co">-- reserved / datahandle</span></a></code></pre></div>
<h3 id="mk-helper-functions">mk* helper functions</h3>
<p>The <code>mk*</code> set of functions help in constructing valid directory entries.</p>
<p>Below are two of these functions</p>
<ul>
<li><code>mkBaseOrder</code> which creates a FWO_ Directory entry.</li>
<li><code>mkLane</code> which creates a LANE Directory entry.</li>
</ul>
<p>As you can see these functions take appropriately typed values in and produce a valid directory entry for the data and directory type. (See <code>Hyrax.Abif.Generate</code> to see them in use)</p>
<h6 id="srchyraxabifwrite.hs-48-to-49">src/Hyrax/Abif/Write.hs (48 to 49)</h6>
<div class="sourceCode" id="cb28"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb28-1" title="1"><span class="co">-- | Used to specify the base order for the FWO directry entry, see 'mkBaseOrder'</span></a>
<a class="sourceLine" id="cb28-2" title="2"><span class="kw">data</span> <span class="dt">Base</span> <span class="fu">=</span> <span class="dt">BaseA</span> <span class="fu">|</span> <span class="dt">BaseC</span> <span class="fu">|</span> <span class="dt">BaseG</span> <span class="fu">|</span> <span class="dt">BaseT</span></a></code></pre></div>
<h6 id="srchyraxabifwrite.hs-208-to-244">src/Hyrax/Abif/Write.hs (208 to 244)</h6>
<div class="sourceCode" id="cb29"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb29-1" title="1"><span class="co">-- | Create a base order (FWO_) 'Directory' entry data</span></a>
<a class="sourceLine" id="cb29-2" title="2"><span class="ot">mkBaseOrder ::</span> <span class="dt">Base</span> <span class="ot">-&gt;</span> <span class="dt">Base</span> <span class="ot">-&gt;</span> <span class="dt">Base</span> <span class="ot">-&gt;</span> <span class="dt">Base</span> <span class="ot">-&gt;</span> <span class="dt">Directory</span></a>
<a class="sourceLine" id="cb29-3" title="3">mkBaseOrder w x y z <span class="fu">=</span></a>
<a class="sourceLine" id="cb29-4" title="4">  <span class="dt">Directory</span> { dTagName <span class="fu">=</span> <span class="st">&quot;FWO_&quot;</span> <span class="co">-- Base order</span></a>
<a class="sourceLine" id="cb29-5" title="5">            , dTagNum <span class="fu">=</span> <span class="dv">1</span></a>
<a class="sourceLine" id="cb29-6" title="6">            , dElemTypeCode <span class="fu">=</span> <span class="dv">2</span></a>
<a class="sourceLine" id="cb29-7" title="7">            , dElemTypeDesc <span class="fu">=</span> <span class="st">&quot;char&quot;</span></a>
<a class="sourceLine" id="cb29-8" title="8">            , dElemType <span class="fu">=</span> <span class="dt">ElemChar</span></a>
<a class="sourceLine" id="cb29-9" title="9">            , dElemSize <span class="fu">=</span> <span class="dv">1</span></a>
<a class="sourceLine" id="cb29-10" title="10">            , dDataOffset <span class="fu">=</span> <span class="dv">0</span></a>
<a class="sourceLine" id="cb29-11" title="11">            , dDataDebug <span class="fu">=</span> []</a>
<a class="sourceLine" id="cb29-12" title="12">            , dData <span class="fu">=</span> getBase w <span class="fu">&lt;&gt;</span> getBase x <span class="fu">&lt;&gt;</span> getBase y <span class="fu">&lt;&gt;</span> getBase z</a>
<a class="sourceLine" id="cb29-13" title="13">            , dDataSize <span class="fu">=</span> <span class="dv">4</span></a>
<a class="sourceLine" id="cb29-14" title="14">            , dElemNum <span class="fu">=</span> <span class="dv">4</span></a>
<a class="sourceLine" id="cb29-15" title="15">            }</a>
<a class="sourceLine" id="cb29-16" title="16">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb29-17" title="17">    getBase <span class="dt">BaseA</span> <span class="fu">=</span> <span class="st">&quot;A&quot;</span></a>
<a class="sourceLine" id="cb29-18" title="18">    getBase <span class="dt">BaseC</span> <span class="fu">=</span> <span class="st">&quot;C&quot;</span></a>
<a class="sourceLine" id="cb29-19" title="19">    getBase <span class="dt">BaseG</span> <span class="fu">=</span> <span class="st">&quot;G&quot;</span></a>
<a class="sourceLine" id="cb29-20" title="20">    getBase <span class="dt">BaseT</span> <span class="fu">=</span> <span class="st">&quot;T&quot;</span></a>
<a class="sourceLine" id="cb29-21" title="21"></a>
<a class="sourceLine" id="cb29-22" title="22"></a>
<a class="sourceLine" id="cb29-23" title="23"><span class="co">-- | Create a lane (LANE) 'Directory' entry and data</span></a>
<a class="sourceLine" id="cb29-24" title="24"><span class="ot">mkLane ::</span> <span class="dt">Int16</span> <span class="ot">-&gt;</span> <span class="dt">Directory</span></a>
<a class="sourceLine" id="cb29-25" title="25">mkLane lane <span class="fu">=</span></a>
<a class="sourceLine" id="cb29-26" title="26">  <span class="dt">Directory</span> { dTagName <span class="fu">=</span> <span class="st">&quot;LANE&quot;</span> <span class="co">-- Lane or capliary number</span></a>
<a class="sourceLine" id="cb29-27" title="27">            , dTagNum <span class="fu">=</span> <span class="dv">1</span></a>
<a class="sourceLine" id="cb29-28" title="28">            , dElemTypeCode <span class="fu">=</span> <span class="dv">4</span></a>
<a class="sourceLine" id="cb29-29" title="29">            , dElemTypeDesc <span class="fu">=</span> <span class="st">&quot;short&quot;</span></a>
<a class="sourceLine" id="cb29-30" title="30">            , dElemType <span class="fu">=</span> <span class="dt">ElemShort</span></a>
<a class="sourceLine" id="cb29-31" title="31">            , dElemSize <span class="fu">=</span> <span class="dv">2</span></a>
<a class="sourceLine" id="cb29-32" title="32">            , dElemNum <span class="fu">=</span> <span class="dv">1</span></a>
<a class="sourceLine" id="cb29-33" title="33">            , dDataSize <span class="fu">=</span> <span class="dv">2</span></a>
<a class="sourceLine" id="cb29-34" title="34">            , dDataOffset <span class="fu">=</span> <span class="dv">0</span></a>
<a class="sourceLine" id="cb29-35" title="35">            , dData <span class="fu">=</span> B.runPut <span class="fu">$</span> B.putInt16be lane</a>
<a class="sourceLine" id="cb29-36" title="36">            , dDataDebug <span class="fu">=</span> []</a>
<a class="sourceLine" id="cb29-37" title="37">            }</a></code></pre></div>
<p>See the code or haddock for the full set of mk* functions.</p>
<h3 id="adding-a-directory">Adding a directory</h3>
<p><code>addDirectory</code> appends a directory entry to an existing <code>Abif</code>. See the examples to see this in use.</p>
<h6 id="srchyraxabifwrite.hs-346-to-349">src/Hyrax/Abif/Write.hs (346 to 349)</h6>
<div class="sourceCode" id="cb30"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb30-1" title="1"><span class="co">-- | Add a directory to an 'Abif'</span></a>
<a class="sourceLine" id="cb30-2" title="2"><span class="ot">addDirectory ::</span> <span class="dt">Abif</span> <span class="ot">-&gt;</span> <span class="dt">Directory</span> <span class="ot">-&gt;</span> <span class="dt">Abif</span></a>
<a class="sourceLine" id="cb30-3" title="3">addDirectory abif dir <span class="fu">=</span></a>
<a class="sourceLine" id="cb30-4" title="4">  abif { aDirs <span class="fu">=</span> aDirs abif <span class="fu">&lt;&gt;</span> [dir] }</a></code></pre></div>
<h2 id="hyrax.abif.generate-and-hyrax.abif.fasta">Hyrax.Abif.Generate and Hyrax.Abif.Fasta</h2>
<p>Generating ABIFs is the main purpose of this package and the code to do this is in <code>Hyrax.Abif.Generate</code>. There is less than 200 lines of code, but I’ll go through how it works in some detail.</p>
<p><code>generateAb1</code> is the main function in this module, it controls the flow of generating a single ABIF. It has the following high level concerns</p>
<ol type="1">
<li>Generate the traces per base from the weighted FASTA</li>
<li>Generate the peak locations</li>
<li>Generate the directories</li>
<li>Create the ABIF</li>
</ol>
<h6 id="srchyraxabifgenerate.hs-131-to-171">src/Hyrax/Abif/Generate.hs (131 to 171)</h6>
<div class="sourceCode" id="cb31"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb31-1" title="1"><span class="co">-- | Create the 'ByteString' data for an AB1 given the data from a weighted FASTA (see 'readWeightedFasta')</span></a>
<a class="sourceLine" id="cb31-2" title="2"><span class="ot">generateAb1 ::</span> (<span class="dt">Text</span>, [(<span class="dt">Double</span>, <span class="dt">Text</span>)]) <span class="ot">-&gt;</span> <span class="dt">BSL.ByteString</span></a>
<a class="sourceLine" id="cb31-3" title="3">generateAb1 (fName, sourceFasta) <span class="fu">=</span> </a>
<a class="sourceLine" id="cb31-4" title="4">  <span class="kw">let</span></a>
<a class="sourceLine" id="cb31-5" title="5">    tr <span class="fu">=</span> generateTraceData sourceFasta</a>
<a class="sourceLine" id="cb31-6" title="6">    valsPerBase <span class="fu">=</span> trValsPerBase tr</a>
<a class="sourceLine" id="cb31-7" title="7">    generatedFastaLen <span class="fu">=</span> (Txt.length <span class="fu">$</span> trFasta tr)</a>
<a class="sourceLine" id="cb31-8" title="8"></a>
<a class="sourceLine" id="cb31-9" title="9">    <span class="co">-- The point that is the peak of the trace, i.e. mid point of trace for a single base</span></a>
<a class="sourceLine" id="cb31-10" title="10">    midPeek <span class="fu">=</span> valsPerBase <span class="ot">`div`</span> <span class="dv">2</span></a>
<a class="sourceLine" id="cb31-11" title="11">    <span class="co">-- Get the peak locations for all bases</span></a>
<a class="sourceLine" id="cb31-12" title="12">    peakLocations <span class="fu">=</span> <span class="fu">take</span> generatedFastaLen [midPeek, valsPerBase <span class="fu">+</span> midPeek<span class="fu">..</span>]</a>
<a class="sourceLine" id="cb31-13" title="13"></a>
<a class="sourceLine" id="cb31-14" title="14">    <span class="co">-- Sample name (from the FASTA name)</span></a>
<a class="sourceLine" id="cb31-15" title="15">    sampleName <span class="fu">=</span> <span class="fu">fst</span> <span class="fu">.</span> Txt.breakOn <span class="st">&quot;_&quot;</span> <span class="fu">$</span> fName</a>
<a class="sourceLine" id="cb31-16" title="16"></a>
<a class="sourceLine" id="cb31-17" title="17">    <span class="co">-- Create the ABIF directories</span></a>
<a class="sourceLine" id="cb31-18" title="18">    dirs <span class="fu">=</span> [ mkData  <span class="dv">9</span> <span class="fu">$</span> trData09G tr <span class="co">-- G</span></a>
<a class="sourceLine" id="cb31-19" title="19">           , mkData <span class="dv">10</span> <span class="fu">$</span> trData10A tr <span class="co">-- A</span></a>
<a class="sourceLine" id="cb31-20" title="20">           , mkData <span class="dv">11</span> <span class="fu">$</span> trData11T tr <span class="co">-- T</span></a>
<a class="sourceLine" id="cb31-21" title="21">           , mkData <span class="dv">12</span> <span class="fu">$</span> trData12C tr <span class="co">-- C</span></a>
<a class="sourceLine" id="cb31-22" title="22">           , mkBaseOrder <span class="dt">BaseG</span> <span class="dt">BaseA</span> <span class="dt">BaseT</span> <span class="dt">BaseC</span> <span class="co">-- Base order, should be GATC for 3500</span></a>
<a class="sourceLine" id="cb31-23" title="23">           , mkLane <span class="dv">1</span> <span class="co">-- Lane or capliary number</span></a>
<a class="sourceLine" id="cb31-24" title="24">           , mkCalledBases <span class="fu">$</span> trFasta tr <span class="co">-- Called bases</span></a>
<a class="sourceLine" id="cb31-25" title="25">           , mkMobilityFileName <span class="dv">1</span> <span class="st">&quot;KB_3500_POP7_BDTv3.mob&quot;</span> <span class="co">-- Mobility file name</span></a>
<a class="sourceLine" id="cb31-26" title="26">           , mkMobilityFileName <span class="dv">2</span> <span class="st">&quot;KB_3500_POP7_BDTv3.mob&quot;</span> <span class="co">-- Mobility file name</span></a>
<a class="sourceLine" id="cb31-27" title="27">           , mkPeakLocations <span class="fu">$</span> <span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> peakLocations <span class="co">-- Peak locations</span></a>
<a class="sourceLine" id="cb31-28" title="28">           , mkDyeSignalStrength <span class="dv">53</span> <span class="dv">75</span> <span class="dv">79</span> <span class="dv">48</span> <span class="co">-- Signal strength per dye</span></a>
<a class="sourceLine" id="cb31-29" title="29">           , mkSampleName sampleName  <span class="co">-- Sample name</span></a>
<a class="sourceLine" id="cb31-30" title="30">           , mkComment <span class="st">&quot;Generated by HyraxBio AB1 generator&quot;</span></a>
<a class="sourceLine" id="cb31-31" title="31">           ]</a>
<a class="sourceLine" id="cb31-32" title="32"></a>
<a class="sourceLine" id="cb31-33" title="33">    <span class="co">-- The ABIF</span></a>
<a class="sourceLine" id="cb31-34" title="34">    abif <span class="fu">=</span> <span class="dt">Abif</span> { aHeader <span class="fu">=</span> mkHeader</a>
<a class="sourceLine" id="cb31-35" title="35">                , aRootDir <span class="fu">=</span> mkRoot</a>
<a class="sourceLine" id="cb31-36" title="36">                , aDirs <span class="fu">=</span> dirs</a>
<a class="sourceLine" id="cb31-37" title="37">                }</a>
<a class="sourceLine" id="cb31-38" title="38">            </a>
<a class="sourceLine" id="cb31-39" title="39">  <span class="kw">in</span></a>
<a class="sourceLine" id="cb31-40" title="40">  <span class="co">-- Generate the data</span></a>
<a class="sourceLine" id="cb31-41" title="41">  B.runPut (putAbif abif)</a></code></pre></div>
<h3 id="a-quick-detour---reading-the-weighted-fasta">A quick detour - Reading the weighted FASTA</h3>
<p><code>readWeightedFasta</code> reads the contents of a single weighted <code>.fasta</code> file. (<em>Unless you are interested in how the FASTA parsing works, you can skip this and go to the next section. Just have a look at what the types represent</em>).</p>
<p>The parsed content has the type <code>[('Double', 'Text')]</code>, which stores the data like this</p>
<pre class="text"><code>[('Double', 'Text')]
   ^         ^
   |         |
   |         +---- read
   |
   +---- weight        </code></pre>
<p>i.e. an array of weights together with the sequence at that weight.</p>
<h6 id="srchyraxabifgenerate.hs-265-to-290">src/Hyrax/Abif/Generate.hs (265 to 290)</h6>
<div class="sourceCode" id="cb33"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb33-1" title="1"><span class="ot">readWeightedFasta ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> <span class="dt">Either</span> <span class="dt">Text</span> [(<span class="dt">Double</span>, <span class="dt">Text</span>)]</a>
<a class="sourceLine" id="cb33-2" title="2">readWeightedFasta fastaData <span class="fu">=</span> </a>
<a class="sourceLine" id="cb33-3" title="3">  <span class="kw">case</span> parseFasta <span class="fu">$</span> TxtE.decodeUtf8 fastaData <span class="kw">of</span></a>
<a class="sourceLine" id="cb33-4" title="4">    <span class="dt">Left</span> e <span class="ot">-&gt;</span> <span class="dt">Left</span> e</a>
<a class="sourceLine" id="cb33-5" title="5">    <span class="dt">Right</span> fs <span class="ot">-&gt;</span> getWeightedFasta fs</a>
<a class="sourceLine" id="cb33-6" title="6"></a>
<a class="sourceLine" id="cb33-7" title="7">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb33-8" title="8"><span class="ot">    getWeightedFasta ::</span> [<span class="dt">Fasta</span>] <span class="ot">-&gt;</span> <span class="dt">Either</span> <span class="dt">Text</span> [(<span class="dt">Double</span>, <span class="dt">Text</span>)]</a>
<a class="sourceLine" id="cb33-9" title="9">    getWeightedFasta fs <span class="fu">=</span> </a>
<a class="sourceLine" id="cb33-10" title="10">      <span class="kw">case</span> <span class="fu">sequenceA</span> <span class="fu">$</span> readWeighted <span class="fu">&lt;$&gt;</span> fs <span class="kw">of</span></a>
<a class="sourceLine" id="cb33-11" title="11">        <span class="dt">Left</span> e <span class="ot">-&gt;</span> <span class="dt">Left</span> e</a>
<a class="sourceLine" id="cb33-12" title="12">        <span class="dt">Right</span> r <span class="ot">-&gt;</span> <span class="dt">Right</span> r</a>
<a class="sourceLine" id="cb33-13" title="13"></a>
<a class="sourceLine" id="cb33-14" title="14"><span class="ot">    readWeighted ::</span> <span class="dt">Fasta</span> <span class="ot">-&gt;</span> <span class="dt">Either</span> <span class="dt">Text</span> (<span class="dt">Double</span>, <span class="dt">Text</span>)</a>
<a class="sourceLine" id="cb33-15" title="15">    readWeighted (<span class="dt">Fasta</span> hdr' dta) <span class="fu">=</span></a>
<a class="sourceLine" id="cb33-16" title="16">      <span class="kw">let</span> (processNucs, hdr) <span class="fu">=</span></a>
<a class="sourceLine" id="cb33-17" title="17">            <span class="co">-- If there is a 'R' suffix, then generate a reverse sequence</span></a>
<a class="sourceLine" id="cb33-18" title="18">            <span class="co">--  Which means complement each nucleotide and then reverse the string</span></a>
<a class="sourceLine" id="cb33-19" title="19">            <span class="kw">if</span> Txt.isSuffixOf <span class="st">&quot;R&quot;</span> hdr'</a>
<a class="sourceLine" id="cb33-20" title="20">            <span class="kw">then</span> (Txt.reverse <span class="fu">.</span> complementNucleotides, Txt.strip <span class="fu">.</span> Txt.dropEnd <span class="dv">1</span> <span class="fu">$</span> hdr')</a>
<a class="sourceLine" id="cb33-21" title="21">            <span class="kw">else</span> (identity, hdr')</a>
<a class="sourceLine" id="cb33-22" title="22">      <span class="kw">in</span></a>
<a class="sourceLine" id="cb33-23" title="23">      </a>
<a class="sourceLine" id="cb33-24" title="24">      <span class="kw">case</span> (readMaybe <span class="fu">.</span> Txt.unpack <span class="fu">$</span><span class="ot"> hdr ::</span> <span class="dt">Maybe</span> <span class="dt">Double</span>) <span class="kw">of</span></a>
<a class="sourceLine" id="cb33-25" title="25">        <span class="dt">Just</span> weight <span class="ot">-&gt;</span> <span class="dt">Right</span> (<span class="fu">min</span> <span class="dv">1</span> <span class="fu">.</span> <span class="fu">max</span> <span class="dv">0</span> <span class="fu">$</span> weight, processNucs <span class="fu">$</span> Txt.strip dta)</a>
<a class="sourceLine" id="cb33-26" title="26">        <span class="dt">Nothing</span> <span class="ot">-&gt;</span> <span class="dt">Left</span> <span class="fu">$</span> <span class="st">&quot;Invalid header reading, expecting numeric weight, got: &quot;</span> <span class="fu">&lt;&gt;</span> hdr</a></code></pre></div>
<p>The FASTA is read and parsed in <code>Hyrax.Abif.Fasta</code>. Note that <code>readWeighted</code> handles the reverse read logic by calling <code>complementNucleotides</code> and then reversing the string. This section of the code is not entirely relevant for this discussion of the ABIF generation so I wont spend much time on it.</p>
<h6 id="srchyraxabifgenerate.hs-391-to-406">src/Hyrax/Abif/Generate.hs (391 to 406)</h6>
<div class="sourceCode" id="cb34"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb34-1" title="1"><span class="co">-- | Return the complement of a nucelotide string</span></a>
<a class="sourceLine" id="cb34-2" title="2"><span class="ot">complementNucleotides ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb34-3" title="3">complementNucleotides ns <span class="fu">=</span></a>
<a class="sourceLine" id="cb34-4" title="4">  <span class="kw">let</span></a>
<a class="sourceLine" id="cb34-5" title="5">    un <span class="fu">=</span> unIupac <span class="fu">&lt;$&gt;</span> Txt.unpack ns</a>
<a class="sourceLine" id="cb34-6" title="6">    comp <span class="fu">=</span> complementNuc <span class="fu">&lt;&lt;$&gt;&gt;</span> un</a>
<a class="sourceLine" id="cb34-7" title="7">    iu <span class="fu">=</span> iupac comp</a>
<a class="sourceLine" id="cb34-8" title="8">  <span class="kw">in</span></a>
<a class="sourceLine" id="cb34-9" title="9">  Txt.pack iu</a>
<a class="sourceLine" id="cb34-10" title="10"></a>
<a class="sourceLine" id="cb34-11" title="11">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb34-12" title="12">    complementNuc <span class="ch">'A'</span> <span class="fu">=</span> <span class="ch">'T'</span></a>
<a class="sourceLine" id="cb34-13" title="13">    complementNuc <span class="ch">'G'</span> <span class="fu">=</span> <span class="ch">'C'</span></a>
<a class="sourceLine" id="cb34-14" title="14">    complementNuc <span class="ch">'T'</span> <span class="fu">=</span> <span class="ch">'A'</span></a>
<a class="sourceLine" id="cb34-15" title="15">    complementNuc <span class="ch">'C'</span> <span class="fu">=</span> <span class="ch">'G'</span></a>
<a class="sourceLine" id="cb34-16" title="16">    complementNuc x <span class="fu">=</span> x</a></code></pre></div>
<h6 id="srchyraxabiffasta.hs-23-to-51">src/Hyrax/Abif/Fasta.hs (23 to 51)</h6>
<div class="sourceCode" id="cb35"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb35-1" title="1"><span class="co">-- | FASTA data</span></a>
<a class="sourceLine" id="cb35-2" title="2"><span class="kw">data</span> <span class="dt">Fasta</span> <span class="fu">=</span> <span class="dt">Fasta</span> {<span class="ot"> fastaName ::</span> <span class="fu">!</span><span class="dt">Text</span> <span class="co">-- ^ Name</span></a>
<a class="sourceLine" id="cb35-3" title="3">                   ,<span class="ot"> fastaRead ::</span> <span class="fu">!</span><span class="dt">Text</span> <span class="co">-- ^ Data</span></a>
<a class="sourceLine" id="cb35-4" title="4">                   } <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</a>
<a class="sourceLine" id="cb35-5" title="5"></a>
<a class="sourceLine" id="cb35-6" title="6"></a>
<a class="sourceLine" id="cb35-7" title="7"><span class="co">-- | Parse the data for a single FASTA into a list of 'Fasta' values.</span></a>
<a class="sourceLine" id="cb35-8" title="8"><span class="co">-- Single and multi-line FASTAs are supported.</span></a>
<a class="sourceLine" id="cb35-9" title="9"><span class="co">-- Used by &quot;Hyrax.Abif.Generate&quot; to read weighted-FASTAs</span></a>
<a class="sourceLine" id="cb35-10" title="10"><span class="ot">parseFasta ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">Either</span> <span class="dt">Text</span> [<span class="dt">Fasta</span>]</a>
<a class="sourceLine" id="cb35-11" title="11">parseFasta s <span class="fu">=</span></a>
<a class="sourceLine" id="cb35-12" title="12">  <span class="fu">reverse</span> <span class="fu">&lt;$&gt;</span> go (Txt.lines s) <span class="dt">Nothing</span> <span class="st">&quot;&quot;</span> []</a>
<a class="sourceLine" id="cb35-13" title="13"></a>
<a class="sourceLine" id="cb35-14" title="14">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb35-15" title="15"><span class="ot">    go ::</span> [<span class="dt">Text</span>] <span class="ot">-&gt;</span> <span class="dt">Maybe</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> [<span class="dt">Fasta</span>] <span class="ot">-&gt;</span> <span class="dt">Either</span> <span class="dt">Text</span> [<span class="dt">Fasta</span>]</a>
<a class="sourceLine" id="cb35-16" title="16">    go (line<span class="fu">:lines</span>) (<span class="dt">Just</span> name) <span class="fu">read</span> acc <span class="fu">=</span></a>
<a class="sourceLine" id="cb35-17" title="17">      <span class="kw">if</span> Txt.take <span class="dv">1</span> line <span class="fu">/=</span> <span class="st">&quot;&gt;&quot;</span></a>
<a class="sourceLine" id="cb35-18" title="18">      <span class="kw">then</span> go <span class="fu">lines</span> (<span class="dt">Just</span> name) (<span class="fu">read</span> <span class="fu">&lt;&gt;</span> line) acc</a>
<a class="sourceLine" id="cb35-19" title="19">      <span class="kw">else</span> go <span class="fu">lines</span> (<span class="dt">Just</span> <span class="fu">$</span> Txt.drop <span class="dv">1</span> line) <span class="st">&quot;&quot;</span> (<span class="dt">Fasta</span> (Txt.strip name) <span class="fu">read</span> <span class="fu">:</span> acc)</a>
<a class="sourceLine" id="cb35-20" title="20">    go (line<span class="fu">:lines</span>) <span class="dt">Nothing</span> _read acc <span class="fu">=</span></a>
<a class="sourceLine" id="cb35-21" title="21">      <span class="kw">if</span> Txt.take <span class="dv">1</span> line <span class="fu">==</span> <span class="st">&quot;&gt;&quot;</span></a>
<a class="sourceLine" id="cb35-22" title="22">      <span class="kw">then</span> go <span class="fu">lines</span> (<span class="dt">Just</span> <span class="fu">$</span> Txt.strip <span class="fu">.</span> Txt.drop <span class="dv">1</span> <span class="fu">$</span> line) <span class="st">&quot;&quot;</span> acc</a>
<a class="sourceLine" id="cb35-23" title="23">      <span class="kw">else</span> <span class="dt">Left</span> <span class="st">&quot;Expecting name&quot;</span></a>
<a class="sourceLine" id="cb35-24" title="24">    go [] <span class="dt">Nothing</span> _ acc <span class="fu">=</span></a>
<a class="sourceLine" id="cb35-25" title="25">      <span class="dt">Right</span> acc</a>
<a class="sourceLine" id="cb35-26" title="26">    go [] (<span class="dt">Just</span> _name) <span class="st">&quot;&quot;</span> _acc <span class="fu">=</span></a>
<a class="sourceLine" id="cb35-27" title="27">      <span class="dt">Left</span> <span class="st">&quot;Expecting read&quot;</span></a>
<a class="sourceLine" id="cb35-28" title="28">    go [] (<span class="dt">Just</span> name) <span class="fu">read</span> acc <span class="fu">=</span></a>
<a class="sourceLine" id="cb35-29" title="29">      <span class="dt">Right</span> <span class="fu">$</span> <span class="dt">Fasta</span> (Txt.strip name) <span class="fu">read</span> <span class="fu">:</span> acc</a></code></pre></div>
<p><code>readWeightedFastas</code> reads all the FASTA files from a directory and returns a tuple of <code>( file-name, f )</code> where <code>f</code> is <code>[('Double', 'Text')]</code> as described above.</p>
<h6 id="srchyraxabifgenerate.hs-296-to-317">src/Hyrax/Abif/Generate.hs (296 to 317)</h6>
<div class="sourceCode" id="cb36"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb36-1" title="1"><span class="co">-- | Read all FASTA files in a directory</span></a>
<a class="sourceLine" id="cb36-2" title="2"><span class="co">--</span></a>
<a class="sourceLine" id="cb36-3" title="3"><span class="co">-- The result data has the type</span></a>
<a class="sourceLine" id="cb36-4" title="4"><span class="co">-- </span></a>
<a class="sourceLine" id="cb36-5" title="5"><span class="co">-- @</span></a>
<a class="sourceLine" id="cb36-6" title="6"><span class="co">--                    [ ('Text', [('Double', 'Text')]) ]</span></a>
<a class="sourceLine" id="cb36-7" title="7"><span class="co">--                        ^         ^         ^</span></a>
<a class="sourceLine" id="cb36-8" title="8"><span class="co">--                        |         |         |</span></a>
<a class="sourceLine" id="cb36-9" title="9"><span class="co">-- file name -------------+         |         +---- read </span></a>
<a class="sourceLine" id="cb36-10" title="10"><span class="co">--                                  | </span></a>
<a class="sourceLine" id="cb36-11" title="11"><span class="co">--                                  +---- weight</span></a>
<a class="sourceLine" id="cb36-12" title="12"><span class="co">-- @</span></a>
<a class="sourceLine" id="cb36-13" title="13"><span class="co">--</span></a>
<a class="sourceLine" id="cb36-14" title="14"><span class="ot">readWeightedFastas ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> (<span class="dt">Either</span> <span class="dt">Text</span> [(<span class="dt">Text</span>, [(<span class="dt">Double</span>, <span class="dt">Text</span>)])])</a>
<a class="sourceLine" id="cb36-15" title="15">readWeightedFastas source <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb36-16" title="16">  files <span class="ot">&lt;-</span> <span class="fu">filter</span> (Txt.isSuffixOf <span class="st">&quot;.fasta&quot;</span> <span class="fu">.</span> Txt.pack) <span class="fu">&lt;$&gt;</span> getFiles source</a>
<a class="sourceLine" id="cb36-17" title="17">  <span class="kw">let</span> names <span class="fu">=</span> Txt.pack <span class="fu">.</span> FP.takeBaseName <span class="fu">&lt;$&gt;</span> files</a>
<a class="sourceLine" id="cb36-18" title="18">  contents <span class="ot">&lt;-</span> <span class="fu">traverse</span> BS.readFile files</a>
<a class="sourceLine" id="cb36-19" title="19">  </a>
<a class="sourceLine" id="cb36-20" title="20">  <span class="kw">case</span> <span class="fu">sequenceA</span> <span class="fu">$</span> readWeightedFasta <span class="fu">&lt;$&gt;</span> contents <span class="kw">of</span></a>
<a class="sourceLine" id="cb36-21" title="21">    <span class="dt">Left</span> e <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Left</span> <span class="fu">$</span> e</a>
<a class="sourceLine" id="cb36-22" title="22">    <span class="dt">Right</span> rs <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Right</span> <span class="fu">$</span> <span class="fu">zip</span> names rs</a></code></pre></div>
<h3 id="generating-the-trace-data">Generating the trace data</h3>
<p><code>generateTraceData</code> does the bulk of the work in the ABIF data generation</p>
<h6 id="srchyraxabifgenerate.hs-181-to-183">src/Hyrax/Abif/Generate.hs (181 to 183)</h6>
<div class="sourceCode" id="cb37"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb37-1" title="1"><span class="co">-- | Generate the traces for the AB1 from the parsed weighted FASTA</span></a>
<a class="sourceLine" id="cb37-2" title="2"><span class="ot">generateTraceData ::</span> [(<span class="dt">Double</span>, <span class="dt">Text</span>)] <span class="ot">-&gt;</span> <span class="dt">TraceData</span></a>
<a class="sourceLine" id="cb37-3" title="3">generateTraceData weighted <span class="fu">=</span></a></code></pre></div>
<h6 id="srchyraxabifgenerate.hs-187-to-188">src/Hyrax/Abif/Generate.hs (187 to 188)</h6>
<div class="sourceCode" id="cb38"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb38-1" title="1">  weightedNucs' <span class="fu">=</span> (\(w, ns) <span class="ot">-&gt;</span> (w,) <span class="fu">.</span> unIupac <span class="fu">&lt;$&gt;</span> Txt.unpack ns) <span class="fu">&lt;$&gt;</span> weighted</a>
<a class="sourceLine" id="cb38-2" title="2">  weightedNucs <span class="fu">=</span> Lst.transpose weightedNucs'</a></code></pre></div>
<p>Lets break <code>(\(w, ns) -&gt; (w,) . unIupac &lt;$&gt; Txt.unpack ns) &lt;$&gt; weighted</code> down a bit</p>
<ul>
<li>Its running a lambda for each weighted element
<ul>
<li>So <code>lambda &lt;$&gt; weighted</code></li>
<li>Weighted has the type <code>[(Double, Text)]</code> as discussed above</li>
<li>The lambda takes the params <code>\(w, ns)</code>. I.e. it destuctures a tuple from the array and gets the weight and the string of nucleotides.</li>
<li>For each nucleotide <code>f &lt;$&gt; Txt.unpack ns</code>
<ul>
<li><code>f</code> is <code>(w,) . unIupac</code></li>
<li>So each nucleotide gets passed to <code>unIupac</code> (as a <code>Text</code>) and added to a tuple with the weigh, so (weight, [nucleotide])
<ul>
<li><code>unIupac</code> takes a possibly ambiguous nucleotide code and returns the list of nucleotides it represents. E.g. <code>V</code> -&gt; <code>ACG</code></li>
</ul></li>
</ul></li>
</ul></li>
<li>And then <code>List.transpose</code> is called. This gives us all the nulceotides and weights per position</li>
</ul>
<p>This code is perhaps a bit hard to follow, so here is an example showing how this would work for the weighted FASTA</p>
<pre class="test"><code>&gt;1
AC
&gt;0.5
WK</code></pre>
<ol type="1">
<li>The weighted fasta is parsed as</li>
</ol>
<div class="sourceCode" id="cb40"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb40-1" title="1">[ (<span class="fl">1.0</span>,<span class="st">&quot;AC&quot;</span>) <span class="co">-- Read 0</span></a>
<a class="sourceLine" id="cb40-2" title="2">, (<span class="fl">0.5</span>,<span class="st">&quot;WK&quot;</span>) <span class="co">-- Read 1</span></a>
<a class="sourceLine" id="cb40-3" title="3">]</a></code></pre></div>
<ol start="2" type="1">
<li>Each of the nucleotides is passed to <code>unIupac</code>, and since <code>W</code> = <code>AT</code> and <code>K</code> = <code>GT</code> we get</li>
</ol>
<div class="sourceCode" id="cb41"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb41-1" title="1">[   [ (<span class="fl">1.0</span>, <span class="st">&quot;A&quot;</span>)  <span class="co">-- Read 0</span></a>
<a class="sourceLine" id="cb41-2" title="2">    , (<span class="fl">1.0</span>, <span class="st">&quot;C&quot;</span>)</a>
<a class="sourceLine" id="cb41-3" title="3">    ]</a>
<a class="sourceLine" id="cb41-4" title="4"></a>
<a class="sourceLine" id="cb41-5" title="5">,   [ (<span class="fl">0.5</span>, <span class="st">&quot;AT&quot;</span>)  <span class="co">-- Read 1</span></a>
<a class="sourceLine" id="cb41-6" title="6">    , (<span class="fl">0.5</span>, <span class="st">&quot;GT&quot;</span>)</a>
<a class="sourceLine" id="cb41-7" title="7">    ]</a>
<a class="sourceLine" id="cb41-8" title="8">]</a></code></pre></div>
<ol start="3" type="1">
<li>Finally, the list is transposed to get the weight and nucleotide per position</li>
</ol>
<div class="sourceCode" id="cb42"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb42-1" title="1">[  [ (<span class="fl">1.0</span>, <span class="st">&quot;A&quot;</span>)   <span class="co">-- Position 0</span></a>
<a class="sourceLine" id="cb42-2" title="2">   , (<span class="fl">0.5</span>, <span class="st">&quot;AT&quot;</span>)</a>
<a class="sourceLine" id="cb42-3" title="3">   ]</a>
<a class="sourceLine" id="cb42-4" title="4">,</a>
<a class="sourceLine" id="cb42-5" title="5">   [ (<span class="fl">1.0</span>, <span class="st">&quot;C&quot;</span>)   <span class="co">-- Position 1</span></a>
<a class="sourceLine" id="cb42-6" title="6">   , (<span class="fl">0.5</span>, <span class="st">&quot;GT&quot;</span>)</a>
<a class="sourceLine" id="cb42-7" title="7">   ]</a>
<a class="sourceLine" id="cb42-8" title="8">]</a></code></pre></div>
<ul>
<li>position <code>0</code> has an <code>A</code> with weight 1 and an <code>A</code>/<code>T</code> with weight 0.5</li>
<li>position <code>1</code> has a <code>C</code> with weight 1 and a <code>G</code>/<code>T</code> with weight 0.5</li>
</ul>
<h6 id="srchyraxabifgenerate.hs-192-to-195">src/Hyrax/Abif/Generate.hs (192 to 195)</h6>
<div class="sourceCode" id="cb43"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb43-1" title="1">  <span class="co">-- Values for a base that was present. This defines the shape of the chromatogram curve,</span></a>
<a class="sourceLine" id="cb43-2" title="2">  <span class="co">--  and defines the number of values per base</span></a>
<a class="sourceLine" id="cb43-3" title="3">  curve <span class="fu">=</span> [<span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">128</span>, <span class="dv">512</span>, <span class="dv">1024</span>, <span class="dv">1024</span>, <span class="dv">512</span>, <span class="dv">128</span>, <span class="dv">0</span>, <span class="dv">0</span>]</a>
<a class="sourceLine" id="cb43-4" title="4">  valsPerBase <span class="fu">=</span> <span class="fu">length</span> curve</a></code></pre></div>
<p>Next the shape of the curve is defined. A curve this shape, was selected as it has some space either side to avoid mixing with neighboring waves and a steep climb so that the peak is easily detectable.</p>
<p><img src="../images/abif_wave.png" /></p>
<h6 id="srchyraxabifgenerate.hs-199-to-203">src/Hyrax/Abif/Generate.hs (199 to 203)</h6>
<div class="sourceCode" id="cb44"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb44-1" title="1">  <span class="co">-- Create the G, A, T and C traces</span></a>
<a class="sourceLine" id="cb44-2" title="2">  data09G <span class="fu">=</span> <span class="fu">concat</span> <span class="fu">$</span> getWeightedTrace curve <span class="ch">'G'</span> <span class="fu">&lt;$&gt;</span> weightedNucs</a>
<a class="sourceLine" id="cb44-3" title="3">  data10A <span class="fu">=</span> <span class="fu">concat</span> <span class="fu">$</span> getWeightedTrace curve <span class="ch">'A'</span> <span class="fu">&lt;$&gt;</span> weightedNucs</a>
<a class="sourceLine" id="cb44-4" title="4">  data11T <span class="fu">=</span> <span class="fu">concat</span> <span class="fu">$</span> getWeightedTrace curve <span class="ch">'T'</span> <span class="fu">&lt;$&gt;</span> weightedNucs</a>
<a class="sourceLine" id="cb44-5" title="5">  data12C <span class="fu">=</span> <span class="fu">concat</span> <span class="fu">$</span> getWeightedTrace curve <span class="ch">'C'</span> <span class="fu">&lt;$&gt;</span> weightedNucs</a></code></pre></div>
<h6 id="srchyraxabifgenerate.hs-224-to-232">src/Hyrax/Abif/Generate.hs (224 to 232)</h6>
<div class="sourceCode" id="cb45"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb45-1" title="1"><span class="ot">  getWeightedTrace ::</span> [<span class="dt">Int</span>] <span class="ot">-&gt;</span> <span class="dt">Char</span> <span class="ot">-&gt;</span> [(<span class="dt">Double</span>, [<span class="dt">Char</span>])] <span class="ot">-&gt;</span> [<span class="dt">Int16</span>]</a>
<a class="sourceLine" id="cb45-2" title="2">  getWeightedTrace curve nuc ws <span class="fu">=</span></a>
<a class="sourceLine" id="cb45-3" title="3">    <span class="kw">let</span></a>
<a class="sourceLine" id="cb45-4" title="4">      found <span class="fu">=</span> <span class="fu">filter</span> ((nuc <span class="ot">`elem`</span>) <span class="fu">.</span> <span class="fu">snd</span>) ws</a>
<a class="sourceLine" id="cb45-5" title="5">      score' <span class="fu">=</span> foldl' (<span class="fu">+</span>) <span class="dv">0</span> <span class="fu">$</span> <span class="fu">fst</span> <span class="fu">&lt;$&gt;</span> found</a>
<a class="sourceLine" id="cb45-6" title="6">      score <span class="fu">=</span> <span class="fu">min</span> <span class="dv">1</span> <span class="fu">.</span> <span class="fu">max</span> <span class="dv">0</span> <span class="fu">$</span> score'</a>
<a class="sourceLine" id="cb45-7" title="7">      wave <span class="fu">=</span> <span class="fu">floor</span> <span class="fu">.</span> (score <span class="fu">*</span>) <span class="fu">.</span> <span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> curve</a>
<a class="sourceLine" id="cb45-8" title="8">    <span class="kw">in</span></a>
<a class="sourceLine" id="cb45-9" title="9">    wave</a></code></pre></div>
<p><code>getWeightedTrace</code> is then called for each of the four bases. For each position for a base it returns a curve. If the position does not have the base then the curve is flat (zeros), if it does the curve above is returned multiplied by the weight.</p>
<p>Again an example may make this easier to understand</p>
<div class="sourceCode" id="cb46"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb46-1" title="1">  <span class="kw">let</span> ns <span class="fu">=</span> [  [ (<span class="fl">1.0</span>, <span class="st">&quot;A&quot;</span>)   <span class="co">-- Position 0</span></a>
<a class="sourceLine" id="cb46-2" title="2">              , (<span class="fl">0.5</span>, <span class="st">&quot;AT&quot;</span>)</a>
<a class="sourceLine" id="cb46-3" title="3">              ]</a>
<a class="sourceLine" id="cb46-4" title="4">           ,</a>
<a class="sourceLine" id="cb46-5" title="5">              [ (<span class="fl">1.0</span>, <span class="st">&quot;C&quot;</span>)   <span class="co">-- Position 1</span></a>
<a class="sourceLine" id="cb46-6" title="6">              , (<span class="fl">0.5</span>, <span class="st">&quot;GT&quot;</span>)</a>
<a class="sourceLine" id="cb46-7" title="7">              ]</a>
<a class="sourceLine" id="cb46-8" title="8">          ]</a>
<a class="sourceLine" id="cb46-9" title="9"></a>
<a class="sourceLine" id="cb46-10" title="10">  <span class="kw">let</span> curve <span class="fu">=</span> [<span class="dv">0</span>, <span class="dv">100</span>, <span class="dv">0</span>]</a>
<a class="sourceLine" id="cb46-11" title="11"></a>
<a class="sourceLine" id="cb46-12" title="12">  <span class="kw">let</span> rA <span class="fu">=</span> getWeightedTrace curve <span class="ch">'A'</span> <span class="fu">&lt;$&gt;</span> ns</a>
<a class="sourceLine" id="cb46-13" title="13">  <span class="fu">print</span> rA</a>
<a class="sourceLine" id="cb46-14" title="14"></a>
<a class="sourceLine" id="cb46-15" title="15">  <span class="kw">let</span> rG <span class="fu">=</span> getWeightedTrace curve <span class="ch">'G'</span> <span class="fu">&lt;$&gt;</span> ns</a>
<a class="sourceLine" id="cb46-16" title="16">  <span class="fu">print</span> rG</a></code></pre></div>
<ul>
<li>We start with the same parsed FASTA as above</li>
<li>We define a small curve as [0, 100, 0]</li>
<li>We call <code>getWeightedTrace</code> for the <code>A</code> and <code>G</code> bases</li>
</ul>
<p>For <code>A</code></p>
<ul>
<li>there is a <code>A</code> at position <code>0</code> with a total weight of <code>1</code> (remember max is 1.0) so the full curve is used</li>
<li>no <code>A</code> at position <code>1</code></li>
</ul>
<div class="sourceCode" id="cb47"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb47-1" title="1">[  [<span class="dv">0</span>, <span class="dv">100</span>, <span class="dv">0</span>]  <span class="co">-- Position 0</span></a>
<a class="sourceLine" id="cb47-2" title="2">,  [<span class="dv">0</span>,   <span class="dv">0</span>, <span class="dv">0</span>]  <span class="co">-- Position 1</span></a>
<a class="sourceLine" id="cb47-3" title="3">]</a></code></pre></div>
<p>For <code>G</code></p>
<ul>
<li>no <code>G</code> at position <code>0</code></li>
<li>there is a <code>G</code> at position <code>1</code> with a weight of <code>0.5</code> so each value in the wave is multiplied by 0.5</li>
</ul>
<div class="sourceCode" id="cb48"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb48-1" title="1">[  [<span class="dv">0</span>,  <span class="dv">0</span>, <span class="dv">0</span>]  <span class="co">-- Position 0</span></a>
<a class="sourceLine" id="cb48-2" title="2">,  [<span class="dv">0</span>, <span class="dv">50</span>, <span class="dv">0</span>]  <span class="co">-- Position 1</span></a>
<a class="sourceLine" id="cb48-3" title="3">]</a></code></pre></div>
<p>Notice that in the code above, these results are then concatenated so the actual results are</p>
<div class="sourceCode" id="cb49"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb49-1" title="1">[<span class="dv">0</span>, <span class="dv">100</span>, <span class="dv">0</span>, <span class="dv">0</span>,  <span class="dv">0</span>, <span class="dv">0</span>]  <span class="co">-- A</span></a>
<a class="sourceLine" id="cb49-2" title="2">[<span class="dv">0</span>,   <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">50</span>, <span class="dv">0</span>]  <span class="co">-- G</span></a></code></pre></div>
<p>With that have a way to generate a wave form for the input weighted fasta</p>
<h6 id="srchyraxabifgenerate.hs-207-to-209">src/Hyrax/Abif/Generate.hs (207 to 209)</h6>
<div class="sourceCode" id="cb50"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb50-1" title="1">  <span class="co">-- Create fasta sequence for the trace</span></a>
<a class="sourceLine" id="cb50-2" title="2">  fastaSeq <span class="fu">=</span> <span class="fu">concat</span> <span class="fu">&lt;$&gt;</span> (<span class="fu">snd</span> <span class="fu">&lt;&lt;$&gt;&gt;</span> weightedNucs)</a>
<a class="sourceLine" id="cb50-3" title="3">  fasta <span class="fu">=</span> Txt.pack <span class="fu">$</span> iupac fastaSeq</a></code></pre></div>
<p>The ABIF needs to store the called bases in the PBAS entry. We get the bases from the input data, IUPAC encode each position and we have the sequence.</p>
<h6 id="srchyraxabifgenerate.hs-213-to-219">src/Hyrax/Abif/Generate.hs (213 to 219)</h6>
<div class="sourceCode" id="cb51"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb51-1" title="1">  <span class="dt">TraceData</span> { trData09G <span class="fu">=</span> data09G</a>
<a class="sourceLine" id="cb51-2" title="2">            , trData10A <span class="fu">=</span> data10A</a>
<a class="sourceLine" id="cb51-3" title="3">            , trData11T <span class="fu">=</span> data11T</a>
<a class="sourceLine" id="cb51-4" title="4">            , trData12C <span class="fu">=</span> data12C</a>
<a class="sourceLine" id="cb51-5" title="5">            , trFasta <span class="fu">=</span> fasta</a>
<a class="sourceLine" id="cb51-6" title="6">            , trValsPerBase <span class="fu">=</span> valsPerBase</a>
<a class="sourceLine" id="cb51-7" title="7">            }</a></code></pre></div>
<p>And return the <code>TraceData</code> value</p>
<p>For completeness here is the <code>unIupac</code> function</p>
<h6 id="srchyraxabifgenerate.hs-329-to-352">src/Hyrax/Abif/Generate.hs (329 to 352)</h6>
<div class="sourceCode" id="cb52"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb52-1" title="1"><span class="co">-- | Convert a IUPAC ambiguity code to the set of nucleotides it represents</span></a>
<a class="sourceLine" id="cb52-2" title="2"><span class="ot">unIupac ::</span> <span class="dt">Char</span> <span class="ot">-&gt;</span> [<span class="dt">Char</span>]</a>
<a class="sourceLine" id="cb52-3" title="3">unIupac c <span class="fu">=</span></a>
<a class="sourceLine" id="cb52-4" title="4">  <span class="kw">case</span> c <span class="kw">of</span></a>
<a class="sourceLine" id="cb52-5" title="5">    <span class="ch">'T'</span> <span class="ot">-&gt;</span> <span class="st">&quot;T&quot;</span></a>
<a class="sourceLine" id="cb52-6" title="6">    <span class="ch">'C'</span> <span class="ot">-&gt;</span> <span class="st">&quot;C&quot;</span></a>
<a class="sourceLine" id="cb52-7" title="7">    <span class="ch">'A'</span> <span class="ot">-&gt;</span> <span class="st">&quot;A&quot;</span></a>
<a class="sourceLine" id="cb52-8" title="8">    <span class="ch">'G'</span> <span class="ot">-&gt;</span> <span class="st">&quot;G&quot;</span></a>
<a class="sourceLine" id="cb52-9" title="9">   </a>
<a class="sourceLine" id="cb52-10" title="10">    <span class="ch">'U'</span> <span class="ot">-&gt;</span> <span class="st">&quot;T&quot;</span></a>
<a class="sourceLine" id="cb52-11" title="11">    <span class="ch">'M'</span> <span class="ot">-&gt;</span> <span class="st">&quot;AC&quot;</span></a>
<a class="sourceLine" id="cb52-12" title="12">    <span class="ch">'R'</span> <span class="ot">-&gt;</span> <span class="st">&quot;AG&quot;</span></a>
<a class="sourceLine" id="cb52-13" title="13">    <span class="ch">'W'</span> <span class="ot">-&gt;</span> <span class="st">&quot;AT&quot;</span></a>
<a class="sourceLine" id="cb52-14" title="14">    <span class="ch">'S'</span> <span class="ot">-&gt;</span> <span class="st">&quot;CG&quot;</span></a>
<a class="sourceLine" id="cb52-15" title="15">    <span class="ch">'Y'</span> <span class="ot">-&gt;</span> <span class="st">&quot;CT&quot;</span></a>
<a class="sourceLine" id="cb52-16" title="16">    <span class="ch">'K'</span> <span class="ot">-&gt;</span> <span class="st">&quot;GT&quot;</span></a>
<a class="sourceLine" id="cb52-17" title="17">    <span class="ch">'V'</span> <span class="ot">-&gt;</span> <span class="st">&quot;ACG&quot;</span></a>
<a class="sourceLine" id="cb52-18" title="18">    <span class="ch">'H'</span> <span class="ot">-&gt;</span> <span class="st">&quot;ACT&quot;</span></a>
<a class="sourceLine" id="cb52-19" title="19">    <span class="ch">'D'</span> <span class="ot">-&gt;</span> <span class="st">&quot;AGT&quot;</span></a>
<a class="sourceLine" id="cb52-20" title="20">    <span class="ch">'B'</span> <span class="ot">-&gt;</span> <span class="st">&quot;CGT&quot;</span></a>
<a class="sourceLine" id="cb52-21" title="21">    <span class="ch">'N'</span> <span class="ot">-&gt;</span> <span class="st">&quot;GATC&quot;</span></a>
<a class="sourceLine" id="cb52-22" title="22">  </a>
<a class="sourceLine" id="cb52-23" title="23">    <span class="ch">'X'</span> <span class="ot">-&gt;</span> <span class="st">&quot;GATC&quot;</span></a>
<a class="sourceLine" id="cb52-24" title="24">    _   <span class="ot">-&gt;</span> <span class="st">&quot;&quot;</span></a></code></pre></div>
<h3 id="generating-the-peak-locations">Generating the peak locations</h3>
<h6 id="srchyraxabifgenerate.hs-140-to-143">src/Hyrax/Abif/Generate.hs (140 to 143)</h6>
<div class="sourceCode" id="cb53"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb53-1" title="1">  <span class="co">-- The point that is the peak of the trace, i.e. mid point of trace for a single base</span></a>
<a class="sourceLine" id="cb53-2" title="2">  midPeek <span class="fu">=</span> valsPerBase <span class="ot">`div`</span> <span class="dv">2</span></a>
<a class="sourceLine" id="cb53-3" title="3">  <span class="co">-- Get the peak locations for all bases</span></a>
<a class="sourceLine" id="cb53-4" title="4">  peakLocations <span class="fu">=</span> <span class="fu">take</span> generatedFastaLen [midPeek, valsPerBase <span class="fu">+</span> midPeek<span class="fu">..</span>]</a></code></pre></div>
<p>To generate the array of peak locations</p>
<ul>
<li>Take the midpoint of a single wave (which will always be the peak for the shape of the waves we have define)</li>
<li>Create an array of positions that start from this point, per wave for the total length of the input data</li>
</ul>
<p>Given a curve of <code>[0, 10, 10, 0]</code></p>
<ul>
<li><code>valsPerBase</code> = the length of the curve = 4</li>
<li><code>midPeak</code> = 4 / 2 = 2</li>
<li>The peaks generated are <code>[2, 6, 10, 14, 18......</code>, one element per length of the input FASTA.</li>
<li>This is the data that is stored in the <code>PLOC</code> directory entry.</li>
</ul>
<h3 id="generating-the-abif">Generating the ABIF</h3>
<p>We now have all the data we need, the <code>mk*</code> functions are used to generate the minimal set of directories</p>
<h6 id="srchyraxabifgenerate.hs-150-to-170">src/Hyrax/Abif/Generate.hs (150 to 170)</h6>
<div class="sourceCode" id="cb54"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb54-1" title="1">    <span class="co">-- Create the ABIF directories</span></a>
<a class="sourceLine" id="cb54-2" title="2">    dirs <span class="fu">=</span> [ mkData  <span class="dv">9</span> <span class="fu">$</span> trData09G tr <span class="co">-- G</span></a>
<a class="sourceLine" id="cb54-3" title="3">           , mkData <span class="dv">10</span> <span class="fu">$</span> trData10A tr <span class="co">-- A</span></a>
<a class="sourceLine" id="cb54-4" title="4">           , mkData <span class="dv">11</span> <span class="fu">$</span> trData11T tr <span class="co">-- T</span></a>
<a class="sourceLine" id="cb54-5" title="5">           , mkData <span class="dv">12</span> <span class="fu">$</span> trData12C tr <span class="co">-- C</span></a>
<a class="sourceLine" id="cb54-6" title="6">           , mkBaseOrder <span class="dt">BaseG</span> <span class="dt">BaseA</span> <span class="dt">BaseT</span> <span class="dt">BaseC</span> <span class="co">-- Base order, should be GATC for 3500</span></a>
<a class="sourceLine" id="cb54-7" title="7">           , mkLane <span class="dv">1</span> <span class="co">-- Lane or capliary number</span></a>
<a class="sourceLine" id="cb54-8" title="8">           , mkCalledBases <span class="fu">$</span> trFasta tr <span class="co">-- Called bases</span></a>
<a class="sourceLine" id="cb54-9" title="9">           , mkMobilityFileName <span class="dv">1</span> <span class="st">&quot;KB_3500_POP7_BDTv3.mob&quot;</span> <span class="co">-- Mobility file name</span></a>
<a class="sourceLine" id="cb54-10" title="10">           , mkMobilityFileName <span class="dv">2</span> <span class="st">&quot;KB_3500_POP7_BDTv3.mob&quot;</span> <span class="co">-- Mobility file name</span></a>
<a class="sourceLine" id="cb54-11" title="11">           , mkPeakLocations <span class="fu">$</span> <span class="fu">fromIntegral</span> <span class="fu">&lt;$&gt;</span> peakLocations <span class="co">-- Peak locations</span></a>
<a class="sourceLine" id="cb54-12" title="12">           , mkDyeSignalStrength <span class="dv">53</span> <span class="dv">75</span> <span class="dv">79</span> <span class="dv">48</span> <span class="co">-- Signal strength per dye</span></a>
<a class="sourceLine" id="cb54-13" title="13">           , mkSampleName sampleName  <span class="co">-- Sample name</span></a>
<a class="sourceLine" id="cb54-14" title="14">           , mkComment <span class="st">&quot;Generated by HyraxBio AB1 generator&quot;</span></a>
<a class="sourceLine" id="cb54-15" title="15">           ]</a>
<a class="sourceLine" id="cb54-16" title="16"></a>
<a class="sourceLine" id="cb54-17" title="17">    <span class="co">-- The ABIF</span></a>
<a class="sourceLine" id="cb54-18" title="18">    abif <span class="fu">=</span> <span class="dt">Abif</span> { aHeader <span class="fu">=</span> mkHeader</a>
<a class="sourceLine" id="cb54-19" title="19">                , aRootDir <span class="fu">=</span> mkRoot</a>
<a class="sourceLine" id="cb54-20" title="20">                , aDirs <span class="fu">=</span> dirs</a>
<a class="sourceLine" id="cb54-21" title="21">                }</a></code></pre></div>
<p>And with that we can generate any test ABIF we need. The code is much shorter than the explanation. Hopefully with the guidance from this post and the code comments it should be easy enough to follow.</p>
<h1 id="testing">Testing</h1>
<p>The package comes with property tests that test</p>
<ul>
<li>Weighted FASTA parsing</li>
<li>Round tripping a ABIF, i.e. generated ABIF == generated + read + written + read</li>
<li>That the peaks in a generated ABIF represent the expected nucleotide sequence.</li>
</ul>
<p>We used <a href="http://hackage.haskell.org/package/hedgehog">Hedgehog</a> for the property tests. It made writing the properties &amp; generators (see the <code>Generators</code> module) really easy.</p>
<p>For more details see the property tests and the following Hedgehog links</p>
<ul>
<li><a href="http://hackage.haskell.org/package/hedgehog">Hedgehog on hackage</a></li>
<li><a href="https://teh.id.au/posts/2017/04/23/property-testing-with-hedgehog/index.html">Tim Humphries’ introduction to Hedgehog</a></li>
</ul>
<h1 id="conclusion">Conclusion</h1>
<p>Hopefully you find this package useful, either as a standalone tool or as a library. If you do we would love to hear how you are using it.</p>
<p>If you have any questions feel free to email me.</p>
<p>Thanks</p>
<p>Andre.</p>
<h1 id="links">Links</h1>
<ul>
<li><a href="https://github.com/hyraxbio/hyraxAbif">Code on github</a>
<ul>
<li>Latest code is on <code>master</code> branch</li>
<li>Code for the blog is on the <code>blog</code> branch, commit = <code>3fa4f873bcb54756d520f9d2f2cd4995aeccaa4c</code></li>
</ul></li>
<li><a href="https://www.reddit.com/r/haskell/comments/ae8qv2/parsing_and_generating_abif_files_dna/">Comments thread on /r/haskell subreddit</a></li>
<li><a href="https://hackage.haskell.org/package/hyraxAbif">HyraxAbif package on hackage</a></li>
<li><a href="http://www6.appliedbiosystems.com/support/software_community/ABIF_File_Format.pdf">ABIF spec</a></li>
<li><a href="https://hyraxbio.co.za">HyraxBio</a></li>
<li><a href="http://hackage.haskell.org/package/hedgehog">Hedgehog</a></li>
</ul>


        </div>
        <div id="footer">
            Site proudly generated by
            <a href="http://jaspervdj.be/hakyll">Hakyll</a>
        </div>
        </div>

        <script>
          (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
          (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
          m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
          })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

          ga('create', 'UA-78428674-1', 'auto');
          ga('send', 'pageview');
        </script>
    </body>
</html>
]]></summary>
</entry>
<entry>
    <title>Haskell roguelike</title>
    <link href="http://www.andrevdm.com/posts/2018-04-02-haskell-rogue-like.html" />
    <id>http://www.andrevdm.com/posts/2018-04-02-haskell-rogue-like.html</id>
    <published>2018-04-02T00:00:00Z</published>
    <updated>2018-04-02T00:00:00Z</updated>
    <summary type="html"><![CDATA[<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
        <title>Andre's Blog</title>
        <link rel="stylesheet" type="text/css" href="../css/default.css" />
        <link rel="stylesheet" type="text/css" href="../css/syntax.css" />
    </head>
    <body>
      <div id="bodyInner">
        <div id="header">
            <div id="logo">
                <a href="../">Blog</a>
            </div>
            <div id="navigation">
                <a href="../">Home</a>
                <a href="../contact.html">Contact</a>
                <!-- <a href="/about.html">About</a> -->
            </div>
        </div>

        <div id="content">
            <h1><a href="#top">Haskell roguelike</a></h1>

            <div class="info">
    Posted on April  2, 2018

</div>

<h1 id="introduction">Introduction</h1>
<p>In this series of posts I’m going to discuss some of the major design decisions that you will need to consider when making a Haskell roguelike game. I’ll be talking about how the code is implemented as well as the decisions I took along the way and why.</p>
<p>See the chapter list below to get an idea of what topics I’ll be covering.</p>
<h2 id="what-is-a-roguelike">What is a roguelike?</h2>
<p><img src="../images/rogue_full_view.png" /></p>
<p><a href="http://www.roguebasin.com/index.php?title=Main_Page">RogueBasin</a> defines a roguelike as</p>
<blockquote>
<p>A Roguelike is usually described as a free turn-based computer game with a strong focus on intricate gameplay and replayability, and an abstract world representation using ASCII-based display, as opposed to 3D graphics. Of course, as with any genre, there are deviations from the norm.</p>
</blockquote>
<h2 id="other-roguelike-tutorials-and-engines">Other roguelike tutorials and engines</h2>
<p>There are several good Haskell roguelike tutorials and tools. The ones I know about are</p>
<ul>
<li><a href="https://github.com/LambdaHack/LambdaHack/blob/master/README.md">Haskell game engine library for ASCII roguelike games</a></li>
<li><a href="http://jamiltron.com/2012/07/Code_Us_Some_Roguelike_in_Haskell.html">Code Us Some Roguelike in Haskell!</a></li>
<li><a href="https://lokathor.gitbooks.io/using-haskell/content/roguelike/">Complete Roguelike Tutorial</a></li>
<li><a href="http://www.roguebasin.com/index.php?title=Haskell">Haskell category on rogue basin</a></li>
<li><a href="http://haskellroguelike.com/">Haskell roguelike</a></li>
</ul>
<p>Each of the tutorials takes a different approach, cover different topics and address different levels of familiarity with haskell. The more the merrier! If you are interested in building a roguelike, or just looking for ideas for writing games in Haskell, then looking at the links above as well as this series seems like a good idea.</p>
<p><a href="https://github.com/LambdaHack/LambdaHack/blob/master/README.md">LambdaHack</a> is a game engine for making ASCII roguelike games. It is definitely worth taking a look at. For this series I decided not to use LambdaHack as it already implements many of the things I was interested in learning about. This is a trade-off you’ll have to make. Are you currently more interested in learning how to build the game or more interested in getting a robust game together? I’d suggest learning with a small roguelike first as you’ll then have a much better idea of what a game engine offers or how it may constrain you.</p>
<p><a href="http://www.roguebasin.com/index.php?title=Articles">RogueBasin</a> has a vast amount of detail on creating roguelike games. Its well worth your time to look at for ideas. I’ll be referring to articles from roguebasin throughout the series</p>
<h1 id="the-series">The series</h1>
<h2 id="why-read-this-series">Why read this series?</h2>
<p>Apart from just being another perspective, I think that these are some reasons you may want to continue reading</p>
<ul>
<li>Discussion of all the basics since I’m not using a game engine</li>
<li>UI style</li>
<li>Reasonably simple Haskell (I hope!)</li>
<li>In total the game is under 1500 lines of haskell with all the features mentioned below</li>
<li>AI implementation</li>
<li>Decisions about energy systems, viewport scrolling, levels and managing a plot</li>
</ul>
<p>Also I’m not a gamer and this is the first game I’ve ever written, so that should bring a slightly different perspective ;)</p>
<h2 id="structure">Structure</h2>
<p>There are 20 “chapters”. Each chapter builds on the previous one. Each chapter’s code is available on <a href="https://github.com/andrevdm/haskellRogueLike">github</a> and has a working example. At the end of each chapter is a patch file that shows what was added/changed.</p>
<h2 id="notes-on-the-code">Notes on the code</h2>
<p>I’ve tried to keep the Haskell code simple, hopefully it is easy to follow even if you don’t have much experience. E.g. There is only one transformer used (chapter 14) and that is entirely optional.</p>
<p>I am using <a href="https://github.com/sdiehl/protolude/">Protolude</a> as my prelude. It should be fairly easy to switch to something else. Note that protolude defines <code>&lt;&lt;$&gt;&gt;</code> which is the same as <code>(fmap . fmap)</code> or <code>&lt;$$&gt;</code> from <a href="https://hackage.haskell.org/package/composition-extra">composition-extra</a></p>
<h3 id="lenses">Lenses</h3>
<p>I am using lenses, since there are several nested record types I use. If you have not used <a href="https://hackage.haskell.org/package/lens">lens</a> before it may seem odd. I’m mostly using only three lenses, so you should be able to follow along without worrying about them too much.</p>
<p>If you are unfamiliar with lenses here are some links that may help get you started quickly,</p>
<ul>
<li><a href="http://www.haskellforall.com/2013/05/program-imperatively-using-haskell.html">Program imperatively using Haskell lenses</a></li>
<li><a href="https://artyom.me/lens-over-tea-1">Lens over tea</a></li>
<li><a href="https://hackage.haskell.org/package/lens-tutorial-1.0.3/docs/Control-Lens-Tutorial.html">Control.Lens.Tutorial</a></li>
</ul>
<p>And here are a few quick examples that may help you get a sense for what they do.</p>
<p>Given this definition</p>
<div class="sourceCode" id="cb1"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb1-1" title="1"><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></a>
<a class="sourceLine" id="cb1-2" title="2"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></a>
<a class="sourceLine" id="cb1-3" title="3"><span class="ot">{-# LANGUAGE TemplateHaskell #-}</span></a>
<a class="sourceLine" id="cb1-4" title="4"></a>
<a class="sourceLine" id="cb1-5" title="5"><span class="kw">module</span> <span class="dt">Main</span> <span class="kw">where</span></a>
<a class="sourceLine" id="cb1-6" title="6"><span class="kw">import</span> <span class="dt">Protolude</span></a>
<a class="sourceLine" id="cb1-7" title="7"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Text</span> <span class="kw">as</span> <span class="dt">Txt</span></a>
<a class="sourceLine" id="cb1-8" title="8"><span class="kw">import</span>           <span class="dt">Control.Lens</span></a>
<a class="sourceLine" id="cb1-9" title="9"><span class="kw">import</span>           <span class="dt">Control.Lens.TH</span></a>
<a class="sourceLine" id="cb1-10" title="10"></a>
<a class="sourceLine" id="cb1-11" title="11"><span class="kw">data</span> <span class="dt">Parent</span> <span class="fu">=</span> <span class="dt">Parent</span> {<span class="ot"> _pName ::</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb1-12" title="12">                     ,<span class="ot"> _pChild ::</span> <span class="dt">Child</span></a>
<a class="sourceLine" id="cb1-13" title="13">                     } <span class="kw">deriving</span> (<span class="dt">Show</span>)</a>
<a class="sourceLine" id="cb1-14" title="14">            </a>
<a class="sourceLine" id="cb1-15" title="15"><span class="kw">data</span> <span class="dt">Child</span> <span class="fu">=</span> <span class="dt">Child</span> {<span class="ot"> _cName ::</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb1-16" title="16">                   } <span class="kw">deriving</span> (<span class="dt">Show</span>)</a>
<a class="sourceLine" id="cb1-17" title="17"></a>
<a class="sourceLine" id="cb1-18" title="18">makeLenses '<span class="dt">'Parent</span></a>
<a class="sourceLine" id="cb1-19" title="19">makeLenses '<span class="dt">'Child</span></a>
<a class="sourceLine" id="cb1-20" title="20"></a>
<a class="sourceLine" id="cb1-21" title="21"><span class="ot">main ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb1-22" title="22">main <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb1-23" title="23">  <span class="kw">let</span> parent <span class="fu">=</span> <span class="dt">Parent</span> { _pName <span class="fu">=</span> <span class="st">&quot;parent1&quot;</span></a>
<a class="sourceLine" id="cb1-24" title="24">                      , _pChild <span class="fu">=</span> <span class="dt">Child</span> { _cName <span class="fu">=</span> <span class="st">&quot;child1&quot;</span> }</a>
<a class="sourceLine" id="cb1-25" title="25">                      }</a></code></pre></div>
<h4 id="section">^.</h4>
<p>The <code>^.</code> lens acts as a field getter</p>
<div class="sourceCode" id="cb2"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb2-1" title="1">  <span class="fu">#</span> <span class="dt">With</span> lens</a>
<a class="sourceLine" id="cb2-2" title="2">  putText <span class="fu">$</span> parent <span class="fu">^.</span> pName</a>
<a class="sourceLine" id="cb2-3" title="3">  putText <span class="fu">$</span> parent <span class="fu">^.</span> pChild <span class="fu">^.</span> cName</a>
<a class="sourceLine" id="cb2-4" title="4"></a>
<a class="sourceLine" id="cb2-5" title="5">  <span class="fu">#</span> <span class="dt">Without</span> lens</a>
<a class="sourceLine" id="cb2-6" title="6">  putText <span class="fu">$</span> _pName parent</a>
<a class="sourceLine" id="cb2-7" title="7">  putText <span class="fu">$</span> _cName <span class="fu">.</span> _pChild <span class="fu">$</span> parent</a></code></pre></div>
<p>Which both print</p>
<pre><code>parent1
child1</code></pre>
<p>There is not too much difference between the two styles, yet.</p>
<h4 id="section-1">.~</h4>
<p>The <code>.~</code> lens acts as a field setter</p>
<div class="sourceCode" id="cb4"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb4-1" title="1">  <span class="fu">#</span> <span class="dt">With</span> lens</a>
<a class="sourceLine" id="cb4-2" title="2">  <span class="fu">print</span> <span class="fu">$</span> parent <span class="fu">&amp;</span> pName <span class="fu">.~</span> <span class="st">&quot;newName&quot;</span></a>
<a class="sourceLine" id="cb4-3" title="3">  <span class="fu">print</span> <span class="fu">$</span> parent <span class="fu">&amp;</span> (pChild <span class="fu">.</span> cName) <span class="fu">.~</span> <span class="st">&quot;new childName&quot;</span></a>
<a class="sourceLine" id="cb4-4" title="4"></a>
<a class="sourceLine" id="cb4-5" title="5"></a>
<a class="sourceLine" id="cb4-6" title="6">  <span class="fu">#</span> <span class="dt">Without</span> lens</a>
<a class="sourceLine" id="cb4-7" title="7">  <span class="fu">print</span> <span class="fu">$</span> parent { _pName <span class="fu">=</span> <span class="st">&quot;newName&quot;</span> }</a>
<a class="sourceLine" id="cb4-8" title="8">  <span class="fu">print</span> <span class="fu">$</span> parent { _pChild <span class="fu">=</span> (_pChild parent) { _cName <span class="fu">=</span> <span class="st">&quot;new childName&quot;</span> } }</a></code></pre></div>
<p>Which both print</p>
<pre><code>Parent {_pName = &quot;newName&quot;, _pChild = Child {_cName = &quot;child1&quot;}}
Parent {_pName = &quot;parent1&quot;, _pChild = Child {_cName = &quot;new childName&quot;}}</code></pre>
<p>Once you start updating nested records, I think the lens code is much easier to read. The deeper the nesting the more true this is.</p>
<h4 id="section-2">%~</h4>
<p>The <code>%~</code> lens acts as a field updater that works by sending the current value through a function</p>
<div class="sourceCode" id="cb6"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb6-1" title="1">  <span class="fu">#</span> <span class="dt">With</span> lens</a>
<a class="sourceLine" id="cb6-2" title="2">  <span class="fu">print</span> <span class="fu">$</span> parent <span class="fu">&amp;</span> pName <span class="fu">%~</span> Txt.toUpper</a>
<a class="sourceLine" id="cb6-3" title="3">  <span class="fu">print</span> <span class="fu">$</span> parent <span class="fu">&amp;</span> (pChild <span class="fu">.</span> cName) <span class="fu">%~</span> Txt.toUpper</a>
<a class="sourceLine" id="cb6-4" title="4"></a>
<a class="sourceLine" id="cb6-5" title="5"></a>
<a class="sourceLine" id="cb6-6" title="6">  <span class="fu">#</span> <span class="dt">Without</span> lens</a>
<a class="sourceLine" id="cb6-7" title="7">  <span class="fu">print</span> <span class="fu">$</span> parent { _pName <span class="fu">=</span> Txt.toUpper <span class="fu">.</span> _pName <span class="fu">$</span> parent }</a>
<a class="sourceLine" id="cb6-8" title="8">  <span class="fu">print</span> <span class="fu">$</span> parent { _pChild <span class="fu">=</span> (_pChild parent) { _cName <span class="fu">=</span> Txt.toUpper <span class="fu">.</span> _cName <span class="fu">.</span> _pChild <span class="fu">$</span> parent  } }</a></code></pre></div>
<p>Which both print</p>
<pre><code>Parent {_pName = &quot;PARENT1&quot;, _pChild = Child {_cName = &quot;child1&quot;}}
Parent {_pName = &quot;parent1&quot;, _pChild = Child {_cName = &quot;CHILD1&quot;}}</code></pre>
<p>Here I’d say the lens code is significantly easier to read, i.e. the intent is much clearer.</p>
<p>Quite often you’ll end up combining these three lenses and the alternative, in my view, is way too noisy. There are some tradeoffs using lens, e.g. template haskell but I feel that it is justified by the resulting code. Obviously if you prefer not to use lens you can do everything reasonably easily without it.</p>
<h1 id="chapters">Chapters</h1>
<ul>
<li><a href="multi/2018-04-02-haskell-rogue-like_01.html">01 - UI &amp; tiles</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_02.html">02 - UI Code</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_03.html">03 - Entities &amp; Drawing</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_04.html">04 - Map loading</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_05.html">05 - Actors</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_06.html">06 - Moving the player</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_07.html">07 - Collisions</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_08.html">08 - Layers</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_09.html">09 - Viewport scrolling</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_10.html">10 - Field of view</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_11.html">11 - Sticky light</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_12.html">12 - Energy</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_13.html">13 - Utility AI</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_14.html">14 - Utility AI annotations</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_15.html">15 - Memory</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_16.html">16 - Debugging</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_17.html">17 - Levels</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_18.html">18 - Mutliple levels</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_19.html">19 - Story</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_20.html">20 - Structure</a></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_fin.html">21 - Conclusion</a></li>
</ul>
<h2 id="bonus">Bonus</h2>
<ul>
<li><a href="multi/2018-04-02-haskell-rogue-like_21.html">22 - ASCII terminal GUI</a></li>
</ul>
<h1 id="links">Links</h1>
<ul>
<li><p><a href="https://www.reddit.com/r/haskell/comments/89et9d/building_a_haskell_roguelike_game/">Comments thread on /r/haskell subreddit</a></p></li>
<li><a href="multi/2018-04-02-haskell-rogue-like_01.html">Chapter 1 - UI &amp; tiles</a></li>
<li><p><a href="https://github.com/andrevdm/haskellRogueLike">Code on github</a></p></li>
<li><a href="https://github.com/LambdaHack/LambdaHack/blob/master/README.md">Haskell game engine library for ASCII roguelike games</a></li>
<li><a href="http://jamiltron.com/2012/07/Code_Us_Some_Roguelike_in_Haskell.html">Code Us Some Roguelike in Haskell!</a></li>
<li><a href="https://lokathor.gitbooks.io/using-haskell/content/roguelike/">Complete Roguelike Tutorial</a></li>
<li><a href="http://www.roguebasin.com/index.php?title=Haskell">Haskell category on rogue basin</a></li>
<li><a href="http://haskellroguelike.com/">Haskell roguelike</a></li>
<li><p><a href="http://www.roguebasin.com/index.php?title=How_to_Write_a_Roguelike_in_15_Steps">How to Write a Roguelike in 15 Steps</a></p></li>
</ul>


        </div>
        <div id="footer">
            Site proudly generated by
            <a href="http://jaspervdj.be/hakyll">Hakyll</a>
        </div>
        </div>

        <script>
          (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
          (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
          m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
          })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

          ga('create', 'UA-78428674-1', 'auto');
          ga('send', 'pageview');
        </script>
    </body>
</html>
]]></summary>
</entry>
<entry>
    <title>Hakyll compiler to include working code samples</title>
    <link href="http://www.andrevdm.com/posts/2018-02-05-hakyll-code-build-include-compiler.html" />
    <id>http://www.andrevdm.com/posts/2018-02-05-hakyll-code-build-include-compiler.html</id>
    <published>2018-02-05T00:00:00Z</published>
    <updated>2018-02-05T00:00:00Z</updated>
    <summary type="html"><![CDATA[<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
        <title>Andre's Blog</title>
        <link rel="stylesheet" type="text/css" href="../css/default.css" />
        <link rel="stylesheet" type="text/css" href="../css/syntax.css" />
    </head>
    <body>
      <div id="bodyInner">
        <div id="header">
            <div id="logo">
                <a href="../">Blog</a>
            </div>
            <div id="navigation">
                <a href="../">Home</a>
                <a href="../contact.html">Contact</a>
                <!-- <a href="/about.html">About</a> -->
            </div>
        </div>

        <div id="content">
            <h1><a href="#top">Hakyll compiler to include working code samples</a></h1>

            <div class="info">
    Posted on February  5, 2018

</div>

<p><em>(updated: 09/March/2018 - includes, local path &amp; html, css and js support)</em></p>
<p>Ensuring that the code you include in a blog post is up to date and works can be a bit of a pain. Often I’ll change code while writing a post and then I have to find and copy anything that has changed. This is manual and error prone.</p>
<p>Fortunately <a href="https://hackage.haskell.org/package/hakyll">Hakyll</a> is reasonably easy to customise. Here I’ll show one way to write a hakyll compiler to help with this issue.</p>
<h1 id="goal">Goal</h1>
<p>What I wanted was</p>
<ol type="1">
<li>Include code from a git repo</li>
<li>Work with a specific version of the code</li>
<li>Check that the code builds</li>
<li>Check that tests or any other custom actions succeed</li>
<li>Check that the repo is still accessible</li>
</ol>
<h2 id="example-template-markdown">Example template markdown</h2>
<div class="sourceCode" id="cb1"><pre class="sourceCode markdown"><code class="sourceCode markdown"><a class="sourceLine" id="cb1-1" title="1">  ---</a>
<a class="sourceLine" id="cb1-2" title="2">  title: testing</a>
<a class="sourceLine" id="cb1-3" title="3">  ---</a>
<a class="sourceLine" id="cb1-4" title="4">  [&lt;code setup.repo&gt;] https://gist.github.com/53e179c4244411493ae1f9deebc3cc3f.git</a>
<a class="sourceLine" id="cb1-5" title="5">  [&lt;code setup.sha&gt;] 5a95ece18ecb248fb745b3e7cb19f5c4d410240f</a>
<a class="sourceLine" id="cb1-6" title="6">  [&lt;code setup.run&gt;] stack init --resolver lts-12.0</a>
<a class="sourceLine" id="cb1-7" title="7">  [&lt;code setup.run&gt;] stack build</a>
<a class="sourceLine" id="cb1-8" title="8">  [&lt;code setup.run&gt;] stack test</a>
<a class="sourceLine" id="cb1-9" title="9">  </a>
<a class="sourceLine" id="cb1-10" title="10">  Some text</a>
<a class="sourceLine" id="cb1-11" title="11">  </a>
<a class="sourceLine" id="cb1-12" title="12">  [&lt;code&gt;] main</a>
<a class="sourceLine" id="cb1-13" title="13">  </a>
<a class="sourceLine" id="cb1-14" title="14">  more text</a></code></pre></div>
<p>The markdown should be parsed as follows</p>
<ul>
<li><code>[&lt;code setup.repo&gt;]</code> - is the git repo to pull the code from</li>
<li><code>[&lt;code setup.sha&gt;]</code> - is the commit to work with</li>
<li><code>[&lt;code setup.run&gt;]</code> - any number of commands to run in order.</li>
<li><code>[&lt;code&gt;] main</code> - gets the section named <code>main</code> from the code and inserts it as a markdown code block</li>
</ul>
<h2 id="example-haskell-file-with-sections">Example haskell file with sections</h2>
<div class="sourceCode" id="cb2"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb2-1" title="1"><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></a>
<a class="sourceLine" id="cb2-2" title="2"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></a>
<a class="sourceLine" id="cb2-3" title="3"></a>
<a class="sourceLine" id="cb2-4" title="4"><span class="kw">import</span>           <span class="dt">Protolude</span> <span class="kw">hiding</span> (onException)</a>
<a class="sourceLine" id="cb2-5" title="5"><span class="kw">import</span>           <span class="dt">System.FilePath</span> ((&lt;/&gt;))</a>
<a class="sourceLine" id="cb2-6" title="6"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">System.FilePath</span> <span class="kw">as</span> <span class="dt">FP</span></a>
<a class="sourceLine" id="cb2-7" title="7"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">System.Directory</span> <span class="kw">as</span> <span class="dt">Dir</span></a>
<a class="sourceLine" id="cb2-8" title="8"><span class="kw">import</span>           <span class="dt">Control.Exception.Safe</span> (onException, throwString)</a>
<a class="sourceLine" id="cb2-9" title="9"></a>
<a class="sourceLine" id="cb2-10" title="10"><span class="co">{-! SECTION&lt; main !-}</span></a>
<a class="sourceLine" id="cb2-11" title="11"><span class="ot">main ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb2-12" title="12">main <span class="fu">=</span> hakyll <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb2-13" title="13">    match <span class="st">&quot;posts/*&quot;</span> <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb2-14" title="14">        route <span class="fu">$</span> setExtension <span class="st">&quot;html&quot;</span></a>
<a class="sourceLine" id="cb2-15" title="15">        compile <span class="fu">$</span> includeCodeCompiler</a>
<a class="sourceLine" id="cb2-16" title="16">            <span class="fu">&gt;&gt;=</span> renderPandoc </a>
<a class="sourceLine" id="cb2-17" title="17"><span class="co">{-! SECTION&gt; main !-}</span></a></code></pre></div>
<ul>
<li><code>{-! SECTION&lt;</code> starts a code section</li>
<li><code>{-! SECTION&gt;</code> ends a code section</li>
<li>The parser will read all sections from all files in the repo, so section names must be unique. The advantage is that you don’t need to worry about finding paths or paths changing later on.</li>
</ul>
<h2 id="result">Result</h2>
<p>When pandoc is run the include compiler will insert the code from the <code>main</code> section and add a title showing the source path (repo relative) and the position (line from &amp; to).</p>
<h6 id="appsite.hs-32-to-37">app/site.hs (32 to 37)</h6>
<div class="sourceCode" id="cb3"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb3-1" title="1"><span class="ot">main ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb3-2" title="2">main <span class="fu">=</span> hakyll <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb3-3" title="3">    match <span class="st">&quot;posts/*&quot;</span> <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb3-4" title="4">        route <span class="fu">$</span> setExtension <span class="st">&quot;html&quot;</span></a>
<a class="sourceLine" id="cb3-5" title="5">        compile <span class="fu">$</span> includeCodeCompiler</a>
<a class="sourceLine" id="cb3-6" title="6">            <span class="fu">&gt;&gt;=</span> renderPandoc </a></code></pre></div>
<p>Before including the code, the <strong>includeCompiler</strong> will checkout the code and run the commands specified in the template. In the example template above I’m cloning from a github gist that does not have a stack.yaml so I run <code>stack init</code> first. You can use the commands to run tests etc to ensure that your sample code is working 100%. If any action fails, the blog generation is aborted.</p>
<h2 id="constraints">Constraints</h2>
<ol type="1">
<li>I only use markdown, so I’m assuming that all input is markdown</li>
<li>This is not “production” code. I’m doing a lot of work in IO and throwing exceptions to abort on error</li>
<li>It works for me, feel free to use the code and change it to match your needs.</li>
</ol>
<h1 id="code">Code</h1>
<h2 id="customising-hakyll">Customising hakyll</h2>
<p>The <a href="https://jaspervdj.be/hakyll/tutorials.html">hakyll tutorial</a> will give you an idea of how to setup hakyll.</p>
<p>This is a fairly standard match clause to run your posts through pandoc to generate HTML output</p>
<div class="sourceCode" id="cb4"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb4-1" title="1">    match <span class="st">&quot;posts/*&quot;</span> <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb4-2" title="2">        route <span class="fu">$</span> setExtension <span class="st">&quot;html&quot;</span></a>
<a class="sourceLine" id="cb4-3" title="3">        compile <span class="fu">$</span> pandocCompiler</a>
<a class="sourceLine" id="cb4-4" title="4">            <span class="fu">&gt;&gt;=</span> loadAndApplyTemplate <span class="st">&quot;templates/post.html&quot;</span>    postCtx</a>
<a class="sourceLine" id="cb4-5" title="5">            <span class="fu">&gt;&gt;=</span> saveSnapshot <span class="st">&quot;content&quot;</span></a>
<a class="sourceLine" id="cb4-6" title="6">            <span class="fu">&gt;&gt;=</span> loadAndApplyTemplate <span class="st">&quot;templates/default.html&quot;</span> postCtx</a>
<a class="sourceLine" id="cb4-7" title="7">            <span class="fu">&gt;&gt;=</span> relativizeUrls</a></code></pre></div>
<p>Lets modify this route to use a new compiler named <strong>includeCodeCompiler</strong> and pipe that output through pandoc</p>
<h6 id="site.hs-32-to-39">site.hs (32 to 39)</h6>
<div class="sourceCode" id="cb5"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb5-1" title="1">  match <span class="st">&quot;posts/*&quot;</span> <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb5-2" title="2">      route <span class="fu">$</span> setExtension <span class="st">&quot;html&quot;</span></a>
<a class="sourceLine" id="cb5-3" title="3">      compile <span class="fu">$</span> includeCodeCompiler</a>
<a class="sourceLine" id="cb5-4" title="4">          <span class="fu">&gt;&gt;=</span> renderPandoc</a>
<a class="sourceLine" id="cb5-5" title="5">          <span class="fu">&gt;&gt;=</span> loadAndApplyTemplate <span class="st">&quot;templates/post.html&quot;</span>    postCtx</a>
<a class="sourceLine" id="cb5-6" title="6">          <span class="fu">&gt;&gt;=</span> saveSnapshot <span class="st">&quot;content&quot;</span></a>
<a class="sourceLine" id="cb5-7" title="7">          <span class="fu">&gt;&gt;=</span> loadAndApplyTemplate <span class="st">&quot;templates/default.html&quot;</span> postCtx</a>
<a class="sourceLine" id="cb5-8" title="8">          <span class="fu">&gt;&gt;=</span> relativizeUrls</a></code></pre></div>
<p>The two changes to notice are</p>
<ol type="1">
<li>Call <strong>includeCompiler</strong> rather than <strong>pandocCompiler</strong></li>
<li>The output of <strong>includeCompiler</strong> is passed to <strong>renderPandoc</strong></li>
</ol>
<h2 id="preliminaries">Preliminaries</h2>
<p>Here are the imports I’m using</p>
<h6 id="site.hs-2-to-20">site.hs (2 to 20)</h6>
<div class="sourceCode" id="cb6"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb6-1" title="1"><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></a>
<a class="sourceLine" id="cb6-2" title="2"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></a>
<a class="sourceLine" id="cb6-3" title="3"><span class="ot">{-# LANGUAGE LambdaCase #-}</span></a>
<a class="sourceLine" id="cb6-4" title="4"></a>
<a class="sourceLine" id="cb6-5" title="5"><span class="kw">import</span>           <span class="dt">Protolude</span> <span class="kw">hiding</span> (onException)</a>
<a class="sourceLine" id="cb6-6" title="6"><span class="kw">import</span>           <span class="dt">Prelude</span> (<span class="dt">String</span>)</a>
<a class="sourceLine" id="cb6-7" title="7"><span class="kw">import</span>           <span class="dt">Data.Map.Strict</span> (<span class="dt">Map</span>)</a>
<a class="sourceLine" id="cb6-8" title="8"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Map.Strict</span> <span class="kw">as</span> <span class="dt">Map</span></a>
<a class="sourceLine" id="cb6-9" title="9"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.List</span> <span class="kw">as</span> <span class="dt">Lst</span></a>
<a class="sourceLine" id="cb6-10" title="10"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Text</span> <span class="kw">as</span> <span class="dt">Txt</span></a>
<a class="sourceLine" id="cb6-11" title="11"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Text.IO</span> <span class="kw">as</span> <span class="dt">Txt</span></a>
<a class="sourceLine" id="cb6-12" title="12"><span class="kw">import</span>           <span class="dt">Data.Monoid</span> (mappend)</a>
<a class="sourceLine" id="cb6-13" title="13"><span class="kw">import</span>           <span class="dt">Hakyll</span></a>
<a class="sourceLine" id="cb6-14" title="14"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">System.Exit</span> <span class="kw">as</span> <span class="dt">Xit</span></a>
<a class="sourceLine" id="cb6-15" title="15"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">System.Process</span> <span class="kw">as</span> <span class="dt">Proc</span></a>
<a class="sourceLine" id="cb6-16" title="16"><span class="kw">import</span>           <span class="dt">System.FilePath</span> ((&lt;/&gt;))</a>
<a class="sourceLine" id="cb6-17" title="17"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">System.FilePath</span> <span class="kw">as</span> <span class="dt">FP</span></a>
<a class="sourceLine" id="cb6-18" title="18"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">System.Directory</span> <span class="kw">as</span> <span class="dt">Dir</span></a>
<a class="sourceLine" id="cb6-19" title="19"><span class="kw">import</span>           <span class="dt">Control.Exception.Safe</span> (onException, throwString)</a></code></pre></div>
<p>And a few helper functions for running shell processes and finding files</p>
<h6 id="site.hs-220-to-250">site.hs (220 to 250)</h6>
<div class="sourceCode" id="cb7"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb7-1" title="1"><span class="ot">runShell' ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb7-2" title="2">runShell' workingDir cmd <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-3" title="3">  putText cmd</a>
<a class="sourceLine" id="cb7-4" title="4">  runShell workingDir cmd <span class="fu">&gt;&gt;=</span> \<span class="kw">case</span></a>
<a class="sourceLine" id="cb7-5" title="5">    <span class="dt">Right</span> _ <span class="ot">-&gt;</span> pass</a>
<a class="sourceLine" id="cb7-6" title="6">    <span class="dt">Left</span> e <span class="ot">-&gt;</span> throwString <span class="fu">$</span> Txt.unpack <span class="st">&quot;Error running `&quot;</span> <span class="fu">&lt;&gt;</span> Txt.unpack cmd <span class="fu">&lt;&gt;</span> <span class="st">&quot;` &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> e</a>
<a class="sourceLine" id="cb7-7" title="7"></a>
<a class="sourceLine" id="cb7-8" title="8"><span class="ot">runShell ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> (<span class="dt">Either</span> <span class="dt">Int</span> ())</a>
<a class="sourceLine" id="cb7-9" title="9">runShell workingDir cmd <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-10" title="10">  <span class="kw">let</span> p <span class="fu">=</span> Proc.shell <span class="fu">$</span> Txt.unpack cmd</a>
<a class="sourceLine" id="cb7-11" title="11">  (_, _, _, phandle) <span class="ot">&lt;-</span> Proc.createProcess p { Proc.cwd <span class="fu">=</span> <span class="dt">Just</span> workingDir }</a>
<a class="sourceLine" id="cb7-12" title="12">  Proc.waitForProcess phandle <span class="fu">&gt;&gt;=</span> \<span class="kw">case</span></a>
<a class="sourceLine" id="cb7-13" title="13">    <span class="dt">Xit.ExitSuccess</span> <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="fu">$</span> <span class="dt">Right</span> ()</a>
<a class="sourceLine" id="cb7-14" title="14">    <span class="dt">Xit.ExitFailure</span> i <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="fu">$</span> <span class="dt">Left</span> i</a>
<a class="sourceLine" id="cb7-15" title="15"></a>
<a class="sourceLine" id="cb7-16" title="16"><span class="ot">getFilesRec ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> [<span class="dt">FilePath</span>]</a>
<a class="sourceLine" id="cb7-17" title="17">getFilesRec p <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-18" title="18">  fs <span class="ot">&lt;-</span> (p <span class="fu">&lt;/&gt;</span>) <span class="fu">&lt;&lt;$&gt;&gt;</span> getFiles p</a>
<a class="sourceLine" id="cb7-19" title="19">  ds <span class="ot">&lt;-</span> (p <span class="fu">&lt;/&gt;</span>) <span class="fu">&lt;&lt;$&gt;&gt;</span> getDirs p</a>
<a class="sourceLine" id="cb7-20" title="20">  cs <span class="ot">&lt;-</span> <span class="fu">traverse</span> getFilesRec ds</a>
<a class="sourceLine" id="cb7-21" title="21">  <span class="fu">pure</span> <span class="fu">$</span> fs <span class="fu">&lt;&gt;</span> join cs</a>
<a class="sourceLine" id="cb7-22" title="22"></a>
<a class="sourceLine" id="cb7-23" title="23"><span class="ot">getDirs ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> [<span class="dt">FilePath</span>]</a>
<a class="sourceLine" id="cb7-24" title="24">getDirs p <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-25" title="25">  entries <span class="ot">&lt;-</span> (p <span class="fu">&lt;/&gt;</span>) <span class="fu">&lt;&lt;$&gt;&gt;</span> Dir.listDirectory p</a>
<a class="sourceLine" id="cb7-26" title="26">  filterM Dir.doesDirectoryExist entries</a>
<a class="sourceLine" id="cb7-27" title="27"></a>
<a class="sourceLine" id="cb7-28" title="28"><span class="ot">getFiles ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> [<span class="dt">FilePath</span>]</a>
<a class="sourceLine" id="cb7-29" title="29">getFiles p <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-30" title="30">  entries <span class="ot">&lt;-</span> (p <span class="fu">&lt;/&gt;</span>) <span class="fu">&lt;&lt;$&gt;&gt;</span> Dir.listDirectory p</a>
<a class="sourceLine" id="cb7-31" title="31">  filterM Dir.doesFileExist entries</a></code></pre></div>
<h2 id="the-includecodecompiler">The includeCodeCompiler</h2>
<h6 id="site.hs-51-to-66">site.hs (51 to 66)</h6>
<div class="sourceCode" id="cb8"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb8-1" title="1"><span class="ot">includeCodeCompiler ::</span> <span class="dt">Compiler</span> (<span class="dt">Item</span> <span class="dt">String</span>)</a>
<a class="sourceLine" id="cb8-2" title="2">includeCodeCompiler <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb8-3" title="3">  p <span class="ot">&lt;-</span> getResourceFilePath</a>
<a class="sourceLine" id="cb8-4" title="4">  getResourceString <span class="fu">&gt;&gt;=</span> withItemBody (unsafeCompiler <span class="fu">.</span> includeCompile p)</a>
<a class="sourceLine" id="cb8-5" title="5"></a>
<a class="sourceLine" id="cb8-6" title="6">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb8-7" title="7"><span class="ot">    includeCompile ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">String</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">String</span></a>
<a class="sourceLine" id="cb8-8" title="8">    includeCompile compilingPath source <span class="fu">=</span> </a>
<a class="sourceLine" id="cb8-9" title="9">      includeCompile' source</a>
<a class="sourceLine" id="cb8-10" title="10">      <span class="ot">`onException`</span></a>
<a class="sourceLine" id="cb8-11" title="11">      <span class="fu">putStr</span> (<span class="st">&quot;Exception compiling includes for: &quot;</span> <span class="fu">&lt;&gt;</span> compilingPath)</a>
<a class="sourceLine" id="cb8-12" title="12"></a>
<a class="sourceLine" id="cb8-13" title="13"><span class="ot">    includeCompile' ::</span> <span class="dt">String</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">String</span></a>
<a class="sourceLine" id="cb8-14" title="14">    includeCompile' source <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb8-15" title="15">      <span class="kw">let</span> ls1 <span class="fu">=</span> Txt.lines <span class="fu">$</span> Txt.pack source </a>
<a class="sourceLine" id="cb8-16" title="16">      <span class="kw">let</span> (sourceNoSetup, repoPath', sha', cmds', path') <span class="fu">=</span> getConfig ls1 </a></code></pre></div>
<p>A pandoc compiler has the type <code>Compiler (Item String)</code>. Since this compiler needs to read file it has to be able to perform IO. To allow IO the <code>unsafeCompiler</code> function is used.</p>
<p>So this code, gets the current file path, the item body and starts the includeCompile in IO</p>
<div class="sourceCode" id="cb9"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb9-1" title="1">  p <span class="ot">&lt;-</span> getResourceFilePath</a>
<a class="sourceLine" id="cb9-2" title="2">  getResourceString <span class="fu">&gt;&gt;=</span> withItemBody (unsafeCompiler <span class="fu">.</span> includeCompile p)</a></code></pre></div>
<p><code>onException</code> is used to print the name of the file being compiled if there is an exception.</p>
<p>Once the config (repo, sha and commands) have been read the main compiler logic can be run.</p>
<h6 id="site.hs-70-to-110">site.hs (70 to 110)</h6>
<div class="sourceCode" id="cb10"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb10-1" title="1">      <span class="kw">case</span> path' <span class="kw">of</span></a>
<a class="sourceLine" id="cb10-2" title="2">        <span class="dt">Nothing</span> <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb10-3" title="3">          <span class="kw">case</span> (repoPath', sha', cmds') <span class="kw">of</span></a>
<a class="sourceLine" id="cb10-4" title="4">            (<span class="dt">Nothing</span>, <span class="dt">Nothing</span>, []) <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="fu">$</span> Txt.unpack <span class="fu">.</span> Txt.unlines <span class="fu">$</span> sourceNoSetup</a>
<a class="sourceLine" id="cb10-5" title="5">            (<span class="dt">Just</span> _, <span class="dt">Nothing</span>, _) <span class="ot">-&gt;</span> throwString <span class="st">&quot;No sha found&quot;</span></a>
<a class="sourceLine" id="cb10-6" title="6">            (<span class="dt">Just</span> _, _, []) <span class="ot">-&gt;</span> throwString <span class="st">&quot;No run commands found&quot;</span></a>
<a class="sourceLine" id="cb10-7" title="7">            (<span class="dt">Nothing</span>, _, (_<span class="fu">:</span>_)) <span class="ot">-&gt;</span> throwString <span class="st">&quot;No repo setup found&quot;</span></a>
<a class="sourceLine" id="cb10-8" title="8">            (<span class="dt">Nothing</span>, <span class="dt">Just</span> _, []) <span class="ot">-&gt;</span> throwString <span class="st">&quot;No repo setup found&quot;</span></a>
<a class="sourceLine" id="cb10-9" title="9">            (<span class="dt">Just</span> repoPath, <span class="dt">Just</span> sha, cmds) <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb10-10" title="10">              root <span class="ot">&lt;-</span> Dir.getCurrentDirectory</a>
<a class="sourceLine" id="cb10-11" title="11">              <span class="kw">let</span> tempPath <span class="fu">=</span> root <span class="fu">&lt;/&gt;</span> tmpDirectory defaultConfiguration <span class="fu">&lt;/&gt;</span> <span class="st">&quot;codeIncludeGit&quot;</span></a>
<a class="sourceLine" id="cb10-12" title="12"></a>
<a class="sourceLine" id="cb10-13" title="13">              <span class="co">-- Cleanup from previous post</span></a>
<a class="sourceLine" id="cb10-14" title="14">              removeDirectoryRecursiveIfExists tempPath</a>
<a class="sourceLine" id="cb10-15" title="15">              Dir.createDirectoryIfMissing <span class="dt">True</span> tempPath</a>
<a class="sourceLine" id="cb10-16" title="16">              <span class="co">-- Clone the git repo</span></a>
<a class="sourceLine" id="cb10-17" title="17">              runShell' root <span class="fu">$</span> <span class="st">&quot;git clone \&quot;&quot;</span> <span class="fu">&lt;&gt;</span> repoPath <span class="fu">&lt;&gt;</span> <span class="st">&quot;\&quot; \&quot;&quot;</span> <span class="fu">&lt;&gt;</span> Txt.pack tempPath <span class="fu">&lt;&gt;</span> <span class="st">&quot;\&quot;&quot;</span></a>
<a class="sourceLine" id="cb10-18" title="18">              <span class="co">-- Goto the correct sha (if it was specified)</span></a>
<a class="sourceLine" id="cb10-19" title="19">              gotoSha sha tempPath</a>
<a class="sourceLine" id="cb10-20" title="20">              <span class="co">-- Execute the run commands (buid, test etc)</span></a>
<a class="sourceLine" id="cb10-21" title="21">              executeRunCommands cmds tempPath</a>
<a class="sourceLine" id="cb10-22" title="22">              <span class="co">-- Delete all dirs we are not interested in (exclude .git and .stack-work)</span></a>
<a class="sourceLine" id="cb10-23" title="23">              removeDirectoryRecursiveIfExists <span class="fu">$</span> tempPath <span class="fu">&lt;/&gt;</span> <span class="st">&quot;.git&quot;</span></a>
<a class="sourceLine" id="cb10-24" title="24">              removeDirectoryRecursiveIfExists <span class="fu">$</span> tempPath <span class="fu">&lt;/&gt;</span> <span class="st">&quot;.stack-work&quot;</span></a>
<a class="sourceLine" id="cb10-25" title="25">              includeCode tempPath repoPath sha sourceNoSetup</a>
<a class="sourceLine" id="cb10-26" title="26"></a>
<a class="sourceLine" id="cb10-27" title="27">        <span class="dt">Just</span> path <span class="ot">-&gt;</span> </a>
<a class="sourceLine" id="cb10-28" title="28">          includeCode (Txt.unpack path) <span class="st">&quot;**local**&quot;</span> <span class="st">&quot;**local**&quot;</span> sourceNoSetup</a>
<a class="sourceLine" id="cb10-29" title="29"></a>
<a class="sourceLine" id="cb10-30" title="30">    includeCode tempPath repoPath sha sourceNoSetup <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb10-31" title="31">      <span class="co">-- Get all files in the repo </span></a>
<a class="sourceLine" id="cb10-32" title="32">      files <span class="ot">&lt;-</span> getFilesRec tempPath</a>
<a class="sourceLine" id="cb10-33" title="33">      <span class="co">-- All sections from all files</span></a>
<a class="sourceLine" id="cb10-34" title="34">      sections' <span class="ot">&lt;-</span> Map.fromList <span class="fu">.</span> <span class="fu">concat</span> <span class="fu">&lt;$&gt;</span> <span class="fu">traverse</span> getSections files</a>
<a class="sourceLine" id="cb10-35" title="35">      <span class="kw">let</span> sections <span class="fu">=</span> Map.map (\(p, s, e, lang, ls) <span class="ot">-&gt;</span> (<span class="fu">drop</span> (<span class="fu">length</span> tempPath <span class="fu">+</span> <span class="dv">1</span>) p, s, e, lang, ls)) sections' </a>
<a class="sourceLine" id="cb10-36" title="36">      <span class="co">-- Replace sections in the file</span></a>
<a class="sourceLine" id="cb10-37" title="37">      replaced' <span class="ot">&lt;-</span> <span class="fu">traverse</span> (replaceCodeLineSection tempPath sections) sourceNoSetup</a>
<a class="sourceLine" id="cb10-38" title="38">      <span class="kw">let</span> replaced <span class="fu">=</span> Txt.unlines <span class="fu">.</span> <span class="fu">concat</span> <span class="fu">$</span> replaced'</a>
<a class="sourceLine" id="cb10-39" title="39">      <span class="co">-- Replace sha and repo tokens</span></a>
<a class="sourceLine" id="cb10-40" title="40">      <span class="fu">pure</span> <span class="fu">.</span> Txt.unpack <span class="fu">.</span> Txt.replace <span class="st">&quot;2297510b93a903ab23a319f7921351a9725cef0e&quot;</span> sha <span class="fu">$</span> Txt.replace <span class="st">&quot;https://gist.github.com/53e179c4244411493ae1f9deebc3cc3f.git&quot;</span> repoPath replaced</a>
<a class="sourceLine" id="cb10-41" title="41">  </a></code></pre></div>
<h6 id="site.hs-114-to-121">site.hs (114 to 121)</h6>
<div class="sourceCode" id="cb11"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb11-1" title="1"><span class="ot">    executeRunCommands ::</span> [<span class="dt">Text</span>] <span class="ot">-&gt;</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb11-2" title="2">    executeRunCommands cmds path <span class="fu">=</span> </a>
<a class="sourceLine" id="cb11-3" title="3">      traverse_ (runShell' path) cmds</a>
<a class="sourceLine" id="cb11-4" title="4"></a>
<a class="sourceLine" id="cb11-5" title="5"><span class="ot">    gotoSha ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb11-6" title="6">    gotoSha sha tmpPath <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb11-7" title="7">      runShell' tmpPath (<span class="st">&quot;git reset &quot;</span> <span class="fu">&lt;&gt;</span> sha <span class="fu">&lt;&gt;</span> <span class="st">&quot; --hard&quot;</span>) </a>
<a class="sourceLine" id="cb11-8" title="8">      void <span class="fu">$</span> runShell tmpPath <span class="st">&quot;git clean -dfx&quot;</span></a></code></pre></div>
<p>This code does the following</p>
<ol type="1">
<li>Pre-clone cleanup</li>
<li>Clone</li>
<li>Goto the configured commit</li>
<li>Run the commands</li>
<li>Read all the sections from the files</li>
<li>Import the sections into the markdown</li>
</ol>
<h2 id="details">Details</h2>
<p>Loading the config is done quite simply by filtering the source lines</p>
<h6 id="site.hs-126-to-142">site.hs (126 to 142)</h6>
<div class="sourceCode" id="cb12"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb12-1" title="1">  getConfig ls <span class="fu">=</span></a>
<a class="sourceLine" id="cb12-2" title="2">    <span class="kw">let</span></a>
<a class="sourceLine" id="cb12-3" title="3">      cfgPath <span class="fu">=</span> <span class="st">&quot;[&lt;code setup.path&gt;]&quot;</span></a>
<a class="sourceLine" id="cb12-4" title="4">      cfgRepo <span class="fu">=</span> <span class="st">&quot;[&lt;code setup.repo&gt;]&quot;</span></a>
<a class="sourceLine" id="cb12-5" title="5">      cfgSha <span class="fu">=</span> <span class="st">&quot;[&lt;code setup.sha&gt;]&quot;</span></a>
<a class="sourceLine" id="cb12-6" title="6">      cfgRun <span class="fu">=</span> <span class="st">&quot;[&lt;code setup.run&gt;]&quot;</span></a>
<a class="sourceLine" id="cb12-7" title="7">      path <span class="fu">=</span> Txt.strip <span class="fu">.</span> Txt.drop (Txt.length cfgRepo) <span class="fu">&lt;$&gt;</span> headMay (<span class="fu">filter</span> (Txt.isPrefixOf cfgPath) ls)</a>
<a class="sourceLine" id="cb12-8" title="8">      repo <span class="fu">=</span> Txt.strip <span class="fu">.</span> Txt.drop (Txt.length cfgRepo) <span class="fu">&lt;$&gt;</span> headMay (<span class="fu">filter</span> (Txt.isPrefixOf cfgRepo) ls)</a>
<a class="sourceLine" id="cb12-9" title="9">      sha <span class="fu">=</span> Txt.strip <span class="fu">.</span> Txt.drop (Txt.length cfgSha) <span class="fu">&lt;$&gt;</span> headMay (<span class="fu">filter</span> (Txt.isPrefixOf cfgSha) ls)</a>
<a class="sourceLine" id="cb12-10" title="10">      run <span class="fu">=</span> Txt.strip <span class="fu">.</span> Txt.drop (Txt.length cfgRun) <span class="fu">&lt;$&gt;</span> <span class="fu">filter</span> (Txt.isPrefixOf cfgRun) ls</a>
<a class="sourceLine" id="cb12-11" title="11">    <span class="kw">in</span></a>
<a class="sourceLine" id="cb12-12" title="12">    (<span class="fu">filter</span> (<span class="fu">not</span> <span class="fu">.</span> Txt.isPrefixOf <span class="st">&quot;[&lt;code setup.&quot;</span>) ls, repo, sha, run, path)</a>
<a class="sourceLine" id="cb12-13" title="13">      </a>
<a class="sourceLine" id="cb12-14" title="14">  removeDirectoryRecursiveIfExists p <span class="fu">=</span> </a>
<a class="sourceLine" id="cb12-15" title="15">    Dir.doesDirectoryExist p <span class="fu">&gt;&gt;=</span> \<span class="kw">case</span></a>
<a class="sourceLine" id="cb12-16" title="16">      <span class="dt">True</span> <span class="ot">-&gt;</span> Dir.removeDirectoryRecursive p</a>
<a class="sourceLine" id="cb12-17" title="17">      <span class="dt">False</span> <span class="ot">-&gt;</span> pass</a></code></pre></div>
<p>And once the sections have been loaded from the source code the tags can be replaced in the markdown. Each <code>[&lt;code&gt;]</code> tag is replaced by a markdown code block, a title showing the source file and offset.</p>
<h6 id="site.hs-147-to-175">site.hs (147 to 175)</h6>
<div class="sourceCode" id="cb13"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb13-1" title="1"><span class="ot">    replaceCodeLineSection ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">Map</span> <span class="dt">Text</span> (<span class="dt">FilePath</span>, <span class="dt">Int</span>, <span class="dt">Int</span>, <span class="dt">Text</span>, [<span class="dt">Text</span>]) <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> [<span class="dt">Text</span>]</a>
<a class="sourceLine" id="cb13-2" title="2">    replaceCodeLineSection tempPath sections line <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb13-3" title="3">      <span class="kw">let</span> codeTag <span class="fu">=</span> <span class="st">&quot;[&lt;code&gt;]&quot;</span> </a>
<a class="sourceLine" id="cb13-4" title="4">      <span class="kw">let</span> includeTag <span class="fu">=</span> <span class="st">&quot;[&lt;include&gt;]&quot;</span> </a>
<a class="sourceLine" id="cb13-5" title="5"></a>
<a class="sourceLine" id="cb13-6" title="6">      <span class="kw">if</span> Txt.isPrefixOf codeTag line </a>
<a class="sourceLine" id="cb13-7" title="7">        <span class="kw">then</span></a>
<a class="sourceLine" id="cb13-8" title="8">          <span class="kw">let</span> secName <span class="fu">=</span> Txt.strip <span class="fu">.</span> Txt.drop (Txt.length codeTag) <span class="fu">$</span> line <span class="kw">in</span></a>
<a class="sourceLine" id="cb13-9" title="9">          <span class="kw">case</span> Map.lookup secName sections <span class="kw">of</span></a>
<a class="sourceLine" id="cb13-10" title="10">            <span class="dt">Nothing</span> <span class="ot">-&gt;</span> throwString <span class="fu">$</span> Txt.unpack <span class="fu">$</span> <span class="st">&quot;No section named &quot;</span> <span class="fu">&lt;&gt;</span> secName</a>
<a class="sourceLine" id="cb13-11" title="11">            <span class="dt">Just</span> (path, start, end, lang, code) <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb13-12" title="12">              <span class="kw">let</span> title <span class="fu">=</span> Txt.pack path <span class="fu">&lt;&gt;</span> <span class="st">&quot; (&quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> start <span class="fu">&lt;&gt;</span> <span class="st">&quot; to &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> end <span class="fu">&lt;&gt;</span> <span class="st">&quot;)&quot;</span> <span class="kw">in</span></a>
<a class="sourceLine" id="cb13-13" title="13"></a>
<a class="sourceLine" id="cb13-14" title="14">              <span class="fu">pure</span> [ <span class="st">&quot;###### &quot;</span> <span class="fu">&lt;&gt;</span> title</a>
<a class="sourceLine" id="cb13-15" title="15">                   , <span class="st">&quot;&quot;</span></a>
<a class="sourceLine" id="cb13-16" title="16">                   , <span class="st">&quot;~~~{.&quot;</span> <span class="fu">&lt;&gt;</span> lang <span class="fu">&lt;&gt;</span> <span class="st">&quot;}&quot;</span></a>
<a class="sourceLine" id="cb13-17" title="17">                   , Txt.unlines code</a>
<a class="sourceLine" id="cb13-18" title="18">                   , <span class="st">&quot;~~~&quot;</span></a>
<a class="sourceLine" id="cb13-19" title="19">                   , <span class="st">&quot;&quot;</span></a>
<a class="sourceLine" id="cb13-20" title="20">                   ]</a>
<a class="sourceLine" id="cb13-21" title="21">        <span class="kw">else</span></a>
<a class="sourceLine" id="cb13-22" title="22">          <span class="kw">if</span> <span class="fu">not</span> <span class="fu">$</span> Txt.isPrefixOf includeTag line </a>
<a class="sourceLine" id="cb13-23" title="23">            <span class="kw">then</span> <span class="fu">pure</span> [line]</a>
<a class="sourceLine" id="cb13-24" title="24">            <span class="kw">else</span></a>
<a class="sourceLine" id="cb13-25" title="25">              <span class="kw">let</span></a>
<a class="sourceLine" id="cb13-26" title="26">                incRelPath <span class="fu">=</span> Txt.strip <span class="fu">.</span> Txt.drop (Txt.length includeTag) <span class="fu">$</span> line </a>
<a class="sourceLine" id="cb13-27" title="27">                incFullPath <span class="fu">=</span> tempPath <span class="fu">&lt;/&gt;</span> Txt.unpack incRelPath</a>
<a class="sourceLine" id="cb13-28" title="28">              <span class="kw">in</span></a>
<a class="sourceLine" id="cb13-29" title="29">              <span class="fu">sequenceA</span> [Txt.readFile incFullPath]</a></code></pre></div>
<h2 id="getting-sections-from-the-repo">Getting sections from the repo</h2>
<h6 id="site.hs-181-to-215">site.hs (181 to 215)</h6>
<div class="sourceCode" id="cb14"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb14-1" title="1"><span class="kw">type</span> <span class="dt">LineState</span> <span class="fu">=</span> (<span class="dt">Int</span>, [(<span class="dt">Text</span>, (<span class="dt">FilePath</span>, <span class="dt">Int</span>, <span class="dt">Int</span>, <span class="dt">Text</span>, [<span class="dt">Text</span>]))]) </a>
<a class="sourceLine" id="cb14-2" title="2"></a>
<a class="sourceLine" id="cb14-3" title="3"><span class="ot">getSections ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> [(<span class="dt">Text</span>, (<span class="dt">FilePath</span>, <span class="dt">Int</span>, <span class="dt">Int</span>, <span class="dt">Text</span>, [<span class="dt">Text</span>]))]</a>
<a class="sourceLine" id="cb14-4" title="4">getSections f <span class="fu">=</span> </a>
<a class="sourceLine" id="cb14-5" title="5">  <span class="kw">case</span> FP.takeExtension f <span class="kw">of</span></a>
<a class="sourceLine" id="cb14-6" title="6">    <span class="st">&quot;.hs&quot;</span> <span class="ot">-&gt;</span> getLangSections <span class="st">&quot;{-! SECTION&lt; &quot;</span> <span class="st">&quot;{-! SECTION&gt; &quot;</span> <span class="st">&quot;{-! SECTION&quot;</span> <span class="st">&quot;haskell&quot;</span></a>
<a class="sourceLine" id="cb14-7" title="7">    <span class="st">&quot;.js&quot;</span> <span class="ot">-&gt;</span> getLangSections <span class="st">&quot;//!SECTION&lt; &quot;</span> <span class="st">&quot;//!SECTION&gt; &quot;</span> <span class="st">&quot;//!SECTION&quot;</span> <span class="st">&quot;javascript&quot;</span></a>
<a class="sourceLine" id="cb14-8" title="8">    <span class="st">&quot;.html&quot;</span> <span class="ot">-&gt;</span> getLangSections <span class="st">&quot;&lt;!-- !SECTION+ &quot;</span> <span class="st">&quot;&lt;!-- !SECTION- &quot;</span> <span class="st">&quot;&lt;!-- !SECTION&quot;</span> <span class="st">&quot;html&quot;</span></a>
<a class="sourceLine" id="cb14-9" title="9">    <span class="st">&quot;.css&quot;</span> <span class="ot">-&gt;</span> getLangSections <span class="st">&quot;/* !SECTION&lt; &quot;</span> <span class="st">&quot;/* !SECTION&gt; &quot;</span> <span class="st">&quot;/* !SECTION&quot;</span> <span class="st">&quot;html&quot;</span></a>
<a class="sourceLine" id="cb14-10" title="10">    _ <span class="ot">-&gt;</span> <span class="fu">pure</span> []</a>
<a class="sourceLine" id="cb14-11" title="11">  </a>
<a class="sourceLine" id="cb14-12" title="12">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb14-13" title="13">    getLangSections startToken endToken cleanToken lang <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb14-14" title="14">      ls <span class="ot">&lt;-</span> Txt.lines <span class="fu">&lt;$&gt;</span> Txt.readFile f</a>
<a class="sourceLine" id="cb14-15" title="15">      (_, r) <span class="ot">&lt;-</span> foldlM (parseLine ls) (<span class="dv">1</span>, []) ls</a>
<a class="sourceLine" id="cb14-16" title="16">      <span class="fu">pure</span> r</a>
<a class="sourceLine" id="cb14-17" title="17"></a>
<a class="sourceLine" id="cb14-18" title="18">      <span class="kw">where</span></a>
<a class="sourceLine" id="cb14-19" title="19"><span class="ot">        parseLine ::</span> [<span class="dt">Text</span>] <span class="ot">-&gt;</span> <span class="dt">LineState</span> <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">LineState</span></a>
<a class="sourceLine" id="cb14-20" title="20">        parseLine ls (lineNum, hist) l <span class="fu">=</span></a>
<a class="sourceLine" id="cb14-21" title="21">          <span class="kw">if</span> <span class="fu">not</span> <span class="fu">.</span> Txt.isPrefixOf startToken <span class="fu">.</span> Txt.strip <span class="fu">$</span> l</a>
<a class="sourceLine" id="cb14-22" title="22">          <span class="kw">then</span> <span class="fu">pure</span> (lineNum <span class="fu">+</span> <span class="dv">1</span>, hist)</a>
<a class="sourceLine" id="cb14-23" title="23">          <span class="kw">else</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb14-24" title="24">            <span class="kw">let</span> secName <span class="fu">=</span> Txt.strip <span class="fu">.</span> <span class="fu">fst</span> <span class="fu">.</span> Txt.breakOn <span class="st">&quot; &quot;</span> <span class="fu">.</span> Txt.strip <span class="fu">.</span> Txt.drop (Txt.length startToken) <span class="fu">.</span> Txt.strip <span class="fu">$</span> l </a>
<a class="sourceLine" id="cb14-25" title="25">            end <span class="ot">&lt;-</span> scanForEnd ls secName lineNum</a>
<a class="sourceLine" id="cb14-26" title="26">            <span class="fu">pure</span> (lineNum <span class="fu">+</span> <span class="dv">1</span>, (secName, (f, lineNum <span class="fu">+</span> <span class="dv">1</span>, lineNum <span class="fu">+</span> <span class="fu">length</span> end, lang, end)) <span class="fu">:</span> hist)</a>
<a class="sourceLine" id="cb14-27" title="27"></a>
<a class="sourceLine" id="cb14-28" title="28">        scanForEnd ls secName fromLine <span class="fu">=</span></a>
<a class="sourceLine" id="cb14-29" title="29">          <span class="kw">let</span> fromOffset <span class="fu">=</span> <span class="fu">drop</span> fromLine ls <span class="kw">in</span></a>
<a class="sourceLine" id="cb14-30" title="30">          <span class="kw">case</span> Lst.span (<span class="fu">not</span> <span class="fu">.</span> Txt.isPrefixOf (endToken <span class="fu">&lt;&gt;</span> secName) <span class="fu">.</span> Txt.strip) fromOffset <span class="kw">of</span></a>
<a class="sourceLine" id="cb14-31" title="31">            (_, []) <span class="ot">-&gt;</span> throwString <span class="fu">$</span> <span class="st">&quot;No section end found for: &quot;</span> <span class="fu">&lt;&gt;</span> Txt.unpack secName</a>
<a class="sourceLine" id="cb14-32" title="32">            (r, _) <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="fu">$</span> <span class="fu">filter</span> cleanLine r</a>
<a class="sourceLine" id="cb14-33" title="33"></a>
<a class="sourceLine" id="cb14-34" title="34">        cleanLine <span class="fu">=</span></a>
<a class="sourceLine" id="cb14-35" title="35">          <span class="fu">not</span> <span class="fu">.</span> Txt.isPrefixOf cleanToken <span class="fu">.</span> Txt.strip</a></code></pre></div>
<p>Different types of files will need different tag styles. In the code above I’m handling haskell, javascript, css and HTML. You should be able to fairly easily add this to other languages as well.</p>
<p><code>parseLine</code> works by going line by line looking for a start token, and for each one that it finds it scans to find the end token. This is a little inefficient but it allows for nested and/or overlapping tags.</p>
<h1 id="code-includes">Code includes</h1>
<p>Sometimes it is useful to include external files into a post. The <code>[&lt;include&gt;]</code> tag makes this simple.</p>
<p>For example <code>[&lt;include&gt;] /home/user/static/interestingStuff.json</code>. Unlike the <code>[&lt;code&gt;]</code> tag, no assumptions are made about the included text. If you want it syntax highlighted simply wrap the text in a code fence.</p>
<h1 id="speeding-up-the-writing-process">Speeding up the writing process</h1>
<p>Fetching the code from a remote repo and doing a full build each time can be pretty slow. This is fine when you are confirming that everything works correctly, but its not idea when you are writing a post and still making many small changes. To help with this there is a <code>[&lt;code setup.path&gt;]</code> tag. This tag overrides the repo and run settings. If it is present then all code sections will be read from this path directly without any fetching, building or running of commands.</p>
<p>e.g. <code>[&lt;code setup.path&gt;] /home/user/dev/myProject</code></p>
<p>Obviously it is important that you remove this setting once the post is done.</p>
<h1 id="using-the-compiler">Using the compiler</h1>
<p>Once you add this to your hakyll you can be sure that you are only using working code blocks. While there is a bit of code in this compiler most of it is for dealing with the file IO and parsing. I think it also shows how easily hakyll can be customised to do useful things.</p>
<p>This code works with hakyll 4.10.0.0. See the cabal file in the gist for other dependencies</p>
<h1 id="links">Links</h1>
<ul>
<li><a href="https://gist.github.com/andrevdm/53e179c4244411493ae1f9deebc3cc3f">Code on github</a> 2297510b93a903ab23a319f7921351a9725cef0e</li>
<li><a href="https://jaspervdj.be/hakyll/tutorials.html">Hakyll tutorial</a></li>
<li><a href="https://medium.com/@phlummox/the-simplest-custom-hakyll-compiler-6ee7b189a6c6">The simplest custom Hakyll compiler</a></li>
</ul>


        </div>
        <div id="footer">
            Site proudly generated by
            <a href="http://jaspervdj.be/hakyll">Hakyll</a>
        </div>
        </div>

        <script>
          (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
          (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
          m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
          })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

          ga('create', 'UA-78428674-1', 'auto');
          ga('send', 'pageview');
        </script>
    </body>
</html>
]]></summary>
</entry>
<entry>
    <title>bhoogle - Building a simple hoogle GUI with brick</title>
    <link href="http://www.andrevdm.com/posts/2018-01-15-bhoogle.html" />
    <id>http://www.andrevdm.com/posts/2018-01-15-bhoogle.html</id>
    <published>2018-01-15T00:00:00Z</published>
    <updated>2018-01-15T00:00:00Z</updated>
    <summary type="html"><![CDATA[<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
        <title>Andre's Blog</title>
        <link rel="stylesheet" type="text/css" href="../css/default.css" />
        <link rel="stylesheet" type="text/css" href="../css/syntax.css" />
    </head>
    <body>
      <div id="bodyInner">
        <div id="header">
            <div id="logo">
                <a href="../">Blog</a>
            </div>
            <div id="navigation">
                <a href="../">Home</a>
                <a href="../contact.html">Contact</a>
                <!-- <a href="/about.html">About</a> -->
            </div>
        </div>

        <div id="content">
            <h1><a href="#top">bhoogle - Building a simple hoogle GUI with brick</a></h1>

            <div class="info">
    Posted on January 15, 2018

</div>

<p><strong>NB</strong>. This is using an old version of brick. <a href="http://www.andrevdm.com/posts/2022-09-07-bhoogle.html">Please see this post</a> for a brick 1.1 updated version</p>
<hr />

<h1 id="overview">Overview</h1>
<p>bhoogle is a simple hoogle terminal GUI written using <a href="https://hackage.haskell.org/package/brick">brick</a>. This post is the annotated source code that should give you an idea of how to use brick and how easy brick makes building terminal UIs.</p>
<h2 id="bhoogle">bhoogle</h2>
<p><img src="../images/bhoogle.png" /></p>
<p>bhoogle is possibly useful as a local hoogle UI as well as a demo app. You can get the full code from <a href="https://github.com/andrevdm/bhoogle">github</a>.</p>
<h3 id="setup">Setup</h3>
<p>You will need an existing local hoogle database. If you do not already have one or are unsure, then do this</p>
<ol type="1">
<li>Install hoogle (e.g. <code>stack install hoogle</code>)</li>
<li>Generate the default database (<code>hoogle generate</code>)</li>
</ol>
<h3 id="build">Build</h3>
<p>You can then <a href="https://github.com/andrevdm/bhoogle">clone the code</a>, or download one of the pre-build <a href="https://github.com/andrevdm/bhoogle/releases">linux releases</a></p>
<h3 id="usage">Usage</h3>
<ol type="1">
<li>Enter a type search in the “type” edit box</li>
<li>Press <strong>enter</strong> to search: focus goes directly to the results list</li>
<li>Or press <strong>tab</strong> to search and focus will go to the “text” edit box</li>
<li>You can then filter the results by typing in the “text” edit box, any result containing the sub-string typed will be shown</li>
<li>Navigate the results by using <strong>arrow</strong> or vi (<strong>hjkl</strong>) keys</li>
<li>Pressing <strong>‘s’</strong> in the results list will toggle the sort order</li>
<li><strong>Escape</strong> to exit</li>
<li>Search-ahead is enable for any type search longer than three characters</li>
</ol>
<h1 id="brick">Brick</h1>
<p>There are a few conventions to get used to when building a brick UI, but I don’t think it should take you too long to get the hang of things.</p>
<p>The <a href="https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst">brick user guide</a> and documentation are fantastic. Brick comes with multiple example apps that show controls and features being used. There are also third party tutorials e.g. <a href="https://github.com/jtdaugherty/brick/blob/master/docs/samtay-tutorial.md">Samuel Tay’s brick tutorial</a></p>
<h1 id="bhoogle-0.1.1.0-source">bhoogle 0.1.1.0 source</h1>
<p>If you have looked at the user guide or Samuel Tay’s tutorial you’ll already have some idea of the fundamental concepts. Below is the annotated source for bhoogle. As always feel free to email or contact me on <a href="https://twitter.com/andrevdm">twitter</a> if anything is unclear and I’ll do my best to assist.</p>
<div class="sourceCode" id="cb1"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb1-1" title="1"><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></a>
<a class="sourceLine" id="cb1-2" title="2"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></a>
<a class="sourceLine" id="cb1-3" title="3"><span class="ot">{-# LANGUAGE TemplateHaskell #-}</span></a>
<a class="sourceLine" id="cb1-4" title="4"></a>
<a class="sourceLine" id="cb1-5" title="5"><span class="kw">module</span> <span class="dt">Main</span> <span class="kw">where</span></a>
<a class="sourceLine" id="cb1-6" title="6"></a>
<a class="sourceLine" id="cb1-7" title="7"><span class="kw">import</span>           <span class="dt">Protolude</span></a>
<a class="sourceLine" id="cb1-8" title="8"><span class="kw">import</span>           <span class="dt">Control.Lens</span> ((^.), (.~), (%~))</a>
<a class="sourceLine" id="cb1-9" title="9"><span class="kw">import</span>           <span class="dt">Control.Lens.TH</span> (makeLenses)</a>
<a class="sourceLine" id="cb1-10" title="10"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.List</span> <span class="kw">as</span> <span class="dt">Lst</span></a>
<a class="sourceLine" id="cb1-11" title="11"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Time</span> <span class="kw">as</span> <span class="dt">Tm</span></a>
<a class="sourceLine" id="cb1-12" title="12"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Text</span> <span class="kw">as</span> <span class="dt">Txt</span></a>
<a class="sourceLine" id="cb1-13" title="13"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Vector</span> <span class="kw">as</span> <span class="dt">Vec</span></a>
<a class="sourceLine" id="cb1-14" title="14"><span class="kw">import</span>           <span class="dt">Brick</span> ((&lt;+&gt;), (&lt;=&gt;))</a>
<a class="sourceLine" id="cb1-15" title="15"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick</span> <span class="kw">as</span> <span class="dt">B</span></a>
<a class="sourceLine" id="cb1-16" title="16"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.BChan</span> <span class="kw">as</span> <span class="dt">BCh</span></a>
<a class="sourceLine" id="cb1-17" title="17"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.Focus</span> <span class="kw">as</span> <span class="dt">BF</span></a>
<a class="sourceLine" id="cb1-18" title="18"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.AttrMap</span> <span class="kw">as</span> <span class="dt">BA</span></a>
<a class="sourceLine" id="cb1-19" title="19"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.Widgets.List</span> <span class="kw">as</span> <span class="dt">BL</span></a>
<a class="sourceLine" id="cb1-20" title="20"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.Widgets.Edit</span> <span class="kw">as</span> <span class="dt">BE</span></a>
<a class="sourceLine" id="cb1-21" title="21"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.Widgets.Border</span> <span class="kw">as</span> <span class="dt">BB</span></a>
<a class="sourceLine" id="cb1-22" title="22"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Brick.Widgets.Border.Style</span> <span class="kw">as</span> <span class="dt">BBS</span></a>
<a class="sourceLine" id="cb1-23" title="23"><span class="kw">import</span>           <span class="dt">Control.Concurrent</span> (threadDelay, forkIO)</a>
<a class="sourceLine" id="cb1-24" title="24"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Graphics.Vty</span> <span class="kw">as</span> <span class="dt">V</span></a>
<a class="sourceLine" id="cb1-25" title="25"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Graphics.Vty.Input.Events</span> <span class="kw">as</span> <span class="dt">K</span></a>
<a class="sourceLine" id="cb1-26" title="26"></a>
<a class="sourceLine" id="cb1-27" title="27"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Hoogle</span> <span class="kw">as</span> <span class="dt">H</span></a></code></pre></div>
<p>Import all the modules we’ll need. I’m using <a href="https://github.com/sdiehl/protolude">protolude</a> as my custom prelude, changing to one of the others e.g. <a href="https://hackage.haskell.org/package/classy-prelude">classy</a> should be pretty simple if you prefer that.</p>
<p>I’m also using lens. The brick examples use lens so its worth getting used to. However I’m only using three of the simpler lenses, so if you don’t like lens or template haskell it should be easy enough to remove them.</p>
<div class="sourceCode" id="cb2"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb2-1" title="1"><span class="co">-- | Events that can be sent</span></a>
<a class="sourceLine" id="cb2-2" title="2"><span class="co">-- | Here there is just one event for updating the time</span></a>
<a class="sourceLine" id="cb2-3" title="3"><span class="kw">newtype</span> <span class="dt">Event</span> <span class="fu">=</span> <span class="dt">EventUpdateTime</span> <span class="dt">Tm.LocalTime</span></a>
<a class="sourceLine" id="cb2-4" title="4"></a>
<a class="sourceLine" id="cb2-5" title="5"><span class="co">-- | Names use to identify each of the controls</span></a>
<a class="sourceLine" id="cb2-6" title="6"><span class="kw">data</span> <span class="dt">Name</span> <span class="fu">=</span> <span class="dt">TypeSearch</span></a>
<a class="sourceLine" id="cb2-7" title="7">          <span class="fu">|</span> <span class="dt">TextSearch</span></a>
<a class="sourceLine" id="cb2-8" title="8">          <span class="fu">|</span> <span class="dt">ListResults</span></a>
<a class="sourceLine" id="cb2-9" title="9">          <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>, <span class="dt">Ord</span>)</a></code></pre></div>
<p>Next we need to define the type of custom events that our brick application can handle and a sum type defining the “name” for each control we want to use.</p>
<p>In this example there is only a single event <strong>EventUpdateTime</strong>. It is sent once a second with the current time. This gets displayed by brick in the top right corner</p>
<p>There are three controls</p>
<ol type="1">
<li>The edit box for the type to search for</li>
<li>The edit box for the substring search</li>
<li>The results listbox</li>
</ol>
<div class="sourceCode" id="cb3"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb3-1" title="1"><span class="co">-- | Sort order</span></a>
<a class="sourceLine" id="cb3-2" title="2"><span class="kw">data</span> <span class="dt">SortBy</span> <span class="fu">=</span> <span class="dt">SortNone</span></a>
<a class="sourceLine" id="cb3-3" title="3">            <span class="fu">|</span> <span class="dt">SortAsc</span></a>
<a class="sourceLine" id="cb3-4" title="4">            <span class="fu">|</span> <span class="dt">SortDec</span></a>
<a class="sourceLine" id="cb3-5" title="5">            <span class="kw">deriving</span> (<span class="dt">Eq</span>)</a>
<a class="sourceLine" id="cb3-6" title="6"></a>
<a class="sourceLine" id="cb3-7" title="7"></a>
<a class="sourceLine" id="cb3-8" title="8"><span class="co">-- | State of the brick app. Contains the controls and any other required state</span></a>
<a class="sourceLine" id="cb3-9" title="9"><span class="kw">data</span> <span class="dt">BrickState</span> <span class="fu">=</span> <span class="dt">BrickState</span> </a>
<a class="sourceLine" id="cb3-10" title="10">     {<span class="ot"> _stEditType ::</span> <span class="fu">!</span>(<span class="dt">BE.Editor</span> <span class="dt">Text</span> <span class="dt">Name</span>)      <span class="co">-- ^ Editor for the type to search for</span></a>
<a class="sourceLine" id="cb3-11" title="11">     ,<span class="ot"> _stEditText ::</span> <span class="fu">!</span>(<span class="dt">BE.Editor</span> <span class="dt">Text</span> <span class="dt">Name</span>)      <span class="co">-- ^ Editor for a text search in the results</span></a>
<a class="sourceLine" id="cb3-12" title="12">     ,<span class="ot"> _stResultsList ::</span> <span class="fu">!</span>(<span class="dt">BL.List</span> <span class="dt">Name</span> <span class="dt">H.Target</span>) <span class="co">-- ^ List for the search results</span></a>
<a class="sourceLine" id="cb3-13" title="13">     ,<span class="ot"> _stFocus ::</span> <span class="fu">!</span>(<span class="dt">BF.FocusRing</span> <span class="dt">Name</span>)           <span class="co">-- ^ Focus ring - a circular list of focusable controls</span></a>
<a class="sourceLine" id="cb3-14" title="14">     ,<span class="ot"> _stTime ::</span> <span class="fu">!</span><span class="dt">Tm.LocalTime</span>                   <span class="co">-- ^ The current time</span></a>
<a class="sourceLine" id="cb3-15" title="15">     ,<span class="ot"> _stResults ::</span> [<span class="dt">H.Target</span>]                   <span class="co">-- ^ The last set of search results from hoohle</span></a>
<a class="sourceLine" id="cb3-16" title="16">     ,<span class="ot"> _stSortResults ::</span> <span class="dt">SortBy</span>                   <span class="co">-- ^ Current sort order for the results</span></a>
<a class="sourceLine" id="cb3-17" title="17">     }</a>
<a class="sourceLine" id="cb3-18" title="18"></a>
<a class="sourceLine" id="cb3-19" title="19">makeLenses '<span class="dt">'BrickState</span></a></code></pre></div>
<p><strong>BrickState</strong> contains the current state of the brick application. Any event e.g. the custom update time event, or any key press event can result in the state being updated. There is a separate draw function that renders the state.</p>
<p>I.e. one part of the code deals with events, roughly <code>state -&gt; event -&gt; state</code> and another handles the drawing <code>state -&gt; GUI</code></p>
<p>Here the state contains</p>
<ol type="1">
<li>The three controls mentioned above (two edit + one listbox)</li>
<li>A focus ring. (A <a href="https://hackage.haskell.org/package/brick-0.33/docs/Brick-Focus.html">focus ring</a> is a circular list of control names that helps your code keep track of which control has the current focus).</li>
<li>The last updated current time</li>
<li>The last search result</li>
<li>The current sort order, so that it can be toggled between ascending and descending</li>
</ol>
<div class="sourceCode" id="cb4"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb4-1" title="1"><span class="co">-- | Defines how the brick application will work / handle events</span></a>
<a class="sourceLine" id="cb4-2" title="2"><span class="ot">app ::</span> <span class="dt">B.App</span> <span class="dt">BrickState</span> <span class="dt">Event</span> <span class="dt">Name</span></a>
<a class="sourceLine" id="cb4-3" title="3">app <span class="fu">=</span> <span class="dt">B.App</span> { B.appDraw <span class="fu">=</span> drawUI</a>
<a class="sourceLine" id="cb4-4" title="4">            , B.appChooseCursor <span class="fu">=</span> B.showFirstCursor</a>
<a class="sourceLine" id="cb4-5" title="5">            , B.appHandleEvent <span class="fu">=</span> handleEvent</a>
<a class="sourceLine" id="cb4-6" title="6">            , B.appStartEvent <span class="fu">=</span> <span class="fu">pure</span></a>
<a class="sourceLine" id="cb4-7" title="7">            , B.appAttrMap <span class="fu">=</span> <span class="fu">const</span> theMap</a>
<a class="sourceLine" id="cb4-8" title="8">            }</a></code></pre></div>
<p>The <strong>App</strong> type defines how the brick app operates, but defining how events are handled (<code>appHandleEvent</code>) and how the GUI is drawn (<code>appDraw</code>)</p>
<div class="sourceCode" id="cb5"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb5-1" title="1"><span class="ot">main ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb5-2" title="2">main <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb5-3" title="3">  chan <span class="ot">&lt;-</span> BCh.newBChan <span class="dv">5</span> <span class="co">-- ^ create a bounded channel for events</span></a>
<a class="sourceLine" id="cb5-4" title="4"></a>
<a class="sourceLine" id="cb5-5" title="5">  <span class="co">-- Send a tick event every 1 seconds with the current time</span></a>
<a class="sourceLine" id="cb5-6" title="6">  <span class="co">-- Brick will send this to our event handler which can then update the stTime field</span></a>
<a class="sourceLine" id="cb5-7" title="7">  void <span class="fu">.</span> forkIO <span class="fu">$</span> forever <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb5-8" title="8">    t <span class="ot">&lt;-</span> getTime </a>
<a class="sourceLine" id="cb5-9" title="9">    BCh.writeBChan chan <span class="fu">$</span> <span class="dt">EventUpdateTime</span> t</a>
<a class="sourceLine" id="cb5-10" title="10">    threadDelay <span class="fu">$</span> <span class="dv">1</span> <span class="fu">*</span> <span class="dv">1000000</span></a>
<a class="sourceLine" id="cb5-11" title="11"></a>
<a class="sourceLine" id="cb5-12" title="12">  <span class="co">-- Initial current time value</span></a>
<a class="sourceLine" id="cb5-13" title="13">  t <span class="ot">&lt;-</span> getTime</a>
<a class="sourceLine" id="cb5-14" title="14"></a>
<a class="sourceLine" id="cb5-15" title="15">  <span class="co">-- Construct the initial state values</span></a>
<a class="sourceLine" id="cb5-16" title="16">  <span class="kw">let</span> st <span class="fu">=</span> <span class="dt">BrickState</span> { _stEditType <span class="fu">=</span> BE.editor <span class="dt">TypeSearch</span> (<span class="dt">Just</span> <span class="dv">1</span>) <span class="st">&quot;&quot;</span></a>
<a class="sourceLine" id="cb5-17" title="17">                      , _stEditText <span class="fu">=</span> BE.editor <span class="dt">TextSearch</span> (<span class="dt">Just</span> <span class="dv">1</span>) <span class="st">&quot;&quot;</span></a>
<a class="sourceLine" id="cb5-18" title="18">                      , _stResultsList <span class="fu">=</span> BL.list <span class="dt">ListResults</span> Vec.empty <span class="dv">1</span></a>
<a class="sourceLine" id="cb5-19" title="19">                      , _stTime <span class="fu">=</span> t</a>
<a class="sourceLine" id="cb5-20" title="20">                      , _stFocus <span class="fu">=</span> BF.focusRing [<span class="dt">TypeSearch</span>, <span class="dt">TextSearch</span>, <span class="dt">ListResults</span>]</a>
<a class="sourceLine" id="cb5-21" title="21">                      , _stResults <span class="fu">=</span> []</a>
<a class="sourceLine" id="cb5-22" title="22">                      , _stSortResults <span class="fu">=</span> <span class="dt">SortNone</span></a>
<a class="sourceLine" id="cb5-23" title="23">                      }</a>
<a class="sourceLine" id="cb5-24" title="24">          </a>
<a class="sourceLine" id="cb5-25" title="25">  <span class="co">-- Run brick</span></a>
<a class="sourceLine" id="cb5-26" title="26">  void <span class="fu">$</span> B.customMain (V.mkVty V.defaultConfig) (<span class="dt">Just</span> chan) app st</a>
<a class="sourceLine" id="cb5-27" title="27"></a>
<a class="sourceLine" id="cb5-28" title="28">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb5-29" title="29">    <span class="co">-- | Get the local time</span></a>
<a class="sourceLine" id="cb5-30" title="30">    getTime <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb5-31" title="31">      t <span class="ot">&lt;-</span> Tm.getCurrentTime</a>
<a class="sourceLine" id="cb5-32" title="32">      tz <span class="ot">&lt;-</span> Tm.getCurrentTimeZone</a>
<a class="sourceLine" id="cb5-33" title="33">      <span class="fu">pure</span> <span class="fu">$</span> Tm.utcToLocalTime tz t</a></code></pre></div>
<p>In <strong>main</strong> some setup is preformed and then brick is started by calling <code>customMain</code>.</p>
<p>For bhoogle the steps are</p>
<ol type="1">
<li>Construct the channel for brick events (passed to <code>customMain</code>)</li>
<li>Create a new thread to send the current time every second</li>
<li>Construct an initial state, with empty controls and search results</li>
<li><code>B.customMain</code> to run brick</li>
</ol>
<div class="sourceCode" id="cb6"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb6-1" title="1"><span class="co">-- | Main even handler for brick events</span></a>
<a class="sourceLine" id="cb6-2" title="2"><span class="ot">handleEvent ::</span> <span class="dt">BrickState</span> <span class="ot">-&gt;</span> <span class="dt">B.BrickEvent</span> <span class="dt">Name</span> <span class="dt">Event</span> <span class="ot">-&gt;</span> <span class="dt">B.EventM</span> <span class="dt">Name</span> (<span class="dt">B.Next</span> <span class="dt">BrickState</span>)</a>
<a class="sourceLine" id="cb6-3" title="3">handleEvent st ev <span class="fu">=</span></a>
<a class="sourceLine" id="cb6-4" title="4">  <span class="kw">case</span> ev <span class="kw">of</span></a>
<a class="sourceLine" id="cb6-5" title="5">    (<span class="dt">B.AppEvent</span> (<span class="dt">EventUpdateTime</span> time)) <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb6-6" title="6">      <span class="co">-- Update the time in the state</span></a>
<a class="sourceLine" id="cb6-7" title="7">      B.continue <span class="fu">$</span> st <span class="fu">&amp;</span> stTime <span class="fu">.~</span> time</a></code></pre></div>
<p><strong>handleEvent</strong> gets all the brick events, updates the state and decides how to continue.</p>
<p>Here the code matches the custom (<strong>B.AppEvent</strong>) event looking for our update time event (<strong>EventUpdateTime</strong>) and then updates the state with the current time. <code>B.continue</code> means that brick continues after updating the state. Note that the UI is not changed in any way here, we are just altering the current state.</p>
<div class="sourceCode" id="cb7"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb7-1" title="1">    <span class="co">-- Handle keyboard events</span></a>
<a class="sourceLine" id="cb7-2" title="2">    <span class="co">--   k is the key</span></a>
<a class="sourceLine" id="cb7-3" title="3">    <span class="co">--   ms are the modifier keys</span></a>
<a class="sourceLine" id="cb7-4" title="4">    (<span class="dt">B.VtyEvent</span> ve<span class="fu">@</span>(<span class="dt">V.EvKey</span> k ms)) <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb7-5" title="5">      <span class="kw">case</span> (k, ms) <span class="kw">of</span></a>
<a class="sourceLine" id="cb7-6" title="6">        <span class="co">-- Escape quits the app, no matter what control has focus</span></a>
<a class="sourceLine" id="cb7-7" title="7">        (<span class="dt">K.KEsc</span>, []) <span class="ot">-&gt;</span> B.halt st</a></code></pre></div>
<p>Then the code matches any keyboard event (<strong>B.VtyEvent</strong>) here matching on the escape key (<strong>K.KEsc</strong>). So when the user clicks the escape key this handler will call <code>B.halt</code> which will terminate the app. As this is done at the top level, this means that no matter which control has the focus, escape will exit.</p>
<div class="sourceCode" id="cb8"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb8-1" title="1">        _ <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb8-2" title="2">          <span class="co">-- How to interpret the key press depends on which control is focused</span></a>
<a class="sourceLine" id="cb8-3" title="3">          <span class="kw">case</span> BF.focusGetCurrent <span class="fu">$</span> st <span class="fu">^.</span> stFocus <span class="kw">of</span></a></code></pre></div>
<p>For the rest of the key press logic, what bhoogle does depends on which control has the focus. <code>BF.focusGetCurrent</code> is used to get that from the state’s focus ring.</p>
<div class="sourceCode" id="cb9"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb9-1" title="1">            <span class="dt">Just</span> <span class="dt">TypeSearch</span> <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb9-2" title="2">              <span class="kw">case</span> k <span class="kw">of</span></a>
<a class="sourceLine" id="cb9-3" title="3">                <span class="dt">K.KChar</span> <span class="ch">'\t'</span> <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb9-4" title="4">                  <span class="co">-- Search, clear sort order, focus next</span></a>
<a class="sourceLine" id="cb9-5" title="5">                  found <span class="ot">&lt;-</span> doSearch st</a>
<a class="sourceLine" id="cb9-6" title="6">                  B.continue <span class="fu">.</span> filterResults <span class="fu">$</span> st <span class="fu">&amp;</span> stFocus <span class="fu">%~</span> BF.focusNext</a>
<a class="sourceLine" id="cb9-7" title="7">                                                  <span class="fu">&amp;</span> stResults <span class="fu">.~</span> found</a>
<a class="sourceLine" id="cb9-8" title="8">                                                  <span class="fu">&amp;</span> stSortResults <span class="fu">.~</span> <span class="dt">SortNone</span></a>
<a class="sourceLine" id="cb9-9" title="9"></a>
<a class="sourceLine" id="cb9-10" title="10">                <span class="dt">K.KBackTab</span> <span class="ot">-&gt;</span><span class="kw">do</span></a>
<a class="sourceLine" id="cb9-11" title="11">                  <span class="co">-- Search, clear sort order, focus prev</span></a>
<a class="sourceLine" id="cb9-12" title="12">                  found <span class="ot">&lt;-</span> doSearch st</a>
<a class="sourceLine" id="cb9-13" title="13">                  B.continue  <span class="fu">.</span> filterResults <span class="fu">$</span> st <span class="fu">&amp;</span> stFocus <span class="fu">%~</span> BF.focusPrev</a>
<a class="sourceLine" id="cb9-14" title="14">                                                   <span class="fu">&amp;</span> stResults <span class="fu">.~</span> found</a>
<a class="sourceLine" id="cb9-15" title="15">                                                   <span class="fu">&amp;</span> stSortResults <span class="fu">.~</span> <span class="dt">SortNone</span></a></code></pre></div>
<p>If the user is typing in the “type” edit box and tabs out (either tab or shift-tab) then</p>
<ol type="1">
<li>Perform the search (see <strong>doSearch</strong> below)</li>
<li>Update the current set of results</li>
<li>Reset the sort order, default to the order that hoogle uses</li>
<li>Move the focus to the next/previous control</li>
</ol>
<div class="sourceCode" id="cb10"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb10-1" title="1">                <span class="dt">K.KEnter</span> <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb10-2" title="2">                  <span class="co">-- Search, clear sort order, focus on results</span></a>
<a class="sourceLine" id="cb10-3" title="3">                  <span class="co">--  This makes it faster if you want to search and navigate </span></a>
<a class="sourceLine" id="cb10-4" title="4">                  <span class="co">--  results without tabing through the text search box</span></a>
<a class="sourceLine" id="cb10-5" title="5">                  found <span class="ot">&lt;-</span> doSearch st</a>
<a class="sourceLine" id="cb10-6" title="6">                  B.continue <span class="fu">.</span> filterResults <span class="fu">$</span> st <span class="fu">&amp;</span> stResults <span class="fu">.~</span> found</a>
<a class="sourceLine" id="cb10-7" title="7">                                                  <span class="fu">&amp;</span> stSortResults <span class="fu">.~</span> <span class="dt">SortNone</span></a>
<a class="sourceLine" id="cb10-8" title="8">                                                  <span class="fu">&amp;</span> stFocus <span class="fu">%~</span> BF.focusSetCurrent <span class="dt">ListResults</span></a></code></pre></div>
<p>If the user presses <strong>enter</strong> while in the type search edit box, then</p>
<ol type="1">
<li>Perform the search (see <strong>doSearch</strong> below)</li>
<li>Update the current set of results</li>
<li>Reset the sort order, default to the order that hoogle uses</li>
<li>Move the focus directly to the results lisbox so they can navigate and see the current item’s details &amp; help text</li>
</ol>
<div class="sourceCode" id="cb11"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb11-1" title="1">                _ <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb11-2" title="2">                  <span class="co">-- Let the editor handle all other events</span></a>
<a class="sourceLine" id="cb11-3" title="3">                  r <span class="ot">&lt;-</span> BE.handleEditorEvent ve <span class="fu">$</span> st <span class="fu">^.</span> stEditType</a>
<a class="sourceLine" id="cb11-4" title="4">                  next <span class="ot">&lt;-</span> liftIO <span class="fu">.</span> searchAhead doSearch <span class="fu">$</span> st <span class="fu">&amp;</span> stEditType <span class="fu">.~</span> r </a>
<a class="sourceLine" id="cb11-5" title="5">                  B.continue next</a></code></pre></div>
<p>For all other key events for the type search, let the editor control handle the key press. This gives us editing, navigation etc for free.</p>
<div class="sourceCode" id="cb12"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb12-1" title="1">            <span class="dt">Just</span> <span class="dt">TextSearch</span> <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb12-2" title="2">              <span class="kw">case</span> k <span class="kw">of</span></a>
<a class="sourceLine" id="cb12-3" title="3">                <span class="dt">K.KChar</span> <span class="ch">'\t'</span> <span class="ot">-&gt;</span> B.continue <span class="fu">$</span> st <span class="fu">&amp;</span> stFocus <span class="fu">%~</span> BF.focusNext <span class="co">-- Focus next</span></a>
<a class="sourceLine" id="cb12-4" title="4">                <span class="dt">K.KBackTab</span> <span class="ot">-&gt;</span> B.continue <span class="fu">$</span> st <span class="fu">&amp;</span> stFocus <span class="fu">%~</span> BF.focusPrev   <span class="co">-- Focus previous</span></a>
<a class="sourceLine" id="cb12-5" title="5">                _ <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb12-6" title="6">                  <span class="co">-- Let the editor handle all other events</span></a>
<a class="sourceLine" id="cb12-7" title="7">                  r <span class="ot">&lt;-</span> BE.handleEditorEvent ve <span class="fu">$</span> st <span class="fu">^.</span> stEditText</a>
<a class="sourceLine" id="cb12-8" title="8">                  B.continue <span class="fu">.</span> filterResults <span class="fu">$</span> st <span class="fu">&amp;</span> stEditText <span class="fu">.~</span> r</a></code></pre></div>
<p>For the text edit box</p>
<ol type="1">
<li>Change focus on tab / shift-tab</li>
<li>For all other keys
<ol type="1">
<li>Let the editor handle the key press</li>
<li>Filter the hoogle results</li>
</ol></li>
</ol>
<div class="sourceCode" id="cb13"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb13-1" title="1">            <span class="dt">Just</span> <span class="dt">ListResults</span> <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb13-2" title="2">              <span class="kw">case</span> k <span class="kw">of</span></a>
<a class="sourceLine" id="cb13-3" title="3">                <span class="dt">K.KChar</span> <span class="ch">'\t'</span> <span class="ot">-&gt;</span> B.continue <span class="fu">$</span> st <span class="fu">&amp;</span> stFocus <span class="fu">%~</span> BF.focusNext <span class="co">-- Focus next</span></a>
<a class="sourceLine" id="cb13-4" title="4">                <span class="dt">K.KBackTab</span> <span class="ot">-&gt;</span> B.continue <span class="fu">$</span> st <span class="fu">&amp;</span> stFocus <span class="fu">%~</span> BF.focusPrev   <span class="co">-- Focus previous</span></a>
<a class="sourceLine" id="cb13-5" title="5">                <span class="dt">K.KChar</span> <span class="ch">'s'</span> <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb13-6" title="6">                  <span class="co">-- Toggle the search order between ascending and descending,</span></a>
<a class="sourceLine" id="cb13-7" title="7">                  <span class="co">--  use asc if sort order was 'none'</span></a>
<a class="sourceLine" id="cb13-8" title="8">                  <span class="kw">let</span> sortDir <span class="fu">=</span> <span class="kw">if</span> (st <span class="fu">^.</span> stSortResults) <span class="fu">==</span> <span class="dt">SortAsc</span> </a>
<a class="sourceLine" id="cb13-9" title="9">                                  <span class="kw">then</span> <span class="dt">SortDec</span> </a>
<a class="sourceLine" id="cb13-10" title="10">                                  <span class="kw">else</span> <span class="dt">SortAsc</span> </a>
<a class="sourceLine" id="cb13-11" title="11">                  <span class="kw">in</span></a>
<a class="sourceLine" id="cb13-12" title="12">                  <span class="kw">let</span> sorter <span class="fu">=</span> <span class="kw">if</span> sortDir <span class="fu">==</span> <span class="dt">SortDec</span> </a>
<a class="sourceLine" id="cb13-13" title="13">                                 <span class="kw">then</span> (Lst.sortBy <span class="fu">$</span> <span class="fu">flip</span> compareType) </a>
<a class="sourceLine" id="cb13-14" title="14">                                 <span class="kw">else</span> (Lst.sortBy compareType) </a>
<a class="sourceLine" id="cb13-15" title="15">                  <span class="kw">in</span></a>
<a class="sourceLine" id="cb13-16" title="16">                  B.continue <span class="fu">.</span> filterResults <span class="fu">$</span> st <span class="fu">&amp;</span> stResults <span class="fu">%~</span> sorter</a>
<a class="sourceLine" id="cb13-17" title="17">                                                  <span class="fu">&amp;</span> stSortResults <span class="fu">.~</span> sortDir</a>
<a class="sourceLine" id="cb13-18" title="18"></a>
<a class="sourceLine" id="cb13-19" title="19">                _ <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb13-20" title="20">                  <span class="co">-- Let the list handle all other events</span></a>
<a class="sourceLine" id="cb13-21" title="21">                  <span class="co">-- Using handleListEventVi which adds vi-style keybindings for navigation</span></a>
<a class="sourceLine" id="cb13-22" title="22">                  <span class="co">--  and the standard handleListEvent as a fallback for all other events</span></a>
<a class="sourceLine" id="cb13-23" title="23">                  r <span class="ot">&lt;-</span> BL.handleListEventVi BL.handleListEvent ve <span class="fu">$</span> st <span class="fu">^.</span> stResultsList</a>
<a class="sourceLine" id="cb13-24" title="24">                  B.continue <span class="fu">$</span> st <span class="fu">&amp;</span> stResultsList <span class="fu">.~</span> r</a>
<a class="sourceLine" id="cb13-25" title="25"></a>
<a class="sourceLine" id="cb13-26" title="26">            _ <span class="ot">-&gt;</span> B.continue st</a>
<a class="sourceLine" id="cb13-27" title="27"></a>
<a class="sourceLine" id="cb13-28" title="28">    _ <span class="ot">-&gt;</span> B.continue st</a></code></pre></div>
<p>For the results listbox</p>
<ul>
<li>Handle tab / shift-tab</li>
<li>Pressing the <strong>‘s’</strong> key will sort the results. Pressing it again toggles the direction, so keep track of which order was used last.</li>
<li>For all other keys use <code>BL.handleListEventVi BL.handleListEvent</code> which gives us vi style navigation and uses the standard <strong>handleListEvent</strong> as the fallback, so that all the normal navigation (arrows) also work.</li>
</ul>
<div class="sourceCode" id="cb14"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb14-1" title="1">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb14-2" title="2">    doSearch st' <span class="fu">=</span> </a>
<a class="sourceLine" id="cb14-3" title="3">      liftIO <span class="fu">$</span> searchHoogle (Txt.strip <span class="fu">.</span> Txt.concat <span class="fu">$</span> BE.getEditContents (st' <span class="fu">^.</span> stEditType))</a></code></pre></div>
<p>And finally for <strong>handleEvent</strong> the <strong>doSearch</strong> function which calls the <strong>searchHoogle</strong> function (below) to search on the text from the type editbox.</p>
<div class="sourceCode" id="cb15"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb15-1" title="1"><span class="co">-- | Search ahead for type strings longer than 3 chars.</span></a>
<a class="sourceLine" id="cb15-2" title="2"><span class="ot">searchAhead ::</span> (<span class="dt">BrickState</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> [<span class="dt">H.Target</span>]) <span class="ot">-&gt;</span> <span class="dt">BrickState</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">BrickState</span></a>
<a class="sourceLine" id="cb15-3" title="3">searchAhead search st <span class="fu">=</span></a>
<a class="sourceLine" id="cb15-4" title="4">  <span class="kw">let</span> searchText <span class="fu">=</span> Txt.strip <span class="fu">.</span> Txt.concat <span class="fu">.</span> BE.getEditContents <span class="fu">$</span> st <span class="fu">^.</span> stEditType <span class="kw">in</span></a>
<a class="sourceLine" id="cb15-5" title="5"></a>
<a class="sourceLine" id="cb15-6" title="6">  <span class="kw">if</span> Txt.length searchText <span class="fu">&gt;</span> <span class="dv">3</span></a>
<a class="sourceLine" id="cb15-7" title="7">  <span class="kw">then</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb15-8" title="8">    <span class="co">-- Search</span></a>
<a class="sourceLine" id="cb15-9" title="9">    found <span class="ot">&lt;-</span> search st</a>
<a class="sourceLine" id="cb15-10" title="10">    <span class="fu">pure</span> <span class="fu">.</span> filterResults <span class="fu">$</span> st <span class="fu">&amp;</span> stResults <span class="fu">.~</span> found</a>
<a class="sourceLine" id="cb15-11" title="11">                              <span class="fu">&amp;</span> stSortResults <span class="fu">.~</span> <span class="dt">SortNone</span></a>
<a class="sourceLine" id="cb15-12" title="12">  <span class="kw">else</span></a>
<a class="sourceLine" id="cb15-13" title="13">    <span class="co">-- Just clear</span></a>
<a class="sourceLine" id="cb15-14" title="14">    <span class="fu">pure</span> <span class="fu">$</span> st <span class="fu">&amp;</span> stResults <span class="fu">.~</span> []</a>
<a class="sourceLine" id="cb15-15" title="15">              <span class="fu">&amp;</span> stResultsList <span class="fu">%~</span> BL.listClear</a></code></pre></div>
<p><strong>searchAhead</strong> is a helper function that searches hoogle as the user types. As long as there are more than three characters being searched for. Without this limit hoogle seems a bit slow on my machine because of the large number of results.</p>
<div class="sourceCode" id="cb16"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb16-1" title="1"><span class="co">-- | Filter the results from hoogle using the search text</span></a>
<a class="sourceLine" id="cb16-2" title="2"><span class="ot">filterResults ::</span> <span class="dt">BrickState</span> <span class="ot">-&gt;</span> <span class="dt">BrickState</span></a>
<a class="sourceLine" id="cb16-3" title="3">filterResults st <span class="fu">=</span></a>
<a class="sourceLine" id="cb16-4" title="4">  <span class="kw">let</span> allResults <span class="fu">=</span> st <span class="fu">^.</span> stResults <span class="kw">in</span></a>
<a class="sourceLine" id="cb16-5" title="5">  <span class="kw">let</span> filterText <span class="fu">=</span> Txt.toLower <span class="fu">.</span> Txt.strip <span class="fu">.</span> Txt.concat <span class="fu">.</span> BE.getEditContents <span class="fu">$</span> st <span class="fu">^.</span> stEditText <span class="kw">in</span></a>
<a class="sourceLine" id="cb16-6" title="6"></a>
<a class="sourceLine" id="cb16-7" title="7">  <span class="kw">let</span> results <span class="fu">=</span></a>
<a class="sourceLine" id="cb16-8" title="8">        <span class="kw">if</span> Txt.null filterText</a>
<a class="sourceLine" id="cb16-9" title="9">        <span class="kw">then</span> allResults</a>
<a class="sourceLine" id="cb16-10" title="10">        <span class="kw">else</span> <span class="fu">filter</span> (\t <span class="ot">-&gt;</span> Txt.isInfixOf filterText <span class="fu">.</span> Txt.toLower <span class="fu">$</span> formatResult t) allResults</a>
<a class="sourceLine" id="cb16-11" title="11">  <span class="kw">in</span></a>
<a class="sourceLine" id="cb16-12" title="12">  st <span class="fu">&amp;</span> stResultsList <span class="fu">.~</span> BL.list <span class="dt">ListResults</span> (Vec.fromList results) <span class="dv">1</span></a></code></pre></div>
<p>Filter the hoogle results by doing a sub-string search if the user has entered one</p>
<div class="sourceCode" id="cb17"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb17-1" title="1"><span class="co">-- | Draw the UI</span></a>
<a class="sourceLine" id="cb17-2" title="2"><span class="ot">drawUI ::</span> <span class="dt">BrickState</span> <span class="ot">-&gt;</span> [<span class="dt">B.Widget</span> <span class="dt">Name</span>]</a>
<a class="sourceLine" id="cb17-3" title="3">drawUI st <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-4" title="4">  [B.padAll <span class="dv">1</span> contentBlock] </a>
<a class="sourceLine" id="cb17-5" title="5"></a>
<a class="sourceLine" id="cb17-6" title="6">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb17-7" title="7">    contentBlock <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-8" title="8">      (B.withBorderStyle BBS.unicode <span class="fu">$</span> BB.border searchBlock)</a>
<a class="sourceLine" id="cb17-9" title="9">      <span class="fu">&lt;=&gt;</span></a>
<a class="sourceLine" id="cb17-10" title="10">      B.padTop (<span class="dt">B.Pad</span> <span class="dv">1</span>) resultsBlock</a>
<a class="sourceLine" id="cb17-11" title="11">      </a>
<a class="sourceLine" id="cb17-12" title="12">    resultsBlock <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-13" title="13">      <span class="kw">let</span> total <span class="fu">=</span> <span class="fu">show</span> <span class="fu">.</span> <span class="fu">length</span> <span class="fu">$</span> st <span class="fu">^.</span> stResults <span class="kw">in</span></a>
<a class="sourceLine" id="cb17-14" title="14">      <span class="kw">let</span> showing <span class="fu">=</span> <span class="fu">show</span> <span class="fu">.</span> <span class="fu">length</span> <span class="fu">$</span> st <span class="fu">^.</span> stResultsList <span class="fu">^.</span> BL.listElementsL <span class="kw">in</span></a>
<a class="sourceLine" id="cb17-15" title="15">      (B.withAttr <span class="st">&quot;infoTitle&quot;</span> <span class="fu">$</span> B.txt <span class="st">&quot;Results: &quot;</span>) <span class="fu">&lt;+&gt;</span> B.txt (showing <span class="fu">&lt;&gt;</span> <span class="st">&quot;/&quot;</span> <span class="fu">&lt;&gt;</span> total)</a>
<a class="sourceLine" id="cb17-16" title="16">      <span class="fu">&lt;=&gt;</span></a>
<a class="sourceLine" id="cb17-17" title="17">      (B.padTop (<span class="dt">B.Pad</span> <span class="dv">1</span>) <span class="fu">$</span></a>
<a class="sourceLine" id="cb17-18" title="18">       resultsContent <span class="fu">&lt;+&gt;</span> resultsDetail</a>
<a class="sourceLine" id="cb17-19" title="19">      )</a>
<a class="sourceLine" id="cb17-20" title="20"></a>
<a class="sourceLine" id="cb17-21" title="21">    resultsContent <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-22" title="22">      BL.renderList (\_ e <span class="ot">-&gt;</span> B.txt <span class="fu">$</span> formatResult e) <span class="dt">False</span> (st <span class="fu">^.</span> stResultsList)</a>
<a class="sourceLine" id="cb17-23" title="23"></a>
<a class="sourceLine" id="cb17-24" title="24">    resultsDetail <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-25" title="25">      B.padLeft (<span class="dt">B.Pad</span> <span class="dv">1</span>) <span class="fu">$</span></a>
<a class="sourceLine" id="cb17-26" title="26">      B.hLimit <span class="dv">60</span> <span class="fu">$</span></a>
<a class="sourceLine" id="cb17-27" title="27">      vtitle <span class="st">&quot;package:&quot;</span></a>
<a class="sourceLine" id="cb17-28" title="28">      <span class="fu">&lt;=&gt;</span></a>
<a class="sourceLine" id="cb17-29" title="29">      B.padLeft (<span class="dt">B.Pad</span> <span class="dv">2</span>) (B.txt <span class="fu">$</span> getSelectedDetail (\t <span class="ot">-&gt;</span> <span class="fu">maybe</span> <span class="st">&quot;&quot;</span> (Txt.pack <span class="fu">.</span> <span class="fu">fst</span>) (H.targetPackage t)))</a>
<a class="sourceLine" id="cb17-30" title="30">      <span class="fu">&lt;=&gt;</span></a>
<a class="sourceLine" id="cb17-31" title="31">      vtitle <span class="st">&quot;module:&quot;</span></a>
<a class="sourceLine" id="cb17-32" title="32">      <span class="fu">&lt;=&gt;</span></a>
<a class="sourceLine" id="cb17-33" title="33">      B.padLeft (<span class="dt">B.Pad</span> <span class="dv">2</span>) (B.txt <span class="fu">$</span> getSelectedDetail (\t <span class="ot">-&gt;</span> <span class="fu">maybe</span> <span class="st">&quot;&quot;</span> (Txt.pack <span class="fu">.</span> <span class="fu">fst</span>) (H.targetModule t)))</a>
<a class="sourceLine" id="cb17-34" title="34">      <span class="fu">&lt;=&gt;</span></a>
<a class="sourceLine" id="cb17-35" title="35">      vtitle <span class="st">&quot;docs:&quot;</span></a>
<a class="sourceLine" id="cb17-36" title="36">      <span class="fu">&lt;=&gt;</span></a>
<a class="sourceLine" id="cb17-37" title="37">      B.padLeft (<span class="dt">B.Pad</span> <span class="dv">2</span>) (B.txt <span class="fu">$</span> getSelectedDetail (Txt.pack <span class="fu">.</span> clean <span class="fu">.</span> H.targetDocs))</a>
<a class="sourceLine" id="cb17-38" title="38">      <span class="fu">&lt;=&gt;</span></a>
<a class="sourceLine" id="cb17-39" title="39">      B.fill <span class="ch">' '</span></a>
<a class="sourceLine" id="cb17-40" title="40">  </a>
<a class="sourceLine" id="cb17-41" title="41">    searchBlock <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-42" title="42">      ((htitle <span class="st">&quot;Type: &quot;</span> <span class="fu">&lt;+&gt;</span> editor <span class="dt">TypeSearch</span> (st <span class="fu">^.</span> stEditType)) <span class="fu">&lt;+&gt;</span> time (st <span class="fu">^.</span> stTime))</a>
<a class="sourceLine" id="cb17-43" title="43">      <span class="fu">&lt;=&gt;</span></a>
<a class="sourceLine" id="cb17-44" title="44">      (htitle <span class="st">&quot;Text: &quot;</span> <span class="fu">&lt;+&gt;</span> editor <span class="dt">TextSearch</span> (st <span class="fu">^.</span> stEditText))</a>
<a class="sourceLine" id="cb17-45" title="45"></a>
<a class="sourceLine" id="cb17-46" title="46">    htitle t <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-47" title="47">      B.hLimit <span class="dv">20</span> <span class="fu">$</span></a>
<a class="sourceLine" id="cb17-48" title="48">      B.withAttr <span class="st">&quot;infoTitle&quot;</span> <span class="fu">$</span></a>
<a class="sourceLine" id="cb17-49" title="49">      B.txt t</a>
<a class="sourceLine" id="cb17-50" title="50">      </a>
<a class="sourceLine" id="cb17-51" title="51">    vtitle t <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-52" title="52">      B.withAttr <span class="st">&quot;infoTitle&quot;</span> <span class="fu">$</span></a>
<a class="sourceLine" id="cb17-53" title="53">      B.txt t</a>
<a class="sourceLine" id="cb17-54" title="54"></a>
<a class="sourceLine" id="cb17-55" title="55">    editor n e <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-56" title="56">      B.vLimit <span class="dv">1</span> <span class="fu">$</span></a>
<a class="sourceLine" id="cb17-57" title="57">      BE.renderEditor (B.txt <span class="fu">.</span> Txt.unlines) (BF.focusGetCurrent (st <span class="fu">^.</span> stFocus) <span class="fu">==</span> <span class="dt">Just</span> n) e</a>
<a class="sourceLine" id="cb17-58" title="58"></a>
<a class="sourceLine" id="cb17-59" title="59">    time t <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-60" title="60">      B.padLeft (<span class="dt">B.Pad</span> <span class="dv">1</span>) <span class="fu">$</span></a>
<a class="sourceLine" id="cb17-61" title="61">      B.hLimit <span class="dv">20</span> <span class="fu">$</span></a>
<a class="sourceLine" id="cb17-62" title="62">      B.withAttr <span class="st">&quot;time&quot;</span> <span class="fu">$</span></a>
<a class="sourceLine" id="cb17-63" title="63">      B.str (Tm.formatTime Tm.defaultTimeLocale <span class="st">&quot;%H-%M-%S&quot;</span> t)</a>
<a class="sourceLine" id="cb17-64" title="64"></a>
<a class="sourceLine" id="cb17-65" title="65">    getSelectedDetail fn <span class="fu">=</span></a>
<a class="sourceLine" id="cb17-66" title="66">      <span class="kw">case</span> BL.listSelectedElement <span class="fu">$</span> st <span class="fu">^.</span> stResultsList <span class="kw">of</span></a>
<a class="sourceLine" id="cb17-67" title="67">        <span class="dt">Nothing</span> <span class="ot">-&gt;</span> <span class="st">&quot;&quot;</span></a>
<a class="sourceLine" id="cb17-68" title="68">        <span class="dt">Just</span> (_, e) <span class="ot">-&gt;</span> fn e</a></code></pre></div>
<p><strong>drawUI</strong> renders the state and creates the GUI. At first this may take some getting used to, but you will soon be able to see the GUI structure from the code.</p>
<ul>
<li><code>&lt;=&gt;</code> means horizontal break, i.e. next “line”</li>
<li><code>&lt;+&gt;</code> means “next to”</li>
<li>I often end up formatting code slightly differently to how I would in the other functions to better communicate the structure</li>
<li><p>Create small GUI fragments/“controls” and combine them with <code>&lt;+&gt;</code> and <code>&lt;=&gt;</code></p>
For example <strong>htitle</strong> creates a “title” by
<ul>
<li>Limiting the max width to 20</li>
<li>Setting the attribute to <strong>infoTitle</strong></li>
<li>Displaying the text using <code>B.txt</code> (<code>B.txt</code> displays a Text, <code>B.str</code> displays a string/[char])</li>
</ul></li>
<li><p><code>B.fill ' '</code> is used to get brick to fill to the maximum width (here 60) rather that having the right detail pain growing/shrinking as the data changes.</p></li>
</ul>
<div class="sourceCode" id="cb18"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb18-1" title="1"><span class="ot">theMap ::</span> <span class="dt">BA.AttrMap</span></a>
<a class="sourceLine" id="cb18-2" title="2">theMap <span class="fu">=</span> BA.attrMap V.defAttr [ (BE.editAttr        , V.black <span class="ot">`B.on`</span> V.cyan)</a>
<a class="sourceLine" id="cb18-3" title="3">                              , (BE.editFocusedAttr , V.black <span class="ot">`B.on`</span> V.yellow)</a>
<a class="sourceLine" id="cb18-4" title="4">                              , (BL.listAttr        , V.white <span class="ot">`B.on`</span> V.blue)</a>
<a class="sourceLine" id="cb18-5" title="5">                              , (BL.listSelectedAttr, V.blue <span class="ot">`B.on`</span> V.white)</a>
<a class="sourceLine" id="cb18-6" title="6">                              , (<span class="st">&quot;infoTitle&quot;</span>        , B.fg V.cyan)</a>
<a class="sourceLine" id="cb18-7" title="7">                              , (<span class="st">&quot;time&quot;</span>             , B.fg V.yellow)</a>
<a class="sourceLine" id="cb18-8" title="8">                              ]</a></code></pre></div>
<p>The attribute map is where attributes for the controls and custom attributes are defined. This makes it easy to change how the GUI looks. There is even support <a href="https://hackage.haskell.org/package/brick-0.33/docs/Brick-Themes.html">for themes</a> and basic <a href="https://hackage.haskell.org/package/brick-0.33/docs/Brick-Markup.html">markup</a>.</p>
<div class="sourceCode" id="cb19"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb19-1" title="1"><span class="co">----------------------------------------------------------------------------------------------</span></a>
<a class="sourceLine" id="cb19-2" title="2"><span class="co">-- | Compare two hoogle results for sorting</span></a>
<a class="sourceLine" id="cb19-3" title="3"><span class="ot">compareType ::</span> <span class="dt">H.Target</span> <span class="ot">-&gt;</span> <span class="dt">H.Target</span> <span class="ot">-&gt;</span> <span class="dt">Ordering</span></a>
<a class="sourceLine" id="cb19-4" title="4">compareType a b <span class="fu">=</span></a>
<a class="sourceLine" id="cb19-5" title="5">  <span class="fu">compare</span> (formatResult a) (formatResult b)</a>
<a class="sourceLine" id="cb19-6" title="6"></a>
<a class="sourceLine" id="cb19-7" title="7">  </a>
<a class="sourceLine" id="cb19-8" title="8"><span class="co">-- | Search hoogle using the default hoogle database</span></a>
<a class="sourceLine" id="cb19-9" title="9"><span class="ot">searchHoogle ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> [<span class="dt">H.Target</span>]</a>
<a class="sourceLine" id="cb19-10" title="10">searchHoogle f <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb19-11" title="11">  d <span class="ot">&lt;-</span> H.defaultDatabaseLocation </a>
<a class="sourceLine" id="cb19-12" title="12">  H.withDatabase d (\x <span class="ot">-&gt;</span> <span class="fu">pure</span> <span class="fu">$</span> H.searchDatabase x (Txt.unpack f))</a>
<a class="sourceLine" id="cb19-13" title="13">  </a>
<a class="sourceLine" id="cb19-14" title="14"></a>
<a class="sourceLine" id="cb19-15" title="15"><span class="co">-- | Format the hoogle results so they roughly match what the terminal app would show</span></a>
<a class="sourceLine" id="cb19-16" title="16"><span class="ot">formatResult ::</span> <span class="dt">H.Target</span> <span class="ot">-&gt;</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb19-17" title="17">formatResult t <span class="fu">=</span></a>
<a class="sourceLine" id="cb19-18" title="18">  <span class="kw">let</span> typ <span class="fu">=</span> clean <span class="fu">$</span> H.targetItem t <span class="kw">in</span></a>
<a class="sourceLine" id="cb19-19" title="19">  <span class="kw">let</span> m <span class="fu">=</span> (clean <span class="fu">.</span> <span class="fu">fst</span>) <span class="fu">&lt;$&gt;</span> H.targetModule t <span class="kw">in</span></a>
<a class="sourceLine" id="cb19-20" title="20">  Txt.pack <span class="fu">$</span> fromMaybe <span class="st">&quot;&quot;</span> m <span class="fu">&lt;&gt;</span> <span class="st">&quot; :: &quot;</span> <span class="fu">&lt;&gt;</span> typ</a>
<a class="sourceLine" id="cb19-21" title="21">  </a>
<a class="sourceLine" id="cb19-22" title="22"></a>
<a class="sourceLine" id="cb19-23" title="23"><span class="ot">clean ::</span> [<span class="dt">Char</span>] <span class="ot">-&gt;</span> [<span class="dt">Char</span>]</a>
<a class="sourceLine" id="cb19-24" title="24">clean <span class="fu">=</span> unescapeHTML <span class="fu">.</span> stripTags</a>
<a class="sourceLine" id="cb19-25" title="25"></a>
<a class="sourceLine" id="cb19-26" title="26"></a>
<a class="sourceLine" id="cb19-27" title="27"><span class="co">-- | From hoogle source: https://hackage.haskell.org/package/hoogle-5.0.16/docs/src/General-Util.html</span></a>
<a class="sourceLine" id="cb19-28" title="28"><span class="ot">unescapeHTML ::</span> [<span class="dt">Char</span>] <span class="ot">-&gt;</span> [<span class="dt">Char</span>]</a>
<a class="sourceLine" id="cb19-29" title="29">unescapeHTML (<span class="ch">'&amp;'</span><span class="fu">:</span>xs)</a>
<a class="sourceLine" id="cb19-30" title="30">    <span class="fu">|</span> <span class="dt">Just</span> x <span class="ot">&lt;-</span> Lst.stripPrefix <span class="st">&quot;lt;&quot;</span> xs <span class="fu">=</span> <span class="ch">'&lt;'</span> <span class="fu">:</span> unescapeHTML x</a>
<a class="sourceLine" id="cb19-31" title="31">    <span class="fu">|</span> <span class="dt">Just</span> x <span class="ot">&lt;-</span> Lst.stripPrefix <span class="st">&quot;gt;&quot;</span> xs <span class="fu">=</span> <span class="ch">'&gt;'</span> <span class="fu">:</span> unescapeHTML x</a>
<a class="sourceLine" id="cb19-32" title="32">    <span class="fu">|</span> <span class="dt">Just</span> x <span class="ot">&lt;-</span> Lst.stripPrefix <span class="st">&quot;amp;&quot;</span> xs <span class="fu">=</span> <span class="ch">'&amp;'</span> <span class="fu">:</span> unescapeHTML x</a>
<a class="sourceLine" id="cb19-33" title="33">    <span class="fu">|</span> <span class="dt">Just</span> x <span class="ot">&lt;-</span> Lst.stripPrefix <span class="st">&quot;quot;&quot;</span> xs <span class="fu">=</span> <span class="ch">'\&quot;'</span> <span class="fu">:</span> unescapeHTML x</a>
<a class="sourceLine" id="cb19-34" title="34">unescapeHTML (x<span class="fu">:</span>xs) <span class="fu">=</span> x <span class="fu">:</span> unescapeHTML xs</a>
<a class="sourceLine" id="cb19-35" title="35">unescapeHTML [] <span class="fu">=</span> []</a>
<a class="sourceLine" id="cb19-36" title="36">  </a>
<a class="sourceLine" id="cb19-37" title="37"></a>
<a class="sourceLine" id="cb19-38" title="38"><span class="co">-- | From hakyll source: https://hackage.haskell.org/package/hakyll-4.1.2.1/docs/src/Hakyll-Web-Html.html#stripTags</span></a>
<a class="sourceLine" id="cb19-39" title="39"><span class="ot">stripTags ::</span> [<span class="dt">Char</span>] <span class="ot">-&gt;</span> [<span class="dt">Char</span>]</a>
<a class="sourceLine" id="cb19-40" title="40">stripTags []         <span class="fu">=</span> []</a>
<a class="sourceLine" id="cb19-41" title="41">stripTags (<span class="ch">'&lt;'</span> <span class="fu">:</span> xs) <span class="fu">=</span> stripTags <span class="fu">$</span> <span class="fu">drop</span> <span class="dv">1</span> <span class="fu">$</span> <span class="fu">dropWhile</span> (<span class="fu">/=</span> <span class="ch">'&gt;'</span>) xs</a>
<a class="sourceLine" id="cb19-42" title="42">stripTags (x <span class="fu">:</span> xs)   <span class="fu">=</span> x <span class="fu">:</span> stripTags xs</a></code></pre></div>
<p>The remainder of the code is non-brick code for searching and formatting hoogle results</p>
<ul>
<li><strong>compareType</strong> compares two results by formatting them first and then comparing the resulting text</li>
<li><strong>searchHoogle</strong> searches hoogle using the default database</li>
<li><strong>formatResults</strong> formats the hoogle results</li>
<li><strong>unescapeHTML</strong> and <strong>stripTags</strong> are used to get plain text from the HTML. Note that this code comes from the <a href="https://hackage.haskell.org/package/hakyll-4.1.2.1/docs/src/Hakyll-Web-Html.html#stripTags">hakyll</a> and <a href="https://hackage.haskell.org/package/hoogle-5.0.16/docs/src/General-Util.html">hoogle</a> source code</li>
</ul>
<h1 id="section"></h1>
<p>Hopefully this example helps you get started with brick and demonstrates how easy brick makes creating terminal UIs</p>
<h1 id="links">Links</h1>
<ul>
<li><a href="https://github.com/andrevdm/bhoogle/tree/blog">Code on github</a></li>
<li><a href="https://github.com/andrevdm/bhoogle/releases">Releases with prebuilt linux binaries</a></li>
<li><a href="https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst">Brick user guide</a></li>
<li><a href="https://github.com/jtdaugherty/brick/blob/master/docs/samtay-tutorial.md">Samuel Tay’s brick tutorial</a></li>
<li><a href="https://hackage.haskell.org/package/bhoogle">Latest version on hackage</a> - NB code does not match the annotated source above</li>
<li><a href="https://github.com/andrevdm/bhoogle">Latest version on github</a> - NB code does not match the annotated source above</li>
</ul>


        </div>
        <div id="footer">
            Site proudly generated by
            <a href="http://jaspervdj.be/hakyll">Hakyll</a>
        </div>
        </div>

        <script>
          (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
          (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
          m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
          })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

          ga('create', 'UA-78428674-1', 'auto');
          ga('send', 'pageview');
        </script>
    </body>
</html>
]]></summary>
</entry>
<entry>
    <title>Refactoring exception handling using a free monad</title>
    <link href="http://www.andrevdm.com/posts/2018-01-08-refactor-free.html" />
    <id>http://www.andrevdm.com/posts/2018-01-08-refactor-free.html</id>
    <published>2018-01-08T00:00:00Z</published>
    <updated>2018-01-08T00:00:00Z</updated>
    <summary type="html"><![CDATA[<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
        <title>Andre's Blog</title>
        <link rel="stylesheet" type="text/css" href="../css/default.css" />
        <link rel="stylesheet" type="text/css" href="../css/syntax.css" />
    </head>
    <body>
      <div id="bodyInner">
        <div id="header">
            <div id="logo">
                <a href="../">Blog</a>
            </div>
            <div id="navigation">
                <a href="../">Home</a>
                <a href="../contact.html">Contact</a>
                <!-- <a href="/about.html">About</a> -->
            </div>
        </div>

        <div id="content">
            <h1><a href="#top">Refactoring exception handling using a free monad</a></h1>

            <div class="info">
    Posted on January  8, 2018

</div>

<h1 id="overview">Overview</h1>
<p>In my <a href="http://www.andrevdm.com/posts/2017-10-31-refactor-away-io.html">previous post</a> I showed how I was managing exceptions by using a “wrapper” around a record of functions. In this post I’ll show how a free monad approach can be used to achieve the same goal and compare the two techniques.</p>
<h1 id="recap">Recap</h1>
<h2 id="requirements">Requirements</h2>
<p>This is the requirement for the example app, which is a pipeline of jobs</p>
<ol type="1">
<li>Job
<ol type="1">
<li>Can run any IO action and as a result these actions can fail with exceptions</li>
<li>This is custom code and can fail for any number of reasons, network errors, disk permissions etc</li>
</ol></li>
<li>Pipeline
<ol type="1">
<li>Must run impure jobs but be as pure as possible itself</li>
<li>Must be able to handle job failure (exceptions)</li>
<li>Supports different storage mechanisms, e.g. on disk for local dev vs cloud for production</li>
</ol></li>
<li>Both jobs and the pipeline should be testable</li>
</ol>
<h2 id="intent">Intent</h2>
<p>The idea was to have a record of operations, different implementations of this record are possible (e.g. run locally vs run in cloud). Then a function is called to create a wrapper function for each record field and a wrapper record is created. The functions in the wrapper record catch all synchronous exceptions and convert them to ExceptT.</p>
<p>The benefit of this approach was that more of the code could be written with pure functions without losing the ability to deal with exceptions that could occur at any point if the operations were specialized to IO.</p>
<div class="sourceCode" id="cb1"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb1-1" title="1"><span class="kw">data</span> <span class="dt">Operations</span> m <span class="fu">=</span> <span class="dt">Operations</span> {<span class="ot"> opRead ::</span> m <span class="dt">Text</span></a>
<a class="sourceLine" id="cb1-2" title="2">                               ,<span class="ot"> opWrite ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> m ()</a>
<a class="sourceLine" id="cb1-3" title="3">                               }</a>
<a class="sourceLine" id="cb1-4" title="4"></a>
<a class="sourceLine" id="cb1-5" title="5"><span class="kw">data</span> <span class="dt">OperationsWrapper</span> m <span class="fu">=</span> <span class="dt">OperationsWrapper</span> {<span class="ot"> opRead ::</span> <span class="dt">ExceptT</span> <span class="dt">OpsError</span> m <span class="dt">Text</span></a>
<a class="sourceLine" id="cb1-6" title="6">                                             ,<span class="ot"> opWrite ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">ExceptT</span> <span class="dt">OpsError</span> m ()</a>
<a class="sourceLine" id="cb1-7" title="7">                                             }</a>
<a class="sourceLine" id="cb1-8" title="8">                                             </a>
<a class="sourceLine" id="cb1-9" title="9"><span class="ot">mkOpsWrapper ::</span> (<span class="dt">MonadCatch</span> m) <span class="ot">=&gt;</span> <span class="dt">I2.Operations</span> m <span class="ot">-&gt;</span> <span class="dt">OperationsWrapper</span> m</a>
<a class="sourceLine" id="cb1-10" title="10">mkOpsWrapper o <span class="fu">=</span> <span class="dt">OperationsWrapper</span> { opRead <span class="fu">=</span> <span class="dt">E.ExceptT</span> ((<span class="dt">Right</span> <span class="fu">&lt;$&gt;</span> I2.opRead o) <span class="ot">`catch`</span> readError)</a>
<a class="sourceLine" id="cb1-11" title="11">                                   , <span class="fu">...</span></a>
<a class="sourceLine" id="cb1-12" title="12">                                   }</a>
<a class="sourceLine" id="cb1-13" title="13">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb1-14" title="14"><span class="ot">    readError ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">SomeException</span> <span class="ot">-&gt;</span> m (<span class="dt">Either</span> <span class="dt">OpsError</span> b)</a>
<a class="sourceLine" id="cb1-15" title="15">    readError e <span class="fu">=</span> <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Left</span> <span class="fu">.</span> <span class="dt">ErrRead</span> <span class="fu">$</span> <span class="st">&quot;Error reading: &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> e</a>
<a class="sourceLine" id="cb1-16" title="16">      </a>
<a class="sourceLine" id="cb1-17" title="17">    <span class="fu">...</span></a></code></pre></div>
<h2 id="observations">Observations</h2>
<p>Here is roughly how it worked</p>
<p><img src="../images/free_wrapper.png" /></p>
<ul>
<li>It seems like a fair amount of code is required to add the exception handling and the wrapper record.</li>
<li>The wrapper is specialized to ExceptT. E.g. The test’s are pure, so using the IO exception handling -&gt; ExceptT pattern is unnecessary</li>
<li>Not only is it a lot of code, but the mkOpsWrapper code is also a little messy</li>
</ul>
<h1 id="a-quick-overview-of-free-monads">A quick overview of free monads</h1>
<p>There are many great articles on what free monads are and how they are implemented, see the links below for some of them. So I wont be going into detail about how they work, rather I’ll show how they can be used. But even if you’ve never used a free monad before, you may well be able to follow along with how I use them here.</p>
<h2 id="what-are-they">What are they?</h2>
<p>A free monad way to build a monad from any functor. The rest of the article demonstrates why you might want to use them.</p>
<h2 id="how-will-this-help">How will this help?</h2>
<p>With a free monad you have a function that builds the free monad structure and one or more functions that interpret/run the AST.</p>
<p><img src="../images/free_free.png" /></p>
<p>As the image above illustrates createAst generates the AST. The AST can then be passed to different interpreters that run the AST. With the record based approach you varied the implementation by choosing which record of functions to pass in. Here you use a different interpreter over the same free monad output to vary the implementation. This results in a clean separation of concerns.</p>
<p>Note that you don’t need to use free monads to implement this pattern. You could create an AST using sum types and have interpreters that run that. The advantage of using free is that since it is monadic you get to use Haskell’s <code>do</code> notation. This makes the code that generates the AST feel “natural”, it is a simple embedded domain specific language</p>
<h1 id="the-free-operations">The free operations</h1>
<div class="sourceCode" id="cb2"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb2-1" title="1"><span class="ot">{-# LANGUAGE FlexibleContexts #-}</span></a>
<a class="sourceLine" id="cb2-2" title="2"><span class="ot">{-# LANGUAGE TemplateHaskell #-}</span></a>
<a class="sourceLine" id="cb2-3" title="3"><span class="ot">{-# LANGUAGE DeriveFunctor #-}</span></a>
<a class="sourceLine" id="cb2-4" title="4"></a>
<a class="sourceLine" id="cb2-5" title="5"><span class="kw">module</span> <span class="dt">Main</span> <span class="kw">where</span></a>
<a class="sourceLine" id="cb2-6" title="6"></a>
<a class="sourceLine" id="cb2-7" title="7"><span class="kw">import</span>           <span class="dt">Control.Monad.Free</span></a>
<a class="sourceLine" id="cb2-8" title="8"><span class="kw">import</span>           <span class="dt">Control.Monad.Free.TH</span></a>
<a class="sourceLine" id="cb2-9" title="9"></a>
<a class="sourceLine" id="cb2-10" title="10"><span class="kw">data</span> <span class="dt">OpsF</span> m next <span class="fu">=</span> <span class="dt">OpRead</span> (<span class="dt">Text</span> <span class="ot">-&gt;</span> next)</a>
<a class="sourceLine" id="cb2-11" title="11">                 <span class="fu">|</span> <span class="dt">OpWrite</span> <span class="dt">Text</span> next</a>
<a class="sourceLine" id="cb2-12" title="12">                 <span class="fu">|</span> <span class="dt">OpLog</span> <span class="dt">Text</span> next</a>
<a class="sourceLine" id="cb2-13" title="13">                 <span class="fu">|</span> <span class="dt">OpRun</span> <span class="dt">Text</span> (<span class="dt">Text</span> <span class="ot">-&gt;</span> m <span class="dt">Text</span>) <span class="dt">Text</span> (<span class="dt">Text</span> <span class="ot">-&gt;</span> next)</a>
<a class="sourceLine" id="cb2-14" title="14">                 <span class="kw">deriving</span> (<span class="dt">Functor</span>)</a>
<a class="sourceLine" id="cb2-15" title="15"></a>
<a class="sourceLine" id="cb2-16" title="16">makeFree '<span class="dt">'OpsF</span></a>
<a class="sourceLine" id="cb2-17" title="17"><span class="kw">type</span> <span class="dt">Ops</span> m <span class="fu">=</span> <span class="dt">Free</span> (<span class="dt">OpsF</span> m)</a></code></pre></div>
<p>I’m using template haskell and DeriveFunctor to do all the heavy lifting. I.e. it creates all the types that lift your operations into the Free monad. Not having to manually do this makes creating free monads pretty simple. If you have not used free before I’d suggest reading some of the articles I’ve linked to below to understand the detail, or you can just follow this pattern for now</p>
<ol type="1">
<li>The last type in the data constructor is the “return type”</li>
<li><code>next</code> is what enables the chaining</li>
<li>If the last type is a function returning next, that means that you can bind the value</li>
</ol>
<p>E.g. for OpWrite</p>
<div class="sourceCode" id="cb3"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb3-1" title="1"><span class="co">-- data OpsF m next = OpWrite Text next</span></a>
<a class="sourceLine" id="cb3-2" title="2"><span class="co">--                  | ...</span></a>
<a class="sourceLine" id="cb3-3" title="3"><span class="kw">do</span></a>
<a class="sourceLine" id="cb3-4" title="4">  opWrite <span class="st">&quot;param1&quot;</span></a>
<a class="sourceLine" id="cb3-5" title="5">  opWrite <span class="st">&quot;param2&quot;</span></a></code></pre></div>
<ol type="1">
<li><strong>opWrite</strong> is the function created by template Haskell that constructs a <strong>OpWrite</strong>.</li>
<li><strong>opWrite</strong> takes a single param, the <strong>Text</strong> from “OpWrite Text next”</li>
<li>Since there is a <strong>next</strong> you can have multiple statements in the <strong>do</strong> block</li>
</ol>
<p>E.g. for OpRead</p>
<div class="sourceCode" id="cb4"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb4-1" title="1"><span class="co">-- data OpsF m next = OpRead (Text -&gt; next)</span></a>
<a class="sourceLine" id="cb4-2" title="2"><span class="co">--                  | ...</span></a>
<a class="sourceLine" id="cb4-3" title="3"><span class="kw">do</span></a>
<a class="sourceLine" id="cb4-4" title="4">  r <span class="ot">&lt;-</span> opRead </a></code></pre></div>
<ol type="1">
<li><strong>opRead</strong> is the function created by template Haskell that constructs a <strong>OpRead</strong>.</li>
<li><strong>opRead</strong> takes no parameters</li>
<li>We can bind to the Text result the <strong>(Text -&gt; next)</strong> from “OpRead (Text -&gt; next)”</li>
</ol>
<p>And here is an example using several of the DSL operations together</p>
<div class="sourceCode" id="cb5"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb5-1" title="1"><span class="ot">createAst ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> (<span class="dt">Ops</span> m) <span class="dt">Text</span></a>
<a class="sourceLine" id="cb5-2" title="2">createAst x <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb5-3" title="3">  opLog <span class="fu">$</span> <span class="st">&quot;starting: &quot;</span> <span class="fu">&lt;&gt;</span> x</a>
<a class="sourceLine" id="cb5-4" title="4">  r <span class="ot">&lt;-</span> opRead</a>
<a class="sourceLine" id="cb5-5" title="5">  opWrite <span class="fu">$</span> r <span class="fu">&lt;&gt;</span> x</a></code></pre></div>
<h2 id="interpreting">Interpreting</h2>
<p>After running the <strong>createAst</strong> function what you have is an AST. opRead etc do nothing on their own. This is the magic of using free with do notation. We go to write normal, pure, code and we end up with an AST.</p>
<p>Given this AST it is possible to write different interpreters that act in various ways. E.g. one for testing, one for local, one for running in the cloud etc.</p>
<h1 id="was-this-not-about-exceptions">Was this not about exceptions?</h1>
<p>Yes, lets write an interpreter that, similar to the record wrapper approach, catches exceptions.</p>
<p>However before starting its worth reiterating a few points about exceptions from my previous post. Remember that it is usually a very bad idea to catch all exceptions as you may end up catching exceptions that you ought not to catch. See <a href="https://www.fpcomplete.com/blog/2016/11/exceptions-best-practices-haskell">Exceptions best practices in Haskell</a> for a good overview. There are several ways to ensure that you are only catch asynchronous exceptions. In these examples I’m going to be using the <a href="https://hackage.haskell.org/package/safe-exceptions">safe exceptions</a> package which does exactly that.</p>
<p>Right, back to the code. In this example interpreterFile is a function that interprets the AST and uses a file to store/load the state</p>
<div class="sourceCode" id="cb6"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb6-1" title="1"><span class="co">-- Make sure that the SafeException functions are used</span></a>
<a class="sourceLine" id="cb6-2" title="2"><span class="kw">import</span> <span class="dt">Protolude</span> <span class="kw">hiding</span> (catch, throwIO)</a>
<a class="sourceLine" id="cb6-3" title="3"><span class="kw">import</span> <span class="dt">Control.Exception.Safe</span> (catch, throwIO)</a>
<a class="sourceLine" id="cb6-4" title="4"></a>
<a class="sourceLine" id="cb6-5" title="5"></a>
<a class="sourceLine" id="cb6-6" title="6"><span class="ot">interpreterFile ::</span> (<span class="dt">Ops</span> <span class="dt">IO</span>) <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">ExceptT</span> <span class="dt">OpsError</span> <span class="dt">IO</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb6-7" title="7">interpreterFile o <span class="fu">=</span></a>
<a class="sourceLine" id="cb6-8" title="8">  <span class="kw">case</span> o <span class="kw">of</span></a>
<a class="sourceLine" id="cb6-9" title="9">    <span class="dt">Pure</span> a <span class="ot">-&gt;</span> <span class="fu">pure</span> a   <span class="co">-- no next action</span></a>
<a class="sourceLine" id="cb6-10" title="10"></a>
<a class="sourceLine" id="cb6-11" title="11">    (<span class="dt">Free</span> (<span class="dt">OpRead</span> n)) <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb6-12" title="12">      <span class="kw">do</span></a>
<a class="sourceLine" id="cb6-13" title="13">        r <span class="ot">&lt;-</span> liftIO <span class="fu">$</span> Txt.readFile <span class="st">&quot;data.txt&quot;</span></a>
<a class="sourceLine" id="cb6-14" title="14">        interpreterFile <span class="fu">$</span> n r  <span class="co">-- run next</span></a>
<a class="sourceLine" id="cb6-15" title="15">      <span class="ot">`catch`</span></a>
<a class="sourceLine" id="cb6-16" title="16">        handler <span class="dt">ErrRead</span></a>
<a class="sourceLine" id="cb6-17" title="17"></a>
<a class="sourceLine" id="cb6-18" title="18">    (<span class="dt">Free</span> (<span class="dt">OpWrite</span> t n)) <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb6-19" title="19">      <span class="kw">do</span></a>
<a class="sourceLine" id="cb6-20" title="20">        liftIO <span class="fu">$</span> Txt.writeFile <span class="st">&quot;data.txt&quot;</span> t</a>
<a class="sourceLine" id="cb6-21" title="21">        interpreterFile n  <span class="co">-- run next</span></a>
<a class="sourceLine" id="cb6-22" title="22">      <span class="ot">`catch`</span></a>
<a class="sourceLine" id="cb6-23" title="23">        handler <span class="dt">ErrWrite</span></a>
<a class="sourceLine" id="cb6-24" title="24">      </a>
<a class="sourceLine" id="cb6-25" title="25">    (<span class="dt">Free</span> (<span class="dt">OpRun</span> name fn t n)) <span class="ot">-&gt;</span></a>
<a class="sourceLine" id="cb6-26" title="26">      <span class="kw">do</span></a>
<a class="sourceLine" id="cb6-27" title="27">        r <span class="ot">&lt;-</span> lift <span class="fu">$</span> fn t</a>
<a class="sourceLine" id="cb6-28" title="28">        interpreterFile <span class="fu">$</span> n r  <span class="co">-- run next</span></a>
<a class="sourceLine" id="cb6-29" title="29">      <span class="ot">`catch`</span></a>
<a class="sourceLine" id="cb6-30" title="30">        handler (<span class="dt">ErrRunning</span> name)</a>
<a class="sourceLine" id="cb6-31" title="31">      </a>
<a class="sourceLine" id="cb6-32" title="32">    (<span class="dt">Free</span> (<span class="dt">OpLog</span> t n)) <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb6-33" title="33">      putText <span class="fu">$</span> <span class="st">&quot;log: &quot;</span> <span class="fu">&lt;&gt;</span> t</a>
<a class="sourceLine" id="cb6-34" title="34">      interpreterFile n  <span class="co">-- run next</span></a>
<a class="sourceLine" id="cb6-35" title="35"></a>
<a class="sourceLine" id="cb6-36" title="36">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb6-37" title="37"><span class="ot">    handler ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> (<span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">OpsError</span>) <span class="ot">-&gt;</span> <span class="dt">SomeException</span> <span class="ot">-&gt;</span> <span class="dt">ExceptT</span> <span class="dt">OpsError</span> m <span class="dt">Text</span></a>
<a class="sourceLine" id="cb6-38" title="38">    handler ope e <span class="fu">=</span> throwE <span class="fu">.</span> ope <span class="fu">$</span> <span class="fu">show</span> e  <span class="co">-- catch exception and use ExceptT's throwE</span></a></code></pre></div>
<p>The operations are run and any synchronous exception is caught and handled in the ExceptT. This looks pretty similar to the record based approach but I think is simpler.</p>
<h2 id="testing">Testing</h2>
<p>Here is an interpreter for testing which uses a state monad to store/retrieve the state</p>
<div class="sourceCode" id="cb7"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb7-1" title="1"><span class="kw">data</span> <span class="dt">TestState</span> <span class="fu">=</span> <span class="dt">TestState</span> {<span class="ot"> tstValue ::</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb7-2" title="2">                           ,<span class="ot"> tstLog ::</span> [<span class="dt">Text</span>]</a>
<a class="sourceLine" id="cb7-3" title="3">                           } <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</a>
<a class="sourceLine" id="cb7-4" title="4"></a>
<a class="sourceLine" id="cb7-5" title="5"><span class="ot">interpreterState ::</span> (<span class="dt">Ops</span> (<span class="dt">S.State</span> <span class="dt">TestState</span>)) <span class="dt">Text</span> <span class="ot">-&gt;</span> (<span class="dt">S.State</span> <span class="dt">TestState</span>) <span class="dt">Text</span></a>
<a class="sourceLine" id="cb7-6" title="6">interpreterState o <span class="fu">=</span></a>
<a class="sourceLine" id="cb7-7" title="7">  <span class="kw">case</span> o <span class="kw">of</span></a>
<a class="sourceLine" id="cb7-8" title="8">    <span class="dt">Pure</span> a <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-9" title="9">      modify (\s <span class="ot">-&gt;</span> s { tstValue <span class="fu">=</span> a })</a>
<a class="sourceLine" id="cb7-10" title="10">      tstValue <span class="fu">&lt;$&gt;</span> get</a>
<a class="sourceLine" id="cb7-11" title="11"></a>
<a class="sourceLine" id="cb7-12" title="12">    (<span class="dt">Free</span> (<span class="dt">OpRead</span> n)) <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-13" title="13">      st <span class="ot">&lt;-</span> S.get </a>
<a class="sourceLine" id="cb7-14" title="14">      interpreterState <span class="fu">$</span> n (tstValue st)</a>
<a class="sourceLine" id="cb7-15" title="15"></a>
<a class="sourceLine" id="cb7-16" title="16">    (<span class="dt">Free</span> (<span class="dt">OpWrite</span> t n)) <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-17" title="17">      S.modify (\s <span class="ot">-&gt;</span> s { tstValue <span class="fu">=</span> t } )</a>
<a class="sourceLine" id="cb7-18" title="18">      interpreterState n</a>
<a class="sourceLine" id="cb7-19" title="19">      </a>
<a class="sourceLine" id="cb7-20" title="20">    (<span class="dt">Free</span> (<span class="dt">OpRun</span> _ fn t n)) <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-21" title="21">      r <span class="ot">&lt;-</span> fn t</a>
<a class="sourceLine" id="cb7-22" title="22">      interpreterState <span class="fu">$</span> n r</a>
<a class="sourceLine" id="cb7-23" title="23">      </a>
<a class="sourceLine" id="cb7-24" title="24">    (<span class="dt">Free</span> (<span class="dt">OpLog</span> t n)) <span class="ot">-&gt;</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-25" title="25">      S.modify (\(<span class="dt">TestState</span> s ls) <span class="ot">-&gt;</span> <span class="dt">TestState</span> s <span class="fu">$</span> ls <span class="fu">&lt;&gt;</span> [t])</a>
<a class="sourceLine" id="cb7-26" title="26">      interpreterState n</a></code></pre></div>
<p>Compare that to the previous approach’s tests</p>
<div class="sourceCode" id="cb8"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb8-1" title="1"><span class="ot">testPipeline ::</span> [<span class="dt">I2.Job</span> (<span class="dt">S.State</span> <span class="dt">Text</span>)] <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">S.State</span> <span class="dt">Text</span> (<span class="dt">Either</span> <span class="dt">I3.OpsError</span> <span class="dt">Text</span>)</a>
<a class="sourceLine" id="cb8-2" title="2">testPipeline jobs initial <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb8-3" title="3">  <span class="kw">let</span> ops <span class="fu">=</span> <span class="dt">I3.OperationsWrapper</span> { I3.opRead <span class="fu">=</span> <span class="dt">E.ExceptT</span> <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb8-4" title="4">                                     r <span class="ot">&lt;-</span> get</a>
<a class="sourceLine" id="cb8-5" title="5">                                     <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Right</span> <span class="fu">$</span> r</a></code></pre></div>
<p>The big advantage here is that the tests are no longer forced to use ExceptT. Each interpreter, for testing or otherwise, can use whatever stack is appropriate</p>
<h1 id="problems">Problems</h1>
<p>As always there are trade offs, see the <a href="https://markkarpov.com/post/free-monad-considered-harmful.html">Free monad considered harmful</a> article for example. While some of these issues can be address (e.g. see church encoding below) it is worth considering alternatives.</p>
<p>Personally, so far, I’ve found free to be a great fit for what I need (e.g. selecting implementation not based on type), but its definitely worth deciding on a case by case basis</p>
<h1 id="church-encoding">Church encoding</h1>
<p>The <a href="https://hackage.haskell.org/package/free-4.12.4/docs/Control-Monad-Free-Church.html">Control.Monad.Free.Church</a> package handles church encoding of a free monad. This can be important to do because, as it says in <a href="https://hackage.haskell.org/package/free-4.12.4/docs/Control-Monad-Free-Church.html">Control.Monad.Free.Church</a>:</p>
<p><em><code>Even if the Haskell runtime optimizes some of the overhead through laziness and generational garbage collection, the asymptotic runtime is still quadratic. On the other hand, if the Church encoding is used, the tree only needs to be constructed once.</code></em></p>
<p>Given how easy this package makes church encoding, and how bad O(n^2) performance can be, it is almost always a good idea to do the encoding.</p>
<p><em>(I originally found getting the types correct for Church encoding a bit tricky. This <a href="https://github.com/queertypes/free-tutorial">Free monad and church encoding example</a> helped clear up a lot of the confusion for me. Be sure to look at it as well if my explanation below does not help you).</em></p>
<p>To get Church encoding, the only requirement is that you use a MonadFree constraint rather than your more specific data type for the function that generates the DSL.</p>
<p>In the example above createAst looked like this.</p>
<div class="sourceCode" id="cb9"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb9-1" title="1"><span class="ot">createAst ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> (<span class="dt">Ops</span> m) <span class="dt">Text</span></a>
<a class="sourceLine" id="cb9-2" title="2">createAst x <span class="fu">=</span> <span class="kw">do</span></a></code></pre></div>
<p>The problem is that I’ve used the “<code>Ops m</code>” type, rather than MonadFree.</p>
<p>Here is what it should look like</p>
<div class="sourceCode" id="cb10"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb10-1" title="1"><span class="ot">createAst ::</span> (<span class="dt">Monad</span> m, <span class="dt">MonadFree</span> (<span class="dt">OpsF</span> m) a) <span class="ot">=&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> [<span class="dt">Job</span> m] <span class="ot">-&gt;</span> a <span class="dt">Text</span></a>
<a class="sourceLine" id="cb10-2" title="2">createAst x <span class="fu">=</span> <span class="kw">do</span></a></code></pre></div>
<p>The important parts being</p>
<div class="sourceCode" id="cb11"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb11-1" title="1"><span class="ot">createAst ::</span> (<span class="dt">Monad</span> m, <span class="dt">MonadFree</span> (<span class="dt">OpsF</span> m) a) <span class="ot">=&gt;</span> <span class="fu">...............</span> <span class="ot">-&gt;</span> a <span class="dt">Text</span></a>
<a class="sourceLine" id="cb11-2" title="2">createAst x <span class="fu">=</span> <span class="kw">do</span></a></code></pre></div>
<ul>
<li>Change from Ops to OpsF</li>
<li>Add “<code>MonadFree (...) a</code>”</li>
</ul>
<p>This is how it would be run without Church encoding</p>
<div class="sourceCode" id="cb12"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb12-1" title="1">  <span class="co">--------------------------------------------------</span></a>
<a class="sourceLine" id="cb12-2" title="2">  <span class="co">-- Example in IO with exception</span></a>
<a class="sourceLine" id="cb12-3" title="3">  <span class="co">--------------------------------------------------</span></a>
<a class="sourceLine" id="cb12-4" title="4">  <span class="kw">let</span> ioJobs <span class="fu">=</span> [ <span class="dt">Job</span> <span class="st">&quot;j1&quot;</span> ioJob1</a>
<a class="sourceLine" id="cb12-5" title="5">               , <span class="dt">Job</span> <span class="st">&quot;j2&quot;</span> ioJob2</a>
<a class="sourceLine" id="cb12-6" title="6">               , <span class="dt">Job</span> <span class="st">&quot;j3&quot;</span> ioJob3</a>
<a class="sourceLine" id="cb12-7" title="7">               ]</a>
<a class="sourceLine" id="cb12-8" title="8">  </a>
<a class="sourceLine" id="cb12-9" title="9">  a <span class="ot">&lt;-</span> runExceptT <span class="fu">$</span> interpreterFile <span class="fu">$</span> createAst <span class="st">&quot;test1&quot;</span> ioJobs</a>
<a class="sourceLine" id="cb12-10" title="10">  <span class="fu">print</span> a</a></code></pre></div>
<p>And this is how its run with Church encoding using <code>improve</code> from Control.Monad.Free.Church</p>
<div class="sourceCode" id="cb13"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb13-1" title="1">  <span class="co">--------------------------------------------------</span></a>
<a class="sourceLine" id="cb13-2" title="2">  <span class="co">-- Example in IO with exception</span></a>
<a class="sourceLine" id="cb13-3" title="3">  <span class="co">--------------------------------------------------</span></a>
<a class="sourceLine" id="cb13-4" title="4">  <span class="kw">let</span> ioJobs <span class="fu">=</span> [ <span class="dt">Job</span> <span class="st">&quot;j1&quot;</span> ioJob1</a>
<a class="sourceLine" id="cb13-5" title="5">               , <span class="dt">Job</span> <span class="st">&quot;j2&quot;</span> ioJob2</a>
<a class="sourceLine" id="cb13-6" title="6">               , <span class="dt">Job</span> <span class="st">&quot;j3&quot;</span> ioJob3</a>
<a class="sourceLine" id="cb13-7" title="7">               ]</a>
<a class="sourceLine" id="cb13-8" title="8">  </a>
<a class="sourceLine" id="cb13-9" title="9">        <span class="co">-- Note that createAst must be run inline here to avoid an error about the monad constraints</span></a>
<a class="sourceLine" id="cb13-10" title="10">  ai <span class="ot">&lt;-</span> runExceptT <span class="fu">$</span> interpreterFile (C.improve <span class="fu">$</span> createAst <span class="st">&quot;test1&quot;</span> ioJobs)</a>
<a class="sourceLine" id="cb13-11" title="11">  <span class="fu">print</span> ai</a></code></pre></div>
<p>That is all it takes, we can now use free without O(n^2) concerns</p>
<h1 id="conclusion">Conclusion</h1>
<p>Free monads give us a nice way to separate pure and impure code while also handling exceptions. Overall I think this approach is more flexible and easier to read that the record of functions approach.</p>
<h1 id="links">Links</h1>
<ul>
<li><p><a href="https://gist.github.com/andrevdm/4d1625e6504e3f1fef9ee9fbc1298b34">Code on github (gist)</a></p></li>
<li>Free monad tutorials
<ul>
<li><a href="http://www.haskellforall.com/2012/07/purify-code-using-free-monads.html">Purify code using free monads</a></li>
<li><a href="http://www.haskellforall.com/2012/06/you-could-have-invented-free-monads.html">Why free monads matter</a></li>
<li><a href="http://www.parsonsmatt.org/2017/09/22/what_does_free_buy_us.html">What does Free buy us?</a></li>
</ul></li>
<li><a href="https://hackage.haskell.org/package/free">Control.Monad.Free</a></li>
<li><a href="https://hackage.haskell.org/package/free-4.12.4/docs/Control-Monad-Free-Church.html">Control.Monad.Free.Church</a></li>
<li><a href="https://markkarpov.com/post/free-monad-considered-harmful.html">Free monad considered harmful</a></li>
<li><a href="https://github.com/queertypes/free-tutorial">Free monad and church encoding example</a></li>
<li><p><a href="https://www.fpcomplete.com/blog/2016/11/exceptions-best-practices-haskell">Exceptions best practices in Haskell</a></p></li>
<li><p><a href="https://gist.github.com/brandonhamilton/2a87b8d66aa6bd7872c3848cd99318e1">Port of example code to use operational monad by @brandonhamilton</a></p></li>
</ul>


        </div>
        <div id="footer">
            Site proudly generated by
            <a href="http://jaspervdj.be/hakyll">Hakyll</a>
        </div>
        </div>

        <script>
          (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
          (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
          m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
          })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

          ga('create', 'UA-78428674-1', 'auto');
          ga('send', 'pageview');
        </script>
    </body>
</html>
]]></summary>
</entry>
<entry>
    <title>Refactoring to pure code and dealing with exceptions.</title>
    <link href="http://www.andrevdm.com/posts/2017-10-31-refactor-away-io.html" />
    <id>http://www.andrevdm.com/posts/2017-10-31-refactor-away-io.html</id>
    <published>2017-10-31T00:00:00Z</published>
    <updated>2017-10-31T00:00:00Z</updated>
    <summary type="html"><![CDATA[<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
        <title>Andre's Blog</title>
        <link rel="stylesheet" type="text/css" href="../css/default.css" />
        <link rel="stylesheet" type="text/css" href="../css/syntax.css" />
    </head>
    <body>
      <div id="bodyInner">
        <div id="header">
            <div id="logo">
                <a href="../">Blog</a>
            </div>
            <div id="navigation">
                <a href="../">Home</a>
                <a href="../contact.html">Contact</a>
                <!-- <a href="/about.html">About</a> -->
            </div>
        </div>

        <div id="content">
            <h1><a href="#top">Refactoring to pure code and dealing with exceptions.</a></h1>

            <div class="info">
    Posted on October 31, 2017

</div>

<h1 id="overview">Overview</h1>
<p><em>(TL;DR: I use a record of functions &amp; a record of wrapper functions that catch all synchronous exceptions and convert to ExceptT for the pure code) </em></p>
<p>See also the followup post on <a href="2018-01-08-refactor-free.html">using Free as an alternative</a></p>
<p>This is a quick overview of how I refactored one of my first production haskell application that had a majority of IO code to be more pure. I’ve seen several approaches with different trade offs but none that fit exactly what I was doing 100%.</p>
<p>The design I needed was a pipeline of actions that needs to be performed, where each job in the pipeline is considered user code (think plugin)</p>
<p>Some design notes</p>
<ol type="1">
<li>Job
<ol type="1">
<li>Can run any IO action and as a result these actions can fail with exceptions</li>
<li>I don’t want to constrain what a job can do in any way, i.e. full IO access</li>
<li>This is custom code and can fail for any number of reasons, network errors, disk permissions etc</li>
</ol></li>
<li>Pipeline
<ol type="1">
<li>Must run impure jobs but be as pure as possible itself</li>
<li>Must be able to handle job failure (exceptions)</li>
<li>Supports different storage mechanisms, e.g. on disk for local dev vs cloud for production</li>
</ol></li>
</ol>
<p>Both jobs and the pipeline should be testable</p>
<h1 id="step-1---just-use-io-and-refactor-later">Step 1 - Just use IO and refactor later</h1>
<h2 id="jobs">Jobs</h2>
<div class="sourceCode" id="cb1"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb1-1" title="1"><span class="kw">data</span> <span class="dt">Job</span> <span class="fu">=</span> <span class="dt">Job</span> {<span class="ot"> jobName ::</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb1-2" title="2">               ,<span class="ot"> jobFn ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb1-3" title="3">               }</a></code></pre></div>
<p>A job has a name and an IO action to perform. In this demo a job takes a text value, does some transformation and returns a resulting text value. In a real world application this record would contain more operations and probably be polymorphic</p>
<h2 id="operations">Operations</h2>
<div class="sourceCode" id="cb2"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb2-1" title="1"><span class="kw">data</span> <span class="dt">Operations</span> <span class="fu">=</span> <span class="dt">Operations</span> {<span class="ot"> opRead ::</span> <span class="dt">IO</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb2-2" title="2">                             ,<span class="ot"> opWrite ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb2-3" title="3">                             }</a></code></pre></div>
<p>Operations is a record of operations that the pipeline uses to persist job results. I.e. this is the pluggable storage and related functions</p>
<p>I’ve chosen to pass a record of functions rather than using a type class. For discussion on records vs typeclass for this type of design see</p>
<ol type="1">
<li><a href="https://www.fpcomplete.com/blog/2017/06/readert-design-pattern">ReaderT design pattern</a></li>
<li><a href="https://github.com/lexi-lambda/mtl-style-example">mtl-style-example: A small, self-contained example of using mtl style to unit test effectful code in a pure way</a></li>
<li><a href="https://chris-martin.org/2017/interfaces-and-records">Java interfaces map to Haskell records</a></li>
</ol>
<p>A pluggable set of operations feels more natural as a record of functions to me than a typeclass. For me this is because they are just a named set of functions rather than something that has a set of rules (“an algebra”).</p>
<h2 id="pipeline">Pipeline</h2>
<div class="sourceCode" id="cb3"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb3-1" title="1"><span class="ot">runPipeline ::</span> <span class="dt">Operations</span> <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> [<span class="dt">Job</span>] <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb3-2" title="2">runPipeline ops <span class="fu">init</span> jobs <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb3-3" title="3">  opWrite ops <span class="fu">init</span></a>
<a class="sourceLine" id="cb3-4" title="4">  <span class="fu">id</span> <span class="ot">&lt;-</span> foldlM runJob <span class="dv">0</span> jobs</a>
<a class="sourceLine" id="cb3-5" title="5"></a>
<a class="sourceLine" id="cb3-6" title="6">  putText <span class="fu">$</span> <span class="st">&quot;\nfinal job id = &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> <span class="fu">id</span></a>
<a class="sourceLine" id="cb3-7" title="7">  opRead ops</a>
<a class="sourceLine" id="cb3-8" title="8"></a>
<a class="sourceLine" id="cb3-9" title="9">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb3-10" title="10">    runJob (<span class="fu">id</span><span class="ot"> ::</span> <span class="dt">Int</span>) (<span class="dt">Job</span> name fn) <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb3-11" title="11">      putText <span class="fu">$</span> <span class="st">&quot;running job: &quot;</span> <span class="fu">&lt;&gt;</span> name</a>
<a class="sourceLine" id="cb3-12" title="12"></a>
<a class="sourceLine" id="cb3-13" title="13">      prev <span class="ot">&lt;-</span> opRead ops</a>
<a class="sourceLine" id="cb3-14" title="14">      r <span class="ot">&lt;-</span> fn prev</a>
<a class="sourceLine" id="cb3-15" title="15">      opWrite ops r</a>
<a class="sourceLine" id="cb3-16" title="16">      </a>
<a class="sourceLine" id="cb3-17" title="17">      putText <span class="fu">$</span> <span class="st">&quot;  = &quot;</span> <span class="fu">&lt;&gt;</span> r</a>
<a class="sourceLine" id="cb3-18" title="18">      putText <span class="st">&quot;  ----&quot;</span></a>
<a class="sourceLine" id="cb3-19" title="19"></a>
<a class="sourceLine" id="cb3-20" title="20">      <span class="fu">pure</span> <span class="fu">$</span> <span class="fu">id</span> <span class="fu">+</span> <span class="dv">1</span></a></code></pre></div>
<p>Run each job in order, for each job</p>
<ol type="1">
<li>Load the last data</li>
<li>Run the job</li>
<li>Store the result</li>
<li>Pass a unique (for the run) id to each step</li>
</ol>
<p><em>(Obviously I could simply pass the previous state as part of the fold and do away with the load and store. Its done this way for the demonstration)</em></p>
<h2 id="storage">Storage</h2>
<div class="sourceCode" id="cb4"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb4-1" title="1"><span class="kw">import</span>           <span class="dt">Protolude</span></a>
<a class="sourceLine" id="cb4-2" title="2"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Data.Text.IO</span> <span class="kw">as</span> <span class="dt">Txt</span></a>
<a class="sourceLine" id="cb4-3" title="3"></a>
<a class="sourceLine" id="cb4-4" title="4"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Step1.Impl1</span> <span class="kw">as</span> <span class="dt">I</span></a>
<a class="sourceLine" id="cb4-5" title="5"></a>
<a class="sourceLine" id="cb4-6" title="6"></a>
<a class="sourceLine" id="cb4-7" title="7"><span class="ot">readFileOp ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb4-8" title="8">readFileOp <span class="fu">=</span> Txt.readFile</a>
<a class="sourceLine" id="cb4-9" title="9"></a>
<a class="sourceLine" id="cb4-10" title="10"></a>
<a class="sourceLine" id="cb4-11" title="11"><span class="ot">writeFileOp ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb4-12" title="12">writeFileOp <span class="fu">=</span> Txt.writeFile</a>
<a class="sourceLine" id="cb4-13" title="13"></a>
<a class="sourceLine" id="cb4-14" title="14"></a>
<a class="sourceLine" id="cb4-15" title="15"><span class="ot">mkFileOps ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">I.Operations</span></a>
<a class="sourceLine" id="cb4-16" title="16">mkFileOps p <span class="fu">=</span></a>
<a class="sourceLine" id="cb4-17" title="17">  <span class="dt">I.Operations</span> { I.opRead <span class="fu">=</span> readFileOp p</a>
<a class="sourceLine" id="cb4-18" title="18">               , I.opWrite <span class="fu">=</span> writeFileOp p</a>
<a class="sourceLine" id="cb4-19" title="19">               }</a></code></pre></div>
<p>Here the operations are implemented by reading and writing to a file, using Data.Text.IO. The <a href="https://github.com/andrevdm/refactorAwayIO">example code</a> in github also has a STM backed storage implementation</p>
<h2 id="example-jobs">Example jobs</h2>
<div class="sourceCode" id="cb5"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb5-1" title="1"><span class="ot">job1 ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb5-2" title="2">job1 v <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb5-3" title="3">  putText <span class="st">&quot;in job1&quot;</span></a>
<a class="sourceLine" id="cb5-4" title="4">  <span class="fu">pure</span> <span class="fu">$</span> <span class="st">&quot;1:&quot;</span> <span class="fu">&lt;&gt;</span> v</a>
<a class="sourceLine" id="cb5-5" title="5"></a>
<a class="sourceLine" id="cb5-6" title="6"><span class="ot">job2 ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb5-7" title="7">job2 v <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb5-8" title="8">  putText <span class="st">&quot;in job2&quot;</span></a>
<a class="sourceLine" id="cb5-9" title="9">  void <span class="fu">.</span> throwIO <span class="fu">$</span> <span class="dt">DemoException</span> <span class="st">&quot;oops&quot;</span></a>
<a class="sourceLine" id="cb5-10" title="10">  <span class="fu">pure</span> <span class="fu">$</span> <span class="st">&quot;2:&quot;</span> <span class="fu">&lt;&gt;</span> v</a>
<a class="sourceLine" id="cb5-11" title="11"></a>
<a class="sourceLine" id="cb5-12" title="12"><span class="ot">job3 ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb5-13" title="13">job3 v <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb5-14" title="14">  putText <span class="st">&quot;in job3&quot;</span></a>
<a class="sourceLine" id="cb5-15" title="15">  <span class="fu">pure</span> <span class="fu">$</span> <span class="st">&quot;3:&quot;</span> <span class="fu">&lt;&gt;</span> v</a>
<a class="sourceLine" id="cb5-16" title="16"></a>
<a class="sourceLine" id="cb5-17" title="17"></a>
<a class="sourceLine" id="cb5-18" title="18"><span class="kw">newtype</span> <span class="dt">DemoException</span> <span class="fu">=</span> <span class="dt">DemoException</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb5-19" title="19"></a>
<a class="sourceLine" id="cb5-20" title="20"><span class="kw">instance</span> <span class="dt">Show</span> <span class="dt">DemoException</span> <span class="kw">where</span></a>
<a class="sourceLine" id="cb5-21" title="21">  <span class="fu">show</span> (<span class="dt">DemoException</span> s) <span class="fu">=</span> Txt.unpack s</a>
<a class="sourceLine" id="cb5-22" title="22">  </a>
<a class="sourceLine" id="cb5-23" title="23"><span class="kw">instance</span> <span class="dt">Exception</span> <span class="dt">DemoException</span></a></code></pre></div>
<p>These are three example jobs. Notice that the second one explicitly throws an exception. A job can explicitly throw an exception like this or it could throw an exception on failure (e.g. network error)</p>
<h2 id="running">Running</h2>
<div class="sourceCode" id="cb6"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb6-1" title="1"><span class="kw">import</span>           <span class="dt">Protolude</span> <span class="kw">hiding</span> (catch, throwIO)</a>
<a class="sourceLine" id="cb6-2" title="2"></a>
<a class="sourceLine" id="cb6-3" title="3"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Step1.Impl1</span> <span class="kw">as</span> <span class="dt">I1</span></a>
<a class="sourceLine" id="cb6-4" title="4"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Step1.Storage1</span> <span class="kw">as</span> <span class="dt">S1</span></a>
<a class="sourceLine" id="cb6-5" title="5"></a>
<a class="sourceLine" id="cb6-6" title="6"><span class="ot">main ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb6-7" title="7">main <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb6-8" title="8">  <span class="kw">let</span> jobs <span class="fu">=</span> [ <span class="dt">I1.Job</span> <span class="st">&quot;j1&quot;</span> job1</a>
<a class="sourceLine" id="cb6-9" title="9">             , <span class="dt">I1.Job</span> <span class="st">&quot;j2&quot;</span> job2</a>
<a class="sourceLine" id="cb6-10" title="10">             , <span class="dt">I1.Job</span> <span class="st">&quot;j3&quot;</span> job3</a>
<a class="sourceLine" id="cb6-11" title="11">             ]</a>
<a class="sourceLine" id="cb6-12" title="12">  </a>
<a class="sourceLine" id="cb6-13" title="13">  <span class="kw">let</span> ops <span class="fu">=</span> S1.mkFileOps</a>
<a class="sourceLine" id="cb6-14" title="14">  r <span class="ot">&lt;-</span> I1.runPipeline ops <span class="st">&quot;0&quot;</span> jobs</a>
<a class="sourceLine" id="cb6-15" title="15">  putText r</a></code></pre></div>
<p>When run this will fail with an exception in job 2 and result in the application terminating</p>
<div class="sourceCode" id="cb7"><pre class="sourceCode email"><code class="sourceCode email"><a class="sourceLine" id="cb7-1" title="1">---------</a>
<a class="sourceLine" id="cb7-2" title="2"> Demo1: in memory</a>
<a class="sourceLine" id="cb7-3" title="3">---------</a>
<a class="sourceLine" id="cb7-4" title="4">running job: j1</a>
<a class="sourceLine" id="cb7-5" title="5">in job1</a>
<a class="sourceLine" id="cb7-6" title="6">  = 1:0</a>
<a class="sourceLine" id="cb7-7" title="7">  ----</a>
<a class="sourceLine" id="cb7-8" title="8">running job: j2</a>
<a class="sourceLine" id="cb7-9" title="9">in job2</a>
<a class="sourceLine" id="cb7-10" title="10"><span class="fu">Exception: </span>oops</a></code></pre></div>
<h1 id="step-2---monad-m">Step 2 - (Monad m)</h1>
<p>So far the example has a working pipeline but everything is in IO and it does nothing about exceptions.</p>
<p>Lets remove some IO constraints.</p>
<div class="sourceCode" id="cb8"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb8-1" title="1"><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></a>
<a class="sourceLine" id="cb8-2" title="2"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></a>
<a class="sourceLine" id="cb8-3" title="3"><span class="ot">{-# LANGUAGE ScopedTypeVariables #-}</span></a>
<a class="sourceLine" id="cb8-4" title="4"></a>
<a class="sourceLine" id="cb8-5" title="5"><span class="kw">module</span> <span class="dt">Step2.Impl2</span> ( <span class="dt">Operations</span> (<span class="fu">..</span>)</a>
<a class="sourceLine" id="cb8-6" title="6">                   , <span class="dt">Job</span> (<span class="fu">..</span>)</a>
<a class="sourceLine" id="cb8-7" title="7">                   , runPipeline</a>
<a class="sourceLine" id="cb8-8" title="8">                   ) <span class="kw">where</span></a>
<a class="sourceLine" id="cb8-9" title="9"></a>
<a class="sourceLine" id="cb8-10" title="10"><span class="kw">import</span> <span class="dt">Protolude</span></a>
<a class="sourceLine" id="cb8-11" title="11"></a>
<a class="sourceLine" id="cb8-12" title="12"></a>
<a class="sourceLine" id="cb8-13" title="13"><span class="kw">data</span> <span class="dt">Operations</span> m <span class="fu">=</span> <span class="dt">Operations</span> {<span class="ot"> opRead ::</span> m <span class="dt">Text</span></a>
<a class="sourceLine" id="cb8-14" title="14">                               ,<span class="ot"> opWrite ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> m ()</a>
<a class="sourceLine" id="cb8-15" title="15">                               ,<span class="ot"> opLog ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> m ()</a>
<a class="sourceLine" id="cb8-16" title="16">                               }</a>
<a class="sourceLine" id="cb8-17" title="17"></a>
<a class="sourceLine" id="cb8-18" title="18"></a>
<a class="sourceLine" id="cb8-19" title="19"><span class="kw">data</span> <span class="dt">Job</span> m <span class="fu">=</span> <span class="dt">Job</span> {<span class="ot"> jobName ::</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb8-20" title="20">                 ,<span class="ot"> jobFn ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> m <span class="dt">Text</span></a>
<a class="sourceLine" id="cb8-21" title="21">                 }</a>
<a class="sourceLine" id="cb8-22" title="22"></a>
<a class="sourceLine" id="cb8-23" title="23"><span class="ot">runPipeline ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">Operations</span> m <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> [<span class="dt">Job</span> m] <span class="ot">-&gt;</span> m <span class="dt">Text</span></a>
<a class="sourceLine" id="cb8-24" title="24">runPipeline ops <span class="fu">init</span> jobs <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb8-25" title="25">  opWrite ops <span class="fu">init</span></a>
<a class="sourceLine" id="cb8-26" title="26">  <span class="fu">id</span> <span class="ot">&lt;-</span> foldlM runJob <span class="dv">0</span> jobs</a>
<a class="sourceLine" id="cb8-27" title="27"></a>
<a class="sourceLine" id="cb8-28" title="28">  opLog ops <span class="fu">$</span> <span class="st">&quot;\nfinal job id = &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> <span class="fu">id</span></a>
<a class="sourceLine" id="cb8-29" title="29">  opRead ops</a>
<a class="sourceLine" id="cb8-30" title="30"></a>
<a class="sourceLine" id="cb8-31" title="31">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb8-32" title="32">    runJob (<span class="fu">id</span><span class="ot"> ::</span> <span class="dt">Int</span>) (<span class="dt">Job</span> name fn) <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb8-33" title="33">      opLog ops <span class="fu">$</span> <span class="st">&quot;running job: &quot;</span> <span class="fu">&lt;&gt;</span> name</a>
<a class="sourceLine" id="cb8-34" title="34"></a>
<a class="sourceLine" id="cb8-35" title="35">      prev <span class="ot">&lt;-</span> opRead ops</a>
<a class="sourceLine" id="cb8-36" title="36">      r <span class="ot">&lt;-</span> fn prev</a>
<a class="sourceLine" id="cb8-37" title="37">      opWrite ops r</a>
<a class="sourceLine" id="cb8-38" title="38">      </a>
<a class="sourceLine" id="cb8-39" title="39">      opLog ops <span class="fu">$</span> <span class="st">&quot;  = &quot;</span> <span class="fu">&lt;&gt;</span> r</a>
<a class="sourceLine" id="cb8-40" title="40">      opLog ops <span class="st">&quot;  ----&quot;</span></a>
<a class="sourceLine" id="cb8-41" title="41"></a>
<a class="sourceLine" id="cb8-42" title="42">      <span class="fu">pure</span> <span class="fu">$</span> <span class="fu">id</span> <span class="fu">+</span> <span class="dv">1</span></a></code></pre></div>
<p>Here I’ve removed all explicit IO actions for the pipeline types and functions</p>
<h2 id="opread">opRead</h2>
<p>opRead has changed from</p>
<div class="sourceCode" id="cb9"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb9-1" title="1"><span class="ot">opRead ::</span> <span class="dt">IO</span> <span class="dt">Text</span></a></code></pre></div>
<p>to</p>
<div class="sourceCode" id="cb10"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb10-1" title="1"><span class="ot">opRead ::</span> m <span class="dt">Text</span></a></code></pre></div>
<p>i.e. the type no longer explicitly says IO but now accepts any kind * -&gt; * (e.g. any monad)</p>
<h2 id="operations-1">Operations</h2>
<p>The Operations type has changed from</p>
<div class="sourceCode" id="cb11"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb11-1" title="1"><span class="kw">data</span> <span class="dt">Operations</span> <span class="fu">=</span> <span class="dt">Operations</span> {<span class="fu">..</span>}</a></code></pre></div>
<p>to</p>
<div class="sourceCode" id="cb12"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb12-1" title="1"><span class="kw">data</span> <span class="dt">Operations</span> m <span class="fu">=</span> <span class="dt">Operations</span> {<span class="fu">..</span>}</a></code></pre></div>
<h2 id="runpipeline">runPipeline</h2>
<p>runPipeline has changed from</p>
<div class="sourceCode" id="cb13"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb13-1" title="1"><span class="ot">runPipeline ::</span> <span class="dt">Operations</span> <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> [<span class="dt">Job</span>] <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">Text</span></a></code></pre></div>
<p>to</p>
<div class="sourceCode" id="cb14"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb14-1" title="1"><span class="ot">runPipeline ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">Operations</span> m <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> [<span class="dt">Job</span> m] <span class="ot">-&gt;</span> m <span class="dt">Text</span></a></code></pre></div>
<p>There is a constraint saying that m must be a monad. This is so that we can use the monadic type class (pure, &gt;&gt;= etc)</p>
<div class="sourceCode" id="cb15"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb15-1" title="1">(<span class="dt">Monad</span> m) <span class="ot">=&gt;</span></a></code></pre></div>
<p>And we use the <strong>Operations m</strong> and <strong>Job m</strong> types</p>
<h2 id="storage-1">Storage</h2>
<p>These changes mean that the pipeline and its types no longer require IO</p>
<p>The storage implementations need IO so you specialize the m to IO. Apart from that nothing changes I.e.</p>
<div class="sourceCode" id="cb16"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb16-1" title="1"><span class="ot">readFileOp ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb16-2" title="2">readFileOp <span class="fu">=</span> Txt.readFile</a>
<a class="sourceLine" id="cb16-3" title="3"></a>
<a class="sourceLine" id="cb16-4" title="4"><span class="ot">writeFileOp ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb16-5" title="5">writeFileOp <span class="fu">=</span> Txt.writeFile</a>
<a class="sourceLine" id="cb16-6" title="6"></a>
<a class="sourceLine" id="cb16-7" title="7"><span class="ot">mkFileOps ::</span> <span class="dt">FilePath</span> <span class="ot">-&gt;</span> <span class="dt">Operations</span> <span class="dt">IO</span></a>
<a class="sourceLine" id="cb16-8" title="8">mkFileOps p <span class="fu">=</span></a>
<a class="sourceLine" id="cb16-9" title="9">  <span class="dt">Operations</span> { opRead <span class="fu">=</span> readFileOp p</a>
<a class="sourceLine" id="cb16-10" title="10">             , opWrite <span class="fu">=</span> writeFileOp p</a>
<a class="sourceLine" id="cb16-11" title="11">             , opLog <span class="fu">=</span> putText</a>
<a class="sourceLine" id="cb16-12" title="12">             }</a></code></pre></div>
<p>Notice that I added <strong>opLog</strong>. It is used for logging rather than calling putText etc which can not be done since there is no IO (or MonadIO constraint)</p>
<h2 id="running-1">Running</h2>
<div class="sourceCode" id="cb17"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb17-1" title="1"><span class="kw">import</span>           <span class="dt">Protolude</span> <span class="kw">hiding</span> (catch, throwIO)</a>
<a class="sourceLine" id="cb17-2" title="2"></a>
<a class="sourceLine" id="cb17-3" title="3"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Step2.Storage2</span> <span class="kw">as</span> <span class="dt">S2</span></a>
<a class="sourceLine" id="cb17-4" title="4"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Step2.Impl2</span> <span class="kw">as</span> <span class="dt">I2</span></a>
<a class="sourceLine" id="cb17-5" title="5"></a>
<a class="sourceLine" id="cb17-6" title="6"></a>
<a class="sourceLine" id="cb17-7" title="7"><span class="ot">main ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb17-8" title="8">main <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb17-9" title="9">  <span class="kw">let</span> jobs <span class="fu">=</span> [ <span class="dt">I2.Job</span> <span class="st">&quot;j1&quot;</span> job1</a>
<a class="sourceLine" id="cb17-10" title="10">             , <span class="dt">I2.Job</span> <span class="st">&quot;j2&quot;</span> job2</a>
<a class="sourceLine" id="cb17-11" title="11">             , <span class="dt">I2.Job</span> <span class="st">&quot;j3&quot;</span> job3</a>
<a class="sourceLine" id="cb17-12" title="12">             ]</a>
<a class="sourceLine" id="cb17-13" title="13">  </a>
<a class="sourceLine" id="cb17-14" title="14">  <span class="kw">let</span> ops <span class="fu">=</span> S2.mkFileOps</a>
<a class="sourceLine" id="cb17-15" title="15">  r <span class="ot">&lt;-</span> I2.runPipeline ops <span class="st">&quot;0&quot;</span> jobs</a>
<a class="sourceLine" id="cb17-16" title="16">  putText r</a></code></pre></div>
<p>Note that we can use the same jobs as we did in step 1 (job1, job2 and job3).</p>
<h2 id="and-so">And… so?</h2>
<p>This simple change has already resulted in a few nice improvements.</p>
<ol type="1">
<li>The pipeline code is pure, no IO at all</li>
<li>This means that the pipeline can already be tested as pure code.</li>
<li>The pipeline can be specialized to IO and can run IO jobs or as above kept pure when testing or running non-IO jobs</li>
<li>The types are now compatible with monad transformers since a concrete monad type was not specified</li>
<li>The jobs can be used as is.</li>
</ol>
<p>That is a pretty good for not much extra work. However I have done nothing about exceptions and when this code runs it still breaks with an exception as it did before.</p>
<h1 id="step-3---exceptions">Step 3 - Exceptions</h1>
<p>If you have not seen the <a href="https://www.fpcomplete.com/blog/2016/11/exceptions-best-practices-haskell">Exceptions best practices in haskell</a> article, I think its worth looking at before continuing. The two points from the article I want to address are</p>
<ol type="1">
<li>Mixing ExceptT and exceptions mean you have to deal with multiple failure modes</li>
<li>When you are using IO anything can fail and throw an exception</li>
</ol>
<p>Not only must we accept that jobs can fail with exceptions but we should treat this as normal. I.e. when someone is writing a IO job they should be able to throw exceptions and the pipeline should handle them.</p>
<p>However I don’t want the pure code to have to deal with exceptions, I’d much rather deal with an Either type there. Which may seem to contradict point 1 from the article above. But this is not the case, remember that jobs perform IO and thus should deal with exceptions and the pipeline is pure and should not, so ExceptT/Either is fine.</p>
<p>And so we need something to bridge the gap between the two worlds.</p>
<h2 id="the-wrapper-type">The wrapper type</h2>
<div class="sourceCode" id="cb18"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb18-1" title="1"><span class="kw">data</span> <span class="dt">OpsError</span> <span class="fu">=</span> <span class="dt">ErrRead</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb18-2" title="2">              <span class="fu">|</span> <span class="dt">ErrWrite</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb18-3" title="3">              <span class="fu">|</span> <span class="dt">ErrLogging</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb18-4" title="4">              <span class="fu">|</span> <span class="dt">ErrRunning</span> <span class="dt">Text</span></a>
<a class="sourceLine" id="cb18-5" title="5">              <span class="kw">deriving</span> (<span class="dt">Show</span>, <span class="dt">Eq</span>)</a>
<a class="sourceLine" id="cb18-6" title="6"></a>
<a class="sourceLine" id="cb18-7" title="7"><span class="kw">data</span> <span class="dt">OperationsWrapper</span> m <span class="fu">=</span> <span class="dt">OperationsWrapper</span> {<span class="ot"> opRead ::</span> <span class="dt">ExceptT</span> <span class="dt">OpsError</span> m <span class="dt">Text</span></a>
<a class="sourceLine" id="cb18-8" title="8">                                             ,<span class="ot"> opWrite ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">ExceptT</span> <span class="dt">OpsError</span> m ()</a>
<a class="sourceLine" id="cb18-9" title="9">                                             ,<span class="ot"> opLog ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">ExceptT</span> <span class="dt">OpsError</span> m ()</a>
<a class="sourceLine" id="cb18-10" title="10">                                             ,<span class="ot"> opRun ::</span> (<span class="dt">Text</span> <span class="ot">-&gt;</span> m <span class="dt">Text</span>) <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">ExceptT</span> <span class="dt">OpsError</span> m <span class="dt">Text</span></a>
<a class="sourceLine" id="cb18-11" title="11">                                             }</a></code></pre></div>
<p>OperationsWrapper is a record with a wrapper function for each function from the Operations record. Each function will run the corresponding Operation function, catch any synchronous exception and covert it into an ExceptT transformer type. (See the section on catching all exceptions below)</p>
<p>The code for the wrapper is not terribly pretty, but I feel its a fair price to pay for separating the two concerns without resorting to any higher level magic (that I’m not comfortable with yet)</p>
<div class="sourceCode" id="cb19"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb19-1" title="1"><span class="ot">mkOpsWrapper ::</span> (<span class="dt">MonadCatch</span> m) <span class="ot">=&gt;</span> <span class="dt">I2.Operations</span> m <span class="ot">-&gt;</span> <span class="dt">OperationsWrapper</span> m</a>
<a class="sourceLine" id="cb19-2" title="2">mkOpsWrapper o <span class="fu">=</span></a>
<a class="sourceLine" id="cb19-3" title="3">  <span class="dt">OperationsWrapper</span> { opRead <span class="fu">=</span> <span class="dt">E.ExceptT</span> ((<span class="dt">Right</span> <span class="fu">&lt;$&gt;</span> I2.opRead o) <span class="ot">`catch`</span> readError)</a>
<a class="sourceLine" id="cb19-4" title="4">                    , opWrite <span class="fu">=</span> \t <span class="ot">-&gt;</span> <span class="dt">E.ExceptT</span> ((<span class="dt">Right</span> <span class="fu">&lt;$&gt;</span> I2.opWrite o t) <span class="ot">`catch`</span> writeError)</a>
<a class="sourceLine" id="cb19-5" title="5">                    , opLog <span class="fu">=</span> \t <span class="ot">-&gt;</span> <span class="dt">E.ExceptT</span> ((<span class="dt">Right</span> <span class="fu">&lt;$&gt;</span> I2.opLog o t) <span class="ot">`catch`</span> logError)</a>
<a class="sourceLine" id="cb19-6" title="6">                    , opRun <span class="fu">=</span> \fn t <span class="ot">-&gt;</span> <span class="dt">E.ExceptT</span> ((<span class="dt">Right</span> <span class="fu">&lt;$&gt;</span> fn t) <span class="ot">`catch`</span> logError)</a>
<a class="sourceLine" id="cb19-7" title="7">                    }</a>
<a class="sourceLine" id="cb19-8" title="8">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb19-9" title="9"><span class="ot">    readError ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">SomeException</span> <span class="ot">-&gt;</span> m (<span class="dt">Either</span> <span class="dt">OpsError</span> b)</a>
<a class="sourceLine" id="cb19-10" title="10">    readError e <span class="fu">=</span> </a>
<a class="sourceLine" id="cb19-11" title="11">      <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Left</span> <span class="fu">.</span> <span class="dt">ErrRead</span> <span class="fu">$</span> <span class="st">&quot;Error reading: &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> e</a>
<a class="sourceLine" id="cb19-12" title="12">    </a>
<a class="sourceLine" id="cb19-13" title="13"><span class="ot">    writeError ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">SomeException</span> <span class="ot">-&gt;</span> m (<span class="dt">Either</span> <span class="dt">OpsError</span> b)</a>
<a class="sourceLine" id="cb19-14" title="14">    writeError e <span class="fu">=</span> </a>
<a class="sourceLine" id="cb19-15" title="15">      <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Left</span> <span class="fu">.</span> <span class="dt">ErrWrite</span> <span class="fu">$</span> <span class="st">&quot;Error writing: &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> e</a>
<a class="sourceLine" id="cb19-16" title="16">    </a>
<a class="sourceLine" id="cb19-17" title="17"><span class="ot">    logError ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">SomeException</span> <span class="ot">-&gt;</span> m (<span class="dt">Either</span> <span class="dt">OpsError</span> b)</a>
<a class="sourceLine" id="cb19-18" title="18">    logError e <span class="fu">=</span> </a>
<a class="sourceLine" id="cb19-19" title="19">      <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Left</span> <span class="fu">.</span> <span class="dt">ErrLogging</span> <span class="fu">$</span> <span class="st">&quot;Error logging: &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> e</a></code></pre></div>
<p>Each function works as follows</p>
<ol type="1">
<li><p>Call the “wrapped” corresponding function and on success return the result as a Right value</p>
<div class="sourceCode" id="cb20"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb20-1" title="1"><span class="dt">Right</span> <span class="fu">&lt;$&gt;</span> I2.opRead o</a></code></pre></div></li>
<li><p>Catch any exception and return it as a Left OpsError</p>
<div class="sourceCode" id="cb21"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb21-1" title="1"><span class="fu">...</span> <span class="ot">`catch`</span> readError</a>
<a class="sourceLine" id="cb21-2" title="2"></a>
<a class="sourceLine" id="cb21-3" title="3"><span class="ot">readError ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">SomeException</span> <span class="ot">-&gt;</span> m (<span class="dt">Either</span> <span class="dt">OpsError</span> b)</a>
<a class="sourceLine" id="cb21-4" title="4">readError e <span class="fu">=</span> </a>
<a class="sourceLine" id="cb21-5" title="5">  <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Left</span> <span class="fu">.</span> <span class="dt">ErrRead</span> <span class="fu">$</span> <span class="st">&quot;Error reading: &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> e</a></code></pre></div></li>
</ol>
<h2 id="pipeline-using-the-wrapper">Pipeline using the wrapper</h2>
<div class="sourceCode" id="cb22"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb22-1" title="1"><span class="ot">runPipeline ::</span> (<span class="dt">Monad</span> m) <span class="ot">=&gt;</span> <span class="dt">OperationsWrapper</span> m <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> [<span class="dt">I2.Job</span> m] <span class="ot">-&gt;</span> m (<span class="dt">Either</span> <span class="dt">OpsError</span> <span class="dt">Text</span>)</a>
<a class="sourceLine" id="cb22-2" title="2">runPipeline ops <span class="fu">init</span> jobs <span class="fu">=</span> runExceptT <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb22-3" title="3">  opWrite ops <span class="fu">init</span></a>
<a class="sourceLine" id="cb22-4" title="4">  <span class="fu">id</span> <span class="ot">&lt;-</span> foldlM runJob <span class="dv">0</span> jobs</a>
<a class="sourceLine" id="cb22-5" title="5"></a>
<a class="sourceLine" id="cb22-6" title="6">  opLog ops <span class="fu">$</span> <span class="st">&quot;\nfinal job id = &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> <span class="fu">id</span></a>
<a class="sourceLine" id="cb22-7" title="7">  opRead ops</a>
<a class="sourceLine" id="cb22-8" title="8"></a>
<a class="sourceLine" id="cb22-9" title="9">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb22-10" title="10">    runJob (<span class="fu">id</span><span class="ot"> ::</span> <span class="dt">Int</span>) (<span class="dt">I2.Job</span> name fn) <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb22-11" title="11">      opLog ops <span class="fu">$</span> <span class="st">&quot;running job: &quot;</span> <span class="fu">&lt;&gt;</span> name</a>
<a class="sourceLine" id="cb22-12" title="12"></a>
<a class="sourceLine" id="cb22-13" title="13">      prev <span class="ot">&lt;-</span> opRead ops</a>
<a class="sourceLine" id="cb22-14" title="14">      r <span class="ot">&lt;-</span> opRun ops fn prev <span class="co">-- don't just lift, use opRun</span></a>
<a class="sourceLine" id="cb22-15" title="15">      opWrite ops r</a>
<a class="sourceLine" id="cb22-16" title="16">  </a>
<a class="sourceLine" id="cb22-17" title="17">      opLog ops <span class="fu">$</span> <span class="st">&quot;  = &quot;</span> <span class="fu">&lt;&gt;</span> r</a>
<a class="sourceLine" id="cb22-18" title="18">      opLog ops <span class="st">&quot;  ----&quot;</span></a>
<a class="sourceLine" id="cb22-19" title="19"></a>
<a class="sourceLine" id="cb22-20" title="20">      <span class="fu">pure</span> <span class="fu">$</span> <span class="fu">id</span> <span class="fu">+</span> <span class="dv">1</span></a></code></pre></div>
<p>The changes from Step2 are</p>
<ol type="1">
<li>The result type is an Either. I.e. failure is now explicit</li>
<li>Its using OperationsWrapper not Operations</li>
<li>It is using the ExceptT monad, so <strong>runExceptT</strong> is used</li>
<li>Each function from the wrapper will abort the monad if it returns a Left (i.e. if the wrapped function throws)</li>
</ol>
<p>Also notice that I added a <strong>opRun</strong> function to wrap the running of the job. If you just lifted the job’s run function, then the exception would not be handled. So we need a wrapper function for this as well.</p>
<h2 id="running-2">Running</h2>
<div class="sourceCode" id="cb23"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb23-1" title="1"><span class="kw">import</span>           <span class="dt">Protolude</span></a>
<a class="sourceLine" id="cb23-2" title="2"></a>
<a class="sourceLine" id="cb23-3" title="3"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Step2.Storage2</span> <span class="kw">as</span> <span class="dt">S2</span></a>
<a class="sourceLine" id="cb23-4" title="4"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Step2.Impl2</span> <span class="kw">as</span> <span class="dt">I2</span></a>
<a class="sourceLine" id="cb23-5" title="5"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Step3.Impl3</span> <span class="kw">as</span> <span class="dt">I3</span></a>
<a class="sourceLine" id="cb23-6" title="6"></a>
<a class="sourceLine" id="cb23-7" title="7"></a>
<a class="sourceLine" id="cb23-8" title="8"><span class="ot">main ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb23-9" title="9">main <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb23-10" title="10">  <span class="kw">let</span> jobs <span class="fu">=</span> [ <span class="dt">I2.Job</span> <span class="st">&quot;j1&quot;</span> job1</a>
<a class="sourceLine" id="cb23-11" title="11">             , <span class="dt">I2.Job</span> <span class="st">&quot;j2&quot;</span> job2</a>
<a class="sourceLine" id="cb23-12" title="12">             , <span class="dt">I2.Job</span> <span class="st">&quot;j3&quot;</span> job3</a>
<a class="sourceLine" id="cb23-13" title="13">             ]</a>
<a class="sourceLine" id="cb23-14" title="14">  </a>
<a class="sourceLine" id="cb23-15" title="15">  <span class="kw">let</span> ops <span class="fu">=</span> S2.mkFileOps</a>
<a class="sourceLine" id="cb23-16" title="16"></a>
<a class="sourceLine" id="cb23-17" title="17">  r <span class="ot">&lt;-</span> I3.runPipeline (I3.mkOpsWrapper ops) <span class="st">&quot;0&quot;</span> jobs</a>
<a class="sourceLine" id="cb23-18" title="18"></a>
<a class="sourceLine" id="cb23-19" title="19">  <span class="kw">case</span> r <span class="kw">of</span></a>
<a class="sourceLine" id="cb23-20" title="20">    <span class="dt">Right</span> x <span class="ot">-&gt;</span> putText <span class="fu">$</span> <span class="st">&quot;Success: &quot;</span> <span class="fu">&lt;&gt;</span> x</a>
<a class="sourceLine" id="cb23-21" title="21">    <span class="dt">Left</span> e <span class="ot">-&gt;</span> putText <span class="fu">$</span> <span class="st">&quot;Exception: &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> e</a></code></pre></div>
<p>When run this will catch the exception in job 2 and correctly report the error, i.e. no runtime failure</p>
<pre><code> Demo3: use file
---------
running job: j1
in job1
  = 1:0
  ----
running job: j2
in job2
Exception: ErrLogging &quot;Error logging: oops&quot;</code></pre>
<h1 id="testing">Testing</h1>
<p>For completeness here is an example of how the pipeline can be tested using only pure code. I’m using the State monad (which you may not want to use in production but for my test and this example its just fine). Skip this the section if you are not interested in the tests</p>
<div class="sourceCode" id="cb25"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb25-1" title="1"><span class="ot">{-# LANGUAGE NoImplicitPrelude #-}</span></a>
<a class="sourceLine" id="cb25-2" title="2"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span></a>
<a class="sourceLine" id="cb25-3" title="3"></a>
<a class="sourceLine" id="cb25-4" title="4"><span class="kw">module</span> <span class="dt">PipelineSpec</span> <span class="kw">where</span></a>
<a class="sourceLine" id="cb25-5" title="5"></a>
<a class="sourceLine" id="cb25-6" title="6"><span class="kw">import</span>           <span class="dt">Protolude</span> </a>
<a class="sourceLine" id="cb25-7" title="7"><span class="kw">import</span>           <span class="dt">Test.Hspec</span></a>
<a class="sourceLine" id="cb25-8" title="8"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Control.Monad.Except</span> <span class="kw">as</span> <span class="dt">E</span></a>
<a class="sourceLine" id="cb25-9" title="9"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Control.Monad.State.Strict</span> <span class="kw">as</span> <span class="dt">S</span></a>
<a class="sourceLine" id="cb25-10" title="10"></a>
<a class="sourceLine" id="cb25-11" title="11"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Step2.Impl2</span> <span class="kw">as</span> <span class="dt">I2</span></a>
<a class="sourceLine" id="cb25-12" title="12"><span class="kw">import</span> <span class="kw">qualified</span> <span class="dt">Step3.Impl3</span> <span class="kw">as</span> <span class="dt">I3</span></a>
<a class="sourceLine" id="cb25-13" title="13"></a>
<a class="sourceLine" id="cb25-14" title="14"><span class="ot">spec ::</span> <span class="dt">Spec</span></a>
<a class="sourceLine" id="cb25-15" title="15">spec <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb25-16" title="16">  describe <span class="st">&quot;simple pipeline&quot;</span> <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb25-17" title="17">    it <span class="st">&quot;should run in correct order&quot;</span> <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb25-18" title="18">      <span class="kw">let</span> jobs <span class="fu">=</span> [ <span class="dt">I2.Job</span> <span class="st">&quot;j1&quot;</span> job1</a>
<a class="sourceLine" id="cb25-19" title="19">                 , <span class="dt">I2.Job</span> <span class="st">&quot;j2&quot;</span> job2</a>
<a class="sourceLine" id="cb25-20" title="20">                 ]</a>
<a class="sourceLine" id="cb25-21" title="21">      </a>
<a class="sourceLine" id="cb25-22" title="22">      <span class="kw">let</span> (r, _) <span class="fu">=</span> S.runState (testPipeline jobs <span class="st">&quot;0&quot;</span>) <span class="st">&quot;&quot;</span></a>
<a class="sourceLine" id="cb25-23" title="23">      r <span class="ot">`shouldBe`</span> (<span class="dt">Right</span> <span class="st">&quot;2:1:0&quot;</span>)</a>
<a class="sourceLine" id="cb25-24" title="24"></a>
<a class="sourceLine" id="cb25-25" title="25"></a>
<a class="sourceLine" id="cb25-26" title="26"></a>
<a class="sourceLine" id="cb25-27" title="27"><span class="ot">testPipeline ::</span> [<span class="dt">I2.Job</span> (<span class="dt">S.State</span> <span class="dt">Text</span>)] <span class="ot">-&gt;</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> <span class="dt">S.State</span> <span class="dt">Text</span> (<span class="dt">Either</span> <span class="dt">I3.OpsError</span> <span class="dt">Text</span>)</a>
<a class="sourceLine" id="cb25-28" title="28">testPipeline jobs initial <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb25-29" title="29">  <span class="kw">let</span> ops <span class="fu">=</span> <span class="dt">I3.OperationsWrapper</span> { I3.opRead <span class="fu">=</span> <span class="dt">E.ExceptT</span> <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb25-30" title="30">                                     r <span class="ot">&lt;-</span> get</a>
<a class="sourceLine" id="cb25-31" title="31">                                     <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Right</span> <span class="fu">$</span> r</a>
<a class="sourceLine" id="cb25-32" title="32"></a>
<a class="sourceLine" id="cb25-33" title="33">                                 , I3.opWrite <span class="fu">=</span> \t <span class="ot">-&gt;</span> <span class="dt">E.ExceptT</span> <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb25-34" title="34">                                     put <span class="fu">$</span> t</a>
<a class="sourceLine" id="cb25-35" title="35">                                     <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Right</span> <span class="fu">$</span> ()</a>
<a class="sourceLine" id="cb25-36" title="36"></a>
<a class="sourceLine" id="cb25-37" title="37">                                 , I3.opRun <span class="fu">=</span> \fn t <span class="ot">-&gt;</span> <span class="dt">E.ExceptT</span> <span class="fu">$</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb25-38" title="38">                                     r <span class="ot">&lt;-</span> fn t</a>
<a class="sourceLine" id="cb25-39" title="39">                                     <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Right</span> <span class="fu">$</span> r</a>
<a class="sourceLine" id="cb25-40" title="40"></a>
<a class="sourceLine" id="cb25-41" title="41">                                 , I3.opLog <span class="fu">=</span> \t <span class="ot">-&gt;</span> <span class="dt">E.ExceptT</span> <span class="fu">.</span> <span class="fu">pure</span> <span class="fu">.</span> <span class="dt">Right</span> <span class="fu">$</span> ()</a>
<a class="sourceLine" id="cb25-42" title="42">                                 }</a>
<a class="sourceLine" id="cb25-43" title="43"></a>
<a class="sourceLine" id="cb25-44" title="44">  I3.runPipeline ops initial jobs</a>
<a class="sourceLine" id="cb25-45" title="45"></a>
<a class="sourceLine" id="cb25-46" title="46"></a>
<a class="sourceLine" id="cb25-47" title="47"><span class="ot">job1 ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> (<span class="dt">S.State</span> <span class="dt">Text</span>) <span class="dt">Text</span></a>
<a class="sourceLine" id="cb25-48" title="48">job1 v <span class="fu">=</span> <span class="fu">pure</span> <span class="fu">$</span> <span class="st">&quot;1:&quot;</span> <span class="fu">&lt;&gt;</span> v</a>
<a class="sourceLine" id="cb25-49" title="49"></a>
<a class="sourceLine" id="cb25-50" title="50"><span class="ot">job2 ::</span> <span class="dt">Text</span> <span class="ot">-&gt;</span> (<span class="dt">S.State</span> <span class="dt">Text</span>) <span class="dt">Text</span></a>
<a class="sourceLine" id="cb25-51" title="51">job2 v <span class="fu">=</span> <span class="fu">pure</span> <span class="fu">$</span> <span class="st">&quot;2:&quot;</span> <span class="fu">&lt;&gt;</span> v</a></code></pre></div>
<h1 id="notes-on-exceptions">Notes on exceptions</h1>
<h2 id="catching-all-exceptions">Catching all exceptions</h2>
<p>Catching all exceptions is generally considered to be a bad idea. See for example the <a href="https://hackage.haskell.org/package/base-4.10.0.0/docs/Control-Exception.html#g:4">docs for Control.Exception</a>.</p>
<p>For a thorough discussion of alternatives see <a href="https://www.schoolofhaskell.com/user/snoyberg/general-haskell/exceptions/catching-all-exceptions">Catching all exceptions</a> from www.schoolofhaskell.com</p>
<h2 id="safe-exceptions">Safe-exceptions</h2>
<p>In this example I am using the <a href="https://hackage.haskell.org/package/safe-exceptions-0.1.6.0/docs/Control-Exception-Safe.html">safe-exceptions package</a>. The catch function comes from Control.Exception.Safe not Control.Exception so only synchronous exceptions are caught. Take a look at the <a href="https://github.com/andrevdm/refactorAwayIO">source code</a> to see the cabal file and the explicit imports from Control.Exception.Safe</p>
<h2 id="using-async">Using async</h2>
<p>Another approach that <a href="https://twitter.com/thumphriees">@thumphriees</a> pointed out to me on twitter (and is discussed in the “Catching All Exceptions” article) is to use the async library to help with exceptions. This is the approach I’ll probably be using with the production version of this code as it for almost no extra cost gives me simple timeout and cancellation control.</p>
<p>As you can see from the code below this is a pretty simple to use</p>
<div class="sourceCode" id="cb26"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb26-1" title="1"><span class="ot">demoAsyncCatch ::</span> <span class="dt">IO</span> ()</a>
<a class="sourceLine" id="cb26-2" title="2">demoAsyncCatch <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb26-3" title="3">  r <span class="ot">&lt;-</span> async jobBad <span class="fu">&gt;&gt;=</span> waitCatch</a>
<a class="sourceLine" id="cb26-4" title="4"></a>
<a class="sourceLine" id="cb26-5" title="5">  <span class="kw">case</span> r <span class="kw">of</span></a>
<a class="sourceLine" id="cb26-6" title="6">    <span class="dt">Right</span> _ <span class="ot">-&gt;</span> putText <span class="st">&quot;demo async - Right&quot;</span></a>
<a class="sourceLine" id="cb26-7" title="7">    <span class="dt">Left</span> e <span class="ot">-&gt;</span> putText <span class="fu">$</span> <span class="st">&quot;demo async - Left: &quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> e</a>
<a class="sourceLine" id="cb26-8" title="8"></a>
<a class="sourceLine" id="cb26-9" title="9">  <span class="kw">where</span></a>
<a class="sourceLine" id="cb26-10" title="10">    jobBad <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb26-11" title="11">      putText <span class="st">&quot;in jobBad&quot;</span></a>
<a class="sourceLine" id="cb26-12" title="12">      void <span class="fu">.</span> throwIO <span class="fu">$</span> <span class="dt">DemoException</span> <span class="st">&quot;oops&quot;</span></a></code></pre></div>
<h1 id="conclusion">Conclusion</h1>
<ul>
<li>The wrapper record separates the pure and effectful worlds and converts all synchronous IO exceptions into Eithers.</li>
<li>Passing around a record of functions is a alternative to using a typeclass and I believe makes more sense in many cases.</li>
<li>It is not that hard to refactor much of the impure code from a codebase</li>
</ul>
<p>The obvious downside to this method is that you end up with boilerplate code for the wrapper. You’ll have to decide on if this is a problem for you or not. For me this is working really well so far.</p>
<h1 id="links">Links</h1>
<ul>
<li><a href="https://github.com/andrevdm/refactorAwayIO">Sample code on github</a></li>
<li><a href="https://www.fpcomplete.com/blog/2016/11/exceptions-best-practices-haskell">Exceptions best practices in haskell</a></li>
<li><a href="https://www.fpcomplete.com/blog/2017/06/readert-design-pattern">ReaderT design pattern</a></li>
<li><a href="https://github.com/lexi-lambda/mtl-style-example">mtl-style-example: A small, self-contained example of using mtl style to unit test effectful code in a pure way</a></li>
<li><a href="https://chris-martin.org/2017/interfaces-and-records">Java interfaces map to Haskell records</a></li>
<li><a href="https://hackage.haskell.org/package/base-4.10.0.0/docs/Control-Exception.html#g:4">docs for Control.Exception</a></li>
<li><a href="https://www.schoolofhaskell.com/user/snoyberg/general-haskell/exceptions/catching-all-exceptions">Catching all exceptions</a></li>
<li><a href="https://hackage.haskell.org/package/safe-exceptions-0.1.6.0/docs/Control-Exception-Safe.html">safe-exceptions package</a></li>
</ul>
<p><img src="../images/pumpkin.png" /></p>


        </div>
        <div id="footer">
            Site proudly generated by
            <a href="http://jaspervdj.be/hakyll">Hakyll</a>
        </div>
        </div>

        <script>
          (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
          (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
          m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
          })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

          ga('create', 'UA-78428674-1', 'auto');
          ga('send', 'pageview');
        </script>
    </body>
</html>
]]></summary>
</entry>
<entry>
    <title>Raspbery Pi GPIO using PureScript</title>
    <link href="http://www.andrevdm.com/posts/2016-10-05-purescript-raspberrypi-gpio.html" />
    <id>http://www.andrevdm.com/posts/2016-10-05-purescript-raspberrypi-gpio.html</id>
    <published>2016-10-05T00:00:00Z</published>
    <updated>2016-10-05T00:00:00Z</updated>
    <summary type="html"><![CDATA[<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
        <title>Andre's Blog</title>
        <link rel="stylesheet" type="text/css" href="../css/default.css" />
        <link rel="stylesheet" type="text/css" href="../css/syntax.css" />
    </head>
    <body>
      <div id="bodyInner">
        <div id="header">
            <div id="logo">
                <a href="../">Blog</a>
            </div>
            <div id="navigation">
                <a href="../">Home</a>
                <a href="../contact.html">Contact</a>
                <!-- <a href="/about.html">About</a> -->
            </div>
        </div>

        <div id="content">
            <h1><a href="#top">Raspbery Pi GPIO using PureScript</a></h1>

            <div class="info">
    Posted on October  5, 2016

</div>

<h1 id="overview">Overview</h1>
<p>This is a quick overview of how you can use PureScript on a RaspberryPi to do GPIO</p>
<h2 id="installing-node-js">Installing Node JS</h2>
<p>The version of NodeJs available in most of the distros is quite old. There are a few ways to get a new version. Personally I found that installing the same version of node that I have on my desktop on the pi worked best. To do this get the version you need from <a href="https://nodejs.org/dist/" class="uri">https://nodejs.org/dist/</a>.</p>
<p>Then run the commands with the appropriate version numbers</p>
<div class="sourceCode" id="cb1"><pre class="sourceCode bash"><code class="sourceCode bash"><a class="sourceLine" id="cb1-1" title="1"><span class="fu">tar</span> -xvf node-v4nnn</a>
<a class="sourceLine" id="cb1-2" title="2"><span class="bu">cd</span> node-v4nnn</a>
<a class="sourceLine" id="cb1-3" title="3"><span class="fu">sudo</span> cp -R . /usr/local</a></code></pre></div>
<p>if you prefer to get the latest, and a more automated install, then you can follow the instructions here <a href="http://thisdavej.com/beginners-guide-to-installing-node-js-on-a-raspberry-pi/">Beginner’s Guide to Installing Node.js on a Raspberry Pi</a></p>
<h2 id="purescript-on-the-pi">PureScript on the Pi</h2>
<p>PureScript itself does not seem to install on the pi, so you’ll need to compile on a desktop machine and copy the resulting JavaScript files across</p>
<h2 id="raspberry-pi-gpio">Raspberry Pi GPIO</h2>
<p>GPIO can quite easily be done using unix files. This is not particularly fast but it should be more that sufficient for many use cases. It is also simple enough that it can even be done directly from the shell. If you need faster access FFI to one of the broadcom libraries is probably the way to go.</p>
<p>The GPIO ports are exposed here</p>
<div class="sourceCode" id="cb2"><pre class="sourceCode bash"><code class="sourceCode bash"><a class="sourceLine" id="cb2-1" title="1"><span class="ex">/sys/class/gpio/gpio</span></a></code></pre></div>
<p>To use a GPIO pin for basic IO you need to do the following</p>
<ol type="1">
<li>Ensure that the port is “open”. Write the port number to <code>/sys/class/gpio/export</code></li>
<li>Set the direction by writing “in” or “out” to <code>/sys/class/gpio/gpioNN/direction</code> (where NN is the pin number)</li>
<li>Set the pin value by writing “on” or “off” to <code>/sys/class/gpio/gpioNN/value</code></li>
<li>Read the pin value by reading from <code>/sys/class/gpio/gpioNN/value</code></li>
</ol>
<h2 id="raspberry-pi-pin-numbers">Raspberry Pi Pin numbers</h2>
<p>The Raspberry Pi pin numbers are a little confusing. There are different models of the pi (A, B, B+, rev 2 etc). There are also different numbering schemes i.e. pin numbers, gpio numbers, wiring pi numbers…</p>
<p>When you are looking at existing code or examples make sure you know which scheme is being used.</p>
<p><a href="http://raspi.tv/wp-content/uploads/2014/07/Raspberry-Pi-GPIO-pinouts.png">Here is a good reference</a> showing pin number and GPIO numbers</p>
<h1 id="purescript">PureScript</h1>
<h2 id="gpio-types">GPIO types</h2>
<div class="sourceCode" id="cb3"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb3-1" title="1"><span class="kw">module</span> <span class="dt">Gpio</span> <span class="kw">where</span></a>
<a class="sourceLine" id="cb3-2" title="2"></a>
<a class="sourceLine" id="cb3-3" title="3"><span class="kw">data</span> <span class="dt">Direction</span> <span class="fu">=</span> <span class="dt">In</span> <span class="fu">|</span> <span class="dt">Out</span></a>
<a class="sourceLine" id="cb3-4" title="4"><span class="kw">newtype</span> <span class="dt">Pin</span> <span class="fu">=</span> <span class="dt">Pin</span> <span class="dt">Int</span></a></code></pre></div>
<h2 id="dealing-with-the-various-pin-numbering-schemes">Dealing with the various pin numbering schemes</h2>
<p>As shown above the physical pin numbers are used when working with GPIO, so all the functions here work with a pin number (Pin newtype). Then there is a module per board that can be used to map from a logical GPIO number to a pin. In this example I’ve only defined the layout for the Rev 2 A &amp; B P1 boards.</p>
<div class="sourceCode" id="cb4"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb4-1" title="1"><span class="kw">import</span> <span class="dt">Gpio</span> (<span class="dt">Pin</span> (..))</a>
<a class="sourceLine" id="cb4-2" title="2"></a>
<a class="sourceLine" id="cb4-3" title="3"><span class="kw">data</span> <span class="dt">GpioPin</span> <span class="fu">=</span> <span class="dt">GpioPin2</span></a>
<a class="sourceLine" id="cb4-4" title="4">             <span class="fu">|</span> <span class="dt">GpioPin3</span></a>
<a class="sourceLine" id="cb4-5" title="5">             <span class="fu">|</span> <span class="dt">GpioPin4</span></a>
<a class="sourceLine" id="cb4-6" title="6">             <span class="fu">|</span> <span class="dt">GpioPin17</span></a>
<a class="sourceLine" id="cb4-7" title="7">             <span class="fu">|</span> <span class="dt">GpioPin27</span></a>
<a class="sourceLine" id="cb4-8" title="8">             <span class="fu">|</span> <span class="dt">GpioPin22</span></a>
<a class="sourceLine" id="cb4-9" title="9">             <span class="fu">|</span> <span class="dt">GpioPin10</span></a>
<a class="sourceLine" id="cb4-10" title="10">             <span class="fu">|</span> <span class="dt">GpioPin9</span></a>
<a class="sourceLine" id="cb4-11" title="11">             <span class="fu">|</span> <span class="dt">GpioPin11</span></a>
<a class="sourceLine" id="cb4-12" title="12">             <span class="fu">|</span> <span class="dt">GpioPin14</span></a>
<a class="sourceLine" id="cb4-13" title="13">             <span class="fu">|</span> <span class="dt">GpioPin15</span></a>
<a class="sourceLine" id="cb4-14" title="14">             <span class="fu">|</span> <span class="dt">GpioPin18</span></a>
<a class="sourceLine" id="cb4-15" title="15">             <span class="fu">|</span> <span class="dt">GpioPin23</span></a>
<a class="sourceLine" id="cb4-16" title="16">             <span class="fu">|</span> <span class="dt">GpioPin24</span></a>
<a class="sourceLine" id="cb4-17" title="17">             <span class="fu">|</span> <span class="dt">GpioPin25</span></a>
<a class="sourceLine" id="cb4-18" title="18">             <span class="fu">|</span> <span class="dt">GpioPin8</span></a>
<a class="sourceLine" id="cb4-19" title="19">             <span class="fu">|</span> <span class="dt">GpioPin7</span></a>
<a class="sourceLine" id="cb4-20" title="20"></a>
<a class="sourceLine" id="cb4-21" title="21"><span class="ot">toPin ::</span> <span class="dt">GpioPin</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span></a>
<a class="sourceLine" id="cb4-22" title="22">toPin g <span class="fu">=</span></a>
<a class="sourceLine" id="cb4-23" title="23">  <span class="kw">case</span> g <span class="kw">of</span></a>
<a class="sourceLine" id="cb4-24" title="24">    <span class="dt">GpioPin2</span>  <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">3</span></a>
<a class="sourceLine" id="cb4-25" title="25">    <span class="dt">GpioPin3</span>  <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">4</span></a>
<a class="sourceLine" id="cb4-26" title="26">    <span class="dt">GpioPin4</span>  <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">7</span></a>
<a class="sourceLine" id="cb4-27" title="27">    <span class="dt">GpioPin17</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">11</span></a>
<a class="sourceLine" id="cb4-28" title="28">    <span class="dt">GpioPin27</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">13</span></a>
<a class="sourceLine" id="cb4-29" title="29">    <span class="dt">GpioPin22</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">15</span></a>
<a class="sourceLine" id="cb4-30" title="30">    <span class="dt">GpioPin10</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">19</span></a>
<a class="sourceLine" id="cb4-31" title="31">    <span class="dt">GpioPin9</span>  <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">21</span></a>
<a class="sourceLine" id="cb4-32" title="32">    <span class="dt">GpioPin11</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">23</span></a>
<a class="sourceLine" id="cb4-33" title="33">    <span class="dt">GpioPin14</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">8</span></a>
<a class="sourceLine" id="cb4-34" title="34">    <span class="dt">GpioPin15</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">10</span></a>
<a class="sourceLine" id="cb4-35" title="35">    <span class="dt">GpioPin18</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">12</span></a>
<a class="sourceLine" id="cb4-36" title="36">    <span class="dt">GpioPin23</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">16</span></a>
<a class="sourceLine" id="cb4-37" title="37">    <span class="dt">GpioPin24</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">18</span></a>
<a class="sourceLine" id="cb4-38" title="38">    <span class="dt">GpioPin25</span> <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">22</span></a>
<a class="sourceLine" id="cb4-39" title="39">    <span class="dt">GpioPin8</span>  <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">24</span></a>
<a class="sourceLine" id="cb4-40" title="40">    <span class="dt">GpioPin7</span>  <span class="ot">-&gt;</span> <span class="dt">Pin</span> <span class="dv">26</span></a></code></pre></div>
<h2 id="gpio">GPIO</h2>
<p>To “open” a port you write the port number to the export file. This function first checks if the port is open</p>
<div class="sourceCode" id="cb5"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb5-1" title="1"><span class="ot">open ::</span> <span class="dt">Pin</span> <span class="ot">-&gt;</span> <span class="kw">forall</span> e<span class="fu">.</span> <span class="dt">Eff</span> (<span class="ot">fs ::</span> <span class="dt">FS</span>,<span class="ot"> err ::</span> <span class="dt">EXCEPTION</span> <span class="fu">|</span> e) <span class="dt">Unit</span></a>
<a class="sourceLine" id="cb5-2" title="2">open (<span class="dt">Pin</span> pin) <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb5-3" title="3">  e <span class="ot">&lt;-</span> S.exists <span class="fu">$</span> <span class="st">&quot;/sys/class/gpio/gpio&quot;</span> <span class="fu">&lt;&gt;</span> <span class="fu">show</span> pin</a>
<a class="sourceLine" id="cb5-4" title="4">  <span class="kw">if</span> <span class="fu">not</span> e </a>
<a class="sourceLine" id="cb5-5" title="5">    <span class="kw">then</span> </a>
<a class="sourceLine" id="cb5-6" title="6">      S.writeTextFile <span class="dt">E.ASCII</span> <span class="st">&quot;/sys/class/gpio/export&quot;</span> (<span class="fu">show</span> pin)</a>
<a class="sourceLine" id="cb5-7" title="7">    <span class="kw">else</span></a>
<a class="sourceLine" id="cb5-8" title="8">      <span class="fu">pure</span> unit</a></code></pre></div>
<p>Set a port to be <em>in</em> or <em>out</em>. Remember that you can read a value from a port that is set to be output, you read if the port was set to on or off. Reading from a port set to <em>in</em> means that you are reading the value from the pin, i.e. is the pin being held high or low by an external input.</p>
<div class="sourceCode" id="cb6"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb6-1" title="1"><span class="ot">setDirection ::</span> <span class="dt">Pin</span> <span class="ot">-&gt;</span> <span class="dt">Direction</span> <span class="ot">-&gt;</span> <span class="kw">forall</span> e<span class="fu">.</span> <span class="dt">Eff</span> (<span class="ot">fs ::</span> <span class="dt">FS</span>,<span class="ot"> err ::</span> <span class="dt">EXCEPTION</span> <span class="fu">|</span> e) <span class="dt">Unit</span></a>
<a class="sourceLine" id="cb6-2" title="2">setDirection (<span class="dt">Pin</span> pin) dir <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb6-3" title="3">  <span class="kw">let</span> dirStr <span class="fu">=</span> <span class="kw">case</span> dir <span class="kw">of</span></a>
<a class="sourceLine" id="cb6-4" title="4">                  <span class="dt">In</span> <span class="ot">-&gt;</span> <span class="st">&quot;in&quot;</span></a>
<a class="sourceLine" id="cb6-5" title="5">                  <span class="dt">Out</span> <span class="ot">-&gt;</span> <span class="st">&quot;out&quot;</span> </a>
<a class="sourceLine" id="cb6-6" title="6">  S.writeTextFile <span class="dt">E.ASCII</span> <span class="st">&quot;/sys/class/gpio/gpio18/direction&quot;</span> dirStr</a></code></pre></div>
<p>Set an <em>output</em> pin to high or low</p>
<div class="sourceCode" id="cb7"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb7-1" title="1"><span class="ot">setValue ::</span> <span class="dt">Pin</span> <span class="ot">-&gt;</span> <span class="dt">Boolean</span> <span class="ot">-&gt;</span> <span class="kw">forall</span> e<span class="fu">.</span> <span class="dt">Eff</span> (<span class="ot">fs ::</span> <span class="dt">FS</span>,<span class="ot"> err ::</span> <span class="dt">EXCEPTION</span> <span class="fu">|</span> e) <span class="dt">Unit</span></a>
<a class="sourceLine" id="cb7-2" title="2">setValue (<span class="dt">Pin</span> pin) on <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb7-3" title="3">  <span class="kw">let</span> val <span class="fu">=</span> <span class="kw">if</span> on <span class="kw">then</span> <span class="st">&quot;1&quot;</span> <span class="kw">else</span> <span class="st">&quot;0&quot;</span></a>
<a class="sourceLine" id="cb7-4" title="4">  S.writeTextFile <span class="dt">E.ASCII</span> (<span class="st">&quot;/sys/class/gpio/gpio&quot;</span> <span class="fu">&lt;&gt;</span> (<span class="fu">show</span> pin) <span class="fu">&lt;&gt;</span> <span class="st">&quot;/value&quot;</span>) val</a></code></pre></div>
<p>Read the current value from the pin</p>
<div class="sourceCode" id="cb8"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb8-1" title="1"><span class="ot">getValue ::</span> <span class="dt">Pin</span> <span class="ot">-&gt;</span> <span class="kw">forall</span> e<span class="fu">.</span> <span class="dt">Eff</span> (<span class="ot">fs ::</span> <span class="dt">FS</span>,<span class="ot"> err ::</span> <span class="dt">EXCEPTION</span> <span class="fu">|</span> e) <span class="dt">Boolean</span></a>
<a class="sourceLine" id="cb8-2" title="2">getValue (<span class="dt">Pin</span> pin) <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb8-3" title="3">  val <span class="ot">&lt;-</span> (Str.trim <span class="fu">&lt;$&gt;</span> S.readTextFile <span class="dt">E.ASCII</span> <span class="st">&quot;/sys/class/gpio/gpio18/value&quot;</span>)</a>
<a class="sourceLine" id="cb8-4" title="4">  <span class="fu">pure</span> <span class="fu">$</span> val <span class="fu">/=</span> <span class="st">&quot;0&quot;</span></a></code></pre></div>
<h2 id="e.g.-toggle-gpio-24">E.g. Toggle GPIO 24</h2>
<div class="sourceCode" id="cb9"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb9-1" title="1"><span class="ot">main ::</span> <span class="kw">forall</span> e<span class="fu">.</span> <span class="dt">Eff</span> (<span class="ot">console ::</span> <span class="dt">CONSOLE</span>,<span class="ot"> fs ::</span> <span class="dt">FS</span>,<span class="ot"> err ::</span> <span class="dt">EXCEPTION</span> <span class="fu">|</span> e) <span class="dt">Unit</span></a>
<a class="sourceLine" id="cb9-2" title="2">main <span class="fu">=</span> <span class="kw">do</span></a>
<a class="sourceLine" id="cb9-3" title="3">  <span class="kw">let</span> pin <span class="fu">=</span> R.toPin <span class="dt">R.GpioPin24</span></a>
<a class="sourceLine" id="cb9-4" title="4">  </a>
<a class="sourceLine" id="cb9-5" title="5">  R.open pin </a>
<a class="sourceLine" id="cb9-6" title="6"></a>
<a class="sourceLine" id="cb9-7" title="7">  v <span class="ot">&lt;-</span> R.getValue pin</a>
<a class="sourceLine" id="cb9-8" title="8"></a>
<a class="sourceLine" id="cb9-9" title="9">  R.setDirection pin <span class="dt">R.Out</span></a>
<a class="sourceLine" id="cb9-10" title="10">  R.setValue pin <span class="fu">$</span> <span class="fu">not</span> v</a></code></pre></div>
<h1 id="building-and-running">Building and running</h1>
<h2 id="build-the-purescript">Build the purescript</h2>
<div class="sourceCode" id="cb10"><pre class="sourceCode bash"><code class="sourceCode bash"><a class="sourceLine" id="cb10-1" title="1"><span class="ex">pulp</span> build --optimise --to ripiTest.js</a></code></pre></div>
<p>You then need to copy everything from the output folder to a folder on the pi</p>
<div class="sourceCode" id="cb11"><pre class="sourceCode bash"><code class="sourceCode bash"><a class="sourceLine" id="cb11-1" title="1"><span class="fu">scp</span> -r ./output pi@192.168.0.99:/home/pi/ripiTest/output</a></code></pre></div>
<p>Finally copy your compiled bundle across</p>
<div class="sourceCode" id="cb12"><pre class="sourceCode bash"><code class="sourceCode bash"><a class="sourceLine" id="cb12-1" title="1"><span class="fu">scp</span> -r ./ripiTest.js pi@192.168.0.99:/home/pi/ripiTest/</a></code></pre></div>
<p>Note that you only need to copy the <em>output</em> folder again when you add more imports. Otherwise just copy your bundle to save time.</p>
<h2 id="running">Running</h2>
<div class="sourceCode" id="cb13"><pre class="sourceCode bash"><code class="sourceCode bash"><a class="sourceLine" id="cb13-1" title="1"><span class="bu">cd</span> /home/pi/ripiTest</a>
<a class="sourceLine" id="cb13-2" title="2"><span class="fu">sudo</span> node ripiTest.js</a></code></pre></div>
<h1 id="links">Links</h1>
<ol type="1">
<li><a href="https://github.com/andrevdm/raspberryPiGpio">Source code</a></li>
</ol>


        </div>
        <div id="footer">
            Site proudly generated by
            <a href="http://jaspervdj.be/hakyll">Hakyll</a>
        </div>
        </div>

        <script>
          (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
          (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
          m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
          })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

          ga('create', 'UA-78428674-1', 'auto');
          ga('send', 'pageview');
        </script>
    </body>
</html>
]]></summary>
</entry>

</feed>
