summaryrefslogtreecommitdiff
path: root/src/Output.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Output.hs')
-rw-r--r--src/Output.hs36
1 files changed, 33 insertions, 3 deletions
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 }