@@ -6,27 +6,22 @@
66-- To match more than one identifier, there are different captures that one can
77-- use:
88--
9−-- * @*@: matches exactly one element of an identifier;
9+-- * @*@: matches at most one element of an identifier;
1010--
1111-- * @**@: matches one or more elements of an identifier.
1212--
1313-- Some examples:
1414--
15−-- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@ nor
16−-- @foo@;
15+-- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@;
1716--
18−-- * @**@ will match any non-empty identifier;
17+-- * @**@ will match any identifier;
1918--
20−-- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@ nor
21−-- @foo@;
19+-- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@;
2220--
23−-- A small warning: patterns are not globs. Using @foo\/*.markdown@ will not do
24−-- what you probably intended, as it will only match the file which is literally
25−-- called @foo\/*.markdown@. Remember that these captures only work on elements
26−-- of identifiers as a whole; not on parts of these elements.
21+-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
2722--
28−-- Furthermore, the 'match' function allows the user to get access to the
29−-- elements captured by the capture elements in the pattern.
23+-- The 'match' function allows the user to get access to the elements captured
24+-- by the capture elements in the pattern.
3025--
3126module Hakyll.Core.Identifier.Pattern
3227 ( Pattern
@@ -39,7 +34,8 @@ module Hakyll.Core.Identifier.Pattern
3934 , fromCaptures
4035 ) where
4136
42−import Data.List (intercalate)
37+import Data.List (isPrefixOf, inits, tails)
38+import Control.Arrow ((&&&), (>>>))
4339import Control.Monad (msum)
4440import Data.Maybe (isJust)
4541import Data.Monoid (mempty, mappend)
@@ -50,23 +46,15 @@ import Hakyll.Core.Identifier
5046
5147-- | One base element of a pattern
5248--
53−data PatternComponent = CaptureOne
49+data PatternComponent = Capture
5450 | CaptureMany
5551 | Literal String
56− deriving (Eq)
57−
58−instance Show PatternComponent where
59− show CaptureOne = "*"
60− show CaptureMany = "**"
61− show (Literal s) = s
52+ deriving (Eq, Show)
6253
6354-- | Type that allows matching on identifiers
6455--
6556newtype Pattern = Pattern {unPattern :: [PatternComponent]}
66− deriving (Eq)
67−
68−instance Show Pattern where
69− show = intercalate "/" . map show . unPattern
57+ deriving (Eq, Show)
7058
7159instance IsString Pattern where
7260 fromString = parsePattern
@@ -74,16 +62,20 @@ instance IsString Pattern where
7462-- | Parse a pattern from a string
7563--
7664parsePattern :: String -> Pattern
77−parsePattern = Pattern . map toPattern . unIdentifier . parseIdentifier
65+parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIdentifier . parseIdentifier
7866 where
79− toPattern x | x == "*" = CaptureOne
80− | x == "**" = CaptureMany
81− | otherwise = Literal x
67+ parse' str =
68+ let (chunk, rest) = break (`elem` "\\*") str
69+ in case rest of
70+ ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse' xs
71+ ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse' xs
72+ ('*' : xs) -> Literal chunk : Capture : parse' xs
73+ xs -> Literal chunk : Literal xs : []
8274
8375-- | Match an identifier against a pattern, generating a list of captures
8476--
8577match :: Pattern -> Identifier -> Maybe [Identifier]
86−match (Pattern p) (Identifier i) = fmap (map Identifier) $ match' p i
78+match p (Identifier i) = fmap (map Identifier) $ match' (unPattern p) i
8779
8880-- | Check if an identifier matches a pattern
8981--
@@ -95,31 +87,30 @@ doesMatch p = isJust . match p
9587matches :: Pattern -> [Identifier] -> [Identifier]
9688matches p = filter (doesMatch p)
9789
98−-- | Split a list at every possible point, generate a list of (init, tail) cases
90+-- | Split a list at every possible point, generate a list of (init, tail)
91+-- cases. The result is sorted with inits decreasing in length.
9992--
10093splits :: [a] -> [([a], [a])]
101−splits ls = reverse $ splits' [] ls
102− where
103− splits' lx ly = (lx, ly) : case ly of
104− [] -> []
105− (y : ys) -> splits' (lx ++ [y]) ys
94+splits = inits &&& tails >>> uncurry zip >>> reverse
10695
10796-- | Internal verion of 'match'
10897--
109−match' :: [PatternComponent] -> [String] -> Maybe [[String]]
98+match' :: [PatternComponent] -> String -> Maybe [String]
11099match' [] [] = Just [] -- An empty match
111−match' [] _ = Nothing -- No match
112−match' _ [] = Nothing -- No match
113−match' (m : ms) (s : ss) = case m of
114− -- Take one string and one literal, fail on mismatch
115− Literal l -> if s == l then match' ms ss else Nothing
116− -- Take one string and one capture
117− CaptureOne -> fmap ([s] :) $ match' ms ss
118− -- Take one string, and one or many captures
119− CaptureMany ->
120− let take' (i, t) = fmap (i :) $ match' ms t
121− in msum $ map take' $ splits (s : ss)
122−
100+match' [] _ = Nothing -- No match
101+-- match' _ [] = Nothing -- No match
102+match' (Literal l : ms) str
103+ -- Match the literal against the string
104+ | l `isPrefixOf` str = match' ms $ drop (length l) str
105+ | otherwise = Nothing
106+match' (Capture : ms) str =
107+ -- Match until the next /
108+ let (chunk, rest) = break (== '/') str
109+ in msum $ [ fmap (i :) (match' ms (t ++ rest)) | (i, t) <- splits chunk ]
110+match' (CaptureMany : ms) str =
111+ -- Match everything
112+ msum $ [ fmap (i :) (match' ms t) | (i, t) <- splits str ]
113+
123114-- | Create an identifier from a pattern by filling in the captures with a given
124115-- string
125116--
@@ -152,9 +143,9 @@ fromCaptureString pattern = fromCapture pattern . parseIdentifier
152143fromCaptures :: Pattern -> [Identifier] -> Identifier
153144fromCaptures (Pattern []) _ = mempty
154145fromCaptures (Pattern (m : ms)) [] = case m of
155− Literal l -> Identifier [l] `mappend` fromCaptures (Pattern ms) []
146+ Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) []
156147 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: "
157148 ++ "identifier list exhausted"
158149fromCaptures (Pattern (m : ms)) ids@(i : is) = case m of
159− Literal l -> Identifier [l] `mappend` fromCaptures (Pattern ms) ids
150+ Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) ids
160151 _ -> i `mappend` fromCaptures (Pattern ms) is