diff options
| -rw-r--r-- | Annex.hs | 5 | ||||
| -rw-r--r-- | Command.hs | 21 | ||||
| -rw-r--r-- | GitAnnex.hs | 4 | ||||
| -rw-r--r-- | Limit.hs | 59 |
4 files changed, 65 insertions, 24 deletions
@@ -31,6 +31,7 @@ import Types.Crypto import Types.BranchState import Types.TrustLevel import Types.UUID +import qualified Utility.Matcher -- git-annex's monad newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a } @@ -59,7 +60,7 @@ data AnnexState = AnnexState , defaultkey :: Maybe String , toremote :: Maybe String , fromremote :: Maybe String - , exclude :: [String] + , limit :: Either [Utility.Matcher.Token (FilePath -> Annex Bool)] (Utility.Matcher.Matcher (FilePath -> Annex Bool)) , forcetrust :: [(UUID, TrustLevel)] , trustmap :: Maybe TrustMap , cipher :: Maybe Cipher @@ -83,7 +84,7 @@ newState gitrepo = AnnexState , defaultkey = Nothing , toremote = Nothing , fromremote = Nothing - , exclude = [] + , limit = Left [] , forcetrust = [] , trustmap = Nothing , cipher = Nothing diff --git a/Command.hs b/Command.hs index 08087a5a5..fd58ca801 100644 --- a/Command.hs +++ b/Command.hs @@ -12,11 +12,8 @@ import System.Directory import System.Posix.Files import Control.Monad (filterM, liftM, when) import Control.Applicative -import System.Path.WildMatch -import Text.Regex.PCRE.Light.Char8 import Data.List import Data.Maybe -import Data.String.Utils import Types import qualified Backend @@ -30,6 +27,7 @@ import Trust import LocationLog import Config import Backend +import Limit {- A command runs in four stages. - @@ -180,23 +178,6 @@ withNothing _ _ = error "This command takes no parameters." backendPairs :: (BackendFile -> CommandStart) -> CommandSeek backendPairs a files = map a <$> Backend.chooseBackends files -{- Filter out files those matching the exclude glob pattern, - - if it was specified. -} -filterFiles :: [FilePath] -> Annex [FilePath] -filterFiles l = do - exclude <- Annex.getState Annex.exclude - if null exclude - then return l - else return $ filter (notExcluded $ wildsRegex exclude) l - where - notExcluded r f = isNothing $ match r f [] - -wildsRegex :: [String] -> Regex -wildsRegex ws = compile regex [] - where - regex = "^(" ++ alternatives ++ ")" - alternatives = join "|" $ map wildToRegex ws - {- filter out symlinks -} notSymlink :: FilePath -> IO Bool notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f diff --git a/GitAnnex.hs b/GitAnnex.hs index 6f4e5d492..bb0f85119 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -19,6 +19,7 @@ import Types import Types.TrustLevel import qualified Annex import qualified Remote +import qualified Limit import qualified Command.Add import qualified Command.Unannex @@ -97,7 +98,7 @@ options = commonOptions ++ "specify to where to transfer content" , Option ['f'] ["from"] (ReqArg setfrom paramRemote) "specify from where to transfer content" - , Option ['x'] ["exclude"] (ReqArg addexclude paramGlob) + , Option ['x'] ["exclude"] (ReqArg (Limit.exclude) paramGlob) "skip files matching the glob pattern" , Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber) "override default number of copies" @@ -113,7 +114,6 @@ options = commonOptions ++ where setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v } setfrom v = Annex.changeState $ \s -> s { Annex.fromremote = Just v } - addexclude v = Annex.changeState $ \s -> s { Annex.exclude = v:Annex.exclude s } setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v } setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v } setgitconfig :: String -> Annex () diff --git a/Limit.hs b/Limit.hs new file mode 100644 index 000000000..324baee2e --- /dev/null +++ b/Limit.hs @@ -0,0 +1,59 @@ +{- user-specified limits on files to act on + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Limit where + +import Text.Regex.PCRE.Light.Char8 +import System.Path.WildMatch +import Control.Monad (filterM) +import Data.Maybe + +import Annex +import qualified Utility.Matcher + +type Limit = Utility.Matcher.Token (FilePath -> Annex Bool) + +{- Filter out files not matching user-specified limits. -} +filterFiles :: [FilePath] -> Annex [FilePath] +filterFiles l = do + matcher <- getMatcher + filterM (Utility.Matcher.matchM matcher) l + +{- Gets a matcher for the user-specified limits. The matcher is cached for + - speed; once it's obtained the user-specified limits can't change. -} +getMatcher :: Annex (Utility.Matcher.Matcher (FilePath -> Annex Bool)) +getMatcher = do + m <- Annex.getState Annex.limit + case m of + Right r -> return r + Left l -> do + let matcher = Utility.Matcher.generate (reverse l) + Annex.changeState $ \s -> s { Annex.limit = Right matcher } + return matcher + +{- Adds something to the limit list. -} +add :: Limit -> Annex () +add l = Annex.changeState $ \s -> s { Annex.limit = append $ Annex.limit s } + where + append (Left ls) = Left $ l:ls + append _ = error "internal" + +{- Adds a new limit. -} +addl :: (FilePath -> Annex Bool) -> Annex () +addl = add . Utility.Matcher.Operation + +{- Adds a new token. -} +addt :: String -> Annex () +addt = add . Utility.Matcher.Token + +{- Add a limit to skip files that do not match the glob. -} +exclude :: String -> Annex () +exclude glob = addl $ return . notExcluded + where + notExcluded f = isNothing $ match cregex f [] + cregex = compile regex [] + regex = '^':wildToRegex glob |