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]