diff options
author | Joey Hess <joeyh@joeyh.name> | 2018-01-09 15:36:56 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2018-01-09 16:22:07 -0400 |
commit | aff377f1fd40d1d5dbfc44e9a3ca37e646c1dcd4 (patch) | |
tree | ca6311b6565f217b1b037c7096d82c791cf010b9 /Command | |
parent | 008fe331573e259960c268e4bd30eb0c851dafb7 (diff) |
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.
Diffstat (limited to 'Command')
-rw-r--r-- | Command/EnableRemote.hs | 4 | ||||
-rw-r--r-- | Command/Map.hs | 33 | ||||
-rw-r--r-- | Command/P2P.hs | 2 |
3 files changed, 21 insertions, 18 deletions
diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index e540473c5..09666147c 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -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] diff --git a/Command/Map.hs b/Command/Map.hs index 9ae73d898..42e3c3645 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -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 diff --git a/Command/P2P.hs b/Command/P2P.hs index 1b5418499..65a2a67da 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -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 |