concurrent-output, first pass

Output without -Jn should be unchanged from before. With -Jn,
concurrent-output is used for messages, but regions are not used yet, so
it's a mess.
This commit is contained in:
Joey Hess 2015-11-04 13:45:34 -04:00
parent 30e39592b4
commit 4fd03ccd7b
Failed to extract signature
12 changed files with 125 additions and 61 deletions

View file

@ -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