git.iko.soy/hakyll
on master help sign in
Return information in rules
f6f7cdeJasper Van der Jeugt
src/Hakyll/Core/Identifier/Pattern.hs+6
compare with master
unifiedsplit
@@ -36,6 +36,7 @@ module Hakyll.Core.Identifier.Pattern
36 , castPattern
36 , castPattern
37 , parseGlob
37 , parseGlob
38 , predicate
38 , predicate
39+ , list
39 , regex
40 , regex
40 , inGroup
41 , inGroup
41 , matches
42 , matches
@@ -106,6 +107,11 @@ parseGlob = Glob . parse'
106predicate :: (Identifier a -> Bool) -> Pattern a
107predicate :: (Identifier a -> Bool) -> Pattern a
107predicate = Predicate
108predicate = Predicate
108
109
110+-- | Create a 'Pattern' from a list of 'Identifier's it should match
111+--
112+list :: [Identifier a] -> Pattern a
113+list = List
114+
109-- | Create a 'Pattern' from a regex
115-- | Create a 'Pattern' from a regex
110--
116--
111-- Example:
117-- Example:
src/Hakyll/Core/Rules.hs+17−10
@@ -61,10 +61,8 @@ tellCompilers :: (Binary a, Typeable a, Writable a)
61 => [(Identifier a, Compiler () a)]
61 => [(Identifier a, Compiler () a)]
62 -> Rules
62 -> Rules
63tellCompilers compilers = RulesM $ do
63tellCompilers compilers = RulesM $ do
64− -- We box the compilers so they have a more simple type, and we apply the
64+ -- We box the compilers so they have a more simple type
65− -- current group to the corresponding identifiers
66− g <- rulesGroup <$> ask
67− let compilers' = map (setGroup g . castIdentifier *** boxCompiler) compilers
65+ let compilers' = map (castIdentifier *** boxCompiler) compilers
68 tell $ RuleSet mempty compilers' mempty
66 tell $ RuleSet mempty compilers' mempty
69 where
67 where
70 boxCompiler = (>>> arr compiledItem >>> arr CompileRule)
68 boxCompiler = (>>> arr compiledItem >>> arr CompileRule)
@@ -116,7 +114,7 @@ match pattern = RulesM . local addPredicate . unRulesM
116-- This will put the compiler for the raw content in a separate group
114-- This will put the compiler for the raw content in a separate group
117-- (@\"raw\"@), which causes it to be compiled as well.
115-- (@\"raw\"@), which causes it to be compiled as well.
118--
116--
119−group :: String -> Rules -> Rules
117+group :: String -> RulesM a -> RulesM a
120group g = RulesM . local setGroup' . unRulesM
118group g = RulesM . local setGroup' . unRulesM
121 where
119 where
122 setGroup' env = env { rulesGroup = Just g }
120 setGroup' env = env { rulesGroup = Just g }
@@ -128,12 +126,13 @@ group g = RulesM . local setGroup' . unRulesM
128-- you might want to have a look at 'create'.
126-- you might want to have a look at 'create'.
129--
127--
130compile :: (Binary a, Typeable a, Writable a)
128compile :: (Binary a, Typeable a, Writable a)
131− => Compiler Resource a -> Rules
129+ => Compiler Resource a -> RulesM (Pattern a)
132compile compiler = do
130compile compiler = do
133 ids <- resources
131 ids <- resources
134 tellCompilers $ flip map ids $ \identifier ->
132 tellCompilers $ flip map ids $ \identifier ->
135 (identifier, constA (fromIdentifier identifier) >>> compiler)
133 (identifier, constA (fromIdentifier identifier) >>> compiler)
136 tellResources $ map fromIdentifier ids
134 tellResources $ map fromIdentifier ids
135+ return $ list ids
137
136
138-- | Add a compilation rule
137-- | Add a compilation rule
139--
138--
@@ -143,8 +142,12 @@ compile compiler = do
143-- actual content itself.
142-- actual content itself.
144--
143--
145create :: (Binary a, Typeable a, Writable a)
144create :: (Binary a, Typeable a, Writable a)
146− => Identifier a -> Compiler () a -> Rules
145+ => Identifier a -> Compiler () a -> RulesM (Identifier a)
146+create id' compiler = RulesM $ do
147+ group' <- rulesGroup <$> ask
148+ let id'' = setGroup group' id'
147−create identifier compiler = tellCompilers [(identifier, compiler)]
149+ unRulesM $ tellCompilers [(id'', compiler)]
150+ return id''
148
151
149-- | Add a route.
152-- | Add a route.
150--
153--
@@ -158,13 +161,17 @@ route route' = RulesM $ do
158 group' <- rulesGroup <$> ask
161 group' <- rulesGroup <$> ask
159 unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route'
162 unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route'
160
163
161−-- | Get a list of resources matching the current pattern
164+-- | Get a list of resources matching the current pattern. This will also set
165+-- the correct group to the identifiers.
162--
166--
163resources :: RulesM [Identifier a]
167resources :: RulesM [Identifier a]
164resources = RulesM $ do
168resources = RulesM $ do
165 pattern <- rulesPattern <$> ask
169 pattern <- rulesPattern <$> ask
166 provider <- rulesResourceProvider <$> ask
170 provider <- rulesResourceProvider <$> ask
171+ group' <- rulesGroup <$> ask
167− return $ filterMatches pattern $ map toIdentifier $ resourceList provider
172+ return $ filterMatches pattern $ map (toId group') $ resourceList provider
173+ where
174+ toId g = setGroup g . toIdentifier
168
175
169-- | Apart from regular compilers, one is also able to specify metacompilers.
176-- | Apart from regular compilers, one is also able to specify metacompilers.
170-- Metacompilers are a special class of compilers: they are compilers which
177-- Metacompilers are a special class of compilers: they are compilers which