├── src ├── Exercise01.lhs ├── Exercise02.lhs ├── Exercise03.lhs ├── Exercise04.lhs ├── Exercise04.md ├── Exercise03.md ├── Exercise01.md └── Exercise02.md ├── .gitignore ├── stack.yaml ├── package.yaml ├── solved ├── package.yaml └── src │ └── Solved │ ├── Exercise03.hs │ ├── Exercise04.hs │ └── Exercise02.hs ├── README.md └── doc └── proposal.md /src/Exercise01.lhs: -------------------------------------------------------------------------------- 1 | Exercise01.md -------------------------------------------------------------------------------- /src/Exercise02.lhs: -------------------------------------------------------------------------------- 1 | Exercise02.md -------------------------------------------------------------------------------- /src/Exercise03.lhs: -------------------------------------------------------------------------------- 1 | Exercise03.md -------------------------------------------------------------------------------- /src/Exercise04.lhs: -------------------------------------------------------------------------------- 1 | Exercise04.md -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .ghci 2 | .stack-work 3 | stack.yaml.lock 4 | *.cabal 5 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-14.22 2 | packages: 3 | - . 4 | - solved 5 | extra-deps: [] 6 | flags: {} 7 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: th-tutorial 2 | version: '0.1' 3 | maintainer: Dan Fithian 4 | license: AllRightsReserved 5 | copyright: 2021 Dan Fithian 6 | default-extensions: 7 | - LambdaCase 8 | - NoImplicitPrelude 9 | - OverloadedStrings 10 | - QuasiQuotes 11 | - ScopedTypeVariables 12 | - TemplateHaskell 13 | 14 | dependencies: 15 | - aeson 16 | - base 17 | - classy-prelude 18 | - hspec 19 | - QuickCheck 20 | - template-haskell 21 | - text 22 | 23 | library: 24 | source-dirs: 25 | - src 26 | ghc-options: 27 | - -Wall 28 | - -fwarn-tabs 29 | - -pgmL markdown-unlit 30 | -------------------------------------------------------------------------------- /solved/package.yaml: -------------------------------------------------------------------------------- 1 | name: th-tutorial-solved 2 | version: '0.1' 3 | maintainer: Dan Fithian 4 | license: AllRightsReserved 5 | copyright: 2020 Dan Fithian 6 | default-extensions: 7 | - LambdaCase 8 | - NoImplicitPrelude 9 | - OverloadedStrings 10 | - QuasiQuotes 11 | - ScopedTypeVariables 12 | - TemplateHaskell 13 | 14 | dependencies: 15 | - aeson 16 | - base 17 | - classy-prelude 18 | - hspec 19 | - QuickCheck 20 | - template-haskell 21 | - text 22 | 23 | library: 24 | source-dirs: 25 | - src 26 | ghc-options: 27 | - -Wall 28 | - -fwarn-tabs 29 | - -pgmL markdown-unlit 30 | -------------------------------------------------------------------------------- /solved/src/Solved/Exercise03.hs: -------------------------------------------------------------------------------- 1 | module Solved.Exercise03 where 2 | 3 | import ClassyPrelude 4 | import Data.Aeson (Value(String), FromJSON, ToJSON, parseJSON, toJSON, withText) 5 | import Language.Haskell.TH 6 | 7 | import Solved.Exercise02 8 | 9 | deriveEnumInstances :: Name -> Q [Dec] 10 | deriveEnumInstances tyName = do 11 | conNames <- extractConstructors tyName 12 | [d| instance PrettyShow $(conT tyName) where 13 | prettyShow = $(spliceConstructors (stringE <=< trimAndLowerTH tyName) conNames) 14 | instance ToJSON $(conT tyName) where 15 | toJSON = $(spliceConstructors (\ c -> [| String $(stringE =<< trimAndLowerTH tyName c) |]) conNames) 16 | instance FromJSON $(conT tyName) where 17 | parseJSON = withText $(stringE (show tyName)) 18 | $(spliceValues (litP . StringL <=< trimAndLowerTH tyName) conNames) 19 | |] 20 | -------------------------------------------------------------------------------- /solved/src/Solved/Exercise04.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | module Solved.Exercise04 where 3 | 4 | import ClassyPrelude 5 | import Data.Aeson (decode, encode) 6 | import Test.Hspec (Spec, describe, shouldBe, shouldSatisfy) 7 | import Test.Hspec.QuickCheck (prop) 8 | import Test.QuickCheck (Arbitrary, arbitrary, elements) 9 | 10 | import Solved.Exercise02 11 | import Solved.Exercise03 12 | 13 | deriveEnumInstances ''Pet 14 | 15 | instance Arbitrary Pet where 16 | arbitrary = elements [PetDog, PetCat, PetTeddyBear] 17 | 18 | -- |Fill in the spec bodies with the tests we want to run. 19 | thEnumSpec :: Spec 20 | thEnumSpec = describe "TH Enums" $ do 21 | prop "always round trips JSON instances" $ \ (x :: Pet) -> 22 | decode (encode x) `shouldBe` Just x 23 | 24 | prop "always encodes to something we expect" $ \ (x :: Pet) -> 25 | encode x `shouldSatisfy` flip elem ["\"dog\"", "\"cat\"", "\"teddyBear\""] 26 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Template Haskell Tutorial 2 | 3 | This is the repository for a Template Haskell tutorial. See [the proposal](doc/proposal.md) for the original 4 | inspiration. 5 | 6 | ## Setup 7 | 8 | [Markdown Unlit](https://hackage.haskell.org/package/markdown-unlit) is a GHC plugin for rendering Markdown as Literate 9 | Haskell. Exercises in this tutorial are written in Markdown, so we need to install the package. 10 | 11 | ```bash 12 | stack install markdown-unlit 13 | ``` 14 | 15 | We will always test a module by loading it into GHCi: 16 | 17 | ```bash 18 | stack ghci th-tutorial 19 | ``` 20 | 21 | Also recommend keeping a tab open to the docs for Template Haskell: 22 | https://www.stackage.org/lts-14.22/package/template-haskell-2.14.0.0 23 | 24 | ## Exercises 25 | 26 | The first two exercises are exploratory in GHCi to get a feel of how Template Haskell works. The next exercises go into 27 | more detail about how to define and test generated code. 28 | 29 | * [Exercise01](src/Exercise01.md) explores "hello world" and TH nuances 30 | * [Exercise02](src/Exercise02.md) helps create helper functions for inspection of a type's constructors at compile 31 | time. 32 | * [Exercise03](src/Exercise03.md) uses the helper functions to generate instances for an enumeration. 33 | * [Exercise04](src/Exercise04.md) demonstrates how to test the generated instances in Hspec. 34 | 35 | Start in the `src` folder and fill in the `TODO` parts of each exercise. The `solved` directory contains hints and 36 | spoilers. 37 | -------------------------------------------------------------------------------- /src/Exercise04.md: -------------------------------------------------------------------------------- 1 | ```haskell 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | module Exercise04 where 4 | 5 | import ClassyPrelude 6 | import Data.Aeson (decode, encode) 7 | import Test.Hspec (Spec, describe, hspec, shouldBe, shouldSatisfy) 8 | import Test.Hspec.QuickCheck (prop) 9 | import Test.QuickCheck (Arbitrary, arbitrary, elements) 10 | 11 | import Exercise02 12 | import Exercise03 13 | ``` 14 | 15 | Now, let's write some tests so that we can do this once and we never have to think about it ever again, even when we 16 | refactor. We create a new enumeration, generate the instances, and test the instances. That way we're testing that (1) 17 | the template haskell even compiles, because that would be terrible if it didn't, and (2) that the generated code does 18 | what we want whenever we generate the way we expect. 19 | 20 | ```haskell 21 | -- TODO uncomment 22 | -- deriveEnumInstances ''Pet 23 | 24 | instance Arbitrary Pet where 25 | arbitrary = elements [PetDog, PetCat, PetTeddyBear] 26 | ``` 27 | 28 | ## Exercises 29 | 30 | ### Write tests for the instances we derived 31 | 32 | ```haskell 33 | -- |Fill in the spec bodies with the tests we want to run. 34 | -- We should be able to call it like this: 35 | -- 36 | -- @ 37 | -- hspec thEnumSpec 38 | -- @ 39 | thEnumSpec :: Spec 40 | thEnumSpec = describe "TH Enums" $ do 41 | prop "always round trips JSON instances" $ \ (x :: Pet) -> 42 | fail "TODO fill me in" :: IO () 43 | 44 | prop "always encodes to something we expect" $ \ (x :: Pet) -> 45 | fail "TODO fill me in" :: IO () 46 | ``` 47 | -------------------------------------------------------------------------------- /solved/src/Solved/Exercise02.hs: -------------------------------------------------------------------------------- 1 | module Solved.Exercise02 where 2 | 3 | import ClassyPrelude hiding (stripPrefix) 4 | import Data.List (stripPrefix) 5 | import Language.Haskell.TH 6 | 7 | data Pet 8 | = PetDog 9 | | PetCat 10 | | PetTeddyBear 11 | deriving (Eq, Show) 12 | 13 | class PrettyShow a where 14 | prettyShow :: a -> Text 15 | 16 | trimAndLowerTH :: Name -> Name -> Q String 17 | trimAndLowerTH tyName conName = 18 | let tyStr = show tyName 19 | conStr = show conName 20 | in case stripPrefix tyStr conStr of 21 | Nothing -> fail $ tyStr <> " not a prefix of " <> conStr 22 | Just suffix -> case suffix of 23 | c:cs -> pure $ (charToLower c):cs 24 | _ -> fail $ tyStr <> " not a proper prefix of " <> conStr 25 | 26 | extractConstructors :: Name -> Q [Name] 27 | extractConstructors tyName = do 28 | info <- reify tyName 29 | case info of 30 | TyConI (DataD _cxt _name _tyVarBndrs_ _kindMay constructors _derivClauses) -> for constructors $ \ case 31 | NormalC conName [] -> pure conName 32 | other -> fail $ "type " <> show tyName <> " had a nontrivial constructor: " <> show other 33 | other -> fail $ "type " <> show tyName <> " was not defined with `data`: " <> show other 34 | 35 | spliceConstructors :: (Name -> Q Exp) -> [Name] -> Q Exp 36 | spliceConstructors effect conNames = 37 | let happyPath = map $ \ conName -> 38 | match (conP conName []) (normalB $ effect conName) [] 39 | in lamCaseE (happyPath conNames) 40 | 41 | spliceValues :: (Name -> Q Pat) -> [Name] -> Q Exp 42 | spliceValues effect conNames = do 43 | let happyPath = map $ \ conName -> do 44 | match (effect conName) (normalB [| pure $(conE conName) |]) [] 45 | sadPath x = match (varP x) (normalB [| fail $ "Don't know what " <> show $(varE x) <> " is" |]) [] 46 | otherName <- newName "other" 47 | lamCaseE (happyPath conNames <> [sadPath otherName]) 48 | -------------------------------------------------------------------------------- /src/Exercise03.md: -------------------------------------------------------------------------------- 1 | ```haskell 2 | module Exercise03 where 3 | 4 | import ClassyPrelude 5 | import Data.Aeson (ToJSON, FromJSON, Value (String), parseJSON, toJSON, withText) 6 | import Language.Haskell.TH 7 | 8 | import Exercise02 9 | ``` 10 | 11 | Recall our helper functions `trimAndLowerTH`, `extractConstructors`, `spliceConstructors`, `spliceValues`. We can 12 | combine them to generate instances for `FromJSON`, `ToJSON`, and `PrettyShow`. 13 | 14 | ## Exercises 15 | 16 | ### Derive enum instances for the `Pet` type 17 | 18 | ```haskell 19 | -- |`deriveEnumInstances tyName` takes a type name and derives three instances: `ToJSON`, `FromJSON`, `PrettyShow`. In 20 | -- order to derive those instances we need to extract the constructors and invoke the `spliceConstructors` or 21 | -- `spliceValues` function depending on what type of instance it is (showing or parsing, respectively). For the `Pet` 22 | -- example you would pass in something like: 23 | -- 24 | -- @ 25 | -- putStrLn $(stringE . pprint =<< deriveEnumInstances ''Pet) 26 | -- @ 27 | -- 28 | -- and get something like: 29 | -- 30 | -- @ 31 | -- Instance PrettyShow Pet where 32 | -- prettyShow = \ case 33 | -- PetDog -> "dog" 34 | -- PetCat -> "cat" 35 | -- PetTeddyBear -> "teddyBear" 36 | -- Instance ToJSON Pet where 37 | -- toJSON = \ case 38 | -- PetDog -> String "dog" 39 | -- PetCat -> String "cat" 40 | -- PetTeddyBear -> String "teddyBear" 41 | -- Instance FromJSON Pet where 42 | -- parseJSON = withText "Pet" $ \ case 43 | -- "dog" -> pure PetDog 44 | -- "cat" -> pure PetCat 45 | -- "teddyBear" -> pure PetTeddyBear 46 | -- other -> fail $ "I don't know about " <> other 47 | -- @ 48 | -- 49 | -- Fill in the body given the function arguments. 50 | deriveEnumInstances :: Name -> Q [Dec] 51 | deriveEnumInstances tyName = do 52 | conNames <- fail "TODO fill me in" 53 | [d| instance PrettyShow $(conT tyName) where 54 | prettyShow = error "TODO fill me in" 55 | instance ToJSON $(conT tyName) where 56 | toJSON = error "TODO fill me in" 57 | instance FromJSON $(conT tyName) where 58 | parseJSON = error "TODO fill me in" 59 | |] 60 | ``` 61 | -------------------------------------------------------------------------------- /src/Exercise01.md: -------------------------------------------------------------------------------- 1 | ```haskell 2 | module Exercise01 where 3 | 4 | import ClassyPrelude 5 | import Language.Haskell.TH 6 | ``` 7 | 8 | # Exercise 01 9 | 10 | Let's start with a simple Template Haskell example. Goals of this exercise: 11 | 12 | 1. Write a simple Hello World splice using the `Q` monad 13 | 2. Debug our splices in GHCi 14 | 15 | ## Hello World 16 | 17 | Consider the following code: 18 | 19 | ```haskell 20 | helloWorldE :: Q Exp 21 | helloWorldE = [| putStrLn "hello world" |] 22 | 23 | helloWorldD :: Q [Dec] 24 | helloWorldD = 25 | [d| helloWorld :: IO () 26 | helloWorld = putStrLn "i'm trapped in a splice!" 27 | |] 28 | 29 | helloWorldD' :: Q [Dec] 30 | helloWorldD' = do 31 | helloWorldName <- newName "helloWorld" 32 | Just ioName <- lookupTypeName "IO" 33 | Just putStrLnName <- lookupValueName "putStrLn" 34 | sequence $ 35 | [ sigD helloWorldName (appT (conT ioName) (tupleT 0)) 36 | , valD (varP helloWorldName) (normalB (appE (varE putStrLnName) (litE (stringL "i'm too far gone!!")))) [] 37 | ] 38 | ``` 39 | 40 | The above functions do more or less the same thing, but with some interesting differences. `helloWorldE` is an `Exp` 41 | (expression), or code that can be evaluated direcly. `helloWorldD` and `helloWorldD'` are `Dec`s (declarations) which 42 | define new top-level declarations within a module. `helloWorldD` and `helloWorldD'` are different in that the former is 43 | QuasiQuoted (using the `d` identifier) while the latter is written directly in Template Haskell. 44 | 45 | ## Configuring GHCi 46 | 47 | Let's load this into GHCi: 48 | 49 | ```bash 50 | cat > .ghci <)`. 65 | 66 | We can't invoke all TH splices in GHCi. We can run `$(helloWorldE)` but we can't run `$(helloWorldD)`. In order to use 67 | the declarations provided by `$(helloWorldD)` we'd have to put it in a file and reload the module. In addition, the 68 | splice has to be declared in a separate file from the one in which it is invoked. Try it out for yourself, if you'd 69 | like. 70 | 71 | ### Debugging expressions in GHCi 72 | 73 | Whenever we want, we can debug our TH splices using a utility. Try it out by replacing `` with a function of 74 | your choice. 75 | 76 | ```bash 77 | putStrLn $(stringE . pprint =<< ) 78 | ``` 79 | 80 | ## Other Notes 81 | 82 | * There are multiple QuasiQuote identifiers - `[| ... |]` or `[e| ... |]` for expressions, `[d| ... |]` for 83 | declarations, `[t| ... |]` for types, and `[p| ... |]` for patterns. 84 | * `Name`s are identifiers for both values and types. We can promote a type to a `Name` to names with two single quotes: 85 | `''MyType`, and a value to a name with one single quote: `'MyDataConstructor` or even `'myVariable`. 86 | * You can mix QuasiQuotes and splices together: `[| $(StringL "foo") :: String |]` and `$(sigE (StringL "foo") [t| 87 | String |])` are both valid. 88 | * Lowercase TH functions and uppercase TH constructors are related. 89 | * `varP :: Name -> PatQ` 90 | * `type PatQ = Q Pat` 91 | * `data Pat = ... | VarP Name | ...` 92 | * Constructors and functions always end with the first letter of their type. 93 | * `varE :: Name -> ExpQ` 94 | * `varT :: Name -> TypeQ` 95 | * `varP :: Name -> PatQ` 96 | -------------------------------------------------------------------------------- /doc/proposal.md: -------------------------------------------------------------------------------- 1 | # Title 2 | 3 | Template Haskell is for Haters - Of Boilerplate 4 | 5 | # Format 6 | 7 | Hop Workshop (2h) 8 | 9 | # Audience 10 | 11 | Intermediate 12 | 13 | # Elevator Pitch 14 | 15 | We all hate boilerplate code. Having to restate slightly different incantations of similar code over and over again is 16 | not only mind numbing, it's prone to error. Use Template Haskell to kill boilerplate with fire. 17 | 18 | # Description 19 | 20 | Everyone can agree that writing boilerplate code sucks. The options available in the Haskell ecosystem to reduce 21 | boilerplate are billed as "advanced" features - [Scrap Your Boilerplate](http://hackage.haskell.org/package/syb), 22 | [Generic programming](http://hackage.haskell.org/package/base-4.12.0.0/docs/GHC-Generics.html), [Template Haskell 23 | metaprogramming](http://hackage.haskell.org/package/template-haskell). However, a simple application of any of these 24 | solutions can go a long way to improving code quality, reducing bugs, and increasing developer happiness. So why do they 25 | have to be advanced features? 26 | 27 | Template Haskell is more approachable than it appears, and this workshop will empower attendees to use it to their 28 | advantage. In this workshop, we'll cover the "why" and "how" of basic applications of TH. Over the course of two hours, 29 | attendees will get familiar with TH functions, identify some boilerplate code to refactor, rewrite it using vanilla TH 30 | and QuasiQuoters, and write tests. By the end, attendees will have written something they can be proud of and be armed 31 | with tools for diving deeper into the world of Template Haskell. 32 | 33 | **NOTE** This talk expects the attendee to have used Haskell before, be used to working in the type system, and 34 | understand concepts like monads. 35 | 36 | # Notes 37 | 38 | ## Format 39 | 40 | This talk will be divided into lecture sessions and exercises. 41 | 42 | ### Lecture topics 43 | 44 | The introduction will center around the tools we'll need for the workshop, what exactly Template Haskell is, what the 45 | `Q` monad is, and how can we use it? Exercises will include a simple "Hello World" written in TH, `fail`ing in `Q`, and 46 | printing the output of a TH splice. 47 | 48 | After getting familiar with the base Template Haskell tools, we'll jump into the larger exercise. Lecture will cover 49 | identifying some boilerplate code, and introduce some basic combinators for TH needed for the exercise. The exercises 50 | will cover rewriting the boilerplate code identified in TH. 51 | 52 | After rewriting the boilerplate code, the next section will introduce QuasiQuoters. QuasiQuoters are a way to "lift" 53 | regular Haskell code into Template Haskell's `Q` monad, so their purpose is to simplify the TH we have already written. 54 | The exercises will simplify the TH just written in the previous exercise to use QuasiQuoters. 55 | 56 | The final section will cover testing. I want to leave a lot of time for this because it's the most important. Nothing's 57 | worse than writing an untestable macro! Lecture will cover the elements of successful tests and writing some tests. 58 | Exercises will be to wire in the TH splices, iterate, and fix bugs. 59 | 60 | ## Motivation 61 | 62 | Simply put, writing boilerplate code makes me very grumpy. For years I went about writing boring instances because I was 63 | afraid of using Template Haskell. Since I decided to start learning to use Template Haskell, my team's use of Template 64 | Haskell has empowered us to focus more on the real code that drives our company and industry forward. I want to share 65 | that knowledge with others, because the more efficient a team or company is in Haskell the better it is for the 66 | ecosystem as a whole. 67 | 68 | Template Haskell is a means to greater productivity, because it takes care of mindless, error-prone work, and lets 69 | developers focus on writing code crucial to the business. It shouldn't be scary. 70 | 71 | # Tags 72 | 73 | * Haskell 74 | * Template Haskell 75 | -------------------------------------------------------------------------------- /src/Exercise02.md: -------------------------------------------------------------------------------- 1 | ```haskell 2 | module Exercise02 where 3 | 4 | import ClassyPrelude hiding (stripPrefix) 5 | import Data.Aeson (FromJSON, ToJSON, Value (String), parseJSON, toJSON, withText) 6 | import Data.List (stripPrefix) 7 | import Language.Haskell.TH 8 | ``` 9 | 10 | Now we have a background in Template Haskell, so what can we do with it? Say we have some boilerplate-y thing we often 11 | do and we want to generate that using a macro. 12 | 13 | ```haskell 14 | data Pet 15 | = PetDog 16 | | PetCat 17 | | PetTeddyBear 18 | deriving (Eq, Show) 19 | ``` 20 | 21 | This is a pattern that I find very common: some enumeration, with constructors prefixed with the type name to avoid 22 | ambiguity (due to Haskell's namespacing woes). Inevitably someone will want JSON instances. 23 | 24 | ```haskell 25 | instance ToJSON Pet where 26 | toJSON = \ case 27 | PetDog -> String "dog" 28 | PetCat -> String "cat" 29 | PetTeddyBear -> String "teddyBear" 30 | instance FromJSON Pet where 31 | parseJSON = withText "Pet" $ \ case 32 | "dog" -> pure PetDog 33 | "cat" -> pure PetCat 34 | "teddyBear" -> pure PetTeddyBear 35 | other -> fail $ "unknown pet type " <> unpack other 36 | ``` 37 | 38 | Maybe on top of that you also generate similar instances for `PersistField` or some prettier `Show`. 39 | 40 | ```haskell 41 | class PrettyShow a where 42 | prettyShow :: a -> Text 43 | ``` 44 | 45 | ```haskell 46 | instance PrettyShow Pet where 47 | prettyShow = \ case 48 | PetDog -> "dog" 49 | PetCat -> "cat" 50 | PetTeddyBear -> "teddyBear" 51 | ``` 52 | 53 | Pretty soon you have a bunch of enumerations and every time you have to write out five or six different instances, and 54 | any time you refactor a function common to them all you have to go change the code in the exact same way in now every 55 | single one of those instances. Terrible. 56 | 57 | Where all this is leading should be pretty obvious: the point is that we want to generate some boilerplate instances for 58 | enumerations. Eventually, we'll want a function `deriveEnumInstances :: Name -> Q [Dec]` that will generate these 59 | instances for us. On the way, we need to define a few helper functions. 60 | 61 | ## Exercises 62 | 63 | ### Trim and lowercasing first letter in a constructor 64 | 65 | We need a way of trimming a type and lowercasing the first letter in each constructor. This function is provided for you 66 | so you can use it in later exercises. 67 | 68 | ```haskell 69 | -- |Trim and lower a string by removing its prefix. 70 | -- Pass in something like: 71 | -- 72 | -- @ 73 | -- putStrLn $(stringE =<< trimAndLowerTH ''Pet 'PetDog) 74 | -- @ 75 | -- 76 | -- and get something like 77 | -- 78 | -- @ 79 | -- dog 80 | -- @ 81 | trimAndLowerTH :: Name -> Name -> Q String 82 | trimAndLowerTH tyName conName = 83 | let tyStr = show tyName 84 | conStr = show conName 85 | in case stripPrefix tyStr conStr of 86 | Nothing -> fail $ tyStr <> " not a prefix of " <> conStr 87 | Just suffix -> case suffix of 88 | c:cs -> pure $ (charToLower c):cs 89 | _ -> fail $ tyStr <> " not a proper prefix of " <> conStr 90 | ``` 91 | 92 | ### Extracting constructors 93 | 94 | Next we need a way to extract constructors from a type in Template Haskell. Since we're in the `Q` monad, a call to 95 | `fail` makes compilation fail. To do this we'll need `reify`, which looks up and provides information about a type, 96 | value, class, you name it. What we're looking for in our case is a `data` type with N constructors, none of which take 97 | any extra arguments. 98 | 99 | ```haskell 100 | -- |Extract the constructors for a type. 101 | -- Fill in the pattern match statement. Pass in something like: 102 | -- 103 | -- @ 104 | -- putStrLn $(stringE . show =<< extractConstructors ''Pet) 105 | -- @ 106 | -- 107 | -- and get something like: 108 | -- 109 | -- @ 110 | -- [PetDog, PetCat, PetTeddyBear] 111 | -- @ 112 | extractConstructors :: Name -> Q [Name] 113 | extractConstructors tyName = do 114 | info <- reify tyName 115 | case info of 116 | _ -> fail "TODO fill me in" 117 | ``` 118 | 119 | ### Iterating over constructors and values 120 | 121 | Then we need a way to iterate over the list of constructors and values as the body of a `case` statement. Note that here 122 | we should look up `lamCaseE` to figure out the appropriate shape for `happyPath`. 123 | 124 | ```haskell 125 | -- |`spliceConstructors f conNames` takes a list of constructor names `conNames` and a function `f` applied to each 126 | -- constructor name. It splices them in a `\ case` expression. For the `Pet` example you would pass in something like: 127 | -- 128 | -- @ 129 | -- putStrLn $(stringE . pprint =<< spliceConstructors (stringE <=< trimAndLowerTH ''Pet) ['PetDog, 'PetCat, 'PetTeddyBear]) 130 | -- @ 131 | -- 132 | -- and get something like: 133 | -- 134 | -- @ 135 | -- \ case 136 | -- PetDog -> "dog" 137 | -- PetCat -> "cat" 138 | -- PetTeddyBear -> "teddyBear" 139 | -- @ 140 | -- 141 | -- Fill in the match statement given the function arguments. 142 | spliceConstructors :: (Name -> Q Exp) -> [Name] -> Q Exp 143 | spliceConstructors effect conNames = 144 | let happyPath = fail "TODO fill this in" 145 | in lamCaseE (happyPath conNames) 146 | 147 | -- |`spliceValues f g tyName conNames` takes a list of constructor names `conNames` as well as a matching function `f` 148 | -- for the constructor names, and a type name `tyName`. It splices them in a `\ case` expression. For the `Pet` example 149 | -- you would pass in something like: 150 | -- 151 | -- @ 152 | -- putStrLn $(stringE . pprint =<< spliceValues (litP . StringL <=< trimAndLowerTH ''Pet) ['PetDog, 'PetCat, 'PetTeddyBear]) 153 | -- @ 154 | -- 155 | -- and get something like: 156 | -- 157 | -- @ 158 | -- \ case 159 | -- "dog" -> pure PetDog 160 | -- "cat" -> pure PetCat 161 | -- "teddyBear" -> pure PetTeddyBear 162 | -- other -> fail $ "Don't know what " <> other <> " is" 163 | -- @ 164 | -- 165 | -- Fill in the match statement given the function arguments. 166 | spliceValues :: (Name -> Q Pat) -> [Name] -> Q Exp 167 | spliceValues effect conNames = do 168 | let happyPath = fail "TODO fill me in" 169 | sadPath x = match (varP x) (normalB [| fail $ "Don't know what " <> show $(varE x) <> " is" |]) [] 170 | otherName <- newName "other" 171 | lamCaseE (happyPath conNames <> [sadPath otherName]) 172 | ``` 173 | --------------------------------------------------------------------------------