summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-02-04 01:56:45 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-02-04 01:56:45 -0400
commitef2d4f650edff99b67554be9288face87159131e (patch)
tree1a491c065b660496db64bf853d6dc4787eef14a6 /Command
parent30869187f0890f9e742b4a5dbb4579b0fca6f7e4 (diff)
fix absrepo data loss
it was dropping the config map for the repos it changed
Diffstat (limited to 'Command')
-rw-r--r--Command/Map.hs30
1 files changed, 14 insertions, 16 deletions
diff --git a/Command/Map.hs b/Command/Map.hs
index 83207d551..d8dd0e94c 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -107,7 +107,7 @@ node umap fullinfo r = unlines $ n:edges
{- 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 umap fullinfo from to =
- Dot.graphEdge (nodeId from) (nodeId $ makeabs from fullto) edgename
+ Dot.graphEdge (nodeId from) (nodeId $ absRepo from fullto) edgename
where
-- get the full info for the remote, to get its UUID
fullto = findfullinfo to
@@ -140,20 +140,13 @@ spider' (r:rs) known
| any (same r) known = spider' rs known
| otherwise = do
r' <- scan r
- let remotes = map (makeabs r') (Git.remotes r')
+ let remotes = map (absRepo r') (Git.remotes r')
spider' (rs ++ remotes) (r':known)
-{- Makes a remote have an absolute url, rather than a host-local path. -}
-makeabs :: Git.Repo -> Git.Repo -> Git.Repo
-makeabs repo remote
- | Git.repoIsUrl remote = remote
- | not $ Git.repoIsUrl repo = remote
- | otherwise = Git.repoFromUrl combinedurl
- where
- combinedurl =
- Git.urlScheme repo ++ "//" ++
- Git.urlHostFull repo ++
- Git.workTree remote
+absRepo :: Git.Repo -> Git.Repo -> Git.Repo
+absRepo reference r
+ | Git.repoIsUrl reference = Git.localToUrl reference r
+ | otherwise = r
{- Checks if two repos are the same. -}
same :: Git.Repo -> Git.Repo -> Bool
@@ -217,9 +210,14 @@ tryScan r
-- Secondly, configlist doesn't include information about
-- the remote's remotes.
sshscan = do
- showNote "sshing..."
- showProgress
+ sshnote
v <- manualconfiglist
case v of
- Nothing -> configlist
+ Nothing -> do
+ sshnote
+ configlist
ok -> return ok
+
+ sshnote = do
+ showNote "sshing..."
+ showProgress