git.iko.soy/hakyll
on dac3fac help sign in
hakyll/src/Hakyll/Core/Resource/Pattern.hs
160 lines 5.6 kB history raw
1--------------------------------------------------------------------------------
2-- | Module providing pattern matching and capturing on file names.
3-- 'Pattern's come in two kinds:
4--
5-- * Simple glob patterns, like @foo\/*@;
6--
7-- * Custom, arbitrary predicates of the type @Identifier -> Bool@.
8--
9-- They both have advantages and disadvantages. By default, globs are used,
10-- unless you construct your 'Pattern' using the 'predicate' function.
11--
12-- A very simple pattern could be, for example, @foo\/bar@. This pattern will
13-- only match the exact @foo\/bar@ identifier.
14--
15-- To match more than one identifier, there are different captures that one can
16-- use:
17--
18-- * @*@: matches at most one element of an identifier;
19--
20-- * @**@: matches one or more elements of an identifier.
21--
22-- Some examples:
23--
24-- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@;
25--
26-- * @**@ will match any identifier;
27--
28-- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@;
29--
30-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
31--
32-- The 'capture' function allows the user to get access to the elements captured
33-- by the capture elements in the pattern.
34--
35-- Like an 'Identifier', a 'Pattern' also has a type parameter. This is simply
36-- an extra layer of safety, and can be discarded using the 'castPattern'
37-- function.
38module Hakyll.Core.Resource.Pattern
39 ( Pattern
40 , parsePattern
41 , capture
42 ) where
45--------------------------------------------------------------------------------
46import Control.Arrow ((&&&), (>>>))
47import Control.Monad (msum)
48import Data.List (inits, isPrefixOf, tails)
49import GHC.Exts (IsString, fromString)
52--------------------------------------------------------------------------------
53import Hakyll.Core.Resource
56--------------------------------------------------------------------------------
57-- | One base element of a pattern
58data GlobComponent
59 = Capture
60 | CaptureMany
61 | Literal String
62 deriving (Eq, Show)
65--------------------------------------------------------------------------------
66-- | Type that allows matching on identifiers
67newtype Pattern = Pattern [GlobComponent]
68 deriving (Show)
71--------------------------------------------------------------------------------
72instance IsString Pattern where
73 fromString = parsePattern
76--------------------------------------------------------------------------------
77-- | Parse a pattern from a string
78parsePattern :: String -> Pattern
79parsePattern = Pattern . parse
80 where
81 parse str =
82 let (chunk, rest) = break (`elem` "\\*") str
83 in case rest of
84 ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse xs
85 ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse xs
86 ('*' : xs) -> Literal chunk : Capture : parse xs
87 xs -> Literal chunk : Literal xs : []
90--------------------------------------------------------------------------------
91-- | Split a list at every possible point, generate a list of (init, tail)
92-- cases. The result is sorted with inits decreasing in length.
93splits :: [a] -> [([a], [a])]
94splits = inits &&& tails >>> uncurry zip >>> reverse
97--------------------------------------------------------------------------------
98-- | Match a glob against a pattern, generating a list of captures
99capture :: Pattern -> Resource -> Maybe [String]
100capture (Pattern p) rs = capture' p (unResource rs)
103--------------------------------------------------------------------------------
104-- | Internal verion of 'capture'
105capture' :: [GlobComponent] -> String -> Maybe [String]
106capture' [] [] = Just [] -- An empty match
107capture' [] _ = Nothing -- No match
108capture' (Literal l : ms) str
109 -- Match the literal against the string
110 | l `isPrefixOf` str = capture' ms $ drop (length l) str
111 | otherwise = Nothing
112capture' (Capture : ms) str =
113 -- Match until the next /
114 let (chunk, rest) = break (== '/') str
115 in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
116capture' (CaptureMany : ms) str =
117 -- Match everything
118 msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
121--------------------------------------------------------------------------------
122-- | Create an identifier from a pattern by filling in the captures with a given
123-- string
124--
125-- Example:
126--
127-- > fromCapture (parsePattern "tags/*") "foo"
128--
129-- Result:
130--
131-- > "tags/foo"
132{-
133fromCapture :: Pattern -> String -> Identifier
134fromCapture pattern = fromCaptures pattern . repeat
135-}
138--------------------------------------------------------------------------------
139-- | Create an identifier from a pattern by filling in the captures with the
140-- given list of strings
141--
142{-
143fromCaptures :: Pattern -> [String] -> String
144fromCaptures (Pattern p) = fromCaptures' p
145-}
148--------------------------------------------------------------------------------
149-- | Internally used version of 'fromCaptures'
150{-
151fromCaptures' :: [GlobComponent] -> [String] -> String
152fromCaptures' [] _ = mempty
153fromCaptures' (m : ms) [] = case m of
154 Literal l -> l `mappend` fromCaptures' ms []
155 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
156 ++ "identifier list exhausted"
157fromCaptures' (m : ms) ids@(i : is) = case m of
158 Literal l -> l `mappend` fromCaptures' ms ids
159 _ -> i `mappend` fromCaptures' ms is
160-}