@@ -1,3 +1,7 @@
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+
15module Ether.TaggedTrans
26 ( TaggedTrans(..)
37 ) where
@@ -7,7 +11,7 @@ import Control.Monad (MonadPlus)
711import Control.Monad.Fix (MonadFix)
812import Control.Monad.Trans.Class (MonadTrans, lift)
913import Control.Monad.IO.Class (MonadIO)
10−import Control.Monad.Morph (MFunctor, MMonad)
14+import Control.Monad.Morph (MFunctor(..), MMonad(..))
1115import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
1216
1317import qualified Control.Monad.Base as MB
@@ -33,7 +37,7 @@ newtype TaggedTrans tag trans m a = TaggedTrans (trans m a)
3337 deriving
3438 ( Generic
3539 , Functor, Applicative, Alternative, Monad, MonadPlus
36− , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
40+ , MonadFix, MonadTrans, MonadIO
3741 , MonadThrow, MonadCatch, MonadMask )
3842
3943type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a
@@ -174,3 +178,29 @@ instance
174178 where
175179 throwError = lift . Mtl.throwError
176180 catchError = Lift.liftCatch Mtl.catchError
181+
182+type Hoist trans =
183+ forall m n b . Monad m =>
184+ (forall a . m a -> n a) -> trans m b -> trans n b
185+
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.
188+instance MFunctor trans => MFunctor (TaggedTrans tag trans) where
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.
201+instance MMonad trans => MMonad (TaggedTrans tag trans) where
202+ embed =
203+ coerce
204+ @(Embed trans)
205+ @(Embed (TaggedTrans tag trans))
206+ embed