From c77cd2a8f60a325bad877256843ca398e505be29 Mon Sep 17 00:00:00 2001
From: Joshua Clayton <joshua.clayton@gmail.com>
Date: Sun, 15 May 2016 16:06:42 -0400
Subject: [PATCH] Handle Ctrl-C both at top thread and forked thread for
 progressbar

This ensures Ctrl-C interrupts the main thread as well as kills the
forked thread rendering progress.
---
 src/Unused/CLI/ProgressIndicator.hs |  3 ++-
 src/Unused/CLI/Util.hs              | 25 +++++++++++++++++++++----
 2 files changed, 23 insertions(+), 5 deletions(-)

diff --git a/src/Unused/CLI/ProgressIndicator.hs b/src/Unused/CLI/ProgressIndicator.hs
index b589190..475b28d 100644
--- a/src/Unused/CLI/ProgressIndicator.hs
+++ b/src/Unused/CLI/ProgressIndicator.hs
@@ -23,7 +23,8 @@ createSpinner =
 progressWithIndicator :: (a -> IO [b]) -> ProgressIndicator -> [a] -> IO [b]
 progressWithIndicator f i terms = do
     printPrefix i
-    (_, indicator) <- start i $ length terms
+    (tid, indicator) <- start i $ length terms
+    installChildInterruptHandler tid
     concat <$> parallel (ioOps indicator) <* stop indicator <* stopGlobalPool
   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 b8f956e..c7330a2 100644
--- a/src/Unused/CLI/Util.hs
+++ b/src/Unused/CLI/Util.hs
@@ -2,6 +2,7 @@ module Unused.CLI.Util
     ( resetScreen
     , withoutCursor
     , withInterruptHandler
+    , installChildInterruptHandler
     , module System.Console.ANSI
     ) where
 
@@ -9,7 +10,7 @@ import Control.Monad (void)
 import System.Console.ANSI
 import Control.Exception (throwTo)
 import System.Posix.Signals (Handler(Catch), installHandler, keyboardSignal)
-import Control.Concurrent (ThreadId, myThreadId)
+import Control.Concurrent (ThreadId, myThreadId, killThread)
 import System.Exit (ExitCode(ExitFailure))
 
 withoutCursor :: IO a -> IO a
@@ -28,15 +29,31 @@ withInterruptHandler body = do
     void $ installHandler keyboardSignal (Catch (handleInterrupt tid)) Nothing
     body
 
+installChildInterruptHandler :: ThreadId -> IO ()
+installChildInterruptHandler tid = do
+    currentThread <- myThreadId
+    void $ installHandler keyboardSignal (Catch (handleChildInterrupt currentThread tid)) Nothing
+
 handleInterrupt :: ThreadId -> IO ()
 handleInterrupt tid = do
-    resetScreen
-    showCursor
-    setSGR [Reset]
+    resetScreenState
     throwTo tid $ ExitFailure interruptExitCode
 
+handleChildInterrupt :: ThreadId -> ThreadId -> IO ()
+handleChildInterrupt parentTid childTid = do
+    killThread childTid
+    resetScreenState
+    throwTo parentTid $ ExitFailure interruptExitCode
+    handleInterrupt parentTid
+
 interruptExitCode :: Int
 interruptExitCode =
     signalToInt $ 128 + keyboardSignal
   where
     signalToInt s = read $ show s :: Int
+
+resetScreenState :: IO ()
+resetScreenState = do
+    resetScreen
+    showCursor
+    setSGR [Reset]