├── .github └── workflows │ └── tests.yml ├── .gitignore ├── COOKBOOK.md ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── safe-exceptions.cabal ├── src └── Control │ └── Exception │ └── Safe.hs ├── stack.yaml ├── stack.yaml.lock └── test ├── Control └── Exception │ └── SafeSpec.hs └── Spec.hs /.github/workflows/tests.yml: -------------------------------------------------------------------------------- 1 | name: Tests 2 | 3 | on: 4 | pull_request: 5 | push: 6 | branches: 7 | - master 8 | 9 | jobs: 10 | build: 11 | name: CI 12 | runs-on: ${{ matrix.os }} 13 | strategy: 14 | fail-fast: false 15 | matrix: 16 | os: [ubuntu-latest, macos-latest, windows-latest] 17 | resolver: [nightly, lts-21, lts-20, lts-19, lts-18, lts-16, lts-14, lts-12] 18 | 19 | steps: 20 | - name: Clone project 21 | uses: actions/checkout@v2 22 | 23 | - name: Build and run tests 24 | shell: bash 25 | run: | 26 | set -ex 27 | stack upgrade 28 | stack --version 29 | 30 | stack test --fast --no-terminal --resolver=${{ matrix.resolver }} 31 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | .stack-work/ -------------------------------------------------------------------------------- /COOKBOOK.md: -------------------------------------------------------------------------------- 1 | This is a cookbook for the usage of `safe-exceptions`. You should 2 | start off by 3 | [reading the README](https://github.com/fpco/safe-exceptions#readme), 4 | or at least 5 | [the quickstart section](https://github.com/fpco/safe-exceptions#quickstart). 6 | 7 | _Request to readers_: if there are specific workflows that you're 8 | unsure of how to accomplish with this library, please ask so we can 9 | add them here. Issues and pull requests very much welcome! 10 | 11 | ## User-defined async exceptions 12 | 13 | In order to define an async exception, you must leverage the 14 | extensible exception machinery, as demonstrated below. Try running the 15 | program, and then comment out the implementation of `toException` and 16 | `fromException` to see the difference in behavior. 17 | 18 | ```haskell 19 | #!/usr/bin/env stack 20 | -- stack --resolver lts-6.4 runghc --package safe-exceptions-0.1.0.0 21 | import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar, 22 | threadDelay) 23 | import Control.Exception.Safe 24 | import Data.Typeable (Typeable, cast) 25 | 26 | data MyAsyncException = MyAsyncException 27 | deriving (Show, Typeable) 28 | 29 | instance Exception MyAsyncException where 30 | toException = toException . SomeAsyncException 31 | fromException se = do 32 | SomeAsyncException e <- fromException se 33 | cast e 34 | 35 | main :: IO () 36 | main = do 37 | baton <- newEmptyMVar -- give the handler a chance to run 38 | tid <- forkIO $ threadDelay maxBound 39 | `withException` 40 | (\e -> print ("Inside withException", e :: MyAsyncException)) 41 | `finally` putMVar baton () 42 | throwTo tid MyAsyncException 43 | takeMVar baton 44 | putStrLn "Done!" 45 | ``` 46 | 47 | The reason the `Inside withException` message isn't printed without 48 | the implementation of `toException` and `fromException` given above is 49 | that `throwTo` wraps `MyAsyncException` inside a different async 50 | exception type, which foils the exception handler from firing. 51 | 52 | *NOTE*: The above code is _not_ recommended concurrency code. If you 53 | have to do something like this, _please use the async package_. 54 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # ChangeLog for safe-exceptions 2 | 3 | ## 0.1.7.4 4 | 5 | * Add `HasCallStack` when `exceptions >= 0.10.6` [#41](https://github.com/fpco/safe-exceptions/issues/41) 6 | 7 | ## 0.1.7.3 8 | 9 | * Allow transformers 0.6 [#39](https://github.com/fpco/safe-exceptions/issues/39) 10 | 11 | ## 0.1.7.2 12 | 13 | * Changed `bracketWithError` and `bracketOnError` to use `generalBracket` from `MonadMask` [#36](https://github.com/fpco/safe-exceptions/issues/36) 14 | * Raised dependency `exceptions` from `>= 0.8` to `>= 0.10` 15 | 16 | ## 0.1.7.1 17 | 18 | * Doc update 19 | 20 | ## 0.1.7.0 21 | 22 | * Add `bracketWithError` 23 | 24 | ## 0.1.6.0 25 | 26 | * Reuse the `Handler` definition from `Control.Monad.Catch` 27 | 28 | ## 0.1.5.0 29 | 30 | * Re-export `Control.Exception.assert` 31 | * Add `throwString` 32 | 33 | ## 0.1.4.0 34 | 35 | * Add `catchJust`, `handleJust`, and `tryJust` 36 | 37 | ## 0.1.3.0 38 | 39 | * Add `catchIO`, `handleIO`, and `tryIO` 40 | 41 | ## 0.1.2.0 42 | 43 | * Added `catches` [#13](https://github.com/fpco/safe-exceptions/issues/13) 44 | 45 | ## 0.1.1.0 46 | 47 | * Add missing `toSyncException` inside `impureThrow` 48 | * Conditionally export `displayException` for older GHCs 49 | * Re-export `Typeable` 50 | * Add the deepseq variants of catch/handle/try functions 51 | 52 | ## 0.1.0.0 53 | 54 | * Initial releae 55 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 FP Complete 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be 12 | included in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # safe-exceptions 2 | 3 | *Safe, consistent, and easy exception handling* 4 | 5 | [![Tests](https://github.com/fpco/safe-exceptions/actions/workflows/tests.yml/badge.svg)](https://github.com/fpco/safe-exceptions/actions/workflows/tests.yml) 6 | [![Stackage](http://stackage.org/package/safe-exceptions/badge/lts)](http://stackage.org/lts/package/safe-exceptions) 7 | 8 | > The documentation for this library is available on [Stackage](http://stackage.org/lts/package/safe-exceptions) 9 | 10 | Runtime exceptions - as exposed in `base` by the `Control.Exception` 11 | module - have long been an intimidating part of the Haskell 12 | ecosystem. This package, and this README for the package, are intended 13 | to overcome this. It provides a safe and simple API on top of the 14 | existing exception handling machinery. The API is equivalent to the 15 | underlying implementation in terms of power but encourages best 16 | practices to minimize the chances of getting the exception handling 17 | wrong. By doing so and explaining the corner cases clearly, the hope is 18 | to turn what was previously something scary into an aspect of Haskell 19 | everyone feels safe using. 20 | 21 | __NOTE__ The `UnliftIO.Exception` module in [the `unliftio` 22 | library](https://www.stackage.org/package/unliftio) provides a very similar API 23 | to this module, but based around the `MonadUnliftIO` typeclass instead of 24 | `MonadCatch` and `MonadMask`. The [unliftio release 25 | announcement](https://www.fpcomplete.com/blog/2017/07/announcing-new-unliftio-library) 26 | explains why this may be considered preferable from a safety perspective. 27 | 28 | ## Goals 29 | 30 | This package provides additional safety and simplicity versus 31 | `Control.Exception` by having its functions recognize the difference between 32 | synchronous and asynchronous exceptions. As described below, synchronous 33 | exceptions are treated as _recoverable_, allowing you to catch and handle them 34 | as well as clean up after them, whereas asynchronous exceptions can only be 35 | cleaned up after. In particular, this library prevents you from making the 36 | following mistakes: 37 | 38 | * Catching and swallowing an asynchronous exception 39 | * Throwing an asynchronous exception synchronously 40 | * Throwing a synchronous exception asynchronously 41 | * Swallowing asynchronous exceptions via failing cleanup handlers 42 | 43 | ## Quickstart 44 | 45 | This section is intended to give you the bare minimum information to 46 | use this library (and Haskell runtime exceptions in general) 47 | correctly. 48 | 49 | * Import the `Control.Exception.Safe` module. Do _not_ import 50 | `Control.Exception` itself, which lacks the safety guarantees that 51 | this library adds. Same applies to `Control.Monad.Catch`. 52 | * If something can go wrong in your function, you can report this with 53 | the `throw`. (For compatible naming, there are synonyms for this of 54 | `throwIO` and `throwM`.) 55 | * If you want to catch a specific type of exception, use `catch`, 56 | `handle`, or `try`. 57 | * If you want to recover from _anything_ that may go wrong in a 58 | function, use `catchAny`, `handleAny`, or `tryAny`. 59 | * If you want to launch separate threads and kill them externally, you 60 | should use the 61 | [async package](https://www.stackage.org/package/async). 62 | * Unless you really know what you're doing, avoid the following functions: 63 | * `catchAsync` 64 | * `handleAsync` 65 | * `tryAsync` 66 | * `impureThrow` 67 | * `throwTo` 68 | * If you need to perform some allocation or cleanup of resources, use 69 | one of the following functions (and _don't_ use the 70 | `catch`/`handle`/`try` family of functions): 71 | 72 | * `onException` 73 | * `withException` 74 | * `bracket` 75 | * `bracket_` 76 | * `finally` 77 | * `bracketOnError` 78 | * `bracketOnError_` 79 | 80 | Hopefully this will be able to get you up-and-running quickly. You may 81 | also be interested in 82 | [browsing through the cookbook](https://github.com/fpco/safe-exceptions/blob/master/COOKBOOK.md). 83 | There is also an 84 | [exception safety tutorial on haskell-lang.org](https://haskell-lang.org/tutorial/exception-safety) 85 | which is based on this package. 86 | 87 | ## Terminology 88 | 89 | We're going to define three different versions of exceptions. Note 90 | that these definitions are based on _how the exception is thrown_, not 91 | based on _what the exception itself is_: 92 | 93 | * **Synchronous** exceptions are generated by the current 94 | thread. What's important about these is that we generally want to be 95 | able to recover from them. For example, if you try to read from a 96 | file, and the file doesn't exist, you may wish to use some default 97 | value instead of having your program exit, or perhaps prompt the 98 | user for a different file location. 99 | 100 | * **Asynchronous** exceptions are thrown by either a different user 101 | thread, or by the runtime system itself. For example, in the 102 | `async` package, `race` will kill the longer-running thread with 103 | an asynchronous exception. Similarly, the `timeout` function will 104 | kill an action which has run for too long. And the runtime system 105 | will kill threads which appear to be deadlocked on `MVar`s or 106 | `STM` actions. 107 | 108 | In contrast to synchronous exceptions, we almost never want to 109 | recover from asynchronous exceptions. In fact, this is a common 110 | mistake in Haskell code, and from what I've seen has been the 111 | largest source of confusion and concern amongst users when it 112 | comes to Haskell's runtime exception system. 113 | 114 | * **Impure** exceptions are hidden inside a pure value, and exposed 115 | by forcing evaluation of that value. Examples are `error`, 116 | `undefined`, and `impureThrow`. Additionally, incomplete pattern 117 | matches can generate impure exceptions. Ultimately, when these 118 | pure values are forced and the exception is exposed, it is thrown 119 | as a synchronous exception. 120 | 121 | Since they are ultimately thrown as synchronous exceptions, when 122 | it comes to handling them, we want to treat them in all ways like 123 | synchronous exceptions. Based on the comments above, that means we 124 | want to be able to recover from impure exceptions. 125 | 126 | ## Why catch asynchronous exceptions? 127 | 128 | If we never want to be able to recover from asynchronous exceptions, 129 | why do we want to be able to catch them at all? The answer is for 130 | _resource cleanup_. For both sync and async exceptions, we would like 131 | to be able to acquire resources - like file descriptors - and register 132 | a cleanup function which is guaranteed to be run. This is exemplified 133 | by functions like `bracket` and `withFile`. 134 | 135 | So to summarize: 136 | 137 | * All synchronous exceptions should be recoverable 138 | * All asynchronous exceptions should not be recoverable 139 | * In both cases, cleanup code needs to work reliably 140 | 141 | ## Determining sync vs async 142 | 143 | Unfortunately, GHC's runtime system provides no way to determine if an 144 | exception was thrown synchronously or asynchronously, but this 145 | information is vitally important. There are two general approaches to 146 | dealing with this: 147 | 148 | * Run an action in a separate thread, don't give that thread's ID to 149 | anyone else, and assume that any exception that kills it is a 150 | synchronous exception. This approach is covered in the School of 151 | Haskell article 152 | [catching all exceptions](https://www.schoolofhaskell.com/user/snoyberg/general-haskell/exceptions/catching-all-exceptions), 153 | and is provided by the 154 | [enclosed-exceptions](https://www.stackage.org/package/enclosed-exceptions) 155 | package. 156 | 157 | * Make assumptions based on the type of an exception, assuming that 158 | certain exception types are only thrown synchronously and certain 159 | only asynchronously. 160 | 161 | Both of these approaches have downsides. For the downsides of the 162 | type-based approach, see the caveats section at the end. The problems 163 | with the first are more interesting to us here: 164 | 165 | * It's much more expensive to fork a thread every time we want to deal 166 | with exceptions 167 | * It's not fully reliable: it's possible for the thread ID of the 168 | forked thread to leak somewhere, or the runtime system to send it an 169 | async exception 170 | * While this works for actions living in `IO`, it gets trickier for 171 | pure functions and monad transformer stacks. The latter issue is 172 | solved via monad-control and the exceptions packages. The former 173 | issue, however, means that it's impossible to provide a universal 174 | interface for failure for pure and impure actions. This may seem 175 | esoteric, and if so, don't worry about it too much. 176 | 177 | Therefore, this package takes the approach of trusting type 178 | information to determine if an exception is asynchronous or 179 | synchronous. The details are less interesting to a user, but the 180 | basics are: we leverage the extensible exception system in GHC and 181 | state that any exception type which is a child of `SomeAsyncException` 182 | is an async exception. All other exception types are assumed to be 183 | synchronous. 184 | 185 | ## Handling of sync vs async exceptions 186 | 187 | Once we're able to distinguish between sync and async exceptions, and 188 | we know our goals with sync vs async, how we handle things is pretty 189 | straightforward: 190 | 191 | * If the user is trying to install a cleanup function (such as with 192 | `bracket` or `finally`), we don't care if the exception is sync or 193 | async: call the cleanup function and then rethrow the exception. 194 | * If the user is trying to catch an exception and recover from it, 195 | only catch sync exceptions and immediately rethrow async exceptions. 196 | 197 | With this explanation, it's useful to consider async exceptions as 198 | "stronger" or more severe than sync exceptions, as the next section 199 | will demonstrate. 200 | 201 | ## Exceptions in cleanup code 202 | 203 | 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: 204 | 205 | * `action` threw sync, `cleanup` threw sync 206 | * `action` threw sync, `cleanup` threw async 207 | * `action` threw async, `cleanup` threw sync 208 | * `action` threw async, `cleanup` threw async 209 | 210 | Our guiding principle is: we cannot hide a more severe exception with 211 | a less severe exception. For example, if `action` threw a sync 212 | exception, and then `cleanup` threw an async exception, it would be a 213 | mistake to rethrow the sync exception thrown by `action`, since it 214 | would allow the user to recover when that is not desired. 215 | 216 | Therefore, this library will always throw an async exception if either 217 | the action or cleanup thows an async exception. Other than that, the 218 | behavior is currently undefined as to which of the two exceptions will 219 | be thrown. The library reserves the right to throw away either of the 220 | two thrown exceptions, or generate a new exception value completely. 221 | 222 | ## Typeclasses 223 | 224 | The [exceptions package](https://www.stackage.org/package/exceptions) 225 | provides an abstraction for throwing, catching, and cleaning up from 226 | exceptions for many different monads. This library leverages those 227 | type classes to generalize our functions. 228 | 229 | ## Naming 230 | 231 | There are a few choices of naming that differ from the base libraries: 232 | 233 | * `throw` in this library is for synchronously throwing within a 234 | monad, as opposed to in base where `throwIO` serves this purpose and 235 | `throw` is for impure throwing. This library provides `impureThrow` 236 | for the latter case, and also provides convenience synonyms 237 | `throwIO` and `throwM` for `throw`. 238 | * The `catch` function in this package will not catch async 239 | exceptions. Please use `catchAsync` if you really want to catch 240 | those, though it's usually better to use a function like `bracket` 241 | or `withException` which ensure that the thrown exception is 242 | rethrown. 243 | 244 | ## Caveats 245 | 246 | Let's talk about the caveats to keep in mind when using this library. 247 | 248 | ### Checked vs unchecked 249 | 250 | There is a big debate and difference of opinion regarding checked 251 | versus unchecked exceptions. With checked exceptions, a function 252 | states explicitly exactly what kinds of exceptions it can throw. With 253 | unchecked exceptions, it simply says "I can throw some kind of 254 | exception." Java is probably the most famous example of a checked 255 | exception system, with many other languages (including C#, Python, and 256 | Ruby) having unchecked exceptions. 257 | 258 | As usual, Haskell makes this interesting. Runtime exceptions are most 259 | assuredly unchecked: all exceptions are converted to `SomeException` 260 | via the `Exception` typeclass, and function signatures do not state 261 | which specific exception types can be thrown (for more on this, see 262 | next caveat). Instead, this information is relegated to documentation, 263 | and unfortunately is often not even covered there. 264 | 265 | By contrast, approaches like `ExceptT` and `EitherT` are very explicit 266 | in the type of exceptions that can be thrown. The cost of this is that 267 | there is extra overhead necessary to work with functions that can 268 | return different types of exceptions, usually by wrapping all possible 269 | exceptions in a sum type. 270 | 271 | This library isn't meant to settle the debate on checked vs unchecked, 272 | but rather to bring sanity to Haskell's runtime exception system. As 273 | such, this library is decidedly in the unchecked exception camp, 274 | purely by virtue of the fact that the underlying mechanism is as well. 275 | 276 | ### Explicit vs implicit 277 | 278 | Another advantage of the `ExceptT`/`EitherT` approach is that you are 279 | explicit in your function signature that a function may fail. However, 280 | the reality of Haskell's standard libraries are that many, if not the 281 | vast majority, of `IO` actions can throw some kind of exception. In 282 | fact, once async exceptions are considered, _every_ `IO` action can 283 | throw an exception. 284 | 285 | Once again, this library deals with the status quo of runtime 286 | exceptions being ubiquitous, and gives the rule: you should consider 287 | the `IO` type as meaning _both_ that a function modifies the outside 288 | world, _and_ may throw an exception (and, based on the previous 289 | caveat, may throw _any type_ of exception it feels like). 290 | 291 | There are attempts at alternative approaches here, such as 292 | [unexceptionalio](https://www.stackage.org/package/unexceptionalio). Again, 293 | this library isn't making a value statement on one approach versus 294 | another, but rather trying to make today's runtime exceptions in 295 | Haskell better. 296 | 297 | ### Type-based differentiation 298 | 299 | As explained above, this library makes heavy usage of type information 300 | to differentiate between sync and async exceptions. While the approach 301 | used is fairly well respected in the Haskell ecosystem today, it's 302 | certainly not universal, and definitely not enforced by the 303 | `Control.Exception` module. In particular, `throwIO` will allow you to 304 | synchronously throw an exception with an asynchronous type, and 305 | `throwTo` will allow you to asynchronously throw an exception with a 306 | synchronous type. 307 | 308 | The functions in this library prevent that from happening via 309 | exception type wrappers, but if an underlying library does something 310 | surprising, the functions here may not work correctly. Further, even 311 | when using this library, you may be surprised by the fact that ``throw 312 | Foo `catch` (\Foo -> ...)`` won't actually trigger the exception 313 | handler if `Foo` looks like an asynchronous exception. 314 | 315 | The ideal solution is to make a stronger distinction in the core 316 | libraries themselves between sync and async exceptions. 317 | 318 | ### Deadlock detection exceptions 319 | 320 | Two exceptions types which are handled surprisingly are 321 | `BlockedIndefinitelyOnMVar` and `BlockedIndefinitelyOnSTM`. Even 322 | though these exceptions are thrown asynchronously by the runtime 323 | system, for our purposes we treat them as synchronous. The reasons are 324 | twofold: 325 | 326 | * There is a specific action taken in the local thread - blocking on a 327 | variable which will never change - which causes the exception to be 328 | raised. This makes their behavior very similar to synchronous 329 | exceptions. In fact, one could argue that a function like `takeMVar` 330 | is synchronously throwing `BlockedIndefinitelyOnMVar` 331 | * By our standards of recoverable vs non-recoverable, these exceptions 332 | certainly fall into the recoverable category. Unlike an intentional 333 | kill signal from another thread or the user (via Ctrl-C), we would 334 | like to be able to detect that we entered a deadlock condition and do 335 | something intelligent in an application. 336 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /safe-exceptions.cabal: -------------------------------------------------------------------------------- 1 | name: safe-exceptions 2 | version: 0.1.7.4 3 | synopsis: Safe, consistent, and easy exception handling 4 | description: Please see README.md 5 | homepage: https://github.com/fpco/safe-exceptions#readme 6 | license: MIT 7 | license-file: LICENSE 8 | author: Michael Snoyman 9 | maintainer: michael@fpcomplete.com 10 | copyright: 2016 FP Complete 11 | category: Control 12 | build-type: Simple 13 | extra-source-files: README.md ChangeLog.md COOKBOOK.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Control.Exception.Safe 19 | build-depends: base >= 4.11 && < 5 20 | , deepseq >= 1.2 && < 1.6 21 | , exceptions >= 0.10 && < 0.11 22 | , transformers >= 0.2 && < 0.7 23 | default-language: Haskell2010 24 | 25 | test-suite safe-exceptions-test 26 | type: exitcode-stdio-1.0 27 | hs-source-dirs: test 28 | main-is: Spec.hs 29 | other-modules: Control.Exception.SafeSpec 30 | build-depends: base 31 | , hspec 32 | , safe-exceptions 33 | , transformers 34 | , void 35 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 36 | default-language: Haskell2010 37 | 38 | source-repository head 39 | type: git 40 | location: https://github.com/fpco/safe-exceptions 41 | -------------------------------------------------------------------------------- /src/Control/Exception/Safe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveDataTypeable #-} 3 | {-# LANGUAGE ExistentialQuantification #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE ImplicitParams #-} 6 | -- | Please see the README.md file in the safe-exceptions repo for 7 | -- information on how to use this module. Relevant links: 8 | -- 9 | -- * https://github.com/fpco/safe-exceptions#readme 10 | -- 11 | -- * https://www.stackage.org/package/safe-exceptions 12 | module Control.Exception.Safe 13 | ( -- * Throwing 14 | throw 15 | , throwIO 16 | , throwM 17 | , throwString 18 | , StringException (..) 19 | , throwTo 20 | , impureThrow 21 | -- * Catching (with recovery) 22 | , catch 23 | , catchIO 24 | , catchAny 25 | , catchDeep 26 | , catchAnyDeep 27 | , catchAsync 28 | , catchJust 29 | 30 | , handle 31 | , handleIO 32 | , handleAny 33 | , handleDeep 34 | , handleAnyDeep 35 | , handleAsync 36 | , handleJust 37 | 38 | , try 39 | , tryIO 40 | , tryAny 41 | , tryDeep 42 | , tryAnyDeep 43 | , tryAsync 44 | , tryJust 45 | 46 | , Handler(..) 47 | , catches 48 | , catchesDeep 49 | , catchesAsync 50 | 51 | -- * Cleanup (no recovery) 52 | , onException 53 | , bracket 54 | , bracket_ 55 | , finally 56 | , withException 57 | , bracketOnError 58 | , bracketOnError_ 59 | , bracketWithError 60 | 61 | -- * Coercion to sync and async 62 | , SyncExceptionWrapper (..) 63 | , toSyncException 64 | , AsyncExceptionWrapper (..) 65 | , toAsyncException 66 | 67 | -- * Check exception type 68 | , isSyncException 69 | , isAsyncException 70 | -- * Reexports 71 | , C.MonadThrow 72 | , C.MonadCatch 73 | , C.MonadMask (..) 74 | , C.mask_ 75 | , C.uninterruptibleMask_ 76 | , C.catchIOError 77 | , C.handleIOError 78 | -- FIXME , C.tryIOError 79 | , Exception (..) 80 | , Typeable 81 | , SomeException (..) 82 | , SomeAsyncException (..) 83 | , E.IOException 84 | , E.assert 85 | #if !MIN_VERSION_base(4,8,0) 86 | , displayException 87 | #endif 88 | ) where 89 | 90 | import Control.Concurrent (ThreadId) 91 | import Control.DeepSeq (($!!), NFData) 92 | import Control.Exception (Exception (..), SomeException (..), SomeAsyncException (..)) 93 | import qualified Control.Exception as E 94 | import qualified Control.Monad.Catch as C 95 | import Control.Monad.Catch (Handler (..)) 96 | import Control.Monad (liftM, void) 97 | import Control.Monad.IO.Class (MonadIO, liftIO) 98 | import Data.Typeable (Typeable, cast) 99 | 100 | #if MIN_VERSION_base(4,9,0) 101 | import GHC.Stack (prettySrcLoc) 102 | import GHC.Stack.Types (HasCallStack, CallStack, getCallStack) 103 | #endif 104 | 105 | #if MIN_VERSION_base(4,9,0) && MIN_VERSION_exceptions(0,10,6) 106 | import GHC.Stack (withFrozenCallStack) 107 | #endif 108 | 109 | -- The exceptions package that safe-exceptions is based on added HasCallStack 110 | -- to many of its functions in 0.10.6: 111 | -- 112 | -- https://github.com/ekmett/exceptions/pull/90 113 | -- https://github.com/ekmett/exceptions/pull/92 114 | -- 115 | -- We make the same change here. The following comment has been lifted 116 | -- verbatim from exceptions: 117 | -- 118 | -- We use the following bit of CPP to enable the use of HasCallStack 119 | -- constraints without breaking the build for pre-8.0 GHCs, which did not 120 | -- provide GHC.Stack. We are careful to always write constraints like this: 121 | -- 122 | -- HAS_CALL_STACK => MonadThrow m => ... 123 | -- 124 | -- Instead of like this: 125 | -- 126 | -- (HAS_CALL_STACK, MonadThrow e) => ... 127 | -- 128 | -- The latter is equivalent to (() :: Constraint, MonadThrow e) => ..., which 129 | -- requires ConstraintKinds. More importantly, it's slightly less efficient, 130 | -- since it requires passing an empty constraint tuple dictionary around. 131 | -- 132 | -- Note that we do /not/ depend on the call-stack compatibility library to 133 | -- provide HasCallStack on older GHCs. We tried this at one point, but we 134 | -- discovered that downstream libraries failed to build because combining 135 | -- call-stack with GeneralizedNewtypeDeriving on older GHCs would require the 136 | -- use of ConstraintKinds/FlexibleContexts, which downstream libraries did not 137 | -- enable. (See #91.) The CPP approach that we use now, while somewhat clunky, 138 | -- avoids these issues by not requiring any additional language extensions for 139 | -- downstream users. 140 | #if MIN_VERSION_base(4,9,0) && MIN_VERSION_exceptions(0,10,6) 141 | # define HAS_CALL_STACK HasCallStack 142 | #else 143 | # define HAS_CALL_STACK () 144 | withFrozenCallStack :: a -> a 145 | withFrozenCallStack a = a 146 | #endif 147 | 148 | -- | Synchronously throw the given exception 149 | -- 150 | -- @since 0.1.0.0 151 | throw :: HAS_CALL_STACK => (C.MonadThrow m, Exception e) => e -> m a 152 | throw = C.throwM . toSyncException 153 | 154 | -- | Synonym for 'throw' 155 | -- 156 | -- @since 0.1.0.0 157 | throwIO :: HAS_CALL_STACK => (C.MonadThrow m, Exception e) => e -> m a 158 | throwIO = withFrozenCallStack throw 159 | 160 | -- | Synonym for 'throw' 161 | -- 162 | -- @since 0.1.0.0 163 | throwM :: HAS_CALL_STACK => (C.MonadThrow m, Exception e) => e -> m a 164 | throwM = withFrozenCallStack throw 165 | 166 | -- | A convenience function for throwing a user error. This is useful 167 | -- for cases where it would be too high a burden to define your own 168 | -- exception type. 169 | -- 170 | -- This throws an exception of type 'StringException'. When GHC 171 | -- supports it (base 4.9 and GHC 8.0 and onward), it includes a call 172 | -- stack. 173 | -- 174 | -- @since 0.1.5.0 175 | #if MIN_VERSION_base(4,9,0) 176 | throwString :: (C.MonadThrow m, HasCallStack) => String -> m a 177 | throwString s = throwM (StringException s ?callStack) 178 | #else 179 | throwString :: C.MonadThrow m => String -> m a 180 | throwString s = throwM (StringException s ()) 181 | #endif 182 | 183 | -- | Exception type thrown by 'throwString'. 184 | -- 185 | -- Note that the second field of the data constructor depends on 186 | -- GHC/base version. For base 4.9 and GHC 8.0 and later, the second 187 | -- field is a call stack. Previous versions of GHC and base do not 188 | -- support call stacks, and the field is simply unit (provided to make 189 | -- pattern matching across GHC versions easier). 190 | -- 191 | -- @since 0.1.5.0 192 | #if MIN_VERSION_base(4,9,0) 193 | data StringException = StringException String CallStack 194 | deriving Typeable 195 | 196 | instance Show StringException where 197 | show (StringException s cs) = concat 198 | $ "Control.Exception.Safe.throwString called with:\n\n" 199 | : s 200 | : "\nCalled from:\n" 201 | : map go (getCallStack cs) 202 | where 203 | go (x, y) = concat 204 | [ " " 205 | , x 206 | , " (" 207 | , prettySrcLoc y 208 | , ")\n" 209 | ] 210 | #else 211 | data StringException = StringException String () 212 | deriving Typeable 213 | 214 | instance Show StringException where 215 | show (StringException s _) = "Control.Exception.Safe.throwString called with:\n\n" ++ s 216 | #endif 217 | instance Exception StringException 218 | 219 | -- | Throw an asynchronous exception to another thread. 220 | -- 221 | -- Synchronously typed exceptions will be wrapped into an 222 | -- `AsyncExceptionWrapper`, see 223 | -- 224 | -- 225 | -- It's usually a better idea to use the async package, see 226 | -- 227 | -- 228 | -- @since 0.1.0.0 229 | throwTo :: (Exception e, MonadIO m) => ThreadId -> e -> m () 230 | throwTo tid = liftIO . E.throwTo tid . toAsyncException 231 | 232 | -- | Generate a pure value which, when forced, will synchronously 233 | -- throw the given exception 234 | -- 235 | -- Generally it's better to avoid using this function and instead use 'throw', 236 | -- see 237 | -- 238 | -- @since 0.1.0.0 239 | impureThrow :: HAS_CALL_STACK => Exception e => e -> a 240 | impureThrow = E.throw . toSyncException 241 | 242 | -- | Same as upstream 'C.catch', but will not catch asynchronous 243 | -- exceptions 244 | -- 245 | -- @since 0.1.0.0 246 | catch :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a 247 | catch f g = f `C.catch` \e -> 248 | if isSyncException e 249 | then g e 250 | -- intentionally rethrowing an async exception synchronously, 251 | -- since we want to preserve async behavior 252 | else C.throwM e 253 | 254 | -- | 'C.catch' specialized to only catching 'E.IOException's 255 | -- 256 | -- @since 0.1.3.0 257 | catchIO :: HAS_CALL_STACK => C.MonadCatch m => m a -> (E.IOException -> m a) -> m a 258 | catchIO = withFrozenCallStack C.catch 259 | 260 | -- | 'catch' specialized to catch all synchronous exception 261 | -- 262 | -- @since 0.1.0.0 263 | catchAny :: HAS_CALL_STACK => C.MonadCatch m => m a -> (SomeException -> m a) -> m a 264 | catchAny = withFrozenCallStack catch 265 | 266 | -- | Same as 'catch', but fully force evaluation of the result value 267 | -- to find all impure exceptions. 268 | -- 269 | -- @since 0.1.1.0 270 | catchDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, Exception e, NFData a) 271 | => m a -> (e -> m a) -> m a 272 | catchDeep = withFrozenCallStack catch . evaluateDeep 273 | 274 | -- | Internal helper function 275 | evaluateDeep :: (MonadIO m, NFData a) => m a -> m a 276 | evaluateDeep action = do 277 | res <- action 278 | liftIO (E.evaluate $!! res) 279 | 280 | -- | 'catchDeep' specialized to catch all synchronous exception 281 | -- 282 | -- @since 0.1.1.0 283 | catchAnyDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, NFData a) => m a -> (SomeException -> m a) -> m a 284 | catchAnyDeep = withFrozenCallStack catchDeep 285 | 286 | -- | 'catch' without async exception safety 287 | -- 288 | -- Generally it's better to avoid using this function since we do not want to 289 | -- recover from async exceptions, see 290 | -- 291 | -- 292 | -- @since 0.1.0.0 293 | catchAsync :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a 294 | catchAsync = C.catch 295 | 296 | -- | 'catchJust' is like 'catch' but it takes an extra argument which 297 | -- is an exception predicate, a function which selects which type of 298 | -- exceptions we're interested in. 299 | -- 300 | -- @since 0.1.4.0 301 | catchJust :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a 302 | catchJust f a b = withFrozenCallStack catch a (\e -> maybe (throwM e) b $ f e) 303 | 304 | -- | Flipped version of 'catch' 305 | -- 306 | -- @since 0.1.0.0 307 | handle :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a 308 | handle = flip (withFrozenCallStack catch) 309 | 310 | -- | 'C.handle' specialized to only catching 'E.IOException's 311 | -- 312 | -- @since 0.1.3.0 313 | handleIO :: HAS_CALL_STACK => C.MonadCatch m => (E.IOException -> m a) -> m a -> m a 314 | handleIO = withFrozenCallStack C.handle 315 | 316 | 317 | -- | Flipped version of 'catchAny' 318 | -- 319 | -- @since 0.1.0.0 320 | handleAny :: HAS_CALL_STACK => C.MonadCatch m => (SomeException -> m a) -> m a -> m a 321 | handleAny = flip (withFrozenCallStack catchAny) 322 | 323 | -- | Flipped version of 'catchDeep' 324 | -- 325 | -- @since 0.1.1.0 326 | handleDeep :: HAS_CALL_STACK => (C.MonadCatch m, Exception e, MonadIO m, NFData a) => (e -> m a) -> m a -> m a 327 | handleDeep = flip (withFrozenCallStack catchDeep) 328 | 329 | -- | Flipped version of 'catchAnyDeep' 330 | -- 331 | -- @since 0.1.1.0 332 | handleAnyDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, NFData a) => (SomeException -> m a) -> m a -> m a 333 | handleAnyDeep = flip (withFrozenCallStack catchAnyDeep) 334 | 335 | -- | Flipped version of 'catchAsync' 336 | -- 337 | -- Generally it's better to avoid using this function since we do not want to 338 | -- recover from async exceptions, see 339 | -- 340 | -- 341 | -- @since 0.1.0.0 342 | handleAsync :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a 343 | handleAsync = C.handle 344 | 345 | -- | Flipped 'catchJust'. 346 | -- 347 | -- @since 0.1.4.0 348 | handleJust :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a 349 | handleJust f = flip (withFrozenCallStack catchJust f) 350 | 351 | -- | Same as upstream 'C.try', but will not catch asynchronous 352 | -- exceptions 353 | -- 354 | -- @since 0.1.0.0 355 | try :: HAS_CALL_STACK => (C.MonadCatch m, E.Exception e) => m a -> m (Either e a) 356 | try f = withFrozenCallStack catch (liftM Right f) (return . Left) 357 | 358 | -- | 'C.try' specialized to only catching 'E.IOException's 359 | -- 360 | -- @since 0.1.3.0 361 | tryIO :: HAS_CALL_STACK => C.MonadCatch m => m a -> m (Either E.IOException a) 362 | tryIO = withFrozenCallStack C.try 363 | 364 | -- | 'try' specialized to catch all synchronous exceptions 365 | -- 366 | -- @since 0.1.0.0 367 | tryAny :: HAS_CALL_STACK => C.MonadCatch m => m a -> m (Either SomeException a) 368 | tryAny = withFrozenCallStack try 369 | 370 | -- | Same as 'try', but fully force evaluation of the result value 371 | -- to find all impure exceptions. 372 | -- 373 | -- @since 0.1.1.0 374 | tryDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, E.Exception e, NFData a) => m a -> m (Either e a) 375 | tryDeep f = withFrozenCallStack catch (liftM Right (evaluateDeep f)) (return . Left) 376 | 377 | -- | 'tryDeep' specialized to catch all synchronous exceptions 378 | -- 379 | -- @since 0.1.1.0 380 | tryAnyDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, NFData a) => m a -> m (Either SomeException a) 381 | tryAnyDeep = withFrozenCallStack tryDeep 382 | 383 | -- | 'try' without async exception safety 384 | -- 385 | -- Generally it's better to avoid using this function since we do not want to 386 | -- recover from async exceptions, see 387 | -- 388 | -- 389 | -- @since 0.1.0.0 390 | tryAsync :: HAS_CALL_STACK => (C.MonadCatch m, E.Exception e) => m a -> m (Either e a) 391 | tryAsync = C.try 392 | 393 | -- | A variant of 'try' that takes an exception predicate to select 394 | -- which exceptions are caught. 395 | -- 396 | -- @since 0.1.4.0 397 | tryJust :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a) 398 | tryJust f a = withFrozenCallStack catch (Right `liftM` a) (\e -> maybe (throwM e) (return . Left) (f e)) 399 | 400 | -- | Async safe version of 'E.onException' 401 | -- 402 | -- @since 0.1.0.0 403 | onException :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m a 404 | onException thing after = withFrozenCallStack withException thing (\(_ :: SomeException) -> after) 405 | 406 | -- Note: [withFrozenCallStack impredicativity] 407 | -- 408 | -- We do not currently use 'withFrozenCallStack' in 'withException' or the similar 409 | -- 'finally' due to impredicativity. That is, we would like to be consistent 410 | -- with other functions and apply 'withFrozenCallStack' to the _handler only_ i.e. 411 | -- 412 | -- withException thing after = withFrozenCallStack C.uninterruptibleMask $ \restore ... 413 | -- 414 | -- Alas, that fails due to impredicativity: 415 | -- 416 | -- • Couldn't match type: m a -> m a 417 | -- with: forall a1. m a1 -> m a1 418 | -- Expected: (forall a1. m a1 -> m a1) -> m a 419 | -- Actual: (m a -> m a) -> m a 420 | -- 421 | -- Armed with -XImpredicativeTypes, we can define: 422 | -- 423 | -- uninterruptibleMaskFrozen :: forall m b. C.MonadMask m => ((forall a. m a -> m a) -> m b) -> m b 424 | -- uninterruptibleMaskFrozen = withFrozenCallStack C.uninterruptibleMask 425 | -- 426 | -- and then 427 | -- 428 | -- withException thing after = uninterruptibleMaskFrozen $ \restore -> do ... 429 | -- 430 | -- But we cannot rely on -XImpredicativeTypes until GHC 9.2 is the oldest 431 | -- supported release, and even then it is worth asking if the benefit 432 | -- (consistency, omit handler from CallStack) is worth the cost (powerful, 433 | -- relatively exotic extension). 434 | 435 | -- | Like 'onException', but provides the handler the thrown 436 | -- exception. 437 | -- 438 | -- @since 0.1.0.0 439 | withException :: HAS_CALL_STACK => (C.MonadMask m, E.Exception e) => m a -> (e -> m b) -> m a 440 | withException thing after = C.uninterruptibleMask $ \restore -> do 441 | fmap fst $ C.generalBracket (pure ()) cAfter (const $ restore thing) 442 | where 443 | -- ignore the exception from after, see bracket for explanation 444 | cAfter () (C.ExitCaseException se) | Just ex <- fromException se = 445 | ignoreExceptions $ after ex 446 | cAfter () _ = pure () 447 | 448 | -- | Async safe version of 'E.bracket' 449 | -- 450 | -- @since 0.1.0.0 451 | bracket :: forall m a b c. HAS_CALL_STACK => C.MonadMask m 452 | => m a -> (a -> m b) -> (a -> m c) -> m c 453 | bracket before after = withFrozenCallStack bracketWithError before (const after) 454 | 455 | -- | Async safe version of 'E.bracket_' 456 | -- 457 | -- @since 0.1.0.0 458 | bracket_ :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m c -> m c 459 | bracket_ before after thing = withFrozenCallStack bracket before (const after) (const thing) 460 | 461 | -- See Note [withFrozenCallStack impredicativity] 462 | 463 | -- | Async safe version of 'E.finally' 464 | -- 465 | -- @since 0.1.0.0 466 | finally :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m a 467 | finally thing after = C.uninterruptibleMask $ \restore -> do 468 | fmap fst $ C.generalBracket (pure ()) cAfter (const $ restore thing) 469 | where 470 | -- ignore the exception from after, see bracket for explanation 471 | cAfter () (C.ExitCaseException se) = 472 | ignoreExceptions after 473 | cAfter () _ = void after 474 | 475 | -- | Async safe version of 'E.bracketOnError' 476 | -- 477 | -- @since 0.1.0.0 478 | bracketOnError :: forall m a b c. HAS_CALL_STACK => C.MonadMask m 479 | => m a -> (a -> m b) -> (a -> m c) -> m c 480 | bracketOnError before after thing = fmap fst $ withFrozenCallStack C.generalBracket before cAfter thing 481 | where 482 | -- ignore the exception from after, see bracket for explanation 483 | cAfter x (C.ExitCaseException se) = 484 | C.uninterruptibleMask_ $ ignoreExceptions $ after x 485 | cAfter x _ = pure () 486 | 487 | 488 | -- | A variant of 'bracketOnError' where the return value from the first 489 | -- computation is not required. 490 | -- 491 | -- @since 0.1.0.0 492 | bracketOnError_ :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m c -> m c 493 | bracketOnError_ before after thing = withFrozenCallStack bracketOnError before (const after) (const thing) 494 | 495 | -- | Async safe version of 'E.bracket' with access to the exception in the 496 | -- cleanup action. 497 | -- 498 | -- @since 0.1.7.0 499 | bracketWithError :: forall m a b c. HAS_CALL_STACK => C.MonadMask m 500 | => m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c 501 | bracketWithError before after thing = fmap fst $ withFrozenCallStack C.generalBracket before cAfter thing 502 | where 503 | cAfter x (C.ExitCaseException se) = 504 | C.uninterruptibleMask_ $ ignoreExceptions $ after (Just se) x 505 | cAfter x _ = 506 | void $ C.uninterruptibleMask_ $ after Nothing x 507 | 508 | -- | Internal function that swallows all exceptions, used in some bracket-like 509 | -- combinators. When it's run inside of uninterruptibleMask, we know that 510 | -- no async exceptions can be thrown from thing, so the other exception from 511 | -- the combinator will not be overridden. 512 | -- 513 | -- https://github.com/fpco/safe-exceptions/issues/2 514 | ignoreExceptions :: C.MonadMask m => m a -> m () 515 | ignoreExceptions thing = void thing `C.catch` (\(_ :: SomeException) -> pure ()) 516 | 517 | -- | Wrap up an asynchronous exception to be treated as a synchronous 518 | -- exception 519 | -- 520 | -- This is intended to be created via 'toSyncException' 521 | -- 522 | -- @since 0.1.0.0 523 | data SyncExceptionWrapper = forall e. Exception e => SyncExceptionWrapper e 524 | deriving Typeable 525 | instance Show SyncExceptionWrapper where 526 | show (SyncExceptionWrapper e) = show e 527 | instance Exception SyncExceptionWrapper where 528 | #if MIN_VERSION_base(4,8,0) 529 | displayException (SyncExceptionWrapper e) = displayException e 530 | #endif 531 | 532 | -- | Convert an exception into a synchronous exception 533 | -- 534 | -- For synchronous exceptions, this is the same as 'toException'. 535 | -- For asynchronous exceptions, this will wrap up the exception with 536 | -- 'SyncExceptionWrapper' 537 | -- 538 | -- @since 0.1.0.0 539 | toSyncException :: Exception e => e -> SomeException 540 | toSyncException e = 541 | case fromException se of 542 | Just (SomeAsyncException _) -> toException (SyncExceptionWrapper e) 543 | Nothing -> se 544 | where 545 | se = toException e 546 | 547 | -- | Wrap up a synchronous exception to be treated as an asynchronous 548 | -- exception 549 | -- 550 | -- This is intended to be created via 'toAsyncException' 551 | -- 552 | -- @since 0.1.0.0 553 | data AsyncExceptionWrapper = forall e. Exception e => AsyncExceptionWrapper e 554 | deriving Typeable 555 | instance Show AsyncExceptionWrapper where 556 | show (AsyncExceptionWrapper e) = show e 557 | instance Exception AsyncExceptionWrapper where 558 | toException = toException . SomeAsyncException 559 | fromException se = do 560 | SomeAsyncException e <- fromException se 561 | cast e 562 | #if MIN_VERSION_base(4,8,0) 563 | displayException (AsyncExceptionWrapper e) = displayException e 564 | #endif 565 | 566 | -- | Convert an exception into an asynchronous exception 567 | -- 568 | -- For asynchronous exceptions, this is the same as 'toException'. 569 | -- For synchronous exceptions, this will wrap up the exception with 570 | -- 'AsyncExceptionWrapper' 571 | -- 572 | -- @since 0.1.0.0 573 | toAsyncException :: Exception e => e -> SomeException 574 | toAsyncException e = 575 | case fromException se of 576 | Just (SomeAsyncException _) -> se 577 | Nothing -> toException (AsyncExceptionWrapper e) 578 | where 579 | se = toException e 580 | 581 | -- | Check if the given exception is synchronous 582 | -- 583 | -- @since 0.1.0.0 584 | isSyncException :: Exception e => e -> Bool 585 | isSyncException e = 586 | case fromException (toException e) of 587 | Just (SomeAsyncException _) -> False 588 | Nothing -> True 589 | 590 | -- | Check if the given exception is asynchronous 591 | -- 592 | -- @since 0.1.0.0 593 | isAsyncException :: Exception e => e -> Bool 594 | isAsyncException = not . isSyncException 595 | {-# INLINE isAsyncException #-} 596 | 597 | #if !MIN_VERSION_base(4,8,0) 598 | -- | A synonym for 'show', specialized to 'Exception' instances. 599 | -- 600 | -- Starting with base 4.8, the 'Exception' typeclass has a method @displayException@, used for user-friendly display of exceptions. This function provides backwards compatibility for users on base 4.7 and earlier, so that anyone importing this module can simply use @displayException@. 601 | -- 602 | -- @since 0.1.1.0 603 | displayException :: Exception e => e -> String 604 | displayException = show 605 | #endif 606 | 607 | -- | Same as upstream 'C.catches', but will not catch asynchronous 608 | -- exceptions 609 | -- 610 | -- @since 0.1.2.0 611 | catches :: HAS_CALL_STACK => (C.MonadCatch m, C.MonadThrow m) => m a -> [Handler m a] -> m a 612 | catches io handlers = withFrozenCallStack catch io (catchesHandler handlers) 613 | 614 | -- | Same as 'catches', but fully force evaluation of the result value 615 | -- to find all impure exceptions. 616 | -- 617 | -- @since 0.1.2.0 618 | catchesDeep :: HAS_CALL_STACK => (C.MonadCatch m, C.MonadThrow m, MonadIO m, NFData a) => m a -> [Handler m a] -> m a 619 | catchesDeep io handlers = withFrozenCallStack catch (evaluateDeep io) (catchesHandler handlers) 620 | 621 | -- | 'catches' without async exception safety 622 | -- 623 | -- Generally it's better to avoid using this function since we do not want to 624 | -- recover from async exceptions, see 625 | -- 626 | -- 627 | -- @since 0.1.2.0 628 | catchesAsync :: HAS_CALL_STACK => (C.MonadCatch m, C.MonadThrow m) => m a -> [Handler m a] -> m a 629 | catchesAsync io handlers = io `catchAsync` catchesHandler handlers 630 | 631 | catchesHandler :: HAS_CALL_STACK => (C.MonadThrow m) => [Handler m a] -> SomeException -> m a 632 | catchesHandler handlers e = foldr tryHandler (C.throwM e) handlers 633 | where tryHandler (Handler handler) res 634 | = case fromException e of 635 | Just e' -> handler e' 636 | Nothing -> res 637 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-18.0 2 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 585393 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/0.yaml 11 | sha256: c632012da648385b9fa3c29f4e0afd56ead299f1c5528ee789058be410e883c0 12 | original: lts-18.0 13 | -------------------------------------------------------------------------------- /test/Control/Exception/SafeSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveDataTypeable #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | module Control.Exception.SafeSpec (spec) where 5 | 6 | import Control.Concurrent (threadDelay, newEmptyMVar, forkIOWithUnmask, takeMVar, putMVar) 7 | import Control.Exception (ArithException (..), AsyncException (..), BlockedIndefinitelyOnMVar (..), BlockedIndefinitelyOnSTM (..)) 8 | import qualified Control.Exception as E 9 | import Control.Exception.Safe 10 | import Control.Monad (forever) 11 | import Control.Monad.Trans.Class (lift) 12 | import Control.Monad.Trans.Except (runExceptT, throwE) 13 | import Data.IORef (modifyIORef, newIORef, readIORef) 14 | import Data.Typeable (Typeable) 15 | import Data.Void (Void, absurd) 16 | import System.IO.Unsafe (unsafePerformIO) 17 | import System.Timeout (timeout) 18 | import Test.Hspec 19 | #if !MIN_VERSION_base(4,9,0) 20 | import System.IO.Error (isUserError) 21 | #endif 22 | 23 | newtype ExceptionPred = ExceptionPred { getExceptionPred :: Maybe () } deriving (Show, Eq, Typeable) 24 | 25 | instance Exception ExceptionPred 26 | 27 | -- | Ugly hack needed because the underlying type is not exported 28 | timeoutException :: SomeException 29 | timeoutException = 30 | case unsafePerformIO $ mask $ \restore -> timeout 1 $ tryAsync $ restore $ forever $ threadDelay maxBound of 31 | Nothing -> error "timeoutException returned Nothing" 32 | Just (Left e) -> e 33 | Just (Right e) -> absurd e 34 | 35 | asyncE :: IO a 36 | asyncE = E.throwIO ThreadKilled 37 | 38 | syncE :: IO a 39 | syncE = E.throwIO Overflow 40 | 41 | -- | Maps each exception to whether it is synchronous 42 | exceptions :: [(SomeException, Bool)] 43 | exceptions = 44 | [ go Overflow True 45 | , go ThreadKilled False 46 | , go timeoutException False 47 | , go BlockedIndefinitelyOnMVar True -- see the README, this is weird 48 | , go BlockedIndefinitelyOnSTM True -- see the README, this is weird 49 | ] 50 | where 51 | go e b = (toException e, b) 52 | 53 | withAll :: (SomeException -> Bool -> IO ()) -> Spec 54 | withAll f = mapM_ (\(e, b) -> it (show e) (f e b)) exceptions 55 | 56 | data ResourceAction 57 | = ResourceAcquire 58 | | ResourceUse 59 | | ResourceRelease 60 | | ExceptionObserve ExceptionPred 61 | deriving (Show, Eq) 62 | 63 | spec :: Spec 64 | spec = do 65 | describe "isSyncException" $ withAll 66 | $ \e sync -> isSyncException e `shouldBe` sync 67 | describe "isAsncException" $ withAll 68 | $ \e sync -> isAsyncException e `shouldBe` not sync 69 | describe "toSyncException" $ withAll 70 | $ \e _ -> isSyncException (toSyncException e) `shouldBe` True 71 | describe "toAsyncException" $ withAll 72 | $ \e _ -> isAsyncException (toAsyncException e) `shouldBe` True 73 | 74 | let shouldBeSync :: Either SomeException Void -> IO () 75 | shouldBeSync (Left e) 76 | | isSyncException e = return () 77 | | otherwise = error $ "Unexpected async exception: " ++ show e 78 | shouldBeSync (Right x) = absurd x 79 | 80 | shouldBeAsync :: Either SomeException Void -> IO () 81 | shouldBeAsync (Left e) 82 | | isAsyncException e = return () 83 | | otherwise = error $ "Unexpected sync exception: " ++ show e 84 | shouldBeAsync (Right x) = absurd x 85 | 86 | shouldThrowSync f = E.try f >>= shouldBeSync 87 | shouldThrowAsync f = E.try f >>= shouldBeAsync 88 | 89 | describe "throw" $ withAll $ \e _ -> shouldThrowSync (throw e) 90 | describe "throwTo" $ withAll $ \e _ -> do 91 | var <- newEmptyMVar 92 | tid <- E.uninterruptibleMask_ $ forkIOWithUnmask $ \restore -> do 93 | res <- E.try $ restore $ forever $ threadDelay maxBound 94 | putMVar var res 95 | throwTo tid e 96 | res <- takeMVar var 97 | shouldBeAsync res 98 | 99 | describe "stays async" $ do 100 | let withPairs f = do 101 | it "sync/sync" $ shouldThrowSync $ f syncE syncE 102 | 103 | -- removing this case from consideration, since cleanup handlers 104 | -- cannot receive async exceptions. See 105 | -- https://github.com/fpco/safe-exceptions/issues/2 106 | -- 107 | -- it "sync/async" $ shouldThrowAsync $ f syncE asyncE 108 | 109 | it "async/sync" $ shouldThrowAsync $ f asyncE syncE 110 | it "async/async" $ shouldThrowAsync $ f asyncE asyncE 111 | describe "onException" $ withPairs $ \e1 e2 -> e1 `onException` e2 112 | describe "withException" $ withPairs $ \e1 e2 -> e1 `withException` (\(_ :: SomeException) -> e2) 113 | describe "bracket_" $ withPairs $ \e1 e2 -> bracket_ (return ()) e2 e1 114 | describe "finally" $ withPairs $ \e1 e2 -> e1 `finally` e2 115 | describe "bracketOnError_" $ withPairs $ \e1 e2 -> bracketOnError_ (return ()) e2 e1 116 | 117 | describe "deepseq" $ do 118 | describe "catchAnyDeep" $ withAll $ \e _ -> do 119 | res <- return (impureThrow e) `catchAnyDeep` \_ -> return () 120 | res `shouldBe` () 121 | describe "handleAnyDeep" $ withAll $ \e _ -> do 122 | res <- handleAnyDeep (const $ return ()) (return (impureThrow e)) 123 | res `shouldBe` () 124 | describe "tryAnyDeep" $ withAll $ \e _ -> do 125 | res <- tryAnyDeep (return (impureThrow e)) 126 | -- deal with a missing NFData instance 127 | shouldBeSync $ either Left (\() -> Right undefined) res 128 | describe "catchesDeep" $ withAll $ \e _ -> do 129 | res <- return (impureThrow e) `catchesDeep` [Handler (\(_ :: SomeException) -> return ())] 130 | res `shouldBe` () 131 | 132 | describe "catchJust" $ do 133 | it "catches a selected exception" $ do 134 | res <- catchJust getExceptionPred (throw (ExceptionPred (Just ()))) (return . Just) 135 | res `shouldBe` Just () 136 | 137 | it "re-raises a selection that is passed on" $ do 138 | let ex = ExceptionPred Nothing 139 | res <- try (catchJust getExceptionPred (throw ex) (return . Just)) 140 | res `shouldBe` Left ex 141 | 142 | describe "throwString" $ do 143 | it "is a StringException" $ 144 | throwString "foo" `catch` \(StringException _ _) -> return () :: IO () 145 | 146 | describe "bracketWithError" $ do 147 | it "should prioritize exceptions from thing" $ do 148 | actionLogRef <- newIORef [] 149 | eiResult <- 150 | try $ 151 | Control.Exception.Safe.bracketWithError 152 | ( do 153 | modifyIORef actionLogRef (ResourceAcquire :) 154 | ) 155 | ( \mbEx () -> do 156 | case mbEx of 157 | Just ex | Just exPred <- fromException ex -> 158 | modifyIORef actionLogRef (ExceptionObserve exPred :) 159 | _ -> pure () 160 | modifyIORef actionLogRef (ResourceRelease :) 161 | throw $ ExceptionPred $ Just () 162 | ) 163 | ( \() -> do 164 | modifyIORef actionLogRef (ResourceUse :) 165 | throw $ ExceptionPred Nothing 166 | pure () 167 | ) 168 | eiResult `shouldBe` Left (ExceptionPred Nothing) 169 | readIORef actionLogRef 170 | `shouldReturn` [ResourceRelease, ExceptionObserve (ExceptionPred Nothing), ResourceUse, ResourceAcquire] 171 | 172 | it "should lift through ExceptT" $ do 173 | actionLogRef <- newIORef [] 174 | eiResult <- 175 | runExceptT $ 176 | Control.Exception.Safe.bracketWithError 177 | ( do 178 | lift $ modifyIORef actionLogRef (ResourceAcquire :) 179 | ) 180 | ( \_ () -> do 181 | lift $ modifyIORef actionLogRef (ResourceRelease :) 182 | ) 183 | ( \() -> do 184 | lift $ modifyIORef actionLogRef (ResourceUse :) 185 | throwE $ ExceptionPred Nothing 186 | pure () 187 | ) 188 | eiResult `shouldBe` Left (ExceptionPred Nothing) 189 | readIORef actionLogRef 190 | `shouldReturn` [ResourceRelease, ResourceUse, ResourceAcquire] 191 | 192 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | --------------------------------------------------------------------------------