diff options
Diffstat (limited to 'Messages/Internal.hs')
| -rw-r--r-- | Messages/Internal.hs | 27 |
1 files changed, 14 insertions, 13 deletions
diff --git a/Messages/Internal.hs b/Messages/Internal.hs index 9b9edccc5..5c5b19bd1 100644 --- a/Messages/Internal.hs +++ b/Messages/Internal.hs @@ -12,25 +12,26 @@ import Annex import Types.Messages import Messages.Concurrent -withOutputType :: (OutputType -> Annex a) -> Annex a -withOutputType a = outputType <$> Annex.getState Annex.output >>= a +withMessageState :: (MessageState -> Annex a) -> Annex a +withMessageState a = Annex.getState Annex.output >>= a outputMessage :: IO () -> String -> Annex () -outputMessage json s = withOutputType go - where - go NormalOutput = liftIO $ - flushed $ putStr s - go QuietOutput = q - go o@(ConcurrentOutput {}) = concurrentMessage o False s q - go JSONOutput = liftIO $ flushed json +outputMessage json msg = withMessageState $ \s -> case outputType s of + NormalOutput + | concurrentOutputEnabled s -> concurrentMessage s False msg q + | otherwise -> liftIO $ flushed $ putStr msg + QuietOutput -> q + JSONOutput -> liftIO $ flushed json outputError :: String -> Annex () -outputError s = withOutputType go +outputError msg = withMessageState $ \s -> + if concurrentOutputEnabled s + then concurrentMessage s True msg go + else go where - go o@(ConcurrentOutput {}) = concurrentMessage o True s (go NormalOutput) - go _ = liftIO $ do + go = liftIO $ do hFlush stdout - hPutStr stderr s + hPutStr stderr msg hFlush stderr q :: Monad m => m () |