Simplify match implementation(s)
This commit is contained in:
parent
4925dd828e
commit
ff118fec98
3 changed files with 25 additions and 25 deletions
|
@ -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'
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in a new issue