@@ -1,4 +1,12 @@
11-- | Module providing pattern matching and capturing on 'Identifier's.
2+-- 'Pattern's come in two kinds:
3+--
4+-- * Simple glob patterns, like @foo\/*@;
5+--
6+-- * Custom, arbitrary predicates of the type @Identifier -> Bool@.
7+--
8+-- They both have advantages and disadvantages. By default, globs are used,
9+-- unless you construct your 'Pattern' using the 'predicate' function.
210--
311-- A very simple pattern could be, for example, @foo\/bar@. This pattern will
412-- only match the exact @foo\/bar@ identifier.
@@ -20,15 +28,17 @@
2028--
2129-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
2230--
23−-- The 'match' function allows the user to get access to the elements captured
31+-- The 'capture' function allows the user to get access to the elements captured
2432-- by the capture elements in the pattern.
2533--
2634module Hakyll.Core.Identifier.Pattern
2735 ( Pattern
28− , parsePattern
29− , match
30− , doesMatch
36+ , parseGlob
37+ , predicate
38+ , regex
3139 , matches
40+ , filterMatches
41+ , capture
3242 , fromCapture
3343 , fromCaptureString
3444 , fromCaptures
@@ -37,32 +47,39 @@ module Hakyll.Core.Identifier.Pattern
3747import Data.List (isPrefixOf, inits, tails)
3848import Control.Arrow ((&&&), (>>>))
3949import Control.Monad (msum)
40−import Data.Maybe (isJust)
41−import Data.Monoid (mempty, mappend)
50+import Data.Maybe (isJust, fromMaybe)
51+import Data.Monoid (Monoid, mempty, mappend)
4252
4353import GHC.Exts (IsString, fromString)
54+import Text.Regex.PCRE ((=~~))
4455
4556import Hakyll.Core.Identifier
4657
4758-- | One base element of a pattern
4859--
49−data PatternComponent = Capture
50− | CaptureMany
51− | Literal String
52− deriving (Eq, Show)
60+data GlobComponent = Capture
61+ | CaptureMany
62+ | Literal String
63+ deriving (Eq, Show)
5364
5465-- | Type that allows matching on identifiers
5566--
56−newtype Pattern = Pattern {unPattern :: [PatternComponent]}
57− deriving (Eq, Show)
67+data Pattern = Glob [GlobComponent]
68+ | Predicate (Identifier -> Bool)
5869
5970instance IsString Pattern where
60− fromString = parsePattern
71+ fromString = parseGlob
72+
73+instance Monoid Pattern where
74+ mempty = Predicate (const True)
75+ g@(Glob _) `mappend` x = Predicate (matches g) `mappend` x
76+ x `mappend` g@(Glob _) = x `mappend` Predicate (matches g)
77+ Predicate f `mappend` Predicate g = Predicate $ \i -> f i && g i
6178
6279-- | Parse a pattern from a string
6380--
64−parsePattern :: String -> Pattern
65−parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIdentifier . parseIdentifier
81+parseGlob :: String -> Pattern
82+parseGlob = Glob . parse'
6683 where
6784 parse' str =
6885 let (chunk, rest) = break (`elem` "\\*") str
@@ -72,20 +89,34 @@ parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIden
7289 ('*' : xs) -> Literal chunk : Capture : parse' xs
7390 xs -> Literal chunk : Literal xs : []
7491
75−-- | Match an identifier against a pattern, generating a list of captures
92+-- | Create a 'Pattern' from an arbitrary predicate
93+--
94+-- Example:
95+--
96+-- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i))
97+--
98+predicate :: (Identifier -> Bool) -> Pattern
99+predicate = Predicate
100+
101+-- | Create a 'Pattern' from a regex
102+--
103+-- Example:
104+--
105+-- > regex "^foo/[^x]*$
76106--
77−match :: Pattern -> Identifier -> Maybe [Identifier]
78−match p (Identifier i) = fmap (map Identifier) $ match' (unPattern p) i
107+regex :: String -> Pattern
108+regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath
79109
80110-- | Check if an identifier matches a pattern
81111--
82−doesMatch :: Pattern -> Identifier -> Bool
83−doesMatch p = isJust . match p
112+matches :: Pattern -> Identifier -> Bool
113+matches (Glob p) = isJust . capture (Glob p)
114+matches (Predicate p) = (p $)
84115
85116-- | Given a list of identifiers, retain only those who match the given pattern
86117--
87−matches :: Pattern -> [Identifier] -> [Identifier]
88−matches p = filter (doesMatch p)
118+filterMatches :: Pattern -> [Identifier] -> [Identifier]
119+filterMatches = filter . matches
89120
90121-- | Split a list at every possible point, generate a list of (init, tail)
91122-- cases. The result is sorted with inits decreasing in length.
@@ -93,30 +124,35 @@ matches p = filter (doesMatch p)
93124splits :: [a] -> [([a], [a])]
94125splits = inits &&& tails >>> uncurry zip >>> reverse
95126
96−-- | Internal verion of 'match'
127+-- | Match a glob against a pattern, generating a list of captures
97128--
98−match' :: [PatternComponent] -> String -> Maybe [String]
99−match' [] [] = Just [] -- An empty match
100−match' [] _ = Nothing -- No match
101−-- match' _ [] = Nothing -- No match
102−match' (Literal l : ms) str
129+capture :: Pattern -> Identifier -> Maybe [Identifier]
130+capture (Glob p) (Identifier i) = fmap (map Identifier) $ capture' p i
131+capture (Predicate _) _ = Nothing
132+
133+-- | Internal verion of 'capture'
134+--
135+capture' :: [GlobComponent] -> String -> Maybe [String]
136+capture' [] [] = Just [] -- An empty match
137+capture' [] _ = Nothing -- No match
138+capture' (Literal l : ms) str
103139 -- Match the literal against the string
104− | l `isPrefixOf` str = match' ms $ drop (length l) str
140+ | l `isPrefixOf` str = capture' ms $ drop (length l) str
105141 | otherwise = Nothing
106−match' (Capture : ms) str =
142+capture' (Capture : ms) str =
107143 -- Match until the next /
108144 let (chunk, rest) = break (== '/') str
109− in msum $ [ fmap (i :) (match' ms (t ++ rest)) | (i, t) <- splits chunk ]
110−match' (CaptureMany : ms) str =
145+ in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
146+capture' (CaptureMany : ms) str =
111147 -- Match everything
112− msum $ [ fmap (i :) (match' ms t) | (i, t) <- splits str ]
148+ msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
113149
114150-- | Create an identifier from a pattern by filling in the captures with a given
115151-- string
116152--
117153-- Example:
118154--
119−-- > fromCapture (parsePattern "tags/*") (parseIdentifier "foo")
155+-- > fromCapture (parseGlob "tags/*") (parseIdentifier "foo")
120156--
121157-- Result:
122158--
@@ -128,7 +164,7 @@ fromCapture pattern = fromCaptures pattern . repeat
128164-- | Simplified version of 'fromCapture' which takes a 'String' instead of an
129165-- 'Identifier'
130166--
131−-- > fromCaptureString (parsePattern "tags/*") "foo"
167+-- > fromCaptureString (parseGlob "tags/*") "foo"
132168--
133169-- Result:
134170--
@@ -141,11 +177,19 @@ fromCaptureString pattern = fromCapture pattern . parseIdentifier
141177-- given list of strings
142178--
143179fromCaptures :: Pattern -> [Identifier] -> Identifier
144−fromCaptures (Pattern []) _ = mempty
145−fromCaptures (Pattern (m : ms)) [] = case m of
146− Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) []
147− _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: "
180+fromCaptures (Glob p) = fromCaptures' p
181+fromCaptures (Predicate _) = error $
182+ "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures called on a " ++
183+ "predicate instead of a glob"
184+
185+-- | Internally used version of 'fromCaptures'
186+--
187+fromCaptures' :: [GlobComponent] -> [Identifier] -> Identifier
188+fromCaptures' [] _ = mempty
189+fromCaptures' (m : ms) [] = case m of
190+ Literal l -> Identifier l `mappend` fromCaptures' ms []
191+ _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
148192 ++ "identifier list exhausted"
149−fromCaptures (Pattern (m : ms)) ids@(i : is) = case m of
150− Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) ids
151− _ -> i `mappend` fromCaptures (Pattern ms) is
193+fromCaptures' (m : ms) ids@(i : is) = case m of
194+ Literal l -> Identifier l `mappend` fromCaptures' ms ids
195+ _ -> i `mappend` fromCaptures' ms is