@@ -1,160 +0,0 @@
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.
38−module Hakyll.Core.Resource.Pattern
39− ( Pattern
40− , parsePattern
41− , capture
42− ) where
43−
44−
45−--------------------------------------------------------------------------------
46−import Control.Arrow ((&&&), (>>>))
47−import Control.Monad (msum)
48−import Data.List (inits, isPrefixOf, tails)
49−import GHC.Exts (IsString, fromString)
50−
51−
52−--------------------------------------------------------------------------------
53−import Hakyll.Core.Resource
54−
55−
56−--------------------------------------------------------------------------------
57−-- | One base element of a pattern
58−data GlobComponent
59− = Capture
60− | CaptureMany
61− | Literal String
62− deriving (Eq, Show)
63−
64−
65−--------------------------------------------------------------------------------
66−-- | Type that allows matching on identifiers
67−newtype Pattern = Pattern [GlobComponent]
68− deriving (Show)
69−
70−
71−--------------------------------------------------------------------------------
72−instance IsString Pattern where
73− fromString = parsePattern
74−
75−
76−--------------------------------------------------------------------------------
77−-- | Parse a pattern from a string
78−parsePattern :: String -> Pattern
79−parsePattern = 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 : []
88−
89−
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.
93−splits :: [a] -> [([a], [a])]
94−splits = inits &&& tails >>> uncurry zip >>> reverse
95−
96−
97−--------------------------------------------------------------------------------
98−-- | Match a glob against a pattern, generating a list of captures
99−capture :: Pattern -> Resource -> Maybe [String]
100−capture (Pattern p) rs = capture' p (unResource rs)
101−
102−
103−--------------------------------------------------------------------------------
104−-- | Internal verion of 'capture'
105−capture' :: [GlobComponent] -> String -> Maybe [String]
106−capture' [] [] = Just [] -- An empty match
107−capture' [] _ = Nothing -- No match
108−capture' (Literal l : ms) str
109− -- Match the literal against the string
110− | l `isPrefixOf` str = capture' ms $ drop (length l) str
111− | otherwise = Nothing
112−capture' (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 ]
116−capture' (CaptureMany : ms) str =
117− -- Match everything
118− msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
119−
120−
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−{-
133−fromCapture :: Pattern -> String -> Identifier
134−fromCapture pattern = fromCaptures pattern . repeat
135−-}
136−
137−
138−--------------------------------------------------------------------------------
139−-- | Create an identifier from a pattern by filling in the captures with the
140−-- given list of strings
141−--
142−{-
143−fromCaptures :: Pattern -> [String] -> String
144−fromCaptures (Pattern p) = fromCaptures' p
145−-}
146−
147−
148−--------------------------------------------------------------------------------
149−-- | Internally used version of 'fromCaptures'
150−{-
151−fromCaptures' :: [GlobComponent] -> [String] -> String
152−fromCaptures' [] _ = mempty
153−fromCaptures' (m : ms) [] = case m of
154− Literal l -> l `mappend` fromCaptures' ms []
155− _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
156− ++ "identifier list exhausted"
157−fromCaptures' (m : ms) ids@(i : is) = case m of
158− Literal l -> l `mappend` fromCaptures' ms ids
159− _ -> i `mappend` fromCaptures' ms is
160−-}