Merge pull request #171 from LightAndLight/master

Add instances for functor product

Author: sjshuck

Control/Monad/Error/Class.hs

@@ -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, (<$>))
 
@@ -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

Control/Monad/RWS/Class.hs

@@ -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
@@ -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)

Control/Monad/Reader/Class.hs

@@ -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
@@ -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)

Control/Monad/State/Class.hs

@@ -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(..))
 
 -- ---------------------------------------------------------------------------
 
@@ -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)

Control/Monad/Writer/Class.hs

@@ -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
@@ -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)