diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2021-11-15 21:42:09 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2021-11-15 21:42:09 +0100 |
commit | 618b54f521191811db4c7247d22be150ce89af6a (patch) | |
tree | f636184d7292860470866063b9e7696d1891379a /src/Output.hs | |
parent | 600432a8b68548024860356976879e9ff31d0eb2 (diff) |
Separate module for output handling
Diffstat (limited to 'src/Output.hs')
-rw-r--r-- | src/Output.hs | 53 |
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" + ] |