From 5264adf4ed9ede6ca08f72b8cf467ae438df4d5f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 15 Nov 2021 22:09:34 +0100
Subject: Keep the waiting prompt below output until triggered

---
 src/Main.hs   |  4 ++--
 src/Output.hs | 36 +++++++++++++++++++++++++++++++++---
 2 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 47e0746..5cb64d9 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -212,9 +212,9 @@ runTest out tool test = do
             expect out p regex
 
         Wait -> do
-            putStr "Waiting..."
-            hFlush stdout
+            outPrompt out $ T.pack "Waiting..."
             void $ getLine
+            outClearPrompt out
 
     _ <- installHandler processStatusChanged oldHandler Nothing
     exitNetwork out net
diff --git a/src/Output.hs b/src/Output.hs
index afa9aa0..d701176 100644
--- a/src/Output.hs
+++ b/src/Output.hs
@@ -2,18 +2,26 @@ module Output (
     Output, OutputType(..),
     startOutput,
     outLine,
+    outPrompt, outClearPrompt,
 ) where
 
 import Control.Concurrent.MVar
 
 import Data.Text (Text)
 import Data.Text qualified as T
+import Data.Text.IO qualified as T
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.IO qualified as TL
 
+import System.IO
+
 import Test
 
-data Output = Output { outState :: MVar () }
+data Output = Output { outState :: MVar OutputState }
+
+data OutputState = OutputState
+    { outCurPrompt :: Maybe Text
+    }
 
 data OutputType = OutputChildStdout
                 | OutputChildStderr
@@ -23,7 +31,7 @@ data OutputType = OutputChildStdout
                 | OutputMatchFail
 
 startOutput :: IO Output
-startOutput =  Output <$> newMVar ()
+startOutput =  Output <$> newMVar OutputState { outCurPrompt = Nothing }
 
 outColor :: OutputType -> Text
 outColor OutputChildStdout = T.pack "0"
@@ -41,8 +49,17 @@ outSign OutputChildFail = T.pack "!!"
 outSign OutputMatch = T.pack "+"
 outSign OutputMatchFail = T.pack "/"
 
+clearPrompt :: OutputState -> IO ()
+clearPrompt OutputState { outCurPrompt = Just _ } = T.putStr $ T.pack "\ESC[2K\r"
+clearPrompt _ = return ()
+
+showPrompt :: OutputState -> IO ()
+showPrompt OutputState { outCurPrompt = Just p } = T.putStr p >> hFlush stdout
+showPrompt _ = return ()
+
 outLine :: Output -> OutputType -> Maybe ProcName -> Text -> IO ()
-outLine out otype mbproc line = withMVar (outState out) $ \_ -> do
+outLine out otype mbproc line = withMVar (outState out) $ \st -> do
+    clearPrompt st
     TL.putStrLn $ TL.fromChunks
         [ T.pack "\ESC[", outColor otype, T.pack "m"
         , maybe T.empty textProcName mbproc
@@ -51,3 +68,16 @@ outLine out otype mbproc line = withMVar (outState out) $ \_ -> do
         , line
         , T.pack "\ESC[0m"
         ]
+    showPrompt st
+
+outPrompt :: Output -> Text -> IO ()
+outPrompt out p = modifyMVar_ (outState out) $ \st -> do
+    clearPrompt st
+    let st' = st { outCurPrompt = Just p }
+    showPrompt st'
+    return st'
+
+outClearPrompt :: Output -> IO ()
+outClearPrompt out = modifyMVar_ (outState out) $ \st -> do
+    clearPrompt st
+    return st { outCurPrompt = Nothing }
-- 
cgit v1.2.3