a8dd85ea5a
This reverts commit cee12f6a2f.
This commit broke git-annex init run in a repo that was cloned from a
repo with an adjusted branch checked out.
The problem is that findAdjustingCommit was not able to identify the
commit that created the adjusted branch. It seems that there is an extra
"\n" at the end of the commit message that it does not expect.
Since backwards compatability needs to be maintained, cannot just make
findAdjustingCommit accept it with the "\n". Will have to instead
have one commitTree variant that uses the old method, and use it for
adjusted branch committing.
96 lines
3.5 KiB
Haskell
96 lines
3.5 KiB
Haskell
{- git-annex remote tracking branches
|
|
-
|
|
- Copyright 2019 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.RemoteTrackingBranch
|
|
( RemoteTrackingBranch
|
|
, mkRemoteTrackingBranch
|
|
, fromRemoteTrackingBranch
|
|
, setRemoteTrackingBranch
|
|
, makeRemoteTrackingBranchMergeCommit
|
|
, makeRemoteTrackingBranchMergeCommit'
|
|
, getRemoteTrackingBranchImportHistory
|
|
) where
|
|
|
|
import Annex.Common
|
|
import Annex.CatFile
|
|
import qualified Annex
|
|
import Git.Types
|
|
import qualified Git.Ref
|
|
import qualified Git.Branch
|
|
import Git.History
|
|
import qualified Types.Remote as Remote
|
|
|
|
import qualified Data.Set as S
|
|
|
|
newtype RemoteTrackingBranch = RemoteTrackingBranch
|
|
{ fromRemoteTrackingBranch :: Ref }
|
|
deriving (Show, Eq)
|
|
|
|
{- Makes a remote tracking branch corresponding to a local branch.
|
|
- Note that the local branch does not need to exist yet. -}
|
|
mkRemoteTrackingBranch :: Remote -> Branch -> RemoteTrackingBranch
|
|
mkRemoteTrackingBranch remote ref = RemoteTrackingBranch $
|
|
Git.Ref.underBase ("refs/remotes/" ++ Remote.name remote) ref
|
|
|
|
{- Set remote tracking branch to point to a commit. -}
|
|
setRemoteTrackingBranch :: RemoteTrackingBranch -> Sha -> Annex ()
|
|
setRemoteTrackingBranch tb commit =
|
|
inRepo $ Git.Branch.update' (fromRemoteTrackingBranch tb) commit
|
|
|
|
{- Makes a merge commit that preserves the import history of the
|
|
- RemoteTrackingBranch, while grafting new git history into it.
|
|
-
|
|
- The second parent of the merge commit is the past history of the
|
|
- RemoteTrackingBranch as imported from a remote. When importing a
|
|
- history of trees from a remote, commits can be sythesized from
|
|
- them, but such commits won't have the same sha due to eg date differing.
|
|
- But since we know that the second parent consists entirely of such
|
|
- import commits, they can be reused when updating the
|
|
- RemoteTrackingBranch.
|
|
-}
|
|
makeRemoteTrackingBranchMergeCommit :: RemoteTrackingBranch -> Sha -> Annex Sha
|
|
makeRemoteTrackingBranchMergeCommit tb commitsha =
|
|
-- Check if the tracking branch exists.
|
|
inRepo (Git.Ref.sha (fromRemoteTrackingBranch tb)) >>= \case
|
|
Nothing -> return commitsha
|
|
Just _ -> inRepo (getHistoryToDepth 1 (fromRemoteTrackingBranch tb)) >>= \case
|
|
Nothing -> return commitsha
|
|
Just (History hc _) -> case historyCommitParents hc of
|
|
[_, importhistory] -> do
|
|
treesha <- maybe
|
|
(giveup $ "Unable to cat commit " ++ fromRef commitsha)
|
|
commitTree
|
|
<$> catCommit commitsha
|
|
makeRemoteTrackingBranchMergeCommit' commitsha importhistory treesha
|
|
-- Earlier versions of git-annex did not
|
|
-- make the merge commit, or perhaps
|
|
-- something else changed where the
|
|
-- tracking branch pointed.
|
|
_ -> return commitsha
|
|
|
|
makeRemoteTrackingBranchMergeCommit' :: Sha -> Sha -> Sha -> Annex Sha
|
|
makeRemoteTrackingBranchMergeCommit' commitsha importedhistory treesha = do
|
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
|
inRepo $ Git.Branch.commitTree
|
|
cmode
|
|
"remote tracking branch"
|
|
[commitsha, importedhistory]
|
|
treesha
|
|
|
|
{- When makeRemoteTrackingBranchMergeCommit was used, this finds the
|
|
- import history, starting from the second parent of the merge commit.
|
|
-}
|
|
getRemoteTrackingBranchImportHistory :: History HistoryCommit -> Maybe (History HistoryCommit)
|
|
getRemoteTrackingBranchImportHistory (History hc s) =
|
|
case historyCommitParents hc of
|
|
[_, importhistory] -> go importhistory (S.toList s)
|
|
_ -> Nothing
|
|
where
|
|
go _ [] = Nothing
|
|
go i (h@(History hc' _):hs)
|
|
| historyCommit hc' == i = Just h
|
|
| otherwise = go i hs
|