reorg
This commit is contained in:
parent
e4e464da65
commit
b6e2a5e9c2
1 changed files with 28 additions and 11 deletions
|
@ -107,7 +107,7 @@ seek o@(RemoteImportOptions {}) = do
|
||||||
(pure Nothing)
|
(pure Nothing)
|
||||||
(Just <$$> inRepo . toTopFilePath)
|
(Just <$$> inRepo . toTopFilePath)
|
||||||
(importToSubDir o)
|
(importToSubDir o)
|
||||||
commandAction $ startRemote r (importToBranch o) subdir
|
seekRemote r (importToBranch o) subdir
|
||||||
|
|
||||||
startLocal :: GetFileMatcher -> DuplicateMode -> (FilePath, FilePath) -> CommandStart
|
startLocal :: GetFileMatcher -> DuplicateMode -> (FilePath, FilePath) -> CommandStart
|
||||||
startLocal largematcher mode (srcfile, destfile) =
|
startLocal largematcher mode (srcfile, destfile) =
|
||||||
|
@ -243,9 +243,8 @@ verifyExisting key destfile (yes, no) = do
|
||||||
verifyEnoughCopiesToDrop [] key Nothing need [] preverified tocheck
|
verifyEnoughCopiesToDrop [] key Nothing need [] preverified tocheck
|
||||||
(const yes) no
|
(const yes) no
|
||||||
|
|
||||||
startRemote :: Remote -> Branch -> Maybe TopFilePath -> CommandStart
|
seekRemote :: Remote -> Branch -> Maybe TopFilePath -> CommandSeek
|
||||||
startRemote remote branch msubdir = do
|
seekRemote remote branch msubdir = allowConcurrentOutput $ do
|
||||||
showStart' "import" (Just (Remote.name remote))
|
|
||||||
importtreeconfig <- case msubdir of
|
importtreeconfig <- case msubdir of
|
||||||
Nothing -> return ImportTree
|
Nothing -> return ImportTree
|
||||||
Just subdir -> frombranch Git.Ref.tree >>= \case
|
Just subdir -> frombranch Git.Ref.tree >>= \case
|
||||||
|
@ -253,15 +252,14 @@ startRemote remote branch msubdir = do
|
||||||
Just tree -> pure $ ImportSubTree subdir tree
|
Just tree -> pure $ ImportSubTree subdir tree
|
||||||
parentcommit <- frombranch Git.Ref.sha
|
parentcommit <- frombranch Git.Ref.sha
|
||||||
let importcommitconfig = ImportCommitConfig parentcommit ManualCommit importmessage
|
let importcommitconfig = ImportCommitConfig parentcommit ManualCommit importmessage
|
||||||
|
|
||||||
|
showStart' "import" (Just (Remote.name remote))
|
||||||
-- TODO enumerate and download
|
-- TODO enumerate and download
|
||||||
let importable = ImportableContents [] []
|
let importable = ImportableContents [] []
|
||||||
importcommit <- buildImportCommit remote importtreeconfig importcommitconfig importable
|
showEndOk
|
||||||
-- Update the tracking branch. Done even when there is nothing new
|
|
||||||
-- to import, to make sure it exists.
|
void $ includeCommandAction $
|
||||||
inRepo $ Git.Branch.update importmessage (fromRemoteTrackingBranch tb) $
|
commitRemote remote branch tb parentcommit importtreeconfig importcommitconfig importable
|
||||||
fromMaybe (giveup $ "Nothing to import and " ++ fromRef branch ++ " does not exist.") $
|
|
||||||
importcommit <|> parentcommit
|
|
||||||
next stop
|
|
||||||
where
|
where
|
||||||
importmessage = "import from " ++ Remote.name remote
|
importmessage = "import from " ++ Remote.name remote
|
||||||
tb = mkRemoteTrackingBranch remote branch
|
tb = mkRemoteTrackingBranch remote branch
|
||||||
|
@ -270,3 +268,22 @@ startRemote remote branch msubdir = do
|
||||||
frombranch a = inRepo (a (fromRemoteTrackingBranch tb)) >>= \case
|
frombranch a = inRepo (a (fromRemoteTrackingBranch tb)) >>= \case
|
||||||
Just v -> return (Just v)
|
Just v -> return (Just v)
|
||||||
Nothing -> inRepo (a branch)
|
Nothing -> inRepo (a branch)
|
||||||
|
|
||||||
|
commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> ImportableContents Key -> CommandStart
|
||||||
|
commitRemote remote branch tb parentcommit importtreeconfig importcommitconfig importable = do
|
||||||
|
showStart' "update" (Just $ fromRef $ fromRemoteTrackingBranch tb)
|
||||||
|
next $ do
|
||||||
|
importcommit <- buildImportCommit remote importtreeconfig importcommitconfig importable
|
||||||
|
next $ updateremotetrackingbranch importcommit
|
||||||
|
|
||||||
|
where
|
||||||
|
-- Update the tracking branch. Done even when there
|
||||||
|
-- is nothing new to import, to make sure it exists.
|
||||||
|
updateremotetrackingbranch importcommit =
|
||||||
|
case importcommit <|> parentcommit of
|
||||||
|
Just c -> do
|
||||||
|
inRepo $ Git.Branch.update' (fromRemoteTrackingBranch tb) c
|
||||||
|
return True
|
||||||
|
Nothing -> do
|
||||||
|
warning $ "Nothing to import and " ++ fromRef branch ++ " does not exist."
|
||||||
|
return False
|
||||||
|
|
Loading…
Reference in a new issue