git.iko.soy/hakyll
on f104f91 help sign in
hakyll/src/Hakyll/Core/Identifier/Pattern.hs
139 lines 4.5 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 exactly 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@ nor
16-- @foo@;
17--
18-- * @**@ will match any non-empty identifier;
19--
20-- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@ nor
21-- @foo@;
22--
23-- A small warning: patterns are not globs. Using @foo\/*.markdown@ will not do
24-- what you probably intended, as it will only match the file which is literally
25-- called @foo\/*.markdown@. Remember that these captures only work on elements
26-- of identifiers as a whole; not on parts of these elements.
27--
28-- Furthermore, the 'match' function allows the user to get access to the
29-- elements captured by the capture elements in the pattern.
30--
31module Hakyll.Core.Identifier.Pattern
32 ( Pattern
33 , parsePattern
34 , match
35 , doesMatch
36 , matches
37 , fromCapture
38 , fromCaptures
39 ) where
41import Data.List (intercalate)
42import Control.Monad (msum)
43import Data.Maybe (isJust)
44import Data.Monoid (mempty, mappend)
46import GHC.Exts (IsString, fromString)
48import Hakyll.Core.Identifier
50-- | One base element of a pattern
51--
52data PatternComponent = CaptureOne
53 | CaptureMany
54 | Literal String
55 deriving (Eq)
57instance Show PatternComponent where
58 show CaptureOne = "*"
59 show CaptureMany = "**"
60 show (Literal s) = s
62-- | Type that allows matching on identifiers
63--
64newtype Pattern = Pattern {unPattern :: [PatternComponent]}
65 deriving (Eq)
67instance Show Pattern where
68 show = intercalate "/" . map show . unPattern
70instance IsString Pattern where
71 fromString = parsePattern
73-- | Parse a pattern from a string
74--
75parsePattern :: String -> Pattern
76parsePattern = Pattern . map toPattern . unIdentifier . parseIdentifier
77 where
78 toPattern x | x == "*" = CaptureOne
79 | x == "**" = CaptureMany
80 | otherwise = Literal x
82-- | Match an identifier against a pattern, generating a list of captures
83--
84match :: Pattern -> Identifier -> Maybe [Identifier]
85match (Pattern p) (Identifier i) = fmap (map Identifier) $ match' p i
87-- | Check if an identifier matches a pattern
88--
89doesMatch :: Pattern -> Identifier -> Bool
90doesMatch p = isJust . match p
92-- | Given a list of identifiers, retain only those who match the given pattern
93--
94matches :: Pattern -> [Identifier] -> [Identifier]
95matches p = filter (doesMatch p)
97-- | Split a list at every possible point, generate a list of (init, tail) cases
98--
99splits :: [a] -> [([a], [a])]
100splits ls = reverse $ splits' [] ls
101 where
102 splits' lx ly = (lx, ly) : case ly of
103 [] -> []
104 (y : ys) -> splits' (lx ++ [y]) ys
106-- | Internal verion of 'match'
107--
108match' :: [PatternComponent] -> [String] -> Maybe [[String]]
109match' [] [] = Just [] -- An empty match
110match' [] _ = Nothing -- No match
111match' _ [] = Nothing -- No match
112match' (m : ms) (s : ss) = case m of
113 -- Take one string and one literal, fail on mismatch
114 Literal l -> if s == l then match' ms ss else Nothing
115 -- Take one string and one capture
116 CaptureOne -> fmap ([s] :) $ match' ms ss
117 -- Take one string, and one or many captures
118 CaptureMany ->
119 let take' (i, t) = fmap (i :) $ match' ms t
120 in msum $ map take' $ splits (s : ss)
122-- | Create an identifier from a pattern by filling in the captures with a given
123-- string
124--
125fromCapture :: Pattern -> Identifier -> Identifier
126fromCapture pattern = fromCaptures pattern . repeat
128-- | Create an identifier from a pattern by filling in the captures with the
129-- given list of strings
130--
131fromCaptures :: Pattern -> [Identifier] -> Identifier
132fromCaptures (Pattern []) _ = mempty
133fromCaptures (Pattern (m : ms)) [] = case m of
134 Literal l -> Identifier [l] `mappend` fromCaptures (Pattern ms) []
135 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: "
136 ++ "identifier list exhausted"
137fromCaptures (Pattern (m : ms)) ids@(i : is) = case m of
138 Literal l -> Identifier [l] `mappend` fromCaptures (Pattern ms) ids
139 _ -> i `mappend` fromCaptures (Pattern ms) is