some initial support for local bare repos
This relies on git-annex's behavior of reading the config of local repos. That allows repoIsLocalBare to examine the git config for core.bare. Hopefully, gitAnnexLocation, gitAnnexDir, and gitAnnexObjectDir are only used on local repos. But, I have not audited fully, since they're probably not (see for example copyToRemote). And so, the functions fall back to their old non-bare-aware behavior for non-local repos.
This commit is contained in:
parent
7ea9f52c28
commit
d651d4985b
3 changed files with 35 additions and 20 deletions
|
@ -51,8 +51,8 @@ calcGitLink file key = do
|
||||||
let absfile = case absNormPath cwd file of
|
let absfile = case absNormPath cwd file of
|
||||||
Just f -> f
|
Just f -> f
|
||||||
Nothing -> error $ "unable to normalize " ++ filePathToString file
|
Nothing -> error $ "unable to normalize " ++ filePathToString file
|
||||||
return $ relPathDirToDir (parentDir absfile) (Git.workTree g) ++
|
return $ relPathDirToDir (parentDir absfile)
|
||||||
annexLocation key
|
(Git.workTree g) </> ".git" </> annexLocation key
|
||||||
|
|
||||||
{- Updates the LocationLog when a key's presence changes. -}
|
{- Updates the LocationLog when a key's presence changes. -}
|
||||||
logStatus :: Key -> LogStatus -> Annex ()
|
logStatus :: Key -> LogStatus -> Annex ()
|
||||||
|
|
18
GitRepo.hs
18
GitRepo.hs
|
@ -16,6 +16,8 @@ module GitRepo (
|
||||||
localToUrl,
|
localToUrl,
|
||||||
repoIsUrl,
|
repoIsUrl,
|
||||||
repoIsSsh,
|
repoIsSsh,
|
||||||
|
repoIsLocalBare,
|
||||||
|
repoIsLocalFull,
|
||||||
repoDescribe,
|
repoDescribe,
|
||||||
repoLocation,
|
repoLocation,
|
||||||
workTree,
|
workTree,
|
||||||
|
@ -161,6 +163,14 @@ repoIsSsh Repo { location = Url url }
|
||||||
| otherwise = False
|
| otherwise = False
|
||||||
repoIsSsh _ = False
|
repoIsSsh _ = False
|
||||||
|
|
||||||
|
repoIsLocalBare :: Repo -> Bool
|
||||||
|
repoIsLocalBare r@(Repo { location = Dir _ }) = configBare r
|
||||||
|
repoIsLocalBare _ = False
|
||||||
|
|
||||||
|
repoIsLocalFull :: Repo -> Bool
|
||||||
|
repoIsLocalFull r@(Repo { location = Dir _ }) = not $ configBare r
|
||||||
|
repoIsLocalFull _ = False
|
||||||
|
|
||||||
assertLocal :: Repo -> a -> a
|
assertLocal :: Repo -> a -> a
|
||||||
assertLocal repo action =
|
assertLocal repo action =
|
||||||
if not $ repoIsUrl repo
|
if not $ repoIsUrl repo
|
||||||
|
@ -174,8 +184,8 @@ assertUrl repo action =
|
||||||
else error $ "acting on local git repo " ++ repoDescribe repo ++
|
else error $ "acting on local git repo " ++ repoDescribe repo ++
|
||||||
" not supported"
|
" not supported"
|
||||||
|
|
||||||
bare :: Repo -> Bool
|
configBare :: Repo -> Bool
|
||||||
bare repo = case Map.lookup "core.bare" $ config repo of
|
configBare repo = case Map.lookup "core.bare" $ config repo of
|
||||||
Just v -> configTrue v
|
Just v -> configTrue v
|
||||||
Nothing -> error $ "it is not known if git repo " ++
|
Nothing -> error $ "it is not known if git repo " ++
|
||||||
repoDescribe repo ++
|
repoDescribe repo ++
|
||||||
|
@ -184,13 +194,13 @@ bare repo = case Map.lookup "core.bare" $ config repo of
|
||||||
{- Path to a repository's gitattributes file. -}
|
{- Path to a repository's gitattributes file. -}
|
||||||
attributes :: Repo -> String
|
attributes :: Repo -> String
|
||||||
attributes repo
|
attributes repo
|
||||||
| bare repo = workTree repo ++ "/info/.gitattributes"
|
| configBare repo = workTree repo ++ "/info/.gitattributes"
|
||||||
| otherwise = workTree repo ++ "/.gitattributes"
|
| otherwise = workTree repo ++ "/.gitattributes"
|
||||||
|
|
||||||
{- Path to a repository's .git directory, relative to its workTree. -}
|
{- Path to a repository's .git directory, relative to its workTree. -}
|
||||||
gitDir :: Repo -> String
|
gitDir :: Repo -> String
|
||||||
gitDir repo
|
gitDir repo
|
||||||
| bare repo = ""
|
| configBare repo = ""
|
||||||
| otherwise = ".git"
|
| otherwise = ".git"
|
||||||
|
|
||||||
{- Path to a repository's --work-tree, that is, its top.
|
{- Path to a repository's --work-tree, that is, its top.
|
||||||
|
|
33
Locations.hs
33
Locations.hs
|
@ -50,35 +50,40 @@ stateDir = addTrailingPathSeparator $ ".git-annex"
|
||||||
gitStateDir :: Git.Repo -> FilePath
|
gitStateDir :: Git.Repo -> FilePath
|
||||||
gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir
|
gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir
|
||||||
|
|
||||||
{- Annexed content is stored in .git/annex/objects; .git/annex is used
|
{- The directory git annex uses for local state, relative to the .git
|
||||||
- for other temporary storage also. -}
|
- directory -}
|
||||||
annexDir :: FilePath
|
annexDir :: FilePath
|
||||||
annexDir = addTrailingPathSeparator $ ".git/annex"
|
annexDir = addTrailingPathSeparator $ "annex"
|
||||||
|
|
||||||
|
{- The directory git annex uses for locally available object content,
|
||||||
|
- relative to the .git directory -}
|
||||||
objectDir :: FilePath
|
objectDir :: FilePath
|
||||||
objectDir = addTrailingPathSeparator $ annexDir </> "objects"
|
objectDir = addTrailingPathSeparator $ annexDir </> "objects"
|
||||||
|
|
||||||
{- Annexed file's location relative to git's working tree.
|
{- Annexed file's location relative to the .git directory. -}
|
||||||
-
|
|
||||||
- Note: Assumes repo is NOT bare.-}
|
|
||||||
annexLocation :: Key -> FilePath
|
annexLocation :: Key -> FilePath
|
||||||
annexLocation key = ".git/annex/objects" </> f </> f
|
annexLocation key = objectDir </> f </> f
|
||||||
where
|
where
|
||||||
f = keyFile key
|
f = keyFile key
|
||||||
|
|
||||||
{- Annexed file's absolute location in a repository. -}
|
{- Annexed file's absolute location in a repository. -}
|
||||||
gitAnnexLocation :: Git.Repo -> Key -> FilePath
|
gitAnnexLocation :: Git.Repo -> Key -> FilePath
|
||||||
gitAnnexLocation r key = Git.workTree r </> annexLocation key
|
gitAnnexLocation r key
|
||||||
|
| Git.repoIsLocalBare r = Git.workTree r </> annexLocation key
|
||||||
|
| otherwise = Git.workTree r </> ".git" </> annexLocation key
|
||||||
|
|
||||||
{- The annex directory of a repository.
|
{- The annex directory of a repository. -}
|
||||||
-
|
|
||||||
- Note: Assumes repo is NOT bare. -}
|
|
||||||
gitAnnexDir :: Git.Repo -> FilePath
|
gitAnnexDir :: Git.Repo -> FilePath
|
||||||
gitAnnexDir r = addTrailingPathSeparator $ Git.workTree r </> annexDir
|
gitAnnexDir r
|
||||||
|
| Git.repoIsLocalBare r = addTrailingPathSeparator $ Git.workTree r </> annexDir
|
||||||
|
| otherwise = addTrailingPathSeparator $ Git.workTree r </> ".git" </> annexDir
|
||||||
|
|
||||||
{- The part of the annex directory where file contents are stored.
|
{- The part of the annex directory where file contents are stored.
|
||||||
-}
|
-}
|
||||||
gitAnnexObjectDir :: Git.Repo -> FilePath
|
gitAnnexObjectDir :: Git.Repo -> FilePath
|
||||||
gitAnnexObjectDir r = addTrailingPathSeparator $ Git.workTree r </> objectDir
|
gitAnnexObjectDir r
|
||||||
|
| Git.repoIsLocalBare r = addTrailingPathSeparator $ Git.workTree r </> objectDir
|
||||||
|
| otherwise = addTrailingPathSeparator $ Git.workTree r </> ".git" </> objectDir
|
||||||
|
|
||||||
{- .git-annex/tmp/ is used for temp files -}
|
{- .git-annex/tmp/ is used for temp files -}
|
||||||
gitAnnexTmpDir :: Git.Repo -> FilePath
|
gitAnnexTmpDir :: Git.Repo -> FilePath
|
||||||
|
@ -98,7 +103,7 @@ gitAnnexUnusedLog r = gitAnnexDir r </> "unused"
|
||||||
|
|
||||||
{- Checks a symlink target to see if it appears to point to annexed content. -}
|
{- Checks a symlink target to see if it appears to point to annexed content. -}
|
||||||
isLinkToAnnex :: FilePath -> Bool
|
isLinkToAnnex :: FilePath -> Bool
|
||||||
isLinkToAnnex s = ("/" ++ objectDir) `isInfixOf` s
|
isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s
|
||||||
|
|
||||||
{- Converts a key into a filename fragment.
|
{- Converts a key into a filename fragment.
|
||||||
-
|
-
|
||||||
|
|
Loading…
Reference in a new issue