fix absrepo data loss

it was dropping the config map for the repos it changed
This commit is contained in:
Joey Hess 2011-02-04 01:56:45 -04:00
parent 30869187f0
commit ef2d4f650e
2 changed files with 29 additions and 17 deletions

View file

@ -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. -} {- 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
edge umap fullinfo from to = edge umap fullinfo from to =
Dot.graphEdge (nodeId from) (nodeId $ makeabs from fullto) edgename Dot.graphEdge (nodeId from) (nodeId $ absRepo from fullto) edgename
where where
-- get the full info for the remote, to get its UUID -- get the full info for the remote, to get its UUID
fullto = findfullinfo to fullto = findfullinfo to
@ -140,20 +140,13 @@ spider' (r:rs) known
| any (same r) known = spider' rs known | any (same r) known = spider' rs known
| otherwise = do | otherwise = do
r' <- scan r r' <- scan r
let remotes = map (makeabs r') (Git.remotes r') let remotes = map (absRepo r') (Git.remotes r')
spider' (rs ++ remotes) (r':known) spider' (rs ++ remotes) (r':known)
{- Makes a remote have an absolute url, rather than a host-local path. -} absRepo :: Git.Repo -> Git.Repo -> Git.Repo
makeabs :: Git.Repo -> Git.Repo -> Git.Repo absRepo reference r
makeabs repo remote | Git.repoIsUrl reference = Git.localToUrl reference r
| Git.repoIsUrl remote = remote | otherwise = r
| not $ Git.repoIsUrl repo = remote
| otherwise = Git.repoFromUrl combinedurl
where
combinedurl =
Git.urlScheme repo ++ "//" ++
Git.urlHostFull repo ++
Git.workTree remote
{- Checks if two repos are the same. -} {- Checks if two repos are the same. -}
same :: Git.Repo -> Git.Repo -> Bool same :: Git.Repo -> Git.Repo -> Bool
@ -217,9 +210,14 @@ tryScan r
-- Secondly, configlist doesn't include information about -- Secondly, configlist doesn't include information about
-- the remote's remotes. -- the remote's remotes.
sshscan = do sshscan = do
showNote "sshing..." sshnote
showProgress
v <- manualconfiglist v <- manualconfiglist
case v of case v of
Nothing -> configlist Nothing -> do
sshnote
configlist
ok -> return ok ok -> return ok
sshnote = do
showNote "sshing..."
showProgress

View file

@ -13,6 +13,7 @@ module GitRepo (
repoFromCwd, repoFromCwd,
repoFromPath, repoFromPath,
repoFromUrl, repoFromUrl,
localToUrl,
repoIsUrl, repoIsUrl,
repoIsSsh, repoIsSsh,
repoDescribe, repoDescribe,
@ -109,6 +110,19 @@ repoFromUrl url
Just v -> v Just v -> v
Nothing -> error $ "bad url " ++ url Nothing -> error $ "bad url " ++ url
{- Converts a Local Repo into a remote repo, using the reference repo
- which is assumed to be on the same host. -}
localToUrl :: Repo -> Repo -> Repo
localToUrl reference r
| not $ repoIsUrl reference = error "internal error; reference repo not url"
| repoIsUrl r = r
| otherwise = r { location = Url $ fromJust $ parseURI absurl }
where
absurl =
urlScheme reference ++ "//" ++
urlHostFull reference ++
workTree r
{- User-visible description of a git repo. -} {- User-visible description of a git repo. -}
repoDescribe :: Repo -> String repoDescribe :: Repo -> String
repoDescribe Repo { remoteName = Just name } = name repoDescribe Repo { remoteName = Just name } = name
@ -338,7 +352,7 @@ configStore :: Repo -> String -> Repo
configStore repo s = r { remotes = configRemotes r } configStore repo s = r { remotes = configRemotes r }
where r = repo { config = configParse s } where r = repo { config = configParse s }
{- Checks if a string fron git config is a true value. -} {- Checks if a string from git config is a true value. -}
configTrue :: String -> Bool configTrue :: String -> Bool
configTrue s = map toLower s == "true" configTrue s = map toLower s == "true"