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:
parent
2f4d4d1c45
commit
5bc32c7f34
3 changed files with 27 additions and 12 deletions
|
@ -131,7 +131,7 @@ checkKeyNumCopies key file numcopies = do
|
||||||
let present = length safelocations
|
let present = length safelocations
|
||||||
if present < needed
|
if present < needed
|
||||||
then do
|
then do
|
||||||
ppuuids <- Remote.prettyPrintUUIDs untrustedlocations
|
ppuuids <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations
|
||||||
warning $ missingNote (filename file key) present needed ppuuids
|
warning $ missingNote (filename file key) present needed ppuuids
|
||||||
return False
|
return False
|
||||||
else return True
|
else return True
|
||||||
|
|
|
@ -33,7 +33,7 @@ perform key = do
|
||||||
if null uuids
|
if null uuids
|
||||||
then stop
|
then stop
|
||||||
else do
|
else do
|
||||||
pp <- prettyPrintUUIDs uuids
|
pp <- prettyPrintUUIDs "whereis" uuids
|
||||||
showLongNote pp
|
showLongNote pp
|
||||||
showOutput
|
showOutput
|
||||||
next $ return True
|
next $ return True
|
||||||
|
|
35
Remote.hs
35
Remote.hs
|
@ -30,11 +30,14 @@ module Remote (
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (filterM)
|
import Control.Monad (filterM)
|
||||||
|
import Control.Monad.State (liftIO)
|
||||||
import Data.List
|
import Data.List
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.String.Utils
|
import Data.String.Utils
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
import Text.JSON
|
||||||
|
import Text.JSON.Generic
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
|
@ -44,6 +47,7 @@ import Config
|
||||||
import Trust
|
import Trust
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Messages
|
import Messages
|
||||||
|
import qualified Utility.JSONStream
|
||||||
import RemoteLog
|
import RemoteLog
|
||||||
|
|
||||||
import qualified Remote.Git
|
import qualified Remote.Git
|
||||||
|
@ -119,23 +123,34 @@ nameToUUID n = do
|
||||||
invertMap = M.fromList . map swap . M.toList
|
invertMap = M.fromList . map swap . M.toList
|
||||||
swap (a, b) = (b, a)
|
swap (a, b) = (b, a)
|
||||||
|
|
||||||
{- Pretty-prints a list of UUIDs of remotes. -}
|
{- Pretty-prints a list of UUIDs of remotes, for human display.
|
||||||
prettyPrintUUIDs :: [UUID] -> Annex String
|
-
|
||||||
prettyPrintUUIDs uuids = do
|
- 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
|
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
|
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
|
where
|
||||||
availMap = M.fromList . map (\r -> (uuid r, name r)) <$> genList
|
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
|
where
|
||||||
base = if not $ null $ findlog m u
|
base = if not $ null $ findlog m u
|
||||||
then u ++ " -- " ++ findlog m u
|
then u ++ " -- " ++ findlog m u
|
||||||
else u
|
else u
|
||||||
ishere = if here == u then " <-- here" else ""
|
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. -}
|
{- Filters a list of remotes to ones that have the listed uuids. -}
|
||||||
remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
|
remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
|
||||||
|
@ -186,8 +201,8 @@ showLocations key exclude = do
|
||||||
untrusteduuids <- trustGet UnTrusted
|
untrusteduuids <- trustGet UnTrusted
|
||||||
let uuidswanted = filteruuids uuids (u:exclude++untrusteduuids)
|
let uuidswanted = filteruuids uuids (u:exclude++untrusteduuids)
|
||||||
let uuidsskipped = filteruuids uuids (u:exclude++uuidswanted)
|
let uuidsskipped = filteruuids uuids (u:exclude++uuidswanted)
|
||||||
ppuuidswanted <- Remote.prettyPrintUUIDs uuidswanted
|
ppuuidswanted <- Remote.prettyPrintUUIDs "wanted" uuidswanted
|
||||||
ppuuidsskipped <- Remote.prettyPrintUUIDs uuidsskipped
|
ppuuidsskipped <- Remote.prettyPrintUUIDs "skipped" uuidsskipped
|
||||||
showLongNote $ message ppuuidswanted ppuuidsskipped
|
showLongNote $ message ppuuidswanted ppuuidsskipped
|
||||||
where
|
where
|
||||||
filteruuids l x = filter (`notElem` x) l
|
filteruuids l x = filter (`notElem` x) l
|
||||||
|
|
Loading…
Reference in a new issue