diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2021-11-15 22:09:34 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2021-11-15 22:09:34 +0100 |
commit | 5264adf4ed9ede6ca08f72b8cf467ae438df4d5f (patch) | |
tree | 0d5e849948d8c0892edd99cd03d849a160c3d688 /src | |
parent | 618b54f521191811db4c7247d22be150ce89af6a (diff) |
Keep the waiting prompt below output until triggered
Diffstat (limited to 'src')
-rw-r--r-- | src/Main.hs | 4 | ||||
-rw-r--r-- | 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 } |