Don't print to stdout during logging

This commit is contained in:
Julian Ospald 2022-01-19 15:40:58 +01:00
parent 66961101c6
commit 67b7b2f292
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
2 changed files with 6 additions and 4 deletions

View File

@ -35,6 +35,7 @@ import Data.Sequence ( Seq, (|>) )
import Data.List import Data.List
import Data.Word8 import Data.Word8
import GHC.IO.Exception import GHC.IO.Exception
import System.IO ( stderr )
import System.IO.Error import System.IO.Error
import System.FilePath import System.FilePath
import System.Directory import System.Directory
@ -142,14 +143,14 @@ execLogged exe args chdir lfile env = do
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO () printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
printToRegion fileFd fdIn size pState no_color = do printToRegion fileFd fdIn size pState no_color = do
-- init region -- init region
forM_ [1..size] $ \_ -> BS.putStr "\n" forM_ [1..size] $ \_ -> BS.hPut stderr "\n"
void $ flip runStateT mempty void $ flip runStateT mempty
$ do $ do
handle handle
(\(ex :: SomeException) -> do (\(ex :: SomeException) -> do
ps <- liftIO $ takeMVar pState ps <- liftIO $ takeMVar pState
when ps (liftIO $ BS.putStr (pos1 <> moveLineUp size <> clearScreen)) when ps (liftIO $ BS.hPut stderr (pos1 <> moveLineUp size <> clearScreen))
throw ex throw ex
) $ readTilEOF lineAction fdIn ) $ readTilEOF lineAction fdIn
@ -184,7 +185,7 @@ execLogged exe args chdir lfile env = do
Just (TP.Window _ w) -> do Just (TP.Window _ w) -> do
regs <- get regs <- get
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
BS.putStr BS.hPut stderr
. overwriteNthLine (size - i) . overwriteNthLine (size - i)
. trim w . trim w
. blue . blue

View File

@ -196,7 +196,8 @@ execLogged exe args chdir lfile env = do
then pure () then pure ()
else do else do
void $ BS.appendFile logFile some void $ BS.appendFile logFile some
void $ BS.hPut stdout some -- subprocess stdout also goes to stderr for logging
void $ BS.hPut stderr some
go go