convert Token to have separate constructors for each peice of syntax
This commit is contained in:
parent
a1578e33dc
commit
5253379953
3 changed files with 50 additions and 39 deletions
18
Limit.hs
18
Limit.hs
|
@ -48,17 +48,17 @@ add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
|
||||||
prepend (Left ls) = Left $ l:ls
|
prepend (Left ls) = Left $ l:ls
|
||||||
prepend _ = error "internal"
|
prepend _ = error "internal"
|
||||||
|
|
||||||
{- Adds a new limit. -}
|
|
||||||
addlimit :: (FilePath -> Annex Bool) -> Annex ()
|
|
||||||
addlimit = add . Utility.Matcher.Operation
|
|
||||||
|
|
||||||
{- Adds a new token. -}
|
{- Adds a new token. -}
|
||||||
token :: String -> Annex ()
|
addToken :: String -> Annex ()
|
||||||
token = add . Utility.Matcher.Token
|
addToken = add . Utility.Matcher.token
|
||||||
|
|
||||||
|
{- Adds a new limit. -}
|
||||||
|
addLimit :: (FilePath -> Annex Bool) -> Annex ()
|
||||||
|
addLimit = add . Utility.Matcher.Operation
|
||||||
|
|
||||||
{- Add a limit to skip files that do not match the glob. -}
|
{- Add a limit to skip files that do not match the glob. -}
|
||||||
addExclude :: String -> Annex ()
|
addExclude :: String -> Annex ()
|
||||||
addExclude glob = addlimit $ return . notExcluded
|
addExclude glob = addLimit $ return . notExcluded
|
||||||
where
|
where
|
||||||
notExcluded f = isNothing $ match cregex f []
|
notExcluded f = isNothing $ match cregex f []
|
||||||
cregex = compile regex []
|
cregex = compile regex []
|
||||||
|
@ -69,7 +69,7 @@ addExclude glob = addlimit $ return . notExcluded
|
||||||
addIn :: String -> Annex ()
|
addIn :: String -> Annex ()
|
||||||
addIn name = do
|
addIn name = do
|
||||||
u <- Remote.nameToUUID name
|
u <- Remote.nameToUUID name
|
||||||
addlimit $ if name == "." then check local else check (remote u)
|
addLimit $ if name == "." then check local else check (remote u)
|
||||||
where
|
where
|
||||||
check a f = Backend.lookupFile f >>= handle a
|
check a f = Backend.lookupFile f >>= handle a
|
||||||
handle _ Nothing = return False
|
handle _ Nothing = return False
|
||||||
|
@ -85,7 +85,7 @@ addCopies :: String -> Annex ()
|
||||||
addCopies num = do
|
addCopies num = do
|
||||||
case readMaybe num :: Maybe Int of
|
case readMaybe num :: Maybe Int of
|
||||||
Nothing -> error "bad number for --copies"
|
Nothing -> error "bad number for --copies"
|
||||||
Just n -> addlimit $ check n
|
Just n -> addLimit $ check n
|
||||||
where
|
where
|
||||||
check n f = Backend.lookupFile f >>= handle n
|
check n f = Backend.lookupFile f >>= handle n
|
||||||
handle _ Nothing = return False
|
handle _ Nothing = return False
|
||||||
|
|
|
@ -58,5 +58,5 @@ matcherOptions =
|
||||||
, shortopt ")" "close group of options"
|
, shortopt ")" "close group of options"
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
longopt o d = Option [] [o] (NoArg (token o)) d
|
longopt o d = Option [] [o] (NoArg (addToken o)) d
|
||||||
shortopt o d = Option o [] (NoArg (token o)) d
|
shortopt o d = Option o [] (NoArg (addToken o)) d
|
||||||
|
|
|
@ -18,6 +18,7 @@
|
||||||
module Utility.Matcher (
|
module Utility.Matcher (
|
||||||
Token(..),
|
Token(..),
|
||||||
Matcher,
|
Matcher,
|
||||||
|
token,
|
||||||
generate,
|
generate,
|
||||||
match,
|
match,
|
||||||
matchM,
|
matchM,
|
||||||
|
@ -26,20 +27,30 @@ module Utility.Matcher (
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
{- A Token can either be a single word, or an Operation of an arbitrary type. -}
|
{- A Token can be an Operation of an arbitrary type, or one of a few
|
||||||
data Token op = Token String | Operation op
|
- predefined peices of syntax. -}
|
||||||
|
data Token op = Operation op | And | Or | Not | Open | Close
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data Matcher op = Any
|
data Matcher op = MAny
|
||||||
| And (Matcher op) (Matcher op)
|
| MAnd (Matcher op) (Matcher op)
|
||||||
| Or (Matcher op) (Matcher op)
|
| MOr (Matcher op) (Matcher op)
|
||||||
| Not (Matcher op)
|
| MNot (Matcher op)
|
||||||
| Op op
|
| MOp op
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
{- Converts a word of syntax into a token. Doesn't handle operations. -}
|
||||||
|
token :: String -> Token op
|
||||||
|
token "and" = And
|
||||||
|
token "or" = Or
|
||||||
|
token "not" = Not
|
||||||
|
token "(" = Open
|
||||||
|
token ")" = Close
|
||||||
|
token t = error $ "unknown token " ++ t
|
||||||
|
|
||||||
{- Converts a list of Tokens into a Matcher. -}
|
{- Converts a list of Tokens into a Matcher. -}
|
||||||
generate :: [Token op] -> Matcher op
|
generate :: [Token op] -> Matcher op
|
||||||
generate ts = generate' Any ts
|
generate ts = generate' MAny ts
|
||||||
generate' :: Matcher op -> [Token op] -> Matcher op
|
generate' :: Matcher op -> [Token op] -> Matcher op
|
||||||
generate' m [] = m
|
generate' m [] = m
|
||||||
generate' m ts = uncurry generate' $ consume m ts
|
generate' m ts = uncurry generate' $ consume m ts
|
||||||
|
@ -48,16 +59,16 @@ generate' m ts = uncurry generate' $ consume m ts
|
||||||
- and returns unconsumed Tokens. -}
|
- and returns unconsumed Tokens. -}
|
||||||
consume :: Matcher op -> [Token op] -> (Matcher op, [Token op])
|
consume :: Matcher op -> [Token op] -> (Matcher op, [Token op])
|
||||||
consume m [] = (m, [])
|
consume m [] = (m, [])
|
||||||
consume m ((Operation o):ts) = (m `And` Op o, ts)
|
consume m (t:ts) = go t
|
||||||
consume m ((Token t):ts)
|
|
||||||
| t == "and" = cont $ m `And` next
|
|
||||||
| t == "or" = cont $ m `Or` next
|
|
||||||
| t == "not" = cont $ m `And` (Not next)
|
|
||||||
| t == "(" = let (n, r) = consume next rest in (m `And` n, r)
|
|
||||||
| t == ")" = (m, ts)
|
|
||||||
| otherwise = error $ "unknown token " ++ t
|
|
||||||
where
|
where
|
||||||
(next, rest) = consume Any ts
|
go And = cont $ m `MAnd` next
|
||||||
|
go Or = cont $ m `MOr` next
|
||||||
|
go Not = cont $ m `MAnd` (MNot next)
|
||||||
|
go Open = let (n, r) = consume next rest in (m `MAnd` n, r)
|
||||||
|
go Close = (m, ts)
|
||||||
|
go (Operation o) = (m `MAnd` MOp o, ts)
|
||||||
|
|
||||||
|
(next, rest) = consume MAny ts
|
||||||
cont v = (v, rest)
|
cont v = (v, rest)
|
||||||
|
|
||||||
{- Checks if a Matcher matches, using a supplied function to check
|
{- Checks if a Matcher matches, using a supplied function to check
|
||||||
|
@ -65,25 +76,25 @@ consume m ((Token t):ts)
|
||||||
match :: (op -> v -> Bool) -> Matcher op -> v -> Bool
|
match :: (op -> v -> Bool) -> Matcher op -> v -> Bool
|
||||||
match a m v = go m
|
match a m v = go m
|
||||||
where
|
where
|
||||||
go Any = True
|
go MAny = True
|
||||||
go (And m1 m2) = go m1 && go m2
|
go (MAnd m1 m2) = go m1 && go m2
|
||||||
go (Or m1 m2) = go m1 || go m2
|
go (MOr m1 m2) = go m1 || go m2
|
||||||
go (Not m1) = not (go m1)
|
go (MNot m1) = not (go m1)
|
||||||
go (Op o) = a o v
|
go (MOp o) = a o v
|
||||||
|
|
||||||
{- Runs a monadic Matcher, where Operations are actions in the monad. -}
|
{- Runs a monadic Matcher, where Operations are actions in the monad. -}
|
||||||
matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool
|
matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool
|
||||||
matchM m v = go m
|
matchM m v = go m
|
||||||
where
|
where
|
||||||
go Any = return True
|
go MAny = return True
|
||||||
go (And m1 m2) = liftM2 (&&) (go m1) (go m2)
|
go (MAnd m1 m2) = liftM2 (&&) (go m1) (go m2)
|
||||||
go (Or m1 m2) = liftM2 (||) (go m1) (go m2)
|
go (MOr m1 m2) = liftM2 (||) (go m1) (go m2)
|
||||||
go (Not m1) = liftM not (go m1)
|
go (MNot m1) = liftM not (go m1)
|
||||||
go (Op o) = o v
|
go (MOp o) = o v
|
||||||
|
|
||||||
{- Checks is a matcher contains no limits, and so (presumably) matches
|
{- Checks is a matcher contains no limits, and so (presumably) matches
|
||||||
- anything. Note that this only checks the trivial case; it is possible
|
- anything. Note that this only checks the trivial case; it is possible
|
||||||
- to construct matchers that match anything but are more complicated. -}
|
- to construct matchers that match anything but are more complicated. -}
|
||||||
matchesAny :: Matcher a -> Bool
|
matchesAny :: Matcher a -> Bool
|
||||||
matchesAny Any = True
|
matchesAny MAny = True
|
||||||
matchesAny _ = False
|
matchesAny _ = False
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue