src/Hakyll/Core/Identifier/Pattern.hs · hakyll

git.iko.soy/hakyll

on cce87f0 help sign in

hakyll/src/Hakyll/Core/Identifier/Pattern.hs

324 lines 11 kB history raw

1--------------------------------------------------------------------------------

2-- | As 'Identifier' is used to specify a single item, a 'Pattern' is used to

3-- specify a list of items.

4--

5-- In most cases, globs are used for patterns.

6--

7-- A very simple pattern of such a pattern is @\"foo\/bar\"@. This pattern will

8-- only match the exact @foo\/bar@ identifier.

9--

10-- To match more than one identifier, there are different captures that one can

11-- use:

12--

13-- * @\"*\"@: matches at most one element of an identifier;

14--

15-- * @\"**\"@: matches one or more elements of an identifier.

16--

17-- Some examples:

18--

19-- * @\"foo\/*\"@ will match @\"foo\/bar\"@ and @\"foo\/foo\"@, but not

20-- @\"foo\/bar\/qux\"@;

21--

22-- * @\"**\"@ will match any identifier;

23--

24-- * @\"foo\/**\"@ will match @\"foo\/bar\"@ and @\"foo\/bar\/qux\"@, but not

25-- @\"bar\/foo\"@;

26--

27-- * @\"foo\/*.html\"@ will match all HTML files in the @\"foo\/\"@ directory.

28--

29-- The 'capture' function allows the user to get access to the elements captured

30-- by the capture elements in the pattern.

31module Hakyll.Core.Identifier.Pattern

32 ( -- * The pattern type

33 Pattern

35 -- * Creating patterns

36 , fromGlob

37 , fromList

38 , fromRegex

39 , fromVersion

40 , hasVersion

41 , hasNoVersion

43 -- * Composing patterns

44 , (.&&.)

45 , (.||.)

46 , complement

48 -- * Applying patterns

49 , matches

50 , filterMatches

52 -- * Capturing strings

53 , capture

54 , fromCapture

55 , fromCaptures

56 ) where

59--------------------------------------------------------------------------------

60import Control.Applicative (pure, (<$>), (<*>))

61import Control.Arrow ((&&&), (>>>))

62import Control.Monad (msum)

63import Data.Binary (Binary (..), getWord8, putWord8)

64import Data.List (inits, isPrefixOf, tails)

65import Data.Maybe (isJust)

66import Data.Monoid (Monoid, mappend, mempty)

67import Data.Set (Set)

68import qualified Data.Set as S

71--------------------------------------------------------------------------------

72import GHC.Exts (IsString, fromString)

73import Text.Regex.TDFA ((=~))

76--------------------------------------------------------------------------------

77import Hakyll.Core.Identifier

80--------------------------------------------------------------------------------

81-- | Elements of a glob pattern

82data GlobComponent

83 = Capture

84 | CaptureMany

85 | Literal String

86 deriving (Eq, Show)

89--------------------------------------------------------------------------------

90instance Binary GlobComponent where

91 put Capture = putWord8 0

92 put CaptureMany = putWord8 1

93 put (Literal s) = putWord8 2 >> put s

95 get = getWord8 >>= \t -> case t of

96 0 -> pure Capture

97 1 -> pure CaptureMany

98 2 -> Literal <$> get

99 _ -> error "Data.Binary.get: Invalid GlobComponent"

100

101

102--------------------------------------------------------------------------------

103-- | Type that allows matching on identifiers

104data Pattern

105 = Everything

106 | Complement Pattern

107 | And Pattern Pattern

108 | Glob [GlobComponent]

109 | List (Set Identifier)

110 | Regex String

111 | Version (Maybe String)

112 deriving (Show)

113

114

115--------------------------------------------------------------------------------

116instance Binary Pattern where

117 put Everything = putWord8 0

118 put (Complement p) = putWord8 1 >> put p

119 put (And x y) = putWord8 2 >> put x >> put y

120 put (Glob g) = putWord8 3 >> put g

121 put (List is) = putWord8 4 >> put is

122 put (Regex r) = putWord8 5 >> put r

123 put (Version v) = putWord8 6 >> put v

124

125 get = getWord8 >>= \t -> case t of

126 0 -> pure Everything

127 1 -> Complement <$> get

128 2 -> And <$> get <*> get

129 3 -> Glob <$> get

130 4 -> List <$> get

131 5 -> Regex <$> get

132 _ -> Version <$> get

133

134

135--------------------------------------------------------------------------------

136instance IsString Pattern where

137 fromString = fromGlob

138

139

140--------------------------------------------------------------------------------

141instance Monoid Pattern where

142 mempty = Everything

143 mappend = (.&&.)

144

145

146--------------------------------------------------------------------------------

147-- | Parse a pattern from a string

148fromGlob :: String -> Pattern

149fromGlob = Glob . parse'

150 where

151 parse' str =

152 let (chunk, rest) = break (`elem` "\\*") str

153 in case rest of

154 ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse' xs

155 ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse' xs

156 ('*' : xs) -> Literal chunk : Capture : parse' xs

157 xs -> Literal chunk : Literal xs : []

158

159

160--------------------------------------------------------------------------------

161-- | Create a 'Pattern' from a list of 'Identifier's it should match.

162--

163-- /Warning/: use this carefully with 'hasNoVersion' and 'hasVersion'. The

164-- 'Identifier's in the list /already/ have versions assigned, and the pattern

165-- will then only match the intersection of both versions.

166--

167-- A more concrete example,

168--

169-- > fromList ["foo.markdown"] .&&. hasVersion "pdf"

170--

171-- will not match anything! The @"foo.markdown"@ 'Identifier' has no version

172-- assigned, so the LHS of '.&&.' will only match this 'Identifier' with no

173-- version. The RHS only matches 'Identifier's with version set to @"pdf"@ --

174-- hence, this pattern matches nothing.

175--

176-- The correct way to use this is:

177--

178-- > fromList $ map (setVersion $ Just "pdf") ["foo.markdown"]

179fromList :: [Identifier] -> Pattern

180fromList = List . S.fromList

181

182

183--------------------------------------------------------------------------------

184-- | Create a 'Pattern' from a regex

185--

186-- Example:

187--

188-- > regex "^foo/[^x]*$

189fromRegex :: String -> Pattern

190fromRegex = Regex

191

192

193--------------------------------------------------------------------------------

194-- | Create a pattern which matches all items with the given version.

195fromVersion :: Maybe String -> Pattern

196fromVersion = Version

197

198

199--------------------------------------------------------------------------------

200-- | Specify a version, e.g.

201--

202-- > "foo/*.markdown" .&&. hasVersion "pdf"

203hasVersion :: String -> Pattern

204hasVersion = fromVersion . Just

205

206

207--------------------------------------------------------------------------------

208-- | Match only if the identifier has no version set, e.g.

209--

210-- > "foo/*.markdown" .&&. hasNoVersion

211hasNoVersion :: Pattern

212hasNoVersion = fromVersion Nothing

213

214

215--------------------------------------------------------------------------------

216-- | '&&' for patterns: the given identifier must match both subterms

217(.&&.) :: Pattern -> Pattern -> Pattern

218x .&&. y = And x y

219infixr 3 .&&.

220

221

222--------------------------------------------------------------------------------

223-- | '||' for patterns: the given identifier must match any subterm

224(.||.) :: Pattern -> Pattern -> Pattern

225x .||. y = complement (complement x `And` complement y) -- De Morgan's law

226infixr 2 .||.

227

228

229--------------------------------------------------------------------------------

230-- | Inverts a pattern, e.g.

231--

232-- > complement "foo/bar.html"

233--

234-- will match /anything/ except @\"foo\/bar.html\"@

235complement :: Pattern -> Pattern

236complement = Complement

237

238

239--------------------------------------------------------------------------------

240-- | Check if an identifier matches a pattern

241matches :: Pattern -> Identifier -> Bool

242matches Everything _ = True

243matches (Complement p) i = not $ matches p i

244matches (And x y) i = matches x i && matches y i

245matches (Glob p) i = isJust $ capture (Glob p) i

246matches (List l) i = i `S.member` l

247matches (Regex r) i = toFilePath i =~ r

248matches (Version v) i = identifierVersion i == v

249

250

251--------------------------------------------------------------------------------

252-- | Given a list of identifiers, retain only those who match the given pattern

253filterMatches :: Pattern -> [Identifier] -> [Identifier]

254filterMatches = filter . matches

255

256

257--------------------------------------------------------------------------------

258-- | Split a list at every possible point, generate a list of (init, tail)

259-- cases. The result is sorted with inits decreasing in length.

260splits :: [a] -> [([a], [a])]

261splits = inits &&& tails >>> uncurry zip >>> reverse

262

263

264--------------------------------------------------------------------------------

265-- | Match a glob against a pattern, generating a list of captures

266capture :: Pattern -> Identifier -> Maybe [String]

267capture (Glob p) i = capture' p (toFilePath i)

268capture _ _ = Nothing

269

270

271--------------------------------------------------------------------------------

272-- | Internal verion of 'capture'

273capture' :: [GlobComponent] -> String -> Maybe [String]

274capture' [] [] = Just [] -- An empty match

275capture' [] _ = Nothing -- No match

276capture' (Literal l : ms) str

277 -- Match the literal against the string

278 | l `isPrefixOf` str = capture' ms $ drop (length l) str

279 | otherwise = Nothing

280capture' (Capture : ms) str =

281 -- Match until the next /

282 let (chunk, rest) = break (== '/') str

283 in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]

284capture' (CaptureMany : ms) str =

285 -- Match everything

286 msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]

287

288

289--------------------------------------------------------------------------------

290-- | Create an identifier from a pattern by filling in the captures with a given

291-- string

292--

293-- Example:

294--

295-- > fromCapture (parseGlob "tags/*") "foo"

296--

297-- Result:

298--

299-- > "tags/foo"

300fromCapture :: Pattern -> String -> Identifier

301fromCapture pattern = fromCaptures pattern . repeat

302

303

304--------------------------------------------------------------------------------

305-- | Create an identifier from a pattern by filling in the captures with the

306-- given list of strings

307fromCaptures :: Pattern -> [String] -> Identifier

308fromCaptures (Glob p) = fromFilePath . fromCaptures' p

309fromCaptures _ = error $

310 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++

311 "on simple globs!"

312

313

314--------------------------------------------------------------------------------

315-- | Internally used version of 'fromCaptures'

316fromCaptures' :: [GlobComponent] -> [String] -> String

317fromCaptures' [] _ = mempty

318fromCaptures' (m : ms) [] = case m of

319 Literal l -> l `mappend` fromCaptures' ms []

320 _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "

321 ++ "identifier list exhausted"

322fromCaptures' (m : ms) ids@(i : is) = case m of

323 Literal l -> l `mappend` fromCaptures' ms ids

324 _ -> i `mappend` fromCaptures' ms is