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:
Joey Hess 2012-10-13 15:17:15 -04:00
parent 902ef88266
commit c78975babb
2 changed files with 12 additions and 13 deletions

View file

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

View file

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