@@ -2,7 +2,7 @@
22-- | This module provides a declarative DSL in which the user can specify the
33-- different rules used to run the compilers.
44--
5−-- The convention is to just list all items in the 'RulesM' monad, routes and
5+-- The convention is to just list all items in the 'Rules' monad, routes and
66-- compilation rules.
77--
88-- A typical usage example would be:
@@ -17,8 +17,7 @@
1717{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1818{-# LANGUAGE OverloadedStrings #-}
1919module Hakyll.Core.Rules
20− ( RulesM
21− , Rules
20+ ( Rules
2221 , match
2322 , group
2423 , compile
@@ -31,7 +30,7 @@ module Hakyll.Core.Rules
3130
3231--------------------------------------------------------------------------------
3332import Control.Applicative ((<$>))
34−import Control.Arrow ((***))
33+import Control.Arrow (second)
3534import Control.Monad.Reader (ask, local)
3635import Control.Monad.State (get, put)
3736import Control.Monad.Writer (tell)
@@ -57,36 +56,36 @@ import Hakyll.Core.Writable
5756
5857--------------------------------------------------------------------------------
5958-- | Add a route
60−tellRoute :: Routes -> Rules
61−tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty
59+tellRoute :: Routes -> Rules ()
60+tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty
6261
6362
6463--------------------------------------------------------------------------------
6564-- | Add a number of compilers
6665tellCompilers :: (Binary a, Typeable a, Writable a)
67− => [(Identifier a, Compiler a)]
68− -> Rules
69−tellCompilers compilers = RulesM $ do
66+ => [(Identifier, Compiler a)]
67+ -> Rules ()
68+tellCompilers compilers = Rules $ do
7069 -- We box the compilers so they have a more simple type
71− let compilers' = map (castIdentifier *** fmap compiledItem) compilers
70+ let compilers' = map (second $ fmap compiledItem) compilers
7271 tell $ RuleSet mempty compilers' mempty
7372
7473
7574--------------------------------------------------------------------------------
7675-- | Add resources
77−tellResources :: [Identifier a]
78− -> Rules
79−tellResources resources' = RulesM $ tell $
80− RuleSet mempty mempty $ S.fromList $ map castIdentifier resources'
76+tellResources :: [Identifier]
77+ -> Rules ()
78+tellResources resources' = Rules $ tell $
79+ RuleSet mempty mempty $ S.fromList resources'
8180
8281
8382--------------------------------------------------------------------------------
8483-- | Only compile/route items satisfying the given predicate
85−match :: Pattern a -> RulesM b -> RulesM b
86−match pattern = RulesM . local addPredicate . unRulesM
84+match :: Pattern -> Rules b -> Rules b
85+match pattern = Rules . local addPredicate . unRules
8786 where
8887 addPredicate env = env
89− { rulesPattern = rulesPattern env `mappend` castPattern pattern
88+ { rulesPattern = rulesPattern env `mappend` pattern
9089 }
9190
9291
@@ -120,8 +119,8 @@ match pattern = RulesM . local addPredicate . unRulesM
120119--
121120-- This will put the compiler for the raw content in a separate group
122121-- (@\"raw\"@), which causes it to be compiled as well.
123−group :: String -> RulesM a -> RulesM a
124−group g = RulesM . local setVersion' . unRulesM
122+group :: String -> Rules a -> Rules a
123+group g = Rules . local setVersion' . unRules
125124 where
126125 setVersion' env = env {rulesVersion = Just g}
127126
@@ -133,12 +132,11 @@ group g = RulesM . local setVersion' . unRulesM
133132-- no resources match the current selection, nothing will happen. In this case,
134133-- you might want to have a look at 'create'.
135134compile :: (Binary a, Typeable a, Writable a)
136− => Compiler a -> RulesM (Pattern a)
135+ => Compiler a -> Rules ()
137136compile compiler = do
138137 ids <- resources
139− tellCompilers [(castIdentifier id', compiler) | id' <- ids]
138+ tellCompilers [(id', compiler) | id' <- ids]
140139 tellResources ids
141− return $ fromList $ map castIdentifier ids
142140
143141
144142--------------------------------------------------------------------------------
@@ -151,33 +149,32 @@ compile compiler = do
151149-- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been
152150-- used).
153151create :: (Binary a, Typeable a, Writable a)
154− => Identifier a -> Compiler a -> RulesM (Identifier a)
155−create id' compiler = RulesM $ do
152+ => Identifier -> Compiler a -> Rules ()
153+create id' compiler = Rules $ do
156154 version' <- rulesVersion <$> ask
157155 let id'' = setVersion version' id'
158− unRulesM $ tellCompilers [(id'', compiler)]
159− return id''
156+ unRules $ tellCompilers [(id'', compiler)]
160157
161158
162159--------------------------------------------------------------------------------
163160-- | Add a route.
164161--
165162-- This adds a route for all items matching the current pattern.
166−route :: Routes -> Rules
167−route route' = RulesM $ do
163+route :: Routes -> Rules ()
164+route route' = Rules $ do
168165 -- We want the route only to be applied if we match the current pattern and
169166 -- version
170167 pattern <- rulesPattern <$> ask
171168 version' <- rulesVersion <$> ask
172− unRulesM $ tellRoute $ matchRoute
169+ unRules $ tellRoute $ matchRoute
173170 (pattern `mappend` fromVersion version') route'
174171
175172
176173--------------------------------------------------------------------------------
177174-- | Get a list of resources matching the current pattern. This will also set
178175-- the correct group to the identifiers.
179−resources :: RulesM [Identifier ()]
180−resources = RulesM $ do
176+resources :: Rules [Identifier]
177+resources = Rules $ do
181178 pattern <- rulesPattern <$> ask
182179 provider <- rulesResourceProvider <$> ask
183180 g <- rulesVersion <$> ask
@@ -187,9 +184,9 @@ resources = RulesM $ do
187184--------------------------------------------------------------------------------
188185-- | Generate a fresh Identifier with a given prefix
189186-- TODO: remove?
190−freshIdentifier :: String -- ^ Prefix
191− -> RulesM (Identifier a) -- ^ Fresh identifier
192−freshIdentifier prefix = RulesM $ do
187+freshIdentifier :: String -- ^ Prefix
188+ -> Rules Identifier -- ^ Fresh identifier
189+freshIdentifier prefix = Rules $ do
193190 state <- get
194191 let index = rulesNextIdentifier state
195192 id' = fromFilePath $ prefix ++ "/" ++ show index