summaryrefslogtreecommitdiff
path: root/src/Output.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Output.hs')
-rw-r--r--src/Output.hs53
1 files changed, 53 insertions, 0 deletions
diff --git a/src/Output.hs b/src/Output.hs
new file mode 100644
index 0000000..afa9aa0
--- /dev/null
+++ b/src/Output.hs
@@ -0,0 +1,53 @@
+module Output (
+ Output, OutputType(..),
+ startOutput,
+ outLine,
+) where
+
+import Control.Concurrent.MVar
+
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Text.Lazy qualified as TL
+import Data.Text.Lazy.IO qualified as TL
+
+import Test
+
+data Output = Output { outState :: MVar () }
+
+data OutputType = OutputChildStdout
+ | OutputChildStderr
+ | OutputChildInfo
+ | OutputChildFail
+ | OutputMatch
+ | OutputMatchFail
+
+startOutput :: IO Output
+startOutput = Output <$> newMVar ()
+
+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 "/"
+
+outLine :: Output -> OutputType -> Maybe ProcName -> Text -> IO ()
+outLine out otype mbproc line = withMVar (outState out) $ \_ -> do
+ 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"
+ ]