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. -}
|
||||
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
|
||||
|
|
16
GitRepo.hs
16
GitRepo.hs
|
@ -13,6 +13,7 @@ module GitRepo (
|
|||
repoFromCwd,
|
||||
repoFromPath,
|
||||
repoFromUrl,
|
||||
localToUrl,
|
||||
repoIsUrl,
|
||||
repoIsSsh,
|
||||
repoDescribe,
|
||||
|
@ -109,6 +110,19 @@ repoFromUrl url
|
|||
Just v -> v
|
||||
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. -}
|
||||
repoDescribe :: Repo -> String
|
||||
repoDescribe Repo { remoteName = Just name } = name
|
||||
|
@ -338,7 +352,7 @@ configStore :: Repo -> String -> Repo
|
|||
configStore repo s = r { remotes = configRemotes r }
|
||||
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 s = map toLower s == "true"
|
||||
|
||||
|
|
Loading…
Reference in a new issue