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:
parent
38c0f3eaf8
commit
8a5a92480b
4 changed files with 65 additions and 24 deletions
5
Annex.hs
5
Annex.hs
|
@ -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
|
||||
|
|
21
Command.hs
21
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
|
||||
|
|
|
@ -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
59
Limit.hs
Normal 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
|
Loading…
Reference in a new issue