split more stuff out of Git.hs
This commit is contained in:
parent
2b24e16a63
commit
02f1bd2bf4
20 changed files with 197 additions and 179 deletions
|
@ -13,6 +13,7 @@ import qualified Data.Map as M
|
|||
import Common.Annex
|
||||
import Command
|
||||
import qualified Git
|
||||
import qualified Git.Url
|
||||
import qualified Git.Config
|
||||
import qualified Git.Construct
|
||||
import Annex.UUID
|
||||
|
@ -68,7 +69,7 @@ drawMap rs umap ts = Dot.graph $ repos ++ trusted ++ others
|
|||
|
||||
hostname :: Git.Repo -> String
|
||||
hostname r
|
||||
| Git.repoIsUrl r = Git.urlHost r
|
||||
| Git.repoIsUrl r = Git.Url.host r
|
||||
| otherwise = "localhost"
|
||||
|
||||
basehostname :: Git.Repo -> String
|
||||
|
@ -82,7 +83,7 @@ repoName umap r
|
|||
| otherwise = M.findWithDefault fallback repouuid umap
|
||||
where
|
||||
repouuid = getUncachedUUID r
|
||||
fallback = fromMaybe "unknown" $ Git.repoRemoteName r
|
||||
fallback = fromMaybe "unknown" $ Git.remoteName r
|
||||
|
||||
{- A unique id for the node for a repo. Uses the annex.uuid if available. -}
|
||||
nodeId :: Git.Repo -> String
|
||||
|
@ -99,7 +100,7 @@ node umap fullinfo r = unlines $ n:edges
|
|||
decorate $ Dot.graphNode (nodeId r) (repoName umap r)
|
||||
edges = map (edge umap fullinfo r) (Git.remotes r)
|
||||
decorate
|
||||
| Git.configMap r == M.empty = unreachable
|
||||
| Git.config r == M.empty = unreachable
|
||||
| otherwise = reachable
|
||||
|
||||
{- An edge between two repos. The second repo is a remote of the first. -}
|
||||
|
@ -116,7 +117,7 @@ edge umap fullinfo from to =
|
|||
{- Only name an edge if the name is different than the name
|
||||
- that will be used for the destination node, and is
|
||||
- different from its hostname. (This reduces visual clutter.) -}
|
||||
edgename = maybe Nothing calcname $ Git.repoRemoteName to
|
||||
edgename = maybe Nothing calcname $ Git.remoteName to
|
||||
calcname n
|
||||
| n `elem` [repoName umap fullto, hostname fullto] = Nothing
|
||||
| otherwise = Just n
|
||||
|
@ -141,7 +142,7 @@ spider' (r:rs) known
|
|||
-- The remotes will be relative to r', and need to be
|
||||
-- made absolute for later use.
|
||||
remotes <- mapM (absRepo r') (Git.remotes r')
|
||||
let r'' = Git.remotesAdd r' remotes
|
||||
let r'' = r' { Git.remotes = remotes }
|
||||
|
||||
spider' (rs ++ remotes) (r'':known)
|
||||
|
||||
|
@ -154,7 +155,7 @@ absRepo reference r
|
|||
{- Checks if two repos are the same. -}
|
||||
same :: Git.Repo -> Git.Repo -> Bool
|
||||
same a b
|
||||
| both Git.repoIsSsh = matching Git.urlAuthority && matching Git.workTree
|
||||
| both Git.repoIsSsh = matching Git.Url.authority && matching Git.workTree
|
||||
| both Git.repoIsUrl && neither Git.repoIsSsh = matching show
|
||||
| neither Git.repoIsSsh = matching Git.workTree
|
||||
| otherwise = False
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue