From c072bcc6ef69535954d0b404cce42a1ccd9a1655 Mon Sep 17 00:00:00 2001
From: Neil Mitchell <ndmitchell@gmail.com>
Date: Mon, 28 Jul 2014 21:15:51 +0100
Subject: [PATCH] #73, make the parallelN function exception safe

---
 CHANGES.txt     | 1 +
 src/Parallel.hs | 7 ++++---
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/CHANGES.txt b/CHANGES.txt
index c5226ef71..9fbda1ba9 100644
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -1,5 +1,6 @@
 Changelog for HLint
 
+    #73, fix multithreading and exceptions with the API
 1.9.2
     #68, add --no-summary
 1.9.1
diff --git a/src/Parallel.hs b/src/Parallel.hs
index f1f2a486c..72b0efc31 100644
--- a/src/Parallel.hs
+++ b/src/Parallel.hs
@@ -13,6 +13,7 @@ module Parallel(parallel) where
 import System.IO.Unsafe
 import GHC.Conc(numCapabilities)
 import Control.Concurrent
+import Control.Exception
 import Control.Monad
 
 
@@ -34,13 +35,13 @@ parallelN xs = do
     chan <- newChan
     mapM_ (writeChan chan . Just) $ zip ms xs
     replicateM_ numCapabilities (writeChan chan Nothing >> forkIO (f chan))
-    parallel1 $ map takeMVar ms
+    let throwE x = throw (x :: SomeException)
+    parallel1 $ map (fmap (either throwE id) . takeMVar) ms
     where
         f chan = do
             v <- readChan chan
             case v of
                 Nothing -> return ()
                 Just (m,x) -> do
-                    x' <- x
-                    putMVar m x'
+                    putMVar m =<< try x
                     f chan