1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
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 OutputState }
data OutputState = OutputState
{ outCurPrompt :: Maybe Text
}
data OutputType = OutputChildStdout
| OutputChildStderr
| OutputChildInfo
| OutputChildFail
| OutputMatch
| OutputMatchFail
startOutput :: IO Output
startOutput = Output <$> newMVar OutputState { outCurPrompt = Nothing }
outColor :: OutputType -> Text
outColor OutputChildStdout = T.pack "0"
outColor OutputChildStderr = T.pack "31"
outColor OutputChildInfo = T.pack "0"
outColor OutputChildFail = T.pack "31"
outColor OutputMatch = T.pack "32"
outColor OutputMatchFail = T.pack "31"
outSign :: OutputType -> Text
outSign OutputChildStdout = T.empty
outSign OutputChildStderr = T.pack "!"
outSign OutputChildInfo = T.pack "."
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) $ \st -> do
clearPrompt st
TL.putStrLn $ TL.fromChunks
[ T.pack "\ESC[", outColor otype, T.pack "m"
, maybe T.empty textProcName mbproc
, outSign otype
, T.pack "> "
, 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 }
|