summaryrefslogtreecommitdiff
path: root/src/Hakyll/Core/Rules
diff options
context:
space:
mode:
authorJasper Van der Jeugt <m@jaspervdj.be>2012-11-08 13:50:08 +0100
committerJasper Van der Jeugt <m@jaspervdj.be>2012-11-08 13:50:08 +0100
commitdac3fac342c2fb8610b6f1d83cbfd97a70cf17f1 (patch)
tree573b3f658af08e0af57c4826402ed46053f4be93 /src/Hakyll/Core/Rules
parent89f324f81b40d6818e6307794fe06b60053adbc0 (diff)
downloadhakyll-dac3fac342c2fb8610b6f1d83cbfd97a70cf17f1.tar.gz
Rules will be in IO...
Diffstat (limited to 'src/Hakyll/Core/Rules')
-rw-r--r--src/Hakyll/Core/Rules/Internal.hs81
1 files changed, 48 insertions, 33 deletions
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs
index 55c4446..9d6a979 100644
--- a/src/Hakyll/Core/Rules/Internal.hs
+++ b/src/Hakyll/Core/Rules/Internal.hs
@@ -1,6 +1,7 @@
+--------------------------------------------------------------------------------
-- | Internal rules module for types which are not exposed to the user
---
-{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE Rank2Types #-}
module Hakyll.Core.Rules.Internal
( CompileRule (..)
, RuleSet (..)
@@ -11,34 +12,38 @@ module Hakyll.Core.Rules.Internal
, 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
+--------------------------------------------------------------------------------
+import Control.Applicative (Applicative)
+import Control.Monad.RWS (RWST, runRWST)
+import qualified Data.Map as M
+import Data.Monoid (Monoid, mappend, mempty)
+import Data.Set (Set)
+
+
+--------------------------------------------------------------------------------
+import Hakyll.Core.CompiledItem
+import Hakyll.Core.Compiler.Internal
+import Hakyll.Core.Identifier
+import Hakyll.Core.Identifier.Pattern
+import Hakyll.Core.Resource
+import Hakyll.Core.Resource.Provider
+import Hakyll.Core.Routes
+
+
+--------------------------------------------------------------------------------
-- | Output of a compiler rule
--
-- * The compiler will produce a simple item. This is the most common case.
--
-- * The compiler will produce more compilers. These new compilers need to be
-- added to the runtime if possible, since other items might depend upon them.
---
data CompileRule = CompileRule CompiledItem
| MetaCompileRule [(Identifier (), Compiler () CompileRule)]
+
+--------------------------------------------------------------------------------
-- | A collection of rules for the compilation process
---
data RuleSet = RuleSet
{ -- | Routes used in the compilation structure
rulesRoutes :: Routes
@@ -48,51 +53,61 @@ data RuleSet = RuleSet
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)
+
+--------------------------------------------------------------------------------
-- | Rule state
---
data RuleState = RuleState
{ rulesNextIdentifier :: Int
} deriving (Show)
+
+--------------------------------------------------------------------------------
-- | Rule environment
---
data RuleEnvironment = RuleEnvironment
{ rulesResourceProvider :: ResourceProvider
, rulesPattern :: forall a. Pattern a
, rulesGroup :: Maybe String
}
+
+--------------------------------------------------------------------------------
-- | The monad used to compose rules
---
newtype RulesM a = RulesM
- { unRulesM :: ReaderT RuleEnvironment (WriterT RuleSet (State RuleState)) a
+ { unRulesM :: RWST RuleEnvironment RuleSet RuleState IO a
} deriving (Monad, Functor, Applicative)
+
+--------------------------------------------------------------------------------
-- | Simplification of the RulesM type; usually, it will not return any
-- result.
---
type Rules = RulesM ()
+
+--------------------------------------------------------------------------------
-- | Run a Rules monad, resulting in a 'RuleSet'
---
-runRules :: RulesM a -> ResourceProvider -> RuleSet
-runRules rules provider = nubCompilers $
- evalState (execWriterT $ runReaderT (unRulesM rules) env) state
+runRules :: RulesM a -> ResourceProvider -> IO RuleSet
+runRules rules provider = do
+ (_, _, ruleSet) <- runRWST (unRulesM rules) env state
+ return $ nubCompilers ruleSet
where
state = RuleState {rulesNextIdentifier = 0}
- env = RuleEnvironment { rulesResourceProvider = provider
- , rulesPattern = mempty
- , rulesGroup = Nothing
- }
+ env = RuleEnvironment
+ { rulesResourceProvider = provider
+ , rulesPattern = mempty
+ , rulesGroup = Nothing
+ }
+
+--------------------------------------------------------------------------------
-- | Remove duplicate compilers from the 'RuleSet'. When two compilers match an
-- item, we prefer the first one
---
nubCompilers :: RuleSet -> RuleSet
nubCompilers set = set { rulesCompilers = nubCompilers' (rulesCompilers set) }
where