618906d9011148cf0b6b020c7e36ef3a8ea00996
[ghc.git] / libraries / template-haskell / Language / Haskell / TH / Quote.hs
1 {-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
2 module Language.Haskell.TH.Quote(
3 QuasiQuoter(..),
4 dataToQa, dataToExpQ, dataToPatQ,
5 quoteFile
6 ) where
7
8 import Data.Data
9 import Language.Haskell.TH.Lib
10 import Language.Haskell.TH.Syntax
11
12 data QuasiQuoter = QuasiQuoter { quoteExp :: String -> Q Exp,
13 quotePat :: String -> Q Pat,
14 quoteType :: String -> Q Type,
15 quoteDec :: String -> Q [Dec] }
16
17 dataToQa :: forall a k q. Data a
18 => (Name -> k)
19 -> (Lit -> Q q)
20 -> (k -> [Q q] -> Q q)
21 -> (forall b . Data b => b -> Maybe (Q q))
22 -> a
23 -> Q q
24 dataToQa mkCon mkLit appCon antiQ t =
25 case antiQ t of
26 Nothing ->
27 case constrRep constr of
28 AlgConstr _ ->
29 appCon (mkCon conName) conArgs
30 where
31 conName :: Name
32 conName =
33 case showConstr constr of
34 "(:)" -> Name (mkOccName ":") (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
35 con@"[]" -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
36 con@('(':_) -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Tuple"))
37 con -> mkNameG_d (tyConPackage tycon)
38 (tyConModule tycon)
39 con
40 where
41 tycon :: TyCon
42 tycon = (typeRepTyCon . typeOf) t
43
44 conArgs :: [Q q]
45 conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
46 IntConstr n ->
47 mkLit $ integerL n
48 FloatConstr n ->
49 mkLit $ rationalL n
50 CharConstr c ->
51 mkLit $ charL c
52 where
53 constr :: Constr
54 constr = toConstr t
55
56 Just y -> y
57
58 -- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the same
59 -- value. It takes a function to handle type-specific cases.
60 dataToExpQ :: Data a
61 => (forall b . Data b => b -> Maybe (Q Exp))
62 -> a
63 -> Q Exp
64 dataToExpQ = dataToQa conE litE (foldl appE)
65
66 -- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
67 -- value. It takes a function to handle type-specific cases.
68 dataToPatQ :: Data a
69 => (forall b . Data b => b -> Maybe (Q Pat))
70 -> a
71 -> Q Pat
72 dataToPatQ = dataToQa id litP conP
73
74 -- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read
75 -- the data out of a file. For example, suppose 'asmq' is an
76 -- assembly-language quoter, so that you can write [asmq| ld r1, r2 |]
77 -- as an expression. Then if you define @asmq_f = quoteFile asmq@, then
78 -- the quote [asmq_f|foo.s|] will take input from file @"foo.s"@ instead
79 -- of the inline text
80 quoteFile :: QuasiQuoter -> QuasiQuoter
81 quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec = qd })
82 = QuasiQuoter { quoteExp = get qe, quotePat = get qp, quoteType = get qt, quoteDec = get qd }
83 where
84 get :: (String -> Q a) -> String -> Q a
85 get old_quoter file_name = do { file_cts <- runIO (readFile file_name)
86 ; addDependentFile file_name
87 ; old_quoter file_cts }