git.iko.soy/hakyll
on 6a88430 help sign in
hakyll/src/Hakyll/Core/Identifier/Pattern.hs
322 lines 11 kB history raw
1--------------------------------------------------------------------------------
2-- | As 'Identifier' is used to specify a single item, a 'Pattern' is used to
3-- specify a list of items.
4--
5-- In most cases, globs are used for patterns.
6--
7-- A very simple pattern of such a pattern is @\"foo\/bar\"@. This pattern will
8-- only match the exact @foo\/bar@ identifier.
9--
10-- To match more than one identifier, there are different captures that one can
11-- use:
12--
13-- * @\"*\"@: matches at most one element of an identifier;
14--
15-- * @\"**\"@: matches one or more elements of an identifier.
16--
17-- Some examples:
18--
19-- * @\"foo\/*\"@ will match @\"foo\/bar\"@ and @\"foo\/foo\"@, but not
20-- @\"foo\/bar\/qux\"@;
21--
22-- * @\"**\"@ will match any identifier;
23--
24-- * @\"foo\/**\"@ will match @\"foo\/bar\"@ and @\"foo\/bar\/qux\"@, but not
25-- @\"bar\/foo\"@;
26--
27-- * @\"foo\/*.html\"@ will match all HTML files in the @\"foo\/\"@ directory.
28--
29-- The 'capture' function allows the user to get access to the elements captured
30-- by the capture elements in the pattern.
31module Hakyll.Core.Identifier.Pattern
32 ( -- * The pattern type
33 Pattern
35 -- * Creating patterns
36 , fromGlob
37 , fromList
38 , fromRegex
39 , fromVersion
40 , hasVersion
41 , hasNoVersion
43 -- * Composing patterns
44 , (.&&.)
45 , (.||.)
46 , complement
48 -- * Applying patterns
49 , matches
50 , filterMatches
52 -- * Capturing strings
53 , capture
54 , fromCapture
55 , fromCaptures
56 ) where
59--------------------------------------------------------------------------------
60import Control.Arrow ((&&&), (>>>))
61import Control.Monad (msum)
62import Data.Binary (Binary (..), getWord8, putWord8)
63import Data.List (inits, isPrefixOf, tails)
64import Data.Maybe (isJust)
65import Data.Set (Set)
66import qualified Data.Set as S
69--------------------------------------------------------------------------------
70import GHC.Exts (IsString, fromString)
71import Text.Regex.TDFA ((=~))
74--------------------------------------------------------------------------------
75import Hakyll.Core.Identifier
78--------------------------------------------------------------------------------
79-- | Elements of a glob pattern
80data GlobComponent
81 = Capture
82 | CaptureMany
83 | Literal String
84 deriving (Eq, Show)
87--------------------------------------------------------------------------------
88instance Binary GlobComponent where
89 put Capture = putWord8 0
90 put CaptureMany = putWord8 1
91 put (Literal s) = putWord8 2 >> put s
93 get = getWord8 >>= \t -> case t of
94 0 -> pure Capture
95 1 -> pure CaptureMany
96 2 -> Literal <$> get
97 _ -> error "Data.Binary.get: Invalid GlobComponent"
100--------------------------------------------------------------------------------
101-- | Type that allows matching on identifiers
102data Pattern
103 = Everything
104 | Complement Pattern
105 | And Pattern Pattern
106 | Glob [GlobComponent]
107 | List (Set Identifier)
108 | Regex String
109 | Version (Maybe String)
110 deriving (Show)
113--------------------------------------------------------------------------------
114instance Binary Pattern where
115 put Everything = putWord8 0
116 put (Complement p) = putWord8 1 >> put p
117 put (And x y) = putWord8 2 >> put x >> put y
118 put (Glob g) = putWord8 3 >> put g
119 put (List is) = putWord8 4 >> put is
120 put (Regex r) = putWord8 5 >> put r
121 put (Version v) = putWord8 6 >> put v
123 get = getWord8 >>= \t -> case t of
124 0 -> pure Everything
125 1 -> Complement <$> get
126 2 -> And <$> get <*> get
127 3 -> Glob <$> get
128 4 -> List <$> get
129 5 -> Regex <$> get
130 _ -> Version <$> get
133--------------------------------------------------------------------------------
134instance IsString Pattern where
135 fromString = fromGlob
138--------------------------------------------------------------------------------
139instance Monoid Pattern where
140 mempty = Everything
141 mappend = (.&&.)
144--------------------------------------------------------------------------------
145-- | Parse a pattern from a string
146fromGlob :: String -> Pattern
147fromGlob = Glob . parse'
148 where
149 parse' str =
150 let (chunk, rest) = break (`elem` "\\*") str
151 in case rest of
152 ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse' xs
153 ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse' xs
154 ('*' : xs) -> Literal chunk : Capture : parse' xs
155 xs -> Literal chunk : Literal xs : []
158--------------------------------------------------------------------------------
159-- | Create a 'Pattern' from a list of 'Identifier's it should match.
160--
161-- /Warning/: use this carefully with 'hasNoVersion' and 'hasVersion'. The
162-- 'Identifier's in the list /already/ have versions assigned, and the pattern
163-- will then only match the intersection of both versions.
164--
165-- A more concrete example,
166--
167-- > fromList ["foo.markdown"] .&&. hasVersion "pdf"
168--
169-- will not match anything! The @"foo.markdown"@ 'Identifier' has no version
170-- assigned, so the LHS of '.&&.' will only match this 'Identifier' with no
171-- version. The RHS only matches 'Identifier's with version set to @"pdf"@ --
172-- hence, this pattern matches nothing.
173--
174-- The correct way to use this is:
175--
176-- > fromList $ map (setVersion $ Just "pdf") ["foo.markdown"]
177fromList :: [Identifier] -> Pattern
178fromList = List . S.fromList
181--------------------------------------------------------------------------------
182-- | Create a 'Pattern' from a regex
183--
184-- Example:
185--
186-- > regex "^foo/[^x]*$
187fromRegex :: String -> Pattern
188fromRegex = Regex
191--------------------------------------------------------------------------------
192-- | Create a pattern which matches all items with the given version.
193fromVersion :: Maybe String -> Pattern
194fromVersion = Version
197--------------------------------------------------------------------------------
198-- | Specify a version, e.g.
199--
200-- > "foo/*.markdown" .&&. hasVersion "pdf"
201hasVersion :: String -> Pattern
202hasVersion = fromVersion . Just
205--------------------------------------------------------------------------------
206-- | Match only if the identifier has no version set, e.g.
207--
208-- > "foo/*.markdown" .&&. hasNoVersion
209hasNoVersion :: Pattern
210hasNoVersion = fromVersion Nothing
213--------------------------------------------------------------------------------
214-- | '&&' for patterns: the given identifier must match both subterms
215(.&&.) :: Pattern -> Pattern -> Pattern
216x .&&. y = And x y
217infixr 3 .&&.
220--------------------------------------------------------------------------------
221-- | '||' for patterns: the given identifier must match any subterm
222(.||.) :: Pattern -> Pattern -> Pattern
223x .||. y = complement (complement x `And` complement y) -- De Morgan's law
224infixr 2 .||.
227--------------------------------------------------------------------------------
228-- | Inverts a pattern, e.g.
229--
230-- > complement "foo/bar.html"
231--
232-- will match /anything/ except @\"foo\/bar.html\"@
233complement :: Pattern -> Pattern
234complement = Complement
237--------------------------------------------------------------------------------
238-- | Check if an identifier matches a pattern
239matches :: Pattern -> Identifier -> Bool
240matches Everything _ = True
241matches (Complement p) i = not $ matches p i
242matches (And x y) i = matches x i && matches y i
243matches (Glob p) i = isJust $ capture (Glob p) i
244matches (List l) i = i `S.member` l
245matches (Regex r) i = toFilePath i =~ r
246matches (Version v) i = identifierVersion i == v
249--------------------------------------------------------------------------------
250-- | Given a list of identifiers, retain only those who match the given pattern
251filterMatches :: Pattern -> [Identifier] -> [Identifier]
252filterMatches = filter . matches
255--------------------------------------------------------------------------------
256-- | Split a list at every possible point, generate a list of (init, tail)
257-- cases. The result is sorted with inits decreasing in length.
258splits :: [a] -> [([a], [a])]
259splits = inits &&& tails >>> uncurry zip >>> reverse
262--------------------------------------------------------------------------------
263-- | Match a glob against a pattern, generating a list of captures
264capture :: Pattern -> Identifier -> Maybe [String]
265capture (Glob p) i = capture' p (toFilePath i)
266capture _ _ = Nothing
269--------------------------------------------------------------------------------
270-- | Internal verion of 'capture'
271capture' :: [GlobComponent] -> String -> Maybe [String]
272capture' [] [] = Just [] -- An empty match
273capture' [] _ = Nothing -- No match
274capture' (Literal l : ms) str
275 -- Match the literal against the string
276 | l `isPrefixOf` str = capture' ms $ drop (length l) str
277 | otherwise = Nothing
278capture' (Capture : ms) str =
279 -- Match until the next /
280 let (chunk, rest) = break (== '/') str
281 in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
282capture' (CaptureMany : ms) str =
283 -- Match everything
284 msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
287--------------------------------------------------------------------------------
288-- | Create an identifier from a pattern by filling in the captures with a given
289-- string
290--
291-- Example:
292--
293-- > fromCapture (fromGlob "tags/*") "foo"
294--
295-- Result:
296--
297-- > "tags/foo"
298fromCapture :: Pattern -> String -> Identifier
299fromCapture pattern = fromCaptures pattern . repeat
302--------------------------------------------------------------------------------
303-- | Create an identifier from a pattern by filling in the captures with the
304-- given list of strings
305fromCaptures :: Pattern -> [String] -> Identifier
306fromCaptures (Glob p) = fromFilePath . fromCaptures' p
307fromCaptures _ = error $
308 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++
309 "on simple globs!"
312--------------------------------------------------------------------------------
313-- | Internally used version of 'fromCaptures'
314fromCaptures' :: [GlobComponent] -> [String] -> String
315fromCaptures' [] _ = mempty
316fromCaptures' (m : ms) [] = case m of
317 Literal l -> l `mappend` fromCaptures' ms []
318 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
319 ++ "identifier list exhausted"
320fromCaptures' (m : ms) ids@(i : is) = case m of
321 Literal l -> l `mappend` fromCaptures' ms ids
322 _ -> i `mappend` fromCaptures' ms is