fix absrepo data loss

it was dropping the config map for the repos it changed

2 files changed, 29 insertions, 17 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
diff --git a/GitRepo.hs b/GitRepo.hs
index 4b252868f..7bb20fc53 100644
--- a/GitRepo.hs
+++ b/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"