git.iko.soy/hakyll
on master help sign in
Autogenerate metacompiler indentifiers
c691251Jasper Van der Jeugt
src/Hakyll/Core/Rules.hs+43−14
compare with master
unifiedsplit
@@ -1,7 +1,7 @@
1-- | This module provides a monadic DSL in which the user can specify the
1-- | This module provides a monadic DSL in which the user can specify the
2-- different rules used to run the compilers
2-- different rules used to run the compilers
3--
3--
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}
5module Hakyll.Core.Rules
5module Hakyll.Core.Rules
6 ( CompileRule (..)
6 ( CompileRule (..)
7 , RuleSet (..)
7 , RuleSet (..)
@@ -11,13 +11,15 @@ module Hakyll.Core.Rules
11 , compile
11 , compile
12 , create
12 , create
13 , route
13 , route
14− , addCompilers
14+ , metaCompile
15+ , metaCompileWith
15 ) where
16 ) where
16
17
17import Control.Applicative (Applicative, (<$>))
18import Control.Applicative (Applicative, (<$>))
18import Control.Monad.Writer
19import Control.Monad.Writer
19import Control.Monad.Reader
20import Control.Monad.Reader
20import Control.Arrow (second, (>>>), arr, (>>^))
21import Control.Arrow (second, (>>>), arr, (>>^))
22+import Control.Monad.State
21
23
22import Data.Typeable (Typeable)
24import Data.Typeable (Typeable)
23import Data.Binary (Binary)
25import Data.Binary (Binary)
@@ -52,10 +54,16 @@ instance Monoid RuleSet where
52 mappend (RuleSet r1 c1) (RuleSet r2 c2) =
54 mappend (RuleSet r1 c1) (RuleSet r2 c2) =
53 RuleSet (mappend r1 r2) (mappend c1 c2)
55 RuleSet (mappend r1 r2) (mappend c1 c2)
54
56
57+-- | Rule state
58+--
59+data RuleState = RuleState
60+ { rulesMetaCompilerIndex :: Int
61+ } deriving (Show)
62+
55-- | The monad used to compose rules
63-- | The monad used to compose rules
56--
64--
57newtype RulesM a = RulesM
65newtype RulesM a = RulesM
58− { unRulesM :: ReaderT ResourceProvider (Writer RuleSet) a
66+ { unRulesM :: ReaderT ResourceProvider (WriterT RuleSet (State RuleState)) a
59 } deriving (Monad, Functor, Applicative)
67 } deriving (Monad, Functor, Applicative)
60
68
61-- | Simplification of the RulesM type; usually, it will not return any
69-- | Simplification of the RulesM type; usually, it will not return any
@@ -66,7 +74,10 @@ type Rules = RulesM ()
66-- | Run a Rules monad, resulting in a 'RuleSet'
74-- | Run a Rules monad, resulting in a 'RuleSet'
67--
75--
68runRules :: Rules -> ResourceProvider -> RuleSet
76runRules :: Rules -> ResourceProvider -> RuleSet
77+runRules rules provider =
69−runRules rules provider = execWriter $ runReaderT (unRulesM rules) provider
78+ evalState (execWriterT $ runReaderT (unRulesM rules) provider) state
79+ where
80+ state = RuleState {rulesMetaCompilerIndex = 0}
70
81
71-- | Add a route
82-- | Add a route
72--
83--
@@ -109,16 +120,34 @@ route pattern route' = tellRoute $ ifMatch pattern route'
109
120
110-- | Add a compiler that produces other compilers over time
121-- | Add a compiler that produces other compilers over time
111--
122--
112−-- TODO: Rename to metaCompile? Auto-generate identifier?
123+metaCompile :: (Binary a, Typeable a, Writable a)
124+ => Compiler () [(Identifier, Compiler () a)]
125+ -- ^ Compiler generating the other compilers
126+ -> Rules
127+ -- ^ Resulting rules
128+metaCompile compiler = RulesM $ do
129+ -- Create an identifier from the state
130+ state <- get
131+ let index = rulesMetaCompilerIndex state
132+ id' = fromCaptureString "Hakyll.Core.Rules.metaCompile/*" (show index)
133+
134+ -- Update the state with a new identifier
135+ put $ state {rulesMetaCompilerIndex = index + 1}
136+
137+ -- Fallback to 'metaCompileWith' with now known identifier
138+ unRulesM $ metaCompileWith id' compiler
139+
140+-- | Version of 'metaCompile' that allows you to specify a custom identifier for
141+-- the metacompiler.
113−--
142+--
114−addCompilers :: (Binary a, Typeable a, Writable a)
143+metaCompileWith :: (Binary a, Typeable a, Writable a)
115− => Identifier
144+ => Identifier
116− -- ^ Identifier for this compiler
145+ -- ^ Identifier for this compiler
117− -> Compiler () [(Identifier, Compiler () a)]
146+ -> Compiler () [(Identifier, Compiler () a)]
118− -- ^ Compiler generating the other compilers
147+ -- ^ Compiler generating the other compilers
119− -> Rules
148+ -> Rules
120− -- ^ Resulting rules
149+ -- ^ Resulting rules
121−addCompilers identifier compiler = RulesM $ tell $ RuleSet mempty
150+metaCompileWith identifier compiler = RulesM $ tell $ RuleSet mempty
122 [(identifier, compiler >>> arr makeRule )]
151 [(identifier, compiler >>> arr makeRule )]
123 where
152 where
124 makeRule = MetaCompileRule . map (second box)
153 makeRule = MetaCompileRule . map (second box)