diff options
author | 2016-03-03 16:19:09 -0400 | |
---|---|---|
committer | 2016-03-03 16:19:09 -0400 | |
commit | ce7e52101cda2715bc4ca0a758884d67fb40669e (patch) | |
tree | 50bc8d47e2c218783b555a896ddfd68b580fce10 /Annex/AdjustedBranch.hs | |
parent | 3d9a971e66e3485da1da7895c4003f044bee65fd (diff) |
working toward adjusted commit propigation
Diffstat (limited to 'Annex/AdjustedBranch.hs')
-rw-r--r-- | Annex/AdjustedBranch.hs | 107 |
1 files changed, 88 insertions, 19 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 |