Display a warning when a non-existing file or directory is specified.
This commit is contained in:
		
					parent
					
						
							
								8ad03e1c78
							
						
					
				
			
			
				commit
				
					
						5f3661238d
					
				
			
		
					 6 changed files with 52 additions and 27 deletions
				
			
		
							
								
								
									
										24
									
								
								Messages.hs
									
										
									
									
									
								
							
							
						
						
									
										24
									
								
								Messages.hs
									
										
									
									
									
								
							|  | @ -23,6 +23,7 @@ module Messages ( | |||
| 	showEndResult, | ||||
| 	showErr, | ||||
| 	warning, | ||||
| 	fileNotFound, | ||||
| 	indent, | ||||
| 	maybeShowJSON, | ||||
| 	showFullJSON, | ||||
|  | @ -44,6 +45,7 @@ import Types.Messages | |||
| import Types.Key | ||||
| import qualified Annex | ||||
| import qualified Messages.JSON as JSON | ||||
| import qualified Data.Set as S | ||||
| 
 | ||||
| showStart :: String -> String -> Annex () | ||||
| showStart command file = handle (JSON.start command $ Just file) $ | ||||
|  | @ -89,11 +91,13 @@ meteredBytes combinemeterupdate size a = withOutputType go | |||
| showSideAction :: String -> Annex () | ||||
| showSideAction m = Annex.getState Annex.output >>= go | ||||
|   where | ||||
| 	go (MessageState v StartBlock) = do | ||||
| 	go st | ||||
| 		| sideActionBlock st == StartBlock = do | ||||
| 			p | ||||
| 		Annex.changeState $ \s -> s { Annex.output = MessageState v InBlock } | ||||
| 	go (MessageState _ InBlock) = return () | ||||
| 	go _ = p | ||||
| 			let st' = st { sideActionBlock = InBlock } | ||||
| 			Annex.changeState $ \s -> s { Annex.output = st' } | ||||
| 		| sideActionBlock st == InBlock = return () | ||||
| 		| otherwise = p | ||||
| 	p = handle q $ putStrLn $ "(" ++ m ++ "...)" | ||||
| 			 | ||||
| showStoringStateAction :: Annex () | ||||
|  | @ -150,6 +154,18 @@ warning' w = do | |||
| 		hFlush stdout | ||||
| 		hPutStrLn stderr w | ||||
| 
 | ||||
| {- Displays a warning one time about a file the user specified not existing. -} | ||||
| fileNotFound :: FilePath -> Annex () | ||||
| fileNotFound file = do | ||||
| 	st <- Annex.getState Annex.output | ||||
| 	let shown = fileNotFoundShown st | ||||
| 	when (S.notMember file shown) $ do | ||||
| 		let shown' = S.insert file shown | ||||
| 		let st' = st { fileNotFoundShown = shown' } | ||||
| 		Annex.changeState $ \s -> s { Annex.output = st' } | ||||
| 		liftIO $ hPutStrLn stderr $ unwords | ||||
| 			[ "git-annex:", file, "not found" ] | ||||
| 
 | ||||
| indent :: String -> String | ||||
| indent = join "\n" . map (\l -> "  " ++ l) . lines | ||||
| 
 | ||||
|  |  | |||
							
								
								
									
										12
									
								
								Seek.hs
									
										
									
									
									
								
							
							
						
						
									
										12
									
								
								Seek.hs
									
										
									
									
									
								
							|  | @ -22,8 +22,14 @@ import qualified Limit | |||
| import qualified Option | ||||
| 
 | ||||
| seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [FilePath] -> Annex [FilePath] | ||||
| seekHelper a params = inRepo $ \g -> | ||||
| 	runPreserveOrder (\fs -> Git.Command.leaveZombie <$> a fs g) params | ||||
| seekHelper a params = do | ||||
| 	ll <- inRepo $ \g -> | ||||
| 		runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g) params | ||||
| 	{- Show warnings only for files/directories that do not exist. -} | ||||
| 	forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p -> | ||||
| 		unlessM (liftIO $ doesFileExist p <||> doesDirectoryExist p) $ | ||||
| 			fileNotFound p | ||||
| 	return $ concat ll | ||||
| 
 | ||||
| withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek | ||||
| withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params | ||||
|  | @ -34,7 +40,7 @@ withFilesNotInGit a params = do | |||
| 	files <- filter (not . dotfile) <$> | ||||
| 		seekunless (null ps && not (null params)) ps | ||||
| 	dotfiles <- seekunless (null dotps) dotps | ||||
| 	prepFiltered a $ return $ preserveOrder params (files++dotfiles) | ||||
| 	prepFiltered a $ return $ concat $ segmentPaths params (files++dotfiles) | ||||
|   where | ||||
| 	(dotps, ps) = partition dotfile params | ||||
| 	seekunless True _ = return [] | ||||
|  |  | |||
|  | @ -7,14 +7,18 @@ | |||
| 
 | ||||
| module Types.Messages where | ||||
| 
 | ||||
| import qualified Data.Set as S | ||||
| 
 | ||||
| data OutputType = NormalOutput | QuietOutput | JSONOutput | ||||
| 
 | ||||
| data SideActionBlock = NoBlock | StartBlock | InBlock | ||||
| 	deriving (Eq) | ||||
| 
 | ||||
| data MessageState = MessageState | ||||
| 	{ outputType :: OutputType | ||||
| 	, sideActionBlock :: SideActionBlock | ||||
| 	, fileNotFoundShown :: S.Set FilePath | ||||
| 	} | ||||
| 
 | ||||
| defaultMessageState :: MessageState | ||||
| defaultMessageState = MessageState NormalOutput NoBlock | ||||
| defaultMessageState = MessageState NormalOutput NoBlock S.empty | ||||
|  |  | |||
|  | @ -104,29 +104,25 @@ prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference | |||
| 		same_dir_shortcurcuits_at_difference = | ||||
| 			relPathDirToFile "/tmp/r/lll/xxx/yyy/18" "/tmp/r/.git/annex/objects/18/gk/SHA256-foo/SHA256-foo" == "../../../../.git/annex/objects/18/gk/SHA256-foo/SHA256-foo" | ||||
| 
 | ||||
| {- Given an original list of files, and an expanded list derived from it, | ||||
|  - ensures that the original list's ordering is preserved.  | ||||
|  - | ||||
|  - The input list may contain a directory, like "dir" or "dir/". Any | ||||
|  - items in the expanded list that are contained in that directory will | ||||
|  - appear at the same position as it did in the input list. | ||||
| {- Given an original list of paths, and an expanded list derived from it, | ||||
|  - generates a list of lists, where each sublist corresponds to one of the | ||||
|  - original paths. When the original path is a direcotry, any items | ||||
|  - in the expanded list that are contained in that directory will appear in | ||||
|  - its segment. | ||||
|  -} | ||||
| preserveOrder :: [FilePath] -> [FilePath] -> [FilePath] | ||||
| preserveOrder [] new = new | ||||
| preserveOrder [_] new = new -- optimisation | ||||
| preserveOrder (l:ls) new = found ++ preserveOrder ls rest | ||||
| segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]] | ||||
| segmentPaths [] new = [new] | ||||
| segmentPaths [_] new = [new] -- optimisation | ||||
| segmentPaths (l:ls) new = [found] ++ segmentPaths ls rest | ||||
| 	where | ||||
| 		(found, rest)=partition (l `dirContains`) new | ||||
| 
 | ||||
| {- Runs an action that takes a list of FilePaths, and ensures that  | ||||
|  - its return list preserves order. | ||||
|  - | ||||
|  - This assumes that it's cheaper to call preserveOrder on the result, | ||||
|  - than it would be to run the action separately with each param. In the case | ||||
|  - of git file list commands, that assumption tends to hold. | ||||
| {- This assumes that it's cheaper to call segmentPaths on the result, | ||||
|  - than it would be to run the action separately with each path. In | ||||
|  - the case of git file list commands, that assumption tends to hold. | ||||
|  -} | ||||
| runPreserveOrder :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath] | ||||
| runPreserveOrder a files = preserveOrder files <$> a files | ||||
| runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]] | ||||
| runSegmentPaths a paths = segmentPaths paths <$> a paths | ||||
| 
 | ||||
| {- Converts paths in the home directory to use ~/ -} | ||||
| relHome :: FilePath -> IO String | ||||
|  |  | |||
							
								
								
									
										1
									
								
								debian/changelog
									
										
									
									
										vendored
									
									
								
							
							
						
						
									
										1
									
								
								debian/changelog
									
										
									
									
										vendored
									
									
								
							|  | @ -22,6 +22,7 @@ git-annex (3.20121113) UNRELEASED; urgency=low | |||
|     client repository group. | ||||
|   * assistant: Apply preferred content settings when a new symlink | ||||
|     is created, or a symlink gets renamed. Made archive directories work. | ||||
|   * Display a warning when a non-existing file or directory is specified. | ||||
| 
 | ||||
|  -- Joey Hess <joeyh@debian.org>  Tue, 13 Nov 2012 13:17:07 -0400 | ||||
| 
 | ||||
|  |  | |||
|  | @ -49,3 +49,5 @@ jason@jasonwoof.com | |||
| > have multiple seek stages that act on different types of files, so | ||||
| > any warning printed by an earlier stage may be premature if a later | ||||
| > stage comes along and deals with a file. --[[Joey]] | ||||
| 
 | ||||
| >> Figured out a non-invasive way to add that warning. [[done]] --[[Joey]]  | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Joey Hess
				Joey Hess