avoid checking location of content when calculating gitAnnexLink
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:
parent
a6db10d565
commit
df4543eb38
1 changed files with 5 additions and 5 deletions
10
Locations.hs
10
Locations.hs
|
@ -126,9 +126,9 @@ annexLocation config key hasher = objectDir </> keyPath key (hasher $ objectHash
|
|||
- the actual location of the file's content.
|
||||
-}
|
||||
gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO FilePath
|
||||
gitAnnexLocation key r config = gitAnnexLocation' key r config (annexCrippledFileSystem config)
|
||||
gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> IO FilePath
|
||||
gitAnnexLocation' key r config crippled
|
||||
gitAnnexLocation key r config = gitAnnexLocation' key r config (annexCrippledFileSystem config) doesFileExist
|
||||
gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> (FilePath -> IO Bool) -> IO FilePath
|
||||
gitAnnexLocation' key r config crippled checker
|
||||
{- Bare repositories default to hashDirLower for new
|
||||
- content, as it's more portable.
|
||||
-
|
||||
|
@ -148,7 +148,7 @@ gitAnnexLocation' key r config crippled
|
|||
| otherwise = return $ inrepo $ annexLocation config key hashDirMixed
|
||||
where
|
||||
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"
|
||||
|
||||
{- 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
|
||||
currdir <- getCurrentDirectory
|
||||
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
|
||||
where
|
||||
whoops = error $ "unable to normalize " ++ file
|
||||
|
|
Loading…
Reference in a new issue