1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
-- | Module providing pattern matching and capturing on 'Identifier's.
--
-- A very simple pattern could be, for example, @foo\/bar@. This pattern will
-- only match the exact @foo\/bar@ identifier.
--
-- To match more than one identifier, there are different captures that one can
-- use:
--
-- * @*@: matches at most one element of an identifier;
--
-- * @**@: matches one or more elements of an identifier.
--
-- Some examples:
--
-- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@;
--
-- * @**@ will match any identifier;
--
-- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@;
--
-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
--
-- The 'match' function allows the user to get access to the elements captured
-- by the capture elements in the pattern.
--
module Hakyll.Core.Identifier.Pattern
( Pattern
, parsePattern
, match
, doesMatch
, matches
, fromCapture
, fromCaptureString
, fromCaptures
) where
import Data.List (isPrefixOf, inits, tails)
import Control.Arrow ((&&&), (>>>))
import Control.Monad (msum)
import Data.Maybe (isJust)
import Data.Monoid (mempty, mappend)
import GHC.Exts (IsString, fromString)
import Hakyll.Core.Identifier
-- | One base element of a pattern
--
data PatternComponent = Capture
| CaptureMany
| Literal String
deriving (Eq, Show)
-- | Type that allows matching on identifiers
--
newtype Pattern = Pattern {unPattern :: [PatternComponent]}
deriving (Eq, Show)
instance IsString Pattern where
fromString = parsePattern
-- | Parse a pattern from a string
--
parsePattern :: String -> Pattern
parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIdentifier . parseIdentifier
where
parse' str =
let (chunk, rest) = break (`elem` "\\*") str
in case rest of
('\\' : x : xs) -> Literal (chunk ++ [x]) : parse' xs
('*' : '*' : xs) -> Literal chunk : CaptureMany : parse' xs
('*' : xs) -> Literal chunk : Capture : parse' xs
xs -> Literal chunk : Literal xs : []
-- | Match an identifier against a pattern, generating a list of captures
--
match :: Pattern -> Identifier -> Maybe [Identifier]
match p (Identifier i) = fmap (map Identifier) $ match' (unPattern p) i
-- | Check if an identifier matches a pattern
--
doesMatch :: Pattern -> Identifier -> Bool
doesMatch p = isJust . match p
-- | Given a list of identifiers, retain only those who match the given pattern
--
matches :: Pattern -> [Identifier] -> [Identifier]
matches p = filter (doesMatch p)
-- | Split a list at every possible point, generate a list of (init, tail)
-- cases. The result is sorted with inits decreasing in length.
--
splits :: [a] -> [([a], [a])]
splits = inits &&& tails >>> uncurry zip >>> reverse
-- | Internal verion of 'match'
--
match' :: [PatternComponent] -> String -> Maybe [String]
match' [] [] = Just [] -- An empty match
match' [] _ = Nothing -- No match
-- match' _ [] = Nothing -- No match
match' (Literal l : ms) str
-- Match the literal against the string
| l `isPrefixOf` str = match' ms $ drop (length l) str
| otherwise = Nothing
match' (Capture : ms) str =
-- Match until the next /
let (chunk, rest) = break (== '/') str
in msum $ [ fmap (i :) (match' ms (t ++ rest)) | (i, t) <- splits chunk ]
match' (CaptureMany : ms) str =
-- Match everything
msum $ [ fmap (i :) (match' ms t) | (i, t) <- splits str ]
-- | Create an identifier from a pattern by filling in the captures with a given
-- string
--
-- Example:
--
-- > fromCapture (parsePattern "tags/*") (parseIdentifier "foo")
--
-- Result:
--
-- > "tags/foo"
--
fromCapture :: Pattern -> Identifier -> Identifier
fromCapture pattern = fromCaptures pattern . repeat
-- | Simplified version of 'fromCapture' which takes a 'String' instead of an
-- 'Identifier'
--
-- > fromCaptureString (parsePattern "tags/*") "foo"
--
-- Result:
--
-- > "tags/foo"
--
fromCaptureString :: Pattern -> String -> Identifier
fromCaptureString pattern = fromCapture pattern . parseIdentifier
-- | Create an identifier from a pattern by filling in the captures with the
-- given list of strings
--
fromCaptures :: Pattern -> [Identifier] -> Identifier
fromCaptures (Pattern []) _ = mempty
fromCaptures (Pattern (m : ms)) [] = case m of
Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) []
_ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: "
++ "identifier list exhausted"
fromCaptures (Pattern (m : ms)) ids@(i : is) = case m of
Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) ids
_ -> i `mappend` fromCaptures (Pattern ms) is
|
