safe-exceptions (empty) → 0.1.0.0

raw patch · 8 files changed

+860/−0 lines, 8 filesdep +basedep +exceptionsdep +hspecsetup-changed

Dependencies added: base, exceptions, hspec, safe-exceptions, transformers, void

Files

• ChangeLog.md +3/−0
• LICENSE +20/−0
• README.md +356/−0
• Setup.hs +2/−0
• safe-exceptions.cabal +38/−0
• src/Control/Exception/Safe.hs +345/−0
• test/Control/Exception/SafeSpec.hs +95/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,3 @@+## 0.1.0.0++* Initial releae

@@ -0,0 +1,20 @@+Copyright (c) 2016 FP Complete++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,356 @@+# safe-exceptions++*Safe, consistent, and easy exception handling*++__NOTE__: This library is early in its development, and there may be some+changes in the near future. See [possible future+changes](-exceptions#possible-future-changes).++[![Build Status](https://travis-ci.org/fpco/safe-exceptions.svg?branch=master)](https://travis-ci.org/fpco/safe-exceptions)++Runtime exceptions - as exposed in `base` by the `Control.Exception`+module - have long been an intimidating part of the Haskell+ecosystem. This package, and this README for the package, are intended+to overcome this. By providing an API that encourages best practices,+and explaining the corner cases clearly, the hope is to turn what was+previously something scary into an aspect of Haskell everyone feels+safe using.++## Goals++This package provides additional safety and simplicity versus+`Control.Exception` by having its functions recognize the difference between+synchronous and asynchronous exceptions. As described below, synchronous+exceptions are treated as _recoverable_, allowing you to catch and handle them+as well as clean up after them, whereas asynchronous exceptions can only be+cleaned up after. In particular, this library prevents you from making the+following mistakes:++* Catching and swallowing an asynchronous exception+* Throwing an asynchronous exception synchronously+* Throwing a synchronous exception asynchronously+* Swallowing asynchronous exceptions via failing cleanup handlers++## Quickstart++This section is intended to give you the bare minimum information to+use this library (and Haskell runtime exceptions in general)+correctly.++* Import the `Control.Exception.Safe` module. Do _not_ import+  `Control.Exception` itself, which lacks the safety guarantees that+  this library adds. Same applies to `Control.Monad.Catch`.+* If something can go wrong in your function, you can report this with+  the `throw`. (For compatible naming, there are synonyms for this of+  `throwIO` and `throwM`.)+* If you want to catch a specific type of exception, use `catch`,+  `handle`, or `try`.+* If you want to recover from _anything_ that may go wrong in a+  function, use `catchAny`, `handleAny`, or `tryAny`.+* If you want to launch separate threads and kill them externally, you+  should use the+  [async package](https://www.stackage.org/package/async).+* Unless you really know what you're doing, avoid the following functions:+    * `catchAsync`+    * `handleAsync`+    * `tryAsync`+    * `impureThrow`+    * `throwTo`+* If you need to perform some allocation or cleanup of resources, use+  one of the following functions (and _don't_ use the+  `catch`/`handle`/`try` family of functions):+    * `onException`+    * `withException`+    * `bracket`+    * `bracket_`+    * `finally`+    * `bracketOnError`+    * `bracketOnError_`++Hopefully this will be able to get you up-and-running quickly.++_Request to readers_: if there are specific workflows that you're+unsure of how to accomplish with this library, please ask so we can+develop a more full-fledged cookbook as a companion to this file.++## Terminology++We're going to define three different versions of exceptions. Note+that these definitions are based on _how the exception is thrown_, not+based on _what the exception itself is_:++* **Synchronous** exceptions are generated by the current+  thread. What's important about these is that we generally want to be+  able to recover from them. For example, if you try to read from a+  file, and the file doesn't exist, you may wish to use some default+  value instead of having your program exit, or perhaps prompt the+  user for a different file location.++*   **Asynchronous** exceptions are thrown by either a different user+    thread, or by the runtime system itself. For example, in the+    `async` package, `race` will kill the longer-running thread with+    an asynchronous exception. Similarly, the `timeout` function will+    kill an action which has run for too long. And the runtime system+    will kill threads which appear to be deadlocked on `MVar`s or+    `STM` actions.++    In contrast to synchronous exceptions, we almost never want to+    recover from asynchronous exceptions. In fact, this is a common+    mistake in Haskell code, and from what I've seen has been the+    largest source of confusion and concern amongst users when it+    comes to Haskell's runtime exception system.++*   **Impure** exceptions are hidden inside a pure value, and exposed+    by forcing evaluation of that value. Examples are `error`,+    `undefined`, and `impureThrow`. Additionally, incomplete pattern+    matches can generate impure exceptions. Ultimately, when these+    pure values are forced and the exception is exposed, it is thrown+    as a synchronous exception.++    Since they are ultimately thrown as synchronous exceptions, when+    it comes to handling them, we want to treat them in all ways like+    synchronous exceptions. Based on the comments above, that means we+    want to be able to recover from impure exceptions.++## Why catch asynchronous exceptions?++If we never want to be able to recover from asynchronous exceptions,+why do we want to be able to catch them at all? The answer is for+_resource cleanup_. For both sync and async exceptions, we would like+to be able to acquire resources - like file descriptors - and register+a cleanup function which is guaranteed to be run. This is exemplified+by functions like `bracket` and `withFile`.++So to summarize:++* All synchronous exceptions should be recoverable+* All asynchronous exceptions should not be recoverable+* In both cases, cleanup code needs to work reliably++## Determining sync vs async++Unfortunately, GHC's runtime system provides no way to determine if an+exception was thrown synchronously or asynchronously, but this+information is vitally important. There are two general approaches to+dealing with this:++* Run an action in a separate thread, don't give that thread's ID to+  anyone else, and assume that any exception that kills it is a+  synchronous exception. This approach is covered in the School of+  Haskell article+  [catching all exceptions](https://www.schoolofhaskell.com/user/snoyberg/general-haskell/exceptions/catching-all-exceptions),+  and is provided by the+  [enclosed-exceptions](https://www.stackage.org/package/enclosed-exceptions)+  package.++* Make assumptions based on the type of an exception, assuming that+  certain exception types are only thrown synchronously and certain+  only asynchronously.++Both of these approaches have downsides. For the downsides the+type-based approach, see the caveats section at the end. The problems+with the first are more interesting to us here:++* It's much more expensive to fork a thread every time we want to deal+  with exceptions+* It's not fully reliable: it's possible for the thread ID of the+  forked thread to leak somewhere, or the runtime system to send it an+  async exception+* While this works for actions living in `IO`, it gets trickier for+  pure functions and monad transformer stacks. The latter issue is+  solved via monad-control and the exceptions packages. The former+  issue, however, means that it's impossible to provide a universal+  interface for failure for pure and impure actions. This may seem+  esoteric, and if so, don't worry about it too much.++Therefore, this package takes the approach of trusting type+information to determine if an exception is asynchronous or+synchronous. The details are less interesting to a user, but the+basics are: we leverage the extensible extension system in GHC and+state that any extension type which is a child of `SomeAsyncException`+is an async exception. All other exception types are assumed to be+synchronous.++## Handling of sync vs async exceptions++Once we're able to distinguish between sync and async exceptions, and+we know our goals with sync vs async, how we handle things is pretty+straightforward:++* If the user is trying to install a cleanup function (such as with+  `bracket` or `finally`), we don't care if the exception is sync or+  async: call the cleanup function and then rethrow the exception.+* If the user is trying to catch an exception and recover from it,+  only catch sync exceptions and immediately rethrow async exceptions.++With this explanation, it's useful to consider async exceptions as+"stronger" or more severe than sync exceptions, as the next section+will demonstrate.++## Exceptions in cleanup code++One annoying corner case is: what happens if, when running a cleanup function after an exception was thrown, the cleanup function _itself_ throws an exception. For this, we'll consider ``action `onException` cleanup``. There are four different possibilities:++* `action` threw sync, `cleanup` threw sync+* `action` threw sync, `cleanup` threw async+* `action` threw async, `cleanup` threw sync+* `action` threw async, `cleanup` threw async++Our guiding principle is: we cannot hide a more severe exception with+a less severe exception. For example, if `action` threw a sync+exception, and then `cleanup` threw an async exception, it would be a+mistake to rethrow the sync exception thrown by `action`, since it+would allow the user to recover when that is not desired.++Therefore, this library will always throw an async exception if either+the action or cleanup thows an async exception. Other than that, the+behavior is currently undefined as to which of the two exceptions will+be thrown. The library reserves the right to throw away either of the+two thrown exceptions, or generate a new exception value completely.++## Typeclasses++The [exceptions package](https://www.stackage.org/package/exceptions)+provides an abstraction for throwing, catching, and cleaning up from+exceptions for many different monads. This library leverages those+type classes to generalize our functions.++## Naming++There are a few choices of naming that differ from the base libraries:++* `throw` in this library is for synchronously throwing within a+  monad, as opposed to in base where `throwIO` serves this purpose and+  `throw` is for impure throwing. This library provides `impureThrow`+  for the latter case, and also provides convenience synonyms+  `throwIO` and `throwM` for `throw`.+* The `catch` function in this package will not catch async+  exceptions. Please use `catchAsync` if you really want to catch+  those, though it's usually better to use a function like `bracket`+  or `withException` with ensure that the thrown exception is+  rethrown.++## Caveats++Let's talk about the caveats to keep in mind when using this library.++### Checked vs unchecked++There is a big debate and difference of opinion regarding checked+versus unchecked exceptions. With checked exceptions, a function+states explicitly exactly what kinds of exceptions it can throw. With+unchecked exceptions, it simply says "I can throw some kind of+exception." Java is probably the most famous example of a checked+exception system, with many other languages (including C#, Python, and+Ruby) having unchecked exceptions.++As usual, Haskell makes this interesting. Runtime exceptions are most+assuredly unchecked: all exceptions are converted to `SomeException`+via the `Exception` typeclass, and function signatures do not state+which specific exception types can be thrown (for more on this, see+next caveat). Instead, this information is relegated to documentation,+and unfortunately is often not even covered there.++By contrast, approaches like `ExceptT` and `EitherT` are very explicit+in the type of exceptions that can be thrown. The cost of this is that+there is extra overhead necessary to work with functions that can+return different types of exceptions, usually by wrapping all possible+exceptions in a sum type.++This library isn't meant to settle the debate on checked vs unchecked,+by rather to bring sanity to Haskell's runtime exception system. As+such, this library is decidedly in the unchecked exception camp,+purely by virtue of the fact that the underlying mechanism is as well.++### Explicit vs implicit++Another advantage of the `ExceptT`/`EitherT` approach is that you are+explicit in your function signature that a function may fail. However,+the reality of Haskell's standard libraries are that many, if not the+vast majority, of `IO` actions can throw some kind of exception. In+fact, once async exceptions are considered, _every_ `IO` action can+throw an exception.++Once again, this library deals with the status quo of runtime+exceptions being ubiquitous, and gives the rule: you should consider+the `IO` type as meaning _both_ that a function modifies the outside+world, _and_ may throw an exception (and, based on the previous+caveat, may throw _any type_ of exception it feels like).++There are attempts at alternative approaches here, such as+[unexceptionalio](https://www.stackage.org/package/unexceptionalio). Again,+this library isn't making a value statement on one approach versus+another, but rather trying to make today's runtime exceptions in+Haskell better.++### Type-based differentiation++As explained above, this library makes heavy usage of type information+to differentiate between sync and async exceptions. While the approach+used is fairly well respected in the Haskell ecosystem today, it's+certainly not universal, and definitely not enforced by the+`Control.Exception` module. In particular, `throwIO` will allow you to+synchronously throw an exception with an asynchronous type, and+`throwTo` will allow you to asynchronously throw an exception with a+synchronous type.++The functions in this library prevent that from happening via+exception type wrappers, but if an underlying library does something+surprising, the functions here may not work correctly. Further, even+when using this library, you may be surprised by the fact that ``throw+Foo `catch` (\Foo -> ...)`` won't actually trigger the exception+handler if `Foo` looks like an asynchronous exception.++The ideal solution is to make a stronger distinction in the core+libraries themselves between sync and async exceptions.++### Deadlock detection exceptions++Two exceptions types which are handled surprisingly are+`BlockedIndefinitelyOnMVar` and `BlockedIndefinitelyOnSTM`. Even+though these exceptions are thrown asynchronously by the runtime+system, for our purposes we treat them as synchronous. The reasons are+twofold:++* There is a specific action taken in the local thread - blocking on a+  variable which will never change - which causes the exception to be+  raised. This makes their behavior very similar to synchronous+  exceptions. In fact, one could argue that a function like `takeMVar`+  is synchronously throwing `BlockedIndefinitelyOnMVar`+* By our standards of recoverable vs non-recoverable, these exceptions+  certainly fall into the recoverable category. Unlike an intentional+  kill signal from another thread or the user (via Ctrl-C), we would+  like to be able to detect the we entered a deadlock condition and do+  something intelligent in an application.++## Possible future changes++### Interruptible vs uninterruptible masking++This discussion is now being tracked at:+https://github.com/fpco/safe-exceptions/issues/3++In `Control.Exception`, allocation functions and cleanup handlers in+combinators like `bracket` are masked using the (interruptible) `mask`+function, in contrast to `uninterruptibleMask`. There have been some debates+about the correctness of this in the past, notably [a libraries mailing list+discussion kicked off by Eyal+Lotem](https://mail.haskell.org/pipermail/libraries/2014-September/023675.html).+It seems that general consensus is:++* `uninterruptibleMask` is a better choice+* But changing the core library like this would potentially break too many+  programs++In its current version, this library uses `mask` (interruptible) for allocation+functions and `uninterruptibleMask` cleanup handlers. This is a debatable+decision (and one worth debating!). An example of alternatives would be:++* Use `uninterruptibleMask` for both allocation and cleanup pieces+* Match `Control.Exception`'s behavior+* Provide two versions of each function, or possibly two modules++### Naming of the synchronous monadic throwing function++We may decide to rename `throw` to something else at some point. Please see+https://github.com/fpco/safe-exceptions/issues/4

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

@@ -0,0 +1,38 @@+name:                safe-exceptions+version:             0.1.0.0+synopsis:            Safe, consistent, and easy exception handling+description:         Please see README.md+homepage:            https://github.com/githubuser/safe-exceptions#readme+license:             MIT+license-file:        LICENSE+author:              Michael Snoyman+maintainer:          michael@fpcomplete.com+copyright:           2016 FP Complete+category:            Control+build-type:          Simple+extra-source-files:  README.md ChangeLog.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Control.Exception.Safe+  build-depends:       base >= 4.7 && < 4.10+                     , exceptions >= 0.8 && < 0.9+                     , transformers >= 0.2 && < 0.6+  default-language:    Haskell2010++test-suite safe-exceptions-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       Control.Exception.SafeSpec+  build-depends:       base+                     , hspec+                     , safe-exceptions+                     , void+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/fpco/safe-exceptions

@@ -0,0 +1,345 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | Please see the README.md file in the safe-exceptions repo for+-- information on how to use this module. Relevant links:+--+-- * https://github.com/fpco/safe-exceptions#readme+--+-- * https://www.stackage.org/package/safe-exceptions+module Control.Exception.Safe+    ( -- * Throwing+      throw+    , throwIO+    , throwM+    , throwTo+    , impureThrow+      -- * Catching (with recovery)+    , catch+    , catchAny+    , catchAsync++    , handle+    , handleAny+    , handleAsync++    , try+    , tryAny+    , tryAsync++      -- * Cleanup (no recovery)+    , onException+    , bracket+    , bracket_+    , finally+    , withException+    , bracketOnError+    , bracketOnError_++      -- * Coercion to sync and async+    , SyncExceptionWrapper (..)+    , toSyncException+    , AsyncExceptionWrapper (..)+    , toAsyncException++      -- * Check exception type+    , isSyncException+    , isAsyncException+      -- * Reexports+    , C.MonadThrow+    , C.MonadCatch+    , C.MonadMask (..)+    , C.mask_+    , C.uninterruptibleMask_+    , C.catchIOError+    , C.handleIOError+    -- FIXME , C.tryIOError+    , C.Handler (..)+    , Exception (..)+    , SomeException (..)+    , SomeAsyncException (..)+    , E.IOException+    ) where++import Control.Concurrent (ThreadId)+import Control.Exception (Exception (..), SomeException (..), SomeAsyncException (..))+import qualified Control.Exception as E+import qualified Control.Monad.Catch as C+import Control.Monad (liftM)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Typeable (Typeable, cast)++-- | Synchronously throw the given exception+--+-- @since 0.1.0.0+throw :: (C.MonadThrow m, Exception e) => e -> m a+throw = C.throwM . toSyncException++-- | Synonym for 'throw'+--+-- @since 0.1.0.0+throwIO :: (C.MonadThrow m, Exception e) => e -> m a+throwIO = throw++-- | Synonym for 'throw'+--+-- @since 0.1.0.0+throwM :: (C.MonadThrow m, Exception e) => e -> m a+throwM = throw++-- | Throw an asynchronous exception to another thread+--+-- It's usually a better idea to use the async package, see+-- <https://github.com/fpco/safe-exceptions#quickstart>+--+-- @since 0.1.0.0+throwTo :: (Exception e, MonadIO m) => ThreadId -> e -> m ()+throwTo tid = liftIO . E.throwTo tid . toAsyncException++-- | Generate a pure value which, when forced, will synchronously+-- throw the given exception+--+-- Generally it's better to avoid using this function and instead use 'throw',+-- see <https://github.com/fpco/safe-exceptions#quickstart>+--+-- @since 0.1.0.0+impureThrow :: Exception e => e -> a+impureThrow = E.throw++-- | Flipped version of 'catch'+--+-- @since 0.1.0.0+catch :: (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a+catch f g = f `C.catch` \e ->+    if isSyncException e+        then g e+        -- intentionally rethrowing an async exception synchronously,+        -- since we want to preserve async behavior+        else C.throwM e++-- | 'catch' specialized to catch all synchronous exception+--+-- @since 0.1.0.0+catchAny :: C.MonadCatch m => m a -> (SomeException -> m a) -> m a+catchAny = catch++-- | 'catch' without async exception safety+--+-- Generally it's better to avoid using this function since we do not want to+-- recover from async exceptions, see+-- <https://github.com/fpco/safe-exceptions#quickstart>+--+-- @since 0.1.0.0+catchAsync :: (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a+catchAsync = C.catch++-- | Flipped version of 'catch'+--+-- @since 0.1.0.0+handle :: (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a+handle = flip catch++-- | Flipped version of 'catchAny'+--+-- @since 0.1.0.0+handleAny :: C.MonadCatch m => (SomeException -> m a) -> m a -> m a+handleAny = flip catchAny++-- | Flipped version of 'catchAsync'+--+-- Generally it's better to avoid using this function since we do not want to+-- recover from async exceptions, see+-- <https://github.com/fpco/safe-exceptions#quickstart>+--+-- @since 0.1.0.0+handleAsync :: (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a+handleAsync = C.handle++-- | Same as upstream 'C.try', but will not catch asynchronous+-- exceptions+--+-- @since 0.1.0.0+try :: (C.MonadCatch m, E.Exception e) => m a -> m (Either e a)+try f = catch (liftM Right f) (return . Left)++-- | 'try' specialized to catch all synchronous exceptions+--+-- @since 0.1.0.0+tryAny :: C.MonadCatch m => m a -> m (Either SomeException a)+tryAny = try++-- | 'try' without async exception safety+--+-- Generally it's better to avoid using this function since we do not want to+-- recover from async exceptions, see+-- <https://github.com/fpco/safe-exceptions#quickstart>+--+-- @since 0.1.0.0+tryAsync :: (C.MonadCatch m, E.Exception e) => m a -> m (Either e a)+tryAsync = C.try++-- | Async safe version of 'E.onException'+--+-- @since 0.1.0.0+onException :: C.MonadMask m => m a -> m b -> m a+onException thing after = withException thing (\(_ :: SomeException) -> after)++-- | Like 'onException', but provides the handler the thrown+-- exception.+--+-- @since 0.1.0.0+withException :: (C.MonadMask m, E.Exception e) => m a -> (e -> m b) -> m a+withException thing after = C.uninterruptibleMask $ \restore -> do+    res1 <- C.try $ restore thing+    case res1 of+        Left e1 -> do+            -- see explanation in bracket+            _ :: Either SomeException b <- C.try $ after e1+            C.throwM e1+        Right x -> return x++-- | Async safe version of 'E.bracket'+--+-- @since 0.1.0.0+bracket :: forall m a b c. C.MonadMask m+        => m a -> (a -> m b) -> (a -> m c) -> m c+bracket before after thing = C.mask $ \restore -> do+    x <- before+    res1 <- C.try $ restore (thing x)+    case res1 of+        Left (e1 :: SomeException) -> do+            -- explicitly ignore exceptions from after. We know that+            -- no async exceptions were thrown there, so therefore+            -- the stronger exception must come from thing+            --+            -- https://github.com/fpco/safe-exceptions/issues/2+            _ :: Either SomeException b <-+                C.try $ C.uninterruptibleMask_ $ after x+            C.throwM e1+        Right y -> do+            C.uninterruptibleMask_ $ after x+            return y++-- | Async safe version of 'E.bracket_'+--+-- @since 0.1.0.0+bracket_ :: C.MonadMask m => m a -> m b -> m c -> m c+bracket_ before after thing = bracket before (const after) (const thing)++-- | Async safe version of 'E.finally'+--+-- @since 0.1.0.0+finally :: C.MonadMask m => m a -> m b -> m a+finally thing after = C.uninterruptibleMask $ \restore -> do+    res1 <- C.try $ restore thing+    case res1 of+        Left (e1 :: SomeException) -> do+            -- see bracket for explanation+            _ :: Either SomeException b <- C.try after+            C.throwM e1+        Right x -> do+            after+            return x++-- | Async safe version of 'E.bracketOnError'+--+-- @since 0.1.0.0+bracketOnError :: forall m a b c. C.MonadMask m+               => m a -> (a -> m b) -> (a -> m c) -> m c+bracketOnError before after thing = C.mask $ \restore -> do+    x <- before+    res1 <- C.try $ restore (thing x)+    case res1 of+        Left (e1 :: SomeException) -> do+            -- ignore the exception, see bracket for explanation+            _ :: Either SomeException b <-+                C.try $ C.uninterruptibleMask_ $ after x+            C.throwM e1+        Right y -> return y++-- | Async safe version of 'E.bracketOnError_'+--+-- @since 0.1.0.0+bracketOnError_ :: C.MonadMask m => m a -> m b -> m c -> m c+bracketOnError_ before after thing = bracketOnError before (const after) (const thing)++-- | Wrap up an asynchronous exception to be treated as a synchronous+-- exception+--+-- This is intended to be created via 'toSyncException'+--+-- @since 0.1.0.0+data SyncExceptionWrapper = forall e. Exception e => SyncExceptionWrapper e+    deriving Typeable+instance Show SyncExceptionWrapper where+    show (SyncExceptionWrapper e) = show e+instance Exception SyncExceptionWrapper where+#if MIN_VERSION_base(4,8,0)+    displayException (SyncExceptionWrapper e) = displayException e+#endif++-- | Convert an exception into a synchronous exception+--+-- For synchronous exceptions, this is the same as 'toException'.+-- For asynchronous exceptions, this will wrap up the exception with+-- 'SyncExceptionWrapper'+--+-- @since 0.1.0.0+toSyncException :: Exception e => e -> SomeException+toSyncException e =+    case fromException se of+        Just (SomeAsyncException _) -> toException (SyncExceptionWrapper e)+        Nothing -> se+  where+    se = toException e++-- | Wrap up a synchronous exception to be treated as an asynchronous+-- exception+--+-- This is intended to be created via 'toAsyncException'+--+-- @since 0.1.0.0+data AsyncExceptionWrapper = forall e. Exception e => AsyncExceptionWrapper e+    deriving Typeable+instance Show AsyncExceptionWrapper where+    show (AsyncExceptionWrapper e) = show e+instance Exception AsyncExceptionWrapper where+    toException = toException . SomeAsyncException+    fromException se = do+        SomeAsyncException e <- fromException se+        cast e+#if MIN_VERSION_base(4,8,0)+    displayException (AsyncExceptionWrapper e) = displayException e+#endif++-- | Convert an exception into an asynchronous exception+--+-- For asynchronous exceptions, this is the same as 'toException'.+-- For synchronous exceptions, this will wrap up the exception with+-- 'AsyncExceptionWrapper'+--+-- @since 0.1.0.0+toAsyncException :: Exception e => e -> SomeException+toAsyncException e =+    case fromException se of+        Just (SomeAsyncException _) -> se+        Nothing -> toException (AsyncExceptionWrapper e)+  where+    se = toException e++-- | Check if the given exception is synchronous+--+-- @since 0.1.0.0+isSyncException :: Exception e => e -> Bool+isSyncException e =+    case fromException (toException e) of+        Just (SomeAsyncException _) -> False+        Nothing -> True++-- | Check if the given exception is asynchronous+--+-- @since 0.1.0.0+isAsyncException :: Exception e => e -> Bool+isAsyncException = not . isSyncException+{-# INLINE isAsyncException #-}

@@ -0,0 +1,95 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Control.Exception.SafeSpec (spec) where++import Control.Concurrent (threadDelay, newEmptyMVar, forkIOWithUnmask, takeMVar, putMVar)+import Control.Exception (assert, ArithException (..), AsyncException (..), BlockedIndefinitelyOnMVar (..), BlockedIndefinitelyOnSTM (..))+import qualified Control.Exception as E+import Control.Exception.Safe+import Control.Monad (forever)+import Data.Void (Void, absurd)+import System.IO.Unsafe (unsafePerformIO)+import System.Timeout (timeout)+import Test.Hspec++-- | Ugly hack needed because the underlying type is not exported+timeoutException :: SomeException+timeoutException =+    case unsafePerformIO $ mask $ \restore -> timeout 1 $ tryAsync $ restore $ forever $ threadDelay maxBound of+        Nothing -> error "timeoutException returned Nothing"+        Just (Left e) -> e+        Just (Right e) -> absurd e++asyncE :: IO a+asyncE = E.throwIO ThreadKilled++syncE :: IO a+syncE = E.throwIO Overflow++-- | Maps each exception to whether it is synchronous+exceptions :: [(SomeException, Bool)]+exceptions =+    [ go Overflow True+    , go ThreadKilled False+    , go timeoutException False+    , go BlockedIndefinitelyOnMVar True -- see the README, this is weird+    , go BlockedIndefinitelyOnSTM True -- see the README, this is weird+    ]+  where+    go e b = (toException e, b)++withAll :: (SomeException -> Bool -> IO ()) -> Spec+withAll f = mapM_ (\(e, b) -> it (show e) (f e b)) exceptions++spec :: Spec+spec = do+    describe "isSyncException" $ withAll+        $ \e sync -> isSyncException e `shouldBe` sync+    describe "isAsncException" $ withAll+        $ \e sync -> isAsyncException e `shouldBe` not sync+    describe "toSyncException" $ withAll+        $ \e _ -> isSyncException (toSyncException e) `shouldBe` True+    describe "toAsyncException" $ withAll+        $ \e _ -> isAsyncException (toAsyncException e) `shouldBe` True++    let shouldBeSync :: Either SomeException Void -> IO ()+        shouldBeSync (Left e)+            | isSyncException e = return ()+            | otherwise = error $ "Unexpected async exception: " ++ show e+        shouldBeSync (Right x) = absurd x++        shouldBeAsync :: Either SomeException Void -> IO ()+        shouldBeAsync (Left e)+            | isAsyncException e = return ()+            | otherwise = error $ "Unexpected sync exception: " ++ show e+        shouldBeAsync (Right x) = absurd x++        shouldThrowSync f = E.try f >>= shouldBeSync+        shouldThrowAsync f = E.try f >>= shouldBeAsync++    describe "throw" $ withAll $ \e _ -> shouldThrowSync (throw e)+    describe "throwTo" $ withAll $ \e _ -> do+        var <- newEmptyMVar+        tid <- E.uninterruptibleMask_ $ forkIOWithUnmask $ \restore -> do+            res <- E.try $ restore $ forever $ threadDelay maxBound+            putMVar var res+        throwTo tid e+        res <- takeMVar var+        shouldBeAsync res++    describe "stays async" $ do+        let withPairs f = do+                it "sync/sync" $ shouldThrowSync $ f syncE syncE++                -- removing this case from consideration, since cleanup handlers+                -- cannot receive async exceptions. See+                -- https://github.com/fpco/safe-exceptions/issues/2+                --+                -- it "sync/async" $ shouldThrowAsync $ f syncE asyncE++                it "async/sync" $ shouldThrowAsync $ f asyncE syncE+                it "async/async" $ shouldThrowAsync $ f asyncE asyncE+        describe "onException" $ withPairs $ \e1 e2 -> e1 `onException` e2+        describe "withException" $ withPairs $ \e1 e2 -> e1 `withException` (\(_ :: SomeException) -> e2)+        describe "bracket_" $ withPairs $ \e1 e2 -> bracket_ (return ()) e2 e1+        describe "finally" $ withPairs $ \e1 e2 -> e1 `finally` e2+        describe "bracketOnError_" $ withPairs $ \e1 e2 -> bracketOnError_ (return ()) e2 e1

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}