git.iko.soy/hakyll
on 760b434 help sign in
hakyll/src/Hakyll/Core/Identifier/Pattern.hs
299 lines 10 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
51 , castPattern
53 -- * Applying patterns
54 , matches
55 , filterMatches
57 -- * Capturing strings
58 , capture
59 , fromCapture
60 , fromCaptures
61 ) where
64--------------------------------------------------------------------------------
65import Control.Applicative (pure, (<$>), (<*>))
66import Control.Arrow ((&&&), (>>>))
67import Control.Monad (msum)
68import Data.Binary (Binary (..), getWord8, putWord8)
69import Data.List (inits, isPrefixOf, tails)
70import Data.Maybe (isJust)
71import Data.Monoid (Monoid, mappend, mempty)
74--------------------------------------------------------------------------------
75import GHC.Exts (IsString, fromString)
76import Text.Regex.TDFA ((=~))
79--------------------------------------------------------------------------------
80import Hakyll.Core.Identifier
83--------------------------------------------------------------------------------
84-- | Elements of a glob pattern
85data GlobComponent
86 = Capture
87 | CaptureMany
88 | Literal String
89 deriving (Eq, Show)
92--------------------------------------------------------------------------------
93instance Binary GlobComponent where
94 put Capture = putWord8 0
95 put CaptureMany = putWord8 1
96 put (Literal s) = putWord8 2 >> put s
98 get = getWord8 >>= \t -> case t of
99 0 -> pure Capture
100 1 -> pure CaptureMany
101 2 -> Literal <$> get
102 _ -> error "Data.Binary.get: Invalid GlobComponent"
105--------------------------------------------------------------------------------
106-- | Type that allows matching on identifiers
107data Pattern a
108 = Everything
109 | Complement (Pattern a)
110 | And (Pattern a) (Pattern a)
111 | Glob [GlobComponent]
112 | List [Identifier a] -- TODO Maybe use a set here
113 | Regex String
114 | Version (Maybe String)
115 deriving (Show)
118--------------------------------------------------------------------------------
119instance Binary (Pattern a) where
120 put Everything = putWord8 0
121 put (Complement p) = putWord8 1 >> put p
122 put (And x y) = putWord8 2 >> put x >> put y
123 put (Glob g) = putWord8 3 >> put g
124 put (List is) = putWord8 4 >> put is
125 put (Regex r) = putWord8 5 >> put r
126 put (Version v) = putWord8 6 >> put v
128 get = getWord8 >>= \t -> case t of
129 0 -> pure Everything
130 1 -> Complement <$> get
131 2 -> And <$> get <*> get
132 3 -> Glob <$> get
133 4 -> List <$> get
134 5 -> Regex <$> get
135 _ -> Version <$> get
138--------------------------------------------------------------------------------
139instance IsString (Pattern a) where
140 fromString = fromGlob
143--------------------------------------------------------------------------------
144instance Monoid (Pattern a) where
145 mempty = Everything
146 mappend = And
149--------------------------------------------------------------------------------
150-- | Parse a pattern from a string
151fromGlob :: String -> Pattern a
152fromGlob = Glob . parse'
153 where
154 parse' str =
155 let (chunk, rest) = break (`elem` "\\*") str
156 in case rest of
157 ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse' xs
158 ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse' xs
159 ('*' : xs) -> Literal chunk : Capture : parse' xs
160 xs -> Literal chunk : Literal xs : []
163--------------------------------------------------------------------------------
164-- | Create a 'Pattern' from a list of 'Identifier's it should match
165fromList :: [Identifier a] -> Pattern a
166fromList = List
169--------------------------------------------------------------------------------
170-- | Create a 'Pattern' from a regex
171--
172-- Example:
173--
174-- > regex "^foo/[^x]*$
175fromRegex :: String -> Pattern a
176fromRegex = Regex
179--------------------------------------------------------------------------------
180fromVersion :: Maybe String -> Pattern a
181fromVersion = Version
184--------------------------------------------------------------------------------
185-- | Inverts a pattern, e.g.
186--
187-- > complement "foo/bar.html"
188--
189-- will match /anything/ except @\"foo\/bar.html\"@
190complement :: Pattern a -> Pattern a
191complement = Complement
194--------------------------------------------------------------------------------
195-- | Specify a version, e.g.
196--
197-- > "foo/*.markdown" `withVersion` "pdf"
198withVersion :: Pattern a -> String -> Pattern a
199withVersion p v = And p $ fromVersion $ Just v
202--------------------------------------------------------------------------------
203-- | Discard the phantom type parameter
204castPattern :: Pattern a -> Pattern b
205castPattern Everything = Everything
206castPattern (Complement x) = Complement (castPattern x)
207castPattern (And x y) = And (castPattern x) (castPattern y)
208castPattern (Glob g) = Glob g
209castPattern (List l) = List $ map castIdentifier l
210castPattern (Regex r) = Regex r
211castPattern (Version v) = Version v
214--------------------------------------------------------------------------------
215-- | Check if an identifier matches a pattern
216matches :: Pattern a -> Identifier a -> Bool
217matches Everything _ = True
218matches (Complement p) i = not $ matches p i
219matches (And x y) i = matches x i && matches y i
220matches (Glob p) i = isJust $ capture (Glob p) i
221matches (List l) i = i `elem` l
222matches (Regex r) i = toFilePath i =~ r
223matches (Version v) i = identifierVersion i == v
226--------------------------------------------------------------------------------
227-- | Given a list of identifiers, retain only those who match the given pattern
228filterMatches :: Pattern a -> [Identifier a] -> [Identifier a]
229filterMatches = filter . matches
232--------------------------------------------------------------------------------
233-- | Split a list at every possible point, generate a list of (init, tail)
234-- cases. The result is sorted with inits decreasing in length.
235splits :: [a] -> [([a], [a])]
236splits = inits &&& tails >>> uncurry zip >>> reverse
239--------------------------------------------------------------------------------
240-- | Match a glob against a pattern, generating a list of captures
241capture :: Pattern a -> Identifier a -> Maybe [String]
242capture (Glob p) i = capture' p (toFilePath i)
243capture _ _ = Nothing
246--------------------------------------------------------------------------------
247-- | Internal verion of 'capture'
248capture' :: [GlobComponent] -> String -> Maybe [String]
249capture' [] [] = Just [] -- An empty match
250capture' [] _ = Nothing -- No match
251capture' (Literal l : ms) str
252 -- Match the literal against the string
253 | l `isPrefixOf` str = capture' ms $ drop (length l) str
254 | otherwise = Nothing
255capture' (Capture : ms) str =
256 -- Match until the next /
257 let (chunk, rest) = break (== '/') str
258 in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
259capture' (CaptureMany : ms) str =
260 -- Match everything
261 msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
264--------------------------------------------------------------------------------
265-- | Create an identifier from a pattern by filling in the captures with a given
266-- string
267--
268-- Example:
269--
270-- > fromCapture (parseGlob "tags/*") "foo"
271--
272-- Result:
273--
274-- > "tags/foo"
275fromCapture :: Pattern a -> String -> Identifier a
276fromCapture pattern = fromCaptures pattern . repeat
279--------------------------------------------------------------------------------
280-- | Create an identifier from a pattern by filling in the captures with the
281-- given list of strings
282fromCaptures :: Pattern a -> [String] -> Identifier a
283fromCaptures (Glob p) = fromFilePath . fromCaptures' p
284fromCaptures _ = error $
285 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++
286 "on simple globs!"
289--------------------------------------------------------------------------------
290-- | Internally used version of 'fromCaptures'
291fromCaptures' :: [GlobComponent] -> [String] -> String
292fromCaptures' [] _ = mempty
293fromCaptures' (m : ms) [] = case m of
294 Literal l -> l `mappend` fromCaptures' ms []
295 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
296 ++ "identifier list exhausted"
297fromCaptures' (m : ms) ids@(i : is) = case m of
298 Literal l -> l `mappend` fromCaptures' ms ids
299 _ -> i `mappend` fromCaptures' ms is