on 01a8ab2 help sign in
204 lines 6.3 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 , castPattern
37 , parseGlob
38 , predicate
39 , list
40 , regex
41 , inGroup
42 , matches
43 , filterMatches
44 , capture
45 , fromCapture
46 , fromCaptures
47 ) where
49import Data.List (isPrefixOf, inits, tails)
50import Control.Arrow ((&&&), (>>>))
51import Control.Monad (msum)
52import Data.Maybe (isJust, fromMaybe)
53import Data.Monoid (Monoid, mempty, mappend)
55import GHC.Exts (IsString, fromString)
56import Text.Regex.PCRE ((=~~))
58import Hakyll.Core.Identifier
60-- | One base element of a pattern
61--
62data GlobComponent = Capture
63 | CaptureMany
64 | Literal String
65 deriving (Eq, Show)
67-- | Type that allows matching on identifiers
68--
69data Pattern a = Glob [GlobComponent]
70 | Predicate (Identifier a -> Bool)
71 | List [Identifier a]
73instance IsString (Pattern a) where
74 fromString = parseGlob
76instance Monoid (Pattern a) where
77 mempty = Predicate (const True)
78 p1 `mappend` p2 = Predicate $ \i -> matches p1 i && matches p2 i
80-- | Discard the phantom type parameter
81--
82castPattern :: Pattern a -> Pattern b
83castPattern (Glob g) = Glob g
84castPattern (Predicate p) = Predicate $ p . castIdentifier
85castPattern (List l) = List $ map castIdentifier l
86{-# INLINE castPattern #-}
88-- | Parse a pattern from a string
89--
90parseGlob :: String -> Pattern a
91parseGlob = Glob . parse'
92 where
93 parse' str =
94 let (chunk, rest) = break (`elem` "\\*") str
95 in case rest of
96 ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse' xs
97 ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse' xs
98 ('*' : xs) -> Literal chunk : Capture : parse' xs
99 xs -> Literal chunk : Literal xs : []
101-- | Create a 'Pattern' from an arbitrary predicate
102--
103-- Example:
104--
105-- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i))
106--
107predicate :: (Identifier a -> Bool) -> Pattern a
108predicate = Predicate
110-- | Create a 'Pattern' from a list of 'Identifier's it should match
111--
112list :: [Identifier a] -> Pattern a
113list = List
115-- | Create a 'Pattern' from a regex
116--
117-- Example:
118--
119-- > regex "^foo/[^x]*$
120--
121regex :: String -> Pattern a
122regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath
124-- | Create a 'Pattern' which matches if the identifier is in a certain group
125-- (or in no group)
126--
127inGroup :: Maybe String -> Pattern a
128inGroup group = predicate $ (== group) . identifierGroup
130-- | Check if an identifier matches a pattern
131--
132matches :: Pattern a -> Identifier a -> Bool
133matches (Glob p) = isJust . capture (Glob p)
134matches (Predicate p) = (p $)
135matches (List l) = (`elem` l)
137-- | Given a list of identifiers, retain only those who match the given pattern
138--
139filterMatches :: Pattern a -> [Identifier a] -> [Identifier a]
140filterMatches = filter . matches
142-- | Split a list at every possible point, generate a list of (init, tail)
143-- cases. The result is sorted with inits decreasing in length.
144--
145splits :: [a] -> [([a], [a])]
146splits = inits &&& tails >>> uncurry zip >>> reverse
148-- | Match a glob against a pattern, generating a list of captures
149--
150capture :: Pattern a -> Identifier a -> Maybe [String]
151capture (Glob p) (Identifier _ i) = capture' p i
152capture _ _ = Nothing
154-- | Internal verion of 'capture'
155--
156capture' :: [GlobComponent] -> String -> Maybe [String]
157capture' [] [] = Just [] -- An empty match
158capture' [] _ = Nothing -- No match
159capture' (Literal l : ms) str
160 -- Match the literal against the string
161 | l `isPrefixOf` str = capture' ms $ drop (length l) str
162 | otherwise = Nothing
163capture' (Capture : ms) str =
164 -- Match until the next /
165 let (chunk, rest) = break (== '/') str
166 in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
167capture' (CaptureMany : ms) str =
168 -- Match everything
169 msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
171-- | Create an identifier from a pattern by filling in the captures with a given
172-- string
173--
174-- Example:
175--
176-- > fromCapture (parseGlob "tags/*") "foo"
177--
178-- Result:
179--
180-- > "tags/foo"
181--
182fromCapture :: Pattern a -> String -> Identifier a
183fromCapture pattern = fromCaptures pattern . repeat
185-- | Create an identifier from a pattern by filling in the captures with the
186-- given list of strings
187--
188fromCaptures :: Pattern a -> [String] -> Identifier a
189fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p
190fromCaptures _ = error $
191 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++
192 "on simple globs!"
194-- | Internally used version of 'fromCaptures'
195--
196fromCaptures' :: [GlobComponent] -> [String] -> String
197fromCaptures' [] _ = mempty
198fromCaptures' (m : ms) [] = case m of
199 Literal l -> l `mappend` fromCaptures' ms []
200 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
201 ++ "identifier list exhausted"
202fromCaptures' (m : ms) ids@(i : is) = case m of
203 Literal l -> l `mappend` fromCaptures' ms ids
204 _ -> i `mappend` fromCaptures' ms is