Simplify match implementation(s)

This commit is contained in:
Jasper Van der Jeugt 2011-04-05 11:58:26 +02:00
parent 4925dd828e
commit ff118fec98
3 changed files with 25 additions and 25 deletions

View file

@ -41,6 +41,7 @@ import Control.Monad (mplus)
import System.FilePath (replaceExtension) import System.FilePath (replaceExtension)
import Hakyll.Core.Identifier import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.Util.String import Hakyll.Core.Util.String
-- | Type used for a route -- | Type used for a route
@ -84,12 +85,12 @@ setExtension :: String -> Routes
setExtension extension = Routes $ fmap (`replaceExtension` extension) setExtension extension = Routes $ fmap (`replaceExtension` extension)
. unRoutes idRoute . unRoutes idRoute
-- | Apply the route if the identifier matches the given predicate, fail -- | Apply the route if the identifier matches the given pattern, fail
-- otherwise -- otherwise
-- --
matchRoute :: (Identifier -> Bool) -> Routes -> Routes matchRoute :: Pattern -> Routes -> Routes
matchRoute predicate (Routes route) = Routes $ \id' -> matchRoute pattern (Routes route) = Routes $ \id' ->
if predicate id' then route id' else Nothing if matches pattern id' then route id' else Nothing
-- | Create a custom route. This should almost always be used with -- | Create a custom route. This should almost always be used with
-- 'matchRoute' -- 'matchRoute'

View file

@ -7,15 +7,18 @@
-- A typical usage example would be: -- A typical usage example would be:
-- --
-- > main = hakyll $ do -- > main = hakyll $ do
-- > route "posts/*" (setExtension "html") -- > match "posts/*" $ do
-- > compile "posts/*" someCompiler -- > route (setExtension "html")
-- > compile someCompiler
-- > match "css/*" $ do
-- > route idRoute
-- > compile compressCssCompiler
-- --
{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}
module Hakyll.Core.Rules module Hakyll.Core.Rules
( RulesM ( RulesM
, Rules , Rules
, matchPattern , match
, matchPredicate
, compile , compile
, create , create
, route , route
@ -28,7 +31,7 @@ import Control.Monad.Writer (tell)
import Control.Monad.Reader (ask, local) import Control.Monad.Reader (ask, local)
import Control.Arrow (second, (>>>), arr, (>>^)) import Control.Arrow (second, (>>>), arr, (>>^))
import Control.Monad.State (get, put) import Control.Monad.State (get, put)
import Data.Monoid (mempty) import Data.Monoid (mempty, mappend)
import qualified Data.Set as S import qualified Data.Set as S
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
@ -65,18 +68,13 @@ tellResources :: [Resource]
-> Rules -> Rules
tellResources resources = RulesM $ tell $ RuleSet mempty mempty $ S.fromList resources tellResources resources = RulesM $ tell $ RuleSet mempty mempty $ S.fromList resources
-- | Only compile/route items matching the given pattern
--
matchPattern :: Pattern -> Rules -> Rules
matchPattern pattern = matchPredicate (doesMatch pattern)
-- | Only compile/route items satisfying the given predicate -- | Only compile/route items satisfying the given predicate
-- --
matchPredicate :: (Identifier -> Bool) -> Rules -> Rules match :: Pattern -> Rules -> Rules
matchPredicate predicate = RulesM . local addPredicate . unRulesM match pattern = RulesM . local addPredicate . unRulesM
where where
addPredicate env = env addPredicate env = env
{ rulesMatcher = \id' -> rulesMatcher env id' && predicate id' { rulesPattern = rulesPattern env `mappend` pattern
} }
-- | Add a compilation rule to the rules. -- | Add a compilation rule to the rules.
@ -88,13 +86,13 @@ matchPredicate predicate = RulesM . local addPredicate . unRulesM
compile :: (Binary a, Typeable a, Writable a) compile :: (Binary a, Typeable a, Writable a)
=> Compiler Resource a -> Rules => Compiler Resource a -> Rules
compile compiler = RulesM $ do compile compiler = RulesM $ do
matcher <- rulesMatcher <$> ask pattern <- rulesPattern <$> ask
provider <- rulesResourceProvider <$> ask provider <- rulesResourceProvider <$> ask
let identifiers = filter matcher $ map unResource $ resourceList provider let ids = filterMatches pattern $ map unResource $ resourceList provider
unRulesM $ do unRulesM $ do
tellCompilers $ flip map identifiers $ \identifier -> tellCompilers $ flip map ids $ \identifier ->
(identifier, constA (Resource identifier) >>> compiler) (identifier, constA (Resource identifier) >>> compiler)
tellResources $ map Resource identifiers tellResources $ map Resource ids
-- | Add a compilation rule -- | Add a compilation rule
-- --
@ -113,8 +111,8 @@ create identifier compiler = tellCompilers [(identifier, compiler)]
-- --
route :: Routes -> Rules route :: Routes -> Rules
route route' = RulesM $ do route route' = RulesM $ do
matcher <- rulesMatcher <$> ask pattern <- rulesPattern <$> ask
unRulesM $ tellRoute $ matchRoute matcher route' unRulesM $ tellRoute $ matchRoute pattern route'
-- | Apart from regular compilers, one is also able to specify metacompilers. -- | Apart from regular compilers, one is also able to specify metacompilers.
-- Metacompilers are a special class of compilers: they are compilers which -- Metacompilers are a special class of compilers: they are compilers which

View file

@ -20,6 +20,7 @@ import Data.Set (Set)
import Hakyll.Core.ResourceProvider import Hakyll.Core.ResourceProvider
import Hakyll.Core.Identifier import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.Compiler.Internal import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Routes import Hakyll.Core.Routes
import Hakyll.Core.CompiledItem import Hakyll.Core.CompiledItem
@ -60,7 +61,7 @@ data RuleState = RuleState
-- --
data RuleEnvironment = RuleEnvironment data RuleEnvironment = RuleEnvironment
{ rulesResourceProvider :: ResourceProvider { rulesResourceProvider :: ResourceProvider
, rulesMatcher :: Identifier -> Bool , rulesPattern :: Pattern
} }
-- | The monad used to compose rules -- | The monad used to compose rules
@ -82,5 +83,5 @@ runRules rules provider =
where where
state = RuleState {rulesMetaCompilerIndex = 0} state = RuleState {rulesMetaCompilerIndex = 0}
env = RuleEnvironment { rulesResourceProvider = provider env = RuleEnvironment { rulesResourceProvider = provider
, rulesMatcher = const True , rulesPattern = mempty
} }