add json formatted list of remotes

Wherever a list of remotes is shown, --json now enables a json formatted
list.
This commit is contained in:
Joey Hess 2011-09-01 16:02:01 -04:00
parent 2f4d4d1c45
commit 5bc32c7f34
3 changed files with 27 additions and 12 deletions

View file

@ -131,7 +131,7 @@ checkKeyNumCopies key file numcopies = do
let present = length safelocations
if present < needed
then do
ppuuids <- Remote.prettyPrintUUIDs untrustedlocations
ppuuids <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations
warning $ missingNote (filename file key) present needed ppuuids
return False
else return True

View file

@ -33,7 +33,7 @@ perform key = do
if null uuids
then stop
else do
pp <- prettyPrintUUIDs uuids
pp <- prettyPrintUUIDs "whereis" uuids
showLongNote pp
showOutput
next $ return True

View file

@ -30,11 +30,14 @@ module Remote (
) where
import Control.Monad (filterM)
import Control.Monad.State (liftIO)
import Data.List
import qualified Data.Map as M
import Data.String.Utils
import Data.Maybe
import Control.Applicative
import Text.JSON
import Text.JSON.Generic
import Types
import Types.Remote
@ -44,6 +47,7 @@ import Config
import Trust
import LocationLog
import Messages
import qualified Utility.JSONStream
import RemoteLog
import qualified Remote.Git
@ -119,23 +123,34 @@ nameToUUID n = do
invertMap = M.fromList . map swap . M.toList
swap (a, b) = (b, a)
{- Pretty-prints a list of UUIDs of remotes. -}
prettyPrintUUIDs :: [UUID] -> Annex String
prettyPrintUUIDs uuids = do
{- Pretty-prints a list of UUIDs of remotes, for human display.
-
- Shows descriptions from the uuid log, falling back to remote names,
- as some remotes may not be in the uuid log.
-
- When JSON is enabled, also generates a machine-readable description
- of the UUIDs. -}
prettyPrintUUIDs :: String -> [UUID] -> Annex String
prettyPrintUUIDs desc uuids = do
here <- getUUID =<< Annex.gitRepo
-- Show descriptions from the uuid log, falling back to remote names,
-- as some remotes may not be in the uuid log
m <- M.union <$> uuidMap <*> availMap
return $ unwords $ map (\u -> "\t" ++ prettify m u here ++ "\n") uuids
liftIO . putStr $ Utility.JSONStream.add
[(desc, map (jsonify m here) uuids)]
return $ unwords $ map (\u -> "\t" ++ prettify m here u ++ "\n") uuids
where
availMap = M.fromList . map (\r -> (uuid r, name r)) <$> genList
prettify m u here = base ++ ishere
findlog m u = M.findWithDefault "" u m
prettify m here u = base ++ ishere
where
base = if not $ null $ findlog m u
then u ++ " -- " ++ findlog m u
else u
ishere = if here == u then " <-- here" else ""
findlog m u = M.findWithDefault "" u m
jsonify m here u = toJSObject
[ ("uuid", toJSON u)
, ("description", toJSON $ findlog m u)
, ("here", toJSON $ here == u)
]
{- Filters a list of remotes to ones that have the listed uuids. -}
remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
@ -186,8 +201,8 @@ showLocations key exclude = do
untrusteduuids <- trustGet UnTrusted
let uuidswanted = filteruuids uuids (u:exclude++untrusteduuids)
let uuidsskipped = filteruuids uuids (u:exclude++uuidswanted)
ppuuidswanted <- Remote.prettyPrintUUIDs uuidswanted
ppuuidsskipped <- Remote.prettyPrintUUIDs uuidsskipped
ppuuidswanted <- Remote.prettyPrintUUIDs "wanted" uuidswanted
ppuuidsskipped <- Remote.prettyPrintUUIDs "skipped" uuidsskipped
showLongNote $ message ppuuidswanted ppuuidsskipped
where
filteruuids l x = filter (`notElem` x) l