async-dejafu 0.1.0.0 → 0.1.1.0

raw patch · 2 files changed

+42/−33 lines, 2 filesdep ~basedep ~dejafudep ~exceptionsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, dejafu, exceptions

API changes (from Hackage documentation)

Files

• Control/Concurrent/Async.hs +31/−31
• async-dejafu.cabal +11/−2

@@ -83,7 +83,7 @@ import Control.Monad.Catch (finally, try, onException) import Control.Monad.Conc.Class import Control.Monad.STM.Class-import Control.Concurrent.STM.CTMVar (newEmptyCTMVar, putCTMVar, readCTMVar)+import Control.Concurrent.Classy.STM.TMVar (newEmptyTMVar, putTMVar, readTMVar)  #if !MIN_VERSION_base(4,8,0) import Data.Traversable@@ -103,7 +103,7 @@ -- necessarily have one. data Async m a = Async   { asyncThreadId :: !(ThreadId m)-  , _asyncWait :: STMLike m (Either SomeException a)+  , _asyncWait :: STM m (Either SomeException a)   }  instance MonadConc m => Eq (Async m a) where@@ -167,19 +167,19 @@ -- | Fork a thread with the given forking function asyncUsing :: MonadConc m => (m () -> m (ThreadId m)) -> m a -> m (Async m a) asyncUsing doFork action = do-  var <- atomically newEmptyCTMVar-  tid <- mask $ \restore -> doFork $ try (restore action) >>= atomically . putCTMVar var+  var <- atomically newEmptyTMVar+  tid <- mask $ \restore -> doFork $ try (restore action) >>= atomically . putTMVar var -  return $ Async tid (readCTMVar var)+  return $ Async tid (readTMVar var)  -- | Fork a thread with the given forking function and give it an -- action to unmask exceptions asyncUnmaskUsing :: MonadConc m => (((forall b. m b -> m b) -> m ()) -> m (ThreadId m)) -> ((forall b. m b -> m b) -> m a) -> m (Async m a) asyncUnmaskUsing doFork action = do-  var <- atomically newEmptyCTMVar-  tid <- doFork $ \restore -> try (action restore) >>= atomically . putCTMVar var+  var <- atomically newEmptyTMVar+  tid <- doFork $ \restore -> try (action restore) >>= atomically . putTMVar var -  return $ Async tid (readCTMVar var)+  return $ Async tid (readTMVar var)  -- | Spawn an asynchronous action in a separate thread, and pass its -- @Async@ handle to the supplied function. When the function returns@@ -214,10 +214,10 @@ -- using the normal async package. Curious. withAsyncUsing :: MonadConc m => (m () -> m (ThreadId m)) -> m a -> (Async m a -> m b) -> m b withAsyncUsing doFork action inner = do-  var <- atomically newEmptyCTMVar-  tid <- mask $ \restore -> doFork $ try (restore action) >>= atomically . putCTMVar var+  var <- atomically newEmptyTMVar+  tid <- mask $ \restore -> doFork $ try (restore action) >>= atomically . putTMVar var -  let a = Async tid (readCTMVar var)+  let a = Async tid (readTMVar var)    res <- inner a `catchAll` (\e -> cancel a >> throw e)   cancel a@@ -228,10 +228,10 @@ -- to unmask exceptions, and kill it when the inner action completed. withAsyncUnmaskUsing :: MonadConc m => (((forall x. m x -> m x) -> m ()) -> m (ThreadId m)) -> ((forall x. m x -> m x) -> m a) -> (Async m a -> m b) -> m b withAsyncUnmaskUsing doFork action inner = do-  var <- atomically newEmptyCTMVar-  tid <- doFork $ \restore -> try (action restore) >>= atomically . putCTMVar var+  var <- atomically newEmptyTMVar+  tid <- doFork $ \restore -> try (action restore) >>= atomically . putTMVar var -  let a = Async tid (readCTMVar var)+  let a = Async tid (readTMVar var)    res <- inner a `catchAll` (\e -> cancel a >> throw e)   cancel a@@ -253,7 +253,7 @@ wait = atomically . waitSTM  -- | A version of 'wait' that can be used inside a @MonadSTM@ transaction.-waitSTM :: MonadConc m => Async m a -> STMLike m a+waitSTM :: MonadConc m => Async m a -> STM m a waitSTM a = do  r <- waitCatchSTM a  either throwSTM return r@@ -268,7 +268,7 @@ poll = atomically . pollSTM  -- | A version of 'poll' that can be used inside a @MonadSTM@ transaction.-pollSTM :: MonadConc m => Async m a -> STMLike m (Maybe (Either SomeException a))+pollSTM :: MonadConc m => Async m a -> STM m (Maybe (Either SomeException a)) pollSTM (Async _ w) = (Just <$> w) `orElse` return Nothing  -- | Wait for an asynchronous action to complete, and return either@@ -280,7 +280,7 @@   tryAgain f = f `catch` \BlockedIndefinitelyOnSTM -> f  -- | A version of 'waitCatch' that can be used inside a @MonadSTM@ transaction.-waitCatchSTM :: MonadConc m => Async m a -> STMLike m (Either SomeException a)+waitCatchSTM :: MonadConc m => Async m a -> STM m (Either SomeException a) waitCatchSTM (Async _ w) = w  -- | Cancel an asynchronous action by throwing the @ThreadKilled@@@ -322,7 +322,7 @@  -- | A version of 'waitAny' that can be used inside a @MonadSTM@ -- transaction.-waitAnySTM :: MonadConc m => [Async m a] -> STMLike m (Async m a, a)+waitAnySTM :: MonadConc m => [Async m a] -> STM m (Async m a, a) waitAnySTM = foldr (orElse . (\a -> do r <- waitSTM a; return (a, r))) retry  -- | Wait for any of the supplied asynchronous operations to complete.@@ -336,7 +336,7 @@  -- | A version of 'waitAnyCatch' that can be used inside a @MonadSTM@ -- transaction.-waitAnyCatchSTM :: MonadConc m => [Async m a] -> STMLike m (Async m a, Either SomeException a)+waitAnyCatchSTM :: MonadConc m => [Async m a] -> STM m (Async m a, Either SomeException a) waitAnyCatchSTM = foldr (orElse . (\a -> do r <- waitCatchSTM a; return (a, r))) retry  -- | Like 'waitAny', but also cancels the other asynchronous@@ -357,7 +357,7 @@  -- | A version of 'waitEither' that can be used inside a @MonadSTM@ -- transaction.-waitEitherSTM :: MonadConc m => Async m a -> Async m b -> STMLike m (Either a b)+waitEitherSTM :: MonadConc m => Async m a -> Async m b -> STM m (Either a b) waitEitherSTM left right =   (Left <$> waitSTM left) `orElse` (Right <$> waitSTM right) @@ -369,7 +369,7 @@ -- | A version of 'waitEitherCatch' that can be used inside a -- @MonadSTM@ transaction. waitEitherCatchSTM :: MonadConc m => Async m a -> Async m b-  -> STMLike m (Either (Either SomeException a) (Either SomeException b))+  -> STM m (Either (Either SomeException a) (Either SomeException b)) waitEitherCatchSTM left right =   (Left <$> waitCatchSTM left) `orElse` (Right <$> waitCatchSTM right) @@ -392,7 +392,7 @@  -- | A version of 'waitEither_' that can be used inside a @MonadSTM@ -- transaction.-waitEitherSTM_:: MonadConc m => Async m a -> Async m b -> STMLike m ()+waitEitherSTM_:: MonadConc m => Async m a -> Async m b -> STM m () waitEitherSTM_ left right = void $ waitEitherSTM left right  -- | Waits for both @Async@s to finish, but if either of them throws@@ -403,7 +403,7 @@  -- | A version of 'waitBoth' that can be used inside a @MonadSTM@ -- transaction.-waitBothSTM :: MonadConc m => Async m a -> Async m b -> STMLike m (a, b)+waitBothSTM :: MonadConc m => Async m a -> Async m b -> STM m (a, b) waitBothSTM left right = do   a <- waitSTM left `orElse` (waitSTM right >> retry)   b <- waitSTM right@@ -464,7 +464,7 @@ race :: MonadConc m => m a -> m b -> m (Either a b) race left right = concurrently' left right collect where   collect m = do-    e <- takeCVar m+    e <- takeMVar m     case e of       Left ex -> throw ex       Right r -> return r@@ -492,23 +492,23 @@   collect [Left a, Right b] _ = return (a, b)   collect [Right b, Left a] _ = return (a, b)   collect xs m = do-    e <- takeCVar m+    e <- takeMVar m     case e of       Left ex -> throw ex       Right r -> collect (r:xs) m  -- Run two things concurrently. Faster than the 'Async' version. concurrently' :: MonadConc m => m a -> m b-  -> (CVar m (Either SomeException (Either a b)) -> m r)+  -> (MVar m (Either SomeException (Either a b)) -> m r)   -> m r concurrently' left right collect = do-  done <- newEmptyCVar+  done <- newEmptyMVar   mask $ \restore -> do-    lid <- fork $ restore (left >>= putCVar done . Right . Left)-          `catch` (putCVar done . Left)+    lid <- fork $ restore (left >>= putMVar done . Right . Left)+          `catch` (putMVar done . Left) -    rid <- fork $ restore (right >>= putCVar done . Right . Right)-          `catch` (putCVar done . Left)+    rid <- fork $ restore (right >>= putMVar done . Right . Right)+          `catch` (putMVar done . Left)      -- See: https://github.com/simonmar/async/issues/27     let stop = killThread rid >> killThread lid

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                async-dejafu-version:             0.1.0.0+version:             0.1.1.0 synopsis:            Run MonadConc operations asynchronously and wait for their results.  description:@@ -30,12 +30,21 @@ -- extra-source-files:   cabal-version:       >=1.10 +source-repository head+  type:     git+  location: https://github.com/barrucadu/dejafu.git++source-repository this+  type:     git+  location: https://github.com/barrucadu/dejafu.git+  tag:      async-dejafu-0.1.1.0+ library   exposed-modules:     Control.Concurrent.Async   -- other-modules:          -- other-extensions:       build-depends:       base >=4.5 && <5-                     , dejafu >= 0.1+                     , dejafu == 0.3.*                      , exceptions   -- hs-source-dirs:         default-language:    Haskell2010