instance MPlus IO?

Ashley Yakeley ashley@semantic.org
Wed, 21 May 2003 22:04:04 -0700


In article <16071.60350.411868.559865@tux-17.corp.peace.com>,
 Tom Pledger <Tom.Pledger@peace.com> wrote:

> Hal Daume III writes:
>  | The docs claim this instance exists, but it doesn't seem to.
>  | Moreoever, such an instance doesn't make sense to me.
> 
> The following is from Control.Monad.Error.
> 
> instance MonadPlus IO where
> 	mzero       = ioError (userError "mzero")
> 	m `mplus` n = m `catch` \_ -> n

I tend to agree with Hal. This muddles up the semantics of MonadPlus 
IMO. I think mplus/mzero should do proper backtracking. For instance:

  test = do {
    t <- (return True) `mplus` (return False);
    if t then mzero else return ();
  }

In my opinion this test should always return rather than be mzero. At 
the very least it's useful have separate "plus" operators that do and 
don't do proper backtracking.

In HBase I have separate classes:

    class (Monad m) =>
     MonadZero m where
        {
        mzero :: m a;
        };  
 
    class (MonadZero m) =>
     MonadOr m where
        {
        mOrElse :: m a -> m a -> m a;
        };

    class (MonadOr m) =>
     MonadPlus m where
        {
        mplus :: m a -> m a -> m a;     
        msum :: [m a] -> m a;
        returnMany :: [a] -> m a;
        
        msum [] = mzero;
        msum (p:ps) = mplus p (msum ps);
        
        returnMany = msum . (fmap return);
        };

    class (MonadPlus m) =>
     MonadFirst m where
        {
        mfirst :: m a -> m a;
        };

As a gloss for their meanings, these are the instances for []:

    instance MonadZero [] where
        {
        mzero = [];
        };

    instance MonadOr [] where
        {
        mOrElse [] = id;
        mOrElse (a:_) = const [a];
        };

    instance MonadPlus [] where
        {
        mplus = (++);
        msum = concatenateList;
        returnMany = id;
        };

    instance MonadFirst [] where
        {
        mfirst [] = [];
        mfirst (x:_) = [x];
        };

-- 
Ashley Yakeley, Seattle WA