Commit 08558a30 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Move liftData and use it as a default definition for Lift.

Summary:
This should make it a lot easier to define Lift instances.
See https://mail.haskell.org/pipermail/libraries/2015-May/025728.html


for motivating discussion.

I needed to muck out some code from Quote into Syntax to get
the definition in the right place; but I would argue that code
never really belonged in Quote to begin with.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: austin, ekmett, goldfire

Subscribers: bgamari, thomie

Differential Revision: https://phabricator.haskell.org/D923
parent cd9c5c66
......@@ -403,6 +403,18 @@
Version number XXXXX (was 2.9.0.0)
</para>
</listitem>
<listitem>
<para>
The <literal>Lift</literal> type class for lifting values
into Template Haskell splices now has a default signature
<literal>lift :: Data a => a -> Q Exp</literal>, which means
that you do not have to provide an explicit implementation
of <literal>lift</literal> for types which have a <literal>Data</literal>
instance. To manually use this default implementation, you
can use the <literal>liftData</literal> function which is
now exported from <literal>Language.Haskell.TH.Syntax</literal>.
</para>
</listitem>
</itemizedlist>
</sect3>
......
......@@ -15,13 +15,11 @@ that is up to you.
-}
module Language.Haskell.TH.Quote(
QuasiQuoter(..),
dataToQa, dataToExpQ, dataToPatQ,
liftData,
quoteFile
quoteFile,
-- * For backwards compatibility
dataToQa, dataToExpQ, dataToPatQ
) where
import Data.Data
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Syntax
-- | The 'QuasiQuoter' type, a value @q@ of this type can be used
......@@ -42,75 +40,6 @@ data QuasiQuoter = QuasiQuoter {
quoteDec :: String -> Q [Dec]
}
-- | 'dataToQa' is a generic utility function for constructing generic
-- conversion functions from types with 'Data' instances to various
-- quasi-quoting representations. It's used by 'dataToExpQ' and
-- 'dataToPatQ'
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 (mkCon conName) conArgs
where
conName :: Name
conName =
case showConstr constr of
"(:)" -> Name (mkOccName ":") (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
con@"[]" -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
con@('(':_) -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Tuple"))
con -> mkNameG_d (tyConPackage tycon)
(tyConModule tycon)
con
where
tycon :: TyCon
tycon = (typeRepTyCon . typeOf) t
conArgs :: [Q q]
conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
IntConstr n ->
mkLit $ integerL n
FloatConstr n ->
mkLit $ rationalL n
CharConstr c ->
mkLit $ charL c
where
constr :: Constr
constr = toConstr t
Just y -> y
-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the
-- same value, in the SYB style. It is generalized to take a function
-- override type-specific cases; see 'liftData' for a more commonly
-- used variant.
dataToExpQ :: Data a
=> (forall b . Data b => b -> Maybe (Q Exp))
-> a
-> Q Exp
dataToExpQ = dataToQa conE litE (foldl appE)
-- | 'liftData' is a variant of 'lift' in the 'Lift' type class which
-- works for any type with a 'Data' instance.
liftData :: Data a => a -> Q Exp
liftData = dataToExpQ (const Nothing)
-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
-- value, in the SYB style. It takes a function to handle type-specific cases,
-- alternatively, pass @const Nothing@ to get default behavior.
dataToPatQ :: Data a
=> (forall b . Data b => b -> Maybe (Q Pat))
-> a
-> Q Pat
dataToPatQ = dataToQa id litP conP
-- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read
-- the data out of a file. For example, suppose 'asmq' is an
-- assembly-language quoter, so that you can write [asmq| ld r1, r2 |]
......
{-# LANGUAGE CPP, DeriveDataTypeable, PolymorphicComponents,
DeriveGeneric, FlexibleInstances #-}
DeriveGeneric, FlexibleInstances, DefaultSignatures,
ScopedTypeVariables, Rank2Types #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE RoleAnnotations #-}
......@@ -28,7 +29,7 @@
module Language.Haskell.TH.Syntax where
import Data.Data (Data(..), Typeable )
import Data.Data hiding (Fixity(..))
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative( Applicative(..) )
#endif
......@@ -468,6 +469,8 @@ sequenceQ = sequence
class Lift t where
lift :: t -> Q Exp
default lift :: Data t => t -> Q Exp
lift = liftData
-- If you add any instances here, consider updating test th/TH_Lift
instance Lift Integer where
......@@ -590,6 +593,99 @@ leftName, rightName :: Name
leftName = mkNameG DataName "base" "Data.Either" "Left"
rightName = mkNameG DataName "base" "Data.Either" "Right"
-----------------------------------------------------
--
-- Generic Lift implementations
--
-----------------------------------------------------
-- | 'dataToQa' is an internal utility function for constructing generic
-- conversion functions from types with 'Data' instances to various
-- quasi-quoting representations. See the source of 'dataToExpQ' and
-- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@
-- and @appQ@ are overloadable to account for different syntax for
-- expressions and patterns; @antiQ@ allows you to override type-specific
-- cases, a common usage is just @const Nothing@, which results in
-- no overloading.
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 (mkCon conName) conArgs
where
conName :: Name
conName =
case showConstr constr of
"(:)" -> Name (mkOccName ":")
(NameG DataName
(mkPkgName "ghc-prim")
(mkModName "GHC.Types"))
con@"[]" -> Name (mkOccName con)
(NameG DataName
(mkPkgName "ghc-prim")
(mkModName "GHC.Types"))
con@('(':_) -> Name (mkOccName con)
(NameG DataName
(mkPkgName "ghc-prim")
(mkModName "GHC.Tuple"))
con -> mkNameG_d (tyConPackage tycon)
(tyConModule tycon)
con
where
tycon :: TyCon
tycon = (typeRepTyCon . typeOf) t
conArgs :: [Q q]
conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
IntConstr n ->
mkLit $ IntegerL n
FloatConstr n ->
mkLit $ RationalL n
CharConstr c ->
mkLit $ CharL c
where
constr :: Constr
constr = toConstr t
Just y -> y
-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the
-- same value, in the SYB style. It is generalized to take a function
-- override type-specific cases; see 'liftData' for a more commonly
-- used variant.
dataToExpQ :: Data a
=> (forall b . Data b => b -> Maybe (Q Exp))
-> a
-> Q Exp
dataToExpQ = dataToQa conE litE (foldl appE)
where conE s = return (ConE s)
appE x y = do { a <- x; b <- y; return (AppE a b)}
litE c = return (LitE c)
-- | 'liftData' is a variant of 'lift' in the 'Lift' type class which
-- works for any type with a 'Data' instance.
liftData :: Data a => a -> Q Exp
liftData = dataToExpQ (const Nothing)
-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
-- value, in the SYB style. It takes a function to handle type-specific cases,
-- alternatively, pass @const Nothing@ to get default behavior.
dataToPatQ :: Data a
=> (forall b . Data b => b -> Maybe (Q Pat))
-> a
-> Q Pat
dataToPatQ = dataToQa id litP conP
where litP l = return (LitP l)
conP n ps = do ps' <- sequence ps
return (ConP n ps')
-----------------------------------------------------
-- Names and uniques
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment