refactor --exclude to use Utility.Matcher

This should change no behavior, but opens the poissibility to use the
matcher for other sorts of limits on which files git-annex processes.
This commit is contained in:
Joey Hess 2011-09-18 17:47:49 -04:00
parent 38c0f3eaf8
commit 8a5a92480b
4 changed files with 65 additions and 24 deletions

View file

@ -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

View file

@ -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

View file

@ -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 ()

59
Limit.hs Normal file
View file

@ -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