diff options
| -rw-r--r-- | src/Hakyll/Core/Routes.hs | 9 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules.hs | 36 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules/Internal.hs | 5 |
3 files changed, 25 insertions, 25 deletions
diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs index 386635f..abbd0a7 100644 --- a/src/Hakyll/Core/Routes.hs +++ b/src/Hakyll/Core/Routes.hs @@ -41,6 +41,7 @@ import Control.Monad (mplus) import System.FilePath (replaceExtension) import Hakyll.Core.Identifier +import Hakyll.Core.Identifier.Pattern import Hakyll.Core.Util.String -- | Type used for a route @@ -84,12 +85,12 @@ setExtension :: String -> Routes setExtension extension = Routes $ fmap (`replaceExtension` extension) . 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 -- -matchRoute :: (Identifier -> Bool) -> Routes -> Routes -matchRoute predicate (Routes route) = Routes $ \id' -> - if predicate id' then route id' else Nothing +matchRoute :: Pattern -> Routes -> Routes +matchRoute pattern (Routes route) = Routes $ \id' -> + if matches pattern id' then route id' else Nothing -- | Create a custom route. This should almost always be used with -- 'matchRoute' diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index 319e10b..19df85e 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -7,15 +7,18 @@ -- A typical usage example would be: -- -- > main = hakyll $ do --- > route "posts/*" (setExtension "html") --- > compile "posts/*" someCompiler +-- > match "posts/*" $ do +-- > route (setExtension "html") +-- > compile someCompiler +-- > match "css/*" $ do +-- > route idRoute +-- > compile compressCssCompiler -- {-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-} module Hakyll.Core.Rules ( RulesM , Rules - , matchPattern - , matchPredicate + , match , compile , create , route @@ -28,7 +31,7 @@ import Control.Monad.Writer (tell) import Control.Monad.Reader (ask, local) import Control.Arrow (second, (>>>), arr, (>>^)) import Control.Monad.State (get, put) -import Data.Monoid (mempty) +import Data.Monoid (mempty, mappend) import qualified Data.Set as S import Data.Typeable (Typeable) @@ -65,18 +68,13 @@ tellResources :: [Resource] -> Rules 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 -- -matchPredicate :: (Identifier -> Bool) -> Rules -> Rules -matchPredicate predicate = RulesM . local addPredicate . unRulesM +match :: Pattern -> Rules -> Rules +match pattern = RulesM . local addPredicate . unRulesM where addPredicate env = env - { rulesMatcher = \id' -> rulesMatcher env id' && predicate id' + { rulesPattern = rulesPattern env `mappend` pattern } -- | Add a compilation rule to the rules. @@ -88,13 +86,13 @@ matchPredicate predicate = RulesM . local addPredicate . unRulesM compile :: (Binary a, Typeable a, Writable a) => Compiler Resource a -> Rules compile compiler = RulesM $ do - matcher <- rulesMatcher <$> ask + pattern <- rulesPattern <$> ask provider <- rulesResourceProvider <$> ask - let identifiers = filter matcher $ map unResource $ resourceList provider + let ids = filterMatches pattern $ map unResource $ resourceList provider unRulesM $ do - tellCompilers $ flip map identifiers $ \identifier -> + tellCompilers $ flip map ids $ \identifier -> (identifier, constA (Resource identifier) >>> compiler) - tellResources $ map Resource identifiers + tellResources $ map Resource ids -- | Add a compilation rule -- @@ -113,8 +111,8 @@ create identifier compiler = tellCompilers [(identifier, compiler)] -- route :: Routes -> Rules route route' = RulesM $ do - matcher <- rulesMatcher <$> ask - unRulesM $ tellRoute $ matchRoute matcher route' + pattern <- rulesPattern <$> ask + unRulesM $ tellRoute $ matchRoute pattern route' -- | Apart from regular compilers, one is also able to specify metacompilers. -- Metacompilers are a special class of compilers: they are compilers which diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs index dc669c1..592194d 100644 --- a/src/Hakyll/Core/Rules/Internal.hs +++ b/src/Hakyll/Core/Rules/Internal.hs @@ -20,6 +20,7 @@ import Data.Set (Set) import Hakyll.Core.ResourceProvider import Hakyll.Core.Identifier +import Hakyll.Core.Identifier.Pattern import Hakyll.Core.Compiler.Internal import Hakyll.Core.Routes import Hakyll.Core.CompiledItem @@ -60,7 +61,7 @@ data RuleState = RuleState -- data RuleEnvironment = RuleEnvironment { rulesResourceProvider :: ResourceProvider - , rulesMatcher :: Identifier -> Bool + , rulesPattern :: Pattern } -- | The monad used to compose rules @@ -82,5 +83,5 @@ runRules rules provider = where state = RuleState {rulesMetaCompilerIndex = 0} env = RuleEnvironment { rulesResourceProvider = provider - , rulesMatcher = const True + , rulesPattern = mempty } |