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 /Git | |
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 'Git')
-rw-r--r-- | Git/Config.hs | 6 | ||||
-rw-r--r-- | Git/Construct.hs | 9 | ||||
-rw-r--r-- | Git/Remote.hs | 9 | ||||
-rw-r--r-- | Git/Repair.hs | 6 | ||||
-rw-r--r-- | Git/Types.hs | 4 |
5 files changed, 18 insertions, 16 deletions
diff --git a/Git/Config.hs b/Git/Config.hs index 9b4c342a4..9cee83f2f 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -13,8 +13,8 @@ import Data.Char import Common import Git import Git.Types -import qualified Git.Construct import qualified Git.Command +import qualified Git.Construct import Utility.UserInfo {- Returns a single git config setting, or a default value if not set. -} @@ -89,12 +89,10 @@ hRead repo h = do store :: String -> Repo -> IO Repo store s repo = do let c = parse s - repo' <- updateLocation $ repo + updateLocation $ repo { config = (M.map Prelude.head c) `M.union` config repo , fullconfig = M.unionWith (++) c (fullconfig repo) } - rs <- Git.Construct.fromRemotes repo' - return $ repo' { remotes = rs } {- Updates the location of a repo, based on its configuration. - diff --git a/Git/Construct.hs b/Git/Construct.hs index 4ad74fd73..d4424c900 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -127,8 +127,7 @@ fromRemotes repo = mapM construct remotepairs where filterconfig f = filter f $ M.toList $ config repo filterkeys f = filterconfig (\(k,_) -> f k) - remotepairs = filterkeys isremote - isremote k = "remote." `isPrefixOf` k && ".url" `isSuffixOf` k + remotepairs = filterkeys isRemoteKey construct (k,v) = remoteNamedFromKey k $ fromRemoteLocation v repo {- Sets the name of a remote when constructing the Repo to represent it. -} @@ -140,10 +139,7 @@ remoteNamed n constructor = do {- Sets the name of a remote based on the git config key, such as - "remote.foo.url". -} remoteNamedFromKey :: String -> IO Repo -> IO Repo -remoteNamedFromKey k = remoteNamed basename - where - basename = intercalate "." $ - reverse $ drop 1 $ reverse $ drop 1 $ splitc '.' k +remoteNamedFromKey = remoteNamed . remoteKeyToRemoteName {- Constructs a new Repo for one of a Repo's remotes using a given - location (ie, an url). -} @@ -233,7 +229,6 @@ newFrom l = Repo { location = l , config = M.empty , fullconfig = M.empty - , remotes = [] , remoteName = Nothing , gitEnv = Nothing , gitEnvOverridesGitDir = False diff --git a/Git/Remote.hs b/Git/Remote.hs index f6eaf9362..ce741a0d0 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -20,6 +20,15 @@ import Network.URI import Git.FilePath #endif +{- Is a git config key one that specifies the location of a remote? -} +isRemoteKey :: String -> Bool +isRemoteKey k = "remote." `isPrefixOf` k && ".url" `isSuffixOf` k + +{- Get a remote's name from the config key that specifies its location. -} +remoteKeyToRemoteName :: String -> RemoteName +remoteKeyToRemoteName k = intercalate "." $ + reverse $ drop 1 $ reverse $ drop 1 $ splitc '.' k + {- Construct a legal git remote name out of an arbitrary input string. - - There seems to be no formal definition of this in the git source, diff --git a/Git/Repair.hs b/Git/Repair.hs index d4f8e0bf9..ffc0976b2 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -11,7 +11,6 @@ module Git.Repair ( removeBadBranches, successfulRepair, cleanCorruptObjects, - retrieveMissingObjects, resetLocalBranches, checkIndex, checkIndexFast, @@ -102,10 +101,11 @@ retrieveMissingObjects missing referencerepo r unlessM (boolSystem "git" [Param "init", File tmpdir]) $ error $ "failed to create temp repository in " ++ tmpdir tmpr <- Config.read =<< Construct.fromAbsPath tmpdir - stillmissing <- pullremotes tmpr (remotes r) fetchrefstags missing + rs <- Construct.fromRemotes r + stillmissing <- pullremotes tmpr rs fetchrefstags missing if S.null (knownMissing stillmissing) then return stillmissing - else pullremotes tmpr (remotes r) fetchallrefs stillmissing + else pullremotes tmpr rs fetchallrefs stillmissing where pullremotes tmpr [] fetchrefs stillmissing = case referencerepo of Nothing -> return stillmissing diff --git a/Git/Types.hs b/Git/Types.hs index 327c1d722..25282a074 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -34,8 +34,8 @@ data Repo = Repo , config :: M.Map String String -- a given git config key can actually have multiple values , fullconfig :: M.Map String [String] - , remotes :: [Repo] - -- remoteName holds the name used for this repo in remotes + -- remoteName holds the name used for this repo in some other + -- repo's list of remotes, when this repo is such a remote , remoteName :: Maybe RemoteName -- alternate environment to use when running git commands , gitEnv :: Maybe [(String, String)] |