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.
This commit is contained in:
Joey Hess 2011-11-20 14:12:48 -04:00
parent 128b4bd015
commit d675f1c82e
3 changed files with 40 additions and 32 deletions

View file

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