diff --git a/Command/Status.hs b/Command/Status.hs index 7448615cdd..a47f21b91a 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 57b7068041..6ea347ca47 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 12bbba11d4..9f96a4fffe 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