summaryrefslogtreecommitdiff
path: root/src/Propellor/Message.hs
diff options
context:
space:
mode:
authorJoey Hess2017-07-05 13:52:29 -0400
committerJoey Hess2017-07-05 13:52:29 -0400
commit2b9d5ca90f053ad21fbbab89b3045bd0822400d5 (patch)
tree10111d133a30984a080858227fcb8db7a2dceef7 /src/Propellor/Message.hs
parent4eb2a663e4d4ff00d121c5f595f2eb7248b98199 (diff)
avoid buffering container chain output
When provisioning a container, output was buffered until the whole process was done; now output will be displayed immediately. I know this didn't used to be a problem. I belive it was introduced by accident when propellor started using concurrent-output. I know I've seen it for a while and never was bothered enough to get to the bottom of it; apparently "a while" was longer than I thought. Also refactored code to do with chain provisioning to all be in Propellor.Engine and avoided some duplication. This commit was sponsored by Anthony DeRobertis on Patreon.
Diffstat (limited to 'src/Propellor/Message.hs')
-rw-r--r--src/Propellor/Message.hs23
1 files changed, 0 insertions, 23 deletions
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index c56f0c5a..7715088f 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -14,7 +14,6 @@ module Propellor.Message (
infoMessage,
errorMessage,
stopPropellorMessage,
- processChainOutput,
messagesDone,
createProcessConcurrent,
withConcurrentOutput,
@@ -31,7 +30,6 @@ import Prelude
import Propellor.Types
import Propellor.Types.Exception
-import Utility.PartialPrelude
import Utility.Monad
import Utility.Exception
@@ -142,27 +140,6 @@ colorLine intensity color msg = concat <$> sequence
, pure "\n"
]
--- | Reads and displays each line from the Handle, except for the last line
--- which is a Result.
-processChainOutput :: Handle -> IO Result
-processChainOutput h = go Nothing
- where
- go lastline = do
- v <- catchMaybeIO (hGetLine h)
- 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
- Just s -> do
- outputConcurrent $
- maybe "" (\l -> if null l then "" else l ++ "\n") lastline
- go (Just s)
-
-- | Called when all messages about properties have been printed.
messagesDone :: IO ()
messagesDone = outputConcurrent