diff options
author | 2016-03-11 16:00:14 -0400 | |
---|---|---|
committer | 2016-03-11 16:05:06 -0400 | |
commit | 92e8a321090bb45e0ae37e4298160f56652b1f1f (patch) | |
tree | d59562279f36267414cdd63d756ce74caeeb15e6 /Annex/AdjustedBranch.hs | |
parent | e082d72b6a1afa651ddb5384f0b768ed26298536 (diff) |
improve propigation of commits from adjusted branches
Only reverse adjust the changes in the commit, which means that adjustments
do not need to be generally cleanly reversable.
For example, an adjustment can unlock all locked files, but does not need
to worry about files that were originally unlocked when reversing, because
it will only ever be run on files that have been changed. So, it's ok
if it locks all files when reversed, or even leaves all files as-is when
reversed.
Diffstat (limited to 'Annex/AdjustedBranch.hs')
-rw-r--r-- | Annex/AdjustedBranch.hs | 150 |
1 files changed, 101 insertions, 49 deletions
diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 208b976cd..ce565a754 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -1,4 +1,4 @@ -{- adjusted version of main branch +{- adjusted branch - - Copyright 2016 Joey Hess <id@joeyh.name> - @@ -25,7 +25,9 @@ import qualified Git.Branch import qualified Git.Ref import qualified Git.Command import qualified Git.Tree +import qualified Git.DiffTree import Git.Tree (TreeItem(..)) +import Git.Sha import Git.Env import Git.Index import Git.FilePath @@ -36,11 +38,14 @@ import Git.HashObject import Annex.AutoMerge import qualified Database.Keys +import qualified Data.Map as M + data Adjustment = UnlockAdjustment deriving (Show) data Direction = Forward | Reverse +{- How to perform various adjustments to a TreeItem. -} adjustTreeItem :: Adjustment -> Direction -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) adjustTreeItem UnlockAdjustment Forward h ti@(TreeItem f m s) | toBlobType m == Just SymlinkBlob = do @@ -53,8 +58,6 @@ adjustTreeItem UnlockAdjustment Forward h ti@(TreeItem f m s) 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 @@ -114,7 +117,8 @@ enterAdjustedBranch :: Adjustment -> Annex () enterAdjustedBranch adj = go =<< originalBranch where go (Just origbranch) = do - adjbranch <- preventCommits $ adjustBranch adj Forward origbranch + adjbranch <- preventCommits $ const $ + adjustBranch adj Forward origbranch inRepo $ Git.Command.run [ Param "checkout" , Param $ fromRef $ Git.Ref.base $ adjbranch @@ -137,23 +141,25 @@ adjust adj direction orig = do adjustTree :: Adjustment -> Direction -> Ref -> Annex Sha adjustTree adj direction orig = do h <- inRepo hashObjectStart - treesha <- Git.Tree.adjustTree (adjustTreeItem adj direction h) orig - =<< Annex.gitRepo + let toadj = adjustTreeItem adj direction h + treesha <- Git.Tree.adjustTree toadj [] orig =<< Annex.gitRepo liftIO $ hashObjectStop h return treesha +type CommitsPrevented = Git.LockFile.LockHandle + {- Locks git's index file, preventing git from making a commit, merge, - or otherwise changing the HEAD ref while the action is run. - - Throws an IO exception if the index file is already locked. -} -preventCommits :: Annex a -> Annex a -preventCommits = bracket setup cleanup . const +preventCommits :: (CommitsPrevented -> Annex a) -> Annex a +preventCommits = bracket setup cleanup where setup = do lck <- fromRepo indexFileLock liftIO $ Git.LockFile.openLock lck - cleanup lckhandle = liftIO $ Git.LockFile.closeLock lckhandle + cleanup = liftIO . Git.LockFile.closeLock {- Commits a given adjusted tree, with the provided parent ref. - @@ -178,25 +184,29 @@ adjustedBranchCommitMessage = "git-annex adjusted branch" {- Update the currently checked out adjusted branch, merging the provided - branch into it. -} updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool -updateAdjustedBranch tomerge (origbranch, adj) commitmode = - catchBoolIO $ preventCommits $ go =<< (,) +updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ do + preventCommits $ \commitsprevented -> go commitsprevented =<< (,) <$> inRepo (Git.Ref.sha tomerge) <*> inRepo Git.Branch.current where - go (Just mergesha, Just currbranch) = ifM (inRepo $ Git.Branch.changed currbranch mergesha) - ( do - 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 - , return False + go commitsprevented (Just mergesha, Just currbranch) = + ifM (inRepo $ Git.Branch.changed currbranch mergesha) + ( do + propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented + adjustedtomerge <- adjust adj Forward mergesha + ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) + ( do + liftIO $ Git.LockFile.closeLock commitsprevented + ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode) + ( preventCommits $ \commitsprevented' -> + recommit commitsprevented' currbranch mergesha =<< catCommit currbranch + , return False + ) + , return True -- no changes to merge ) - , return True -- no changes to merge - ) - , return True -- no changes to merge - ) - go _ = return False + , return True -- no changes to merge + ) + go _ _ = return False {- Once a merge commit has been made, re-do it, removing - the old version of the adjusted branch as a parent, and - making the only parent be the branch that was merged in. @@ -204,12 +214,12 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = - Doing this ensures that the same commit Sha is - always arrived at for a given commit from the merged in branch. -} - recommit currbranch parent (Just commit) = do + recommit commitsprevented currbranch parent (Just commit) = do commitsha <- commitAdjustedTree (commitTree commit) parent inRepo $ Git.Branch.update currbranch commitsha - propigateAdjustedCommits origbranch (adj, currbranch) + propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented return True - recommit _ _ Nothing = return False + 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. @@ -218,16 +228,26 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = - rebase the adjusted branch on top of the updated orig branch. -} propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex () -propigateAdjustedCommits origbranch (adj, currbranch) = do +propigateAdjustedCommits origbranch (adj, currbranch) = + preventCommits $ propigateAdjustedCommits' origbranch (adj, currbranch) + +propigateAdjustedCommits' :: OrigBranch -> (Adjustment, AdjBranch) -> CommitsPrevented -> Annex () +propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do ov <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads" origbranch) case ov of - Just origsha -> preventCommits $ do + Just origsha -> do cv <- catCommit currbranch case cv of - Just currcommit -> - newcommits - >>= go origsha False - >>= rebase currcommit + Just currcommit -> do + h <- inRepo hashObjectStart + v <- newcommits >>= go h origsha False + liftIO $ hashObjectStop h + case v of + Left e -> do + warning e + return () + Right newparent -> + rebase currcommit newparent Nothing -> return () Nothing -> return () where @@ -235,19 +255,21 @@ propigateAdjustedCommits origbranch (adj, currbranch) = do -- Get commits oldest first, so they can be processed -- in order made. [Param "--reverse"] - go parent _ [] = do + go _ parent _ [] = do inRepo $ Git.Branch.update origbranch parent - return parent - go parent pastadjcommit (sha:l) = do + return (Right parent) + go h parent pastadjcommit (sha:l) = do mc <- catCommit sha case mc of Just c | commitMessage c == adjustedBranchCommitMessage -> - go parent True l + go h parent True l | pastadjcommit -> do - commit <- reverseAdjustedCommit parent adj c - go commit pastadjcommit l - _ -> go parent pastadjcommit l + v <- reverseAdjustedCommit h parent adj (sha, c) origbranch + case v of + Left e -> return (Left e) + Right commit -> go h commit pastadjcommit l + _ -> go h parent pastadjcommit l rebase currcommit newparent = do -- Reuse the current adjusted tree, -- and reparent it on top of the new @@ -255,16 +277,46 @@ propigateAdjustedCommits origbranch (adj, currbranch) = do commitAdjustedTree (commitTree currcommit) newparent >>= inRepo . Git.Branch.update currbranch -{- Reverses an adjusted commit, yielding a commit sha. +{- Reverses an adjusted commit, and commit on top of the provided newparent, + - yielding a commit sha. + - + - Adjust the tree of the newparent, changing only the files that the + - commit changed, and reverse adjusting those changes. - - 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 +reverseAdjustedCommit :: HashObjectHandle -> Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex (Either String Sha) +reverseAdjustedCommit h newparent adj (csha, c) origbranch + -- commitDiff does not support merge commits + | length (commitParent c) > 1 = return $ + Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch + | otherwise = do + (diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha) + let (adds, changes) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff + adds' <- catMaybes <$> + mapM (adjustTreeItem adj Reverse h) (map diffTreeToTreeItem adds) + treesha <- Git.Tree.adjustTree (propchanges changes) + adds' newparent + =<< Annex.gitRepo + void $ liftIO cleanup + revadjcommit <- inRepo $ commitWithMetaData + (commitAuthorMetaData c) + (commitCommitterMetaData c) $ + Git.Branch.commitTree Git.Branch.AutomaticCommit + (commitMessage c) [newparent] treesha + return (Right revadjcommit) + where + propchanges changes ti@(TreeItem f _ _) = + case M.lookup f m of + Nothing -> return (Just ti) -- not changed + Just change -> adjustTreeItem adj Reverse h change + where + m = M.fromList $ map (\i@(TreeItem f' _ _) -> (f', i)) $ + map diffTreeToTreeItem changes + +diffTreeToTreeItem :: Git.DiffTree.DiffTreeItem -> TreeItem +diffTreeToTreeItem dti = TreeItem + (Git.DiffTree.file dti) + (Git.DiffTree.dstmode dti) + (Git.DiffTree.dstsha dti) |