git.iko.soy/hakyll
on 877cb21 help sign in
hakyll/src/Hakyll/Core/Identifier/Pattern.hs
286 lines 9.6 kB history raw
1--------------------------------------------------------------------------------
2-- | Module providing pattern matching and capturing on 'Identifier's.
3-- 'Pattern's come in two kinds:
4--
5-- * Simple glob patterns, like @foo\/*@;
6--
7-- * Custom, arbitrary predicates of the type @Identifier -> Bool@.
8--
9-- They both have advantages and disadvantages. By default, globs are used,
10-- unless you construct your 'Pattern' using the 'predicate' function.
11--
12-- A very simple pattern could be, for example, @foo\/bar@. This pattern will
13-- only match the exact @foo\/bar@ identifier.
14--
15-- To match more than one identifier, there are different captures that one can
16-- use:
17--
18-- * @*@: matches at most one element of an identifier;
19--
20-- * @**@: matches one or more elements of an identifier.
21--
22-- Some examples:
23--
24-- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@;
25--
26-- * @**@ will match any identifier;
27--
28-- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@;
29--
30-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
31--
32-- The 'capture' function allows the user to get access to the elements captured
33-- by the capture elements in the pattern.
34--
35-- Like an 'Identifier', a 'Pattern' also has a type parameter. This is simply
36-- an extra layer of safety, and can be discarded using the 'castPattern'
37-- function.
38module Hakyll.Core.Identifier.Pattern
39 ( -- * The pattern type
40 Pattern
42 -- * Creating patterns
43 , fromGlob
44 , fromList
45 , fromRegex
46 , fromVersion
48 -- * Manipulating patterns
49 , complement
50 , withVersion
52 -- * Applying patterns
53 , matches
54 , filterMatches
56 -- * Capturing strings
57 , capture
58 , fromCapture
59 , fromCaptures
60 ) where
63--------------------------------------------------------------------------------
64import Control.Applicative (pure, (<$>), (<*>))
65import Control.Arrow ((&&&), (>>>))
66import Control.Monad (msum)
67import Data.Binary (Binary (..), getWord8, putWord8)
68import Data.List (inits, isPrefixOf, tails)
69import Data.Maybe (isJust)
70import Data.Monoid (Monoid, mappend, mempty)
73--------------------------------------------------------------------------------
74import GHC.Exts (IsString, fromString)
75import Text.Regex.TDFA ((=~))
78--------------------------------------------------------------------------------
79import Hakyll.Core.Identifier
82--------------------------------------------------------------------------------
83-- | Elements of a glob pattern
84data GlobComponent
85 = Capture
86 | CaptureMany
87 | Literal String
88 deriving (Eq, Show)
91--------------------------------------------------------------------------------
92instance Binary GlobComponent where
93 put Capture = putWord8 0
94 put CaptureMany = putWord8 1
95 put (Literal s) = putWord8 2 >> put s
97 get = getWord8 >>= \t -> case t of
98 0 -> pure Capture
99 1 -> pure CaptureMany
100 2 -> Literal <$> get
101 _ -> error "Data.Binary.get: Invalid GlobComponent"
104--------------------------------------------------------------------------------
105-- | Type that allows matching on identifiers
106data Pattern
107 = Everything
108 | Complement Pattern
109 | And Pattern Pattern
110 | Glob [GlobComponent]
111 | List [Identifier] -- TODO Maybe use a set here
112 | Regex String
113 | Version (Maybe String)
114 deriving (Show)
117--------------------------------------------------------------------------------
118instance Binary Pattern where
119 put Everything = putWord8 0
120 put (Complement p) = putWord8 1 >> put p
121 put (And x y) = putWord8 2 >> put x >> put y
122 put (Glob g) = putWord8 3 >> put g
123 put (List is) = putWord8 4 >> put is
124 put (Regex r) = putWord8 5 >> put r
125 put (Version v) = putWord8 6 >> put v
127 get = getWord8 >>= \t -> case t of
128 0 -> pure Everything
129 1 -> Complement <$> get
130 2 -> And <$> get <*> get
131 3 -> Glob <$> get
132 4 -> List <$> get
133 5 -> Regex <$> get
134 _ -> Version <$> get
137--------------------------------------------------------------------------------
138instance IsString Pattern where
139 fromString = fromGlob
142--------------------------------------------------------------------------------
143instance Monoid Pattern where
144 mempty = Everything
145 mappend = And
148--------------------------------------------------------------------------------
149-- | Parse a pattern from a string
150fromGlob :: String -> Pattern
151fromGlob = Glob . parse'
152 where
153 parse' str =
154 let (chunk, rest) = break (`elem` "\\*") str
155 in case rest of
156 ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse' xs
157 ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse' xs
158 ('*' : xs) -> Literal chunk : Capture : parse' xs
159 xs -> Literal chunk : Literal xs : []
162--------------------------------------------------------------------------------
163-- | Create a 'Pattern' from a list of 'Identifier's it should match
164fromList :: [Identifier] -> Pattern
165fromList = List
168--------------------------------------------------------------------------------
169-- | Create a 'Pattern' from a regex
170--
171-- Example:
172--
173-- > regex "^foo/[^x]*$
174fromRegex :: String -> Pattern
175fromRegex = Regex
178--------------------------------------------------------------------------------
179fromVersion :: Maybe String -> Pattern
180fromVersion = Version
183--------------------------------------------------------------------------------
184-- | Inverts a pattern, e.g.
185--
186-- > complement "foo/bar.html"
187--
188-- will match /anything/ except @\"foo\/bar.html\"@
189complement :: Pattern -> Pattern
190complement = Complement
193--------------------------------------------------------------------------------
194-- | Specify a version, e.g.
195--
196-- > "foo/*.markdown" `withVersion` "pdf"
197withVersion :: Pattern -> String -> Pattern
198withVersion p v = And p $ fromVersion $ Just v
201--------------------------------------------------------------------------------
202-- | Check if an identifier matches a pattern
203matches :: Pattern -> Identifier -> Bool
204matches Everything _ = True
205matches (Complement p) i = not $ matches p i
206matches (And x y) i = matches x i && matches y i
207matches (Glob p) i = isJust $ capture (Glob p) i
208matches (List l) i = i `elem` l
209matches (Regex r) i = toFilePath i =~ r
210matches (Version v) i = identifierVersion i == v
213--------------------------------------------------------------------------------
214-- | Given a list of identifiers, retain only those who match the given pattern
215filterMatches :: Pattern -> [Identifier] -> [Identifier]
216filterMatches = filter . matches
219--------------------------------------------------------------------------------
220-- | Split a list at every possible point, generate a list of (init, tail)
221-- cases. The result is sorted with inits decreasing in length.
222splits :: [a] -> [([a], [a])]
223splits = inits &&& tails >>> uncurry zip >>> reverse
226--------------------------------------------------------------------------------
227-- | Match a glob against a pattern, generating a list of captures
228capture :: Pattern -> Identifier -> Maybe [String]
229capture (Glob p) i = capture' p (toFilePath i)
230capture _ _ = Nothing
233--------------------------------------------------------------------------------
234-- | Internal verion of 'capture'
235capture' :: [GlobComponent] -> String -> Maybe [String]
236capture' [] [] = Just [] -- An empty match
237capture' [] _ = Nothing -- No match
238capture' (Literal l : ms) str
239 -- Match the literal against the string
240 | l `isPrefixOf` str = capture' ms $ drop (length l) str
241 | otherwise = Nothing
242capture' (Capture : ms) str =
243 -- Match until the next /
244 let (chunk, rest) = break (== '/') str
245 in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
246capture' (CaptureMany : ms) str =
247 -- Match everything
248 msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
251--------------------------------------------------------------------------------
252-- | Create an identifier from a pattern by filling in the captures with a given
253-- string
254--
255-- Example:
256--
257-- > fromCapture (parseGlob "tags/*") "foo"
258--
259-- Result:
260--
261-- > "tags/foo"
262fromCapture :: Pattern -> String -> Identifier
263fromCapture pattern = fromCaptures pattern . repeat
266--------------------------------------------------------------------------------
267-- | Create an identifier from a pattern by filling in the captures with the
268-- given list of strings
269fromCaptures :: Pattern -> [String] -> Identifier
270fromCaptures (Glob p) = fromFilePath . fromCaptures' p
271fromCaptures _ = error $
272 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++
273 "on simple globs!"
276--------------------------------------------------------------------------------
277-- | Internally used version of 'fromCaptures'
278fromCaptures' :: [GlobComponent] -> [String] -> String
279fromCaptures' [] _ = mempty
280fromCaptures' (m : ms) [] = case m of
281 Literal l -> l `mappend` fromCaptures' ms []
282 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
283 ++ "identifier list exhausted"
284fromCaptures' (m : ms) ids@(i : is) = case m of
285 Literal l -> l `mappend` fromCaptures' ms ids
286 _ -> i `mappend` fromCaptures' ms is