@@ -1,4 +1,7 @@
1−{-# LANGUAGE CPP #-}
1+-- The use of ImpredicativeTypes here is safe, see discussion under GitHub issue
2+-- #35. It's only needed to allow the visible type application of a polytype.
3+{-# LANGUAGE ImpredicativeTypes #-}
4+
25module Ether.TaggedTrans
36 ( TaggedTrans(..)
47 ) where
@@ -30,17 +33,11 @@ import qualified Control.Monad.Error.Class as Mtl
3033import GHC.Generics (Generic)
3134import Data.Coerce (coerce)
3235
33−#define TRAC_11837_PRESENT \
34− __GLASGOW_HASKELL__ == 800 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1
35−
3636newtype TaggedTrans tag trans m a = TaggedTrans (trans m a)
3737 deriving
3838 ( Generic
3939 , Functor, Applicative, Alternative, Monad, MonadPlus
4040 , MonadFix, MonadTrans, MonadIO
41−#if !(TRAC_11837_PRESENT)
42− , MFunctor, MMonad
43−#endif
4441 , MonadThrow, MonadCatch, MonadMask )
4542
4643type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a
@@ -182,15 +179,28 @@ instance
182179 throwError = lift . Mtl.throwError
183180 catchError = Lift.liftCatch Mtl.catchError
184181
185−#if TRAC_11837_PRESENT
186−-- NB: Don't use GeneralizedNewtypeDeriving to create these instances on
187−-- GHC 8.0.1, as they will trigger GHC Trac #11837
182+type Hoist trans =
183+ forall m n b . Monad m =>
184+ (forall a . m a -> n a) -> trans m b -> trans n b
188185
186+-- NB: Don't use GeneralizedNewtypeDeriving to create this instance, as it will
187+-- trigger GHC Trac #11837 on GHC 8.0.1 and older.
189188instance MFunctor trans => MFunctor (TaggedTrans tag trans) where
190− hoist f (TaggedTrans t) = TaggedTrans (hoist f t)
191−
189+ hoist =
190+ coerce
191+ @(Hoist trans)
192+ @(Hoist (TaggedTrans tag trans))
193+ hoist
194+
195+type Embed trans =
196+ forall n m b . Monad n =>
197+ (forall a . m a -> trans n a) -> trans m b -> trans n b
198+
199+-- NB: Don't use GeneralizedNewtypeDeriving to create this instance, as it will
200+-- trigger GHC Trac #11837 on GHC 8.0.1 and older.
192201instance MMonad trans => MMonad (TaggedTrans tag trans) where
193− embed f (TaggedTrans t) = TaggedTrans (embed (runTaggedTrans . f) t)
194− where
195− runTaggedTrans (TaggedTrans x) = x
196−#endif
202+ embed =
203+ coerce
204+ @(Embed trans)
205+ @(Embed (TaggedTrans tag trans))
206+ embed