summaryrefslogtreecommitdiff
path: root/Messages.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-11-20 14:12:48 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-11-20 14:12:48 -0400
commitd675f1c82e7a3c7aa3f0b3f67284433cce111781 (patch)
tree285754ab5188172ba77f58b9a934885eca4fb41d /Messages.hs
parent128b4bd01509bcdcdd6120a29d24527cff82d3ab (diff)
status --json now shows most things
Left out the backend usage graph for now, and bad/temp directory sizes are only displayed when present. Also, disk usage is returned as a string with units, which I can see changing later.
Diffstat (limited to 'Messages.hs')
-rw-r--r--Messages.hs24
1 files changed, 11 insertions, 13 deletions
diff --git a/Messages.hs b/Messages.hs
index 57b706804..6ea347ca4 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -68,17 +68,17 @@ showEndFail :: Annex ()
showEndFail = showEndResult False
showEndResult :: Bool -> Annex ()
-showEndResult b = handle (JSON.end b) $ putStrLn msg
+showEndResult ok = handle (JSON.end ok) $ putStrLn msg
where
msg
- | b = "ok"
+ | ok = "ok"
| otherwise = "failed"
showErr :: (Show a) => a -> Annex ()
showErr e = warning' $ "git-annex: " ++ show e
warning :: String -> Annex ()
-warning w = warning' (indent w)
+warning = warning' . indent
warning' :: String -> Annex ()
warning' w = do
@@ -88,7 +88,7 @@ warning' w = do
hPutStrLn stderr w
indent :: String -> String
-indent s = join "\n" $ map (\l -> " " ++ l) $ lines s
+indent = join "\n" . map (\l -> " " ++ l) . lines
{- Shows a JSON value only when in json mode. -}
maybeShowJSON :: JSON a => [(String, a)] -> Annex ()
@@ -105,9 +105,8 @@ showCustom command a = do
handle (JSON.end r) q
showHeader :: String -> Annex ()
-showHeader h = handle q $ do
- putStr $ h ++ ": "
- hFlush stdout
+showHeader h = handle q $
+ flushed $ putStr $ h ++ ": "
showRaw :: String -> Annex ()
showRaw s = handle q $ putStrLn s
@@ -126,12 +125,11 @@ setupConsole = do
hSetBinaryMode stderr True
handle :: IO () -> IO () -> Annex ()
-handle json normal = do
- output <- Annex.getState Annex.output
- case output of
- Annex.NormalOutput -> liftIO normal
- Annex.QuietOutput -> q
- Annex.JSONOutput -> liftIO json
+handle json normal = Annex.getState Annex.output >>= go
+ where
+ go Annex.NormalOutput = liftIO normal
+ go Annex.QuietOutput = q
+ go Annex.JSONOutput = liftIO json
q :: Monad m => m ()
q = return ()