Display a warning when a non-existing file or directory is specified.

6 files changed, 52 insertions, 27 deletions

diff --git a/Messages.hs b/Messages.hs
index 822458143..d75fe6769 100644
--- a/Messages.hs
+++ b/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
-		p
-		Annex.changeState $ \s -> s { Annex.output = MessageState v InBlock }
-	go (MessageState _ InBlock) = return ()
-	go _ = p
+	go st
+		| sideActionBlock st == StartBlock = do
+			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
 
diff --git a/Seek.hs b/Seek.hs
index cd3098664..959255cbc 100644
--- a/Seek.hs
+++ b/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 []
diff --git a/Types/Messages.hs b/Types/Messages.hs
index 75653d574..4fcce79f8 100644
--- a/Types/Messages.hs
+++ b/Types/Messages.hs
@@ -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
diff --git a/Utility/Path.hs b/Utility/Path.hs
index f4c2843fc..272d2e85b 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -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
diff --git a/debian/changelog b/debian/changelog
index 21bba4230..02e89e14d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -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
 
diff --git a/doc/bugs/unlock_fails_silently_with_directory_symlinks.mdwn b/doc/bugs/unlock_fails_silently_with_directory_symlinks.mdwn
index 4f6c82300..9b9bb6342 100644
--- a/doc/bugs/unlock_fails_silently_with_directory_symlinks.mdwn
+++ b/doc/bugs/unlock_fails_silently_with_directory_symlinks.mdwn
@@ -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]]