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
|
||||
Nothing -> return True
|
||||
Just matcher ->
|
||||
Utility.Matcher.matchM2 matcher notpresent $
|
||||
getTopFilePath file
|
||||
Utility.Matcher.matchMrun matcher $ \a ->
|
||||
a notpresent (getTopFilePath file)
|
||||
|
||||
{- Read the preferredContentLog into a map. The map is cached for speed. -}
|
||||
preferredContentMap :: Annex Annex.PreferredContentMap
|
||||
|
|
|
@ -15,6 +15,8 @@
|
|||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE Rank2Types, KindSignatures #-}
|
||||
|
||||
module Utility.Matcher (
|
||||
Token(..),
|
||||
Matcher,
|
||||
|
@ -23,7 +25,7 @@ module Utility.Matcher (
|
|||
generate,
|
||||
match,
|
||||
matchM,
|
||||
matchM2,
|
||||
matchMrun,
|
||||
matchesAny
|
||||
) where
|
||||
|
||||
|
@ -89,22 +91,19 @@ match a m v = go m
|
|||
|
||||
{- Runs a monadic Matcher, where Operations are actions in the monad. -}
|
||||
matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool
|
||||
matchM m v = go m
|
||||
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
|
||||
matchM m v = matchMrun m $ \o -> o v
|
||||
|
||||
matchM2 :: Monad m => Matcher (v1 -> v2 -> m Bool) -> v1 -> v2 -> m Bool
|
||||
matchM2 m v1 v2 = go m
|
||||
{- More generic running of a monadic Matcher, with full control over running
|
||||
- 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
|
||||
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 v1 v2
|
||||
go (MOp o) = run o
|
||||
|
||||
{- Checks is a matcher contains no limits, and so (presumably) matches
|
||||
- anything. Note that this only checks the trivial case; it is possible
|
||||
|
|
Loading…
Add table
Reference in a new issue