map: Hide dead repositories that are not connected to the graph.

* map: Hide dead repositories that are not connected to the graph.
* map: Changed colors; red is used for untrusted repositories and grey
  for dead.
This commit is contained in:
Joey Hess 2016-05-04 14:12:41 -04:00
parent 4a773f2608
commit c608df5802
Failed to extract signature
3 changed files with 39 additions and 24 deletions

View file

@ -19,6 +19,7 @@ import qualified Annex
import Annex.UUID import Annex.UUID
import Logs.UUID import Logs.UUID
import Logs.Trust import Logs.Trust
import Types.TrustLevel
import qualified Remote.Helper.Ssh as Ssh import qualified Remote.Helper.Ssh as Ssh
import qualified Utility.Dot as Dot import qualified Utility.Dot as Dot
@ -39,11 +40,11 @@ start = do
rs <- combineSame <$> (spider =<< gitRepo) rs <- combineSame <$> (spider =<< gitRepo)
umap <- uuidMap umap <- uuidMap
trusted <- trustGet Trusted trustmap <- trustMapLoad
file <- (</>) <$> fromRepo gitAnnexDir <*> pure "map.dot" file <- (</>) <$> fromRepo gitAnnexDir <*> pure "map.dot"
liftIO $ writeFile file (drawMap rs umap trusted) liftIO $ writeFile file (drawMap rs trustmap umap)
next $ next $ next $ next $
ifM (Annex.getState Annex.fast) ifM (Annex.getState Annex.fast)
( do ( do
@ -55,24 +56,26 @@ start = do
liftIO $ boolSystem "dot" [Param "-Tx11", File file] liftIO $ boolSystem "dot" [Param "-Tx11", File file]
) )
{- Generates a graph for dot(1). Each repository, and any other uuids, are {- Generates a graph for dot(1). Each repository, and any other uuids
- displayed as a node, and each of its remotes is represented as an edge - (except for dead ones), are displayed as a node, and each of its
- pointing at the node for the remote. - remotes is represented as an edge pointing at the node for the remote.
- -
- The order nodes are added to the graph matters, since dot will draw - The order nodes are added to the graph matters, since dot will draw
- the first ones near to the top and left. So it looks better to put - the first ones near to the top and left. So it looks better to put
- the repositories first, followed by uuids that were not matched - the repositories first, followed by uuids that were not matched
- to a repository. - to a repository.
-} -}
drawMap :: [Git.Repo] -> M.Map UUID String -> [UUID] -> String drawMap :: [Git.Repo] -> TrustMap -> M.Map UUID String -> String
drawMap rs umap ts = Dot.graph $ repos ++ trusted ++ others drawMap rs trustmap umap = Dot.graph $ repos ++ others
where where
repos = map (node umap rs) rs repos = map (node umap rs trustmap) rs
ruuids = ts ++ map getUncachedUUID rs ruuids = map getUncachedUUID rs
others = map (unreachable . uuidnode) $ others = map uuidnode $
filter (\u -> M.lookup u trustmap /= Just DeadTrusted) $
filter (`notElem` ruuids) (M.keys umap) filter (`notElem` ruuids) (M.keys umap)
trusted = map (trustworthy . uuidnode) ts uuidnode u = trustDecorate trustmap u $
uuidnode u = Dot.graphNode (fromUUID u) $ M.findWithDefault "" u umap Dot.graphNode (fromUUID u) $ M.findWithDefault "" u umap
ts = M.keys (M.filter (== Trusted) trustmap)
hostname :: Git.Repo -> String hostname :: Git.Repo -> String
hostname r hostname r
@ -100,15 +103,13 @@ nodeId r =
UUID u -> u UUID u -> u
{- A node representing a repo. -} {- A node representing a repo. -}
node :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> String node :: M.Map UUID String -> [Git.Repo] -> TrustMap -> Git.Repo -> String
node umap fullinfo r = unlines $ n:edges node umap fullinfo trustmap r = unlines $ n:edges
where where
n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $ n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $
decorate $ Dot.graphNode (nodeId r) (repoName umap r) trustDecorate trustmap (getUncachedUUID r) $
Dot.graphNode (nodeId r) (repoName umap r)
edges = map (edge umap fullinfo r) (Git.remotes r) edges = map (edge umap fullinfo r) (Git.remotes r)
decorate
| Git.config r == M.empty = unreachable
| otherwise = reachable
{- An edge between two repos. The second repo is a remote of the first. -} {- An edge between two repos. The second repo is a remote of the first. -}
edge :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> Git.Repo -> String edge :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> Git.Repo -> String
@ -129,12 +130,13 @@ edge umap fullinfo from to =
| n `elem` [repoName umap fullto, hostname fullto] = Nothing | n `elem` [repoName umap fullto, hostname fullto] = Nothing
| otherwise = Just n | otherwise = Just n
unreachable :: String -> String trustDecorate :: TrustMap -> UUID -> String -> String
unreachable = Dot.fillColor "red" trustDecorate trustmap u s = case M.lookup u trustmap of
reachable :: String -> String Just Trusted -> Dot.fillColor "green" s
reachable = Dot.fillColor "white" Just UnTrusted -> Dot.fillColor "red" s
trustworthy :: String -> String Just SemiTrusted -> Dot.fillColor "white" s
trustworthy = Dot.fillColor "green" Just DeadTrusted -> Dot.fillColor "grey" s
Nothing -> Dot.fillColor "white" s
{- Recursively searches out remotes starting with the specified repo. -} {- Recursively searches out remotes starting with the specified repo. -}
spider :: Git.Repo -> Annex [Git.Repo] spider :: Git.Repo -> Annex [Git.Repo]

3
debian/changelog vendored
View file

@ -12,6 +12,9 @@ git-annex (6.20160420) UNRELEASED; urgency=medium
* git-annex.cabal: Add Setup-Depends. * git-annex.cabal: Add Setup-Depends.
* Windows: Fix several bugs in propigation of changes from the adjusted * Windows: Fix several bugs in propigation of changes from the adjusted
branch back to the master branch. branch back to the master branch.
* map: Hide dead repositories that are not connected to the graph.
* map: Changed colors; red is used for untrusted repositories and grey
for dead.
-- Joey Hess <id@joeyh.name> Thu, 28 Apr 2016 13:17:04 -0400 -- Joey Hess <id@joeyh.name> Thu, 28 Apr 2016 13:17:04 -0400

View file

@ -23,6 +23,16 @@ it several times as the map is being built.
Note that this subcommand can be used to graph any git repository; it Note that this subcommand can be used to graph any git repository; it
is not limited to git-annex repositories. is not limited to git-annex repositories.
# MAP KEY
Ovals are repositories. White is regular, green is trusted, red is
untrusted, and grey is dead.
Arrows between repositories are connections via git remotes.
Light blue boxes are hosts that were mapped, and contain the repositories
on that host.
# OPTIONS # OPTIONS
* `--fast` * `--fast`