diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2015-03-04 15:44:36 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2015-03-04 15:45:16 -0400 |
| commit | 179af68964152d182caeea9fd6c75858e4cfd2af (patch) | |
| tree | 3a6df2e371acd2853b8d9c17d0befbc2fc94578e /Locations.hs | |
| parent | 15ffb8b60e26bd8707c132f2452cb4adbe7e6d02 (diff) | |
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.
Diffstat (limited to 'Locations.hs')
| -rw-r--r-- | Locations.hs | 10 |
1 files changed, 5 insertions, 5 deletions
diff --git a/Locations.hs b/Locations.hs index 18238d86d..9b10d3c20 100644 --- a/Locations.hs +++ b/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 |