summaryrefslogtreecommitdiff
path: root/src/Propellor/Message.hs
diff options
context:
space:
mode:
authorJoey Hess2017-07-05 13:10:59 -0400
committerJoey Hess2017-07-05 13:10:59 -0400
commitc59ce983999ddbfe6cb8b27e4f376b5c37d7f853 (patch)
tree0654ca04c6bb4c5a1a21ee0dfe0097f8860f2f24 /src/Propellor/Message.hs
parent211d87cdfae4a3077074ef954ef0524f640aae78 (diff)
speed up chain output displaying
Avoid needing to wait for a subsequent line before displaying the previous line.
Diffstat (limited to 'src/Propellor/Message.hs')
-rw-r--r--src/Propellor/Message.hs25
1 files changed, 13 insertions, 12 deletions
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 ()