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:
parent
4a773f2608
commit
c608df5802
3 changed files with 39 additions and 24 deletions
|
@ -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
3
debian/changelog
vendored
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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`
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue