Why MonadPlus and not Monad + Monoid?
Your guard'
does not match your Monoid m a
type.
If you mean Monoid (m a)
, then you need to define what mempty
is for m ()
. Once you've done that, you've defined a MonadPlus
.
In other words, MonadPlus
defines two opeartions: mzero
and mplus
satisfying two rules: mzero
is neutral with respect to mplus
, and mplus
is associative. This satisfies the definition of a Monoid
so that mzero
is mempty
and mplus
is mappend
.
The difference is that MonadPlus m
is a monoid m a
for any a
, but Monoid m
defines a monoid only for m
. Your guard'
works because you only needed m
to be a Monoid
only for ()
. But MonadPlus
is stronger, it claims m a
to be a monoid for any a
.
But couldn't you rewrite any type constraint of
(MonadPlus m) => ...
as a combination of Monad and Monoid?
No. In the top answer to the question you link, there is already a good explanation about the laws of MonadPlus vs. Monoid. But there are differences even if we ignore the typeclass laws.
Monoid (m a) => ...
means that m a
has to be a monoid for one particular a
chosen by the caller, but MonadPlus m
means that m a
has to be a monoid for all a
. So MonadPlus a
is more flexible, and this flexibility is helpful in four situations:
If we don't want to tell the caller what
a
we intend to use.MonadPlus m => ...
instead ofMonoid (m SecretType) => ...
If we want to use multiple different
a
.MonadPlus m => ...
instead of(Monoid (m Type1), Monoid (m Type2), ...) => ...
If we want to use infinitely many different
a
.MonadPlus m => ...
instead of not possible.If we don't know what
a
we need.MonadPlus m => ...
instead of not possible.
With the QuantifiedConstraints
language extension you can express that the Monoid (m a)
instance has to be uniform across all choices of a
:
{-# LANGUAGE QuantifiedConstraints #-}
class (Monad m, forall a. Monoid (m a)) => MonadPlus m
mzero :: (MonadPlus m) => m a
mzero = mempty
mplus :: (MonadPlus m) => m a -> m a -> m a
mplus = mappend
Alternative
ly, we can implement the "real" MonadPlus
class generically for all such monoid-monads:
{-# LANGUAGE GeneralizedNewtypeDeriving, DerivingStrategies, QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}
import Control.Monad
import Control.Applicative
newtype MonoidMonad m a = MonoidMonad{ runMonoidMonad :: m a }
deriving (Functor, Applicative, Monad)
instance (Applicative m, forall a. Monoid (m a)) => Alternative (MonoidMonad m) where
empty = MonoidMonad mempty
(MonoidMonad x) <|> (MonoidMonad y) = MonoidMonad (x <> y)
instance (Monad m, forall a. Monoid (m a)) => MonadPlus (MonoidMonad m)
Note that depending on your choice of m
, this may or may not give you the MonadPlus
you expect; for example, MonoidMonad []
is really the same as []
; but for Maybe
, the Monoid
instance lifts some underlying semigroup by artifically giving it an identity element, whereas the MonadPlus
instance is left-biased choice; and so we have to use MonoidMonad First
instead of MonoidMonad Maybe
to get the right instance.