Use a newtype `Code` for the return type of typed quotations (Proposal #195)wip/proposal-195

There are three problems with the current API:

1. It is hard to properly write instances for ``Quote m => m (TExp a)`` as the type is the composition
   of two type constructors. Doing so in your program involves making your own newtype and
   doing a lot of wrapping/unwrapping.

   For example, if I want to create a language which I can either run immediately or
   generate code from I could write the following with the new API. ::

      class Lang r where
        _int :: Int -> r Int
        _if  :: r Bool -> r a -> r a -> r a

      instance Lang Identity where
        _int = Identity
        _if (Identity b) (Identity t) (Identity f) = Identity (if b then t else f)

      instance Quote m => Lang (Code m) where
        _int = liftTyped
        _if cb ct cf = [|| if $$cb then $$ct else $$cf ||]

2. When doing code generation it is common to want to store code fragments in
   a map. When doing typed code generation, these code fragments contain a
   type index so it is desirable to store them in one of the parameterised
   map data types such as ``DMap`` from ``dependent-map`` or ``MapF`` from
   ``parameterized-utils``.

   ::

      compiler :: Env -> AST a -> Code Q a

      data AST a where ...
      data Ident a = ...

      type Env = MapF Ident (Code Q)

      newtype Code m a = Code (m (TExp a))

   In this example, the ``MapF`` maps an ``Ident String`` directly to a ``Code Q String``.
   Using one of these map types currently requires creating your own newtype and constantly
   wrapping every quotation and unwrapping it when using a splice. Achievable, but
   it creates even more syntactic noise than normal metaprogramming.

3. ``m (TExp a)`` is ugly to read and write, understanding ``Code m a`` is
   easier. This is a weak reason but one everyone
   can surely agree with.

Updates text submodule.

5 files changed, 132 insertions, 52 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs
index 36529e54dc..2da2bd61c6 100644
--- a/libraries/template-haskell/Language/Haskell/TH.hs
+++ b/libraries/template-haskell/Language/Haskell/TH.hs
@@ -50,6 +50,8 @@ module Language.Haskell.TH(
 
         -- * Typed expressions
         TExp, unType,
+        Code(..), unTypeCode, unsafeCodeCoerce, hoistCode, bindCode,
+        bindCode_, joinCode, liftCode,
 
         -- * Names
         Name, NameSpace,        -- Abstract
diff --git a/libraries/template-haskell/Language/Haskell/TH/CodeDo.hs b/libraries/template-haskell/Language/Haskell/TH/CodeDo.hs
new file mode 100644
index 0000000000..8e69a833fb
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/CodeDo.hs
@@ -0,0 +1,20 @@
+-- | This module exists to work nicely with the QualifiedDo
+-- extension.
+-- @
+-- import qualified Language.Haskell.TH.CodeDo as Code
+-- myExample :: Monad m => Code m a -> Code m a -> Code m a
+-- myExample opt1 opt2 =
+--   Code.do
+--    x <- someSideEffect               -- This one is of type `M Bool`
+--    if x then opt1 else opt2
+-- @
+module Language.Haskell.TH.CodeDo((>>=), (>>)) where
+
+import Language.Haskell.TH.Syntax
+import Prelude(Monad)
+
+-- | Module over monad operator for 'Code'
+(>>=) :: Monad m => m a -> (a -> Code m b) -> Code m b
+(>>=) = bindCode
+(>>) :: Monad m => m a -> Code m b -> Code m b
+(>>)  = bindCode_
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index 7aa4761321..505b9125bc 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -18,7 +18,7 @@ module Language.Haskell.TH.Lib (
 
     -- * Library functions
     -- ** Abbreviations
-        InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, KindQ,
+        InfoQ, ExpQ, TExpQ, CodeQ, DecQ, DecsQ, ConQ, TypeQ, KindQ,
         TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,
         StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,
         BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
index c93cc6c3a8..cb19882a97 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -31,6 +31,7 @@ type PatQ                = Q Pat
 type FieldPatQ           = Q FieldPat
 type ExpQ                = Q Exp
 type TExpQ a             = Q (TExp a)
+type CodeQ               = Code Q
 type DecQ                = Q Dec
 type DecsQ               = Q [Dec]
 type Decs                = [Dec] -- Defined as it is more convenient to wire-in
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index a894ce8378..dac97c641f 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -374,6 +374,63 @@ be inferred (#8459).  Consider
 The splice will evaluate to (MkAge 3) and you can't add that to
 4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}
 
+-- Code constructor
+
+type role Code representational nominal   -- See Note [Role of TExp]
+newtype Code m (a :: TYPE (r :: RuntimeRep)) = Code
+  { examineCode :: m (TExp a) -- ^ Underlying monadic value
+  }
+
+-- | Unsafely convert an untyped code representation into a typed code
+-- representation.
+unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
+                      Quote m => m Exp -> Code m a
+unsafeCodeCoerce m = Code (unsafeTExpCoerce m)
+
+-- | Lift a monadic action producing code into the typed 'Code'
+-- representation
+liftCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . m (TExp a) -> Code m a
+liftCode = Code
+
+-- | Extract the untyped representation from the typed representation
+unTypeCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m
+           => Code m a -> m Exp
+unTypeCode = unTypeQ . examineCode
+
+-- | Modify the ambient monad used during code generation. For example, you
+-- can use `hoistCode` to handle a state effect:
+-- @
+--  handleState :: Code (StateT Int Q) a -> Code Q a
+--  handleState = hoistCode (flip runState 0)
+-- @
+hoistCode :: forall m n (r :: RuntimeRep) (a :: TYPE r) . Monad m
+          => (forall x . m x -> n x) -> Code m a -> Code n a
+hoistCode f (Code a) = Code (f a)
+
+
+-- | Variant of (>>=) which allows effectful computations to be injected
+-- into code generation.
+bindCode :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
+         => m a -> (a -> Code m b) -> Code m b
+bindCode q k = liftCode (q >>= examineCode . k)
+
+-- | Variant of (>>) which allows effectful computations to be injected
+-- into code generation.
+bindCode_ :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
+          => m a -> Code m b -> Code m b
+bindCode_ q c = liftCode ( q >> examineCode c)
+
+-- | A useful combinator for embedding monadic actions into 'Code'
+-- @
+-- myCode :: ... => Code m a
+-- myCode = joinCode $ do
+--   x <- someSideEffect
+--   return (makeCodeWith x)
+-- @
+joinCode :: forall m (r :: RuntimeRep) (a :: TYPE r) . Monad m
+         => m (Code m a) -> Code m a
+joinCode = flip bindCode id
+
 ----------------------------------------------------
 -- Packaged versions for the programmer, hiding the Quasi-ness
 
@@ -758,107 +815,107 @@ class Lift (t :: TYPE r) where
   -- a splice.
   lift :: Quote m => t -> m Exp
   default lift :: (r ~ 'LiftedRep, Quote m) => t -> m Exp
-  lift = unTypeQ . liftTyped
+  lift = unTypeCode . liftTyped
 
   -- | Turn a value into a Template Haskell typed expression, suitable for use
   -- in a typed splice.
   --
   -- @since 2.16.0.0
-  liftTyped :: Quote m => t -> m (TExp t)
+  liftTyped :: Quote m => t -> Code m t
 
 
 -- If you add any instances here, consider updating test th/TH_Lift
 instance Lift Integer where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL x))
 
 instance Lift Int where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 -- | @since 2.16.0.0
 instance Lift Int# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntPrimL (fromIntegral (I# x))))
 
 instance Lift Int8 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Int16 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Int32 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Int64 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 -- | @since 2.16.0.0
 instance Lift Word# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (WordPrimL (fromIntegral (W# x))))
 
 instance Lift Word where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Word8 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Word16 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Word32 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Word64 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Natural where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Integral a => Lift (Ratio a) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (RationalL (toRational x)))
 
 instance Lift Float where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (RationalL (toRational x)))
 
 -- | @since 2.16.0.0
 instance Lift Float# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (FloatPrimL (toRational (F# x))))
 
 instance Lift Double where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (RationalL (toRational x)))
 
 -- | @since 2.16.0.0
 instance Lift Double# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (DoublePrimL (toRational (D# x))))
 
 instance Lift Char where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (CharL x))
 
 -- | @since 2.16.0.0
 instance Lift Char# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (CharPrimL (C# x)))
 
 instance Lift Bool where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
 
   lift True  = return (ConE trueName)
   lift False = return (ConE falseName)
@@ -868,24 +925,24 @@ instance Lift Bool where
 --
 -- @since 2.16.0.0
 instance Lift Addr# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = return (LitE (StringPrimL (map (fromIntegral . ord) (unpackCString# x))))
 
 instance Lift a => Lift (Maybe a) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
 
   lift Nothing  = return (ConE nothingName)
   lift (Just x) = liftM (ConE justName `AppE`) (lift x)
 
 instance (Lift a, Lift b) => Lift (Either a b) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
 
   lift (Left x)  = liftM (ConE leftName  `AppE`) (lift x)
   lift (Right y) = liftM (ConE rightName `AppE`) (lift y)
 
 instance Lift a => Lift [a] where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
 
 liftString :: Quote m => String -> m Exp
@@ -894,7 +951,7 @@ liftString s = return (LitE (StringL s))
 
 -- | @since 2.15.0.0
 instance Lift a => Lift (NonEmpty a) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
 
   lift (x :| xs) = do
     x' <- lift x
@@ -903,77 +960,77 @@ instance Lift a => Lift (NonEmpty a) where
 
 -- | @since 2.15.0.0
 instance Lift Void where
-  liftTyped = pure . absurd
+  liftTyped = liftCode . absurd
   lift = pure . absurd
 
 instance Lift () where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift () = return (ConE (tupleDataName 0))
 
 instance (Lift a, Lift b) => Lift (a, b) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b)
     = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b]
 
 instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b, c)
     = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c]
 
 instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b, c, d)
     = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c, lift d]
 
 instance (Lift a, Lift b, Lift c, Lift d, Lift e)
       => Lift (a, b, c, d, e) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b, c, d, e)
     = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b
                                               , lift c, lift d, lift e ]
 
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
       => Lift (a, b, c, d, e, f) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b, c, d, e, f)
     = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
                                               , lift d, lift e, lift f ]
 
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
       => Lift (a, b, c, d, e, f, g) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b, c, d, e, f, g)
     = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
                                               , lift d, lift e, lift f, lift g ]
 
 -- | @since 2.16.0.0
 instance Lift (# #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# #) = return (ConE (unboxedTupleTypeName 0))
 
 -- | @since 2.16.0.0
 instance (Lift a) => Lift (# a #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a]
 
 -- | @since 2.16.0.0
 instance (Lift a, Lift b) => Lift (# a, b #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b]
 
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c)
       => Lift (# a, b, c #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b, c #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b, lift c]
 
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d)
       => Lift (# a, b, c, d #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b, c, d #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b
                                                      , lift c, lift d ]
@@ -981,7 +1038,7 @@ instance (Lift a, Lift b, Lift c, Lift d)
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e)
       => Lift (# a, b, c, d, e #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b, c, d, e #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b
                                                      , lift c, lift d, lift e ]
@@ -989,7 +1046,7 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e)
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
       => Lift (# a, b, c, d, e, f #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b, c, d, e, f #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
                                                      , lift d, lift e, lift f ]
@@ -997,7 +1054,7 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
       => Lift (# a, b, c, d, e, f, g #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b, c, d, e, f, g #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
                                                      , lift d, lift e, lift f
@@ -1005,7 +1062,7 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
 
 -- | @since 2.16.0.0
 instance (Lift a, Lift b) => Lift (# a | b #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 2
@@ -1014,7 +1071,7 @@ instance (Lift a, Lift b) => Lift (# a | b #) where
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c)
       => Lift (# a | b | c #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 3
@@ -1024,7 +1081,7 @@ instance (Lift a, Lift b, Lift c)
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d)
       => Lift (# a | b | c | d #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 4
@@ -1035,7 +1092,7 @@ instance (Lift a, Lift b, Lift c, Lift d)
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e)
       => Lift (# a | b | c | d | e #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 5
@@ -1047,7 +1104,7 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e)
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
       => Lift (# a | b | c | d | e | f #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 6
@@ -1060,7 +1117,7 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
       => Lift (# a | b | c | d | e | f | g #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 7