-
Notifications
You must be signed in to change notification settings - Fork 2
/
TileShow.hs
27 lines (25 loc) · 1.17 KB
/
TileShow.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
{-# LANGUAGE TemplateHaskell #-}
module TileShow where
import Language.Haskell.TH
makeShow t = do
TyConI (DataD _ _ _ constructors _) <- reify t
-- Make `show` clause for one constructor:
-- show (A x1 x2) = "A "++show x1++" "++show x2
let showClause (NormalC name fields) = do
-- Name of constructor, i.e. "A". Will become string literal in generated code
let constructorName = [(head $ nameBase name)]
-- Generate function clause for one constructor
clause [conP name []] -- (A x1 x2)
(normalB [| constructorName |]) [] -- "A "++show x1++" "++show x2
-- Make body for function `show`:
-- show (A x1 x2) = "A "++show x1++" "++show x2
-- show (B x1) = "B "++show x1
-- show C = "C"
showbody <- mapM showClause constructors
-- Generate template instance declaration and then replace
-- type name (T1) and function body (\x -> "text") with our data
d <- [d| instance Show String where
show _x = "text"
|]
let [InstanceD [] (AppT showt (ConT _T1)) [FunD showf _text]] = d
return [InstanceD [] (AppT showt (ConT t )) [FunD showf showbody]]