c98fb0b637
Seems unlikely to be very useful, but trivial. And, this completes the story that git-annex sync does not need json, since every sub-operation is available in a command that does support json. (Well, except for committing, but that's not a git-annex command.) Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project
68 lines
1.9 KiB
Haskell
68 lines
1.9 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2011-2021 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Merge where
|
|
|
|
import Command
|
|
import qualified Annex.Branch
|
|
import qualified Git
|
|
import qualified Git.Branch
|
|
import Annex.CurrentBranch
|
|
import Command.Sync (prepMerge, mergeLocal, mergeConfig, merge, notOnlyAnnexOption, parseUnrelatedHistoriesOption)
|
|
import Git.Types
|
|
|
|
cmd :: Command
|
|
cmd = withAnnexOptions [jsonOptions] $
|
|
command "merge" SectionMaintenance
|
|
"merge changes from remotes"
|
|
(paramOptional paramRef) (seek <$$> optParser)
|
|
|
|
data MergeOptions = MergeOptions
|
|
{ mergeBranches :: [String]
|
|
, allowUnrelatedHistories :: Bool
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser MergeOptions
|
|
optParser desc = MergeOptions
|
|
<$> cmdParams desc
|
|
<*> parseUnrelatedHistoriesOption
|
|
|
|
seek :: MergeOptions -> CommandSeek
|
|
seek o
|
|
| mergeBranches o == [] = do
|
|
prepMerge
|
|
commandAction mergeAnnexBranch
|
|
commandAction (mergeSyncedBranch o)
|
|
| otherwise = do
|
|
prepMerge
|
|
forM_ (mergeBranches o) $
|
|
commandAction . mergeBranch o . Git.Ref . encodeBS
|
|
|
|
mergeAnnexBranch :: CommandStart
|
|
mergeAnnexBranch = starting "merge" ai si $ do
|
|
_ <- Annex.Branch.update
|
|
-- commit explicitly, in case no remote branches were merged
|
|
Annex.Branch.commit =<< Annex.Branch.commitMessage
|
|
next $ return True
|
|
where
|
|
ai = ActionItemOther (Just (UnquotedString (fromRef Annex.Branch.name)))
|
|
si = SeekInput []
|
|
|
|
mergeSyncedBranch :: MergeOptions -> CommandStart
|
|
mergeSyncedBranch o = do
|
|
mc <- mergeConfig (allowUnrelatedHistories o)
|
|
mergeLocal mc def =<< getCurrentBranch
|
|
|
|
mergeBranch :: MergeOptions -> Git.Ref -> CommandStart
|
|
mergeBranch o r = starting "merge" ai si $ do
|
|
currbranch <- getCurrentBranch
|
|
mc <- mergeConfig (allowUnrelatedHistories o)
|
|
let so = def { notOnlyAnnexOption = True }
|
|
next $ merge currbranch mc so Git.Branch.ManualCommit r
|
|
where
|
|
ai = ActionItemOther (Just (UnquotedString (Git.fromRef r)))
|
|
si = SeekInput []
|