Merge pull request #34 from twittner/except

Initial conversion to ExceptT.

Control/Error.hs

@@ -15,7 +15,7 @@
     * "Control.Error.Util": Utility functions and conversions between common
       error-handling types
 
-    * @Control.Monad.Trans.Either@: The 'EitherT' monad transformer
+    * @Control.Monad.Trans.Except@: The 'ExceptT' monad transformer
 
     * @Control.Monad.Trans.Maybe@: The 'MaybeT' monad transformer
 
@@ -36,7 +36,7 @@ module Control.Error (
     module Control.Error.Safe,
     module Control.Error.Script,
     module Control.Error.Util,
-    module Control.Monad.Trans.Either,
+    module Control.Monad.Trans.Except,
     module Control.Monad.Trans.Maybe,
     module Data.Either,
     module Data.EitherR,
@@ -47,15 +47,13 @@ module Control.Error (
 import Control.Error.Safe
 import Control.Error.Script
 import Control.Error.Util
-import Control.Monad.Trans.Either (
-    EitherT(EitherT),
-    runEitherT,
-    eitherT,
-    bimapEitherT,
-    mapEitherT,
-    hoistEither,
-    left,
-    right )
+import Control.Monad.Trans.Except (
+    ExceptT(ExceptT),
+    runExceptT,
+    throwE,
+    catchE,
+    mapExceptT,
+    withExceptT )
 import Control.Monad.Trans.Maybe (
     MaybeT(MaybeT),
     runMaybeT,

Control/Error/Safe.hs

@@ -1,9 +1,9 @@
 {-| This module extends the @safe@ library's functions with corresponding
-    versions compatible with 'Either' and 'EitherT', and also provides a few
+    versions compatible with 'Either' and 'ExceptT', and also provides a few
     'Maybe'-compatible functions missing from @safe@.
 
     I suffix the 'Either'-compatible functions with @Err@ and prefix the
-    'EitherT'-compatible functions with @try@.
+    'ExceptT'-compatible functions with @try@.
 
     Note that this library re-exports the 'Maybe' compatible functions from
     @safe@ in the "Control.Error" module, so they are not provided here.
@@ -15,7 +15,7 @@
 
     * Most parsers
 
-    * 'EitherT' (if the left value is a 'Monoid')
+    * 'ExceptT' (if the left value is a 'Monoid')
 -}
 
 module Control.Error.Safe (
@@ -38,7 +38,7 @@ module Control.Error.Safe (
     assertErr,
     justErr,
 
-    -- * EitherT-compatible functions
+    -- * ExceptT-compatible functions
     tryTail,
     tryInit,
     tryHead,
@@ -71,9 +71,9 @@ module Control.Error.Safe (
     rightZ
     ) where
 
-import Control.Error.Util (note)
+import Control.Error.Util (note, hoistEither)
 import Control.Monad (MonadPlus(mzero))
-import Control.Monad.Trans.Either (EitherT, hoistEither)
+import Control.Monad.Trans.Except (ExceptT)
 import qualified Safe as S
 
 -- | An assertion that fails in the 'Maybe' monad
@@ -136,60 +136,60 @@ assertErr e p = if p then Right () else Left e
 justErr :: e -> Maybe a -> Either e a
 justErr e = maybe (Left e) Right
 
--- | A 'tail' that fails in the 'EitherT' monad
-tryTail :: (Monad m) => e -> [a] -> EitherT e m [a]
+-- | A 'tail' that fails in the 'ExceptT' monad
+tryTail :: (Monad m) => e -> [a] -> ExceptT e m [a]
 tryTail e xs = hoistEither $ tailErr e xs
 
--- | An 'init' that fails in the 'EitherT' monad
-tryInit :: (Monad m) => e -> [a] -> EitherT e m [a]
+-- | An 'init' that fails in the 'ExceptT' monad
+tryInit :: (Monad m) => e -> [a] -> ExceptT e m [a]
 tryInit e xs = hoistEither $ initErr e xs
 
--- | A 'head' that fails in the 'EitherT' monad
-tryHead :: (Monad m) => e -> [a] -> EitherT e m a
+-- | A 'head' that fails in the 'ExceptT' monad
+tryHead :: (Monad m) => e -> [a] -> ExceptT e m a
 tryHead e xs = hoistEither $ headErr e xs
 
--- | A 'last' that fails in the 'EitherT' monad
-tryLast :: (Monad m) => e -> [a] -> EitherT e m a
+-- | A 'last' that fails in the 'ExceptT' monad
+tryLast :: (Monad m) => e -> [a] -> ExceptT e m a
 tryLast e xs = hoistEither $ lastErr e xs
 
--- | A 'minimum' that fails in the 'EitherT' monad
-tryMinimum :: (Monad m, Ord a) => e -> [a] -> EitherT e m a
+-- | A 'minimum' that fails in the 'ExceptT' monad
+tryMinimum :: (Monad m, Ord a) => e -> [a] -> ExceptT e m a
 tryMinimum e xs = hoistEither $ maximumErr e xs
 
--- | A 'maximum' that fails in the 'EitherT' monad
-tryMaximum :: (Monad m, Ord a) => e -> [a] -> EitherT e m a
+-- | A 'maximum' that fails in the 'ExceptT' monad
+tryMaximum :: (Monad m, Ord a) => e -> [a] -> ExceptT e m a
 tryMaximum e xs = hoistEither $ maximumErr e xs
 
--- | A 'foldr1' that fails in the 'EitherT' monad
-tryFoldr1 :: (Monad m) => e -> (a -> a -> a) -> [a] -> EitherT e m a
+-- | A 'foldr1' that fails in the 'ExceptT' monad
+tryFoldr1 :: (Monad m) => e -> (a -> a -> a) -> [a] -> ExceptT e m a
 tryFoldr1 e step xs = hoistEither $ foldr1Err e step xs
 
--- | A 'foldl1' that fails in the 'EitherT' monad
-tryFoldl1 :: (Monad m) => e -> (a -> a -> a) -> [a] -> EitherT e m a
+-- | A 'foldl1' that fails in the 'ExceptT' monad
+tryFoldl1 :: (Monad m) => e -> (a -> a -> a) -> [a] -> ExceptT e m a
 tryFoldl1 e step xs = hoistEither $ foldl1Err e step xs
 
--- | A 'foldl1'' that fails in the 'EitherT' monad
-tryFoldl1' :: (Monad m) => e -> (a -> a -> a) -> [a] -> EitherT e m a
+-- | A 'foldl1'' that fails in the 'ExceptT' monad
+tryFoldl1' :: (Monad m) => e -> (a -> a -> a) -> [a] -> ExceptT e m a
 tryFoldl1' e step xs = hoistEither $ foldl1Err' e step xs
 
--- | A ('!!') that fails in the 'EitherT' monad
-tryAt :: (Monad m) => e -> [a] -> Int -> EitherT e m a
+-- | A ('!!') that fails in the 'ExceptT' monad
+tryAt :: (Monad m) => e -> [a] -> Int -> ExceptT e m a
 tryAt e xs n = hoistEither $ atErr e xs n
 
--- | A 'read' that fails in the 'EitherT' monad
-tryRead :: (Monad m, Read a) => e -> String -> EitherT e m a
+-- | A 'read' that fails in the 'ExceptT' monad
+tryRead :: (Monad m, Read a) => e -> String -> ExceptT e m a
 tryRead e str = hoistEither $ readErr e str
 
--- | An assertion that fails in the 'EitherT' monad
-tryAssert :: (Monad m) => e -> Bool -> EitherT e m ()
+-- | An assertion that fails in the 'ExceptT' monad
+tryAssert :: (Monad m) => e -> Bool -> ExceptT e m ()
 tryAssert e p = hoistEither $ assertErr e p
 
--- | A 'fromJust' that fails in the 'EitherT' monad
-tryJust :: (Monad m) => e -> Maybe a -> EitherT e m a
+-- | A 'fromJust' that fails in the 'ExceptT' monad
+tryJust :: (Monad m) => e -> Maybe a -> ExceptT e m a
 tryJust e m = hoistEither $ justErr e m
 
--- | A 'fromRight' that fails in the 'EitherT' monad
-tryRight :: (Monad m) => Either e a -> EitherT e m a
+-- | A 'fromRight' that fails in the 'ExceptT' monad
+tryRight :: (Monad m) => Either e a -> ExceptT e m a
 tryRight = hoistEither
 
 -- | A 'tail' that fails using 'mzero'

Control/Error/Script.hs

@@ -1,6 +1,6 @@
 {-|
     Use this module if you like to write simple scripts with 'String'-based
-    errors, but you prefer to use 'EitherT' to handle errors rather than
+    errors, but you prefer to use 'ExceptT' to handle errors rather than
     @Control.Exception@.
 
 > import Control.Error
@@ -21,7 +21,7 @@ module Control.Error.Script (
 import Control.Exception (try, SomeException)
 import Control.Monad (liftM)
 import Control.Monad.IO.Class (MonadIO(liftIO))
-import Control.Monad.Trans.Either (EitherT(EitherT, runEitherT))
+import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
 import Control.Error.Util (errLn)
 import Data.EitherR (fmapL)
 import System.Environment (getProgName)
@@ -32,15 +32,15 @@ import Control.Monad.Trans.Class (lift)
 import System.IO (stderr)
 
 -- | An 'IO' action that can fail with a 'String' error message
-type Script = EitherT String IO
+type Script = ExceptT String IO
 
 {-| Runs the 'Script' monad
 
     Prints the first error to 'stderr' and exits with 'exitFailure'
 -}
 runScript :: Script a -> IO a
 runScript s = do
-    e <- runEitherT s
+    e <- runExceptT s
     case e of
         Left  e -> do
             errLn =<< liftM (++ ": " ++ e) getProgName
@@ -52,8 +52,8 @@ runScript s = do
 
     Note that 'scriptIO' is compatible with the 'Script' monad.
 -}
-scriptIO :: (MonadIO m) => IO a -> EitherT String m a
-scriptIO = EitherT
+scriptIO :: (MonadIO m) => IO a -> ExceptT String m a
+scriptIO = ExceptT
          . liftIO
          . liftM (fmapL show)
          . (try :: IO a -> IO (Either SomeException a))

Control/Error/Util.hs

@@ -8,6 +8,7 @@ module Control.Error.Util (
     note,
     noteT,
     hoistMaybe,
+    hoistEither,
     (??),
     (!?),
     failWith,
@@ -33,10 +34,12 @@ module Control.Error.Util (
     AllE(..),
     AnyE(..),
 
-    -- * EitherT
+    -- * ExceptT
     isLeftT,
     isRightT,
     fmapRT,
+    exceptT,
+    bimapExceptT,
 
     -- * Error Reporting
     err,
@@ -51,65 +54,83 @@ import Control.Applicative (Applicative, pure, (<$>))
 import qualified Control.Exception as Ex
 import Control.Monad (liftM)
 import Control.Monad.IO.Class (MonadIO(liftIO))
-import Control.Monad.Trans.Either (EitherT(EitherT), runEitherT, eitherT)
+import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
 import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)
 import Data.Dynamic (Dynamic)
 import Data.Monoid (Monoid(mempty, mappend))
 import Data.Maybe (fromMaybe)
 import System.Exit (ExitCode)
 import System.IO (hPutStr, hPutStrLn, stderr)
 
+-- | Fold an 'ExceptT' by providing one continuation for each constructor
+exceptT :: Monad m => (a -> m c) -> (b -> m c) -> ExceptT a m b -> m c
+exceptT f g (ExceptT m) = m >>= \z -> case z of
+    Left  a -> f a
+    Right b -> g b
+{-# INLINEABLE exceptT #-}
+
+-- | Transform the left and right value
+bimapExceptT :: Functor m => (e -> f) -> (a -> b) -> ExceptT e m a -> ExceptT f m b
+bimapExceptT f g (ExceptT m) = ExceptT (fmap h m)
+  where
+    h (Left e)  = Left  (f e)
+    h (Right a) = Right (g a)
+{-# INLINEABLE bimapExceptT #-}
+
+-- | Upgrade an 'Either' to an 'ExceptT'
+hoistEither :: Monad m => Either e a -> ExceptT e m a
+hoistEither = ExceptT . return
+{-# INLINEABLE hoistEither #-}
+
 {- $conversion
     Use these functions to convert between 'Maybe', 'Either', 'MaybeT', and
-    'EitherT'.
-
-    Note that 'hoistEither' and 'eitherT' are provided by the @either@ package.
+    'ExceptT'.
 -}
 -- | Suppress the 'Left' value of an 'Either'
 hush :: Either a b -> Maybe b
 hush = either (const Nothing) Just
 
--- | Suppress the 'Left' value of an 'EitherT'
-hushT :: (Monad m) => EitherT a m b -> MaybeT m b
-hushT = MaybeT . liftM hush . runEitherT
+-- | Suppress the 'Left' value of an 'ExceptT'
+hushT :: (Monad m) => ExceptT a m b -> MaybeT m b
+hushT = MaybeT . liftM hush . runExceptT
 
 -- | Tag the 'Nothing' value of a 'Maybe'
 note :: a -> Maybe b -> Either a b
 note a = maybe (Left a) Right
 
 -- | Tag the 'Nothing' value of a 'MaybeT'
-noteT :: (Monad m) => a -> MaybeT m b -> EitherT a m b
-noteT a = EitherT . liftM (note a) . runMaybeT
+noteT :: (Monad m) => a -> MaybeT m b -> ExceptT a m b
+noteT a = ExceptT . liftM (note a) . runMaybeT
 
 -- | Lift a 'Maybe' to the 'MaybeT' monad
 hoistMaybe :: (Monad m) => Maybe b -> MaybeT m b
 hoistMaybe = MaybeT . return
 
--- | Convert a 'Maybe' value into the 'EitherT' monad
-(??) :: Applicative m => Maybe a -> e -> EitherT e m a
-(??) a e = EitherT (pure $ note e a)
+-- | Convert a 'Maybe' value into the 'ExceptT' monad
+(??) :: Applicative m => Maybe a -> e -> ExceptT e m a
+(??) a e = ExceptT (pure $ note e a)
 
--- | Convert an applicative 'Maybe' value into the 'EitherT' monad
-(!?) :: Applicative m => m (Maybe a) -> e -> EitherT e m a
-(!?) a e = EitherT (note e <$> a)
+-- | Convert an applicative 'Maybe' value into the 'ExceptT' monad
+(!?) :: Applicative m => m (Maybe a) -> e -> ExceptT e m a
+(!?) a e = ExceptT (note e <$> a)
 
 -- | An infix form of 'fromMaybe' with arguments flipped.
 (?:) :: Maybe a -> a -> a
 maybeA ?: b = fromMaybe b maybeA
 {-# INLINABLE (?:) #-}
 
-{-| Convert a 'Maybe' value into the 'EitherT' monad
+{-| Convert a 'Maybe' value into the 'ExceptT' monad
 
     Named version of ('??') with arguments flipped
 -}
-failWith :: Applicative m => e -> Maybe a -> EitherT e m a
+failWith :: Applicative m => e -> Maybe a -> ExceptT e m a
 failWith e a = a ?? e
 
-{- | Convert an applicative 'Maybe' value into the 'EitherT' monad
+{- | Convert an applicative 'Maybe' value into the 'ExceptT' monad
 
     Named version of ('!?') with arguments flipped
 -}
-failWithM :: Applicative m => e -> m (Maybe a) -> EitherT e m a
+failWithM :: Applicative m => e -> m (Maybe a) -> ExceptT e m a
 failWithM e a = a !? e
 
 {- | Case analysis for the 'Bool' type.
@@ -186,20 +207,20 @@ instance (Monoid e, Monoid r) => Monoid (AnyE e r) where
     mappend (AnyE (Left  _)) (AnyE (Right y)) = AnyE (Right y)
     mappend (AnyE (Left  x)) (AnyE (Left  y)) = AnyE (Left  (mappend x y))
 
--- | Analogous to 'isLeft', but for 'EitherT'
-isLeftT :: (Monad m) => EitherT a m b -> m Bool
-isLeftT = eitherT (\_ -> return True) (\_ -> return False)
+-- | Analogous to 'isLeft', but for 'ExceptT'
+isLeftT :: (Monad m) => ExceptT a m b -> m Bool
+isLeftT = exceptT (\_ -> return True) (\_ -> return False)
 {-# INLINABLE isLeftT #-}
 
--- | Analogous to 'isRight', but for 'EitherT'
-isRightT :: (Monad m) => EitherT a m b -> m Bool
-isRightT = eitherT (\_ -> return False) (\_ -> return True)
+-- | Analogous to 'isRight', but for 'ExceptT'
+isRightT :: (Monad m) => ExceptT a m b -> m Bool
+isRightT = exceptT (\_ -> return False) (\_ -> return True)
 {-# INLINABLE isRightT #-}
 
-{- | 'fmap' specialized to 'EitherT', given a name symmetric to
+{- | 'fmap' specialized to 'ExceptT', given a name symmetric to
      'Data.EitherR.fmapLT'
 -}
-fmapRT :: (Monad m) => (a -> b) -> EitherT l m a -> EitherT l m b
+fmapRT :: (Monad m) => (a -> b) -> ExceptT l m a -> ExceptT l m b
 fmapRT = liftM
 
 -- | Write a string to standard error
@@ -210,15 +231,15 @@ err = hPutStr stderr
 errLn :: String -> IO ()
 errLn = hPutStrLn stderr
 
--- | Catch 'Ex.IOException's and convert them to the 'EitherT' monad
-tryIO :: (MonadIO m) => IO a -> EitherT Ex.IOException m a
-tryIO = EitherT . liftIO . Ex.try
+-- | Catch 'Ex.IOException's and convert them to the 'ExceptT' monad
+tryIO :: (MonadIO m) => IO a -> ExceptT Ex.IOException m a
+tryIO = ExceptT . liftIO . Ex.try
 
 {-| Catch all exceptions, except for asynchronous exceptions found in @base@
-    and convert them to the 'EitherT' monad
+    and convert them to the 'ExceptT' monad
 -}
-syncIO :: MonadIO m => IO a -> EitherT Ex.SomeException m a
-syncIO a = EitherT . liftIO $ Ex.catches (Right <$> a)
+syncIO :: MonadIO m => IO a -> ExceptT Ex.SomeException m a
+syncIO a = ExceptT . liftIO $ Ex.catches (Right <$> a)
     [ Ex.Handler $ \e -> Ex.throw (e :: Ex.ArithException)
     , Ex.Handler $ \e -> Ex.throw (e :: Ex.ArrayException)
     , Ex.Handler $ \e -> Ex.throw (e :: Ex.AssertionFailed)