Improve startup time for commands that do not operate on remotes

And for tab completion, by not unnessessarily statting paths to remotes,
which used to cause eg, spin-up of removable drives.

Got rid of the remotes member of Git.Repo. This was a bit painful.

Remote.Git modifies the list of remotes as it reads their configs,
so still need a persistent list of remotes. So, put it in as
Annex.gitremotes. It's only populated by getGitRemotes, so commands
like examinekey that don't care about remotes won't do so.

This commit was sponsored by Jake Vosloo on Patreon.
This commit is contained in:
Joey Hess 2018-01-09 15:36:56 -04:00
parent d0fe4d7308
commit 2b66492d6e
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
22 changed files with 148 additions and 70 deletions

View file

@ -36,7 +36,7 @@ seek = withWords start
start :: [String] -> CommandStart
start [] = unknownNameError "Specify the remote to enable."
start (name:rest) = go =<< filter matchingname <$> Annex.fromRepo Git.remotes
start (name:rest) = go =<< filter matchingname <$> Annex.getGitRemotes
where
matchingname r = Git.remoteName r == Just name
go [] = startSpecialRemote name (Logs.Remote.keyValToConfig rest)
@ -104,7 +104,7 @@ unknownNameError prefix = do
else Remote.prettyPrintUUIDsDescs
"known special remotes"
descm (M.keys m)
disabledremotes <- filterM isdisabled =<< Annex.fromRepo Git.remotes
disabledremotes <- filterM isdisabled =<< Annex.getGitRemotes
let remotesmsg = unlines $ map ("\t" ++) $
mapMaybe Git.remoteName disabledremotes
giveup $ concat $ filter (not . null) [prefix ++ "\n", remotesmsg, specialmsg]

View file

@ -27,6 +27,9 @@ import qualified Utility.Dot as Dot
-- a link from the first repository to the second (its remote)
data Link = Link Git.Repo Git.Repo
-- a repo and its remotes
type RepoRemotes = (Git.Repo, [Git.Repo])
cmd :: Command
cmd = dontCheck repoExists $
command "map" SectionQuery
@ -76,11 +79,11 @@ runViewer file ((c, ps):rest) = ifM (liftIO $ inPath c)
- the repositories first, followed by uuids that were not matched
- to a repository.
-}
drawMap :: [Git.Repo] -> TrustMap -> M.Map UUID String -> String
drawMap :: [RepoRemotes] -> TrustMap -> M.Map UUID String -> String
drawMap rs trustmap umap = Dot.graph $ repos ++ others
where
repos = map (node umap rs trustmap) rs
ruuids = map getUncachedUUID rs
repos = map (node umap (map fst rs) trustmap) rs
ruuids = map (getUncachedUUID . fst) rs
others = map uuidnode $
filter (\u -> M.lookup u trustmap /= Just DeadTrusted) $
filter (`notElem` ruuids) (M.keys umap)
@ -113,13 +116,13 @@ nodeId r =
UUID u -> u
{- A node representing a repo. -}
node :: M.Map UUID String -> [Git.Repo] -> TrustMap -> Git.Repo -> String
node umap fullinfo trustmap r = unlines $ n:edges
node :: M.Map UUID String -> [Git.Repo] -> TrustMap -> RepoRemotes -> String
node umap fullinfo trustmap (r, rs) = unlines $ n:edges
where
n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $
trustDecorate trustmap (getUncachedUUID r) $
Dot.graphNode (nodeId r) (repoName umap r)
edges = map (edge umap fullinfo r) (Git.remotes r)
edges = map (edge umap fullinfo r) rs
{- 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
@ -149,21 +152,21 @@ trustDecorate trustmap u s = case M.lookup u trustmap of
Nothing -> Dot.fillColor "white" s
{- Recursively searches out remotes starting with the specified repo. -}
spider :: Git.Repo -> Annex [Git.Repo]
spider :: Git.Repo -> Annex [RepoRemotes]
spider r = spider' [r] []
spider' :: [Git.Repo] -> [Git.Repo] -> Annex [Git.Repo]
spider' :: [Git.Repo] -> [RepoRemotes] -> Annex [RepoRemotes]
spider' [] known = return known
spider' (r:rs) known
| any (same r) known = spider' rs known
| any (same r) (map fst known) = spider' rs known
| otherwise = do
r' <- scan r
-- The remotes will be relative to r', and need to be
-- made absolute for later use.
remotes <- mapM (absRepo r') (Git.remotes r')
let r'' = r' { Git.remotes = remotes }
spider' (rs ++ remotes) (r'':known)
remotes <- mapM (absRepo r')
=<< (liftIO $ Git.Construct.fromRemotes r')
spider' (rs ++ remotes) ((r', remotes):known)
{- Converts repos to a common absolute form. -}
absRepo :: Git.Repo -> Git.Repo -> Annex Git.Repo
@ -260,11 +263,11 @@ tryScan r
{- Spidering can find multiple paths to the same repo, so this is used
- to combine (really remove) duplicate repos with the same UUID. -}
combineSame :: [Git.Repo] -> [Git.Repo]
combineSame :: [RepoRemotes] -> [RepoRemotes]
combineSame = map snd . nubBy sameuuid . map pair
where
sameuuid (u1, _) (u2, _) = u1 == u2 && u1 /= NoUUID
pair r = (getUncachedUUID r, r)
pair (r, rs) = (getUncachedUUID r, (r, rs))
safely :: IO Git.Repo -> IO (Maybe Git.Repo)
safely a = do

View file

@ -76,7 +76,7 @@ seek (Pair, Nothing) = commandAction $ do
unusedPeerRemoteName :: Annex RemoteName
unusedPeerRemoteName = go (1 :: Integer) =<< usednames
where
usednames = mapMaybe remoteName . remotes <$> Annex.gitRepo
usednames = mapMaybe remoteName <$> Annex.getGitRemotes
go n names = do
let name = "peer" ++ show n
if name `elem` names