either 3.0.3 → 3.1

raw patch · 3 files changed

+141/−30 lines, 3 filesdep +MonadRandomdep +mtldep ~semigroupoidsdep ~semigroupsPVP ok

version bump matches the API change (PVP)

Dependencies added: MonadRandom, mtl

Dependency ranges changed: semigroupoids, semigroups

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +6/−1
• either.cabal +10/−11
• src/Control/Monad/Trans/Either.hs +125/−18

@@ -1,3 +1,8 @@+3.1+---+* Added instances for `mtl` classes and `MonadRandom`.+* The meaning of `mapEitherT` has changed to match `mapErrorT` in the `mtl`. The old `mapEitherT` is now `bimapEitherT`.+ 3.0.3 ------* Started CHANGELOG+* Started `CHANGELOG`

@@ -1,6 +1,6 @@ name:          either category:      Control, Monads-version:       3.0.3+version:       3.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -9,9 +9,9 @@ stability:     provisional homepage:      http://github.com/ekmett/either/ bug-reports:   http://github.com/ekmett/either/issues-copyright:     Copyright (C) 2008-2012 Edward A. Kmett-synopsis:      Haskell 98 either monad transformer-description:   Haskell 98 either monad transformer+copyright:     Copyright (C) 2008-2013 Edward A. Kmett+synopsis:      An either monad transformer+description:   An either monad transformer build-type:    Simple extra-source-files:   .gitignore@@ -28,14 +28,13 @@ library   build-depends:     base          >= 4       && < 5,-    semigroups    >= 0.8.3.1,-    semigroupoids >= 3,+    MonadRandom   == 0.1.*,+    mtl           >= 2.0     && < 2.2,+    semigroups    >= 0.8.3.1 && < 1,+    semigroupoids >= 3       && < 4,     transformers  >= 0.2     && < 0.4    extensions: CPP--  exposed-modules:-    Control.Monad.Trans.Either--  ghc-options:      -Wall+  exposed-modules: Control.Monad.Trans.Either+  ghc-options: -Wall   hs-source-dirs: src

@@ -1,7 +1,24 @@-{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Trans.Either+-- Copyright   :  (C) 2008-2013 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  MPTCs+--+-- This module provides a minimalist 'Either' monad transformer.+-----------------------------------------------------------------------------+ module Control.Monad.Trans.Either   ( EitherT(..)   , eitherT+  , bimapEitherT   , mapEitherT   , hoistEither   , left@@ -9,65 +26,100 @@   ) where  import Control.Applicative-import Data.Functor.Bind-import Data.Functor.Plus+import Control.Monad (liftM)+import Control.Monad.Cont.Class+import Control.Monad.Error.Class+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Reader.Class+import Control.Monad.State (MonadState,get,put)+import Control.Monad.Trans.Class+import Control.Monad.Writer.Class+import Control.Monad.Random (MonadRandom,getRandom,getRandoms,getRandomR,getRandomRs) import Data.Foldable import Data.Function (on)+import Data.Functor.Bind+import Data.Functor.Plus import Data.Traversable import Data.Semigroup-import Control.Monad.Trans.Class--- import Control.Monad.Error.Class-import Control.Monad.IO.Class-import Control.Monad.Fix-import Control.Monad (liftM) +-- | 'EitherT' is a version of 'Control.Monad.Trans.Error.ErrorT' that does not+-- require a spurious 'Control.Monad.Error.Class.Error' instance for the 'Left'+-- case.+--+-- 'Either' is a perfectly usable 'Monad' without such a constraint. 'ErrorT' is+-- not the generalization of the current 'Either' monad, it is something else.+--+-- This is necessary for both theoretical and practical reasons. For instance an+-- apomorphism is the generalized anamorphism for this Monad, but it cannot be+-- written with 'ErrorT'.+--+-- In addition to the combinators here, the @errors@ package provides a large +-- number of combinators for working with this type. newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) }--- TODO: Data, Typeable  instance Show (m (Either e a)) => Show (EitherT e m a) where   showsPrec d (EitherT m) = showParen (d > 10) $     showString "EitherT " . showsPrec 11 m+  {-# INLINE showsPrec #-}  instance Read (m (Either e a)) => Read (EitherT e m a) where-  readsPrec d r = readParen (d > 10)+  readsPrec d = readParen (d > 10)     (\r' -> [ (EitherT m, t)             | ("EitherT", s) <- lex r'-            , (m, t) <- readsPrec 11 s]) r+            , (m, t) <- readsPrec 11 s])+  {-# INLINE readsPrec #-}  instance Eq (m (Either e a)) => Eq (EitherT e m a) where   (==) = (==) `on` runEitherT+  {-# INLINE (==) #-}  instance Ord (m (Either e a)) => Ord (EitherT e m a) where   compare = compare `on` runEitherT-+  {-# INLINE compare #-} +-- | Given a pair of actions, one to perform in case of failure, and one to perform+-- in case of success, run an 'EitherT' and get back a monadic result. eitherT :: Monad m => (a -> m c) -> (b -> m c) -> EitherT a m b -> m c eitherT f g (EitherT m) = m >>= \z -> case z of   Left a -> f a   Right b -> g b {-# INLINE eitherT #-} +-- | Analogous to 'Left'. Equivalent to 'throwError'. left :: Monad m => e -> EitherT e m a left = EitherT . return . Left {-# INLINE left #-} +-- | Analogous to 'Right'. Equivalent to 'return'. right :: Monad m => a -> EitherT e m a right = return {-# INLINE right #-} --mapEitherT :: Functor m => (e -> f) -> (a -> b) -> EitherT e m a -> EitherT f m b-mapEitherT f g (EitherT m) = EitherT (fmap h m) where+-- | Map over both failure and success.+bimapEitherT :: Functor m => (e -> f) -> (a -> b) -> EitherT e m a -> EitherT f m b+bimapEitherT f g (EitherT m) = EitherT (fmap h m) where   h (Left e)  = Left (f e)   h (Right a) = Right (g a)+{-# INLINE bimapEitherT #-}++-- | Map the unwrapped computation using the given function.+--+-- @+-- 'runEitherT' ('mapEitherT' f m) = f ('runEitherT' m)+-- @+mapEitherT :: (m (Either e a) -> n (Either e' b)) -> EitherT e m a -> EitherT e' n b+mapEitherT f m = EitherT $ f (runEitherT m) {-# INLINE mapEitherT #-} +-- | Lift an 'Either' into an 'EitherT' hoistEither :: Monad m => Either e a -> EitherT e m a hoistEither = EitherT . return {-# INLINE hoistEither #-}  instance Functor m => Functor (EitherT e m) where   fmap f = EitherT . fmap (fmap f) . runEitherT+  {-# INLINE fmap #-}  instance (Functor m, Monad m) => Apply (EitherT e m) where   EitherT f <.> EitherT v = EitherT $ f >>= \mf -> case mf of@@ -75,56 +127,111 @@     Right k -> v >>= \mv -> case mv of       Left  e -> return (Left e)       Right x -> return (Right (k x))+  {-# INLINE (<.>) #-}  instance (Functor m, Monad m) => Applicative (EitherT e m) where   pure a  = EitherT $ return (Right a)+  {-# INLINE pure #-}   EitherT f <*> EitherT v = EitherT $ f >>= \mf -> case mf of     Left  e -> return (Left e)     Right k -> v >>= \mv -> case mv of       Left  e -> return (Left e)       Right x -> return (Right (k x))+  {-# INLINE (<*>) #-}  instance Monad m => Semigroup (EitherT e m a) where   EitherT m <> EitherT n = EitherT $ m >>= \a -> case a of     Left _ -> n     Right r -> return (Right r)+  {-# INLINE (<>) #-}  instance (Functor m, Monad m) => Alt (EitherT e m) where   (<!>) = (<>)+  {-# INLINE (<!>) #-}  instance (Functor m, Monad m) => Bind (EitherT e m) where   (>>-) = (>>=)+  {-# INLINE (>>-) #-}  instance Monad m => Monad (EitherT e m) where   return a = EitherT $ return (Right a)+  {-# INLINE return #-}   m >>= k  = EitherT $ do     a <- runEitherT m     case a of       Left  l -> return (Left l)       Right r -> runEitherT (k r)+  {-# INLINE (>>=) #-} -{- instance Monad m => MonadError e (EitherT e m) where   throwError = EitherT . return . Left+  {-# INLINE throwError #-}   EitherT m `catchError` h = EitherT $ m >>= \a -> case a of     Left  l -> runEitherT (h l)     Right r -> return (Right r)--}+  {-# INLINE catchError #-}  instance MonadFix m => MonadFix (EitherT e m) where   mfix f = EitherT $ mfix $ \a -> runEitherT $ f $ case a of     Right r -> r     _       -> error "empty mfix argument"+  {-# INLINE mfix #-}  instance MonadTrans (EitherT e) where   lift = EitherT . liftM Right+  {-# INLINE lift #-}  instance MonadIO m => MonadIO (EitherT e m) where   liftIO = lift . liftIO+  {-# INLINE liftIO #-} +instance MonadCont m => MonadCont (EitherT e m) where+  callCC f = EitherT $+    callCC $ \c ->+    runEitherT (f (\a -> EitherT $ c (Right a)))+  {-# INLINE callCC #-}++instance MonadReader r m => MonadReader r (EitherT e m) where+  ask = lift ask+  {-# INLINE ask #-}+  local f (EitherT m) = EitherT (local f m)+  {-# INLINE local #-}++instance MonadState s m => MonadState s (EitherT e m) where+  get = lift get+  {-# INLINE get #-}+  put = lift . put+  {-# INLINE put #-}++instance MonadWriter s m => MonadWriter s (EitherT e m) where+  tell = lift . tell+  {-# INLINE tell #-}+  listen = mapEitherT $ \ m -> do+    (a, w) <- listen m+    return $! fmap (\ r -> (r, w)) a+  {-# INLINE listen #-}+  pass = mapEitherT $ \ m -> pass $ do+    a <- m+    return $! case a of+        Left  l      -> (Left  l, id)+        Right (r, f) -> (Right r, f)+  {-# INLINE pass #-}++instance MonadRandom m => MonadRandom (EitherT e m) where+  getRandom   = lift getRandom+  {-# INLINE getRandom #-}+  getRandoms  = lift getRandoms+  {-# INLINE getRandoms #-}+  getRandomR  = lift . getRandomR+  {-# INLINE getRandomR #-}+  getRandomRs = lift . getRandomRs+  {-# INLINE getRandomRs #-}+ instance Foldable m => Foldable (EitherT e m) where   foldMap f = foldMap (either mempty f) . runEitherT+  {-# INLINE foldMap #-} -instance (Traversable f) => Traversable (EitherT e f) where+instance Traversable f => Traversable (EitherT e f) where   traverse f (EitherT a) =     EitherT <$> traverse (either (pure . Left) (fmap Right . f)) a+  {-# INLINE traverse #-}