git.iko.soy/hakyll
on 5cc710d help sign in
hakyll/src/Hakyll/Core/Identifier/Pattern.hs
151 lines 4.9 kB history raw
1-- | Module providing pattern matching and capturing on 'Identifier's.
2--
3-- A very simple pattern could be, for example, @foo\/bar@. This pattern will
4-- only match the exact @foo\/bar@ identifier.
5--
6-- To match more than one identifier, there are different captures that one can
7-- use:
8--
9-- * @*@: matches at most one element of an identifier;
10--
11-- * @**@: matches one or more elements of an identifier.
12--
13-- Some examples:
14--
15-- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@;
16--
17-- * @**@ will match any identifier;
18--
19-- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@;
20--
21-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
22--
23-- The 'match' function allows the user to get access to the elements captured
24-- by the capture elements in the pattern.
25--
26module Hakyll.Core.Identifier.Pattern
27 ( Pattern
28 , parsePattern
29 , match
30 , doesMatch
31 , matches
32 , fromCapture
33 , fromCaptureString
34 , fromCaptures
35 ) where
37import Data.List (isPrefixOf, inits, tails)
38import Control.Arrow ((&&&), (>>>))
39import Control.Monad (msum)
40import Data.Maybe (isJust)
41import Data.Monoid (mempty, mappend)
43import GHC.Exts (IsString, fromString)
45import Hakyll.Core.Identifier
47-- | One base element of a pattern
48--
49data PatternComponent = Capture
50 | CaptureMany
51 | Literal String
52 deriving (Eq, Show)
54-- | Type that allows matching on identifiers
55--
56newtype Pattern = Pattern {unPattern :: [PatternComponent]}
57 deriving (Eq, Show)
59instance IsString Pattern where
60 fromString = parsePattern
62-- | Parse a pattern from a string
63--
64parsePattern :: String -> Pattern
65parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIdentifier . parseIdentifier
66 where
67 parse' str =
68 let (chunk, rest) = break (`elem` "\\*") str
69 in case rest of
70 ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse' xs
71 ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse' xs
72 ('*' : xs) -> Literal chunk : Capture : parse' xs
73 xs -> Literal chunk : Literal xs : []
75-- | Match an identifier against a pattern, generating a list of captures
76--
77match :: Pattern -> Identifier -> Maybe [Identifier]
78match p (Identifier i) = fmap (map Identifier) $ match' (unPattern p) i
80-- | Check if an identifier matches a pattern
81--
82doesMatch :: Pattern -> Identifier -> Bool
83doesMatch p = isJust . match p
85-- | Given a list of identifiers, retain only those who match the given pattern
86--
87matches :: Pattern -> [Identifier] -> [Identifier]
88matches p = filter (doesMatch p)
90-- | Split a list at every possible point, generate a list of (init, tail)
91-- cases. The result is sorted with inits decreasing in length.
92--
93splits :: [a] -> [([a], [a])]
94splits = inits &&& tails >>> uncurry zip >>> reverse
96-- | Internal verion of 'match'
97--
98match' :: [PatternComponent] -> String -> Maybe [String]
99match' [] [] = Just [] -- An empty match
100match' [] _ = Nothing -- No match
101-- match' _ [] = Nothing -- No match
102match' (Literal l : ms) str
103 -- Match the literal against the string
104 | l `isPrefixOf` str = match' ms $ drop (length l) str
105 | otherwise = Nothing
106match' (Capture : ms) str =
107 -- Match until the next /
108 let (chunk, rest) = break (== '/') str
109 in msum $ [ fmap (i :) (match' ms (t ++ rest)) | (i, t) <- splits chunk ]
110match' (CaptureMany : ms) str =
111 -- Match everything
112 msum $ [ fmap (i :) (match' ms t) | (i, t) <- splits str ]
114-- | Create an identifier from a pattern by filling in the captures with a given
115-- string
116--
117-- Example:
118--
119-- > fromCapture (parsePattern "tags/*") (parseIdentifier "foo")
120--
121-- Result:
122--
123-- > "tags/foo"
124--
125fromCapture :: Pattern -> Identifier -> Identifier
126fromCapture pattern = fromCaptures pattern . repeat
128-- | Simplified version of 'fromCapture' which takes a 'String' instead of an
129-- 'Identifier'
130--
131-- > fromCaptureString (parsePattern "tags/*") "foo"
132--
133-- Result:
134--
135-- > "tags/foo"
136--
137fromCaptureString :: Pattern -> String -> Identifier
138fromCaptureString pattern = fromCapture pattern . parseIdentifier
140-- | Create an identifier from a pattern by filling in the captures with the
141-- given list of strings
142--
143fromCaptures :: Pattern -> [Identifier] -> Identifier
144fromCaptures (Pattern []) _ = mempty
145fromCaptures (Pattern (m : ms)) [] = case m of
146 Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) []
147 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: "
148 ++ "identifier list exhausted"
149fromCaptures (Pattern (m : ms)) ids@(i : is) = case m of
150 Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) ids
151 _ -> i `mappend` fromCaptures (Pattern ms) is