QuasiQuoting

Quasi.hs

{-# LANGUAGE TemplateHaskell #-}

{- This works in GHC 7.8.3 -}

import Control.Monad
import Language.Haskell.TH

data DB = DB { couples :: [Couple], people :: [People] }
type Couple = (String, String)
type People = (String, Int)

db :: DB
db = undefined

sumExpr :: Q Exp
sumExpr = [e| do (n1, n2) <- couples db
                 p1 <- people db
                 guard (fst p1 == n1)
                 p2 <- people db
                 guard (fst p2 == n2)
                 return ((n1, n2), snd p1 + snd p2) |]
                 
{-

> (pprint `fmap` runQ sumExpr) >>= putStrLn
do {(n1_0, n2_1) <- Main.couples Main.db;
    p1_2 <- Main.people Main.db;
    Control.Monad.guard (Data.Tuple.fst p1_2 GHC.Classes.== n1_0);
    p2_3 <- Main.people Main.db;
    Control.Monad.guard (Data.Tuple.fst p2_3 GHC.Classes.== n2_1);
    GHC.Base.return ((n1_0, n2_1),
                     Data.Tuple.snd p1_2 GHC.Num.+ Data.Tuple.snd p2_3)}
                     
-}

sumTExp :: Q (TExp [((String,String), Int)])
sumTExp = [e|| do (n1, n2) <- couples db
                  p1 <- people db
                  guard (fst p1 == n1)
                  p2 <- people db
                  guard (fst p2 == n2)
                  return ((n1, n2), snd p1 + snd p2) ||]
                  
{-

> ((pprint . unType) `fmap` runQ sumTExp) >>= putStrLn
do {(n1_0, n2_1) <- Main.couples Main.db;
    p1_2 <- Main.people Main.db;
    Control.Monad.guard (Data.Tuple.fst p1_2 GHC.Classes.== n1_0);
    p2_3 <- Main.people Main.db;
    Control.Monad.guard (Data.Tuple.fst p2_3 GHC.Classes.== n2_1);
    GHC.Base.return ((n1_0, n2_1),
                     Data.Tuple.snd p1_2 GHC.Num.+ Data.Tuple.snd p2_3)}
                     
-}