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…
	
	Add table
		Add a link
		
	
		Reference in a new issue