async-extras (empty) → 0.1.0.0

raw patch · 4 files changed

+118/−0 lines, 4 filesdep +SafeSemaphoredep +asyncdep +basesetup-changed

Dependencies added: SafeSemaphore, async, base, stm

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• async-extras.cabal +28/−0
• src/Control/Concurrent/Async/Extra.hs +58/−0

@@ -0,0 +1,30 @@+Copyright (c) 2014, Jonathan Fischoff++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jonathan Fischoff nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

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

@@ -0,0 +1,28 @@+-- Initial async-extras.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                async-extras+version:             0.1.0.0+synopsis:            Extra Utilities for the Async Library+-- description:         +homepage:            http://github.com/jfischoff/async-extras+license:             BSD3+license-file:        LICENSE+author:              Jonathan Fischoff+maintainer:          jonathangfischoff@gmail.com+-- copyright:           +category:            Concurrency+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Control.Concurrent.Async.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+  hs-source-dirs:      src+  default-language:    Haskell2010

@@ -0,0 +1,58 @@+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE DeriveFunctor #-}+module Control.Concurrent.Async.Extra where+import Control.Concurrent.Async+import Control.Concurrent.STM+import Control.Concurrent+import Control.Concurrent.MSem (new, with)+import Data.Traversable +import Control.Applicative+import Control.Monad++-- | Implementation derived from Petr Pudlák's answer on StackOverflow+--   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+mapPool :: Traversable t => Int -> (a -> IO b) -> t a -> IO (t b)+mapPool max f xs = do+    sem <- new max+    mapConcurrently (with sem . f) xs+    +sequenceConcurrently :: Traversable t => t (IO a) -> IO (t a)+sequenceConcurrently = runConcurrently . traverse Concurrently++-- | Create an Async a 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+--   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+newtype Promise a = Promise { unPromise :: IO a }+  deriving (Functor)++instance Applicative Promise where+  pure = Promise . return+  Promise f <*> Promise x = Promise $ uncurry ($) <$> concurrently f x+  +instance Alternative Promise where+  empty = Promise $ forever (threadDelay maxBound)+  Promise x <|> Promise y = Promise $ either id id <$> race x y++instance Monad Promise where+  return = pure+  Promise m >>= f = Promise $ async m >>= wait >>= unPromise . f ++instance MonadPlus Promise where+  mzero = empty+  mplus = (<|>)