adjust: Add --fix adjustment, which is useful when the git directory is in a nonstandard place.
This commit is contained in:
parent
76170b0457
commit
eda5d9cc74
7 changed files with 99 additions and 25 deletions
|
@ -57,6 +57,8 @@ import qualified Data.Map as M
|
|||
data Adjustment
|
||||
= UnlockAdjustment
|
||||
| LockAdjustment
|
||||
| FixAdjustment
|
||||
| UnFixAdjustment
|
||||
| HideMissingAdjustment
|
||||
| ShowMissingAdjustment
|
||||
deriving (Show, Eq)
|
||||
|
@ -66,32 +68,16 @@ reverseAdjustment UnlockAdjustment = LockAdjustment
|
|||
reverseAdjustment LockAdjustment = UnlockAdjustment
|
||||
reverseAdjustment HideMissingAdjustment = ShowMissingAdjustment
|
||||
reverseAdjustment ShowMissingAdjustment = HideMissingAdjustment
|
||||
reverseAdjustment FixAdjustment = UnFixAdjustment
|
||||
reverseAdjustment UnFixAdjustment = FixAdjustment
|
||||
|
||||
{- How to perform various adjustments to a TreeItem. -}
|
||||
adjustTreeItem :: Adjustment -> TreeItem -> Annex (Maybe TreeItem)
|
||||
adjustTreeItem UnlockAdjustment ti@(TreeItem f m s)
|
||||
| toBlobType m == Just SymlinkBlob = do
|
||||
mk <- catKey s
|
||||
case mk of
|
||||
Just k -> do
|
||||
Database.Keys.addAssociatedFile k f
|
||||
Just . TreeItem f (fromBlobType FileBlob)
|
||||
<$> hashPointerFile k
|
||||
Nothing -> return (Just ti)
|
||||
| otherwise = return (Just ti)
|
||||
adjustTreeItem LockAdjustment ti@(TreeItem f m s)
|
||||
| toBlobType m /= Just SymlinkBlob = do
|
||||
mk <- catKey s
|
||||
case mk of
|
||||
Just k -> do
|
||||
absf <- inRepo $ \r -> absPath $
|
||||
fromTopFilePath f r
|
||||
linktarget <- calcRepo $ gitAnnexLink absf k
|
||||
Just . TreeItem f (fromBlobType SymlinkBlob)
|
||||
<$> hashSymlink linktarget
|
||||
Nothing -> return (Just ti)
|
||||
| otherwise = return (Just ti)
|
||||
adjustTreeItem HideMissingAdjustment ti@(TreeItem _ _ s) = do
|
||||
adjustTreeItem UnlockAdjustment = ifSymlink adjustToPointer noAdjust
|
||||
adjustTreeItem LockAdjustment = ifSymlink noAdjust adjustToSymlink
|
||||
adjustTreeItem FixAdjustment = ifSymlink adjustToSymlink noAdjust
|
||||
adjustTreeItem UnFixAdjustment = ifSymlink (adjustToSymlink' gitAnnexLinkCanonical) noAdjust
|
||||
adjustTreeItem HideMissingAdjustment = \ti@(TreeItem _ _ s) -> do
|
||||
mk <- catKey s
|
||||
case mk of
|
||||
Just k -> ifM (inAnnex k)
|
||||
|
@ -99,7 +85,40 @@ adjustTreeItem HideMissingAdjustment ti@(TreeItem _ _ s) = do
|
|||
, return Nothing
|
||||
)
|
||||
Nothing -> return (Just ti)
|
||||
adjustTreeItem ShowMissingAdjustment ti = return (Just ti)
|
||||
adjustTreeItem ShowMissingAdjustment = noAdjust
|
||||
|
||||
ifSymlink :: (TreeItem -> Annex a) -> (TreeItem -> Annex a) -> TreeItem -> Annex a
|
||||
ifSymlink issymlink notsymlink ti@(TreeItem _f m _s)
|
||||
| toBlobType m == Just SymlinkBlob = issymlink ti
|
||||
| otherwise = notsymlink ti
|
||||
|
||||
noAdjust :: TreeItem -> Annex (Maybe TreeItem)
|
||||
noAdjust = return . Just
|
||||
|
||||
adjustToPointer :: TreeItem -> Annex (Maybe TreeItem)
|
||||
adjustToPointer ti@(TreeItem f _m s) = do
|
||||
mk <- catKey s
|
||||
case mk of
|
||||
Just k -> do
|
||||
Database.Keys.addAssociatedFile k f
|
||||
Just . TreeItem f (fromBlobType FileBlob)
|
||||
<$> hashPointerFile k
|
||||
Nothing -> return (Just ti)
|
||||
|
||||
adjustToSymlink :: TreeItem -> Annex (Maybe TreeItem)
|
||||
adjustToSymlink = adjustToSymlink' gitAnnexLink
|
||||
|
||||
adjustToSymlink' :: (FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath) -> TreeItem -> Annex (Maybe TreeItem)
|
||||
adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = do
|
||||
mk <- catKey s
|
||||
case mk of
|
||||
Just k -> do
|
||||
absf <- inRepo $ \r -> absPath $
|
||||
fromTopFilePath f r
|
||||
linktarget <- calcRepo $ gitannexlink absf k
|
||||
Just . TreeItem f (fromBlobType SymlinkBlob)
|
||||
<$> hashSymlink linktarget
|
||||
Nothing -> return (Just ti)
|
||||
|
||||
type OrigBranch = Branch
|
||||
newtype AdjBranch = AdjBranch { adjBranch :: Branch }
|
||||
|
@ -123,11 +142,15 @@ serialize UnlockAdjustment = "unlocked"
|
|||
serialize LockAdjustment = "locked"
|
||||
serialize HideMissingAdjustment = "present"
|
||||
serialize ShowMissingAdjustment = "showmissing"
|
||||
serialize FixAdjustment = "fixed"
|
||||
serialize UnFixAdjustment = "unfixed"
|
||||
|
||||
deserialize :: String -> Maybe Adjustment
|
||||
deserialize "unlocked" = Just UnlockAdjustment
|
||||
deserialize "locked" = Just UnlockAdjustment
|
||||
deserialize "present" = Just HideMissingAdjustment
|
||||
deserialize "fixed" = Just FixAdjustment
|
||||
deserialize "unfixed" = Just UnFixAdjustment
|
||||
deserialize _ = Nothing
|
||||
|
||||
originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
|
||||
|
|
|
@ -15,6 +15,7 @@ module Annex.Locations (
|
|||
gitAnnexLocation,
|
||||
gitAnnexLocationDepth,
|
||||
gitAnnexLink,
|
||||
gitAnnexLinkCanonical,
|
||||
gitAnnexContentLock,
|
||||
gitAnnexMapping,
|
||||
gitAnnexInodeCache,
|
||||
|
@ -80,6 +81,7 @@ import Types.UUID
|
|||
import Types.GitConfig
|
||||
import Types.Difference
|
||||
import qualified Git
|
||||
import qualified Git.Types as Git
|
||||
import Git.FilePath
|
||||
import Annex.DirHashes
|
||||
import Annex.Fixup
|
||||
|
@ -182,6 +184,20 @@ gitAnnexLink file key r config = do
|
|||
| otherwise = Git.localGitDir r
|
||||
whoops = error $ "unable to normalize " ++ file
|
||||
|
||||
{- Calculates a symlink target as would be used in a typical git
|
||||
- repository, with .git in the top of the work tree. -}
|
||||
gitAnnexLinkCanonical :: FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath
|
||||
gitAnnexLinkCanonical file key r config = gitAnnexLink file key r' config'
|
||||
where
|
||||
r' = case r of
|
||||
Git.Repo { Git.location = l@Git.Local { Git.worktree = Just wt } } ->
|
||||
r { Git.location = l { Git.gitdir = wt </> ".git" } }
|
||||
_ -> r
|
||||
config' = config
|
||||
{ annexCrippledFileSystem = False
|
||||
, coreSymlinks = True
|
||||
}
|
||||
|
||||
{- File used to lock a key's content. -}
|
||||
gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO FilePath
|
||||
gitAnnexContentLock key r config = do
|
||||
|
|
|
@ -21,6 +21,10 @@ optParser _ =
|
|||
( long "unlock"
|
||||
<> help "unlock annexed files"
|
||||
)
|
||||
<|> flag' FixAdjustment
|
||||
( long "fix"
|
||||
<> help "fix symlinks to annnexed files"
|
||||
)
|
||||
{- Not ready yet
|
||||
<|> flag' HideMissingAdjustment
|
||||
( long "hide-missing"
|
||||
|
|
2
debian/changelog
vendored
2
debian/changelog
vendored
|
@ -13,6 +13,8 @@ git-annex (6.20160512) UNRELEASED; urgency=medium
|
|||
* add: Adding a v6 pointer file used to annex it; now the pointer file is
|
||||
added to git as-is. (git add of a pointer file already did the right
|
||||
thing)
|
||||
* adjust: Add --fix adjustment, which is useful when the git directory
|
||||
is in a nonstandard place.
|
||||
|
||||
-- Joey Hess <id@joeyh.name> Wed, 11 May 2016 16:08:38 -0400
|
||||
|
||||
|
|
|
@ -0,0 +1,14 @@
|
|||
[[!comment format=mdwn
|
||||
username="joey"
|
||||
subject="""comment 6"""
|
||||
date="2016-05-16T20:14:57Z"
|
||||
content="""
|
||||
I hope this will be fixed on the git side, but I don't know when it will
|
||||
be. Probably comes down to someone developing a patch.
|
||||
|
||||
Occurs to me that git-annex could use adjusted branches to deal with this.
|
||||
When initializing in a submodule, it could enter an adjusted branch with
|
||||
`git annex adjust --fix`. This way, symlinks would be re-written to point
|
||||
to the submodule's git repository. The .git dotfile would not need to be
|
||||
converted to a symlink at all.
|
||||
"""]]
|
|
@ -0,0 +1,8 @@
|
|||
[[!comment format=mdwn
|
||||
username="joey"
|
||||
subject="""comment 4"""
|
||||
date="2016-05-16T20:34:28Z"
|
||||
content="""
|
||||
@thowz great idea! And not hard at all to implement! I've done so:
|
||||
`git annex adjust --fix`
|
||||
"""]]
|
|
@ -4,7 +4,7 @@ git-annex adjust - enter an adjusted branch
|
|||
|
||||
# SYNOPSIS
|
||||
|
||||
git annex adjust --unlock`
|
||||
git annex adjust --unlock|--fix`
|
||||
|
||||
# DESCRIPTION
|
||||
|
||||
|
@ -33,6 +33,13 @@ This command can only be used in a v6 git-annex repository.
|
|||
Unlock all annexed files in the adjusted branch. This allows
|
||||
annexed files to be modified.
|
||||
|
||||
* `--fix`
|
||||
|
||||
Fix the symlinks to annexed files to point to the local git annex
|
||||
object directory. This can be useful if a repository is checked out in an
|
||||
unusual way that prevents the symlinks committed to git from pointing at
|
||||
the annex objects.
|
||||
|
||||
# SEE ALSO
|
||||
|
||||
[[git-annex]](1)
|
||||
|
|
Loading…
Reference in a new issue