async-extras 0.1.0.0 → 0.1.1.0

raw patch · 3 files changed

+92/−11 lines, 3 filesdep +lifted-asyncdep +lifted-basedep +monad-controldep ~SafeSemaphoredep ~asyncdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: lifted-async, lifted-base, monad-control, transformers-base

Dependency ranges changed: SafeSemaphore, async, base, stm

API changes (from Hackage documentation)

Files

• async-extras.cabal +12/−6
• src/Control/Concurrent/Async/Extra.hs +5/−5
• src/Control/Concurrent/Async/Lifted/Extra.hs +75/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                async-extras-version:             0.1.0.0+version:             0.1.1.0 synopsis:            Extra Utilities for the Async Library -- description:          homepage:            http://github.com/jfischoff/async-extras@@ -17,12 +17,18 @@ cabal-version:       >=1.10  library-  exposed-modules:     Control.Concurrent.Async.Extra+  exposed-modules: Control.Concurrent.Async.Extra+                 , Control.Concurrent.Async.Lifted.Extra   -- other-modules:          other-extensions:    RecursiveDo-  build-depends: base          >=4.6 && <4.8-               , async         >=2.0 && <2.1-               , stm           >=2.4 && <2.5-               , SafeSemaphore >=0.10 && <0.11+  build-depends: base              >= 4.6 && <5.0+               , async             >= 2.0 +               , stm               >= 2.4 +               , SafeSemaphore     >= 0.10+               , lifted-async      >= 0.2.0+               , lifted-base       >= 0.2+               , monad-control     >= 0.3.1+               , transformers-base >= 0.4+                  hs-source-dirs:      src   default-language:    Haskell2010

@@ -10,14 +10,14 @@ import Control.Monad  -- | Implementation derived from Petr Pudlák's answer on StackOverflow---   http://stackoverflow.com/a/18898822/230050+--   <http://stackoverflow.com/a/18898822/230050> sequencePool :: Traversable t => Int -> t (IO a) -> IO (t a) sequencePool max xs = do     sem <- new max     runConcurrently $ traverse (Concurrently . with sem) xs      -- | Implementation copied from Petr Pudlák's answer on StackOverflow---   http://stackoverflow.com/a/18898822/230050+--   <http://stackoverflow.com/a/18898822/230050> mapPool :: Traversable t => Int -> (a -> IO b) -> t a -> IO (t b) mapPool max f xs = do     sem <- new max@@ -26,18 +26,18 @@ sequenceConcurrently :: Traversable t => t (IO a) -> IO (t a) sequenceConcurrently = runConcurrently . traverse Concurrently --- | Create an Async a and pass it to itself.+-- | Create an 'Async' and pass it to itself. fixAsync :: (Async a -> IO a) -> IO (Async a) fixAsync f = mdo      this <- async $ f this     return this --- | Create an async that is link to a parent. If the parent+-- | Create an async that is linked to a parent. If the parent --   dies so does this async withParent :: Async a -> IO b -> IO (Async b) withParent parent act = async $ link parent >> act --- | Is like Concurrently but includes a sequential monad instance+-- | 'Promise' is like 'Concurrently' but includes a sequential monad instance newtype Promise a = Promise { unPromise :: IO a }   deriving (Functor) 

@@ -0,0 +1,75 @@+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeFamilies #-}+module Control.Concurrent.Async.Lifted.Extra where+import Control.Concurrent.Async.Lifted+import Control.Concurrent.STM+import Control.Concurrent+import Control.Concurrent.MSem (new, with)+import Data.Traversable +import Control.Applicative+import Control.Monad+import Control.Monad.Trans.Control+import Control.Monad.Fix+import Control.Monad.Base++-- | Implementation derived from Petr Pudlák's answer on StackOverflow+--   <http://stackoverflow.com/a/18898822/230050>+sequencePool :: (Traversable t, MonadBaseControl IO m) +             => Int -> t (m a) -> m (t a)+sequencePool max xs = do+    sem <- liftBase $ new max+    runConcurrently $ traverse (Concurrently . liftBaseOp_ (with sem)) xs+    +-- | Implementation copied from Petr Pudlák's answer on StackOverflow+--   <http://stackoverflow.com/a/18898822/230050>+mapPool :: (Traversable t, MonadBaseControl IO m) +        => Int +        -> (a -> m b) +        -> t a +        -> m (t b)+mapPool max f xs = do+    sem <- liftBase $ new max+    mapConcurrently (liftBaseOp_ (with sem) . f) xs+    +sequenceConcurrently :: (Traversable t, MonadBaseControl IO m) +                     => t (m a) -> m (t a)+sequenceConcurrently = runConcurrently . traverse Concurrently++-- | Create an 'Async' and pass it to itself.+fixAsync :: (MonadFix m, MonadBaseControl IO m) +            => (Async (StM m a) -> m a) -> m (Async (StM m a))+fixAsync f = mdo +    this <- async $ f this+    return this++-- | Create an async that is linked to a parent. If the parent+--   dies so does this async+withParent :: MonadBaseControl IO m +           => Async (StM m a) -> m b -> m (Async (StM m b))+withParent parent act = async $ link parent >> act+++-- | 'Promise' is like 'Concurrently' but includes a sequential monad instance+newtype Promise (b :: * -> *) m a = Promise { unPromise :: m a }++instance (b ~ IO, Functor m) => Functor (Promise b m) where+  fmap f (Promise a) = Promise $ f <$> a++instance (b ~ IO, MonadBaseControl b m) => Applicative (Promise b m) where+  pure = Promise . return+  Promise f <*> Promise x = Promise $ uncurry ($) <$> concurrently f x+  +instance (b ~ IO, MonadBaseControl b m) => Alternative (Promise b m) where+  empty = Promise $ liftBaseWith . const $ forever (threadDelay maxBound)+  Promise x <|> Promise y = Promise $ either id id <$> race x y++instance (b ~ IO, MonadBaseControl b m) => Monad (Promise b m) where+  return = pure+  Promise m >>= f = Promise $ async m >>= wait >>= unPromise . f ++instance (b ~ IO, MonadBaseControl b m) => MonadPlus (Promise b m) where+  mzero = empty+  mplus = (<|>)