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.
This commit is contained in:
Joshua Clayton 2016-06-18 06:38:33 -04:00
parent a5b8f31e4d
commit a6e926e4d2
2 changed files with 3 additions and 2 deletions

View File

@ -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

View File

@ -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