include adjustment in the adjusted branch name

Allows it to be recovered easily.
This commit is contained in:
Joey Hess 2016-02-29 15:04:03 -04:00
parent 3b4557c754
commit 9e1ebc2336
Failed to extract signature

View file

@ -5,7 +5,14 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Annex.AdjustedBranch where module Annex.AdjustedBranch (
Adjustment(..),
OrigBranch,
AdjBranch,
adjustedToOriginal,
enterAdjustedBranch,
updateAdjustedBranch,
) where
import Annex.Common import Annex.Common
import qualified Annex import qualified Annex
@ -38,22 +45,35 @@ type AdjBranch = Branch
adjustedBranchPrefix :: String adjustedBranchPrefix :: String
adjustedBranchPrefix = "refs/heads/adjusted/" adjustedBranchPrefix = "refs/heads/adjusted/"
originalToAdjusted :: OrigBranch -> AdjBranch serialize :: Adjustment -> String
originalToAdjusted orig = Ref $ adjustedBranchPrefix ++ takeFileName (fromRef orig) serialize UnlockAdjustment = "unlock"
adjustedToOriginal :: AdjBranch -> Maybe (OrigBranch) deserialize :: String -> Maybe Adjustment
deserialize "unlock" = Just UnlockAdjustment
deserialize _ = Nothing
originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
originalToAdjusted orig adj = Git.Ref.under base orig
where
base = adjustedBranchPrefix ++ serialize adj
adjustedToOriginal :: AdjBranch -> Maybe (Adjustment, OrigBranch)
adjustedToOriginal b adjustedToOriginal b
| adjustedBranchPrefix `isPrefixOf` bs = | adjustedBranchPrefix `isPrefixOf` bs = do
Just $ Ref $ drop prefixlen bs adj <- deserialize (takeWhile (/= '/') (drop prefixlen bs))
Just (adj, Git.Ref.basename b)
| otherwise = Nothing | otherwise = Nothing
where where
bs = fromRef b bs = fromRef b
prefixlen = length adjustedBranchPrefix prefixlen = length adjustedBranchPrefix
getAdjustment :: Annex (Maybe (Adjustment, OrigBranch))
getAdjustment = maybe Nothing adjustedToOriginal <$> inRepo Git.Branch.current
originalBranch :: Annex (Maybe OrigBranch) originalBranch :: Annex (Maybe OrigBranch)
originalBranch = fmap getorig <$> inRepo Git.Branch.current originalBranch = fmap getorig <$> inRepo Git.Branch.current
where where
getorig currbranch = fromMaybe currbranch (adjustedToOriginal currbranch) getorig currbranch = maybe currbranch snd (adjustedToOriginal currbranch)
{- Enter an adjusted version of current branch (or, if already in an {- Enter an adjusted version of current branch (or, if already in an
- adjusted version of a branch, changes the adjustment of the original - adjusted version of a branch, changes the adjustment of the original
@ -82,7 +102,7 @@ adjustBranch adj origbranch = do
inRepo $ Git.Branch.update adjbranch commitsha inRepo $ Git.Branch.update adjbranch commitsha
return adjbranch return adjbranch
where where
adjbranch = originalToAdjusted origbranch adjbranch = originalToAdjusted origbranch adj
{- Commits a given adjusted tree, with the provided parent ref. {- Commits a given adjusted tree, with the provided parent ref.
- -
@ -100,3 +120,9 @@ commitAdjustedTree treesha parent = go =<< catCommit parent
mkcommit mkcommit
mkcommit = Git.Branch.commitTree mkcommit = Git.Branch.commitTree
Git.Branch.AutomaticCommit "adjusted branch" [parent] treesha Git.Branch.AutomaticCommit "adjusted branch" [parent] treesha
{- Update the currently checked out adjusted branch, merging the provided
- branch into it. -}
updateAdjustedBranch :: Adjustment -> OrigBranch -> Branch -> Annex ()
updateAdjustedBranch mergebranch = do
error "updateAdjustedBranch"