Add compilers producing compilers

3 files changed, 61 insertions, 26 deletions

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index ed38b12..73ee359 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -31,25 +31,34 @@ import Hakyll.Core.Writable
 import Hakyll.Core.ResourceProvider
 import Hakyll.Core.Compiler.Internal
 import Hakyll.Core.Store
+import Hakyll.Core.Rules
 
 -- | Run a compiler, yielding the resulting target and it's dependencies. This
 -- version of 'runCompilerJob' also stores the result
 --
-runCompiler :: Compiler () CompiledItem  -- ^ Compiler to run
-            -> Identifier                -- ^ Target identifier
-            -> ResourceProvider          -- ^ Resource provider
-            -> Maybe FilePath            -- ^ Route
-            -> Store                     -- ^ Store
-            -> Bool                      -- ^ Was the resource modified?
-            -> IO CompiledItem           -- ^ Resulting item
-runCompiler compiler identifier provider route store modified = do
+runCompiler :: Compiler () CompileRule  -- ^ Compiler to run
+            -> Identifier               -- ^ Target identifier
+            -> ResourceProvider         -- ^ Resource provider
+            -> Maybe FilePath           -- ^ Route
+            -> Store                    -- ^ Store
+            -> Bool                     -- ^ Was the resource modified?
+            -> IO CompileRule           -- ^ Resulting item
+runCompiler compiler identifier provider route' store modified = do
     -- Run the compiler job
-    CompiledItem result <- runCompilerJob
-        compiler identifier provider route store modified
+    result <- runCompilerJob compiler identifier provider route' store modified
 
-    -- Store a copy in the cache and return
-    storeSet store "Hakyll.Core.Compiler.runCompiler" identifier result
-    return $ CompiledItem result
+    -- Inspect the result
+    case result of
+        -- In case we compiled an item, we will store a copy in the cache first,
+        -- before we return control. This makes sure the compiled item can later
+        -- be accessed by e.g. require.
+        ItemRule (CompiledItem x) ->
+            storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x
+
+        -- Otherwise, we do nothing here
+        _ -> return ()
+
+    return result
 
 -- | Get the identifier of the item that is currently being compiled
 --
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index de7f6d4..ea3eadc 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -3,19 +3,21 @@
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Hakyll.Core.Rules
-    ( RuleSet (..)
+    ( CompileRule (..)
+    , RuleSet (..)
     , RulesM
     , Rules
     , runRules
     , compile
     , create
     , route
+    , addCompilers
     ) where
 
 import Control.Applicative (Applicative, (<$>))
 import Control.Monad.Writer
 import Control.Monad.Reader
-import Control.Arrow (second, (>>>), arr)
+import Control.Arrow (second, (>>>), arr, (>>^))
 
 import Data.Typeable (Typeable)
 import Data.Binary (Binary)
@@ -23,16 +25,26 @@ import Data.Binary (Binary)
 import Hakyll.Core.ResourceProvider
 import Hakyll.Core.Identifier
 import Hakyll.Core.Identifier.Pattern
-import Hakyll.Core.Compiler
+import Hakyll.Core.Compiler.Internal
 import Hakyll.Core.Route
 import Hakyll.Core.CompiledItem
 import Hakyll.Core.Writable
 
+-- | Output of a compiler rule
+--
+-- * The compiler will produce a simple item. This is the most common case.
+--
+-- * The compiler will produce more compilers. These new compilers need to be
+--   added to the runtime if possible, since other items might depend upon them.
+--
+data CompileRule = ItemRule CompiledItem
+                 | AddCompilersRule [(Identifier, Compiler () CompiledItem)]
+
 -- | A collection of rules for the compilation process
 --
 data RuleSet = RuleSet
     { rulesRoute     :: Route
-    , rulesCompilers :: [(Identifier, Compiler () CompiledItem)]
+    , rulesCompilers :: [(Identifier, Compiler () CompileRule)]
     }
 
 instance Monoid RuleSet where
@@ -58,18 +70,18 @@ runRules rules provider = execWriter $ runReaderT (unRulesM rules) provider
 
 -- | Add a route
 --
-addRoute :: Route -> Rules
-addRoute route' = RulesM $ tell $ RuleSet route' mempty
+tellRoute :: Route -> Rules
+tellRoute route' = RulesM $ tell $ RuleSet route' mempty
 
 -- | Add a number of compilers
 --
-addCompilers :: (Binary a, Typeable a, Writable a)
+tellCompilers :: (Binary a, Typeable a, Writable a)
              => [(Identifier, Compiler () a)]
              -> Rules
-addCompilers compilers = RulesM $ tell $ RuleSet mempty $
+tellCompilers compilers = RulesM $ tell $ RuleSet mempty $
     map (second boxCompiler) compilers
   where
-    boxCompiler = (>>> arr compiledItem)
+    boxCompiler = (>>> arr compiledItem >>> arr ItemRule)
 
 -- | Add a compilation rule
 --
@@ -80,7 +92,7 @@ compile :: (Binary a, Typeable a, Writable a)
         => Pattern -> Compiler () a -> Rules
 compile pattern compiler = RulesM $ do
     identifiers <- matches pattern . resourceList <$> ask
-    unRulesM $ addCompilers $ zip identifiers (repeat compiler)
+    unRulesM $ tellCompilers $ zip identifiers (repeat compiler)
 
 -- | Add a compilation rule
 --
@@ -88,9 +100,23 @@ compile pattern compiler = RulesM $ do
 --
 create :: (Binary a, Typeable a, Writable a)
        => Identifier -> Compiler () a -> Rules
-create identifier compiler = addCompilers [(identifier, compiler)]
+create identifier compiler = tellCompilers [(identifier, compiler)]
 
 -- | Add a route
 --
 route :: Pattern -> Route -> Rules
-route pattern route' = addRoute $ ifMatch pattern route'
+route pattern route' = tellRoute $ ifMatch pattern route'
+
+-- | Add a compiler that produces other compilers over time
+--
+addCompilers :: (Binary a, Typeable a, Writable a)
+             => Identifier
+             -- ^ Identifier for this compiler
+             -> Compiler () [(Identifier, Compiler () a)]   
+             -- ^ Compiler generating the other compilers
+             -> Rules
+             -- ^ Resulting rules
+addCompilers identifier compiler = RulesM $ tell $ RuleSet mempty $
+    [(identifier, compiler >>^ makeRule)]
+  where
+    makeRule = AddCompilersRule . map (second (>>^ compiledItem))
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 7121068..0b102d8 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -91,7 +91,7 @@ hakyllWith rules provider store = do
         let isModified = id' `S.member` modified'
 
         -- Run the compiler
-        compiled <- runCompiler comp id' provider url store isModified
+        ItemRule compiled <- runCompiler comp id' provider url store isModified
         putStrLn $ "Generated target: " ++ show id'
 
         case url of