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.

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