1 files changed, 35 insertions, 0 deletions
diff --git a/Utility/Parallel.hs b/Utility/Parallel.hs
new file mode 100644
index 000000000..fcab2a90a
--- /dev/null
+++ b/Utility/Parallel.hs
@@ -0,0 +1,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 ()) -> [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 ())
+				case r of
+					Left _ -> putMVar mvar False
+					Right _ -> putMVar mvar True
+			return mvar