fix push status, broken when inParallel was adapted for -threaded
Before pushing ran in its own process, so exitSuccess was the right thing to do, but with the threaded code, that's caught as an exception.
This commit is contained in:
parent
3dce75fb23
commit
40c9973675
2 changed files with 8 additions and 15 deletions
|
@ -18,7 +18,7 @@ import Control.Exception
|
|||
-
|
||||
- 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 :: (v -> IO Bool) -> [v] -> IO ([v], [v])
|
||||
inParallel a l = do
|
||||
mvars <- mapM thread l
|
||||
statuses <- mapM takeMVar mvars
|
||||
|
@ -28,8 +28,8 @@ inParallel a l = do
|
|||
thread v = do
|
||||
mvar <- newEmptyMVar
|
||||
_ <- forkIO $ do
|
||||
r <- try (a v) :: IO (Either SomeException ())
|
||||
r <- try (a v) :: IO (Either SomeException Bool)
|
||||
case r of
|
||||
Left _ -> putMVar mvar False
|
||||
Right _ -> putMVar mvar True
|
||||
Right b -> putMVar mvar b
|
||||
return mvar
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue