41b7f37 · hakyll · git.iko.soy

git.iko.soy/hakyll

Type-safe patterns

commit41b7f3713889e8c5b4a21a85d8a2fcebf0b59054 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateTue 24 May 2011, 10:12 (15 years ago) parentf5c018a

6 files changed+38−30

compare with master

unifiedsplit

.ghci+1−1 src/Hakyll/Core/Compiler.hs+3−3 src/Hakyll/Core/Identifier/Pattern.hs+29−21 src/Hakyll/Core/Routes.hs+1−1 src/Hakyll/Core/Rules.hs+2−2 src/Hakyll/Core/Rules/Internal.hs+2−2

.ghci+1−1

@@ -1 +1 @@

1−:set -isrc -isrc-inotify -itests -idist/build/autogen

1+:set -isrc -isrc-interval -itests -idist/build/autogen

src/Hakyll/Core/Compiler.hs+3−3

@@ -258,7 +258,7 @@ requireA identifier = (id &&& require_ identifier >>>)

258258-- | Variant of 'requireAll' which drops the current value

259259--

260260requireAll_ :: (Binary a, Typeable a, Writable a)

261− => Pattern

261+ => Pattern a

262262 -> Compiler b [a]

263263requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'

264264 where

@@ -271,7 +271,7 @@ requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'

271271-- of dependencies

272272--

273273requireAll :: (Binary a, Typeable a, Writable a)

274− => Pattern

274+ => Pattern a

275275 -> (b -> [a] -> c)

276276 -> Compiler b c

277277requireAll pattern = requireAllA pattern . arr . uncurry

@@ -279,7 +279,7 @@ requireAll pattern = requireAllA pattern . arr . uncurry

279279-- | Arrow-based variant of 'requireAll'

280280--

281281requireAllA :: (Binary a, Typeable a, Writable a)

282− => Pattern

282+ => Pattern a

283283 -> Compiler (b, [a]) c

284284 -> Compiler b c

285285requireAllA pattern = (id &&& requireAll_ pattern >>>)

src/Hakyll/Core/Identifier/Pattern.hs+29−21

@@ -33,6 +33,7 @@

3333--

3434module Hakyll.Core.Identifier.Pattern

3535 ( Pattern

36+ , castPattern

3637 , parseGlob

3738 , predicate

3839 , regex

@@ -64,21 +65,27 @@ data GlobComponent = Capture

6465

6566-- | Type that allows matching on identifiers

6667--

67−data Pattern = Glob [GlobComponent]

68− | Predicate (Identifier -> Bool)

68+data Pattern a = Glob [GlobComponent]

69+ | Predicate (Identifier -> Bool)

70+ | List [Identifier]

6971

70−instance IsString Pattern where

72+instance IsString (Pattern a) where

7173 fromString = parseGlob

7274

73−instance Monoid Pattern where

75+instance Monoid (Pattern a) where

7476 mempty = Predicate (const True)

75− g@(Glob _) `mappend` x = Predicate (matches g) `mappend` x

76− x `mappend` g@(Glob _) = x `mappend` Predicate (matches g)

77− Predicate f `mappend` Predicate g = Predicate $ \i -> f i && g i

77+ p1 `mappend` p2 = Predicate $ \i -> matches p1 i && matches p2 i

78+

79+-- | Discard the phantom type parameter

80+--

81+castPattern :: Pattern a -> Pattern b

82+castPattern (Glob g) = Glob g

83+castPattern (Predicate p) = Predicate p

84+castPattern (List l) = List l

7885

7986-- | Parse a pattern from a string

8087--

81−parseGlob :: String -> Pattern

88+parseGlob :: String -> Pattern a

8289parseGlob = Glob . parse'

8390 where

8491 parse' str =

@@ -95,7 +102,7 @@ parseGlob = Glob . parse'

95102--

96103-- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i))

97104--

98−predicate :: (Identifier -> Bool) -> Pattern

105+predicate :: (Identifier -> Bool) -> Pattern a

99106predicate = Predicate

100107

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

@@ -104,24 +111,25 @@ predicate = Predicate

104111--

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

106113--

107−regex :: String -> Pattern

114+regex :: String -> Pattern a

108115regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath

109116

110117-- | Create a 'Pattern' which matches if the identifier is in a certain group

111118-- (or in no group)

112119--

113−inGroup :: Maybe String -> Pattern

120+inGroup :: Maybe String -> Pattern a

114121inGroup group = predicate $ (== group) . identifierGroup

115122

116123-- | Check if an identifier matches a pattern

117124--

118−matches :: Pattern -> Identifier -> Bool

125+matches :: Pattern a -> Identifier -> Bool

119126matches (Glob p) = isJust . capture (Glob p)

120127matches (Predicate p) = (p $)

128+matches (List l) = (`elem` l)

121129

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

123131--

124−filterMatches :: Pattern -> [Identifier] -> [Identifier]

132+filterMatches :: Pattern a -> [Identifier] -> [Identifier]

125133filterMatches = filter . matches

126134

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

@@ -132,9 +140,9 @@ splits = inits &&& tails >>> uncurry zip >>> reverse

132140

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

134142--

135−capture :: Pattern -> Identifier -> Maybe [String]

143+capture :: Pattern a -> Identifier -> Maybe [String]

136144capture (Glob p) (Identifier _ i) = capture' p i

137−capture (Predicate _) _ = Nothing

145+capture _ _ = Nothing

138146

139147-- | Internal verion of 'capture'

140148--

@@ -164,17 +172,17 @@ capture' (CaptureMany : ms) str =

164172--

165173-- > "tags/foo"

166174--

167−fromCapture :: Pattern -> String -> Identifier

175+fromCapture :: Pattern a -> String -> Identifier

168176fromCapture pattern = fromCaptures pattern . repeat

169177

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

171179-- given list of strings

172180--

173−fromCaptures :: Pattern -> [String] -> Identifier

174−fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p

175−fromCaptures (Predicate _) = error $

176− "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures called on a " ++

177− "predicate instead of a glob"

181+fromCaptures :: Pattern a -> [String] -> Identifier

182+fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p

183+fromCaptures _ = error $

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

185+ "on simple globs!"

178186

179187-- | Internally used version of 'fromCaptures'

180188--

src/Hakyll/Core/Routes.hs+1−1

@@ -88,7 +88,7 @@ setExtension extension = Routes $ fmap (`replaceExtension` extension)

8888-- | Apply the route if the identifier matches the given pattern, fail

8989-- otherwise

9090--

91−matchRoute :: Pattern -> Routes -> Routes

91+matchRoute :: Pattern a -> Routes -> Routes

9292matchRoute pattern (Routes route) = Routes $ \id' ->

9393 if matches pattern id' then route id' else Nothing

9494

src/Hakyll/Core/Rules.hs+2−2

@@ -78,11 +78,11 @@ tellResources resources' = RulesM $ tell $

7878

7979-- | Only compile/route items satisfying the given predicate

8080--

81−match :: Pattern -> Rules -> Rules

81+match :: Pattern a -> RulesM b -> RulesM b

8282match pattern = RulesM . local addPredicate . unRulesM

8383 where

8484 addPredicate env = env

85− { rulesPattern = rulesPattern env `mappend` pattern

85+ { rulesPattern = rulesPattern env `mappend` castPattern pattern

8686 }

8787

8888-- | Greate a group of compilers

src/Hakyll/Core/Rules/Internal.hs+2−2

@@ -1,6 +1,6 @@

11-- | Internal rules module for types which are not exposed to the user

22--

3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3+{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-}

44module Hakyll.Core.Rules.Internal

55 ( CompileRule (..)

66 , RuleSet (..)

@@ -63,7 +63,7 @@ data RuleState = RuleState

6363--

6464data RuleEnvironment = RuleEnvironment

6565 { rulesResourceProvider :: ResourceProvider

66− , rulesPattern :: Pattern

66+ , rulesPattern :: forall a. Pattern a

6767 , rulesGroup :: Maybe String

6868 }

6969