packages feed

transformers-either 0.0.2 → 0.1.0

raw patch · 3 files changed

+184/−8 lines, 3 filesdep +exceptions

Dependencies added: exceptions

Files

src/Control/Monad/Trans/Either.hs view
@@ -17,8 +17,8 @@ module Control.Monad.Trans.Either (   -- * Control.Monad.Trans.Either     EitherT-  , newEitherT   , pattern EitherT+  , newEitherT   , runEitherT   , eitherT   , left@@ -32,16 +32,37 @@   , secondEitherT   , hoistMaybe   , hoistEitherT+  , handleIOEitherT+  , handleEitherT+  , handlesEitherT+  , handleLeftT++  , catchIOEitherT+  , catchEitherT+  , catchesEitherT+  , catchLeftT++  , bracketEitherT+  , bracketExceptionT   ) where +import           Control.Exception (Exception, IOException, SomeException)+import qualified Control.Exception as Exception import           Control.Monad (Monad(..), (=<<))+import           Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, catchAll, mask, throwM)+import qualified Control.Monad.Catch as Catch+import           Control.Monad.IO.Class (MonadIO, liftIO)+import           Control.Monad.Trans.Class (lift) import           Control.Monad.Trans.Except (ExceptT(..))  import           Data.Maybe (Maybe, maybe) import           Data.Either (Either(..), either)-import           Data.Function ((.), id)+import           Data.Foldable (Foldable, foldr)+import           Data.Function (($), (.), const, id, flip) import           Data.Functor (Functor(..)) +import           System.IO (IO)+ ------------------------------------------------------------------------ -- Control.Monad.Trans.Either @@ -65,6 +86,9 @@   ExceptT {-# INLINE newEitherT #-} +-- | Map over both arguments at the same time.+--+-- Specialised version of 'bimap' for 'EitherT'. eitherT :: Monad m => (x -> m b) -> (a -> m b) -> EitherT x m a -> m b eitherT f g m =   either f g =<< runEitherT m@@ -88,7 +112,7 @@   EitherT . f . runEitherT {-# INLINE mapEitherT #-} --- | Hoist an "Either" into an "EitherT m"+-- | Hoist an 'Either' into an 'EitherT' m. hoistEither :: Monad m => Either x a -> EitherT x m a hoistEither =   EitherT . return@@ -116,14 +140,165 @@   bimapEitherT id {-# INLINE secondEitherT #-} --- | Hoist a 'Maybe a' into a 'Right a'+-- | Hoist 'Maybe' a into 'Right' a. hoistMaybe :: Monad m => x -> Maybe a -> EitherT x m a hoistMaybe x =   maybe (left x) return {-# INLINE hoistMaybe #-} --- | Hoist+-- | Hoist 'Either' m into an 'Either' n. hoistEitherT :: (forall b. m b -> n b) -> EitherT x m a -> EitherT x n a hoistEitherT f =   EitherT . f . runEitherT {-# INLINE hoistEitherT #-}++------------------------------------------------------------------------+-- Error handling++-- | Try an 'IO' action inside an 'EitherT'. If the 'IO' action throws an+-- 'IOException', catch it and wrap it with the provided handler to convert it+-- to the error type of the 'EitherT' transformer. Exceptions other than+-- 'IOException' will escape the EitherT transformer.+--+-- Note: 'IOError' is a type synonym for 'IOException'.+handleIOEitherT :: MonadIO m => (IOException -> x) -> IO a -> EitherT x m a+handleIOEitherT wrap =+  firstEitherT wrap . newEitherT . liftIO . Exception.try+{-# INLINE handleIOEitherT #-}++-- | Flipped 'handleIOEitherT'.+catchIOEitherT :: MonadIO m => IO a -> (IOException -> x) -> EitherT x m a+catchIOEitherT = flip handleIOEitherT+{-# INLINE catchIOEitherT #-}++-- | Try any monad action and catch the specified exception, wrapping it to+-- convert it to the error type of the 'EitherT' transformer. Exceptions other+-- that the specified exception type will escape the 'EitherT' transformer.+--+-- *Warning*: This function should be used with caution!+-- In particular, it is bad practice to catch 'SomeException' because that+-- includes asynchronous exceptions like stack/heap overflow, thread killed and+-- user interrupt. Trying to handle 'StackOverflow', 'HeapOverflow' and+-- 'ThreadKilled' exceptions could cause your program to crash or behave in+-- unexpected ways.+handleEitherT :: (MonadCatch m, Exception e) => (e -> x) -> m a -> EitherT x m a+handleEitherT wrap =+  firstEitherT wrap . newEitherT . Catch.try+{-# INLINE handleEitherT #-}++-- | Flipped 'handleEitherT'.+catchEitherT :: (MonadCatch m, Exception e) => m a -> (e -> x) -> EitherT x m a+catchEitherT = flip handleEitherT+{-# INLINE catchEitherT #-}++-- | Try a monad action and catch any of the exceptions caught by the provided+-- handlers. The handler for each exception type needs to wrap it to convert it+-- to the error type of the 'EitherT' transformer. Exceptions not explicitly+-- handled by the provided handlers will escape the 'EitherT' transformer.+handlesEitherT :: (Foldable f, MonadCatch m) => f (Handler m x) -> m a -> EitherT x m a+handlesEitherT wrappers action =+  newEitherT (fmap Right action `Catch.catch` fmap (fmap Left) handler)+  where+    handler e =+      let probe (Handler h) xs =+            maybe xs h (Exception.fromException e)+      in+        foldr probe (Catch.throwM e) wrappers++-- | Flipped 'handlesEitherT'.+catchesEitherT  :: (Foldable f, MonadCatch m) => m a -> f (Handler m x) -> EitherT x m a+catchesEitherT = flip handlesEitherT+{-# INLINE catchesEitherT #-}++-- | Handle an error. Equivalent to 'handleError' in mtl package.+handleLeftT :: Monad m => (e -> EitherT e m a) -> EitherT e m a -> EitherT e m a+handleLeftT handler thing = do+  r <- lift $ runEitherT thing+  case r of+    Left e ->+      handler e+    Right a ->+      return a+{-# INLINE handleLeftT #-}++-- | Flipped 'handleLeftT'.+catchLeftT  :: Monad m => EitherT e m a -> (e -> EitherT e m a) -> EitherT e m a+catchLeftT = flip handleLeftT+{-# INLINE catchLeftT #-}++-- | Acquire a resource in 'EitherT' and then perform an action with+-- it, cleaning up afterwards regardless of 'left'.+--+-- This function does not clean up in the event of an exception.+-- Prefer 'bracketExceptionT' in any impure setting.+bracketEitherT :: Monad m => EitherT e m a -> (a -> EitherT e m b) -> (a -> EitherT e m c) -> EitherT e m c+bracketEitherT before after thing = do+    a <- before+    r <- (\err -> after a >> left err) `handleLeftT` thing a+    -- If handleLeftT already triggered, then `after` already ran *and* we are+    -- in a Left state, so `after` will not run again here.+    _ <- after a+    return r+{-# INLINE bracketEitherT #-}++-- | Acquire a resource in EitherT and then perform an action with it,+-- cleaning up afterwards regardless of 'left' or exception.+--+-- Like 'bracketEitherT', but the cleanup is called even when the bracketed+-- function throws an exception. Exceptions in the bracketed function are caught+-- to allow the cleanup to run and then rethrown.+bracketExceptionT ::+     MonadMask m+  => EitherT e m a+  -> (a -> EitherT e m c)+  -> (a -> EitherT e m b)+  -> EitherT e m b+bracketExceptionT acquire release run =+  EitherT $ bracketF+    (runEitherT acquire)+    (\r -> case r of+      Left _ ->+        -- Acquire failed, we have nothing to release+        return . Right $ ()+      Right r' ->+        -- Acquire succeeded, we need to try and release+        runEitherT (release r') >>= \x -> return $ case x of+          Left err -> Left (Left err)+          Right _ -> Right ())+    (\r -> case r of+      Left err ->+        -- Acquire failed, we have nothing to run+        return . Left $ err+      Right r' ->+        -- Acquire succeeded, we can do some work+        runEitherT (run r'))+{-# INLINE bracketExceptionT #-}++-- This is for internal use only. The 'bracketF' function catches all exceptions+-- so the cleanup function can be called and then rethrow the exception.+data BracketResult a =+    BracketOk a+  | BracketFailedFinalizerOk SomeException+  | BracketFailedFinalizerError a++-- Bracket where you care about the output of the finalizer. If the finalizer fails+-- with a value level fail, it will return the result of the finalizer.+-- Finalizer:+--  - Left indicates a value level fail.+--  - Right indicates that the finalizer has a value level success, and its results can be ignored.+--+bracketF :: MonadMask m => m a -> (a -> m (Either b c)) -> (a -> m b) -> m b+bracketF a f g =+  mask $ \restore -> do+    a' <- a+    x <- restore (BracketOk `fmap` g a') `catchAll`+           (\ex -> either BracketFailedFinalizerError (const $ BracketFailedFinalizerOk ex) `fmap` f a')+    case x of+      BracketFailedFinalizerOk ex ->+        throwM ex+      BracketFailedFinalizerError b ->+        return b+      BracketOk b -> do+        z <- f a'+        return $ either id (const b) z+{-# INLINE bracketF #-}
src/Control/Monad/Trans/Either/Exit.hs view
@@ -17,7 +17,6 @@  import           Control.Monad.Trans.Either - -- | orDieWithCode with an exit code of 1 in case of an error -- orDie :: (e -> Text) -> EitherT e IO a -> IO a
transformers-either.cabal view
@@ -1,5 +1,5 @@ name:                  transformers-either-version:               0.0.2+version:               0.1.0 license:               BSD3 license-file:          LICENSE author:                Tim McGilchrist <timmcgil@gmail.com>@@ -14,7 +14,8 @@              Uses a pattern synonym to maintain compatibility with the old EitherT types             but is actually ExceptT under the covers.-+homepage:      http://github.com/tmcgilchrist/transformers-either/+bug-reports:   http://github.com/tmcgilchrist/transformers-either/issues source-repository head   type: git   location: https://github.com/tmcgilchrist/transformers-either.git@@ -23,6 +24,7 @@   build-depends:                        base                            >= 3          && < 5                      , text                            == 1.2.*+                     , exceptions                      >= 0.6        && < 0.9                      , transformers                    >= 0.4        && < 0.6    ghc-options: