@@ -3,19 +3,21 @@
33--
44{-# LANGUAGE GeneralizedNewtypeDeriving #-}
55module Hakyll.Core.Rules
6− ( RuleSet (..)
6+ ( CompileRule (..)
7+ , RuleSet (..)
78 , RulesM
89 , Rules
910 , runRules
1011 , compile
1112 , create
1213 , route
14+ , addCompilers
1315 ) where
1416
1517import Control.Applicative (Applicative, (<$>))
1618import Control.Monad.Writer
1719import Control.Monad.Reader
18−import Control.Arrow (second, (>>>), arr)
20+import Control.Arrow (second, (>>>), arr, (>>^))
1921
2022import Data.Typeable (Typeable)
2123import Data.Binary (Binary)
@@ -23,16 +25,26 @@ import Data.Binary (Binary)
2325import Hakyll.Core.ResourceProvider
2426import Hakyll.Core.Identifier
2527import Hakyll.Core.Identifier.Pattern
26−import Hakyll.Core.Compiler
28+import Hakyll.Core.Compiler.Internal
2729import Hakyll.Core.Route
2830import Hakyll.Core.CompiledItem
2931import Hakyll.Core.Writable
3032
33+-- | Output of a compiler rule
34+--
35+-- * The compiler will produce a simple item. This is the most common case.
36+--
37+-- * The compiler will produce more compilers. These new compilers need to be
38+-- added to the runtime if possible, since other items might depend upon them.
39+--
40+data CompileRule = ItemRule CompiledItem
41+ | AddCompilersRule [(Identifier, Compiler () CompiledItem)]
42+
3143-- | A collection of rules for the compilation process
3244--
3345data RuleSet = RuleSet
3446 { rulesRoute :: Route
35− , rulesCompilers :: [(Identifier, Compiler () CompiledItem)]
47+ , rulesCompilers :: [(Identifier, Compiler () CompileRule)]
3648 }
3749
3850instance Monoid RuleSet where
@@ -58,18 +70,18 @@ runRules rules provider = execWriter $ runReaderT (unRulesM rules) provider
5870
5971-- | Add a route
6072--
61−addRoute :: Route -> Rules
62−addRoute route' = RulesM $ tell $ RuleSet route' mempty
73+tellRoute :: Route -> Rules
74+tellRoute route' = RulesM $ tell $ RuleSet route' mempty
6375
6476-- | Add a number of compilers
6577--
66−addCompilers :: (Binary a, Typeable a, Writable a)
78+tellCompilers :: (Binary a, Typeable a, Writable a)
6779 => [(Identifier, Compiler () a)]
6880 -> Rules
69−addCompilers compilers = RulesM $ tell $ RuleSet mempty $
81+tellCompilers compilers = RulesM $ tell $ RuleSet mempty $
7082 map (second boxCompiler) compilers
7183 where
72− boxCompiler = (>>> arr compiledItem)
84+ boxCompiler = (>>> arr compiledItem >>> arr ItemRule)
7385
7486-- | Add a compilation rule
7587--
@@ -80,7 +92,7 @@ compile :: (Binary a, Typeable a, Writable a)
8092 => Pattern -> Compiler () a -> Rules
8193compile pattern compiler = RulesM $ do
8294 identifiers <- matches pattern . resourceList <$> ask
83− unRulesM $ addCompilers $ zip identifiers (repeat compiler)
95+ unRulesM $ tellCompilers $ zip identifiers (repeat compiler)
8496
8597-- | Add a compilation rule
8698--
@@ -88,9 +100,23 @@ compile pattern compiler = RulesM $ do
88100--
89101create :: (Binary a, Typeable a, Writable a)
90102 => Identifier -> Compiler () a -> Rules
91−create identifier compiler = addCompilers [(identifier, compiler)]
103+create identifier compiler = tellCompilers [(identifier, compiler)]
92104
93105-- | Add a route
94106--
95107route :: Pattern -> Route -> Rules
96−route pattern route' = addRoute $ ifMatch pattern route'
108+route pattern route' = tellRoute $ ifMatch pattern route'
109+
110+-- | Add a compiler that produces other compilers over time
111+--
112+addCompilers :: (Binary a, Typeable a, Writable a)
113+ => Identifier
114+ -- ^ Identifier for this compiler
115+ -> Compiler () [(Identifier, Compiler () a)]
116+ -- ^ Compiler generating the other compilers
117+ -> Rules
118+ -- ^ Resulting rules
119+addCompilers identifier compiler = RulesM $ tell $ RuleSet mempty $
120+ [(identifier, compiler >>^ makeRule)]
121+ where
122+ makeRule = AddCompilersRule . map (second (>>^ compiledItem))