From c59ce983999ddbfe6cb8b27e4f376b5c37d7f853 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 5 Jul 2017 13:10:59 -0400 Subject: speed up chain output displaying Avoid needing to wait for a subsequent line before displaying the previous line. --- src/Propellor/Message.hs | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) (limited to 'src/Propellor/Message.hs') diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index c56f0c5a..1a01875c 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -27,10 +27,12 @@ import System.IO.Unsafe (unsafePerformIO) import Control.Concurrent import System.Console.Concurrent import Control.Applicative +import Control.Monad import Prelude import Propellor.Types import Propellor.Types.Exception +import Propellor.Debug import Utility.PartialPrelude import Utility.Monad import Utility.Exception @@ -147,21 +149,20 @@ colorLine intensity color msg = concat <$> sequence processChainOutput :: Handle -> IO Result processChainOutput h = go Nothing where - go lastline = do + go rval = do v <- catchMaybeIO (hGetLine h) + debug ["chain process output", show v] case v of - Nothing -> case lastline of - Nothing -> do - return FailedChange - Just l -> case readish l of - Just r -> pure r - Nothing -> do - outputConcurrent (l ++ "\n") - return FailedChange + Nothing -> case rval of + Nothing -> return FailedChange + Just r -> return r Just s -> do - outputConcurrent $ - maybe "" (\l -> if null l then "" else l ++ "\n") lastline - go (Just s) + case readish s of + Nothing -> do + unless (null s) $ + outputConcurrent (s ++ "\n") + go rval + Just rval' -> go rval' -- | Called when all messages about properties have been printed. messagesDone :: IO () -- cgit v1.2.3