git.iko.soy/hakyll
on 5dba607 help sign in
hakyll/src/Hakyll/Core/Rules/Internal.hs
99 lines 3.2 kB history raw
1-- | Internal rules module for types which are not exposed to the user
2--
3{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-}
4module Hakyll.Core.Rules.Internal
5 ( CompileRule (..)
6 , RuleSet (..)
7 , RuleState (..)
8 , RuleEnvironment (..)
9 , RulesM (..)
10 , Rules
11 , runRules
12 ) where
14import Control.Applicative (Applicative)
15import Control.Monad.Writer (WriterT, execWriterT)
16import Control.Monad.Reader (ReaderT, runReaderT)
17import Control.Monad.State (State, evalState)
18import Data.Monoid (Monoid, mempty, mappend)
19import Data.Set (Set)
20import qualified Data.Map as M
22import Hakyll.Core.Resource
23import Hakyll.Core.Resource.Provider
24import Hakyll.Core.Identifier
25import Hakyll.Core.Identifier.Pattern
26import Hakyll.Core.Compiler.Internal
27import Hakyll.Core.Routes
28import Hakyll.Core.CompiledItem
30-- | Output of a compiler rule
31--
32-- * The compiler will produce a simple item. This is the most common case.
33--
34-- * The compiler will produce more compilers. These new compilers need to be
35-- added to the runtime if possible, since other items might depend upon them.
36--
37data CompileRule = CompileRule CompiledItem
38 | MetaCompileRule [(Identifier (), Compiler () CompileRule)]
40-- | A collection of rules for the compilation process
41--
42data RuleSet = RuleSet
43 { -- | Routes used in the compilation structure
44 rulesRoutes :: Routes
45 , -- | Compilation rules
46 rulesCompilers :: [(Identifier (), Compiler () CompileRule)]
47 , -- | A list of the used resources
48 rulesResources :: Set Resource
49 }
51instance Monoid RuleSet where
52 mempty = RuleSet mempty mempty mempty
53 mappend (RuleSet r1 c1 s1) (RuleSet r2 c2 s2) =
54 RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2)
56-- | Rule state
57--
58data RuleState = RuleState
59 { rulesNextIdentifier :: Int
60 } deriving (Show)
62-- | Rule environment
63--
64data RuleEnvironment = RuleEnvironment
65 { rulesResourceProvider :: ResourceProvider
66 , rulesPattern :: forall a. Pattern a
67 , rulesGroup :: Maybe String
68 }
70-- | The monad used to compose rules
71--
72newtype RulesM a = RulesM
73 { unRulesM :: ReaderT RuleEnvironment (WriterT RuleSet (State RuleState)) a
74 } deriving (Monad, Functor, Applicative)
76-- | Simplification of the RulesM type; usually, it will not return any
77-- result.
78--
79type Rules = RulesM ()
81-- | Run a Rules monad, resulting in a 'RuleSet'
82--
83runRules :: RulesM a -> ResourceProvider -> RuleSet
84runRules rules provider = nubCompilers $
85 evalState (execWriterT $ runReaderT (unRulesM rules) env) state
86 where
87 state = RuleState {rulesNextIdentifier = 0}
88 env = RuleEnvironment { rulesResourceProvider = provider
89 , rulesPattern = mempty
90 , rulesGroup = Nothing
91 }
93-- | Remove duplicate compilers from the 'RuleSet'. When two compilers match an
94-- item, we prefer the first one
95--
96nubCompilers :: RuleSet -> RuleSet
97nubCompilers set = set { rulesCompilers = nubCompilers' (rulesCompilers set) }
98 where
99 nubCompilers' = M.toList . M.fromListWith (flip const)