From 11d7031da3928b31cf622a8d1c21bced735dddd3 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 7 Jan 2011 12:12:13 +0100 Subject: Add compilers producing compilers --- src/Hakyll/Core/Compiler.hs | 35 +++++++++++++++++++------------ src/Hakyll/Core/Rules.hs | 50 ++++++++++++++++++++++++++++++++++----------- src/Hakyll/Core/Run.hs | 2 +- 3 files changed, 61 insertions(+), 26 deletions(-) (limited to 'src') 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 -- cgit v1.2.3