<p>There's certain amount of boilerplate code in my game that keeps repeating time after time. I can't quite remove it, but I can hide it with template haskell.</p>
<h2 id="newtype-recap">newtype recap</h2>
<p>I'll be using <code>PlanetName</code> as an example throughout the show. <code>newtype</code> is Haskell's way of defining a new type, that wraps around an old type. This lets us to give better meaning to the wrapped type. Instead of talking about <code>Text</code>, we can talk about <code>PlanetName</code> and we won't accidentally mix it up with <code>StarName</code> or <code>ContentsOfAlexandrianLibrary</code>. It comes with no performance cost at all, as the wrapping is removed during the compilation.</p>
<p>Below is how our <code>PlanetName</code> is defined:</p>
<pre><code>newtype PlanetName
   = MkPlanetName {_unPlanetName :: Text}
   deriving (Show, Read, Eq)
</code></pre>
<p>It has:</p>
<ul>
<li>type constructor <code>PlanetName</code></li>
<li>data constructor <code>MkPlanetName</code></li>
<li>single field <code>_unPlanetName</code></li>
<li>type for that field <code>Text</code></li>
<li>deriving clause, telling compiler to automatically generate <code>Show</code>, <code>Read</code> and <code>Eq</code> instances</li>
</ul>
<p>If it were wrapping a <code>Integer</code>, we would add <code>Ord</code> and <code>Num</code> instances too.</p>
<p>These instances give us some basic functions that we can use to turn out value into <code>String</code> and back or compare two values to see if they're equal or not. <code>Ord</code> lets us compare their relative size and <code>Num</code> adds some basic arithmetics like addition and subtraction.</p>
<p>Remember, type constructor is used when talking about the type (function signatures, declaring type of a value, etc.), while data constructor is used to create values of the type ("Earth", "Mars", etc.). <code>isPlanet :: PlanetName -&gt; Bool</code> states that <code>isPlanet</code> function takes one parameter of type <code>PlanetName</code> and returns value of type <code>Bool</code>. <code>planet = MkPlanetName "Earth"</code> creates a new value <code>planet</code>, that has type <code>PlanetName</code> and which value is <code>MkPlanetName "Earth"</code>.</p>
<h2 id="boilerplate">Boilerplate</h2>
<p>When <code>PlanetName</code> is defined, I need to add some instances by hand: <code>IsString</code>, <code>ToJSON</code>, <code>FromJSON</code>, <code>PersistField</code> and <code>PersistFieldSql</code>.</p>
<p><code>IsString</code> lets me use string literals in code, without having to call the data constructor. Compiler is smart enough to infer from context if string I typed should be <code>PlanetName</code> or something else.</p>
<p><code>ToJSON</code> and <code>FromJSON</code> are used to turn value to and from json for transferring back and forth between client and server. In json our value is just simple string, but we still need to program that transformation.</p>
<p><code>PersistFieldSql</code> tells Persistent (database layer I'm using) what type of database field should be created to hold this data in database.</p>
<p><code>PersistField</code> contains functions for serializing our value to database and loading it from there.</p>
<p>Below is full code that I want to abstract out as much as I can:</p>
<pre><code>newtype PlanetName
   = MkPlanetName {_unPlanetName :: Text}
   deriving (Show, Read, Eq)

instance IsString PlanetName where
   fromString = (MkPlanetName . fromString)

instance ToJSON PlanetName where
   toJSON = (toJSON . _unPlanetName)

instance FromJSON PlanetName where
   parseJSON = (withText &quot;PlanetName&quot;) (return . MkPlanetName)

instance PersistField PlanetName where
   toPersistValue (MkPlanetName s) = PersistText s
   fromPersistValue (PersistText s) = (Right $ MkPlanetName s)
   fromPersistValue _ = Left &quot;Failed to deserialize&quot;

instance PersistFieldSql PlanetName where
   sqlType _ = SqlString
</code></pre>
<h2 id="template-haskell">Template Haskell</h2>
<p>Template Haskell is an extension that adds metaprogramming capabilities to Haskell. One can write function that generates Haskell code and call it in appropriate place in source file. During compilation the function gets executed and resulting code injected in source file. After this source file is compiled normally. If you have used lisp macros, this is the similar thing.</p>
<h2 id="generating-the-code">Generating the code</h2>
<p>We want a function that can be called like <code>$(makeDomainType "PlanetName" ''Text)</code> and it will create all the boiler plate for us.</p>
<p>The function is show below:</p>
<pre><code>makeDomainType :: String -&gt; Name -&gt; Q [Dec]
makeDomainType name fType = do
    tq &lt;- reify fType
    case tq of
        TyConI (DataD _ tName _ _ _ _) -&gt;
            selectDomainType name tName
        _ -&gt; do
            Language.Haskell.TH.reportError &quot;Only simple types are supported&quot;
            return []
</code></pre>
<p><code>reify</code> is interesting function. When called during compile time and given a name, it'll figure what the name refers to and construct datastructure that contains relevant information about the thing. If you were to give it name of a function, you would have access to code inside of the function and could introspect it.</p>
<p>Here we're using <code>tq &lt;- reify fType</code> to find out what kind of type our code should wrap. Code uses pattern matching to match <code>TyConI (DataD _ tName _ _ _ _)</code>. This is referring to a type constructor. In all other cases (more complex types, functions and so on), code reports and error.</p>
<p>Since code should support different types of types and the respective generated code differs, next there's check to find out what kind of code to generate:</p>
<pre><code>selectDomainType :: String -&gt; Name -&gt; Q [Dec]
selectDomainType name fType
    | fType == &#39;&#39;Text = makeTextDomainType name
    | fType == &#39;&#39;Int  = makeIntDomainType name
    | otherwise = do
                    Language.Haskell.TH.reportError &quot;Unsupported type&quot;
                    return []
</code></pre>
<p>This uses guard clause to check if <code>fType</code> is <code>Text</code> or <code>Int</code> and call respective function to generate it. Again, if there's no match, code reports an error.</p>
<p>I could have written a function that generates all the code, but that would have been pretty long and hard to maintain. Instead of that, I opted to split generation in parts. <code>makeTextDomainType</code> calls these functions, one at a time and combines the results together to form the final code to be generated.</p>
<pre><code>makeTextDomainType :: String -&gt; Q [Dec]
makeTextDomainType name = do
    td &lt;- makeNewTypeDefinition name &#39;&#39;Text
    si &lt;- makeIsStringInstance name
    tj &lt;- makeToJSONInstance name
    fj &lt;- makeFromJSONInstanceForText name
    mp &lt;- makePersistFieldInstanceForText name
    mps &lt;- makePersistFieldSqlInstance name &#39;&#39;Text
    return $ td ++ si ++ tj ++ fj ++ mp ++ mps
</code></pre>
<p>Some of the functions called are specific for <code>Text</code> type, while others are written to work with <code>Text</code> and <code>Int</code>. The latter ones have extra parameter passed in to indicate which type of code should be generated.</p>
<h2 id="actual-code-generation">Actual code generation</h2>
<p>Now we're getting into actual code generation. First one is <code>makeNewTypeDefinition</code>, which generates code for <code>newtype</code>.</p>
<pre><code>makeNewTypeDefinition :: String -&gt; Name -&gt; Q [Dec]
makeNewTypeDefinition name fType = do
    deriv &lt;- derivClausForNewType fType
    return $
        [NewtypeD []
                 (mkName name)
                 []
                 Nothing
                 (RecC (mkName $ &quot;Mk&quot; ++ name)
                       [(mkName $ &quot;_un&quot; ++ name, Bang NoSourceUnpackedness NoSourceStrictness, (ConT fType))])
                 [ DerivClause Nothing deriv]]
</code></pre>
<p>First step is to call <code>derivClausForNewType</code> to create deriving clause (we'll look into that just in a bit). The major part of the code consist of generating newtype definition. There's two ways for code generation: quoting (which works very similar to lisp macros) and writing abstract syntax tree by hand. No matter what I tried, I couldn't get the quoting work for newtype, so I had to write the AST out by hand. And as you can see, it's not particularly pleasant experience. Constructor names are short and cryptic and there's plenty of them there. Some major parts:</p>
<ul>
<li><code>NewtypeD</code> starts definition for newtype</li>
<li><code>(mkName name)</code> creates <code>Name</code> for the newtype, <code>PlanetName</code> in our example</li>
<li><code>RecC</code> record constuctor. We have a single record in our newtype, remember?</li>
<li><code>DerivClause</code> deriving clause, which istructs compiler to autogenerate some useful instances for us</li>
</ul>
<p>And <code>RecC</code> takes a bunch of parameters to guide what kind of record we're actually creating:</p>
<ul>
<li><code>(mkName $ "Mk" ++ name)</code> creates <code>Name</code> for our record constructor, <code>MkPlanetName</code> in our case</li>
<li>then there's a list of tuples defining fields of constructor, which has only one element in our case</li>
<li>first is name of the field <code>mkName $ "_un" ++ name</code>, which is <code>_unPlanetName</code> in our case</li>
<li><code>Bang</code> controls source packedness (that I don't know what it really is) and strictness (when value should be computed)</li>
<li>finally, <code>ConT fType</code> creates type constructor call, indicating type of the field: <code>Text</code> in our case</li>
</ul>
<p>That's quite lot to write and keep track of. It's especially tedious to come back to code and figure out what it is exactly doing.</p>
<p>Lets not forget our deriving clause:</p>
<pre><code>derivClausForNewType :: Name -&gt; Q [Type]
derivClausForNewType fType
    | fType == &#39;&#39;Text = return $ (ConT . mkName) &lt;$&gt; [ &quot;Show&quot;, &quot;Read&quot;, &quot;Eq&quot; ]
    | fType == &#39;&#39;Int = return $ (ConT . mkName) &lt;$&gt; [ &quot;Show&quot;, &quot;Read&quot;, &quot;Eq&quot;, &quot;Ord&quot;, &quot;Num&quot; ]
    | otherwise = do Language.Haskell.TH.reportError &quot;Unsupported type&quot;
                     return []
</code></pre>
<p>Again we're using guard to check if we're working with <code>Text</code> or <code>Int</code> and in any other case signal an error. <code>&lt;$&gt;</code> is used to call <code>(ConT . mkName)</code> function to elements in list of strings, getting back a list of type constructors.</p>
<p>Next step, we create <code>IsString</code> instance for turning string literals into our domain type.</p>
<pre><code>makeIsStringInstance :: String -&gt; Q [Dec]
makeIsStringInstance name = do
    [d|instance IsString $(conT $ mkName name) where
            fromString = $(conE $ mkName $ &quot;Mk&quot; ++ name) . fromString|]
</code></pre>
<p>Here I could get quoting to work. In the example, everything inside of <code>[d| ... |]</code> is quoted literally, ie. I don't have to bother with AST, but can just write in plain Haskell what I want the result to be. <code>$</code> that is immediately followed with another symbol is used to unquote. <code>$(conT $ mkName name)</code> executes <code>conT $ mkName name</code> and splices result inside the quote. Because <code>name</code> is a <code>String</code>, we can create a new <code>String</code> by appending <code>"Mk"</code> at the start of it. This creates our data constructor <code>MkPlanetName</code>. Notice how we use <code>conT</code> when creating a type constructor and <code>conE</code> for applying data constructor.</p>
<p>For transforming our domain type to and from json we need <code>ToJSON</code> and <code>FromJSON</code> instances. Generating them is very similar than generating <code>IsString</code> instance, but I have included them below for sake of completeness.</p>
<pre><code>makeToJSONInstance :: String -&gt; Q [Dec]
makeToJSONInstance name = do
    [d|instance ToJSON $(conT $ mkName name) where
            toJSON = toJSON . $(varE $ mkName $ &quot;_un&quot; ++ name)|]

makeFromJSONInstanceForText :: String -&gt; Q [Dec]
makeFromJSONInstanceForText name = do
    [d|instance FromJSON $(conT $ mkName name) where
            parseJSON =
                withText name
                    (return . $(conE $ mkName $ &quot;Mk&quot; ++ name))|]
</code></pre>
<p>Next we'll take serializing to and from database. Since Persistent takes care of the details, it's enough that we have two instances that interface with Persistent. First one of them is <code>PersistField</code> as show below:</p>
<pre><code>makePersistFieldInstanceForText :: String -&gt; Q [Dec]
makePersistFieldInstanceForText name = do
    let constName = mkName $ &quot;Mk&quot; ++ name
        constPatt = conP constName [varP $ mkName &quot;s&quot;]
        pTextPatt = conP (mkName &quot;PersistText&quot;) [varP $ mkName &quot;s&quot;]
    [d|instance PersistField $(conT $ mkName name) where
            toPersistValue $constPatt =
                PersistText s

            fromPersistValue $pTextPatt =
                Right $ $(conE constName) s

            fromPersistValue _ =
                Left &quot;Failed to deserialize&quot;|]
</code></pre>
<p>This has more code into it as the type class requires us to implement three functions. Imagine how tedious this would be to write out as plain AST. But thanks to quoting, we can write most of the code as it were regular Haskell and just splice in the parts that vary.</p>
<p>First notable part in it is <code>constPatt = conP constName [varP $ mkName "s"]</code>, which creates a pattern used in pattern matching. When <code>toPersistValue</code> is called with <code>MkPlanetName s</code> as parameter, our pattern matches and we have access to <code>s</code>. When then call data constructor <code>PersistText s</code> and let Persistent to save this newly created value into database.</p>
<p>Second pattern in the code is <code>conP (mkName "PersistText") [varP $ mkName "s"]</code> and we use it in <code>fromPersistValue</code> function. So when that function is called with <code>PersistText s</code>, our pattern matches and we have access to <code>s</code>. Which we then use to call <code>MkPlanetName s</code> to construct our domain type. If <code>fromPersistValue</code> would be called with something else, say numeric value from database, <code>fromPersistValue _</code> pattern matches and we'll report an error. This normally shouldn't happen, but it's good practice to always cover all patterns, otherwise we get a nasty runtime exception and whole program grinds to halt.</p>
<p>Last piece in our long puzzle is <code>PersistFieldSql</code>, which tells Persistent the type of the backing field in database.</p>
<pre><code>makePersistFieldSqlInstance :: String -&gt; Name -&gt; Q [Dec]
makePersistFieldSqlInstance name fType = do
    let typeName = mkName name
    let backingType = selectBackingSqlType fType
    [d|instance PersistFieldSql $(conT typeName) where
            sqlType _ = $backingType|]

selectBackingSqlType :: Name -&gt; ExpQ
selectBackingSqlType fType
    | fType == &#39;&#39;Text = conE $ mkName &quot;SqlString&quot;
    | fType == &#39;&#39;Int  = conE $ mkName &quot;SqlInt64&quot;
    | otherwise = do Language.Haskell.TH.reportError &quot;Unsupported type&quot;
                     return $ ConE $ mkName &quot;SqlString&quot;
</code></pre>
<p>This is probably starting to look familiar to you by now. We create instance of <code>PersistFieldSql</code> for our domain type. For <code>Text</code> we want to save data as <code>SqlString</code> and for <code>Int</code> we use <code>SqlInt64</code>. The actual, concrete and definite, column type is actually selected by Persistent based on this information. Persistent supports different kinds of databases, so it'll take care of mapping this information for the actual database product we're using.</p>
<h2 id="in-closing">In closing</h2>
<p>Using template Haskell can cut down amount of boiler plate code. It also lets you create new abstractions that might not be possible with the tools offered by regular Haskell. All this is nice until things don't work as planned and you have to figure out why. Debugging complicated template Haskell, especially if written by somebody else, can be tedious.</p>
<p>As usual, if you have any questions, comments or feedback, feel free to reach out for me via email or in fediverse where I'm <code>Tuula@tech.lgbt</code>. Or even better, record your own episode telling us where you use template Haskell or why did you choose not to use it at all.</p>
<p>ad astra!</p>
