41b7f37 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Type-safe patterns

41b7f37Jasper Van der Jeugt15 years ago

.ghci+1−1

compare with master

unifiedsplit

@@ -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 >>>)

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

259--

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

261− => Pattern

261+ => Pattern a

262 -> Compiler b [a]

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

264 where

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

271-- of dependencies

272--

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

274− => Pattern

274+ => Pattern a

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

276 -> Compiler b c

277requireAll pattern = requireAllA pattern . arr . uncurry

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

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

280--

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

282− => Pattern

282+ => Pattern a

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

284 -> Compiler b c

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

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

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

33--

34module Hakyll.Core.Identifier.Pattern

35 ( Pattern

36+ , castPattern

36 , parseGlob

37 , parseGlob

37 , predicate

38 , predicate

38 , regex

39 , regex

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

65-- | Type that allows matching on identifiers

66-- | Type that allows matching on identifiers

66--

67--

67−data Pattern = Glob [GlobComponent]

68+data Pattern a = Glob [GlobComponent]

68− | Predicate (Identifier -> Bool)

69+ | Predicate (Identifier -> Bool)

70+ | List [Identifier]

70−instance IsString Pattern where

72+instance IsString (Pattern a) where

71 fromString = parseGlob

73 fromString = parseGlob

73−instance Monoid Pattern where

75+instance Monoid (Pattern a) where

74 mempty = Predicate (const True)

76 mempty = Predicate (const True)

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

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

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

78+

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

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

79-- | Parse a pattern from a string

86-- | Parse a pattern from a string

80--

87--

81−parseGlob :: String -> Pattern

88+parseGlob :: String -> Pattern a

82parseGlob = Glob . parse'

89parseGlob = Glob . parse'

83 where

90 where

84 parse' str =

91 parse' str =

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

95--

102--

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

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

97--

104--

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

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

99predicate = Predicate

106predicate = Predicate

100

107

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

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

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

104--

111--

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

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

106--

113--

107−regex :: String -> Pattern

114+regex :: String -> Pattern a

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

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

109

116

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

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

111-- (or in no group)

118-- (or in no group)

112--

119--

113−inGroup :: Maybe String -> Pattern

120+inGroup :: Maybe String -> Pattern a

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

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

115

122

116-- | Check if an identifier matches a pattern

123-- | Check if an identifier matches a pattern

117--

124--

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

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

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

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

120matches (Predicate p) = (p $)

127matches (Predicate p) = (p $)

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

121

129

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

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

123--

131--

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

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

125filterMatches = filter . matches

133filterMatches = filter . matches

126

134

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

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

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

132

140

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

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

134--

142--

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

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

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

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

137−capture (Predicate _) _ = Nothing

145+capture _ _ = Nothing

138

146

139-- | Internal verion of 'capture'

147-- | Internal verion of 'capture'

140--

148--

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

164--

172--

165-- > "tags/foo"

173-- > "tags/foo"

166--

174--

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

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

168fromCapture pattern = fromCaptures pattern . repeat

176fromCapture pattern = fromCaptures pattern . repeat

169

177

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

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

171-- given list of strings

179-- given list of strings

172--

180--

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

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

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

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

175−fromCaptures (Predicate _) = error $

183+fromCaptures _ = error $

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

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

177− "predicate instead of a glob"

185+ "on simple globs!"

178

186

179-- | Internally used version of 'fromCaptures'

187-- | Internally used version of 'fromCaptures'

180--

188--

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

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

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

89-- otherwise

90--

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

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

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

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

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

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

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

80--

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

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

82match pattern = RulesM . local addPredicate . unRulesM

83 where

84 addPredicate env = env

85− { rulesPattern = rulesPattern env `mappend` pattern

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

86 }

88-- | Greate a group of compilers

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

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

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

2--

3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

4module Hakyll.Core.Rules.Internal

5 ( CompileRule (..)

6 , RuleSet (..)

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

63--

64data RuleEnvironment = RuleEnvironment

65 { rulesResourceProvider :: ResourceProvider

66− , rulesPattern :: Pattern

66+ , rulesPattern :: forall a. Pattern a

67 , rulesGroup :: Maybe String

68 }