optimize gitAnnexLocation
For non-bare it's back to doing no work.
This commit is contained in:
parent
f4bf444ae0
commit
e6ef66cea3
1 changed files with 19 additions and 12 deletions
31
Locations.hs
31
Locations.hs
|
@ -59,28 +59,35 @@ objectDir :: FilePath
|
||||||
objectDir = addTrailingPathSeparator $ annexDir </> "objects"
|
objectDir = addTrailingPathSeparator $ annexDir </> "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;
|
- There are two different possibilities, using different hashes. -}
|
||||||
- the first is the default for new content. -}
|
|
||||||
annexLocations :: Key -> [FilePath]
|
annexLocations :: Key -> [FilePath]
|
||||||
annexLocations key = [using hashDirMixed, using hashDirLower]
|
annexLocations key = map (annexLocation key) [hashDirMixed, hashDirLower]
|
||||||
|
annexLocation :: Key -> (Key -> FilePath) -> FilePath
|
||||||
|
annexLocation key hasher = objectDir </> hasher key </> f </> f
|
||||||
where
|
where
|
||||||
using h = objectDir </> h key </> f </> f
|
|
||||||
f = keyFile key
|
f = keyFile key
|
||||||
|
|
||||||
{- Annexed file's absolute location in a repository.
|
{- Annexed file's absolute location in a repository.
|
||||||
- Out of the possible annexLocations, returns the one where the file
|
-
|
||||||
- is actually present. When the file is not present, returns the
|
- When there are multiple possible locations, returns the one where the
|
||||||
- one where the file should be put.
|
- file is actually present.
|
||||||
|
-
|
||||||
|
- When the file is not present, returns the location where the file should
|
||||||
|
- be stored.
|
||||||
-}
|
-}
|
||||||
gitAnnexLocation :: Key -> Git.Repo -> IO FilePath
|
gitAnnexLocation :: Key -> Git.Repo -> IO FilePath
|
||||||
gitAnnexLocation key r
|
gitAnnexLocation key r
|
||||||
| Git.repoIsLocalBare r =
|
| Git.repoIsLocalBare r =
|
||||||
-- bare repositories default to hashDirLower for new
|
{- Bare repositories default to hashDirLower for new
|
||||||
-- content, as it's more portable, so check locations
|
- content, as it's more portable. -}
|
||||||
-- in reverse order
|
go (Git.workTree r) $
|
||||||
go (Git.workTree r) $ reverse $ annexLocations key
|
map (annexLocation key) [hashDirLower, hashDirMixed]
|
||||||
| otherwise =
|
| otherwise =
|
||||||
go (Git.workTree r </> ".git") $ annexLocations key
|
{- Non-bare repositories only use hashDirMixed, so
|
||||||
|
- don't need to do any work to check if the file is
|
||||||
|
- present. -}
|
||||||
|
return $ Git.workTree r </> ".git" </>
|
||||||
|
annexLocation key hashDirMixed
|
||||||
where
|
where
|
||||||
go dir locs = fromMaybe (dir </> head locs) <$> check dir locs
|
go dir locs = fromMaybe (dir </> head locs) <$> check dir locs
|
||||||
check _ [] = return Nothing
|
check _ [] = return Nothing
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue