git.iko.soy/hakyll
on da3aa16 help sign in
hakyll/src/Hakyll/Core/Identifier/Pattern.hs
189 lines 5.9 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--
34module Hakyll.Core.Identifier.Pattern
35 ( Pattern
36 , parseGlob
37 , predicate
38 , regex
39 , inGroup
40 , matches
41 , filterMatches
42 , capture
43 , fromCapture
44 , fromCaptures
45 ) where
47import Data.List (isPrefixOf, inits, tails)
48import Control.Arrow ((&&&), (>>>))
49import Control.Monad (msum)
50import Data.Maybe (isJust, fromMaybe)
51import Data.Monoid (Monoid, mempty, mappend)
53import GHC.Exts (IsString, fromString)
54import Text.Regex.PCRE ((=~~))
56import Hakyll.Core.Identifier
58-- | One base element of a pattern
59--
60data GlobComponent = Capture
61 | CaptureMany
62 | Literal String
63 deriving (Eq, Show)
65-- | Type that allows matching on identifiers
66--
67data Pattern = Glob [GlobComponent]
68 | Predicate (Identifier -> Bool)
70instance IsString Pattern where
71 fromString = parseGlob
73instance Monoid Pattern where
74 mempty = Predicate (const True)
75 g@(Glob _) `mappend` x = Predicate (matches g) `mappend` x
76 x `mappend` g@(Glob _) = x `mappend` Predicate (matches g)
77 Predicate f `mappend` Predicate g = Predicate $ \i -> f i && g i
79-- | Parse a pattern from a string
80--
81parseGlob :: String -> Pattern
82parseGlob = Glob . parse'
83 where
84 parse' str =
85 let (chunk, rest) = break (`elem` "\\*") str
86 in case rest of
87 ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse' xs
88 ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse' xs
89 ('*' : xs) -> Literal chunk : Capture : parse' xs
90 xs -> Literal chunk : Literal xs : []
92-- | Create a 'Pattern' from an arbitrary predicate
93--
94-- Example:
95--
96-- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i))
97--
98predicate :: (Identifier -> Bool) -> Pattern
99predicate = Predicate
101-- | Create a 'Pattern' from a regex
102--
103-- Example:
104--
105-- > regex "^foo/[^x]*$
106--
107regex :: String -> Pattern
108regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath
110-- | Create a 'Pattern' which matches if the identifier is in a certain group
111-- (or in no group)
112--
113inGroup :: Maybe String -> Pattern
114inGroup group = predicate $ (== group) . identifierGroup
116-- | Check if an identifier matches a pattern
117--
118matches :: Pattern -> Identifier -> Bool
119matches (Glob p) = isJust . capture (Glob p)
120matches (Predicate p) = (p $)
122-- | Given a list of identifiers, retain only those who match the given pattern
123--
124filterMatches :: Pattern -> [Identifier] -> [Identifier]
125filterMatches = filter . matches
127-- | Split a list at every possible point, generate a list of (init, tail)
128-- cases. The result is sorted with inits decreasing in length.
129--
130splits :: [a] -> [([a], [a])]
131splits = inits &&& tails >>> uncurry zip >>> reverse
133-- | Match a glob against a pattern, generating a list of captures
134--
135capture :: Pattern -> Identifier -> Maybe [String]
136capture (Glob p) (Identifier _ i) = capture' p i
137capture (Predicate _) _ = Nothing
139-- | Internal verion of 'capture'
140--
141capture' :: [GlobComponent] -> String -> Maybe [String]
142capture' [] [] = Just [] -- An empty match
143capture' [] _ = Nothing -- No match
144capture' (Literal l : ms) str
145 -- Match the literal against the string
146 | l `isPrefixOf` str = capture' ms $ drop (length l) str
147 | otherwise = Nothing
148capture' (Capture : ms) str =
149 -- Match until the next /
150 let (chunk, rest) = break (== '/') str
151 in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
152capture' (CaptureMany : ms) str =
153 -- Match everything
154 msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
156-- | Create an identifier from a pattern by filling in the captures with a given
157-- string
158--
159-- Example:
160--
161-- > fromCapture (parseGlob "tags/*") "foo"
162--
163-- Result:
164--
165-- > "tags/foo"
166--
167fromCapture :: Pattern -> String -> Identifier
168fromCapture pattern = fromCaptures pattern . repeat
170-- | Create an identifier from a pattern by filling in the captures with the
171-- given list of strings
172--
173fromCaptures :: Pattern -> [String] -> Identifier
174fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p
175fromCaptures (Predicate _) = error $
176 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures called on a " ++
177 "predicate instead of a glob"
179-- | Internally used version of 'fromCaptures'
180--
181fromCaptures' :: [GlobComponent] -> [String] -> String
182fromCaptures' [] _ = mempty
183fromCaptures' (m : ms) [] = case m of
184 Literal l -> l `mappend` fromCaptures' ms []
185 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
186 ++ "identifier list exhausted"
187fromCaptures' (m : ms) ids@(i : is) = case m of
188 Literal l -> l `mappend` fromCaptures' ms ids
189 _ -> i `mappend` fromCaptures' ms is