summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2011-02-15 18:32:55 +0100
committerJasper Van der Jeugt <jaspervdj@gmail.com>2011-02-15 18:32:55 +0100
commit5a591ee24c50ed25702c06f8f811189984e443ea (patch)
tree3f112517c7042e11e3bd475fb4849c515d789835
parentabfb4c19195cf305637f1a9acd7f6dd70d59b831 (diff)
downloadhakyll-5a591ee24c50ed25702c06f8f811189984e443ea.tar.gz
Rules DSL tracks resources used
-rw-r--r--src/Hakyll/Core/Rules.hs24
-rw-r--r--src/Hakyll/Core/Rules/Internal.hs15
2 files changed, 27 insertions, 12 deletions
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index 137dc2c..1aa3ad3 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -27,6 +27,7 @@ import Control.Monad.Reader (ask)
import Control.Arrow (second, (>>>), arr, (>>^))
import Control.Monad.State (get, put)
import Data.Monoid (mempty)
+import qualified Data.Set as S
import Data.Typeable (Typeable)
import Data.Binary (Binary)
@@ -44,18 +45,24 @@ import Hakyll.Core.Util.Arrow
-- | Add a route
--
tellRoute :: Routes -> Rules
-tellRoute route' = RulesM $ tell $ RuleSet route' mempty
+tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty
-- | Add a number of compilers
--
tellCompilers :: (Binary a, Typeable a, Writable a)
=> [(Identifier, Compiler () a)]
-> Rules
-tellCompilers compilers = RulesM $ tell $ RuleSet mempty $
- map (second boxCompiler) compilers
+tellCompilers compilers = RulesM $ tell $ RuleSet mempty compilers' mempty
where
+ compilers' = map (second boxCompiler) compilers
boxCompiler = (>>> arr compiledItem >>> arr CompileRule)
+-- | Add resources
+--
+tellResources :: [Resource]
+ -> Rules
+tellResources resources = RulesM $ tell $ RuleSet mempty mempty $ S.fromList resources
+
-- | Add a compilation rule to the rules.
--
-- This instructs all resources matching the given pattern to be compiled using
@@ -66,8 +73,10 @@ compile :: (Binary a, Typeable a, Writable a)
=> Pattern -> Compiler Resource a -> Rules
compile pattern compiler = RulesM $ do
identifiers <- matches pattern . map unResource . resourceList <$> ask
- unRulesM $ tellCompilers $ flip map identifiers $ \identifier ->
- (identifier, constA (Resource identifier) >>> compiler)
+ unRulesM $ do
+ tellCompilers $ flip map identifiers $ \identifier ->
+ (identifier, constA (Resource identifier) >>> compiler)
+ tellResources $ map Resource identifiers
-- | Add a compilation rule
--
@@ -125,8 +134,9 @@ metaCompileWith :: (Binary a, Typeable a, Writable a)
-- ^ Compiler generating the other compilers
-> Rules
-- ^ Resulting rules
-metaCompileWith identifier compiler = RulesM $ tell $ RuleSet mempty
- [(identifier, compiler >>> arr makeRule )]
+metaCompileWith identifier compiler = RulesM $ tell $
+ RuleSet mempty compilers mempty
where
makeRule = MetaCompileRule . map (second box)
+ compilers = [(identifier, compiler >>> arr makeRule )]
box = (>>> fromDependency identifier >>^ CompileRule . compiledItem)
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs
index bedc67a..2895257 100644
--- a/src/Hakyll/Core/Rules/Internal.hs
+++ b/src/Hakyll/Core/Rules/Internal.hs
@@ -15,6 +15,7 @@ import Control.Monad.Writer (WriterT, execWriterT)
import Control.Monad.Reader (ReaderT, runReaderT)
import Control.Monad.State (State, evalState)
import Data.Monoid (Monoid, mempty, mappend)
+import Data.Set (Set)
import Hakyll.Core.ResourceProvider
import Hakyll.Core.Identifier
@@ -35,14 +36,18 @@ data CompileRule = CompileRule CompiledItem
-- | A collection of rules for the compilation process
--
data RuleSet = RuleSet
- { rulesRoutes :: Routes
- , rulesCompilers :: [(Identifier, Compiler () CompileRule)]
+ { -- | Routes used in the compilation structure
+ rulesRoutes :: Routes
+ , -- | Compilation rules
+ rulesCompilers :: [(Identifier, Compiler () CompileRule)]
+ , -- | A list of the used resources
+ rulesResources :: Set Resource
}
instance Monoid RuleSet where
- mempty = RuleSet mempty mempty
- mappend (RuleSet r1 c1) (RuleSet r2 c2) =
- RuleSet (mappend r1 r2) (mappend c1 c2)
+ mempty = RuleSet mempty mempty mempty
+ mappend (RuleSet r1 c1 s1) (RuleSet r2 c2 s2) =
+ RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2)
-- | Rule state
--