    {-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
    module Language.Haskell.TH.Quote(
    	QuasiQuoter(..),
            dataToQa, dataToExpQ, dataToPatQ
        ) where

    import Data.Data
    import Language.Haskell.TH.Lib
    import Language.Haskell.TH.Syntax

    data QuasiQuoter = QuasiQuoter { quoteExp :: String -> Q Exp,
                                     quotePat :: String -> Q Pat }

    dataToQa  ::  forall a k q. Data a
              =>  (Name -> k)
              ->  (Lit -> Q q)
              ->  (k -> [Q q] -> Q q)
              ->  (forall b . Data b => b -> Maybe (Q q))
              ->  a
              ->  Q q
    dataToQa mkCon mkLit appCon antiQ t =
        case antiQ t of
          Nothing ->
              case constrRep constr of
                AlgConstr _  ->
                    appCon con conArgs
                IntConstr n ->
                    mkLit $ integerL n
                FloatConstr n ->
                    mkLit $ rationalL (toRational n)
                StringConstr (c:_) ->
                    mkLit $ charL c
                StringConstr [] ->
                    fail "StringConstr with no name"
            where
              constr :: Constr
              constr = toConstr t
              constrName :: Constr -> String
              constrName k =
                  case showConstr k of
                    "(:)"  -> ":"
                    name   -> name
              con :: k
              con = mkCon (mkName (constrName constr))
              conArgs :: [Q q]
              conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t

          Just y -> y

    -- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the same
    -- value. It takes a function to handle type-specific cases.
    dataToExpQ  ::  Data a
                =>  (forall b . Data b => b -> Maybe (Q Exp))
                ->  a
                ->  Q Exp
    dataToExpQ = dataToQa conE litE (foldl appE)

    -- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
    -- value. It takes a function to handle type-specific cases.
    dataToPatQ  ::  Data a
                =>  (forall b . Data b => b -> Maybe (Q Pat))
                ->  a
                ->  Q Pat
    dataToPatQ = dataToQa id litP conP