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