diff --git a/CmdLine.hs b/CmdLine.hs index 0903cc1fb7..cb164a6ab2 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 059b6e435e..8edea7622e 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 5ecf942013..4b8fb1050b 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 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 66e8bbaa8b..f6dc2fe5b3 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 417d335e16..1173ab9139 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