@@ -30,9 +30,10 @@ module Hakyll.Core.Rules
3030
3131--------------------------------------------------------------------------------
3232import Control.Applicative ((<$>))
33−import Control.Arrow (second)
3433import Control.Monad.Reader (ask, local)
34+import Control.Monad.State (get, modify, put)
3535import Control.Monad.Writer (censor, tell)
36+import Data.Maybe (fromMaybe)
3637import Data.Monoid (mappend, mempty)
3738import qualified Data.Set as S
3839
@@ -63,40 +64,50 @@ tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty
6364
6465--------------------------------------------------------------------------------
6566-- | Add a number of compilers
66−tellCompilers :: (Binary a, Typeable a, Writable a)
67− => [(Identifier, Compiler (Item a))]
68− -> Rules ()
69−tellCompilers compilers = Rules $ do
70− -- We box the compilers so they have a more simple type
71− let compilers' = map (second $ fmap SomeItem) compilers
72− tell $ RuleSet mempty compilers' mempty
67+tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()
68+tellCompilers compilers = Rules $ tell $ RuleSet mempty compilers mempty
7369
7470
7571--------------------------------------------------------------------------------
7672-- | Add resources
77−tellResources :: [Identifier]
78− -> Rules ()
73+tellResources :: [Identifier] -> Rules ()
7974tellResources resources' = Rules $ tell $
8075 RuleSet mempty mempty $ S.fromList resources'
8176
8277
8378--------------------------------------------------------------------------------
84−-- | Make sure routes are consistent with the compilers in this section
85−fixRoutes :: Rules b -> Rules b
86−fixRoutes = Rules . censor matchRoutes . unRules
87− where
88− -- Create a fast pattern for routing that matches exactly the compilers
89− -- created in the block given to match
90− matchRoutes ruleSet = ruleSet
91− { rulesRoutes = matchRoute fastPattern (rulesRoutes ruleSet)
92− }
93− where
94− fastPattern = fromList [id' | (id', _) <- rulesCompilers ruleSet]
79+flush :: Rules ()
80+flush = Rules $ do
81+ mcompiler <- rulesCompiler <$> get
82+ case mcompiler of
83+ Nothing -> return ()
84+ Just compiler -> do
85+ pattern <- rulesPattern <$> ask
86+ version' <- rulesVersion <$> ask
87+ route' <- fromMaybe mempty . rulesRoute <$> get
88+ ids <- case fromLiteral pattern of
89+ Just id' -> return [setVersion version' id']
90+ Nothing -> do
91+ ids <- unRules $ getMatches pattern
92+ unRules $ tellResources ids
93+ return $ map (setVersion version') ids
94+
95+ -- Create a fast pattern for routing that matches exactly the
96+ -- compilers created in the block given to match
97+ let fastPattern = fromList ids
98+
99+ -- Write out the compilers and routes
100+ unRules $ tellRoute $ matchRoute fastPattern route'
101+ unRules $ tellCompilers $ [(id', compiler) | id' <- ids]
102+
103+ put $ emptyRulesState
95104
96105
97106--------------------------------------------------------------------------------
98−match :: Pattern -> Rules b -> Rules b
99−match pattern = fixRoutes . Rules . local addPattern . unRules
107+match :: Pattern -> Rules () -> Rules ()
108+match pattern rules = do
109+ flush
110+ Rules $ local addPattern $ unRules $ rules >> flush
100111 where
101112 addPattern env = env
102113 { rulesPattern = rulesPattern env `mappend` pattern
@@ -104,8 +115,10 @@ match pattern = fixRoutes . Rules . local addPattern . unRules
104115
105116
106117--------------------------------------------------------------------------------
107−version :: String -> Rules a -> Rules a
108−version v = fixRoutes . Rules . local setVersion' . unRules
118+version :: String -> Rules () -> Rules ()
119+version v rules = do
120+ flush
121+ Rules $ local setVersion' $ unRules $ rules >> flush
109122 where
110123 setVersion' env = env {rulesVersion = Just v}
111124
@@ -116,19 +129,9 @@ version v = fixRoutes . Rules . local setVersion' . unRules
116129-- This instructs all resources to be compiled using the given compiler. When
117130-- no resources match the current selection, nothing will happen. In this case,
118131-- you might want to have a look at 'create'.
119−compile :: (Binary a, Typeable a, Writable a)
120− => Compiler (Item a) -> Rules ()
121−compile compiler = do
122− pattern <- Rules $ rulesPattern <$> ask
123− version' <- Rules $ rulesVersion <$> ask
124− ids <- case fromLiteral pattern of
125− Just id' -> return [id']
126− Nothing -> do
127− ids <- getMatches pattern
128− tellResources ids
129− return ids
130−
131− tellCompilers [(setVersion version' id', compiler) | id' <- ids]
132+compile :: (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules ()
133+compile compiler = Rules $ modify $ \s ->
134+ s {rulesCompiler = Just (fmap SomeItem compiler)}
132135
133136
134137--------------------------------------------------------------------------------
@@ -136,7 +139,7 @@ compile compiler = do
136139--
137140-- This adds a route for all items matching the current pattern.
138141route :: Routes -> Rules ()
139−route = tellRoute
142+route route' = Rules $ modify $ \s -> s {rulesRoute = Just route'}
140143
141144
142145--------------------------------------------------------------------------------