module Hakyll.Core.Rules.Internal
( CompileRule (..)
, RuleSet (..)
, RuleState (..)
, RuleEnvironment (..)
, RulesM (..)
, Rules
, runRules
) where
import Control.Applicative (Applicative)
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 qualified Data.Map as M
import Hakyll.Core.Resource
import Hakyll.Core.Resource.Provider
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Routes
import Hakyll.Core.CompiledItem
data CompileRule = CompileRule CompiledItem
| MetaCompileRule [(Identifier (), Compiler () CompileRule)]
data RuleSet = RuleSet
{
rulesRoutes :: Routes
,
rulesCompilers :: [(Identifier (), Compiler () CompileRule)]
,
rulesResources :: Set Resource
}
instance Monoid RuleSet where
mempty = RuleSet mempty mempty mempty
mappend (RuleSet r1 c1 s1) (RuleSet r2 c2 s2) =
RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2)
data RuleState = RuleState
{ rulesNextIdentifier :: Int
} deriving (Show)
data RuleEnvironment = RuleEnvironment
{ rulesResourceProvider :: ResourceProvider
, rulesPattern :: forall a. Pattern a
, rulesGroup :: Maybe String
}
newtype RulesM a = RulesM
{ unRulesM :: ReaderT RuleEnvironment (WriterT RuleSet (State RuleState)) a
} deriving (Monad, Functor, Applicative)
type Rules = RulesM ()
runRules :: RulesM a -> ResourceProvider -> RuleSet
runRules rules provider = nubCompilers $
evalState (execWriterT $ runReaderT (unRulesM rules) env) state
where
state = RuleState {rulesNextIdentifier = 0}
env = RuleEnvironment { rulesResourceProvider = provider
, rulesPattern = mempty
, rulesGroup = Nothing
}
nubCompilers :: RuleSet -> RuleSet
nubCompilers set = set { rulesCompilers = nubCompilers' (rulesCompilers set) }
where
nubCompilers' = M.toList . M.fromListWith (flip const)