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:
parent
30e39592b4
commit
4fd03ccd7b
12 changed files with 125 additions and 61 deletions
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue