Add --exclude option to exclude files from processing.

Required some lifting so flags are evaled in the Annex monad before
file filtering.

5 files changed, 57 insertions, 27 deletions

diff --git a/CmdLine.hs b/CmdLine.hs
index 0903cc1fb..cb164a6ab 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -9,6 +9,7 @@ module CmdLine (parseCmd) where
 
 import System.Console.GetOpt
 import Control.Monad (when)
+import Control.Monad.State (liftIO)
 
 import qualified Annex
 import Types
@@ -103,6 +104,8 @@ options = [
 		"specify to where to transfer content"
 	  , Option ['f'] ["from"] (ReqArg (storestring "fromrepository") "REPOSITORY")
 		"specify from where to transfer content"
+	  , Option ['x'] ["exclude"] (ReqArg (storestring "exclude") "GLOB")
+		"skip files matching the glob pattern"
 	  ]
 	where
 		storebool n b = Annex.flagChange n $ FlagBool b
@@ -125,22 +128,17 @@ usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs
 		indent l = "  " ++ l
 		pad n s = replicate (n - length s) ' '
 
-{- Parses command line and returns two lists of actions to be 
- - run in the Annex monad. The first actions configure it
- - according to command line options, while the second actions
- - handle subcommands. -}
-parseCmd :: [String] -> AnnexState -> IO ([Annex Bool], [Annex Bool])
-parseCmd argv state = do
-	(flags, params) <- getopt
+{- Parses command line, stores configure flags, and returns a 
+ - list of actions to be run in the Annex monad. -}
+parseCmd :: [String] -> Annex [Annex Bool]
+parseCmd argv = do
+	(flags, params) <- liftIO $ getopt
 	when (null params) $ error usage
 	case lookupCmd (head params) of
 		[] -> error usage
 		[subcommand] -> do
-			actions <- prepSubCmd subcommand state (drop 1 params)
-			let configactions = map (\flag -> do
-				flag
-				return True) flags
-			return (configactions, actions)
+			_ <- sequence flags
+			prepSubCmd subcommand (drop 1 params)
 		_ -> error "internal error: multiple matching subcommands"
 	where
 		getopt = case getOpt Permute options argv of
diff --git a/Command.hs b/Command.hs
index 059b6e435..8edea7622 100644
--- a/Command.hs
+++ b/Command.hs
@@ -11,6 +11,8 @@ import Control.Monad.State (liftIO)
 import System.Directory
 import System.Posix.Files
 import Control.Monad (filterM)
+import System.Path.WildMatch
+import Text.Regex
 
 import Types
 import qualified Backend
@@ -59,9 +61,9 @@ data SubCommand = SubCommand {
 
 {- Prepares a list of actions to run to perform a subcommand, based on
  - the parameters passed to it. -}
-prepSubCmd :: SubCommand -> AnnexState -> [String] -> IO [Annex Bool]
-prepSubCmd SubCommand { subcmdseek = seek } state params = do
-	lists <- Annex.eval state $ mapM (\s -> s params) seek
+prepSubCmd :: SubCommand -> [String] -> Annex [Annex Bool]
+prepSubCmd SubCommand { subcmdseek = seek } params = do
+	lists <- mapM (\s -> s params) seek
 	return $ map doSubCmd $ foldl (++) [] lists
 
 {- Runs a subcommand through the start, perform and cleanup stages -}
@@ -106,18 +108,20 @@ withFilesInGit :: SubCmdSeekStrings
 withFilesInGit a params = do
 	repo <- Annex.gitRepo
 	files <- liftIO $ mapM (Git.inRepo repo) params
-	return $ map a $ filter notState $ foldl (++) [] files
+	files' <- filterFiles $ foldl (++) [] files
+	return $ map a files'
 withAttrFilesInGit :: String -> SubCmdSeekAttrFiles
 withAttrFilesInGit attr a params = do
 	repo <- Annex.gitRepo
 	files <- liftIO $ mapM (Git.inRepo repo) params
-	pairs <- liftIO $ Git.checkAttr repo attr $
-		filter notState $ foldl (++) [] files
+	files' <- filterFiles $ foldl (++) [] files
+	pairs <- liftIO $ Git.checkAttr repo attr files'
 	return $ map a pairs
 withFilesMissing :: SubCmdSeekStrings
 withFilesMissing a params = do
 	files <- liftIO $ filterM missing params
-	return $ map a $ filter notState files
+	files' <- filterFiles files
+	return $ map a files'
 	where
 		missing f = do
 			e <- doesFileExist f
@@ -126,7 +130,8 @@ withFilesNotInGit :: SubCmdSeekBackendFiles
 withFilesNotInGit a params = do
 	repo <- Annex.gitRepo
 	newfiles <- liftIO $ mapM (Git.notInRepo repo) params
-	backendPairs a $ filter notState $ foldl (++) [] newfiles
+	newfiles' <- filterFiles $ foldl (++) [] newfiles
+	backendPairs a newfiles'
 withString :: SubCmdSeekStrings
 withString a params = return [a $ unwords params]
 withStrings :: SubCmdSeekStrings
@@ -135,7 +140,8 @@ withFilesToBeCommitted :: SubCmdSeekStrings
 withFilesToBeCommitted a params = do
 	repo <- Annex.gitRepo
 	tocommit <- liftIO $ mapM (Git.stagedFiles repo) params
-	return $ map a $ filter notState $ foldl (++) [] tocommit
+	tocommit' <- filterFiles $ foldl (++) [] tocommit
+	return $ map a tocommit'
 withFilesUnlocked :: SubCmdSeekBackendFiles
 withFilesUnlocked = withFilesUnlocked' Git.typeChangedFiles
 withFilesUnlockedToBeCommitted :: SubCmdSeekBackendFiles
@@ -146,7 +152,8 @@ withFilesUnlocked' typechanged a params = do
 	repo <- Annex.gitRepo
 	typechangedfiles <- liftIO $ mapM (typechanged repo) params
 	unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
-	backendPairs a $ filter notState unlockedfiles
+	unlockedfiles' <- filterFiles unlockedfiles
+	backendPairs a unlockedfiles'
 withKeys :: SubCmdSeekStrings
 withKeys a params = return $ map a params
 withTempFile :: SubCmdSeekStrings
@@ -173,9 +180,23 @@ withDefault :: String-> (a -> SubCmdSeek) -> (a -> SubCmdSeek)
 withDefault d w a [] = w a [d]
 withDefault _ w a p = w a p
 
-{- filter out files from the state directory -}
-notState :: FilePath -> Bool
-notState f = stateLoc /= take (length stateLoc) f
+{- Filter out files from the state directory, and those matching the
+ - exclude glob pattern, if it was specified. -}
+filterFiles :: [FilePath] -> Annex [FilePath]
+filterFiles l = do
+	let l' = filter notState l
+	exclude <- Annex.flagGet "exclude"
+	if null exclude
+		then return l'
+		else do
+			let regexp = mkRegex $ "^" ++ wildToRegex exclude
+			return $ filter (notExcluded regexp) l'
+	where
+		notState f = stateLoc /= take stateLocLen f
+		stateLocLen = length stateLoc
+		notExcluded r f = case matchRegex r f of
+			Nothing -> True
+			Just _ -> False
 
 {- filter out symlinks -}	
 notSymlink :: FilePath -> IO Bool
diff --git a/debian/changelog b/debian/changelog
index 5ecf94201..4b8fb1050 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+git-annex (0.12) UNRELEASED; urgency=low
+
+  * Add --exclude option to exclude files from processing.
+
+ -- Joey Hess <joeyh@debian.org>  Wed, 08 Dec 2010 14:06:47 -0400
+
 git-annex (0.11) unstable; urgency=low
 
   * If available, rsync will be used for file transfers from remote
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 66e8bbaa8..f6dc2fe5b 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -234,6 +234,11 @@ Many git-annex subcommands will stage changes for later `git commit` by you.
   Specifies a git repository that content will be sent to. 
   It should be specified using the name of a configured git remote.
 
+* --exclude=glob
+
+  Skips files matching the glob pattern. The glob is matched relative to
+  the current directory.
+
 * --backend=name
 
   Specifies which key-value backend to use.
diff --git a/git-annex.hs b/git-annex.hs
index 417d335e1..1173ab913 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -19,5 +19,5 @@ main = do
 	args <- getArgs
 	gitrepo <- Git.repoFromCwd
 	state <- Annex.new gitrepo allBackends
-	(configure, actions) <- parseCmd args state
-	tryRun state $ [startup, upgrade] ++ configure ++ actions
+	(actions, state') <- Annex.run state $ parseCmd args
+	tryRun state' $ [startup, upgrade] ++ actions