module Data.Monoid.Monad
( module Data.Monoid.Reducer
, module Data.Ring.Module
, Action(Action,getAction)
, snocAction
, MonadSum(MonadSum, getMonadSum)
, Mon(Mon,getMon)
) where
import Control.Applicative
import Control.Functor.Pointed
import Data.Monoid.Reducer
import Data.Ring.Module
import Control.Monad
newtype Action m = Action { getAction :: m () }
instance Monad m => Monoid (Action m) where
mempty = Action (return ())
Action a `mappend` Action b = Action (a >> b)
instance Monad m => Reducer (m a) (Action m) where
unit a = Action (a >> return ())
a `cons` Action b = Action (a >> b)
Action a `snoc` b = Action (a >> b >> return ())
snocAction :: Reducer (m ()) (Action m) => Action m -> m () -> Action m
snocAction a = mappend a . Action
newtype MonadSum m a = MonadSum { getMonadSum :: m a }
deriving (Eq,Ord,Show,Read,Monad,MonadPlus)
instance MonadPlus m => Monoid (MonadSum m a) where
mempty = mzero
mappend = mplus
instance (Monad m, Monoid a) => Multiplicative (MonadSum m a) where
one = return mempty
times = liftM2 mappend
instance Monad m => Functor (MonadSum m) where
fmap = liftM
instance Monad m => Applicative (MonadSum m) where
pure = return
(<*>) = ap
instance Monad m => Pointed (MonadSum m) where
point = return
instance MonadPlus m => Reducer (m a) (MonadSum m a) where
unit = MonadSum
instance (MonadPlus m, Monoid a) => Ringoid (MonadSum m a)
instance (MonadPlus m, Monoid a) => RightSemiNearRing (MonadSum m a)
newtype Mon f m = Mon { getMon :: f m }
deriving (Eq,Ord,Show,Read,Functor,Pointed, Monad,MonadPlus)
instance (Monoid m, Monad f) => Monoid (f `Mon` m) where
mempty = return mempty
mappend = liftM2 mappend
instance (Group m, Monad f) => Group (f `Mon` m) where
gnegate = liftM gnegate
minus = liftM2 minus
gsubtract = liftM2 gsubtract
instance (c `Reducer` m, Monad f) => Reducer c (f `Mon` m) where
unit = return . unit
instance (LeftModule r m, Monad f) => LeftModule r (f `Mon` m) where
x *. m = liftM (x *.) m
instance (RightModule r m, Monad f) => RightModule r (f `Mon` m) where
m .* y = liftM (.* y) m
instance (Module r m, Monad f) => Module r (f `Mon` m)