diff options
Diffstat (limited to 'Messages/Internal.hs')
| -rw-r--r-- | Messages/Internal.hs | 34 |
1 files changed, 30 insertions, 4 deletions
diff --git a/Messages/Internal.hs b/Messages/Internal.hs index 2495f4fd3..1501c072a 100644 --- a/Messages/Internal.hs +++ b/Messages/Internal.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Messages.Internal where import Common @@ -12,14 +14,38 @@ import Types import Types.Messages import qualified Annex -handleMessage :: IO () -> IO () -> Annex () -handleMessage json normal = withOutputType go +#ifdef WITH_CONCURRENTOUTPUT +import System.Console.Concurrent +#endif + +outputMessage :: IO () -> String -> Annex () +outputMessage json s = withOutputType go where - go NormalOutput = liftIO normal + go NormalOutput = liftIO $ + flushed $ putStr s go QuietOutput = q - go (ParallelOutput _) = q + go (ConcurrentOutput _) = liftIO $ +#ifdef WITH_CONCURRENTOUTPUT + outputConcurrent s +#else + q +#endif go JSONOutput = liftIO $ flushed json +outputError :: String -> Annex () +outputError s = withOutputType go + where + go (ConcurrentOutput _) = liftIO $ +#ifdef WITH_CONCURRENTOUTPUT + errorConcurrent s +#else + q +#endif + go _ = liftIO $ do + hFlush stdout + hPutStr stderr s + hFlush stderr + q :: Monad m => m () q = noop |