on master help sign in
Add compilers producing compilers
commit11d7031da3928b31cf622a8d1c21bced735dddd3 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateFri 7 Jan 2011, 12:12 (16 years ago) parent70fa0c2
3 files changed+61−26
src/Hakyll/Core/Compiler.hs+22−13 src/Hakyll/Core/Rules.hs+38−12 src/Hakyll/Core/Run.hs+1−1
src/Hakyll/Core/Compiler.hs+22−13
@@ -31,25 +31,34 @@ import Hakyll.Core.Writable
3131import Hakyll.Core.ResourceProvider
3232import Hakyll.Core.Compiler.Internal
3333import Hakyll.Core.Store
34+import Hakyll.Core.Rules
3435
3536-- | Run a compiler, yielding the resulting target and it's dependencies. This
3637-- version of 'runCompilerJob' also stores the result
3738--
38−runCompiler :: Compiler () CompiledItem -- ^ Compiler to run
39− -> Identifier -- ^ Target identifier
40− -> ResourceProvider -- ^ Resource provider
41− -> Maybe FilePath -- ^ Route
42− -> Store -- ^ Store
43− -> Bool -- ^ Was the resource modified?
44− -> IO CompiledItem -- ^ Resulting item
45−runCompiler compiler identifier provider route store modified = do
39+runCompiler :: Compiler () CompileRule -- ^ Compiler to run
40+ -> Identifier -- ^ Target identifier
41+ -> ResourceProvider -- ^ Resource provider
42+ -> Maybe FilePath -- ^ Route
43+ -> Store -- ^ Store
44+ -> Bool -- ^ Was the resource modified?
45+ -> IO CompileRule -- ^ Resulting item
46+runCompiler compiler identifier provider route' store modified = do
4647 -- Run the compiler job
47− CompiledItem result <- runCompilerJob
48− compiler identifier provider route store modified
48+ result <- runCompilerJob compiler identifier provider route' store modified
4949
50− -- Store a copy in the cache and return
51− storeSet store "Hakyll.Core.Compiler.runCompiler" identifier result
52− return $ CompiledItem result
50+ -- Inspect the result
51+ case result of
52+ -- In case we compiled an item, we will store a copy in the cache first,
53+ -- before we return control. This makes sure the compiled item can later
54+ -- be accessed by e.g. require.
55+ ItemRule (CompiledItem x) ->
56+ storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x
57+
58+ -- Otherwise, we do nothing here
59+ _ -> return ()
60+
61+ return result
5362
5463-- | Get the identifier of the item that is currently being compiled
5564--
src/Hakyll/Core/Rules.hs+38−12
@@ -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))
src/Hakyll/Core/Run.hs+1−1
@@ -91,7 +91,7 @@ hakyllWith rules provider store = do
9191 let isModified = id' `S.member` modified'
9292
9393 -- Run the compiler
94− compiled <- runCompiler comp id' provider url store isModified
94+ ItemRule compiled <- runCompiler comp id' provider url store isModified
9595 putStrLn $ "Generated target: " ++ show id'
9696
9797 case url of