From a6e926e4d2b7fc754ae2b9b27f6e00fad12fcf0c Mon Sep 17 00:00:00 2001
From: Joshua Clayton <joshua.clayton@gmail.com>
Date: Sat, 18 Jun 2016 06:38:33 -0400
Subject: [PATCH] Move thread management to app wrapper

Why?
====

With multiple calls to `parallel`, `stopGlobalPool` stops working
correctly.

This moves `stopGlobalPool` higher up, and executes it once, allowing
multiple calls to `parallel` to happen without causing issues.
---
 src/Unused/CLI/ProgressIndicator.hs | 2 +-
 src/Unused/CLI/Util.hs              | 3 ++-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Unused/CLI/ProgressIndicator.hs b/src/Unused/CLI/ProgressIndicator.hs
index 65adda5..a18425f 100644
--- a/src/Unused/CLI/ProgressIndicator.hs
+++ b/src/Unused/CLI/ProgressIndicator.hs
@@ -25,6 +25,6 @@ progressWithIndicator f i terms = do
     printPrefix i
     (tid, indicator) <- start i $ length terms
     installChildInterruptHandler tid
-    mconcat <$> parallel (ioOps indicator) <* stop indicator <* stopGlobalPool
+    mconcat <$> parallel (ioOps indicator) <* stop indicator
   where
     ioOps i' = map (\t -> f t <* increment i') terms
diff --git a/src/Unused/CLI/Util.hs b/src/Unused/CLI/Util.hs
index 4182464..19bcded 100644
--- a/src/Unused/CLI/Util.hs
+++ b/src/Unused/CLI/Util.hs
@@ -5,6 +5,7 @@ module Unused.CLI.Util
     , module System.Console.ANSI
     ) where
 
+import Control.Concurrent.ParallelIO
 import Control.Monad (void)
 import System.Console.ANSI
 import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
@@ -16,7 +17,7 @@ import System.Exit (ExitCode(ExitFailure))
 withRuntime :: IO a -> IO a
 withRuntime a = do
     hSetBuffering stdout NoBuffering
-    withInterruptHandler $ withoutCursor a
+    withInterruptHandler $ withoutCursor a <* stopGlobalPool
 
 resetScreen :: IO ()
 resetScreen = do