mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

RawFilePath conversion

Browse source 
May slightly speed up startup.
This commit is contained in:
Joey Hess 2023-10-26 13:53:43 -04:00
parent b0302c937d
commit e4ef688b98
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 12 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Assistant/MakeRepo.hs
View file

@ -95,4 +95,4 @@ initRepo' desc mgroup = unlessM isInitialized $ do
{- Checks if a git repo exists at a location. -} {- Checks if a git repo exists at a location. -}
probeRepoExists :: FilePath -> IO Bool probeRepoExists :: FilePath -> IO Bool
probeRepoExists dir = isJust <$> probeRepoExists dir = isJust <$>
catchDefaultIO Nothing (Git.Construct.checkForRepo dir) catchDefaultIO Nothing (Git.Construct.checkForRepo (encodeBS dir))

20
Git/Construct.hs
View file

@ -40,6 +40,7 @@ import Git.FilePath
import qualified Git.Url as Url import qualified Git.Url as Url
import Utility.UserInfo import Utility.UserInfo
import Utility.Url.Parse import Utility.Url.Parse
import qualified Utility.RawFilePath as R
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified System.FilePath.ByteString as P import qualified System.FilePath.ByteString as P
@ -47,14 +48,14 @@ import qualified System.FilePath.ByteString as P
{- Finds the git repository used for the cwd, which may be in a parent {- Finds the git repository used for the cwd, which may be in a parent
- directory. -} - directory. -}
fromCwd :: IO (Maybe Repo) fromCwd :: IO (Maybe Repo)
fromCwd = getCurrentDirectory >>= seekUp fromCwd = R.getCurrentDirectory >>= seekUp
where where
seekUp dir = do seekUp dir = do
r <- checkForRepo dir r <- checkForRepo dir
case r of case r of
Nothing -> case upFrom (toRawFilePath dir) of Nothing -> case upFrom dir of
Nothing -> return Nothing Nothing -> return Nothing
Just d -> seekUp (fromRawFilePath d) Just d -> seekUp d
Just loc -> pure $ Just $ newFrom loc Just loc -> pure $ Just $ newFrom loc
{- Local Repo constructor, accepts a relative or absolute path. -} {- Local Repo constructor, accepts a relative or absolute path. -}
@ -220,26 +221,27 @@ expandTilde p = expandt True p
{- Checks if a git repository exists in a directory. Does not find {- Checks if a git repository exists in a directory. Does not find
- git repositories in parent directories. -} - git repositories in parent directories. -}
checkForRepo :: FilePath -> IO (Maybe RepoLocation) checkForRepo :: RawFilePath -> IO (Maybe RepoLocation)
checkForRepo dir = checkForRepo dir =
check isRepo $ check isRepo $
check (checkGitDirFile (toRawFilePath dir)) $ check (checkGitDirFile dir) $
check (checkdir (isBareRepo dir)) $ check (checkdir (isBareRepo dir')) $
return Nothing return Nothing
where where
check test cont = maybe cont (return . Just) =<< test check test cont = maybe cont (return . Just) =<< test
checkdir c = ifM c checkdir c = ifM c
( return $ Just $ LocalUnknown $ toRawFilePath dir ( return $ Just $ LocalUnknown dir
, return Nothing , return Nothing
) )
isRepo = checkdir $ isRepo = checkdir $
doesFileExist (dir </> ".git" </> "config") doesFileExist (dir' </> ".git" </> "config")
<||> <||>
-- A git-worktree lacks .git/config, but has .git/gitdir. -- A git-worktree lacks .git/config, but has .git/gitdir.
-- (Normally the .git is a file, not a symlink, but it can -- (Normally the .git is a file, not a symlink, but it can
-- be converted to a symlink and git will still work; -- be converted to a symlink and git will still work;
-- this handles that case.) -- this handles that case.)
doesFileExist (dir </> ".git" </> "gitdir") doesFileExist (dir' </> ".git" </> "gitdir")
dir' = fromRawFilePath dir
isBareRepo :: FilePath -> IO Bool isBareRepo :: FilePath -> IO Bool
isBareRepo dir = doesFileExist (dir </> "config") isBareRepo dir = doesFileExist (dir </> "config")