summaryrefslogtreecommitdiff
path: root/Messages.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Messages.hs')
-rw-r--r--Messages.hs34
1 files changed, 14 insertions, 20 deletions
diff --git a/Messages.hs b/Messages.hs
index f1055efb8..53f356c1d 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -40,7 +40,7 @@ module Messages (
commandProgressDisabled,
outputMessage,
implicitMessage,
- withOutputType,
+ withMessageState,
) where
import System.Log.Logger
@@ -85,7 +85,7 @@ showSideAction m = Annex.getState Annex.output >>= go
Annex.changeState $ \s -> s { Annex.output = st' }
| sideActionBlock st == InBlock = return ()
| otherwise = p
- p = outputMessage q $ "(" ++ m ++ "...)\n"
+ p = outputMessage JSON.none $ "(" ++ m ++ "...)\n"
showStoringStateAction :: Annex ()
showStoringStateAction = showSideAction "recording state in git"
@@ -110,7 +110,7 @@ doSideAction' b a = do
{- Make way for subsequent output of a command. -}
showOutput :: Annex ()
showOutput = unlessM commandProgressDisabled $
- outputMessage q "\n"
+ outputMessage JSON.none "\n"
showLongNote :: String -> Annex ()
showLongNote s = outputMessage (JSON.note s) ('\n' : indent s ++ "\n")
@@ -122,7 +122,7 @@ showEndFail :: Annex ()
showEndFail = showEndResult False
showEndResult :: Bool -> Annex ()
-showEndResult ok = outputMessage (JSON.end ok) $ endResult ok ++ "\n"
+showEndResult ok = outputMessageFinal (JSON.end ok) $ endResult ok ++ "\n"
endResult :: Bool -> String
endResult True = "ok"
@@ -140,7 +140,7 @@ earlyWarning = warning' False
warning' :: Bool -> String -> Annex ()
warning' makeway w = do
when makeway $
- outputMessage q "\n"
+ outputMessage JSON.none "\n"
outputError (w ++ "\n")
{- Not concurrent output safe. -}
@@ -155,17 +155,11 @@ indent = intercalate "\n" . map (\l -> " " ++ l) . lines
{- Shows a JSON chunk only when in json mode. -}
maybeShowJSON :: JSONChunk v -> Annex ()
-maybeShowJSON v = withOutputType $ liftIO . go
- where
- go JSONOutput = JSON.add v
- go _ = return ()
+maybeShowJSON v = void $ withMessageState $ outputJSON (JSON.add v) False
{- Shows a complete JSON value, only when in json mode. -}
showFullJSON :: JSONChunk v -> Annex Bool
-showFullJSON v = withOutputType $ liftIO . go
- where
- go JSONOutput = JSON.complete v >> return True
- go _ = return False
+showFullJSON v = withMessageState $ outputJSON (JSON.complete v) True
{- Performs an action that outputs nonstandard/customized output, and
- in JSON mode wraps its output in JSON.start and JSON.end, so it's
@@ -179,10 +173,10 @@ showCustom command a = do
outputMessage (JSON.end r) ""
showHeader :: String -> Annex ()
-showHeader h = outputMessage q $ (h ++ ": ")
+showHeader h = outputMessage JSON.none $ (h ++ ": ")
showRaw :: String -> Annex ()
-showRaw s = outputMessage q (s ++ "\n")
+showRaw s = outputMessage JSON.none (s ++ "\n")
setupConsole :: IO ()
setupConsole = do
@@ -216,11 +210,11 @@ debugEnabled = do
{- Should commands that normally output progress messages have that
- output disabled? -}
commandProgressDisabled :: Annex Bool
-commandProgressDisabled = withOutputType $ \t -> return $ case t of
- QuietOutput -> True
- JSONOutput -> True
- NormalOutput -> False
- ConcurrentOutput {} -> True
+commandProgressDisabled = withMessageState $ \s -> return $
+ case outputType s of
+ QuietOutput -> True
+ JSONOutput _ -> True
+ NormalOutput -> concurrentOutputEnabled s
{- Use to show a message that is displayed implicitly, and so might be
- disabled when running a certian command that needs more control over its