2012-11-08 12:50:08 +00:00
|
|
|
--------------------------------------------------------------------------------
|
2011-02-11 12:30:55 +00:00
|
|
|
-- | Internal rules module for types which are not exposed to the user
|
2012-11-08 12:50:08 +00:00
|
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
|
|
{-# LANGUAGE Rank2Types #-}
|
2011-02-11 12:30:55 +00:00
|
|
|
module Hakyll.Core.Rules.Internal
|
2012-11-10 18:56:45 +00:00
|
|
|
( RuleSet (..)
|
2011-02-11 12:30:55 +00:00
|
|
|
, RuleState (..)
|
2011-04-04 18:49:22 +00:00
|
|
|
, RuleEnvironment (..)
|
2011-02-11 12:30:55 +00:00
|
|
|
, RulesM (..)
|
|
|
|
, Rules
|
|
|
|
, runRules
|
|
|
|
) where
|
|
|
|
|
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
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
|
2012-11-09 15:34:45 +00:00
|
|
|
import Hakyll.Core.ResourceProvider
|
2012-11-08 12:50:08 +00:00
|
|
|
import Hakyll.Core.Routes
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-02-11 12:30:55 +00:00
|
|
|
-- | A collection of rules for the compilation process
|
|
|
|
data RuleSet = RuleSet
|
2011-02-15 17:32:55 +00:00
|
|
|
{ -- | Routes used in the compilation structure
|
|
|
|
rulesRoutes :: Routes
|
|
|
|
, -- | Compilation rules
|
2012-11-10 18:56:45 +00:00
|
|
|
rulesCompilers :: [(Identifier (), Compiler () CompiledItem)]
|
2012-11-09 15:34:45 +00:00
|
|
|
, -- | A set of the actually used files
|
|
|
|
rulesResources :: Set (Identifier ())
|
2011-02-11 12:30:55 +00:00
|
|
|
}
|
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-02-11 12:30:55 +00:00
|
|
|
instance Monoid RuleSet where
|
2011-02-15 17:32:55 +00:00
|
|
|
mempty = RuleSet mempty mempty mempty
|
|
|
|
mappend (RuleSet r1 c1 s1) (RuleSet r2 c2 s2) =
|
|
|
|
RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2)
|
2011-02-11 12:30:55 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-02-11 12:30:55 +00:00
|
|
|
-- | Rule state
|
|
|
|
data RuleState = RuleState
|
2012-01-16 13:35:43 +00:00
|
|
|
{ rulesNextIdentifier :: Int
|
2011-02-11 12:30:55 +00:00
|
|
|
} deriving (Show)
|
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-04-04 18:49:22 +00:00
|
|
|
-- | Rule environment
|
|
|
|
data RuleEnvironment = RuleEnvironment
|
|
|
|
{ rulesResourceProvider :: ResourceProvider
|
2011-05-24 08:12:10 +00:00
|
|
|
, rulesPattern :: forall a. Pattern a
|
2011-04-11 19:57:33 +00:00
|
|
|
, rulesGroup :: Maybe String
|
2011-04-04 18:49:22 +00:00
|
|
|
}
|
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-02-11 12:30:55 +00:00
|
|
|
-- | The monad used to compose rules
|
|
|
|
newtype RulesM a = RulesM
|
2012-11-08 12:50:08 +00:00
|
|
|
{ unRulesM :: RWST RuleEnvironment RuleSet RuleState IO a
|
2011-02-11 12:30:55 +00:00
|
|
|
} deriving (Monad, Functor, Applicative)
|
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-02-11 12:30:55 +00:00
|
|
|
-- | Simplification of the RulesM type; usually, it will not return any
|
|
|
|
-- result.
|
|
|
|
type Rules = RulesM ()
|
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-02-11 12:30:55 +00:00
|
|
|
-- | Run a Rules monad, resulting in a 'RuleSet'
|
2012-11-08 12:50:08 +00:00
|
|
|
runRules :: RulesM a -> ResourceProvider -> IO RuleSet
|
|
|
|
runRules rules provider = do
|
|
|
|
(_, _, ruleSet) <- runRWST (unRulesM rules) env state
|
|
|
|
return $ nubCompilers ruleSet
|
2011-02-11 12:30:55 +00:00
|
|
|
where
|
2012-01-16 13:35:43 +00:00
|
|
|
state = RuleState {rulesNextIdentifier = 0}
|
2012-11-08 12:50:08 +00:00
|
|
|
env = RuleEnvironment
|
|
|
|
{ rulesResourceProvider = provider
|
|
|
|
, rulesPattern = mempty
|
|
|
|
, rulesGroup = Nothing
|
|
|
|
}
|
2011-04-13 15:42:57 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-04-13 15:42:57 +00:00
|
|
|
-- | 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
|
|
|
|
nubCompilers' = M.toList . M.fromListWith (flip const)
|