Commit 33fa8d94 authored by Ryan Scott's avatar Ryan Scott Committed by Marge Bot

Generalize liftData to work over any Quote (#17857)

The Overloaded Quotations proposal generalized the type of `lift`
to work over any `Quote`, but not the type of `liftData`, leading
to #17857. Thankfully, generalizing `liftData` is extremely
straightforward.

Fixes #17857.
parent 58175379
......@@ -1074,13 +1074,13 @@ nonemptyName = mkNameG DataName "base" "GHC.Base" ":|"
-- 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
dataToQa :: forall m a k q. (Quote m, Data a)
=> (Name -> k)
-> (Lit -> Q q)
-> (k -> [Q q] -> Q q)
-> (forall b . Data b => b -> Maybe (Q q))
-> (Lit -> m q)
-> (k -> [m q] -> m q)
-> (forall b . Data b => b -> Maybe (m q))
-> a
-> Q q
-> m q
dataToQa mkCon mkLit appCon antiQ t =
case antiQ t of
Nothing ->
......@@ -1117,7 +1117,7 @@ dataToQa mkCon mkLit appCon antiQ t =
tyconPkg = tyConPackage tycon
tyconMod = tyConModule tycon
conArgs :: [Q q]
conArgs :: [m q]
conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
IntConstr n ->
mkLit $ IntegerL n
......@@ -1159,14 +1159,14 @@ function. Two complications
"pack" is defined in a different module than the data type "Text".
-}
-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the
-- | 'dataToExpQ' converts a value to a '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))
dataToExpQ :: (Quote m, Data a)
=> (forall b . Data b => b -> Maybe (m Exp))
-> a
-> Q Exp
-> m Exp
dataToExpQ = dataToQa varOrConE litE (foldl appE)
where
-- Make sure that VarE is used if the Constr value relies on a
......@@ -1176,23 +1176,23 @@ dataToExpQ = dataToQa varOrConE litE (foldl appE)
case nameSpace s of
Just VarName -> return (VarE s)
Just DataName -> return (ConE s)
_ -> fail $ "Can't construct an expression from name "
++ showName s
_ -> error $ "Can't construct an expression from name "
++ showName 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 :: (Quote m, Data a) => a -> m Exp
liftData = dataToExpQ (const Nothing)
-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
-- | 'dataToPatQ' converts a value to a '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))
dataToPatQ :: (Quote m, Data a)
=> (forall b . Data b => b -> Maybe (m Pat))
-> a
-> Q Pat
-> m Pat
dataToPatQ = dataToQa id litP conP
where litP l = return (LitP l)
conP n ps =
......@@ -1200,8 +1200,8 @@ dataToPatQ = dataToQa id litP conP
Just DataName -> do
ps' <- sequence ps
return (ConP n ps')
_ -> fail $ "Can't construct a pattern from name "
++ showName n
_ -> error $ "Can't construct a pattern from name "
++ showName n
-----------------------------------------------------
-- Names and uniques
......
......@@ -3,11 +3,12 @@
## 2.17.0.0
* Implement Overloaded Quotations (GHC Proposal #246). This patch modifies a
few fundamental things in the API. All the library combinators are generalised
to be in terms of a new minimal class `Quote`. The type of `lift` and `liftTyped`
are modified to return `m Exp` rather than `Q Exp`. Instances written in terms
of `Q` are now disallowed. The types of `unsafeTExpCoerce` and `unTypeQ`
are also generalised in terms of `Quote` rather than specific to `Q`.
few fundamental things in the API. All the library combinators are generalised
to be in terms of a new minimal class `Quote`. The types of `lift`, `liftTyped`,
and `liftData` are modified to return `m Exp` rather than `Q Exp`. Instances
written in terms of `Q` are now disallowed. The types of `unsafeTExpCoerce`
and `unTypeQ` are also generalised in terms of `Quote` rather than specific
to `Q`.
## 2.16.0.0 *TBA*
......
{-# LANGUAGE DeriveDataTypeable #-}
module T17857 where
import Data.Data
import Language.Haskell.TH.Syntax
data T = MkT deriving Data
instance Lift T where
lift = liftData
liftTyped = unsafeTExpCoerce . lift
......@@ -16,6 +16,7 @@ test('T8759a', normal, compile, ['-v0'])
test('T9824', normal, compile, ['-v0'])
test('T10384', normal, compile_fail, [''])
test('T16384', req_th, compile, [''])
test('T17857', normal, compile, [''])
test('TH_tf2', normal, compile, ['-v0'])
test('TH_ppr1', normal, compile_and_run, [''])
......
T10796b.hs:8:16: error:
• Can't construct a pattern from name Data.Set.Internal.fromList
T10796b.hs:8:15: error:
• Exception when trying to run compile-time code:
Can't construct a pattern from name Data.Set.Internal.fromList
CallStack (from HasCallStack):
error, called at libraries/template-haskell/Language/Haskell/TH/Syntax.hs:1203:22 in template-haskell:Language.Haskell.TH.Syntax
Code: (dataToPatQ (const Nothing) (fromList "test"))
• In the untyped splice:
$(dataToPatQ (const Nothing) (fromList "test"))
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