enclosed-exceptions (empty) → 1.0.0

raw patch · 5 files changed

+265/−0 lines, 5 filesdep +QuickCheckdep +asyncdep +basesetup-changed

Dependencies added: QuickCheck, async, base, deepseq, hspec, lifted-base, monad-control, transformers

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• enclosed-exceptions.cabal +42/−0
• src/Control/Exception/Enclosed.hs +149/−0
• test/main.hs +52/−0

@@ -0,0 +1,20 @@+Copyright (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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,42 @@+name:                enclosed-exceptions+version:             1.0.0+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.+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+  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+    ghc-options:     -Wall++source-repository head+  type:     git+  location: git://github.com/jcristovao/enclosed-exceptions.git

@@ -0,0 +1,149 @@+{-# 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:+--+-- <https://www.fpcomplete.com/user/snoyberg/general-haskell/exceptions/catching-all-exceptions>+--+-- and+--+-- <https://groups.google.com/forum/#!topic/haskell-cafe/e9H2I-3uVJE>+--+module Control.Exception.Enclosed+    ( -- ** Exceptions+      catchAny+    , handleAny+    , tryAny+    , catchAnyDeep+    , handleAnyDeep+    , 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.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 @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 @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+    return $!! 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 = 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+

@@ -0,0 +1,52 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# 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.Monad.IO.Class+import Control.Concurrent (throwTo, threadDelay, forkIO)+import Control.Exception.Enclosed++{-# ANN main ("HLint: ignore Redundant do"::String) #-}+main :: IO ()+main = hspec $ do+    describe "any exceptions" $ do+        it "catchAny" $ do+            failed <- newIORef 0+            tid <- forkIO $ do+                catchAny+                    (threadDelay 20000)+                    (const $ writeIORef failed 1)+                writeIORef failed 2+            threadDelay 10000+            throwTo tid DummyException+            threadDelay 50000+            didFail <- readIORef failed+            liftIO $ didFail `shouldBe` (0 :: Int)+        it "tryAny" $ do+            failed <- newIORef False+            tid <- forkIO $ do+                _ <- tryAny $ threadDelay 20000+                writeIORef failed True+            threadDelay 10000+            throwTo tid DummyException+            threadDelay 50000+            didFail <- readIORef failed+            liftIO $ didFail `shouldBe` False+        it "tryAnyDeep" $ do+            eres <- tryAnyDeep $ return $ throw DummyException+            case eres of+                Left e+                    | Just DummyException <- fromException e -> return ()+                    | otherwise -> error "Expected a DummyException"+                Right () -> error "Expected an exception" :: IO ()++data DummyException = DummyException+    deriving (Show, Typeable)+instance Exception DummyException++