diff options
Diffstat (limited to 'Utility')
| -rw-r--r-- | Utility/Parallel.hs | 20 | ||||
| -rw-r--r-- | Utility/ThreadScheduler.hs | 6 |
2 files changed, 26 insertions, 0 deletions
diff --git a/Utility/Parallel.hs b/Utility/Parallel.hs new file mode 100644 index 000000000..a512a6d30 --- /dev/null +++ b/Utility/Parallel.hs @@ -0,0 +1,20 @@ +{- parallel processes + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.Parallel where + +import Common + +{- Runs an action in parallel with a set of values. + - Returns values that caused the action to fail. -} +inParallel :: (v -> IO ()) -> [v] -> IO [v] +inParallel a v = do + pids <- mapM (forkProcess . a) v + statuses <- mapM (getProcessStatus True False) pids + return $ map fst $ filter failed $ zip v statuses + where + failed (_, status) = status /= Just (Exited ExitSuccess) diff --git a/Utility/ThreadScheduler.hs b/Utility/ThreadScheduler.hs index 6557398fd..07a740160 100644 --- a/Utility/ThreadScheduler.hs +++ b/Utility/ThreadScheduler.hs @@ -24,6 +24,12 @@ runEvery n a = forever $ do threadDelaySeconds n a +runEveryWith :: Seconds -> a -> (a -> IO a) -> IO () +runEveryWith n val a = do + threadDelaySeconds n + val' <- a val + runEveryWith n val' a + threadDelaySeconds :: Seconds -> IO () threadDelaySeconds (Seconds n) = unboundDelay (fromIntegral n * oneSecond) where |