git.iko.soy/typeable/ether
on master help sign in
Merge branch 'master' into mod-split
f9bd91aVladislav Zavialov
src/Ether/TaggedTrans.hs+32−2
compare with master
unifiedsplit
@@ -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+
1module Ether.TaggedTrans
5module Ether.TaggedTrans
2 ( TaggedTrans(..)
6 ( TaggedTrans(..)
3 ) where
7 ) where
@@ -7,7 +11,7 @@ import Control.Monad (MonadPlus)
7import Control.Monad.Fix (MonadFix)
11import Control.Monad.Fix (MonadFix)
8import Control.Monad.Trans.Class (MonadTrans, lift)
12import Control.Monad.Trans.Class (MonadTrans, lift)
9import Control.Monad.IO.Class (MonadIO)
13import Control.Monad.IO.Class (MonadIO)
10−import Control.Monad.Morph (MFunctor, MMonad)
14+import Control.Monad.Morph (MFunctor(..), MMonad(..))
11import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
15import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
12
16
13import qualified Control.Monad.Base as MB
17import qualified Control.Monad.Base as MB
@@ -33,7 +37,7 @@ newtype TaggedTrans tag trans m a = TaggedTrans (trans m a)
33 deriving
37 deriving
34 ( Generic
38 ( Generic
35 , Functor, Applicative, Alternative, Monad, MonadPlus
39 , Functor, Applicative, Alternative, Monad, MonadPlus
36− , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
40+ , MonadFix, MonadTrans, MonadIO
37 , MonadThrow, MonadCatch, MonadMask )
41 , MonadThrow, MonadCatch, MonadMask )
38
42
39type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a
43type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a
@@ -174,3 +178,29 @@ instance
174 where
178 where
175 throwError = lift . Mtl.throwError
179 throwError = lift . Mtl.throwError
176 catchError = Lift.liftCatch Mtl.catchError
180 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
stack.yaml+4−1
@@ -1,2 +1,5 @@
1−resolver: nightly-2017-05-17
1+resolver: lts-7.23
2packages: ['.']
2packages: ['.']
3+extra-deps:
4+- transformers-lift-0.2.0.1
5+- mmorph-1.1.0