diff options
Diffstat (limited to 'src/Hakyll/Core/Rules.hs')
-rw-r--r-- | src/Hakyll/Core/Rules.hs | 50 |
1 files changed, 38 insertions, 12 deletions
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)) |