diff options
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 58 | ||||
| -rw-r--r-- | libraries/template-haskell/changelog.md | 5 | ||||
| -rw-r--r-- | testsuite/tests/deriving/should_compile/T14682.stderr | 7 |
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) |