threadmanager (empty) → 0.1

raw patch · 4 files changed

+133/−0 lines, 4 filesdep +basedep +containerssetup-changed

Dependencies added: base, containers

Files

• LICENSE +26/−0
• Setup.hs +6/−0
• src/Control/Concurrent/ThreadManager.hs +76/−0
• threadmanager.cabal +25/−0

@@ -0,0 +1,26 @@+Copyright Bryan O'Sullivan, Don Stewart, John Goerzen, Brian Lewis, Ian Taylor 2009++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.++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,6 @@+module Main (main) where++import Distribution.Simple (defaultMain)++main :: IO ()+main = defaultMain

@@ -0,0 +1,76 @@+{-|+  A simple thread management API inspired by the one in chapter+  24 of /Real World Haskell/.++  See <http://book.realworldhaskell.org/read/concurrent-and-multicore-programming.html>.++  Intended to be imported qualified (suggestion: TM).+ -}++module Control.Concurrent.ThreadManager+  ( ThreadManager+  , ThreadStatus+  , make+  , fork, forkn, getStatus, waitFor, waitForAll+  ) where++import Control.Concurrent      (ThreadId, forkIO)+import Control.Concurrent.MVar (MVar, modifyMVar, newEmptyMVar, newMVar, putMVar, takeMVar, tryTakeMVar)+import Control.Exception       (SomeException, try)+import Control.Monad           (join, replicateM)+import qualified Data.Map as M++data ThreadStatus =+    Running+  | Finished+  | Threw SomeException+  deriving Show++newtype ThreadManager = TM (MVar (M.Map ThreadId (MVar ThreadStatus)))+  deriving Eq++-- | Make a thread manager.+make :: IO ThreadManager+make = TM `fmap` newMVar M.empty++-- | Make a managed thread.+fork :: ThreadManager -> IO () -> IO ThreadId+fork (TM tm) action =+    modifyMVar tm $ \m -> do+        state <- newEmptyMVar+        tid <- forkIO $ do+            r <- try action+            putMVar state (either Threw (const Finished) r)+        return (M.insert tid state m, tid)++-- | Make the given number of managed threads.+forkn :: ThreadManager -> Int -> IO () -> IO [ThreadId]+forkn tm n = replicateM n . fork tm++-- | Get the status of a managed thread.+getStatus :: ThreadManager -> ThreadId -> IO (Maybe ThreadStatus)+getStatus (TM tm) tid =+    modifyMVar tm $ \m ->+      case M.lookup tid m of+        Nothing    -> return (m, Nothing)+        Just state -> tryTakeMVar state >>= \mst ->+          return $+            case mst of+              Nothing  -> (m, Just Running)+              Just sth -> (M.delete tid m, Just sth)++-- | Block until a specific managed thread terminates.+waitFor :: ThreadManager -> ThreadId -> IO (Maybe ThreadStatus)+waitFor (TM tm) tid =+    join . modifyMVar tm $ \m ->+      return $+        case M.updateLookupWithKey (\_ _ -> Nothing) tid m of+          (Nothing, _)     -> (m, return Nothing)+          (Just state, m') -> (m', Just `fmap` takeMVar state)++-- | Block until all managed threads terminate.+waitForAll :: ThreadManager -> IO ()+waitForAll (TM tm) =+    modifyMVar tm elems >>= mapM_ takeMVar+  where+    elems m = return (M.empty, M.elems m)

@@ -0,0 +1,25 @@+name:         threadmanager+version:      0.1+license:      BSD3+license-file: LICENSE+author:       _Real World Haskell_, http://www.realworldhaskell.org/+maintainer:   Brian Lewis <brian@lorf.org>, Ian Taylor <ian@lorf.org>+homepage:     http://github.com/bsl/threadmanager++category:    Concurrency+synopsis:    Simple thread management+description: A simple thread management API inspired by the one in chapter 24+             of /Real World Haskell/.+             .+             See <http://book.realworldhaskell.org/read/concurrent-and-multicore-programming.html>.++cabal-version: >= 1.6+build-type:    Simple++library+  hs-source-dirs:  src+  exposed-modules: Control.Concurrent.ThreadManager+  build-depends:   base == 4.*, containers == 0.2.*+  ghc-options:     -Wall+  if impl(ghc >= 6.8)+    ghc-options:   -fwarn-tabs