aboutsummaryrefslogtreecommitdiff
path: root/Utility/Parallel.hs
blob: 373a0ece5489a4d6f30e88d159b090581f9c4cb6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
{- parallel processing via threads
 -
 - Copyright 2012 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Utility.Parallel where

import Common

import Control.Concurrent
import Control.Exception

{- Runs an action in parallel with a set of values, in a set of threads.
 - In order for the actions to truely run in parallel, requires GHC's
 - threaded runtime, 
 -
 - Returns the values partitioned into ones with which the action succeeded,
 - and ones with which it failed. -}
inParallel :: (v -> IO Bool) -> [v] -> IO ([v], [v])
inParallel a l = do
	mvars <- mapM thread l
	statuses <- mapM takeMVar mvars
	return $ reduce $ partition snd $ zip l statuses
	where
		reduce (x,y) = (map fst x, map fst y)
		thread v = do
			mvar <- newEmptyMVar
			_ <- forkIO $ do
				r <- try (a v) :: IO (Either SomeException Bool)
				case r of
					Left _ -> putMVar mvar False
					Right b -> putMVar mvar b
			return mvar