summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Messages.hs26
-rw-r--r--Seek.hs12
-rw-r--r--Types/Messages.hs6
-rw-r--r--Utility/Path.hs32
-rw-r--r--debian/changelog1
-rw-r--r--doc/bugs/unlock_fails_silently_with_directory_symlinks.mdwn2
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]]