unliftio 0.2.16 → 0.2.17
raw patch · 5 files changed
+146/−4 lines, 5 files
Files
- ChangeLog.md +6/−0
- src/UnliftIO/Async.hs +6/−1
- src/UnliftIO/Exception.hs +49/−0
- test/UnliftIO/ExceptionSpec.hs +82/−0
- unliftio.cabal +3/−3
ChangeLog.md view
@@ -1,5 +1,11 @@ # Changelog for unliftio +## 0.2.17++* Re-export `AsyncCancelled` in `UnliftIO.Async` [#80](https://github.com/fpco/unliftio/pull/80)+* Add `fromExceptionUnwrap` [#80](https://github.com/fpco/unliftio/pull/80)+* Add `catchSyncOrAsync`, `handleSyncOrAsync`, and `trySyncOrAsync` [#80](https://github.com/fpco/unliftio/pull/80)+ ## 0.2.16 * Add `createFileLink`
src/UnliftIO/Async.hs view
@@ -67,7 +67,12 @@ #if MIN_VERSION_base(4,8,0) Conc, conc, runConc,- ConcException (..)+ ConcException (..),+#endif++ -- * Re-exports+#if MIN_VERSION_async(2,2,0)+ A.AsyncCancelled (..), #endif ) where
src/UnliftIO/Exception.hs view
@@ -51,6 +51,11 @@ , catches , catchesDeep + -- * Catching async exceptions (with recovery)+ , catchSyncOrAsync+ , handleSyncOrAsync+ , trySyncOrAsync+ -- * Cleanup (no recovery) , onException , bracket@@ -65,6 +70,7 @@ , toSyncException , AsyncExceptionWrapper (..) , toAsyncException+ , fromExceptionUnwrap -- * Check exception type , isSyncException@@ -155,6 +161,19 @@ catchJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a catchJust f a b = a `catch` \e -> maybe (liftIO (throwIO e)) b $ f e +-- | A variant of 'catch' that catches both synchronous and asynchronous exceptions.+--+-- WARNING: This function (and other @*SyncOrAsync@ functions) is for advanced users. Most of the+-- time, you probably want to use the non-@SyncOrAsync@ versions.+--+-- Before attempting to use this function, be familiar with the "Rules for async safe handling"+-- section in+-- [this blog post](https://www.fpcomplete.com/blog/2018/04/async-exception-handling-haskell/).+--+-- @since 0.2.17+catchSyncOrAsync :: (MonadUnliftIO m, Exception e) => m a -> (e -> m a) -> m a+catchSyncOrAsync f g = withRunInIO $ \run -> run f `EUnsafe.catch` \e -> run (g e)+ -- | Flipped version of 'catch'. -- -- @since 0.1.0.0@@ -191,6 +210,14 @@ handleJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a handleJust f = flip (catchJust f) +-- | A variant of 'handle' that catches both synchronous and asynchronous exceptions.+--+-- See 'catchSyncOrAsync'.+--+-- @since 0.2.17+handleSyncOrAsync :: (MonadUnliftIO m, Exception e) => (e -> m a) -> m a -> m a+handleSyncOrAsync = flip catchSyncOrAsync+ -- | Run the given action and catch any synchronous exceptions as a 'Left' value. -- -- This is parameterized on the exception type. To catch all synchronous exceptions,@@ -232,6 +259,14 @@ tryJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a) tryJust f a = catch (Right `liftM` a) (\e -> maybe (throwIO e) (return . Left) (f e)) +-- | A variant of 'try' that catches both synchronous and asynchronous exceptions.+--+-- See 'catchSyncOrAsync'.+--+-- @since 0.2.17+trySyncOrAsync :: (MonadUnliftIO m, Exception e) => m a -> m (Either e a)+trySyncOrAsync f = catchSyncOrAsync (liftM Right f) (return . Left)+ -- | Evaluate the value to WHNF and catch any synchronous exceptions. -- -- The expression may still have bottom values within it; you may@@ -471,6 +506,20 @@ Nothing -> toException (AsyncExceptionWrapper e) where se = toException e++-- | Convert from a possibly wrapped exception.+--+-- The inverse of 'toAsyncException' and 'toSyncException'. When using those+-- functions (or functions that use them, like 'throwTo' or 'throwIO'),+-- 'fromException' might not be sufficient because the exception might be+-- wrapped within 'SyncExceptionWrapper' or 'AsyncExceptionWrapper'.+--+-- @since 0.2.17+fromExceptionUnwrap :: Exception e => SomeException -> Maybe e+fromExceptionUnwrap se+ | Just (AsyncExceptionWrapper e) <- fromException se = cast e+ | Just (SyncExceptionWrapper e) <- fromException se = cast e+ | otherwise = fromException se -- | Check if the given exception is synchronous. --
test/UnliftIO/ExceptionSpec.hs view
@@ -1,10 +1,92 @@+{-# LANGUAGE CPP #-}+ module UnliftIO.ExceptionSpec (spec) where +import qualified Control.Exception+import Control.Monad (void, (<=<))+import Data.Bifunctor (first) import Test.Hspec import UnliftIO+import UnliftIO.Concurrent (threadDelay) +#if MIN_VERSION_async(2,2,0)+cancelled :: AsyncCancelled+cancelled = AsyncCancelled+#else+cancelled :: Control.Exception.AsyncException+cancelled = Control.Exception.ThreadKilled+#endif+ spec :: Spec spec = do+ let -- The callback will run in a thread that gets cancelled immediately,+ -- then get Exception2 thrown synchronously after 1 second.+ withAsyncExceptionThrown :: (IO a -> IO b) -> IO b+ withAsyncExceptionThrown f = do+ var <- newEmptyMVar+ a <- async $ f $ do+ putMVar var ()+ threadDelay 1000000+ throwIO Exception2+ -- wait until thread is running, then cancel+ takeMVar var+ cancel a+ -- check result+ wait a+ -- The callback will run in a thread that gets Exception1 thrown as+ -- an async exception immediately, then get Exception2 thrown+ -- synchronously after 1 second.+ withWrappedAsyncExceptionThrown :: (IO a -> IO b) -> IO b+ withWrappedAsyncExceptionThrown f = do+ var <- newEmptyMVar+ a <- async $ f $ do+ putMVar var ()+ threadDelay 1000000+ throwIO Exception2+ -- wait until thread is running, then cancel+ takeMVar var+ throwTo (asyncThreadId a) Exception1+ -- check result+ wait a+ describe "catchSyncOrAsync" $ do+ it "should catch sync exceptions" $ do+ result <- (`catchSyncOrAsync` return) $ throwIO Exception1+ result `shouldBe` Exception1+ it "should catch async exceptions" $ do+ result <- withAsyncExceptionThrown $ \m -> m `catchSyncOrAsync` return+ result `shouldBe` cancelled+ it "should catch unliftio-wrapped async exceptions" $ do+ result <- withWrappedAsyncExceptionThrown $ \m -> m `catchSyncOrAsync` return+ fromExceptionUnwrap result `shouldBe` Just Exception1+ describe "handleSyncOrAsync" $ do+ it "should catch sync exceptions" $ do+ result <- handleSyncOrAsync return $ throwIO Exception1+ result `shouldBe` Exception1+ it "should catch async exceptions" $ do+ result <- withAsyncExceptionThrown $ \m -> handleSyncOrAsync return m+ result `shouldBe` cancelled+ it "should catch unliftio-wrapped async exceptions" $ do+ result <- withWrappedAsyncExceptionThrown $ \m -> handleSyncOrAsync return m+ fromExceptionUnwrap result `shouldBe` Just Exception1+ describe "trySyncOrAsync" $ do+ it "should catch sync exceptions" $ do+ result <- trySyncOrAsync $ void $ throwIO Exception1+ result `shouldBe` Left Exception1+ it "should catch async exceptions" $ do+ result <- withAsyncExceptionThrown $ \m -> trySyncOrAsync (void m)+ result `shouldBe` Left cancelled+ it "should catch unliftio-wrapped async exceptions" $ do+ result <- withWrappedAsyncExceptionThrown $ \m -> trySyncOrAsync (void m)+ first fromExceptionUnwrap result `shouldBe` Left (Just Exception1)++ describe "fromExceptionUnwrap" $ do+ it "should be the inverse of toAsyncException" $ do+ fromExceptionUnwrap (toAsyncException Exception1) `shouldBe` Just Exception1+ it "should be the inverse of toSyncException" $ do+ let toAsyncToSync = toSyncException . toAsyncException+ fromSyncFromAsyc = fromExceptionUnwrap <=< fromExceptionUnwrap+ fromSyncFromAsyc (toAsyncToSync Exception1) `shouldBe` Just Exception1+ let shouldLeft x = either (const Nothing) Just x `shouldBe` Nothing shouldRight x = either (Just . show) (const Nothing) x `shouldBe` Nothing describe "pureTry" $ do
unliftio.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: 57462bd1ca0ffabd88cb1b743945f84d5c6330a59b7b364445e08d6399628d80+-- hash: 6dc6425588ff3d300e7e59ea7cb3a42401bdb810af3e566aa8bd26ec2718a3bb name: unliftio-version: 0.2.16+version: 0.2.17 synopsis: The MonadUnliftIO typeclass for unlifting monads to IO (batteries included) description: Please see the documentation and README at <https://www.stackage.org/package/unliftio> category: Control