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

avoid checking location of content when calculating gitAnnexLink

Browse source 
It doesn't matter if the object is present or not, gitAnnexLink should
always yield the same symlink target.

This is an optimisation; no behavior should be changed.
This commit is contained in:
Joey Hess 2015-03-04 15:44:36 -04:00
parent a6db10d565
commit df4543eb38
1 changed files with 5 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

10
Locations.hs
View file

@ -126,9 +126,9 @@ annexLocation config key hasher = objectDir </> keyPath key (hasher $ objectHash
- the actual location of the file's content. - the actual location of the file's content.
-} -}
gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO FilePath gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO FilePath
gitAnnexLocation key r config = gitAnnexLocation' key r config (annexCrippledFileSystem config) gitAnnexLocation key r config = gitAnnexLocation' key r config (annexCrippledFileSystem config) doesFileExist
gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> IO FilePath gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> (FilePath -> IO Bool) -> IO FilePath
gitAnnexLocation' key r config crippled gitAnnexLocation' key r config crippled checker
{- Bare repositories default to hashDirLower for new {- Bare repositories default to hashDirLower for new
- content, as it's more portable. - content, as it's more portable.
- -
@ -148,7 +148,7 @@ gitAnnexLocation' key r config crippled
| otherwise = return $ inrepo $ annexLocation config key hashDirMixed | otherwise = return $ inrepo $ annexLocation config key hashDirMixed
where where
inrepo d = Git.localGitDir r </> d inrepo d = Git.localGitDir r </> d
check locs@(l:_) = fromMaybe l <$> firstM doesFileExist locs check locs@(l:_) = fromMaybe l <$> firstM checker locs
check [] = error "internal" check [] = error "internal"
{- Calculates a symlink to link a file to an annexed object. -} {- Calculates a symlink to link a file to an annexed object. -}
@ -156,7 +156,7 @@ gitAnnexLink :: FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath
gitAnnexLink file key r config = do gitAnnexLink file key r config = do
currdir <- getCurrentDirectory currdir <- getCurrentDirectory
let absfile = fromMaybe whoops $ absNormPathUnix currdir file let absfile = fromMaybe whoops $ absNormPathUnix currdir file
loc <- gitAnnexLocation' key r config False loc <- gitAnnexLocation' key r config False (\_ -> return True)
toInternalGitPath <$> relPathDirToFile (parentDir absfile) loc toInternalGitPath <$> relPathDirToFile (parentDir absfile) loc
where where
whoops = error $ "unable to normalize " ++ file whoops = error $ "unable to normalize " ++ file