Proposal: merge either into transformers

Kei Hibino ex8k.hibino at gmail.com
Wed Apr 30 09:00:50 UTC 2014


Hello, Ross

I discovered mplus of ExceptT doesn't call mappend to accumulate
error states which is different from origitnal EitherT like below.
I suppose this EitherT semantics is more useful than fixed adoption
of last error state.
(For example, Last Monoid is pre-defined in base)

ExceptT
>instance (Monad m, Monoid e) => MonadPlus (ExceptT e m) where
>    mzero = ExceptT $ return (Left mempty)
>    ExceptT m `mplus` ExceptT n = ExceptT $ do
>        a <- m
>        case a of
>            Left _ -> n                  -- throw left error away
>            Right x -> return (Right x)

EitherT
>instance (Monad m, Monoid e) => Alternative (EitherT e m) where
>  EitherT m <|> EitherT n = EitherT $ m >>= \a -> case a of
>    Left l -> liftM (\b -> case b of
>      Left l' -> Left (mappend l l')     -- mappend error states
>      Right r -> Right r) n
>    Right r -> return (Right r)
>
>  empty = EitherT $ return (Left mempty)


From: R.Paterson at city.ac.uk (Ross Paterson)
Subject: Proposal: merge either into transformers
Date: Sat, 26 Apr 2014 01:21:09 +0100

> Instead of EitherT, the next version will deprecate ErrorT in favour
> of a transformer ExceptT with base monad Except.  The idea is to have
> analogous transformers and monads
> 
> 	  ExceptT : Except : Either
> 	  WriterT : Writer : (,)
> 	  ReaderT : Reader : (->)
> 
> Other changes are:
> 
>         * Added infixr 9 `Compose` to match (.)
>         * Added Eq, Ord, Read and Show instances where possible
>         * Replaced record syntax for newtypes with separate inverse functions
>         * Added delimited continuation functions to ContT
>         * Added instance Alternative IO to ErrorT
> 
> Pre-release docs are here:
> 
> 	    http://code.haskell.org/~ross/transformers/dist/doc/html/transformers/


--
Kei Hibino
ex8k.hibino at gmail.com
https://github.com/khibino/


More information about the Libraries mailing list