Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 8 additions & 0 deletions Control/Monad/Error/Class.hs
Original file line number Diff line number Diff line change
Expand Up @@ -74,6 +74,7 @@ import qualified Control.Monad.Trans.Writer.CPS as CPSWriter
import Control.Monad.Trans.Class (lift)
import Control.Exception (IOException, catch, ioError)
import Control.Monad (Monad ((>>=), (>>)))
import Data.Functor.Product (Product(..))
import Data.Monoid (Monoid)
import Prelude (Either (Left, Right), Maybe (Nothing), either, flip, (.), IO, pure, (<$>))

Expand Down Expand Up @@ -206,6 +207,13 @@ instance
throwError = lift . throwError
catchError = Accum.liftCatch catchError

instance (MonadError e m, MonadError e n) => MonadError e (Product m n) where
throwError e = Pair (throwError e) (throwError e)
catchError (Pair ma na) f = Pair (catchError ma (productFst . f)) (catchError na (productSnd . f))
where
productFst (Pair a _) = a
productSnd (Pair _ b) = b

-- | 'MonadError' analogue to the 'Control.Exception.try' function.
--
-- @since 2.3
Expand Down
3 changes: 3 additions & 0 deletions Control/Monad/RWS/Class.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ import Control.Monad.Trans.Identity (IdentityT)
import qualified Control.Monad.Trans.RWS.CPS as CPS (RWST)
import qualified Control.Monad.Trans.RWS.Lazy as Lazy (RWST)
import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST)
import Data.Functor.Product (Product(..))

class (Monoid w, MonadReader r m, MonadWriter w m, MonadState s m)
=> MonadRWS r w s m | m -> r, m -> w, m -> s
Expand All @@ -62,3 +63,5 @@ instance (Monoid w, Monad m) => MonadRWS r w s (Strict.RWST r w s m)
instance MonadRWS r w s m => MonadRWS r w s (ExceptT e m)
instance MonadRWS r w s m => MonadRWS r w s (IdentityT m)
instance MonadRWS r w s m => MonadRWS r w s (MaybeT m)

instance (MonadRWS r w s m, MonadRWS r w s n) => MonadRWS r w s (Product m n)
5 changes: 5 additions & 0 deletions Control/Monad/Reader/Class.hs
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,7 @@ import Control.Monad.Trans.Select (SelectT (SelectT), runSelectT)
import qualified Control.Monad.Trans.RWS.CPS as CPSRWS
import qualified Control.Monad.Trans.Writer.CPS as CPS
import Control.Monad.Trans.Class (lift)
import Data.Functor.Product (Product(..))

-- ----------------------------------------------------------------------------
-- class MonadReader
Expand Down Expand Up @@ -202,3 +203,7 @@ instance
r <- ask
local f (runSelectT m (local (const r) . c))
reader = lift . reader

instance (MonadReader r m, MonadReader r n) => MonadReader r (Product m n) where
ask = Pair ask ask
local f (Pair ma na) = Pair (local f ma) (local f na)
5 changes: 5 additions & 0 deletions Control/Monad/State/Class.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,6 +52,7 @@ import Control.Monad.Trans.Select (SelectT)
import qualified Control.Monad.Trans.RWS.CPS as CPSRWS
import qualified Control.Monad.Trans.Writer.CPS as CPS
import Control.Monad.Trans.Class (lift)
import Data.Functor.Product (Product(..))

-- ---------------------------------------------------------------------------

Expand Down Expand Up @@ -192,3 +193,7 @@ instance MonadState s m => MonadState s (SelectT r m) where
get = lift get
put = lift . put
state = lift . state

instance (MonadState s m, MonadState s n) => MonadState s (Product m n) where
get = Pair get get
put s = Pair (put s) (put s)
6 changes: 6 additions & 0 deletions Control/Monad/Writer/Class.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,7 @@ import qualified Control.Monad.Trans.Accum as Accum
import qualified Control.Monad.Trans.RWS.CPS as CPSRWS
import qualified Control.Monad.Trans.Writer.CPS as CPS
import Control.Monad.Trans.Class (lift)
import Data.Functor.Product (Product(..))

-- ---------------------------------------------------------------------------
-- MonadWriter class
Expand Down Expand Up @@ -205,3 +206,8 @@ instance
tell = lift . tell
listen = Accum.liftListen listen
pass = Accum.liftPass pass

instance (MonadWriter w m, MonadWriter w n) => MonadWriter w (Product m n) where
tell w = Pair (tell w) (tell w)
listen (Pair ma na) = Pair (listen ma) (listen na)
pass (Pair maf naf) = Pair (pass maf) (pass naf)