git.iko.soy/hakyll
on 5dba607 help sign in
hakyll/src/Hakyll/Core/Rules.hs
250 lines 8.7 kB history raw
1-- | This module provides a declarative DSL in which the user can specify the
2-- different rules used to run the compilers.
3--
4-- The convention is to just list all items in the 'RulesM' monad, routes and
5-- compilation rules.
6--
7-- A typical usage example would be:
8--
9-- > main = hakyll $ do
10-- > match "posts/*" $ do
11-- > route (setExtension "html")
12-- > compile someCompiler
13-- > match "css/*" $ do
14-- > route idRoute
15-- > compile compressCssCompiler
16--
17{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}
18module Hakyll.Core.Rules
19 ( RulesM
20 , Rules
21 , match
22 , group
23 , compile
24 , create
25 , route
26 , resources
27 , metaCompile
28 , metaCompileWith
29 , freshIdentifier
30 ) where
32import Control.Applicative ((<$>))
33import Control.Monad.Writer (tell)
34import Control.Monad.Reader (ask, local)
35import Control.Arrow ((>>>), arr, (>>^), (***))
36import Control.Monad.State (get, put)
37import Data.Monoid (mempty, mappend)
38import qualified Data.Set as S
40import Data.Typeable (Typeable)
41import Data.Binary (Binary)
43import Hakyll.Core.Resource
44import Hakyll.Core.Resource.Provider
45import Hakyll.Core.Identifier
46import Hakyll.Core.Identifier.Pattern
47import Hakyll.Core.Compiler.Internal
48import Hakyll.Core.Routes
49import Hakyll.Core.CompiledItem
50import Hakyll.Core.Writable
51import Hakyll.Core.Rules.Internal
52import Hakyll.Core.Util.Arrow
54-- | Add a route
55--
56tellRoute :: Routes -> Rules
57tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty
59-- | Add a number of compilers
60--
61tellCompilers :: (Binary a, Typeable a, Writable a)
62 => [(Identifier a, Compiler () a)]
63 -> Rules
64tellCompilers compilers = RulesM $ do
65 -- We box the compilers so they have a more simple type
66 let compilers' = map (castIdentifier *** boxCompiler) compilers
67 tell $ RuleSet mempty compilers' mempty
68 where
69 boxCompiler = (>>> arr compiledItem >>> arr CompileRule)
71-- | Add resources
72--
73tellResources :: [Resource]
74 -> Rules
75tellResources resources' = RulesM $ tell $
76 RuleSet mempty mempty $ S.fromList resources'
78-- | Only compile/route items satisfying the given predicate
79--
80match :: Pattern a -> RulesM b -> RulesM b
81match pattern = RulesM . local addPredicate . unRulesM
82 where
83 addPredicate env = env
84 { rulesPattern = rulesPattern env `mappend` castPattern pattern
85 }
87-- | Greate a group of compilers
88--
89-- Imagine you have a page that you want to render, but you also want the raw
90-- content available on your site.
91--
92-- > match "test.markdown" $ do
93-- > route $ setExtension "html"
94-- > compile pageCompiler
95-- >
96-- > match "test.markdown" $ do
97-- > route idRoute
98-- > compile copyPageCompiler
99--
100-- Will of course conflict! In this case, Hakyll will pick the first matching
101-- compiler (@pageCompiler@ in this case).
102--
103-- In case you want to have them both, you can use the 'group' function to
104-- create a new group. For example,
105--
106-- > match "test.markdown" $ do
107-- > route $ setExtension "html"
108-- > compile pageCompiler
109-- >
110-- > group "raw" $ do
111-- > match "test.markdown" $ do
112-- > route idRoute
113-- > compile copyPageCompiler
114--
115-- This will put the compiler for the raw content in a separate group
116-- (@\"raw\"@), which causes it to be compiled as well.
117--
118group :: String -> RulesM a -> RulesM a
119group g = RulesM . local setGroup' . unRulesM
120 where
121 setGroup' env = env { rulesGroup = Just g }
123-- | Add a compilation rule to the rules.
124--
125-- This instructs all resources to be compiled using the given compiler. When
126-- no resources match the current selection, nothing will happen. In this case,
127-- you might want to have a look at 'create'.
128--
129compile :: (Binary a, Typeable a, Writable a)
130 => Compiler Resource a -> RulesM (Pattern a)
131compile compiler = do
132 ids <- resources
133 tellCompilers $ flip map ids $ \identifier ->
134 (identifier, constA (fromIdentifier identifier) >>> compiler)
135 tellResources $ map fromIdentifier ids
136 return $ list ids
138-- | Add a compilation rule
139--
140-- This sets a compiler for the given identifier. No resource is needed, since
141-- we are creating the item from scratch. This is useful if you want to create a
142-- page on your site that just takes content from other items -- but has no
143-- actual content itself. Note that the group of the given identifier is
144-- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been
145-- used).
146--
147create :: (Binary a, Typeable a, Writable a)
148 => Identifier a -> Compiler () a -> RulesM (Identifier a)
149create id' compiler = RulesM $ do
150 group' <- rulesGroup <$> ask
151 let id'' = setGroup group' id'
152 unRulesM $ tellCompilers [(id'', compiler)]
153 return id''
155-- | Add a route.
156--
157-- This adds a route for all items matching the current pattern.
158--
159route :: Routes -> Rules
160route route' = RulesM $ do
161 -- We want the route only to be applied if we match the current pattern and
162 -- group
163 pattern <- rulesPattern <$> ask
164 group' <- rulesGroup <$> ask
165 unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route'
167-- | Get a list of resources matching the current pattern. This will also set
168-- the correct group to the identifiers.
169--
170resources :: RulesM [Identifier a]
171resources = RulesM $ do
172 pattern <- rulesPattern <$> ask
173 provider <- rulesResourceProvider <$> ask
174 group' <- rulesGroup <$> ask
175 return $ filterMatches pattern $ map (toId group') $ resourceList provider
176 where
177 toId g = setGroup g . toIdentifier
179-- | Apart from regular compilers, one is also able to specify metacompilers.
180-- Metacompilers are a special class of compilers: they are compilers which
181-- produce other compilers.
182--
183-- This is needed when the list of compilers depends on something we cannot know
184-- before actually running other compilers. The most typical example is if we
185-- have a blogpost using tags.
186--
187-- Every post has a collection of tags. For example,
188--
189-- > post1: code, haskell
190-- > post2: code, random
191--
192-- Now, we want to create a list of posts for every tag. We cannot write this
193-- down in our 'Rules' DSL directly, since we don't know what tags the different
194-- posts will have -- we depend on information that will only be available when
195-- we are actually compiling the pages.
196--
197-- The solution is simple, using 'metaCompile', we can add a compiler that will
198-- parse the pages and produce the compilers needed for the different tag pages.
199--
200-- And indeed, we can see that the first argument to 'metaCompile' is a
201-- 'Compiler' which produces a list of ('Identifier', 'Compiler') pairs. The
202-- idea is simple: 'metaCompile' produces a list of compilers, and the
203-- corresponding identifiers.
204--
205-- For simple hakyll systems, it is no need for this construction. More
206-- formally, it is only needed when the content of one or more items determines
207-- which items must be rendered.
208--
209metaCompile :: (Binary a, Typeable a, Writable a)
210 => Compiler () [(Identifier a, Compiler () a)]
211 -- ^ Compiler generating the other compilers
212 -> Rules
213 -- ^ Resulting rules
214metaCompile compiler = do
215 id' <- freshIdentifier "Hakyll.Core.Rules.metaCompile"
216 metaCompileWith id' compiler
218-- | Version of 'metaCompile' that allows you to specify a custom identifier for
219-- the metacompiler.
220--
221metaCompileWith :: (Binary a, Typeable a, Writable a)
222 => Identifier ()
223 -- ^ Identifier for this compiler
224 -> Compiler () [(Identifier a, Compiler () a)]
225 -- ^ Compiler generating the other compilers
226 -> Rules
227 -- ^ Resulting rules
228metaCompileWith identifier compiler = RulesM $ do
229 group' <- rulesGroup <$> ask
231 let -- Set the correct group on the identifier
232 id' = setGroup group' identifier
233 -- Function to box an item into a rule
234 makeRule = MetaCompileRule . map (castIdentifier *** box)
235 -- Entire boxing function
236 box = (>>> fromDependency id' >>^ CompileRule . compiledItem)
237 -- Resulting compiler list
238 compilers = [(id', compiler >>> arr makeRule )]
240 tell $ RuleSet mempty compilers mempty
242-- | Generate a fresh Identifier with a given prefix
243freshIdentifier :: String -- ^ Prefix
244 -> RulesM (Identifier a) -- ^ Fresh identifier
245freshIdentifier prefix = RulesM $ do
246 state <- get
247 let index = rulesNextIdentifier state
248 id' = parseIdentifier $ prefix ++ "/" ++ show index
249 put $ state {rulesNextIdentifier = index + 1}
250 return id'