add AdjBranch newtype; some simplications

This commit is contained in:
Joey Hess 2016-04-09 15:10:26 -04:00
parent 17acfe8032
commit 5e190913a4
Failed to extract signature
3 changed files with 42 additions and 45 deletions

View file

@ -10,7 +10,7 @@
module Annex.AdjustedBranch ( module Annex.AdjustedBranch (
Adjustment(..), Adjustment(..),
OrigBranch, OrigBranch,
AdjBranch, AdjBranch(..),
originalToAdjusted, originalToAdjusted,
adjustedToOriginal, adjustedToOriginal,
fromAdjustedBranch, fromAdjustedBranch,
@ -98,7 +98,7 @@ adjustTreeItem HideMissingAdjustment ti@(TreeItem _ _ s) = do
adjustTreeItem ShowMissingAdjustment ti = return (Just ti) adjustTreeItem ShowMissingAdjustment ti = return (Just ti)
type OrigBranch = Branch 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, -- 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 -- 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 -- The basis for refs/heads/adjusted/master(unlocked) is
-- refs/basis/adjusted/master(unlocked). -- refs/basis/adjusted/master(unlocked).
basisBranch :: AdjBranch -> BasisBranch basisBranch :: AdjBranch -> BasisBranch
basisBranch adjbranch = BasisBranch $ basisBranch (AdjBranch adjbranch) = BasisBranch $
Ref ("refs/basis/" ++ fromRef (Git.Ref.base adjbranch)) Ref ("refs/basis/" ++ fromRef (Git.Ref.base adjbranch))
adjustedBranchPrefix :: String adjustedBranchPrefix :: String
@ -127,12 +127,12 @@ deserialize "present" = Just HideMissingAdjustment
deserialize _ = Nothing deserialize _ = Nothing
originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
originalToAdjusted orig adj = Ref $ originalToAdjusted orig adj = AdjBranch $ Ref $
adjustedBranchPrefix ++ base ++ '(' : serialize adj ++ ")" adjustedBranchPrefix ++ base ++ '(' : serialize adj ++ ")"
where where
base = fromRef (Git.Ref.basename orig) base = fromRef (Git.Ref.basename orig)
adjustedToOriginal :: AdjBranch -> Maybe (Adjustment, OrigBranch) adjustedToOriginal :: Branch -> Maybe (Adjustment, OrigBranch)
adjustedToOriginal b adjustedToOriginal b
| adjustedBranchPrefix `isPrefixOf` bs = do | adjustedBranchPrefix `isPrefixOf` bs = do
let (base, as) = separate (== '(') (drop prefixlen bs) let (base, as) = separate (== '(') (drop prefixlen bs)
@ -146,7 +146,7 @@ adjustedToOriginal b
getAdjustment :: Branch -> Maybe Adjustment getAdjustment :: Branch -> Maybe Adjustment
getAdjustment = fmap fst . adjustedToOriginal getAdjustment = fmap fst . adjustedToOriginal
fromAdjustedBranch :: AdjBranch -> OrigBranch fromAdjustedBranch :: Branch -> OrigBranch
fromAdjustedBranch b = maybe b snd (adjustedToOriginal b) fromAdjustedBranch b = maybe b snd (adjustedToOriginal b)
originalBranch :: Annex (Maybe OrigBranch) originalBranch :: Annex (Maybe OrigBranch)
@ -163,12 +163,12 @@ enterAdjustedBranch :: Adjustment -> Annex ()
enterAdjustedBranch adj = go =<< originalBranch enterAdjustedBranch adj = go =<< originalBranch
where where
go (Just origbranch) = do go (Just origbranch) = do
adjbranch <- preventCommits $ const $ AdjBranch b <- preventCommits $ const $
adjustBranch adj origbranch adjustBranch adj origbranch
showOutput -- checkout can have output in large repos showOutput -- checkout can have output in large repos
inRepo $ Git.Command.run inRepo $ Git.Command.run
[ Param "checkout" [ Param "checkout"
, Param $ fromRef $ Git.Ref.base $ adjbranch , Param $ fromRef $ Git.Ref.base b
] ]
go Nothing = error "not on any branch!" go Nothing = error "not on any branch!"
@ -184,16 +184,19 @@ adjustToCrippledFileSystem = do
] ]
enterAdjustedBranch UnlockAdjustment enterAdjustedBranch UnlockAdjustment
updateBasisBranch :: BasisBranch -> Ref -> Annex () setBasisBranch :: BasisBranch -> Ref -> Annex ()
updateBasisBranch (BasisBranch basis) new = setBasisBranch (BasisBranch basis) new =
inRepo $ Git.Branch.update' 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 :: Adjustment -> OrigBranch -> Annex AdjBranch
adjustBranch adj origbranch = do adjustBranch adj origbranch = do
-- Start basis off with the current value of the origbranch. -- Start basis off with the current value of the origbranch.
updateBasisBranch basis origbranch setBasisBranch basis origbranch
sha <- adjustCommit adj basis sha <- adjustCommit adj basis
inRepo $ Git.Branch.update "entering adjusted branch" adjbranch sha setAdjustedBranch "entering adjusted branch" adjbranch sha
return adjbranch return adjbranch
where where
adjbranch = originalToAdjusted origbranch adj adjbranch = originalToAdjusted origbranch adj
@ -255,22 +258,19 @@ adjustedBranchCommitMessage = "git-annex adjusted branch"
- branch. -} - branch. -}
updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool
updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
join $ preventCommits $ \commitsprevented -> join $ preventCommits go
go commitsprevented =<< inRepo Git.Branch.current
where where
adjbranch = originalToAdjusted origbranch adj adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj
basis = basisBranch adjbranch basis = basisBranch adjbranch
go commitsprevented (Just currbranch) = go commitsprevented =
ifM (inRepo $ Git.Branch.changed currbranch tomerge) ifM (inRepo $ Git.Branch.changed currbranch tomerge)
( do ( do
(updatedorig, _) <- propigateAdjustedCommits' (updatedorig, _) <- propigateAdjustedCommits'
origbranch (adj, currbranch) origbranch adj commitsprevented
commitsprevented changestomerge updatedorig
changestomerge updatedorig currbranch
, nochangestomerge , nochangestomerge
) )
go _ _ = return $ return False
nochangestomerge = return $ return True 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 - (Doing the merge this way also lets it run even though the main
- index file is currently locked.) - index file is currently locked.)
-} -}
changestomerge (Just updatedorig) currbranch = do changestomerge (Just updatedorig) = do
misctmpdir <- fromRepo gitAnnexTmpMiscDir misctmpdir <- fromRepo gitAnnexTmpMiscDir
void $ createAnnexDirectory misctmpdir void $ createAnnexDirectory misctmpdir
tmpwt <- fromRepo gitAnnexMergeDir tmpwt <- fromRepo gitAnnexMergeDir
@ -306,9 +306,9 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
then do then do
!mergecommit <- liftIO $ extractSha <$> readFile (tmpgit </> "HEAD") !mergecommit <- liftIO $ extractSha <$> readFile (tmpgit </> "HEAD")
-- This is run after the commit lock is dropped. -- This is run after the commit lock is dropped.
return $ postmerge currbranch mergecommit return $ postmerge mergecommit
else return $ return False else return $ return False
changestomerge Nothing _ = return $ return False changestomerge Nothing = return $ return False
withemptydir d a = bracketIO setup cleanup (const a) withemptydir d a = bracketIO setup cleanup (const a)
where where
@ -327,8 +327,8 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
- so the check out is done by making a normal merge of - so the check out is done by making a normal merge of
- the new adjusted branch. - the new adjusted branch.
-} -}
postmerge currbranch (Just mergecommit) = do postmerge (Just mergecommit) = do
updateBasisBranch basis mergecommit setBasisBranch basis mergecommit
inRepo $ Git.Branch.update' origbranch mergecommit inRepo $ Git.Branch.update' origbranch mergecommit
adjtree <- adjustTree adj (BasisBranch mergecommit) adjtree <- adjustTree adj (BasisBranch mergecommit)
adjmergecommit <- commitAdjustedTree adjtree (BasisBranch mergecommit) adjmergecommit <- commitAdjustedTree adjtree (BasisBranch mergecommit)
@ -337,25 +337,25 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch] adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch]
showAction "Merging into adjusted branch" showAction "Merging into adjusted branch"
ifM (autoMergeFrom adjmergecommitff (Just currbranch) commitmode) ifM (autoMergeFrom adjmergecommitff (Just currbranch) commitmode)
( reparent currbranch adjtree adjmergecommit =<< getcurrentcommit ( reparent adjtree adjmergecommit =<< getcurrentcommit
, return False , return False
) )
postmerge _ Nothing = return False postmerge Nothing = return False
-- Now that the merge into the adjusted branch is complete, -- Now that the merge into the adjusted branch is complete,
-- take the tree from that merge, and attach it on top of the -- take the tree from that merge, and attach it on top of the
-- adjmergecommit, if it's different. -- adjmergecommit, if it's different.
reparent currbranch adjtree adjmergecommit (Just currentcommit) = do reparent adjtree adjmergecommit (Just currentcommit) = do
if (commitTree currentcommit /= adjtree) if (commitTree currentcommit /= adjtree)
then do then do
c <- inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit c <- inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit
("Merged " ++ fromRef tomerge) [adjmergecommit] ("Merged " ++ fromRef tomerge) [adjmergecommit]
(commitTree currentcommit) (commitTree currentcommit)
inRepo $ Git.Branch.update "updating adjusted branch" currbranch c 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 else inRepo $ Git.Branch.update "updating adjusted branch" currbranch adjmergecommit
return True return True
reparent _ _ _ Nothing = return False reparent _ _ Nothing = return False
getcurrentcommit = do getcurrentcommit = do
v <- inRepo Git.Branch.currentUnsafe v <- inRepo Git.Branch.currentUnsafe
@ -370,19 +370,19 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
- After propigating the commits back to the basis banch, - After propigating the commits back to the basis banch,
- rebase the adjusted branch on top of the updated basis branch. - rebase the adjusted branch on top of the updated basis branch.
-} -}
propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex () propigateAdjustedCommits :: OrigBranch -> Adjustment -> Annex ()
propigateAdjustedCommits origbranch (adj, currbranch) = propigateAdjustedCommits origbranch adj =
preventCommits $ \commitsprevented -> 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 {- Returns sha of updated basis branch, and action which will rebase
- the adjusted branch on top of the updated basis branch. -} - the adjusted branch on top of the updated basis branch. -}
propigateAdjustedCommits' propigateAdjustedCommits'
:: OrigBranch :: OrigBranch
-> (Adjustment, AdjBranch) -> Adjustment
-> CommitsPrevented -> CommitsPrevented
-> Annex (Maybe Sha, Annex ()) -> Annex (Maybe Sha, Annex ())
propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do propigateAdjustedCommits' origbranch adj _commitsprevented = do
ov <- inRepo $ Git.Ref.sha basis ov <- inRepo $ Git.Ref.sha basis
case ov of case ov of
Just origsha -> do Just origsha -> do
@ -402,13 +402,13 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do
Nothing -> return (Nothing, return ()) Nothing -> return (Nothing, return ())
where where
(BasisBranch basis) = basisBranch adjbranch (BasisBranch basis) = basisBranch adjbranch
adjbranch = originalToAdjusted origbranch adj adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj
newcommits = inRepo $ Git.Branch.changedCommits basis currbranch newcommits = inRepo $ Git.Branch.changedCommits basis currbranch
-- Get commits oldest first, so they can be processed -- Get commits oldest first, so they can be processed
-- in order made. -- in order made.
[Param "--reverse"] [Param "--reverse"]
go parent _ [] = do go parent _ [] = do
updateBasisBranch (BasisBranch basis) parent setBasisBranch (BasisBranch basis) parent
inRepo $ Git.Branch.update' origbranch parent inRepo $ Git.Branch.update' origbranch parent
return (Right parent) return (Right parent)
go parent pastadjcommit (sha:l) = do 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 remotebranch = Git.Ref.underBase "refs/remotes/origin" origbranch
let basis@(BasisBranch bb) = basisBranch (originalToAdjusted origbranch adj) let basis@(BasisBranch bb) = basisBranch (originalToAdjusted origbranch adj)
unlessM (inRepo $ Git.Ref.exists bb) $ unlessM (inRepo $ Git.Ref.exists bb) $
updateBasisBranch basis remotebranch setBasisBranch basis remotebranch
unlessM (inRepo $ Git.Ref.exists origbranch) $ unlessM (inRepo $ Git.Ref.exists origbranch) $
inRepo $ Git.Branch.update' origbranch remotebranch inRepo $ Git.Branch.update' origbranch remotebranch

View file

@ -258,7 +258,7 @@ mergeLocal currbranch@(Just branch, madj) = go =<< needmerge
go True = do go True = do
showStart "merge" $ Git.Ref.describe syncbranch showStart "merge" $ Git.Ref.describe syncbranch
next $ next $ merge currbranch Git.Branch.ManualCommit 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 mergeLocal (Nothing, _) = stop
pushLocal :: CurrBranch -> CommandStart pushLocal :: CurrBranch -> CommandStart
@ -271,10 +271,7 @@ updateSyncBranch (Nothing, _) = noop
updateSyncBranch (Just branch, madj) = do updateSyncBranch (Just branch, madj) = do
-- When in an adjusted branch, propigate any changes made to it -- When in an adjusted branch, propigate any changes made to it
-- back to the original branch. -- back to the original branch.
case madj of maybe noop (propigateAdjustedCommits branch) madj
Just adj -> propigateAdjustedCommits branch
(adj, originalToAdjusted branch adj)
Nothing -> return ()
-- Update the sync branch to match the new state of the branch -- 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 -- In direct mode, we're operating on some special direct mode

View file

@ -54,12 +54,12 @@ upgrade automatic = do
{- Create adjusted branch where all files are unlocked. {- Create adjusted branch where all files are unlocked.
- This should have the same content for each file as - This should have the same content for each file as
- have been staged in upgradeDirectWorkTree. -} - have been staged in upgradeDirectWorkTree. -}
adjbranch <- adjustBranch UnlockAdjustment cur AdjBranch b <- adjustBranch UnlockAdjustment cur
{- Since the work tree was already set up by {- Since the work tree was already set up by
- upgradeDirectWorkTree, and contains unlocked file - upgradeDirectWorkTree, and contains unlocked file
- contents too, don't use git checkout to check out the - contents too, don't use git checkout to check out the
- adjust branch. Instead, update HEAD manually. -} - adjust branch. Instead, update HEAD manually. -}
inRepo $ setHeadRef adjbranch inRepo $ setHeadRef b
configureSmudgeFilter configureSmudgeFilter
-- Inode sentinal file was only used in direct mode and when -- Inode sentinal file was only used in direct mode and when
-- locking down files as they were added. In v6, it's used more -- locking down files as they were added. In v6, it's used more