summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2021-11-15 22:09:34 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2021-11-15 22:09:34 +0100
commit5264adf4ed9ede6ca08f72b8cf467ae438df4d5f (patch)
tree0d5e849948d8c0892edd99cd03d849a160c3d688 /src
parent618b54f521191811db4c7247d22be150ce89af6a (diff)
Keep the waiting prompt below output until triggered
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs4
-rw-r--r--src/Output.hs36
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 }