fix absrepo data loss
it was dropping the config map for the repos it changed
This commit is contained in:
parent
30869187f0
commit
ef2d4f650e
2 changed files with 29 additions and 17 deletions
|
@ -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
|
||||||
|
|
16
GitRepo.hs
16
GitRepo.hs
|
@ -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"
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue