Add regex predicate helper

2 files changed, 25 insertions, 2 deletions

diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
index 28e23ad..8f3ac01 100644
--- a/src/Hakyll/Core/Identifier/Pattern.hs
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -35,6 +35,7 @@ module Hakyll.Core.Identifier.Pattern
     ( Pattern
     , parseGlob
     , predicate
+    , regex
     , matches
     , filterMatches
     , capture
@@ -46,10 +47,11 @@ module Hakyll.Core.Identifier.Pattern
 import Data.List (isPrefixOf, inits, tails)
 import Control.Arrow ((&&&), (>>>))
 import Control.Monad (msum)
-import Data.Maybe (isJust)
+import Data.Maybe (isJust, fromMaybe)
 import Data.Monoid (Monoid, mempty, mappend)
 
 import GHC.Exts (IsString, fromString)
+import Text.Regex.PCRE ((=~~))
 
 import Hakyll.Core.Identifier
 
@@ -96,6 +98,15 @@ parseGlob = Glob . parse'
 predicate :: (Identifier -> Bool) -> Pattern
 predicate = Predicate
 
+-- | Create a 'Pattern' from a regex
+--
+-- Example:
+--
+-- > regex "^foo/[^x]*$
+--
+regex :: String -> Pattern
+regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath
+
 -- | Check if an identifier matches a pattern
 --
 matches :: Pattern -> Identifier -> Bool
diff --git a/tests/Hakyll/Core/Identifier/Tests.hs b/tests/Hakyll/Core/Identifier/Tests.hs
index 5b5d34d..0d7bfb8 100644
--- a/tests/Hakyll/Core/Identifier/Tests.hs
+++ b/tests/Hakyll/Core/Identifier/Tests.hs
@@ -10,7 +10,13 @@ import Hakyll.Core.Identifier.Pattern
 import TestSuite.Util
 
 tests :: [Test]
-tests = fromAssertions "capture"
+tests = concat
+    [ captureTests
+    , regexTests
+    ]
+
+captureTests :: [Test]
+captureTests = fromAssertions "capture"
     [ Just ["bar"]              @=? capture "foo/**" "foo/bar"
     , Just ["foo/bar"]          @=? capture "**" "foo/bar"
     , Nothing                   @=? capture "*" "foo/bar"
@@ -25,3 +31,9 @@ tests = fromAssertions "capture"
     , Just ["foo/bar", "wut"]   @=? capture "**/qux/*" "foo/bar/qux/wut"
     , Just ["lol", "fun/large"] @=? capture "*cat/**.jpg" "lolcat/fun/large.jpg"
     ]
+
+regexTests :: [Test]
+regexTests = fromAssertions "regex"
+    [ True  @=? matches (regex "^foo/[^x]*$") "foo/bar"
+    , False @=? matches (regex "^foo/[^x]*$") "foo/barx"
+    ]