Common blink var for whole terminal output

2 files changed, 15 insertions, 9 deletions

diff --git a/src/Command/Run.hs b/src/Command/Run.hs
index bd2aba9..403e8b8 100644
--- a/src/Command/Run.hs
+++ b/src/Command/Run.hs
@@ -113,19 +113,14 @@ showStatus blink = \case
 
 displayStatusLine :: TerminalOutput -> Text -> Text -> [ Maybe (TVar (JobStatus JobOutput)) ] -> IO ()
 displayStatusLine tout prefix1 prefix2 statuses = do
-    blinkVar <- newTVarIO False
-    t <- forkIO $ forever $ do
-        threadDelay 500000
-        atomically $ writeTVar blinkVar . not =<< readTVar blinkVar
     line <- newLine tout ""
     void $ forkIO $ do
-        go line blinkVar "\0"
-        killThread t
+        go line "\0"
   where
-    go line blinkVar prev = do
+    go line prev = do
         (ss, cur) <- atomically $ do
             ss <- mapM (sequence . fmap readTVar) statuses
-            blink <- readTVar blinkVar
+            blink <- terminalBlinkStatus tout
             let cur = T.concat $ map (maybe "        " ((" " <>) . showStatus blink)) ss
             when (cur == prev) retry
             return (ss, cur)
@@ -137,4 +132,4 @@ displayStatusLine tout prefix1 prefix2 statuses = do
 
         if all (maybe True jobStatusFinished) ss
            then return ()
-           else go line blinkVar cur
+           else go line cur
diff --git a/src/Terminal.hs b/src/Terminal.hs
index bf50c58..84dfb91 100644
--- a/src/Terminal.hs
+++ b/src/Terminal.hs
@@ -4,9 +4,12 @@ module Terminal (
     initTerminalOutput,
     newLine,
     redrawLine,
+    terminalBlinkStatus,
 ) where
 
 import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad
 
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -17,6 +20,7 @@ import System.IO
 
 data TerminalOutput = TerminalOutput
     { outNumLines :: MVar Int
+    , outBlinkVar :: TVar Bool
     }
 
 data TerminalLine = TerminalLine
@@ -27,6 +31,10 @@ data TerminalLine = TerminalLine
 initTerminalOutput :: IO TerminalOutput
 initTerminalOutput = do
     outNumLines <- newMVar 0
+    outBlinkVar <- newTVarIO False
+    void $ forkIO $ forever $ do
+        threadDelay 500000
+        atomically $ writeTVar outBlinkVar . not =<< readTVar outBlinkVar
     return TerminalOutput {..}
 
 newLine :: TerminalOutput -> Text -> IO TerminalLine
@@ -43,3 +51,6 @@ redrawLine TerminalLine {..} text = do
         let moveBy = total - lineNum
         T.putStr $ "\ESC[s\ESC[" <> T.pack (show moveBy) <> "F" <> text <> "\ESC[u"
         hFlush stdout
+
+terminalBlinkStatus :: TerminalOutput -> STM Bool
+terminalBlinkStatus TerminalOutput {..} = readTVar outBlinkVar