Hello community, here is the log from the commit of package ghc-mmorph for openSUSE:Factory checked in at 2015-05-13 07:13:17 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-mmorph (Old) and /work/SRC/openSUSE:Factory/.ghc-mmorph.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-mmorph" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-mmorph/ghc-mmorph.changes 2014-04-02 17:19:06.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-mmorph.new/ghc-mmorph.changes 2015-05-13 07:13:19.000000000 +0200 @@ -1,0 +2,5 @@ +Tue Apr 21 19:48:50 UTC 2015 - [email protected] + +- update to 1.0.4 + +------------------------------------------------------------------- Old: ---- _service mmorph-1.0.0.tar.gz New: ---- mmorph-1.0.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-mmorph.spec ++++++ --- /var/tmp/diff_new_pack.fEPgpe/_old 2015-05-13 07:13:19.000000000 +0200 +++ /var/tmp/diff_new_pack.fEPgpe/_new 2015-05-13 07:13:19.000000000 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-mmorph # -# Copyright (c) 2013 SUSE LINUX Products GmbH, Nuernberg, Germany. +# Copyright (c) 2015 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name mmorph Name: ghc-mmorph -Version: 1.0.0 +Version: 1.0.4 Release: 0 Summary: Monad morphisms License: BSD-3-Clause ++++++ mmorph-1.0.0.tar.gz -> mmorph-1.0.4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mmorph-1.0.0/Control/Monad/Morph.hs new/mmorph-1.0.4/Control/Monad/Morph.hs --- old/mmorph-1.0.0/Control/Monad/Morph.hs 2013-03-16 06:08:18.000000000 +0100 +++ new/mmorph-1.0.4/Control/Monad/Morph.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,424 +0,0 @@ -{-| A monad morphism is a natural transformation: - -> morph :: forall a . m a -> n a - - ... that obeys the following two laws: - -> morph $ do x <- m = do x <- morph m -> f x morph (f x) -> -> morph (return x) = return x - - ... which are equivalent to the following two functor laws: - -> morph . (f >=> g) = morph . f >=> morph . g -> -> morph . return = return - - Examples of monad morphisms include: - - * 'lift' (from 'MonadTrans') - - * 'squash' (See below) - - * @'hoist' f@ (See below), if @f@ is a monad morphism - - * @(f . g)@, if @f@ and @g@ are both monad morphisms - - * 'id' - - Monad morphisms commonly arise when manipulating existing monad transformer - code for compatibility purposes. The 'MFunctor', 'MonadTrans', and - 'MMonad' classes define standard ways to change monad transformer stacks: - - * 'lift' introduces a new monad transformer layer of any type. - - * 'squash' flattens two identical monad transformer layers into a single - layer of the same type. - - * 'hoist' maps monad morphisms to modify deeper layers of the monad - transformer stack. - --} - -{-# LANGUAGE Rank2Types #-} - -module Control.Monad.Morph ( - -- * Functors over Monads - MFunctor(..), - -- * Monads over Monads - MMonad(..), - MonadTrans(lift), - squash, - (>|>), - (<|<), - (=<|), - (|>=) - - -- * Tutorial - -- $tutorial - - -- ** Generalizing base monads - -- $generalize - - -- ** Monad morphisms - -- $mmorph - - -- ** Mixing diverse transformers - -- $interleave - - -- ** Embedding transformers - -- $embed - ) where - -import Control.Monad.Trans.Class (MonadTrans(lift)) -import qualified Control.Monad.Trans.Error as E -import qualified Control.Monad.Trans.Identity as I -import qualified Control.Monad.Trans.Maybe as M -import qualified Control.Monad.Trans.Reader as R -import qualified Control.Monad.Trans.RWS.Lazy as RWS -import qualified Control.Monad.Trans.RWS.Strict as RWS' -import qualified Control.Monad.Trans.State.Lazy as S -import qualified Control.Monad.Trans.State.Strict as S' -import qualified Control.Monad.Trans.Writer.Lazy as W' -import qualified Control.Monad.Trans.Writer.Strict as W -import Data.Monoid (Monoid, mappend) - --- For documentation -import Control.Exception (try, IOException) -import Control.Monad ((=<<), (>=>), (<=<), join) -import Data.Functor.Identity (Identity) - -{-| A functor in the category of monads, using 'hoist' as the analog of 'fmap': - -> hoist (f . g) = hoist f . hoist g -> -> hoist id = id --} -class MFunctor t where - {-| Lift a monad morphism from @m@ to @n@ into a monad morphism from - @(t m)@ to @(t n)@ - -} - hoist :: (Monad m) => (forall a . m a -> n a) -> t m b -> t n b - -instance MFunctor (E.ErrorT e) where - hoist nat m = E.ErrorT (nat (E.runErrorT m)) - -instance MFunctor I.IdentityT where - hoist nat m = I.IdentityT (nat (I.runIdentityT m)) - -instance MFunctor M.MaybeT where - hoist nat m = M.MaybeT (nat (M.runMaybeT m)) - -instance MFunctor (R.ReaderT r) where - hoist nat m = R.ReaderT (\i -> nat (R.runReaderT m i)) - -instance MFunctor (RWS.RWST r w s) where - hoist nat m = RWS.RWST (\r s -> nat (RWS.runRWST m r s)) - -instance MFunctor (RWS'.RWST r w s) where - hoist nat m = RWS'.RWST (\r s -> nat (RWS'.runRWST m r s)) - -instance MFunctor (S.StateT s) where - hoist nat m = S.StateT (\s -> nat (S.runStateT m s)) - -instance MFunctor (S'.StateT s) where - hoist nat m = S'.StateT (\s -> nat (S'.runStateT m s)) - -instance MFunctor (W.WriterT w) where - hoist nat m = W.WriterT (nat (W.runWriterT m)) - -instance MFunctor (W'.WriterT w) where - hoist nat m = W'.WriterT (nat (W'.runWriterT m)) - -{-| A monad in the category of monads, using 'lift' from 'MonadTrans' as the - analog of 'return' and 'embed' as the analog of ('=<<'): - -> embed lift = id -> -> embed f (lift m) = f m -> -> embed g (embed f t) = embed (\m -> embed g (f m)) t --} -class (MFunctor t, MonadTrans t) => MMonad t where - {-| Embed a newly created 'MMonad' layer within an existing layer - - 'embed' is analogous to ('=<<') - -} - embed :: (Monad n) => (forall a . m a -> t n a) -> t m b -> t n b - -{-| Squash two 'MMonad' layers into a single layer - - 'squash' is analogous to 'join' --} -squash :: (Monad m, MMonad t) => t (t m) a -> t m a -squash = embed id -{-# INLINABLE squash #-} - -infixr 2 >|>, =<| -infixl 2 <|<, |>= - -{-| Compose two 'MMonad' layer-building functions - - ('>|>') is analogous to ('>=>') --} -(>|>) - :: (Monad m3, MMonad t) - => (forall a . m1 a -> t m2 a) - -> (forall b . m2 b -> t m3 b) - -> m1 c -> t m3 c -(f >|> g) m = embed g (f m) -{-# INLINABLE (>|>) #-} - -{-| Equivalent to ('>|>') with the arguments flipped - - ('<|<') is analogous to ('<=<') --} -(<|<) - :: (Monad m3, MMonad t) - => (forall b . m2 b -> t m3 b) - -> (forall a . m1 a -> t m2 a) - -> m1 c -> t m3 c -(g <|< f) m = embed g (f m) -{-# INLINABLE (<|<) #-} - -{-| An infix operator equivalent to 'embed' - - ('=<|') is analogous to ('=<<') --} -(=<|) :: (Monad n, MMonad t) => (forall a . m a -> t n a) -> t m b -> t n b -(=<|) = embed -{-# INLINABLE (=<|) #-} - -{-| Equivalent to ('=<|') with the arguments flipped - - ('|>=') is analogous to ('>>=') --} -(|>=) :: (Monad n, MMonad t) => t m b -> (forall a . m a -> t n a) -> t n b -t |>= f = embed f t -{-# INLINABLE (|>=) #-} - -instance (E.Error e) => MMonad (E.ErrorT e) where - embed f m = E.ErrorT (do - x <- E.runErrorT (f (E.runErrorT m)) - return (case x of - Left e -> Left e - Right (Left e) -> Left e - Right (Right a) -> Right a ) ) - -instance MMonad I.IdentityT where - embed f m = f (I.runIdentityT m) - -instance MMonad M.MaybeT where - embed f m = M.MaybeT (do - x <- M.runMaybeT (f (M.runMaybeT m)) - return (case x of - Nothing -> Nothing - Just Nothing -> Nothing - Just (Just a) -> Just a ) ) - -instance MMonad (R.ReaderT r) where - embed f m = R.ReaderT (\i -> R.runReaderT (f (R.runReaderT m i)) i) - -instance (Monoid w) => MMonad (W.WriterT w) where - embed f m = W.WriterT (do - ~((a, w1), w2) <- W.runWriterT (f (W.runWriterT m)) - return (a, mappend w1 w2) ) - -instance (Monoid w) => MMonad (W'.WriterT w) where - embed f m = W'.WriterT (do - ((a, w1), w2) <- W'.runWriterT (f (W'.runWriterT m)) - return (a, mappend w1 w2) ) - -{- $tutorial - Monad morphisms solve the common problem of fixing monadic code after the - fact without modifying the original source code or type signatures. The - following sections illustrate various examples of transparently modifying - existing functions. --} - -{- $generalize - Imagine that some library provided the following 'S.State' code: - -> import Control.Monad.Trans.State -> -> tick :: State Int () -> tick = modify (+1) - - ... but we would prefer to reuse @tick@ within a larger - @('S.StateT' Int 'IO')@ block in order to mix in 'IO' actions. - - We could patch the original library to generalize @tick@'s type signature: - -> tick :: (Monad m) => StateT Int m () - - ... but we would prefer not to fork upstream code if possible. How could - we generalize @tick@'s type without modifying the original code? - - We can solve this if we realize that 'S.State' is a type synonym for - 'S.StateT' with an 'Identity' base monad: - -> type State s = StateT s Identity - - ... which means that @tick@'s true type is actually: - -> tick :: StateT Int Identity () - - Now all we need is a function that @generalize@s the 'Identity' base monad - to be any monad: - -> import Data.Functor.Identity -> -> generalize :: (Monad m) => Identity a -> m a -> generalize m = return (runIdentity m) - - ... which we can 'hoist' to change @tick@'s base monad: - -> hoist :: (Monad m, MFunctor t) => (forall a . m a -> n a) -> t m b -> t n b -> -> hoist generalize :: (Monad m, MFunctor t) => t Identity b -> t m b -> -> hoist generalize tick :: (Monad m) => StateT Int m () - - This lets us mix @tick@ alongside 'IO' using 'lift': - -> import Control.Monad.Morph -> import Control.Monad.Trans.Class -> -> tock :: StateT Int IO () -> tock = do -> hoist generalize tick :: (Monad m) => StateT Int m () -> lift $ putStrLn "Tock!" :: (MonadTrans t) => t IO () - ->>> runStateT tock 0 -Tock! -((), 1) - --} - -{- $mmorph - Notice that @generalize@ is a monad morphism, and the following two proofs - show how @generalize@ satisfies the monad morphism laws. You can refer to - these proofs as an example for how to prove a function obeys the monad - morphism laws: - -> generalize (return x) -> -> -- Definition of 'return' for the Identity monad -> = generalize (Identity x) -> -> -- Definition of 'generalize' -> = return (runIdentity (Identity x)) -> -> -- runIdentity (Identity x) = x -> = return x - -> generalize $ do x <- m -> f x -> -> -- Definition of (>>=) for the Identity monad -> = generalize (f (runIdentity m)) -> -> -- Definition of 'generalize' -> = return (runIdentity (f (runIdentity m))) -> -> -- Monad law: Left identity -> = do x <- return (runIdentity m) -> return (runIdentity (f x)) -> -> -- Definition of 'generalize' in reverse -> = do x <- generalize m -> generalize (f x) --} - -{- $interleave - You can combine 'hoist' and 'lift' to insert arbitrary layers anywhere - within a monad transformer stack. This comes in handy when interleaving two - diverse stacks. - - For example, we might want to combine the following @save@ function: - -> import Control.Monad.Trans.Writer -> -> -- i.e. :: StateT Int (WriterT [Int] Identity) () -> save :: StateT Int (Writer [Int]) () -> save = do -> n <- get -> lift $ tell [n] - - ... with our previous @tock@ function: - -> tock :: StateT Int IO () - - However, @save@ and @tock@ differ in two ways: - - * @tock@ lacks a 'W.WriterT' layer - - * @save@ has an 'Identity' base monad - - We can mix the two by inserting a 'W.WriterT' layer for @tock@ and - generalizing @save@'s base monad: - -> import Control.Monad -> -> program :: StateT Int (WriterT [Int] IO) () -> program = replicateM_ 4 $ do -> hoist lift tock -> :: (MonadTrans t) => StateT Int (t IO) () -> hoist (hoist generalize) save -> :: (Monad m) => StateT Int (WriterT [Int] m ) () - ->>> execWriterT (runStateT program 0) -Tock! -Tock! -Tock! -Tock! -[1,2,3,4] - --} - -{- $embed - Suppose we decided to @check@ all 'IOException's using a combination of - 'try' and 'ErrorT': - -> import Control.Exception -> import Control.Monad.Trans.Class -> import Control.Monad.Trans.Error -> -> check :: IO a -> ErrorT IOException IO a -> check io = ErrorT (try io) - - ... but then we forget to use @check@ in one spot, mistakenly using 'lift' - instead: - -> program :: ErrorT IOException IO () -> program = do -> str <- lift $ readFile "test.txt" -> check $ putStr str - ->>> runErrorT program -*** Exception: test.txt: openFile: does not exist (No such file or directory) - - How could we go back and fix 'program' without modifying its source code? - - Well, @check@ is a monad morphism, but we can't 'hoist' it to modify the - base monad because then we get two 'E.ErrorT' layers instead of one: - -> hoist check :: (MFunctor t) => t IO a -> t (ErrorT IOException IO) a -> -> hoist check program :: ErrorT IOException (ErrorT IOException IO) () - - We'd prefer to 'embed' all newly generated exceptions in the existing - 'E.ErrorT' layer: - -> embed check :: ErrorT IOException IO a -> ErrorT IOException IO a -> -> embed check program :: ErrorT IOException IO () - - This correctly checks the exceptions that slipped through the cracks: - ->>> import Control.Monad.Morph ->>> runErrorT (embed check program) -Left test.txt: openFile: does not exist (No such file or directory) - --} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mmorph-1.0.0/mmorph.cabal new/mmorph-1.0.4/mmorph.cabal --- old/mmorph-1.0.0/mmorph.cabal 2013-03-16 06:08:18.000000000 +0100 +++ new/mmorph-1.0.4/mmorph.cabal 2014-08-28 06:04:28.000000000 +0200 @@ -1,5 +1,5 @@ Name: mmorph -Version: 1.0.0 +Version: 1.0.4 Cabal-Version: >= 1.8.0.2 Build-Type: Simple License: BSD3 @@ -17,8 +17,9 @@ Location: https://github.com/Gabriel439/Haskell-MMorph-Library Library + Hs-Source-Dirs: src Build-Depends: base >= 4 && < 5 , - transformers >= 0.2.0.0 && < 0.4 - Exposed-Modules: Control.Monad.Morph + transformers >= 0.2.0.0 && < 0.5 + Exposed-Modules: Control.Monad.Morph, Control.Monad.Trans.Compose GHC-Options: -O2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mmorph-1.0.0/src/Control/Monad/Morph.hs new/mmorph-1.0.4/src/Control/Monad/Morph.hs --- old/mmorph-1.0.0/src/Control/Monad/Morph.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/mmorph-1.0.4/src/Control/Monad/Morph.hs 2014-08-28 06:04:28.000000000 +0200 @@ -0,0 +1,479 @@ +{-# LANGUAGE CPP, RankNTypes #-} + +{-| A monad morphism is a natural transformation: + +> morph :: forall a . m a -> n a + + ... that obeys the following two laws: + +> morph $ do x <- m = do x <- morph m +> f x morph (f x) +> +> morph (return x) = return x + + ... which are equivalent to the following two functor laws: + +> morph . (f >=> g) = morph . f >=> morph . g +> +> morph . return = return + + Examples of monad morphisms include: + + * 'lift' (from 'MonadTrans') + + * 'squash' (See below) + + * @'hoist' f@ (See below), if @f@ is a monad morphism + + * @(f . g)@, if @f@ and @g@ are both monad morphisms + + * 'id' + + Monad morphisms commonly arise when manipulating existing monad transformer + code for compatibility purposes. The 'MFunctor', 'MonadTrans', and + 'MMonad' classes define standard ways to change monad transformer stacks: + + * 'lift' introduces a new monad transformer layer of any type. + + * 'squash' flattens two identical monad transformer layers into a single + layer of the same type. + + * 'hoist' maps monad morphisms to modify deeper layers of the monad + transformer stack. + +-} + +module Control.Monad.Morph ( + -- * Functors over Monads + MFunctor(..), + generalize, + -- * Monads over Monads + MMonad(..), + MonadTrans(lift), + squash, + (>|>), + (<|<), + (=<|), + (|>=) + + -- * Tutorial + -- $tutorial + + -- ** Generalizing base monads + -- $generalize + + -- ** Monad morphisms + -- $mmorph + + -- ** Mixing diverse transformers + -- $interleave + + -- ** Embedding transformers + -- $embed + ) where + +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.Identity as I +import qualified Control.Monad.Trans.List as L +import qualified Control.Monad.Trans.Maybe as M +import qualified Control.Monad.Trans.Reader as R +import qualified Control.Monad.Trans.RWS.Lazy as RWS +import qualified Control.Monad.Trans.RWS.Strict as RWS' +import qualified Control.Monad.Trans.State.Lazy as S +import qualified Control.Monad.Trans.State.Strict as S' +import qualified Control.Monad.Trans.Writer.Lazy as W' +import qualified Control.Monad.Trans.Writer.Strict as W +import Data.Monoid (Monoid, mappend) +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) +import Control.Monad ((=<<), (>=>), (<=<), join) +import Data.Functor.Identity (Identity) + +{-| A functor in the category of monads, using 'hoist' as the analog of 'fmap': + +> hoist (f . g) = hoist f . hoist g +> +> hoist id = id +-} +class MFunctor t where + {-| Lift a monad morphism from @m@ to @n@ into a monad morphism from + @(t m)@ to @(t n)@ + -} + hoist :: (Monad m) => (forall a . m a -> n a) -> t m b -> t n b + +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)) + +instance MFunctor L.ListT where + hoist nat m = L.ListT (nat (L.runListT m)) + +instance MFunctor M.MaybeT where + hoist nat m = M.MaybeT (nat (M.runMaybeT m)) + +instance MFunctor (R.ReaderT r) where + hoist nat m = R.ReaderT (\i -> nat (R.runReaderT m i)) + +instance MFunctor (RWS.RWST r w s) where + hoist nat m = RWS.RWST (\r s -> nat (RWS.runRWST m r s)) + +instance MFunctor (RWS'.RWST r w s) where + hoist nat m = RWS'.RWST (\r s -> nat (RWS'.runRWST m r s)) + +instance MFunctor (S.StateT s) where + hoist nat m = S.StateT (\s -> nat (S.runStateT m s)) + +instance MFunctor (S'.StateT s) where + hoist nat m = S'.StateT (\s -> nat (S'.runStateT m s)) + +instance MFunctor (W.WriterT w) where + hoist nat m = W.WriterT (nat (W.runWriterT m)) + +instance MFunctor (W'.WriterT w) where + hoist nat m = W'.WriterT (nat (W'.runWriterT m)) + +instance Functor f => MFunctor (Compose f) where + hoist nat (Compose f) = Compose (fmap nat f) + +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 +generalize = return . runIdentity +{-# INLINABLE generalize #-} + +{-| A monad in the category of monads, using 'lift' from 'MonadTrans' as the + analog of 'return' and 'embed' as the analog of ('=<<'): + +> embed lift = id +> +> embed f (lift m) = f m +> +> embed g (embed f t) = embed (\m -> embed g (f m)) t +-} +class (MFunctor t, MonadTrans t) => MMonad t where + {-| Embed a newly created 'MMonad' layer within an existing layer + + 'embed' is analogous to ('=<<') + -} + embed :: (Monad n) => (forall a . m a -> t n a) -> t m b -> t n b + +{-| Squash two 'MMonad' layers into a single layer + + 'squash' is analogous to 'join' +-} +squash :: (Monad m, MMonad t) => t (t m) a -> t m a +squash = embed id +{-# INLINABLE squash #-} + +infixr 2 >|>, =<| +infixl 2 <|<, |>= + +{-| Compose two 'MMonad' layer-building functions + + ('>|>') is analogous to ('>=>') +-} +(>|>) + :: (Monad m3, MMonad t) + => (forall a . m1 a -> t m2 a) + -> (forall b . m2 b -> t m3 b) + -> m1 c -> t m3 c +(f >|> g) m = embed g (f m) +{-# INLINABLE (>|>) #-} + +{-| Equivalent to ('>|>') with the arguments flipped + + ('<|<') is analogous to ('<=<') +-} +(<|<) + :: (Monad m3, MMonad t) + => (forall b . m2 b -> t m3 b) + -> (forall a . m1 a -> t m2 a) + -> m1 c -> t m3 c +(g <|< f) m = embed g (f m) +{-# INLINABLE (<|<) #-} + +{-| An infix operator equivalent to 'embed' + + ('=<|') is analogous to ('=<<') +-} +(=<|) :: (Monad n, MMonad t) => (forall a . m a -> t n a) -> t m b -> t n b +(=<|) = embed +{-# INLINABLE (=<|) #-} + +{-| Equivalent to ('=<|') with the arguments flipped + + ('|>=') is analogous to ('>>=') +-} +(|>=) :: (Monad n, MMonad t) => t m b -> (forall a . m a -> t n a) -> t n b +t |>= f = embed f t +{-# INLINABLE (|>=) #-} + +instance (E.Error e) => MMonad (E.ErrorT e) where + embed f m = E.ErrorT (do + x <- E.runErrorT (f (E.runErrorT m)) + return (case x of + Left e -> Left e + 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)) + return (case x of + 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) + +instance MMonad L.ListT where + embed f m = L.ListT (do + x <- L.runListT (f (L.runListT m)) + return (concat x)) + +instance MMonad M.MaybeT where + embed f m = M.MaybeT (do + x <- M.runMaybeT (f (M.runMaybeT m)) + return (case x of + Nothing -> Nothing + Just Nothing -> Nothing + Just (Just a) -> Just a ) ) + +instance MMonad (R.ReaderT r) where + embed f m = R.ReaderT (\i -> R.runReaderT (f (R.runReaderT m i)) i) + +instance (Monoid w) => MMonad (W.WriterT w) where + embed f m = W.WriterT (do + ~((a, w1), w2) <- W.runWriterT (f (W.runWriterT m)) + return (a, mappend w1 w2) ) + +instance (Monoid w) => MMonad (W'.WriterT w) where + embed f m = W'.WriterT (do + ((a, w1), w2) <- W'.runWriterT (f (W'.runWriterT m)) + return (a, mappend w1 w2) ) + +{- $tutorial + Monad morphisms solve the common problem of fixing monadic code after the + fact without modifying the original source code or type signatures. The + following sections illustrate various examples of transparently modifying + existing functions. +-} + +{- $generalize + Imagine that some library provided the following 'S.State' code: + +> import Control.Monad.Trans.State +> +> tick :: State Int () +> tick = modify (+1) + + ... but we would prefer to reuse @tick@ within a larger + @('S.StateT' Int 'IO')@ block in order to mix in 'IO' actions. + + We could patch the original library to generalize @tick@'s type signature: + +> tick :: (Monad m) => StateT Int m () + + ... but we would prefer not to fork upstream code if possible. How could + we generalize @tick@'s type without modifying the original code? + + We can solve this if we realize that 'S.State' is a type synonym for + 'S.StateT' with an 'Identity' base monad: + +> type State s = StateT s Identity + + ... which means that @tick@'s true type is actually: + +> tick :: StateT Int Identity () + + Now all we need is a function that @generalize@s the 'Identity' base monad + to be any monad: + +> import Data.Functor.Identity +> +> generalize :: (Monad m) => Identity a -> m a +> generalize m = return (runIdentity m) + + ... which we can 'hoist' to change @tick@'s base monad: + +> hoist :: (Monad m, MFunctor t) => (forall a . m a -> n a) -> t m b -> t n b +> +> hoist generalize :: (Monad m, MFunctor t) => t Identity b -> t m b +> +> hoist generalize tick :: (Monad m) => StateT Int m () + + This lets us mix @tick@ alongside 'IO' using 'lift': + +> import Control.Monad.Morph +> import Control.Monad.Trans.Class +> +> tock :: StateT Int IO () +> tock = do +> hoist generalize tick :: (Monad m) => StateT Int m () +> lift $ putStrLn "Tock!" :: (MonadTrans t) => t IO () + +>>> runStateT tock 0 +Tock! +((), 1) + +-} + +{- $mmorph + Notice that @generalize@ is a monad morphism, and the following two proofs + show how @generalize@ satisfies the monad morphism laws. You can refer to + these proofs as an example for how to prove a function obeys the monad + morphism laws: + +> generalize (return x) +> +> -- Definition of 'return' for the Identity monad +> = generalize (Identity x) +> +> -- Definition of 'generalize' +> = return (runIdentity (Identity x)) +> +> -- runIdentity (Identity x) = x +> = return x + +> generalize $ do x <- m +> f x +> +> -- Definition of (>>=) for the Identity monad +> = generalize (f (runIdentity m)) +> +> -- Definition of 'generalize' +> = return (runIdentity (f (runIdentity m))) +> +> -- Monad law: Left identity +> = do x <- return (runIdentity m) +> return (runIdentity (f x)) +> +> -- Definition of 'generalize' in reverse +> = do x <- generalize m +> generalize (f x) +-} + +{- $interleave + You can combine 'hoist' and 'lift' to insert arbitrary layers anywhere + within a monad transformer stack. This comes in handy when interleaving two + diverse stacks. + + For example, we might want to combine the following @save@ function: + +> import Control.Monad.Trans.Writer +> +> -- i.e. :: StateT Int (WriterT [Int] Identity) () +> save :: StateT Int (Writer [Int]) () +> save = do +> n <- get +> lift $ tell [n] + + ... with our previous @tock@ function: + +> tock :: StateT Int IO () + + However, @save@ and @tock@ differ in two ways: + + * @tock@ lacks a 'W.WriterT' layer + + * @save@ has an 'Identity' base monad + + We can mix the two by inserting a 'W.WriterT' layer for @tock@ and + generalizing @save@'s base monad: + +> import Control.Monad +> +> program :: StateT Int (WriterT [Int] IO) () +> program = replicateM_ 4 $ do +> hoist lift tock +> :: (MonadTrans t) => StateT Int (t IO) () +> hoist (hoist generalize) save +> :: (Monad m) => StateT Int (WriterT [Int] m ) () + +>>> execWriterT (runStateT program 0) +Tock! +Tock! +Tock! +Tock! +[1,2,3,4] + +-} + +{- $embed + Suppose we decided to @check@ all 'IOException's using a combination of + 'try' and 'ErrorT': + +> import Control.Exception +> import Control.Monad.Trans.Class +> import Control.Monad.Trans.Error +> +> check :: IO a -> ErrorT IOException IO a +> check io = ErrorT (try io) + + ... but then we forget to use @check@ in one spot, mistakenly using 'lift' + instead: + +> program :: ErrorT IOException IO () +> program = do +> str <- lift $ readFile "test.txt" +> check $ putStr str + +>>> runErrorT program +*** Exception: test.txt: openFile: does not exist (No such file or directory) + + How could we go back and fix 'program' without modifying its source code? + + Well, @check@ is a monad morphism, but we can't 'hoist' it to modify the + base monad because then we get two 'E.ErrorT' layers instead of one: + +> hoist check :: (MFunctor t) => t IO a -> t (ErrorT IOException IO) a +> +> hoist check program :: ErrorT IOException (ErrorT IOException IO) () + + We'd prefer to 'embed' all newly generated exceptions in the existing + 'E.ErrorT' layer: + +> embed check :: ErrorT IOException IO a -> ErrorT IOException IO a +> +> embed check program :: ErrorT IOException IO () + + This correctly checks the exceptions that slipped through the cracks: + +>>> import Control.Monad.Morph +>>> runErrorT (embed check program) +Left test.txt: openFile: does not exist (No such file or directory) + +-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mmorph-1.0.0/src/Control/Monad/Trans/Compose.hs new/mmorph-1.0.4/src/Control/Monad/Trans/Compose.hs --- old/mmorph-1.0.0/src/Control/Monad/Trans/Compose.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/mmorph-1.0.4/src/Control/Monad/Trans/Compose.hs 2014-08-28 06:04:28.000000000 +0200 @@ -0,0 +1,67 @@ +{-# LANGUAGE FlexibleContexts, KindSignatures #-} + +{-| Composition of monad transformers. A higher-order version of + "Data.Functor.Compose". +-} + +module Control.Monad.Trans.Compose ( + -- * ComposeT + ComposeT(ComposeT, getComposeT), + ) where + +import Control.Applicative ( + Applicative(pure, (<*>), (*>), (<*)), Alternative(empty, (<|>)) ) +import Control.Monad (MonadPlus(mzero, mplus), liftM) +import Control.Monad.Morph (MFunctor(hoist)) +import Control.Monad.Trans.Class (MonadTrans(lift)) +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) + +-- | Composition of monad transformers. +newtype ComposeT (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *) m a + = ComposeT { getComposeT :: f (g m) a } + +instance (MFunctor f, MonadTrans f, MonadTrans g) => MonadTrans (ComposeT f g) + where + lift = ComposeT . hoist lift . lift + +instance Functor (f (g m)) => Functor (ComposeT f g m) where + fmap f (ComposeT m) = ComposeT (fmap f m) + +instance Applicative (f (g m)) => Applicative (ComposeT f g m) where + pure a = ComposeT (pure a) + ComposeT f <*> ComposeT a = ComposeT (f <*> a) + ComposeT a *> ComposeT b = ComposeT (a *> b) + ComposeT a <* ComposeT b = ComposeT (a <* b) + +instance Alternative (f (g m)) => Alternative (ComposeT f g m) where + empty = ComposeT empty + ComposeT a <|> ComposeT b = ComposeT (a <|> b) + +instance Monad (f (g m)) => Monad (ComposeT f g m) where + return a = ComposeT (return a) + m >>= f = ComposeT (getComposeT m >>= \x -> getComposeT (f x)) + fail e = ComposeT (fail e) + +instance MonadPlus (f (g m)) => MonadPlus (ComposeT f g m) where + mzero = ComposeT mzero + ComposeT a `mplus` ComposeT b = ComposeT (a `mplus` b) + +instance MonadIO (f (g m)) => MonadIO (ComposeT f g m) where + liftIO m = ComposeT (liftIO m) + +instance Foldable (f (g m)) => Foldable (ComposeT f g m) where + fold (ComposeT m) = fold m + foldMap f (ComposeT m) = foldMap f m + foldr f a (ComposeT m) = foldr f a m + foldl f a (ComposeT m) = foldl f a m + foldr1 f (ComposeT m) = foldr1 f m + foldl1 f (ComposeT m) = foldl1 f m + +instance Traversable (f (g m)) => Traversable (ComposeT f g m) where + traverse f (ComposeT m) = fmap ComposeT (traverse f m) + sequenceA (ComposeT m) = fmap ComposeT (sequenceA m) + mapM f (ComposeT m) = liftM ComposeT (mapM f m) + sequence (ComposeT m) = liftM ComposeT (sequence m)
