avoid duplicate code with a more generic monadic matcher
Interesting type signature ghc derived for this: forall o (m :: * -> *). Monad m => Matcher o -> (o -> m Bool) -> m Bool
This commit is contained in:
parent
902ef88266
commit
c78975babb
2 changed files with 12 additions and 13 deletions
|
@ -53,8 +53,8 @@ isPreferredContent mu notpresent file = do
|
||||||
case M.lookup u m of
|
case M.lookup u m of
|
||||||
Nothing -> return True
|
Nothing -> return True
|
||||||
Just matcher ->
|
Just matcher ->
|
||||||
Utility.Matcher.matchM2 matcher notpresent $
|
Utility.Matcher.matchMrun matcher $ \a ->
|
||||||
getTopFilePath file
|
a notpresent (getTopFilePath file)
|
||||||
|
|
||||||
{- Read the preferredContentLog into a map. The map is cached for speed. -}
|
{- Read the preferredContentLog into a map. The map is cached for speed. -}
|
||||||
preferredContentMap :: Annex Annex.PreferredContentMap
|
preferredContentMap :: Annex Annex.PreferredContentMap
|
||||||
|
|
|
@ -15,6 +15,8 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE Rank2Types, KindSignatures #-}
|
||||||
|
|
||||||
module Utility.Matcher (
|
module Utility.Matcher (
|
||||||
Token(..),
|
Token(..),
|
||||||
Matcher,
|
Matcher,
|
||||||
|
@ -23,7 +25,7 @@ module Utility.Matcher (
|
||||||
generate,
|
generate,
|
||||||
match,
|
match,
|
||||||
matchM,
|
matchM,
|
||||||
matchM2,
|
matchMrun,
|
||||||
matchesAny
|
matchesAny
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -89,22 +91,19 @@ match a m v = go m
|
||||||
|
|
||||||
{- 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 = matchMrun m $ \o -> o v
|
||||||
where
|
|
||||||
go MAny = return True
|
|
||||||
go (MAnd m1 m2) = go m1 <&&> go m2
|
|
||||||
go (MOr m1 m2) = go m1 <||> go m2
|
|
||||||
go (MNot m1) = liftM not (go m1)
|
|
||||||
go (MOp o) = o v
|
|
||||||
|
|
||||||
matchM2 :: Monad m => Matcher (v1 -> v2 -> m Bool) -> v1 -> v2 -> m Bool
|
{- More generic running of a monadic Matcher, with full control over running
|
||||||
matchM2 m v1 v2 = go m
|
- of Operations. Mostly useful in order to match on more than one
|
||||||
|
- parameter. -}
|
||||||
|
matchMrun :: forall o (m :: * -> *). Monad m => Matcher o -> (o -> m Bool) -> m Bool
|
||||||
|
matchMrun m run = go m
|
||||||
where
|
where
|
||||||
go MAny = return True
|
go MAny = return True
|
||||||
go (MAnd m1 m2) = go m1 <&&> go m2
|
go (MAnd m1 m2) = go m1 <&&> go m2
|
||||||
go (MOr m1 m2) = go m1 <||> go m2
|
go (MOr m1 m2) = go m1 <||> go m2
|
||||||
go (MNot m1) = liftM not (go m1)
|
go (MNot m1) = liftM not (go m1)
|
||||||
go (MOp o) = o v1 v2
|
go (MOp o) = run o
|
||||||
|
|
||||||
{- 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
|
||||||
|
|
Loading…
Add table
Reference in a new issue