git.iko.soy/hakyll
on b91c8be help sign in
hakyll/src/Hakyll/Core/Rules.hs
183 lines 6.6 kB history raw
1--------------------------------------------------------------------------------
2-- | This module provides a declarative DSL in which the user can specify the
3-- different rules used to run the compilers.
4--
5-- The convention is to just list all items in the 'Rules' monad, routes and
6-- compilation rules.
7--
8-- A typical usage example would be:
9--
10-- > main = hakyll $ do
11-- > match "posts/*" $ do
12-- > route (setExtension "html")
13-- > compile someCompiler
14-- > match "css/*" $ do
15-- > route idRoute
16-- > compile compressCssCompiler
17{-# LANGUAGE GeneralizedNewtypeDeriving #-}
18{-# LANGUAGE OverloadedStrings #-}
19module Hakyll.Core.Rules
20 ( Rules
21 , match
22 , create
23 , version
24 , compile
25 , route
27 -- * Advanced usage
28 , preprocess
29 , Dependency (..)
30 , rulesExtraDependencies
31 ) where
34--------------------------------------------------------------------------------
35import Control.Applicative ((<$>))
36import Control.Monad.Reader (ask, local)
37import Control.Monad.State (get, modify, put)
38import Control.Monad.Trans (liftIO)
39import Control.Monad.Writer (censor, tell)
40import Data.Maybe (fromMaybe)
41import Data.Monoid (mempty)
42import qualified Data.Set as S
45--------------------------------------------------------------------------------
46import Data.Binary (Binary)
47import Data.Typeable (Typeable)
50--------------------------------------------------------------------------------
51import Hakyll.Core.Compiler.Internal
52import Hakyll.Core.Dependencies
53import Hakyll.Core.Identifier
54import Hakyll.Core.Identifier.Pattern
55import Hakyll.Core.Item
56import Hakyll.Core.Item.SomeItem
57import Hakyll.Core.Metadata
58import Hakyll.Core.Routes
59import Hakyll.Core.Rules.Internal
60import Hakyll.Core.Writable
63--------------------------------------------------------------------------------
64-- | Add a route
65tellRoute :: Routes -> Rules ()
66tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty
69--------------------------------------------------------------------------------
70-- | Add a number of compilers
71tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()
72tellCompilers compilers = Rules $ tell $ RuleSet mempty compilers mempty
75--------------------------------------------------------------------------------
76-- | Add resources
77tellResources :: [Identifier] -> Rules ()
78tellResources resources' = Rules $ tell $
79 RuleSet mempty mempty $ S.fromList resources'
82--------------------------------------------------------------------------------
83flush :: Rules ()
84flush = Rules $ do
85 mcompiler <- rulesCompiler <$> get
86 case mcompiler of
87 Nothing -> return ()
88 Just compiler -> do
89 matches' <- rulesMatches <$> ask
90 version' <- rulesVersion <$> ask
91 route' <- fromMaybe mempty . rulesRoute <$> get
93 -- The version is possibly not set correctly at this point (yet)
94 let ids = map (setVersion version') matches'
96 {-
97 ids <- case fromLiteral pattern of
98 Just id' -> return [setVersion version' id']
99 Nothing -> do
100 ids <- unRules $ getMatches pattern
101 unRules $ tellResources ids
102 return $ map (setVersion version') ids
103 -}
105 -- Create a fast pattern for routing that matches exactly the
106 -- compilers created in the block given to match
107 let fastPattern = fromList ids
109 -- Write out the compilers and routes
110 unRules $ tellRoute $ matchRoute fastPattern route'
111 unRules $ tellCompilers $ [(id', compiler) | id' <- ids]
113 put $ emptyRulesState
116--------------------------------------------------------------------------------
117match :: Pattern -> Rules () -> Rules ()
118match pattern rules = do
119 flush
120 ids <- getMatches pattern
121 tellResources ids
122 Rules $ local (setMatches ids) $ unRules $ rules >> flush
123 where
124 setMatches ids env = env {rulesMatches = ids}
127--------------------------------------------------------------------------------
128create :: [Identifier] -> Rules () -> Rules ()
129create ids rules = do
130 flush
131 -- TODO Maybe check if the resources exist and call tellResources on that
132 Rules $ local setMatches $ unRules $ rules >> flush
133 where
134 setMatches env = env {rulesMatches = ids}
137--------------------------------------------------------------------------------
138version :: String -> Rules () -> Rules ()
139version v rules = do
140 flush
141 Rules $ local setVersion' $ unRules $ rules >> flush
142 where
143 setVersion' env = env {rulesVersion = Just v}
146--------------------------------------------------------------------------------
147-- | Add a compilation rule to the rules.
148--
149-- This instructs all resources to be compiled using the given compiler.
150compile :: (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules ()
151compile compiler = Rules $ modify $ \s ->
152 s {rulesCompiler = Just (fmap SomeItem compiler)}
155--------------------------------------------------------------------------------
156-- | Add a route.
157--
158-- This adds a route for all items matching the current pattern.
159route :: Routes -> Rules ()
160route route' = Rules $ modify $ \s -> s {rulesRoute = Just route'}
163--------------------------------------------------------------------------------
164-- | Execute an 'IO' action immediately while the rules are being evaluated.
165-- This should be avoided if possible, but occasionally comes in useful.
166preprocess :: IO a -> Rules a
167preprocess = Rules . liftIO
170--------------------------------------------------------------------------------
171-- | Advanced usage: add extra dependencies to compilers. Basically this is
172-- needed when you're doing unsafe tricky stuff in the rules monad, but you
173-- still want correct builds.
174rulesExtraDependencies :: [Dependency] -> Rules a -> Rules a
175rulesExtraDependencies deps = Rules . censor addDependencies . unRules
176 where
177 -- Adds the dependencies to the compilers in the ruleset
178 addDependencies ruleSet = ruleSet
179 { rulesCompilers =
180 [ (i, compilerTellDependencies deps >> c)
181 | (i, c) <- rulesCompilers ruleSet
182 ]
183 }