split annexLocations

To avoid mistakes like commit 0ccbed4f6f,
be explicit about the two variants of this.

Incidentially avoids a small amount of overhead in calling reverse.

Sponsored-by: Shae Erisson on Patreon
This commit is contained in:
Joey Hess 2021-07-16 14:16:05 -04:00
parent aa33c928cb
commit 635e7f3e26
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 27 additions and 25 deletions

View file

@ -1,6 +1,6 @@
{- git-annex file locations {- git-annex file locations
- -
- Copyright 2010-2020 Joey Hess <id@joeyh.name> - Copyright 2010-2021 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -22,7 +22,8 @@ module Annex.Locations (
gitAnnexContentLock, gitAnnexContentLock,
gitAnnexInodeSentinal, gitAnnexInodeSentinal,
gitAnnexInodeSentinalCache, gitAnnexInodeSentinalCache,
annexLocations, annexLocationsBare,
annexLocationsNonBare,
gitAnnexDir, gitAnnexDir,
gitAnnexObjectDir, gitAnnexObjectDir,
gitAnnexTmpOtherDir, gitAnnexTmpOtherDir,
@ -134,13 +135,20 @@ objectDir = fromRawFilePath objectDir'
objectDir' :: RawFilePath objectDir' :: RawFilePath
objectDir' = P.addTrailingPathSeparator $ annexDir P.</> "objects" objectDir' = P.addTrailingPathSeparator $ annexDir P.</> "objects"
{- Annexed file's possible locations relative to the .git directory. {- Annexed file's possible locations relative to the .git directory
- There are two different possibilities, using different hashes. - in a non-bare repository.
- -
- Also, some repositories have a Difference in hash directory depth. - Normally it is hashDirMixed. However, it's always possible that a
-} - bare repository was converted to non-bare, or that the cripped
annexLocations :: GitConfig -> Key -> [RawFilePath] - filesystem setting changed, so still need to check both. -}
annexLocations config key = map (annexLocation config key) dirHashes annexLocationsNonBare :: GitConfig -> Key -> [RawFilePath]
annexLocationsNonBare config key =
map (annexLocation config key) [hashDirMixed, hashDirLower]
{- Annexed file's possible locations relative to a bare repository. -}
annexLocationsBare :: GitConfig -> Key -> [RawFilePath]
annexLocationsBare config key =
map (annexLocation config key) [hashDirLower, hashDirMixed]
annexLocation :: GitConfig -> Key -> (HashLevels -> Hasher) -> RawFilePath annexLocation :: GitConfig -> Key -> (HashLevels -> Hasher) -> RawFilePath
annexLocation config key hasher = objectDir' P.</> keyPath key (hasher $ objectHashLevels config) annexLocation config key hasher = objectDir' P.</> keyPath key (hasher $ objectHashLevels config)
@ -171,26 +179,20 @@ gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> Bool -> (RawFilePat
gitAnnexLocation' key r config crippled symlinkssupported checker gitdir gitAnnexLocation' key r config crippled symlinkssupported checker gitdir
{- Bare repositories default to hashDirLower for new {- Bare repositories default to hashDirLower for new
- content, as it's more portable. But check all locations. -} - content, as it's more portable. But check all locations. -}
| Git.repoIsLocalBare r = checkall id | Git.repoIsLocalBare r = checkall annexLocationsBare
{- If the repository is configured to only use lower, no need {- If the repository is configured to only use lower, no need
- to check both. -} - to check both. -}
| hasDifference ObjectHashLower (annexDifferences config) = | hasDifference ObjectHashLower (annexDifferences config) =
only hashDirLower only hashDirLower
{- Repositories on crippled filesystems use hashDirLower {- Repositories on crippled filesystems use same layout as bare
- for new content, unless symlinks are supported too. - repos for new content, unless symlinks are supported too. -}
- Then hashDirMixed is used. But, the content could be
- in either location so check both. -}
| crippled = if symlinkssupported | crippled = if symlinkssupported
then checkall reverse then checkall annexLocationsNonBare
else checkall id else checkall annexLocationsBare
{- Regular repositories usually only use hashDirMixed. | otherwise = checkall annexLocationsNonBare
- However, it's always possible that a bare repository was
- converted to non-bare, or that the cripped filesystem
- setting changed, so still need to check both. -}
| otherwise = checkall reverse
where where
only = return . inrepo . annexLocation config key only = return . inrepo . annexLocation config key
checkall f = check $ map inrepo $ f $ annexLocations config key checkall f = check $ map inrepo $ f config key
inrepo d = gitdir P.</> d inrepo d = gitdir P.</> d
check locs@(l:_) = fromMaybe l <$> firstM checker locs check locs@(l:_) = fromMaybe l <$> firstM checker locs
@ -624,8 +626,8 @@ keyPath key hasher = hasher key P.</> f P.</> f
{- All possibile locations to store a key in a special remote {- All possibile locations to store a key in a special remote
- using different directory hashes. - using different directory hashes.
- -
- This is compatible with the annexLocations, for interoperability between - This is compatible with the annexLocationsNonBare and annexLocationsBare,
- special remotes and git-annex repos. - for interoperability between special remotes and git-annex repos.
-} -}
keyPaths :: Key -> [RawFilePath] keyPaths :: Key -> [RawFilePath]
keyPaths key = map (\h -> keyPath key (h def)) dirHashes keyPaths key = map (\h -> keyPath key (h def)) dirHashes

View file

@ -429,8 +429,8 @@ keyUrls gc repo r key = map tourl locs'
-- If the remote is known to not be bare, try the hash locations -- If the remote is known to not be bare, try the hash locations
-- used for non-bare repos first, as an optimisation. -- used for non-bare repos first, as an optimisation.
locs locs
| remoteAnnexBare remoteconfig == Just False = reverse (annexLocations gc key) | remoteAnnexBare remoteconfig == Just False = annexLocationsNonBare gc key
| otherwise = annexLocations gc key | otherwise = annexLocationsBare gc key
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
locs' = map fromRawFilePath locs locs' = map fromRawFilePath locs
#else #else