summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt <m@jaspervdj.be>2013-01-03 19:02:11 +0100
committerJasper Van der Jeugt <m@jaspervdj.be>2013-01-03 19:02:11 +0100
commit8c0a609d6a8437b129228cfaad592d839b60b2c8 (patch)
tree6a3ac772513bc6f0b2ffa80259f29e630fa51ae1
parent9ea75c128c2f80bc3b75b1f1b9e718ce6df6dd36 (diff)
downloadhakyll-8c0a609d6a8437b129228cfaad592d839b60b2c8.tar.gz
Add .&&. and .||. operators
-rw-r--r--src/Hakyll/Core/Identifier/Pattern.hs41
-rw-r--r--tests/Hakyll/Core/Identifier/Tests.hs1
2 files changed, 33 insertions, 9 deletions
diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
index eb79c6e..8fbc6f8 100644
--- a/src/Hakyll/Core/Identifier/Pattern.hs
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -39,6 +39,8 @@ module Hakyll.Core.Identifier.Pattern
, fromVersion
-- * Manipulating patterns
+ , (.&&.)
+ , (.||.)
, complement
, withVersion
, fromLiteral
@@ -103,6 +105,7 @@ data Pattern
= Everything
| Complement Pattern
| And Pattern Pattern
+ | Or Pattern Pattern
| Glob [GlobComponent]
| List (Set Identifier)
| Regex String
@@ -115,18 +118,20 @@ instance Binary Pattern where
put Everything = putWord8 0
put (Complement p) = putWord8 1 >> put p
put (And x y) = putWord8 2 >> put x >> put y
- put (Glob g) = putWord8 3 >> put g
- put (List is) = putWord8 4 >> put is
- put (Regex r) = putWord8 5 >> put r
- put (Version v) = putWord8 6 >> put v
+ put (Or x y) = putWord8 3 >> put x >> put y
+ put (Glob g) = putWord8 4 >> put g
+ put (List is) = putWord8 5 >> put is
+ put (Regex r) = putWord8 6 >> put r
+ put (Version v) = putWord8 7 >> put v
get = getWord8 >>= \t -> case t of
0 -> pure Everything
1 -> Complement <$> get
2 -> And <$> get <*> get
- 3 -> Glob <$> get
- 4 -> List <$> get
- 5 -> Regex <$> get
+ 3 -> Or <$> get <*> get
+ 4 -> Glob <$> get
+ 5 -> List <$> get
+ 6 -> Regex <$> get
_ -> Version <$> get
@@ -137,8 +142,8 @@ instance IsString Pattern where
--------------------------------------------------------------------------------
instance Monoid Pattern where
- mempty = Everything
- mappend x y = optimize $ And x y
+ mempty = Everything
+ mappend = (.&&.)
--------------------------------------------------------------------------------
@@ -148,6 +153,9 @@ optimize (Complement x) = Complement (optimize x)
optimize (And x Everything) = x
optimize (And Everything y) = y
optimize (And x y) = And (optimize x) (optimize y)
+optimize (Or _ Everything) = Everything
+optimize (Or Everything _) = Everything
+optimize (Or x y) = Or (optimize x) (optimize y)
optimize p = p
@@ -188,6 +196,20 @@ fromVersion = Version
--------------------------------------------------------------------------------
+-- | '&&' for patterns: the given identifier must match both subterms
+(.&&.) :: Pattern -> Pattern -> Pattern
+x .&&. y = optimize (And x y)
+infixr 3 .&&.
+
+
+--------------------------------------------------------------------------------
+-- | '||' for patterns: the given identifier must match any subterm
+(.||.) :: Pattern -> Pattern -> Pattern
+x .||. y = optimize (Or x y)
+infixr 2 .||.
+
+
+--------------------------------------------------------------------------------
-- | Inverts a pattern, e.g.
--
-- > complement "foo/bar.html"
@@ -224,6 +246,7 @@ matches :: Pattern -> Identifier -> Bool
matches Everything _ = True
matches (Complement p) i = not $ matches p i
matches (And x y) i = matches x i && matches y i
+matches (Or x y) i = matches x i || matches y i
matches (Glob p) i = isJust $ capture (Glob p) i
matches (List l) i = i `S.member` l
matches (Regex r) i = toFilePath i =~ r
diff --git a/tests/Hakyll/Core/Identifier/Tests.hs b/tests/Hakyll/Core/Identifier/Tests.hs
index a31b424..8a8ed7c 100644
--- a/tests/Hakyll/Core/Identifier/Tests.hs
+++ b/tests/Hakyll/Core/Identifier/Tests.hs
@@ -66,4 +66,5 @@ matchesTests = fromAssertions "matches"
, False @=? matches (fromRegex "^foo/[^x]*$") "foo/barx"
, True @=? matches (complement "foo.markdown") "bar.markdown"
, False @=? matches (complement "foo.markdown") "foo.markdown"
+ , True @=? matches ("foo" .||. "bar") "bar"
]