From 7c835a209277ca11b44e0c10ce6c88f0c4943208 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Fri, 28 Jun 2019 17:50:26 +0400 Subject: [PATCH] add Monoid instance --- src/Control/Monad/Cont/Trans.purs | 8 ++++++++ src/Control/Monad/Except/Trans.purs | 8 ++++++++ src/Control/Monad/Maybe/Trans.purs | 8 ++++++++ src/Control/Monad/RWS/Trans.purs | 8 ++++++++ src/Control/Monad/State/Trans.purs | 8 ++++++++ src/Control/Monad/Writer/Trans.purs | 8 ++++++++ 6 files changed, 48 insertions(+) diff --git a/src/Control/Monad/Cont/Trans.purs b/src/Control/Monad/Cont/Trans.purs index 608a77ff..cfa3d2cc 100644 --- a/src/Control/Monad/Cont/Trans.purs +++ b/src/Control/Monad/Cont/Trans.purs @@ -8,6 +8,7 @@ module Control.Monad.Cont.Trans import Prelude +import Control.Apply (lift2) import Control.Monad.Cont.Class (class MonadCont, callCC) import Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local) import Control.Monad.State.Class (class MonadState, state) @@ -67,3 +68,10 @@ instance monadReaderContT :: MonadReader r1 m => MonadReader r1 (ContT r m) wher instance monadStateContT :: MonadState s m => MonadState s (ContT r m) where state = lift <<< state + +instance semigroupContT :: (Apply m, Semigroup a) => Semigroup (ContT r m a) where + append = lift2 (<>) + +instance monoidContT :: (Applicative m, Monoid a) => Monoid (ContT r m a) where + mempty = pure mempty + diff --git a/src/Control/Monad/Except/Trans.purs b/src/Control/Monad/Except/Trans.purs index 21ef0148..c5e4b565 100644 --- a/src/Control/Monad/Except/Trans.purs +++ b/src/Control/Monad/Except/Trans.purs @@ -10,6 +10,7 @@ import Prelude import Control.Alt (class Alt) import Control.Alternative (class Alternative) +import Control.Apply (lift2) import Control.Monad.Cont.Class (class MonadCont, callCC) import Control.Monad.Error.Class (class MonadThrow, class MonadError, throwError, catchError) import Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local) @@ -136,3 +137,10 @@ instance monadWriterExceptT :: MonadWriter w m => MonadWriter w (ExceptT e m) wh pure case a of Left e -> Tuple (Left e) identity Right (Tuple r f) -> Tuple (Right r) f + +instance semigroupExceptT :: (Monad m, Semigroup a) => Semigroup (ExceptT e m a) where + append = lift2 (<>) + +instance monoidExceptT :: (Monad m, Monoid a) => Monoid (ExceptT e m a) where + mempty = pure mempty + diff --git a/src/Control/Monad/Maybe/Trans.purs b/src/Control/Monad/Maybe/Trans.purs index 625aed0a..c34b6b89 100644 --- a/src/Control/Monad/Maybe/Trans.purs +++ b/src/Control/Monad/Maybe/Trans.purs @@ -9,6 +9,7 @@ import Prelude import Control.Alt (class Alt) import Control.Alternative (class Alternative) +import Control.Apply (lift2) import Control.Monad.Cont.Class (class MonadCont, callCC) import Control.Monad.Error.Class (class MonadThrow, class MonadError, catchError, throwError) import Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local) @@ -121,3 +122,10 @@ instance monadWriterMaybeT :: MonadWriter w m => MonadWriter w (MaybeT m) where pure case a of Nothing -> Tuple Nothing identity Just (Tuple v f) -> Tuple (Just v) f + +instance semigroupMaybeT :: (Monad m, Semigroup a) => Semigroup (MaybeT m a) where + append = lift2 (<>) + +instance monoidMaybeT :: (Monad m, Monoid a) => Monoid (MaybeT m a) where + mempty = pure mempty + diff --git a/src/Control/Monad/RWS/Trans.purs b/src/Control/Monad/RWS/Trans.purs index f4fe609a..6024c484 100644 --- a/src/Control/Monad/RWS/Trans.purs +++ b/src/Control/Monad/RWS/Trans.purs @@ -10,6 +10,7 @@ import Prelude import Control.Alt (class Alt, (<|>)) import Control.Alternative (class Alternative) +import Control.Apply (lift2) import Control.Lazy (class Lazy) import Control.Monad.Error.Class (class MonadThrow, class MonadError, throwError, catchError) import Control.Monad.Reader.Class (class MonadAsk, class MonadReader) @@ -130,3 +131,10 @@ instance monadRecRWST :: (MonadRec m, Monoid w) => MonadRec (RWST r w s m) where instance plusRWST :: Plus m => Plus (RWST r w s m) where empty = RWST \ _ _ -> empty + +instance semigroupRWST :: (Bind m, Monoid w, Semigroup a) => Semigroup (RWST r w s m a) where + append = lift2 (<>) + +instance monoidRWST :: (Monad m, Monoid w, Monoid a) => Monoid (RWST r w s m a) where + mempty = pure mempty + diff --git a/src/Control/Monad/State/Trans.purs b/src/Control/Monad/State/Trans.purs index dd1c86dc..d2d9a624 100644 --- a/src/Control/Monad/State/Trans.purs +++ b/src/Control/Monad/State/Trans.purs @@ -10,6 +10,7 @@ import Prelude import Control.Alt (class Alt, (<|>)) import Control.Alternative (class Alternative) +import Control.Apply (lift2) import Control.Lazy (class Lazy) import Control.Monad.Cont.Class (class MonadCont, callCC) import Control.Monad.Error.Class (class MonadThrow, class MonadError, catchError, throwError) @@ -137,3 +138,10 @@ instance monadWriterStateT :: MonadWriter w m => MonadWriter w (StateT s m) wher StateT m' -> do Tuple (Tuple a f) s' <- m' s pure $ Tuple (Tuple a s') f + +instance semigroupStateT :: (Monad m, Semigroup a) => Semigroup (StateT s m a) where + append = lift2 (<>) + +instance monoidStateT :: (Monad m, Monoid a) => Monoid (StateT s m a) where + mempty = pure mempty + diff --git a/src/Control/Monad/Writer/Trans.purs b/src/Control/Monad/Writer/Trans.purs index 862fa01f..9ce2e83e 100644 --- a/src/Control/Monad/Writer/Trans.purs +++ b/src/Control/Monad/Writer/Trans.purs @@ -10,6 +10,7 @@ import Prelude import Control.Alt (class Alt, (<|>)) import Control.Alternative (class Alternative) +import Control.Apply (lift2) import Control.Monad.Cont.Class (class MonadCont, callCC) import Control.Monad.Error.Class (class MonadThrow, class MonadError, catchError, throwError) import Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local) @@ -125,3 +126,10 @@ instance monadWriterWriterT :: (Monoid w, Monad m) => MonadWriter w (WriterT w m pass (WriterT m) = WriterT do Tuple (Tuple a f) w <- m pure $ Tuple a (f w) + +instance semigroupWriterT :: (Apply m, Semigroup w, Semigroup a) => Semigroup (WriterT w m a) where + append = lift2 (<>) + +instance monoidWriterT :: (Applicative m, Monoid w, Monoid a) => Monoid (WriterT w m a) where + mempty = pure mempty +