From 86351a85ec5c92a390e7bfc70648a67be84619c0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Thu, 27 Oct 2022 21:56:22 +0200
Subject: Show GDB console output always and without prompt

---
 src/GDB.hs     |  2 +-
 src/Main.hs    |  8 ++++----
 src/Output.hs  | 12 ++++++++----
 src/Process.hs |  2 +-
 4 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/src/GDB.hs b/src/GDB.hs
index 75f42fe..8cd6e10 100644
--- a/src/GDB.hs
+++ b/src/GDB.hs
@@ -132,7 +132,7 @@ gdbLine gdb rline = either (outProc OutputError (gdbProcess gdb) . T.pack . erro
                 , Just (MiString tgid) <- lookup "group-id" params
                 -> liftIO $ modifyMVar_ (gdbInferiors gdb) $ return . map (\inf -> if infThreadGroup inf == tgid then inf { infThreads = filter (/=tid) $ infThreads inf } else inf)
             _ -> return ()
-        ConsoleStreamOutput line -> mapM_ (outProc OutputChildStdout (gdbProcess gdb)) (T.lines line)
+        ConsoleStreamOutput line -> mapM_ (outLine OutputAlways Nothing) (T.lines line)
         TargetStreamOutput line -> mapM_ (outProc OutputChildStderr (gdbProcess gdb) . ("target-stream: " <>)) (T.lines line)
         LogStreamOutput line -> mapM_ (outProc OutputChildInfo (gdbProcess gdb) . ("log: " <>)) (T.lines line)
 
diff --git a/src/Main.hs b/src/Main.hs
index 9d2f9cc..d293226 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -72,7 +72,7 @@ newtype TestRun a = TestRun { fromTestRun :: ReaderT (TestEnv, TestState) (Excep
 
 instance MonadFail TestRun where
     fail str = do
-        outLine OutputError T.empty $ T.pack str
+        outLine OutputError Nothing $ T.pack str
         throwError Failed
 
 instance MonadError Failed TestRun where
@@ -249,9 +249,9 @@ exprFailed :: Text -> SourceLine -> Maybe ProcName -> Expr a -> TestRun ()
 exprFailed desc (SourceLine sline) pname expr = do
     let prompt = maybe T.empty textProcName pname
     exprVars <- gatherVars expr
-    outLine OutputMatchFail prompt $ T.concat [desc, T.pack " failed on ", sline]
+    outLine OutputMatchFail (Just prompt) $ T.concat [desc, T.pack " failed on ", sline]
     forM_ exprVars $ \(name, value) ->
-        outLine OutputMatchFail prompt $ T.concat [T.pack "  ", textVarName name, T.pack " = ", textSomeVarValue value]
+        outLine OutputMatchFail (Just prompt) $ T.concat [T.pack "  ", textVarName name, T.pack " = ", textSomeVarValue value]
     throwError Failed
 
 expect :: SourceLine -> Process -> Expr Regex -> [TypedVarName Text] -> TestRun () -> TestRun ()
@@ -301,7 +301,7 @@ evalSteps = mapM_ $ \case
     Let (SourceLine sline) name expr inner -> do
         cur <- asks (lookup name . tsVars . snd)
         when (isJust cur) $ do
-            outLine OutputError T.empty $ T.pack "variable '" `T.append` textVarName name `T.append` T.pack "' already exists on " `T.append` sline
+            outLine OutputError Nothing $ T.pack "variable '" `T.append` textVarName name `T.append` T.pack "' already exists on " `T.append` sline
             throwError Failed
         value <- eval expr
         withVar name value $ evalSteps inner
diff --git a/src/Output.hs b/src/Output.hs
index ca7f862..661e4fc 100644
--- a/src/Output.hs
+++ b/src/Output.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Output (
     Output, OutputType(..),
     MonadOutput(..),
@@ -38,6 +40,7 @@ data OutputType = OutputChildStdout
                 | OutputMatch
                 | OutputMatchFail
                 | OutputError
+                | OutputAlways
 
 class MonadIO m => MonadOutput m where
     getOutput :: m Output
@@ -58,6 +61,7 @@ outColor OutputChildFail = T.pack "31"
 outColor OutputMatch = T.pack "32"
 outColor OutputMatchFail = T.pack "31"
 outColor OutputError = T.pack "31"
+outColor OutputAlways = "0"
 
 outSign :: OutputType -> Text
 outSign OutputChildStdout = T.empty
@@ -67,6 +71,7 @@ outSign OutputChildFail = T.pack "!!"
 outSign OutputMatch = T.pack "+"
 outSign OutputMatchFail = T.pack "/"
 outSign OutputError = T.pack "!!"
+outSign OutputAlways = T.empty
 
 printWhenQuiet :: OutputType -> Bool
 printWhenQuiet = \case
@@ -77,6 +82,7 @@ printWhenQuiet = \case
     OutputMatch -> False
     OutputMatchFail -> True
     OutputError -> True
+    OutputAlways -> True
 
 clearPrompt :: OutputState -> IO ()
 clearPrompt OutputState { outCurPrompt = Just _ } = T.putStr $ T.pack "\ESC[2K\r"
@@ -89,16 +95,14 @@ showPrompt _ = return ()
 ioWithOutput :: MonadOutput m => (Output -> IO a) -> m a
 ioWithOutput act = liftIO . act =<< getOutput
 
-outLine :: MonadOutput m => OutputType -> Text -> Text -> m ()
+outLine :: MonadOutput m => OutputType -> Maybe Text -> Text -> m ()
 outLine otype prompt line = ioWithOutput $ \out ->
     when (outVerbose (outConfig out) || printWhenQuiet otype) $ do
         withMVar (outState out) $ \st -> do
             clearPrompt st
             TL.putStrLn $ TL.fromChunks
                 [ T.pack "\ESC[", outColor otype, T.pack "m"
-                , prompt
-                , outSign otype
-                , T.pack "> "
+                , maybe "" (<> outSign otype <> "> ") prompt
                 , line
                 , T.pack "\ESC[0m"
                 ]
diff --git a/src/Process.hs b/src/Process.hs
index de834a5..8548e73 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -68,7 +68,7 @@ send p line = liftIO $ do
     hFlush (procStdin p)
 
 outProc :: MonadOutput m => OutputType -> Process -> Text -> m ()
-outProc otype p line = outLine otype (textProcName $ procName p) line
+outProc otype p line = outLine otype (Just $ textProcName $ procName p) line
 
 lineReadingLoop :: MonadOutput m => Process -> Handle -> (Text -> m ()) -> m ()
 lineReadingLoop process h act =
-- 
cgit v1.2.3