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.

3 files changed, 40 insertions, 32 deletions

diff --git a/Command/Status.hs b/Command/Status.hs
index 7448615cd..a47f21b91 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -11,6 +11,7 @@ import Control.Monad.State
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Set (Set)
+import Text.JSON
 
 import Common.Annex
 import qualified Types.Backend as B
@@ -78,12 +79,21 @@ start = do
 		return True
 	stop
 
-stat :: String -> StatState String -> Stat
-stat desc a = return $ Just (desc, a)
+stat :: String -> (String -> StatState String) -> Stat
+stat desc a = return $ Just (desc, a desc)
 
 nostat :: Stat
 nostat = return Nothing
 
+json :: JSON j => (j -> String) -> StatState j -> String -> StatState String
+json serialize a desc = do
+	j <- a
+	lift $ maybeShowJSON [(desc, j)]
+	return $ serialize j
+
+nojson :: StatState String -> String -> StatState String
+nojson a _ = a
+
 showStat :: Stat -> StatState ()
 showStat s = calc =<< s
 	where
@@ -93,15 +103,15 @@ showStat s = calc =<< s
 		calc Nothing = return ()
 
 supported_backends :: Stat
-supported_backends = stat "supported backends" $ 
-	return $ unwords $ map B.name Backend.list
+supported_backends = stat "supported backends" $ json unwords $
+	return $ map B.name Backend.list
 
 supported_remote_types :: Stat
-supported_remote_types = stat "supported remote types" $
-	return $ unwords $ map R.typename Remote.remoteTypes
+supported_remote_types = stat "supported remote types" $ json unwords $
+	return $ map R.typename Remote.remoteTypes
 
 remote_list :: TrustLevel -> String -> Stat
-remote_list level desc = stat n $ lift $ do
+remote_list level desc = stat n $ nojson $ lift $ do
 	us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap)
 	rs <- fst <$> trustPartition level us
 	s <- prettyPrintUUIDs n rs
@@ -110,20 +120,20 @@ remote_list level desc = stat n $ lift $ do
 		n = desc ++ " repositories"
 
 local_annex_size :: Stat
-local_annex_size = stat "local annex size" $
+local_annex_size = stat "local annex size" $ json id $
 	keySizeSum <$> cachedKeysPresent
 
 local_annex_keys :: Stat
-local_annex_keys = stat "local annex keys" $
-	show . S.size <$> cachedKeysPresent
+local_annex_keys = stat "local annex keys" $ json show $
+	S.size <$> cachedKeysPresent
 
 visible_annex_size :: Stat
-visible_annex_size = stat "visible annex size" $
+visible_annex_size = stat "visible annex size" $ json id $
 	keySizeSum <$> cachedKeysReferenced
 
 visible_annex_keys :: Stat
-visible_annex_keys = stat "visible annex keys" $
-	show . S.size <$> cachedKeysReferenced
+visible_annex_keys = stat "visible annex keys" $ json show $
+	S.size <$> cachedKeysReferenced
 
 tmp_size :: Stat
 tmp_size = staleSize "temporary directory size" gitAnnexTmpDir
@@ -132,7 +142,8 @@ bad_data_size :: Stat
 bad_data_size = staleSize "bad keys size" gitAnnexBadDir
 
 backend_usage :: Stat
-backend_usage = stat "backend usage" $ usage <$> cachedKeysReferenced <*> cachedKeysPresent
+backend_usage = stat "backend usage" $ nojson $
+	usage <$> cachedKeysReferenced <*> cachedKeysPresent
 	where
 		usage a b = pp "" $ reverse . sort $ map swap $ splits $ S.toList $ S.union a b
 		splits :: [Key] -> [(String, Integer)]
@@ -179,9 +190,9 @@ staleSize label dirspec = do
 	keys <- lift (Command.Unused.staleKeys dirspec)
 	if null keys
 		then nostat
-		else stat label $ do
-			let s = keySizeSum $ S.fromList keys
-			return $ s ++ aside "clean up with git-annex unused"
+		else do
+			stat label $ json (++ aside "clean up with git-annex unused") $
+				return $ keySizeSum $ S.fromList keys
 
 aside :: String -> String
 aside s = " (" ++ s ++ ")"
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 ()
diff --git a/debian/changelog b/debian/changelog
index 12bbba11d..9f96a4fff 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -11,8 +11,7 @@ git-annex (3.20111112) UNRELEASED; urgency=low
   * status: Now displays trusted, untrusted, and semitrusted repositories
     separately.
   * status: Include all special remotes in the list of repositories.
-  * status: Fix --json mode (only the repository lists are currently
-    displayed)
+  * status: Fix --json mode.
   * status: --fast is back
   * Fix support for insteadOf url remapping. Closes: #644278
   * When not run in a git repository, git-annex can still display a usage