eliminate dependency on syb
[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 ) where
6
7 import Data.Data
8 import Language.Haskell.TH.Lib
9 import Language.Haskell.TH.Syntax
10
11 data QuasiQuoter = QuasiQuoter { quoteExp :: String -> Q Exp,
12 quotePat :: String -> Q Pat }
13
14 dataToQa :: forall a k q. Data a
15 => (Name -> k)
16 -> (Lit -> Q q)
17 -> (k -> [Q q] -> Q q)
18 -> (forall b . Data b => b -> Maybe (Q q))
19 -> a
20 -> Q q
21 dataToQa mkCon mkLit appCon antiQ t =
22 case antiQ t of
23 Nothing ->
24 case constrRep constr of
25 AlgConstr _ ->
26 appCon con conArgs
27 IntConstr n ->
28 mkLit $ integerL n
29 FloatConstr n ->
30 mkLit $ rationalL (toRational n)
31 StringConstr (c:_) ->
32 mkLit $ charL c
33 StringConstr [] ->
34 fail "StringConstr with no name"
35 where
36 constr :: Constr
37 constr = toConstr t
38 constrName :: Constr -> String
39 constrName k =
40 case showConstr k of
41 "(:)" -> ":"
42 name -> name
43 con :: k
44 con = mkCon (mkName (constrName constr))
45 conArgs :: [Q q]
46 conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
47
48 Just y -> y
49
50 -- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the same
51 -- value. It takes a function to handle type-specific cases.
52 dataToExpQ :: Data a
53 => (forall b . Data b => b -> Maybe (Q Exp))
54 -> a
55 -> Q Exp
56 dataToExpQ = dataToQa conE litE (foldl appE)
57
58 -- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
59 -- value. It takes a function to handle type-specific cases.
60 dataToPatQ :: Data a
61 => (forall b . Data b => b -> Maybe (Q Pat))
62 -> a
63 -> Q Pat
64 dataToPatQ = dataToQa id litP conP