add AdjBranch newtype; some simplications
This commit is contained in:
parent
17acfe8032
commit
5e190913a4
3 changed files with 42 additions and 45 deletions
|
@ -10,7 +10,7 @@
|
|||
module Annex.AdjustedBranch (
|
||||
Adjustment(..),
|
||||
OrigBranch,
|
||||
AdjBranch,
|
||||
AdjBranch(..),
|
||||
originalToAdjusted,
|
||||
adjustedToOriginal,
|
||||
fromAdjustedBranch,
|
||||
|
@ -98,7 +98,7 @@ adjustTreeItem HideMissingAdjustment ti@(TreeItem _ _ s) = do
|
|||
adjustTreeItem ShowMissingAdjustment ti = return (Just ti)
|
||||
|
||||
type OrigBranch = Branch
|
||||
type AdjBranch = Branch
|
||||
newtype AdjBranch = AdjBranch { adjBranch :: Branch }
|
||||
|
||||
-- This is a hidden branch ref, that's used as the basis for the AdjBranch,
|
||||
-- since pushes can overwrite the OrigBranch at any time. So, changes
|
||||
|
@ -108,7 +108,7 @@ newtype BasisBranch = BasisBranch Ref
|
|||
-- The basis for refs/heads/adjusted/master(unlocked) is
|
||||
-- refs/basis/adjusted/master(unlocked).
|
||||
basisBranch :: AdjBranch -> BasisBranch
|
||||
basisBranch adjbranch = BasisBranch $
|
||||
basisBranch (AdjBranch adjbranch) = BasisBranch $
|
||||
Ref ("refs/basis/" ++ fromRef (Git.Ref.base adjbranch))
|
||||
|
||||
adjustedBranchPrefix :: String
|
||||
|
@ -127,12 +127,12 @@ deserialize "present" = Just HideMissingAdjustment
|
|||
deserialize _ = Nothing
|
||||
|
||||
originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
|
||||
originalToAdjusted orig adj = Ref $
|
||||
originalToAdjusted orig adj = AdjBranch $ Ref $
|
||||
adjustedBranchPrefix ++ base ++ '(' : serialize adj ++ ")"
|
||||
where
|
||||
base = fromRef (Git.Ref.basename orig)
|
||||
|
||||
adjustedToOriginal :: AdjBranch -> Maybe (Adjustment, OrigBranch)
|
||||
adjustedToOriginal :: Branch -> Maybe (Adjustment, OrigBranch)
|
||||
adjustedToOriginal b
|
||||
| adjustedBranchPrefix `isPrefixOf` bs = do
|
||||
let (base, as) = separate (== '(') (drop prefixlen bs)
|
||||
|
@ -146,7 +146,7 @@ adjustedToOriginal b
|
|||
getAdjustment :: Branch -> Maybe Adjustment
|
||||
getAdjustment = fmap fst . adjustedToOriginal
|
||||
|
||||
fromAdjustedBranch :: AdjBranch -> OrigBranch
|
||||
fromAdjustedBranch :: Branch -> OrigBranch
|
||||
fromAdjustedBranch b = maybe b snd (adjustedToOriginal b)
|
||||
|
||||
originalBranch :: Annex (Maybe OrigBranch)
|
||||
|
@ -163,12 +163,12 @@ enterAdjustedBranch :: Adjustment -> Annex ()
|
|||
enterAdjustedBranch adj = go =<< originalBranch
|
||||
where
|
||||
go (Just origbranch) = do
|
||||
adjbranch <- preventCommits $ const $
|
||||
AdjBranch b <- preventCommits $ const $
|
||||
adjustBranch adj origbranch
|
||||
showOutput -- checkout can have output in large repos
|
||||
inRepo $ Git.Command.run
|
||||
[ Param "checkout"
|
||||
, Param $ fromRef $ Git.Ref.base $ adjbranch
|
||||
, Param $ fromRef $ Git.Ref.base b
|
||||
]
|
||||
go Nothing = error "not on any branch!"
|
||||
|
||||
|
@ -184,16 +184,19 @@ adjustToCrippledFileSystem = do
|
|||
]
|
||||
enterAdjustedBranch UnlockAdjustment
|
||||
|
||||
updateBasisBranch :: BasisBranch -> Ref -> Annex ()
|
||||
updateBasisBranch (BasisBranch basis) new =
|
||||
setBasisBranch :: BasisBranch -> Ref -> Annex ()
|
||||
setBasisBranch (BasisBranch basis) new =
|
||||
inRepo $ Git.Branch.update' basis new
|
||||
|
||||
setAdjustedBranch :: String -> AdjBranch -> Ref -> Annex ()
|
||||
setAdjustedBranch msg (AdjBranch b) r = inRepo $ Git.Branch.update msg b r
|
||||
|
||||
adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch
|
||||
adjustBranch adj origbranch = do
|
||||
-- Start basis off with the current value of the origbranch.
|
||||
updateBasisBranch basis origbranch
|
||||
setBasisBranch basis origbranch
|
||||
sha <- adjustCommit adj basis
|
||||
inRepo $ Git.Branch.update "entering adjusted branch" adjbranch sha
|
||||
setAdjustedBranch "entering adjusted branch" adjbranch sha
|
||||
return adjbranch
|
||||
where
|
||||
adjbranch = originalToAdjusted origbranch adj
|
||||
|
@ -255,22 +258,19 @@ adjustedBranchCommitMessage = "git-annex adjusted branch"
|
|||
- branch. -}
|
||||
updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool
|
||||
updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
|
||||
join $ preventCommits $ \commitsprevented ->
|
||||
go commitsprevented =<< inRepo Git.Branch.current
|
||||
join $ preventCommits go
|
||||
where
|
||||
adjbranch = originalToAdjusted origbranch adj
|
||||
adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj
|
||||
basis = basisBranch adjbranch
|
||||
|
||||
go commitsprevented (Just currbranch) =
|
||||
go commitsprevented =
|
||||
ifM (inRepo $ Git.Branch.changed currbranch tomerge)
|
||||
( do
|
||||
(updatedorig, _) <- propigateAdjustedCommits'
|
||||
origbranch (adj, currbranch)
|
||||
commitsprevented
|
||||
changestomerge updatedorig currbranch
|
||||
origbranch adj commitsprevented
|
||||
changestomerge updatedorig
|
||||
, nochangestomerge
|
||||
)
|
||||
go _ _ = return $ return False
|
||||
|
||||
nochangestomerge = return $ return True
|
||||
|
||||
|
@ -290,7 +290,7 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
|
|||
- (Doing the merge this way also lets it run even though the main
|
||||
- index file is currently locked.)
|
||||
-}
|
||||
changestomerge (Just updatedorig) currbranch = do
|
||||
changestomerge (Just updatedorig) = do
|
||||
misctmpdir <- fromRepo gitAnnexTmpMiscDir
|
||||
void $ createAnnexDirectory misctmpdir
|
||||
tmpwt <- fromRepo gitAnnexMergeDir
|
||||
|
@ -306,9 +306,9 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
|
|||
then do
|
||||
!mergecommit <- liftIO $ extractSha <$> readFile (tmpgit </> "HEAD")
|
||||
-- This is run after the commit lock is dropped.
|
||||
return $ postmerge currbranch mergecommit
|
||||
return $ postmerge mergecommit
|
||||
else return $ return False
|
||||
changestomerge Nothing _ = return $ return False
|
||||
changestomerge Nothing = return $ return False
|
||||
|
||||
withemptydir d a = bracketIO setup cleanup (const a)
|
||||
where
|
||||
|
@ -327,8 +327,8 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
|
|||
- so the check out is done by making a normal merge of
|
||||
- the new adjusted branch.
|
||||
-}
|
||||
postmerge currbranch (Just mergecommit) = do
|
||||
updateBasisBranch basis mergecommit
|
||||
postmerge (Just mergecommit) = do
|
||||
setBasisBranch basis mergecommit
|
||||
inRepo $ Git.Branch.update' origbranch mergecommit
|
||||
adjtree <- adjustTree adj (BasisBranch mergecommit)
|
||||
adjmergecommit <- commitAdjustedTree adjtree (BasisBranch mergecommit)
|
||||
|
@ -337,25 +337,25 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
|
|||
adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch]
|
||||
showAction "Merging into adjusted branch"
|
||||
ifM (autoMergeFrom adjmergecommitff (Just currbranch) commitmode)
|
||||
( reparent currbranch adjtree adjmergecommit =<< getcurrentcommit
|
||||
( reparent adjtree adjmergecommit =<< getcurrentcommit
|
||||
, return False
|
||||
)
|
||||
postmerge _ Nothing = return False
|
||||
postmerge Nothing = return False
|
||||
|
||||
-- Now that the merge into the adjusted branch is complete,
|
||||
-- take the tree from that merge, and attach it on top of the
|
||||
-- adjmergecommit, if it's different.
|
||||
reparent currbranch adjtree adjmergecommit (Just currentcommit) = do
|
||||
reparent adjtree adjmergecommit (Just currentcommit) = do
|
||||
if (commitTree currentcommit /= adjtree)
|
||||
then do
|
||||
c <- inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit
|
||||
("Merged " ++ fromRef tomerge) [adjmergecommit]
|
||||
(commitTree currentcommit)
|
||||
inRepo $ Git.Branch.update "updating adjusted branch" currbranch c
|
||||
propigateAdjustedCommits origbranch (adj, currbranch)
|
||||
propigateAdjustedCommits origbranch adj
|
||||
else inRepo $ Git.Branch.update "updating adjusted branch" currbranch adjmergecommit
|
||||
return True
|
||||
reparent _ _ _ Nothing = return False
|
||||
reparent _ _ Nothing = return False
|
||||
|
||||
getcurrentcommit = do
|
||||
v <- inRepo Git.Branch.currentUnsafe
|
||||
|
@ -370,19 +370,19 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
|
|||
- After propigating the commits back to the basis banch,
|
||||
- rebase the adjusted branch on top of the updated basis branch.
|
||||
-}
|
||||
propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex ()
|
||||
propigateAdjustedCommits origbranch (adj, currbranch) =
|
||||
propigateAdjustedCommits :: OrigBranch -> Adjustment -> Annex ()
|
||||
propigateAdjustedCommits origbranch adj =
|
||||
preventCommits $ \commitsprevented ->
|
||||
join $ snd <$> propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented
|
||||
join $ snd <$> propigateAdjustedCommits' origbranch adj commitsprevented
|
||||
|
||||
{- Returns sha of updated basis branch, and action which will rebase
|
||||
- the adjusted branch on top of the updated basis branch. -}
|
||||
propigateAdjustedCommits'
|
||||
:: OrigBranch
|
||||
-> (Adjustment, AdjBranch)
|
||||
-> Adjustment
|
||||
-> CommitsPrevented
|
||||
-> Annex (Maybe Sha, Annex ())
|
||||
propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do
|
||||
propigateAdjustedCommits' origbranch adj _commitsprevented = do
|
||||
ov <- inRepo $ Git.Ref.sha basis
|
||||
case ov of
|
||||
Just origsha -> do
|
||||
|
@ -402,13 +402,13 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do
|
|||
Nothing -> return (Nothing, return ())
|
||||
where
|
||||
(BasisBranch basis) = basisBranch adjbranch
|
||||
adjbranch = originalToAdjusted origbranch adj
|
||||
adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj
|
||||
newcommits = inRepo $ Git.Branch.changedCommits basis currbranch
|
||||
-- Get commits oldest first, so they can be processed
|
||||
-- in order made.
|
||||
[Param "--reverse"]
|
||||
go parent _ [] = do
|
||||
updateBasisBranch (BasisBranch basis) parent
|
||||
setBasisBranch (BasisBranch basis) parent
|
||||
inRepo $ Git.Branch.update' origbranch parent
|
||||
return (Right parent)
|
||||
go parent pastadjcommit (sha:l) = do
|
||||
|
@ -504,6 +504,6 @@ checkAdjustedClone = go =<< inRepo Git.Branch.current
|
|||
let remotebranch = Git.Ref.underBase "refs/remotes/origin" origbranch
|
||||
let basis@(BasisBranch bb) = basisBranch (originalToAdjusted origbranch adj)
|
||||
unlessM (inRepo $ Git.Ref.exists bb) $
|
||||
updateBasisBranch basis remotebranch
|
||||
setBasisBranch basis remotebranch
|
||||
unlessM (inRepo $ Git.Ref.exists origbranch) $
|
||||
inRepo $ Git.Branch.update' origbranch remotebranch
|
||||
|
|
|
@ -258,7 +258,7 @@ mergeLocal currbranch@(Just branch, madj) = go =<< needmerge
|
|||
go True = do
|
||||
showStart "merge" $ Git.Ref.describe syncbranch
|
||||
next $ next $ merge currbranch Git.Branch.ManualCommit syncbranch
|
||||
branch' = maybe branch (originalToAdjusted branch) madj
|
||||
branch' = maybe branch (adjBranch . originalToAdjusted branch) madj
|
||||
mergeLocal (Nothing, _) = stop
|
||||
|
||||
pushLocal :: CurrBranch -> CommandStart
|
||||
|
@ -271,10 +271,7 @@ updateSyncBranch (Nothing, _) = noop
|
|||
updateSyncBranch (Just branch, madj) = do
|
||||
-- When in an adjusted branch, propigate any changes made to it
|
||||
-- back to the original branch.
|
||||
case madj of
|
||||
Just adj -> propigateAdjustedCommits branch
|
||||
(adj, originalToAdjusted branch adj)
|
||||
Nothing -> return ()
|
||||
maybe noop (propigateAdjustedCommits branch) madj
|
||||
-- Update the sync branch to match the new state of the branch
|
||||
inRepo $ updateBranch (syncBranch branch) branch
|
||||
-- In direct mode, we're operating on some special direct mode
|
||||
|
|
|
@ -54,12 +54,12 @@ upgrade automatic = do
|
|||
{- Create adjusted branch where all files are unlocked.
|
||||
- This should have the same content for each file as
|
||||
- have been staged in upgradeDirectWorkTree. -}
|
||||
adjbranch <- adjustBranch UnlockAdjustment cur
|
||||
AdjBranch b <- adjustBranch UnlockAdjustment cur
|
||||
{- Since the work tree was already set up by
|
||||
- upgradeDirectWorkTree, and contains unlocked file
|
||||
- contents too, don't use git checkout to check out the
|
||||
- adjust branch. Instead, update HEAD manually. -}
|
||||
inRepo $ setHeadRef adjbranch
|
||||
inRepo $ setHeadRef b
|
||||
configureSmudgeFilter
|
||||
-- Inode sentinal file was only used in direct mode and when
|
||||
-- locking down files as they were added. In v6, it's used more
|
||||
|
|
Loading…
Add table
Reference in a new issue