diff options
author | 2016-03-03 16:19:09 -0400 | |
---|---|---|
committer | 2016-03-03 16:19:09 -0400 | |
commit | ce7e52101cda2715bc4ca0a758884d67fb40669e (patch) | |
tree | 50bc8d47e2c218783b555a896ddfd68b580fce10 | |
parent | 3d9a971e66e3485da1da7895c4003f044bee65fd (diff) |
working toward adjusted commit propigation
-rw-r--r-- | Annex/AdjustedBranch.hs | 107 | ||||
-rw-r--r-- | Command/Sync.hs | 15 | ||||
-rw-r--r-- | Git/Branch.hs | 20 | ||||
-rw-r--r-- | doc/design/adjusted_branches.mdwn | 2 |
4 files changed, 112 insertions, 32 deletions
diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 5762c6b30..30d4e7c09 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -9,6 +9,7 @@ module Annex.AdjustedBranch ( Adjustment(..), OrigBranch, AdjBranch, + originalToAdjusted, adjustedToOriginal, fromAdjustedBranch, enterAdjustedBranch, @@ -18,13 +19,16 @@ module Annex.AdjustedBranch ( import Annex.Common import qualified Annex +import Git import Git.Types import qualified Git.Branch import qualified Git.Ref import qualified Git.Command -import Git.Tree +import qualified Git.Tree +import Git.Tree (TreeItem(..)) import Git.Env import Git.Index +import Git.FilePath import qualified Git.LockFile import Annex.CatFile import Annex.Link @@ -35,8 +39,10 @@ import qualified Database.Keys data Adjustment = UnlockAdjustment deriving (Show) -adjustTreeItem :: Adjustment -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) -adjustTreeItem UnlockAdjustment h ti@(TreeItem f m s) +data Direction = Forward | Reverse + +adjustTreeItem :: Adjustment -> Direction -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) +adjustTreeItem UnlockAdjustment Forward h ti@(TreeItem f m s) | toBlobType m == Just SymlinkBlob = do mk <- catKey s case mk of @@ -46,6 +52,20 @@ adjustTreeItem UnlockAdjustment h ti@(TreeItem f m s) <$> hashPointerFile' h k Nothing -> return (Just ti) | otherwise = return (Just ti) +adjustTreeItem UnlockAdjustment Reverse h ti@(TreeItem f m s) + -- XXX does not remember when files were originally unlocked; locks + -- everything + | toBlobType m /= Just SymlinkBlob = do + mk <- catKey s + case mk of + Just k -> do + absf <- inRepo $ \r -> absPath $ + repoPath r <> fromTopFilePath f r + linktarget <- calcRepo $ gitAnnexLink absf k + Just . TreeItem f (fromBlobType SymlinkBlob) + <$> hashSymlink' h linktarget + Nothing -> return (Just ti) + | otherwise = return (Just ti) type OrigBranch = Branch type AdjBranch = Branch @@ -92,27 +112,33 @@ enterAdjustedBranch :: Adjustment -> Annex () enterAdjustedBranch adj = go =<< originalBranch where go (Just origbranch) = do - adjbranch <- preventCommits $ adjustBranch adj origbranch + adjbranch <- preventCommits $ adjustBranch adj Forward origbranch inRepo $ Git.Command.run [ Param "checkout" , Param $ fromRef $ Git.Ref.base $ adjbranch ] go Nothing = error "not on any branch!" -adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch -adjustBranch adj origbranch = do - sha <- adjust adj origbranch +adjustBranch :: Adjustment -> Direction -> OrigBranch -> Annex AdjBranch +adjustBranch adj direction origbranch = do + sha <- adjust adj direction origbranch inRepo $ Git.Branch.update adjbranch sha return adjbranch where adjbranch = originalToAdjusted origbranch adj -adjust :: Adjustment -> Ref -> Annex Sha -adjust adj orig = do +adjust :: Adjustment -> Direction -> Ref -> Annex Sha +adjust adj direction orig = do + treesha <- adjustTree adj direction orig + commitAdjustedTree treesha orig + +adjustTree :: Adjustment -> Direction -> Ref -> Annex Sha +adjustTree adj direction orig = do h <- inRepo hashObjectStart - treesha <- adjustTree (adjustTreeItem adj h) orig =<< Annex.gitRepo + treesha <- Git.Tree.adjustTree (adjustTreeItem adj direction h) orig + =<< Annex.gitRepo liftIO $ hashObjectStop h - commitAdjustedTree treesha orig + return treesha {- Locks git's index file, preventing git from making a commit, merge, - or otherwise changing the HEAD ref while the action is run. @@ -141,8 +167,11 @@ commitAdjustedTree treesha parent = go =<< catCommit parent (commitAuthorMetaData parentcommit) (commitCommitterMetaData parentcommit) mkcommit - mkcommit = Git.Branch.commitTree - Git.Branch.AutomaticCommit "adjusted branch" [parent] treesha + mkcommit = Git.Branch.commitTree Git.Branch.AutomaticCommit + adjustedBranchCommitMessage [parent] treesha + +adjustedBranchCommitMessage :: String +adjustedBranchCommitMessage = "git-annex adjusted branch" {- Update the currently checked out adjusted branch, merging the provided - branch into it. -} @@ -154,8 +183,8 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = where go (Just mergesha, Just currbranch) = ifM (inRepo $ Git.Branch.changed currbranch mergesha) ( do - propigateAdjustedCommits origbranch adj - adjustedtomerge <- adjust adj mergesha + propigateAdjustedCommits origbranch (adj, currbranch) + adjustedtomerge <- adjust adj Forward mergesha ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) ( ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode) ( recommit currbranch mergesha =<< catCommit currbranch @@ -176,11 +205,51 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = recommit currbranch parent (Just commit) = do commitsha <- commitAdjustedTree (commitTree commit) parent inRepo $ Git.Branch.update currbranch commitsha - propigateAdjustedCommits origbranch adj + propigateAdjustedCommits origbranch (adj, currbranch) return True recommit _ _ Nothing = return False {- Check for any commits present on the adjusted branch that have not yet - - been propigated to the orig branch, and propigate them. -} -propigateAdjustedCommits :: OrigBranch -> Adjustment -> Annex () -propigateAdjustedCommits originbranch adj = return () -- TODO + - been propigated to the orig branch, and propigate them. + - + - After propigating the commits back to the orig banch, + - rebase the adjusted branch on top of the updated orig branch. + -} +propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex () +propigateAdjustedCommits origbranch (adj, currbranch) = do + v <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads/" origbranch) + case v of + Just origsha -> go origsha False =<< newcommits + Nothing -> return () + where + newcommits = inRepo $ Git.Branch.changedCommits origbranch currbranch + -- Get commits oldest first, so they can be processed + -- in order made. + [Param "--reverse"] + go newhead _ [] = do + inRepo $ Git.Branch.update origbranch newhead + -- TODO rebase adjusted branch + go parent pastadjcommit (sha:l) = do + mc <- catCommit sha + case mc of + Just c + | commitMessage c == adjustedBranchCommitMessage -> + go parent True l + | pastadjcommit -> do + commit <- reverseAdjustedCommit parent adj c + go commit pastadjcommit l + _ -> go parent pastadjcommit l + +{- Reverses an adjusted commit, yielding a commit sha. + - + - Note that the commit message, and the author and committer metadata are + - copied over. However, any gpg signature will be lost, and any other + - headers are not copied either. -} +reverseAdjustedCommit :: Sha -> Adjustment -> Commit -> Annex Sha +reverseAdjustedCommit parent adj c = do + treesha <- adjustTree adj Reverse (commitTree c) + inRepo $ commitWithMetaData + (commitAuthorMetaData c) + (commitCommitterMetaData c) $ + Git.Branch.commitTree Git.Branch.AutomaticCommit + (commitMessage c) [parent] treesha diff --git a/Command/Sync.hs b/Command/Sync.hs index 355f71d1d..e6a8373ce 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -267,21 +267,20 @@ pushLocal b = do updateSyncBranch :: CurrBranch -> Annex () updateSyncBranch (Nothing, _) = noop -updateSyncBranch (Just branch, _) = do +updateSyncBranch (Just branch, madj) = do -- When in an adjusted branch, propigate any changes to it back to -- the original branch. - branch' <- case adjustedToOriginal branch of - Just (adj, origbranch) -> do - propigateAdjustedCommits origbranch adj - return origbranch - Nothing -> return branch + case madj of + Just adj -> propigateAdjustedCommits branch + (adj, originalToAdjusted branch adj) + Nothing -> return () -- Update the sync branch to match the new state of the branch - inRepo $ updateBranch (syncBranch branch') branch' + inRepo $ updateBranch (syncBranch branch) branch -- In direct mode, we're operating on some special direct mode -- branch, rather than the intended branch, so update the intended -- branch. whenM isDirect $ - inRepo $ updateBranch (fromDirectBranch branch') branch' + inRepo $ updateBranch (fromDirectBranch branch) branch updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO () updateBranch syncbranch updateto g = diff --git a/Git/Branch.hs b/Git/Branch.hs index ff209d44d..a0c15d171 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -48,15 +48,25 @@ currentUnsafe r = parse . firstLine changed :: Branch -> Branch -> Repo -> IO Bool changed origbranch newbranch repo | origbranch == newbranch = return False - | otherwise = not . null <$> diffs + | otherwise = not . null + <$> changed' origbranch newbranch [Param "-n1"] repo where - diffs = pipeReadStrict + +changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO String +changed' origbranch newbranch extraps repo = pipeReadStrict ps repo + where + ps = [ Param "log" , Param (fromRef origbranch ++ ".." ++ fromRef newbranch) - , Param "-n1" , Param "--pretty=%H" - ] repo - + ] ++ extraps + +{- Lists commits that are in the second branch and not in the first branch. -} +changedCommits :: Branch -> Branch -> [CommandParam] -> Repo -> IO [Sha] +changedCommits origbranch newbranch extraps repo = + catMaybes . map extractSha . lines + <$> changed' origbranch newbranch extraps repo + {- Check if it's possible to fast-forward from the old - ref to the new ref. - diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index 9213158f4..63af16972 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -351,3 +351,5 @@ like this, at its most simple: * Entering an adjusted branch can race with commits to the current branch, and so the assistant should not be running, or at least should have commits disabled when entering it. +* When the adjusted branch unlocks files, behave as if annex.addunlocked is + set, so git annex add will add files unlocked. |