enclosed-exceptions-1.0.1.1/0000755000000000000000000000000012504204507014010 5ustar0000000000000000enclosed-exceptions-1.0.1.1/LICENSE0000644000000000000000000000207512504204507015021 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. enclosed-exceptions-1.0.1.1/Setup.hs0000644000000000000000000000005612504204507015445 0ustar0000000000000000import Distribution.Simple main = defaultMain enclosed-exceptions-1.0.1.1/enclosed-exceptions.cabal0000644000000000000000000000356012504204507020753 0ustar0000000000000000name: enclosed-exceptions version: 1.0.1.1 synopsis: Catching all exceptions from within an enclosed computation description: Catching all exceptions raised within an enclosed computation, while remaining responsive to (external) asynchronous exceptions. For more information on the technique, please see: homepage: https://github.com/jcristovao/enclosed-exceptions license: MIT license-file: LICENSE author: Michael Snoyman, João Cristóvão maintainer: jmacristovao@gmail.com, michael@snoyman.com category: Control build-type: Simple cabal-version: >=1.8 library exposed-modules: Control.Exception.Enclosed hs-source-dirs: src build-depends: base >= 4 && < 5 , transformers , lifted-base >= 0.2 , monad-control , async >= 2.0 , deepseq , transformers-base ghc-options: -Wall -fno-warn-orphans test-suite test hs-source-dirs: src, test main-is: main.hs type: exitcode-stdio-1.0 build-depends: base , lifted-base >= 0.2 , monad-control , async >= 2.0 , deepseq , hspec >= 1.3 , QuickCheck , transformers , transformers-base ghc-options: -Wall source-repository head type: git location: git://github.com/jcristovao/enclosed-exceptions.git enclosed-exceptions-1.0.1.1/src/0000755000000000000000000000000012504204507014577 5ustar0000000000000000enclosed-exceptions-1.0.1.1/src/Control/0000755000000000000000000000000012504204507016217 5ustar0000000000000000enclosed-exceptions-1.0.1.1/src/Control/Exception/0000755000000000000000000000000012504204507020155 5ustar0000000000000000enclosed-exceptions-1.0.1.1/src/Control/Exception/Enclosed.hs0000644000000000000000000001337312504204507022254 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} -- | The purpose of this module is to allow you to capture all exceptions -- originating from within the enclosed computation, while still reacting -- to asynchronous exceptions aimed at the calling thread. -- -- This way, you can be sure that the function that calls, for example, -- @'catchAny'@, will still respond to @'ThreadKilled'@ or @'Timeout'@ -- events raised by another thread (with @'throwTo'@), while capturing -- all exceptions, synchronous or asynchronous, resulting from the -- execution of the enclosed computation. -- -- One particular use case is to allow the safe execution of code from various -- libraries (which you do not control), capturing any faults that might -- occur, while remaining responsive to higher level events and control -- actions. -- -- This library was originally developed by Michael Snoyman for the -- 'ClassyPrelude' library, and was latter 'spun-off' into a separate -- independent package. -- -- For a more detailed explanation of the motivation behind this functions, -- see: -- -- -- -- and -- -- -- module Control.Exception.Enclosed ( -- ** Exceptions catchAny , handleAny , tryAny , catchDeep , catchAnyDeep , handleAnyDeep , tryDeep , tryAnyDeep , catchIO , handleIO , tryIO -- ** Force types -- | Helper functions for situations where type inferer gets confused. , asIOException , asSomeException ) where import Prelude import Control.Exception.Lifted import Control.Monad (liftM) import Control.Monad.Base (liftBase) import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith, restoreM) import Control.Concurrent.Async (withAsync, waitCatch) import Control.DeepSeq (NFData, ($!!)) -- | A version of 'catch' which is specialized for any exception. This -- simplifies usage as no explicit type signatures are necessary. -- -- Note that since version 0.5.9, this function now has proper support for -- asynchronous exceptions, by only catching exceptions generated by the -- internal (enclosed) action. -- -- Since 0.5.6 catchAny :: MonadBaseControl IO m => m a -> (SomeException -> m a) -> m a catchAny action onE = tryAny action >>= either onE return -- | A version of 'handle' which is specialized for any exception. This -- simplifies usage as no explicit type signatures are necessary. -- -- Note that since version 0.5.9, this function now has proper support for -- asynchronous exceptions, by only catching exceptions generated by the -- internal (enclosed) action. -- -- Since 0.5.6 handleAny :: MonadBaseControl IO m => (SomeException -> m a) -> m a -> m a handleAny = flip catchAny -- | A version of 'try' which is specialized for any exception. -- This simplifies usage as no explicit type signatures are necessary. -- -- Note that since version 0.5.9, this function now has proper support for -- asynchronous exceptions, by only catching exceptions generated by the -- internal (enclosed) action. -- -- Since 0.5.6 tryAny :: MonadBaseControl IO m => m a -> m (Either SomeException a) tryAny m = liftBaseWith (\runInIO -> withAsync (runInIO m) waitCatch) >>= either (return . Left) (liftM Right . restoreM) -- | An extension to @catch@ which ensures that the return value is fully -- evaluated. See @tryAny@. -- -- Since 1.0.1 catchDeep :: (Exception e, NFData a, MonadBaseControl IO m) => m a -> (e -> m a) -> m a catchDeep action onE = tryDeep action >>= either onE return -- | An extension to @catchAny@ which ensures that the return value is fully -- evaluated. See @tryAnyDeep@. -- -- Since 0.5.9 catchAnyDeep :: (NFData a, MonadBaseControl IO m) => m a -> (SomeException -> m a) -> m a catchAnyDeep action onE = tryAnyDeep action >>= either onE return -- | @flip catchAnyDeep@ -- -- Since 0.5.6 handleAnyDeep :: (NFData a, MonadBaseControl IO m) => (SomeException -> m a) -> m a -> m a handleAnyDeep = flip catchAnyDeep -- | an extension to @try@ which ensures that the return value is fully -- evaluated. in other words, if you get a @right@ response here, you can be -- confident that using it will not result in another exception. -- -- Since 1.0.1 tryDeep :: (Exception e, NFData a, MonadBaseControl IO m) => m a -> m (Either e a) tryDeep m = try $ do x <- m liftBase $ evaluate $!! x -- | an extension to @tryany@ which ensures that the return value is fully -- evaluated. in other words, if you get a @right@ response here, you can be -- confident that using it will not result in another exception. -- -- Since 0.5.9 tryAnyDeep :: (NFData a, MonadBaseControl IO m) => m a -> m (Either SomeException a) tryAnyDeep m = tryAny $ do x <- m liftBase $ evaluate $!! x -- | A version of 'catch' which is specialized for IO exceptions. This -- simplifies usage as no explicit type signatures are necessary. -- -- Since 0.5.6 catchIO :: MonadBaseControl IO m => m a -> (IOException -> m a) -> m a catchIO = Control.Exception.Lifted.catch -- | A version of 'handle' which is specialized for IO exceptions. This -- simplifies usage as no explicit type signatures are necessary. -- -- Since 0.5.6 handleIO :: MonadBaseControl IO m => (IOException -> m a) -> m a -> m a handleIO = handle -- | A version of 'try' which is specialized for IO exceptions. -- This simplifies usage as no explicit type signatures are necessary. -- -- Since 0.5.6 tryIO :: MonadBaseControl IO m => m a -> m (Either IOException a) tryIO = try -- | -- -- Since 0.5.6 asSomeException :: SomeException -> SomeException asSomeException = id -- | -- -- Since 0.5.6 asIOException :: IOException -> IOException asIOException = id enclosed-exceptions-1.0.1.1/test/0000755000000000000000000000000012504204507014767 5ustar0000000000000000enclosed-exceptions-1.0.1.1/test/main.hs0000644000000000000000000002026412504204507016253 0ustar0000000000000000{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PatternGuards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} import Test.Hspec import Test.QuickCheck.Arbitrary () import Control.Exception.Lifted hiding (throwTo) import Data.IORef import Data.Typeable import Control.Concurrent (threadDelay) import Control.Concurrent.Async (async, cancelWith, waitCatch) import Control.Concurrent.MVar import Control.Exception.Enclosed import Control.Monad (forever) {-# ANN main ("HLint: ignore Redundant do"::String) #-} main :: IO () main = hspec $ do context "Unhandled.Exception" $ do -- const :: Catcher describe "const" $ do it "doesn't catch exceptions thrown from the inside" $ do const `catcherCatchesInside` False it "doesn't catch exceptions thrown from the outside" $ do const `catcherCatchesOutside` False it "doesn't catch exceptions lazily thrown in its pure result" $ do const `catcherCatchesDeep` False -- fmap Right :: Trier describe "fmap Right" $ do it "doesn't catch exceptions thrown from the inside" $ do fmap Right `trierCatchesInside` False it "doesn't catch exceptions thrown from the outside" $ do fmap Right `trierCatchesOutside` False it "doesn't catch exceptions lazily thrown in its pure result" $ do fmap Right `trierCatchesDeep` False context "Control.Exception" $ do describe "catch" $ do it "catches exceptions thrown from the inside" $ do catch `catcherCatchesInside` True it "catches exceptions thrown from the outside" $ do catch `catcherCatchesOutside` True it "doesn't catch exceptions lazily thrown in its pure result" $ do catch `catcherCatchesDeep` False describe "try" $ do it "catches exceptions thrown from the inside" $ do try `trierCatchesInside` True it "catches exceptions thrown from the outside" $ do try `trierCatchesOutside` True it "doesn't catch exceptions lazily thrown in its pure result" $ do try `trierCatchesDeep` False context "Control.Exception.Enclosed" $ do describe "catchAny" $ do it "catches exceptions thrown from the inside" $ do catchAny `catcherCatchesInside` True it "doesn't catch exceptions thrown from the outside" $ do catchAny `catcherCatchesOutside` False it "doesn't catch exceptions lazily thrown in its pure result" $ do catchAny `catcherCatchesDeep` False describe "catchDeep" $ do it "catches exceptions thrown from the inside" $ do catchDeep `catcherCatchesInside` True it "catches exceptions thrown from the outside" $ do catchDeep `catcherCatchesOutside` True it "catches exceptions lazily thrown in its pure result" $ do catchDeep `catcherCatchesDeep` True describe "tryAny" $ do it "catches exceptions thrown from the inside" $ do tryAny `trierCatchesInside` True it "doesn't catch exceptions thrown from the outside" $ do tryAny `trierCatchesOutside` False it "doesn't catch exceptions lazily thrown in its pure result" $ do tryAny `trierCatchesDeep` False describe "tryDeep" $ do it "catches exceptions thrown from the inside" $ do tryDeep `trierCatchesInside` True it "catches exceptions thrown from the outside" $ do tryDeep `trierCatchesOutside` True it "catches exceptions lazily thrown in its pure result" $ do tryDeep `trierCatchesDeep` True describe "tryAnyDeep" $ do it "catches exceptions thrown from the inside" $ do tryAnyDeep `trierCatchesInside` True it "doesn't catch exceptions thrown from the outside" $ do tryAnyDeep `trierCatchesOutside` False it "catches exceptions lazily thrown in its pure result" $ do tryAnyDeep `trierCatchesDeep` True type Catcher = IO () -> (SomeException -> IO ()) -> IO () type Trier = IO () -> IO (Either SomeException ()) -- Dummy exception types used just for testing. data DummyException = DummyException deriving (Show, Typeable) instance Exception DummyException -- A handler that fails the test if it catches the wrong type of exception. catchAssert :: forall e. Exception e => e -> IO () -> SomeException -> IO () catchAssert _ act se = case fromException se of Just (_ :: e) -> act Nothing -> expectationFailure "Caught an unexpected exception" -- Block a thread blockIndefinitely :: IO () blockIndefinitely = forever $ threadDelay maxBound -- Test whether a catcher will catch exceptions thrown from the inside. catcherCatchesInside :: Catcher -> Bool -> IO () catcherCatchesInside fCatch asExpected = do caughtRef <- newIORef False thread <- async $ do fCatch (throwIO DummyException) (catchAssert DummyException $ writeIORef caughtRef True) -- No known catchers will catch an exception without also handling it. readIORef caughtRef `shouldReturn` True _ <- waitCatch thread readIORef caughtRef `shouldReturn` asExpected -- Test whether a catcher will catch exceptions thrown from the outside. catcherCatchesOutside :: Catcher -> Bool -> IO () catcherCatchesOutside fCatch asExpected = do caughtRef <- newIORef False baton <- newEmptyMVar thread <- async $ do fCatch (do putMVar baton () -- DummyException can happen from here on blockIndefinitely) (catchAssert DummyException $ writeIORef caughtRef True) -- No known catchers will catch an exception without also handling it. readIORef caughtRef `shouldReturn` True takeMVar baton cancelWith thread DummyException _ <- waitCatch thread readIORef caughtRef `shouldReturn` asExpected -- Test whether a catcher will catch exceptions lazily thrown in a pure result. -- This is done by `return (throw DummyException)`, which will not -- raise the exception until the return value is forced. catcherCatchesDeep :: Catcher -> Bool -> IO () catcherCatchesDeep fCatch asExpected = do caughtRef <- newIORef False thread <- async $ do fCatch (return (throw DummyException)) (catchAssert DummyException $ writeIORef caughtRef True) _ <- waitCatch thread readIORef caughtRef `shouldReturn` asExpected -- Test whether a trier will catch exceptions thrown from the inside. trierCatchesInside :: Trier -> Bool -> IO () trierCatchesInside fTry asExpected = do caughtRef <- newIORef False thread <- async $ do _ <- fTry (throwIO DummyException) writeIORef caughtRef True _ <- waitCatch thread readIORef caughtRef `shouldReturn` asExpected -- Test whether a trier will catch exceptions thrown from the outside. trierCatchesOutside :: Trier -> Bool -> IO () trierCatchesOutside fTry asExpected = do caughtRef <- newIORef False baton <- newEmptyMVar thread <- async $ do _ <- fTry $ do putMVar baton () -- DummyException can happen from here on blockIndefinitely writeIORef caughtRef True takeMVar baton cancelWith thread DummyException _ <- waitCatch thread readIORef caughtRef `shouldReturn` asExpected -- Test whether a trier will catch exceptions lazily thrown in a pure result. -- This is done by `return (throw DummyException)`, which will not -- raise the exception until the return value is forced. trierCatchesDeep :: Trier -> Bool -> IO () trierCatchesDeep fTry asExpected = do eres <- fTry $ return $ throw DummyException let caughtDummyException = case eres of Left e | Just DummyException <- fromException e -> True | otherwise -> error "Caught an unexpected exception" Right _ -> False caughtDummyException `shouldBe` asExpected