git.iko.soy/hakyll
on 3e80608 help sign in
hakyll/src/Hakyll/Core/Identifier/Pattern.hs
223 lines 6.8 kB history raw
1-- | Module providing pattern matching and capturing on 'Identifier's.
2-- 'Pattern's come in two kinds:
3--
4-- * Simple glob patterns, like @foo\/*@;
5--
6-- * Custom, arbitrary predicates of the type @Identifier -> Bool@.
7--
8-- They both have advantages and disadvantages. By default, globs are used,
9-- unless you construct your 'Pattern' using the 'predicate' function.
10--
11-- A very simple pattern could be, for example, @foo\/bar@. This pattern will
12-- only match the exact @foo\/bar@ identifier.
13--
14-- To match more than one identifier, there are different captures that one can
15-- use:
16--
17-- * @*@: matches at most one element of an identifier;
18--
19-- * @**@: matches one or more elements of an identifier.
20--
21-- Some examples:
22--
23-- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@;
24--
25-- * @**@ will match any identifier;
26--
27-- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@;
28--
29-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
30--
31-- The 'capture' function allows the user to get access to the elements captured
32-- by the capture elements in the pattern.
33--
34-- Like an 'Identifier', a 'Pattern' also has a type parameter. This is simply
35-- an extra layer of safety, and can be discarded using the 'castPattern'
36-- function.
37--
38module Hakyll.Core.Identifier.Pattern
39 ( -- * The pattern type
40 Pattern
41 , castPattern
43 -- * Creating patterns
44 , parseGlob
45 , predicate
46 , list
47 , regex
48 , inGroup
49 , complement
51 -- * Applying patterns
52 , matches
53 , filterMatches
54 , capture
55 , fromCapture
56 , fromCaptures
57 ) where
59import Data.List (isPrefixOf, inits, tails)
60import Control.Arrow ((&&&), (>>>))
61import Control.Monad (msum)
62import Data.Maybe (isJust, fromMaybe)
63import Data.Monoid (Monoid, mempty, mappend)
65import GHC.Exts (IsString, fromString)
66import Text.Regex.TDFA ((=~~))
68import Hakyll.Core.Identifier
70-- | One base element of a pattern
71--
72data GlobComponent = Capture
73 | CaptureMany
74 | Literal String
75 deriving (Eq, Show)
77-- | Type that allows matching on identifiers
78--
79data Pattern a = Glob [GlobComponent]
80 | Predicate (Identifier a -> Bool)
81 | List [Identifier a]
83instance IsString (Pattern a) where
84 fromString = parseGlob
86instance Monoid (Pattern a) where
87 mempty = Predicate (const True)
88 p1 `mappend` p2 = Predicate $ \i -> matches p1 i && matches p2 i
90-- | Discard the phantom type parameter
91--
92castPattern :: Pattern a -> Pattern b
93castPattern (Glob g) = Glob g
94castPattern (Predicate p) = Predicate $ p . castIdentifier
95castPattern (List l) = List $ map castIdentifier l
96{-# INLINE castPattern #-}
98-- | Parse a pattern from a string
99--
100parseGlob :: String -> Pattern a
101parseGlob = Glob . parse'
102 where
103 parse' str =
104 let (chunk, rest) = break (`elem` "\\*") str
105 in case rest of
106 ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse' xs
107 ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse' xs
108 ('*' : xs) -> Literal chunk : Capture : parse' xs
109 xs -> Literal chunk : Literal xs : []
111-- | Create a 'Pattern' from an arbitrary predicate
112--
113-- Example:
114--
115-- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i))
116--
117predicate :: (Identifier a -> Bool) -> Pattern a
118predicate = Predicate
120-- | Create a 'Pattern' from a list of 'Identifier's it should match
121--
122list :: [Identifier a] -> Pattern a
123list = List
125-- | Create a 'Pattern' from a regex
126--
127-- Example:
128--
129-- > regex "^foo/[^x]*$
130--
131regex :: String -> Pattern a
132regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath
134-- | Create a 'Pattern' which matches if the identifier is in a certain group
135-- (or in no group)
136--
137inGroup :: Maybe String -> Pattern a
138inGroup group = predicate $ (== group) . identifierGroup
140-- | Inverts a pattern, e.g.
141--
142-- > complement "foo/bar.html"
143--
144-- will match /anything/ except @\"foo\/bar.html\"@
145--
146complement :: Pattern a -> Pattern a
147complement p = predicate (not . matches p)
149-- | Check if an identifier matches a pattern
150--
151matches :: Pattern a -> Identifier a -> Bool
152matches (Glob p) = isJust . capture (Glob p)
153matches (Predicate p) = (p $)
154matches (List l) = (`elem` l)
156-- | Given a list of identifiers, retain only those who match the given pattern
157--
158filterMatches :: Pattern a -> [Identifier a] -> [Identifier a]
159filterMatches = filter . matches
161-- | Split a list at every possible point, generate a list of (init, tail)
162-- cases. The result is sorted with inits decreasing in length.
163--
164splits :: [a] -> [([a], [a])]
165splits = inits &&& tails >>> uncurry zip >>> reverse
167-- | Match a glob against a pattern, generating a list of captures
168--
169capture :: Pattern a -> Identifier a -> Maybe [String]
170capture (Glob p) (Identifier _ i) = capture' p i
171capture _ _ = Nothing
173-- | Internal verion of 'capture'
174--
175capture' :: [GlobComponent] -> String -> Maybe [String]
176capture' [] [] = Just [] -- An empty match
177capture' [] _ = Nothing -- No match
178capture' (Literal l : ms) str
179 -- Match the literal against the string
180 | l `isPrefixOf` str = capture' ms $ drop (length l) str
181 | otherwise = Nothing
182capture' (Capture : ms) str =
183 -- Match until the next /
184 let (chunk, rest) = break (== '/') str
185 in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
186capture' (CaptureMany : ms) str =
187 -- Match everything
188 msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
190-- | Create an identifier from a pattern by filling in the captures with a given
191-- string
192--
193-- Example:
194--
195-- > fromCapture (parseGlob "tags/*") "foo"
196--
197-- Result:
198--
199-- > "tags/foo"
200--
201fromCapture :: Pattern a -> String -> Identifier a
202fromCapture pattern = fromCaptures pattern . repeat
204-- | Create an identifier from a pattern by filling in the captures with the
205-- given list of strings
206--
207fromCaptures :: Pattern a -> [String] -> Identifier a
208fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p
209fromCaptures _ = error $
210 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++
211 "on simple globs!"
213-- | Internally used version of 'fromCaptures'
214--
215fromCaptures' :: [GlobComponent] -> [String] -> String
216fromCaptures' [] _ = mempty
217fromCaptures' (m : ms) [] = case m of
218 Literal l -> l `mappend` fromCaptures' ms []
219 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
220 ++ "identifier list exhausted"
221fromCaptures' (m : ms) ids@(i : is) = case m of
222 Literal l -> l `mappend` fromCaptures' ms ids
223 _ -> i `mappend` fromCaptures' ms is