mmorph 1.0.5 → 1.0.6
raw patch · 3 files changed
+50/−15 lines, 3 filesdep +mtldep +transformers-compat
Dependencies added: mtl, transformers-compat
Files
- mmorph.cabal +5/−3
- src/Control/Monad/Morph.hs +1/−11
- src/Control/Monad/Trans/Compose.hs +44/−1
mmorph.cabal view
@@ -1,5 +1,5 @@ Name: mmorph-Version: 1.0.5+Version: 1.0.6 Cabal-Version: >= 1.8.0.2 Build-Type: Simple License: BSD3@@ -19,7 +19,9 @@ Library Hs-Source-Dirs: src Build-Depends:- base >= 4 && < 5 ,- transformers >= 0.2.0.0 && < 0.6+ base >= 4 && < 5 ,+ mtl >= 2.0.1 && < 2.3,+ transformers >= 0.2.0.0 && < 0.6,+ transformers-compat >= 0.3 && < 0.6 Exposed-Modules: Control.Monad.Morph, Control.Monad.Trans.Compose GHC-Options: -O2
src/Control/Monad/Morph.hs view
@@ -74,9 +74,7 @@ import Control.Monad.Trans.Class (MonadTrans(lift)) import qualified Control.Monad.Trans.Error as E-#if MIN_VERSION_transformers(0,4,0)-import qualified Control.Monad.Trans.Except as Ex-#endif+import qualified Control.Monad.Trans.Except as Ex import qualified Control.Monad.Trans.Identity as I import qualified Control.Monad.Trans.List as L import qualified Control.Monad.Trans.Maybe as M@@ -91,10 +89,8 @@ import Data.Functor.Compose (Compose (Compose)) import Data.Functor.Identity (runIdentity) import Data.Functor.Product (Product (Pair))-#if MIN_VERSION_transformers(0,3,0) import Control.Applicative.Backwards (Backwards (Backwards)) import Control.Applicative.Lift (Lift (Pure, Other))-#endif -- For documentation import Control.Exception (try, IOException)@@ -116,10 +112,8 @@ instance MFunctor (E.ErrorT e) where hoist nat m = E.ErrorT (nat (E.runErrorT m)) -#if MIN_VERSION_transformers(0,4,0) instance MFunctor (Ex.ExceptT e) where hoist nat m = Ex.ExceptT (nat (Ex.runExceptT m))-#endif instance MFunctor I.IdentityT where hoist nat m = I.IdentityT (nat (I.runIdentityT m))@@ -157,14 +151,12 @@ instance MFunctor (Product f) where hoist nat (Pair f g) = Pair f (nat g) -#if MIN_VERSION_transformers(0,3,0) instance MFunctor Backwards where hoist nat (Backwards f) = Backwards (nat f) instance MFunctor Lift where hoist _ (Pure a) = Pure a hoist nat (Other f) = Other (nat f)-#endif -- | A function that @generalize@s the 'Identity' base monad to be any monad. generalize :: Monad m => Identity a -> m a@@ -246,7 +238,6 @@ Right (Left e) -> Left e Right (Right a) -> Right a ) ) -#if MIN_VERSION_transformers(0,4,0) instance MMonad (Ex.ExceptT e) where embed f m = Ex.ExceptT (do x <- Ex.runExceptT (f (Ex.runExceptT m))@@ -254,7 +245,6 @@ Left e -> Left e Right (Left e) -> Left e Right (Right a) -> Right a ) )-#endif instance MMonad I.IdentityT where embed f m = f (I.runIdentityT m)
src/Control/Monad/Trans/Compose.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleContexts, KindSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-} {-| Composition of monad transformers. A higher-order version of "Data.Functor.Compose".@@ -7,21 +11,31 @@ module Control.Monad.Trans.Compose ( -- * ComposeT ComposeT(ComposeT, getComposeT),+ mapComposeT ) where import Control.Applicative ( Applicative(pure, (<*>), (*>), (<*)), Alternative(empty, (<|>)) ) import Control.Monad (MonadPlus(mzero, mplus), liftM)+import Control.Monad.Cont.Class (MonadCont(callCC))+import Control.Monad.Error.Class (MonadError(throwError, catchError)) import Control.Monad.Morph (MFunctor(hoist))+import Control.Monad.RWS.Class (MonadRWS)+import Control.Monad.Reader.Class (MonadReader(ask, local, reader))+import Control.Monad.State.Class (MonadState(get, put, state)) import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.Monad.Writer.Class (MonadWriter(writer, tell, listen, pass)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.Foldable (Foldable(fold, foldMap, foldr, foldl, foldr1, foldl1)) import Data.Traversable (Traversable(traverse, sequenceA, mapM, sequence)) import Prelude hiding (foldr, foldl, foldr1, foldl1, mapM, sequence) +infixr 9 `ComposeT`+ -- | Composition of monad transformers. newtype ComposeT (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *) m a = ComposeT { getComposeT :: f (g m) a }+ deriving (Eq, Ord, Read, Show) instance (MFunctor f, MonadTrans f, MonadTrans g) => MonadTrans (ComposeT f g) where@@ -65,3 +79,32 @@ sequenceA (ComposeT m) = fmap ComposeT (sequenceA m) mapM f (ComposeT m) = liftM ComposeT (mapM f m) sequence (ComposeT m) = liftM ComposeT (sequence m)++instance MonadCont (f (g m)) => MonadCont (ComposeT f g m) where+ callCC f = ComposeT $ callCC $ \c -> getComposeT (f (ComposeT . c))++instance MonadError e (f (g m)) => MonadError e (ComposeT f g m) where+ throwError = ComposeT . throwError+ catchError m h = ComposeT $ catchError (getComposeT m) (getComposeT . h)++instance MonadRWS r w s (f (g m)) => MonadRWS r w s (ComposeT f g m)++instance MonadReader r (f (g m)) => MonadReader r (ComposeT f g m) where+ ask = ComposeT ask+ local = mapComposeT . local+ reader = ComposeT . reader++instance MonadState s (f (g m)) => MonadState s (ComposeT f g m) where+ get = ComposeT get+ put = ComposeT . put+ state = ComposeT . state++instance MonadWriter w (f (g m)) => MonadWriter w (ComposeT f g m) where+ writer = ComposeT . writer+ tell = ComposeT . tell+ listen = mapComposeT listen+ pass = mapComposeT pass++-- | Transform the computation inside a 'ComposeT'.+mapComposeT :: (f (g m) a -> p (q n) b) -> ComposeT f g m a -> ComposeT p q n b+mapComposeT f = ComposeT . f . getComposeT