@@ -1,4 +1,12 @@
1-- | Module providing pattern matching and capturing on 'Identifier's.
1-- | Module providing pattern matching and capturing on 'Identifier's.
2+-- 'Pattern's come in two kinds:
4+-- * Simple glob patterns, like @foo\/*@;
6+-- * Custom, arbitrary predicates of the type @Identifier -> Bool@.
8+-- They both have advantages and disadvantages. By default, globs are used,
9+-- unless you construct your 'Pattern' using the 'predicate' function.
3-- A very simple pattern could be, for example, @foo\/bar@. This pattern will
11-- A very simple pattern could be, for example, @foo\/bar@. This pattern will
4-- only match the exact @foo\/bar@ identifier.
12-- only match the exact @foo\/bar@ identifier.
@@ -20,15 +28,15 @@
21-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
29-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
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
24-- by the capture elements in the pattern.
32-- by the capture elements in the pattern.
26module Hakyll.Core.Identifier.Pattern
34module Hakyll.Core.Identifier.Pattern
28− , parsePattern
36+ , parseGlob
32 , fromCapture
40 , fromCapture
33 , fromCaptureString
41 , fromCaptureString
34 , fromCaptures
42 , fromCaptures
@@ -46,23 +54,23 @@ import Hakyll.Core.Identifier
47-- | One base element of a pattern
55-- | One base element of a pattern
49−data PatternComponent = Capture
57+data GlobComponent = Capture
50− | CaptureMany
58+ | CaptureMany
51− | Literal String
59+ | Literal String
52− deriving (Eq, Show)
60+ deriving (Eq, Show)
54-- | Type that allows matching on identifiers
62-- | Type that allows matching on identifiers
56−newtype Pattern = Pattern {unPattern :: [PatternComponent]}
64+data Pattern = Glob [GlobComponent]
57− deriving (Eq, Show)
65+ | Predicate (Identifier -> Bool)
59instance IsString Pattern where
67instance IsString Pattern where
60− fromString = parsePattern
68+ fromString = parseGlob
62-- | Parse a pattern from a string
70-- | Parse a pattern from a string
64−parsePattern :: String -> Pattern
72+parseGlob :: String -> Pattern
65−parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIdentifier . parseIdentifier
73+parseGlob = Glob . parse'
67 parse' str =
75 parse' str =
68 let (chunk, rest) = break (`elem` "\\*") str
76 let (chunk, rest) = break (`elem` "\\*") str
@@ -72,20 +80,16 @@ parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIden
72 ('*' : xs) -> Literal chunk : Capture : parse' xs
80 ('*' : xs) -> Literal chunk : Capture : parse' xs
73 xs -> Literal chunk : Literal xs : []
81 xs -> Literal chunk : Literal xs : []
75−-- | Match an identifier against a pattern, generating a list of captures
77−match :: Pattern -> Identifier -> Maybe [Identifier]
78−match p (Identifier i) = fmap (map Identifier) $ match' (unPattern p) i
80-- | Check if an identifier matches a pattern
83-- | Check if an identifier matches a pattern
82−doesMatch :: Pattern -> Identifier -> Bool
85+matches :: Pattern -> Identifier -> Bool
83−doesMatch p = isJust . match p
86+matches (Glob p) = isJust . capture (Glob p)
87+matches (Predicate p) = (p $)
85-- | Given a list of identifiers, retain only those who match the given pattern
89-- | Given a list of identifiers, retain only those who match the given pattern
87−matches :: Pattern -> [Identifier] -> [Identifier]
91+filterMatches :: Pattern -> [Identifier] -> [Identifier]
88−matches p = filter (doesMatch p)
92+filterMatches = filter . matches
90-- | Split a list at every possible point, generate a list of (init, tail)
94-- | Split a list at every possible point, generate a list of (init, tail)
91-- cases. The result is sorted with inits decreasing in length.
95-- cases. The result is sorted with inits decreasing in length.
@@ -93,30 +97,35 @@ matches p = filter (doesMatch p)
93splits :: [a] -> [([a], [a])]
97splits :: [a] -> [([a], [a])]
94splits = inits &&& tails >>> uncurry zip >>> reverse
98splits = inits &&& tails >>> uncurry zip >>> reverse
96−-- | Internal verion of 'match'
100+-- | Match a glob against a pattern, generating a list of captures
102+capture :: Pattern -> Identifier -> Maybe [Identifier]
103+capture (Glob p) (Identifier i) = fmap (map Identifier) $ capture' p i
104+capture (Predicate _) _ = Nothing
106+-- | Internal verion of 'capture'
98−match' :: [PatternComponent] -> String -> Maybe [String]
108+capture' :: [GlobComponent] -> String -> Maybe [String]
99−match' [] [] = Just [] -- An empty match
109+capture' [] [] = Just [] -- An empty match
100−match' [] _ = Nothing -- No match
110+capture' [] _ = Nothing -- No match
101−-- match' _ [] = Nothing -- No match
102−match' (Literal l : ms) str
111+capture' (Literal l : ms) str
103 -- Match the literal against the string
112 -- Match the literal against the string
104− | l `isPrefixOf` str = match' ms $ drop (length l) str
113+ | l `isPrefixOf` str = capture' ms $ drop (length l) str
105 | otherwise = Nothing
114 | otherwise = Nothing
106−match' (Capture : ms) str =
115+capture' (Capture : ms) str =
107 -- Match until the next /
116 -- Match until the next /
108 let (chunk, rest) = break (== '/') str
117 let (chunk, rest) = break (== '/') str
109− in msum $ [ fmap (i :) (match' ms (t ++ rest)) | (i, t) <- splits chunk ]
118+ in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
110−match' (CaptureMany : ms) str =
119+capture' (CaptureMany : ms) str =
111 -- Match everything
120 -- Match everything
112− msum $ [ fmap (i :) (match' ms t) | (i, t) <- splits str ]
121+ msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
114-- | Create an identifier from a pattern by filling in the captures with a given
123-- | Create an identifier from a pattern by filling in the captures with a given
117-- Example:
126-- Example:
119−-- > fromCapture (parsePattern "tags/*") (parseIdentifier "foo")
128+-- > fromCapture (parseGlob "tags/*") (parseIdentifier "foo")
121-- Result:
130-- Result:
@@ -128,7 +137,7 @@ fromCapture pattern = fromCaptures pattern . repeat
128-- | Simplified version of 'fromCapture' which takes a 'String' instead of an
137-- | Simplified version of 'fromCapture' which takes a 'String' instead of an
129-- 'Identifier'
138-- 'Identifier'
131−-- > fromCaptureString (parsePattern "tags/*") "foo"
140+-- > fromCaptureString (parseGlob "tags/*") "foo"
133-- Result:
142-- Result:
@@ -141,11 +150,19 @@ fromCaptureString pattern = fromCapture pattern . parseIdentifier
141-- given list of strings
150-- given list of strings
143fromCaptures :: Pattern -> [Identifier] -> Identifier
152fromCaptures :: Pattern -> [Identifier] -> Identifier
144−fromCaptures (Pattern []) _ = mempty
153+fromCaptures (Glob p) = fromCaptures' p
154+fromCaptures (Predicate _) = error $
155+ "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures called on a " ++
156+ "predicate instead of a glob"
158+-- | Internally used version of 'fromCaptures'
160+fromCaptures' :: [GlobComponent] -> [Identifier] -> Identifier
161+fromCaptures' [] _ = mempty
145−fromCaptures (Pattern (m : ms)) [] = case m of
162+fromCaptures' (m : ms) [] = case m of
146− Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) []
163+ Literal l -> Identifier l `mappend` fromCaptures' ms []
147− _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: "
164+ _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
148 ++ "identifier list exhausted"
165 ++ "identifier list exhausted"
149−fromCaptures (Pattern (m : ms)) ids@(i : is) = case m of
166+fromCaptures' (m : ms) ids@(i : is) = case m of
150− Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) ids
167+ Literal l -> Identifier l `mappend` fromCaptures' ms ids
151− _ -> i `mappend` fromCaptures (Pattern ms) is
168+ _ -> i `mappend` fromCaptures' ms is