summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs58
-rw-r--r--libraries/template-haskell/changelog.md5
-rw-r--r--testsuite/tests/deriving/should_compile/T14682.stderr7
3 files changed, 66 insertions, 4 deletions
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 3ff6393794..7bff489650 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -200,12 +200,53 @@ instance Applicative Q where
-----------------------------------------------------
type role TExp nominal -- See Note [Role of TExp]
-newtype TExp a = TExp { unType :: Exp }
-
+newtype TExp a = TExp
+ { unType :: Exp -- ^ Underlying untyped Template Haskell expression
+ }
+-- ^ Represents an expression which has type @a@. Built on top of 'Exp', typed
+-- expressions allow for type-safe splicing via:
+--
+-- - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if
+-- that expression has type @a@, then the quotation has type
+-- @'Q' ('TExp' a)@
+--
+-- - typed splices inside of typed quotes, written as @$$(...)@ where @...@
+-- is an arbitrary expression of type @'Q' ('TExp' a)@
+--
+-- Traditional expression quotes and splices let us construct ill-typed
+-- expressions:
+--
+-- >>> fmap ppr $ runQ [| True == $( [| "foo" |] ) |]
+-- GHC.Types.True GHC.Classes.== "foo"
+-- >>> GHC.Types.True GHC.Classes.== "foo"
+-- <interactive> error:
+-- • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
+-- • In the second argument of ‘(==)’, namely ‘"foo"’
+-- In the expression: True == "foo"
+-- In an equation for ‘it’: it = True == "foo"
+--
+-- With typed expressions, the type error occurs when /constructing/ the
+-- Template Haskell expression:
+--
+-- >>> fmap ppr $ runQ [|| True == $$( [|| "foo" ||] ) ||]
+-- <interactive> error:
+-- • Couldn't match type ‘[Char]’ with ‘Bool’
+-- Expected type: Q (TExp Bool)
+-- Actual type: Q (TExp [Char])
+-- • In the Template Haskell quotation [|| "foo" ||]
+-- In the expression: [|| "foo" ||]
+-- In the Template Haskell splice $$([|| "foo" ||])
+
+-- | Discard the type annotation and produce a plain Template Haskell
+-- expression
unTypeQ :: Q (TExp a) -> Q Exp
unTypeQ m = do { TExp e <- m
; return e }
+-- | Annotate the Template Haskell expression with a type
+--
+-- This is unsafe because GHC cannot check for you that the expression
+-- really does have the type you claim it has.
unsafeTExpCoerce :: Q Exp -> Q (TExp a)
unsafeTExpCoerce m = do { e <- m
; return (TExp e) }
@@ -635,8 +676,17 @@ class Lift t where
-- | Turn a value into a Template Haskell expression, suitable for use in
-- a splice.
lift :: t -> Q Exp
- default lift :: Data t => t -> Q Exp
- lift = liftData
+ lift = unTypeQ . liftTyped
+
+ -- | Turn a value into a Template Haskell typed expression, suitable for use
+ -- in a typed splice.
+ --
+ -- @since 2.16.0.0
+ liftTyped :: t -> Q (TExp t)
+ liftTyped = unsafeTExpCoerce . lift
+
+ {-# MINIMAL lift | liftTyped #-}
+
-- If you add any instances here, consider updating test th/TH_Lift
instance Lift Integer where
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index b1444341d8..cfed120471 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -1,5 +1,10 @@
# Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
+## 2.16.0.0 *TBA*
+
+ * Introduce a `liftTyped` method to the `Lift` class and set the default
+ implementations of `lift`/`liftTyped` to be in terms of each other.
+
## 2.15.0.0 *TBA*
* In `Language.Haskell.TH.Syntax`, `DataInstD`, `NewTypeInstD`, `TySynEqn`,
diff --git a/testsuite/tests/deriving/should_compile/T14682.stderr b/testsuite/tests/deriving/should_compile/T14682.stderr
index ed44b3c2b1..75e9030bc7 100644
--- a/testsuite/tests/deriving/should_compile/T14682.stderr
+++ b/testsuite/tests/deriving/should_compile/T14682.stderr
@@ -98,6 +98,13 @@ GHC.Show.Show [T14682.Foo]
==================== Filling in method body ====================
+Language.Haskell.TH.Syntax.Lift [T14682.Foo]
+ Language.Haskell.TH.Syntax.liftTyped = Language.Haskell.TH.Syntax.$dmliftTyped
+ @(T14682.Foo)
+
+
+
+==================== Filling in method body ====================
Data.Data.Data [T14682.Foo]
Data.Data.dataCast1 = Data.Data.$dmdataCast1 @(T14682.Foo)