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

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

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]