diff options
Diffstat (limited to 'src/Hakyll')
| -rw-r--r-- | src/Hakyll/Core/Routes.hs | 17 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules.hs | 42 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules/Internal.hs | 15 |
3 files changed, 52 insertions, 22 deletions
diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs index fcab28d..386635f 100644 --- a/src/Hakyll/Core/Routes.hs +++ b/src/Hakyll/Core/Routes.hs @@ -30,7 +30,7 @@ module Hakyll.Core.Routes , runRoutes , idRoute , setExtension - , ifMatch + , matchRoute , customRoute , gsubRoute , composeRoutes @@ -41,7 +41,6 @@ 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 @@ -85,15 +84,15 @@ setExtension :: String -> Routes setExtension extension = Routes $ fmap (`replaceExtension` extension) . unRoutes idRoute --- | Modify a route: apply the route if the identifier matches the given --- pattern, fail otherwise. +-- | Apply the route if the identifier matches the given predicate, fail +-- otherwise -- -ifMatch :: Pattern -> Routes -> Routes -ifMatch pattern (Routes route) = Routes $ \id' -> - if doesMatch pattern id' then route id' - else Nothing +matchRoute :: (Identifier -> Bool) -> Routes -> Routes +matchRoute predicate (Routes route) = Routes $ \id' -> + if predicate id' then route id' else Nothing --- | Create a custom route. This should almost always be used with 'ifMatch'. +-- | Create a custom route. This should almost always be used with +-- 'matchRoute' -- customRoute :: (Identifier -> FilePath) -> Routes customRoute f = Routes $ Just . f diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index eba3fb9..319e10b 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -14,6 +14,8 @@ module Hakyll.Core.Rules ( RulesM , Rules + , matchPattern + , matchPredicate , compile , create , route @@ -23,7 +25,7 @@ module Hakyll.Core.Rules import Control.Applicative ((<$>)) import Control.Monad.Writer (tell) -import Control.Monad.Reader (ask) +import Control.Monad.Reader (ask, local) import Control.Arrow (second, (>>>), arr, (>>^)) import Control.Monad.State (get, put) import Data.Monoid (mempty) @@ -63,21 +65,37 @@ 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 + where + addPredicate env = env + { rulesMatcher = \id' -> rulesMatcher env id' && predicate id' + } + -- | Add a compilation rule to the rules. -- --- This instructs all resources matching the given pattern to be compiled using --- the given compiler. When no resources match the given pattern, nothing will --- happen. In this case, you might want to have a look at 'create'. +-- This instructs all resources to be compiled using the given compiler. When +-- no resources match the current selection, nothing will happen. In this case, +-- you might want to have a look at 'create'. -- compile :: (Binary a, Typeable a, Writable a) - => Pattern -> Compiler Resource a -> Rules -compile pattern compiler = RulesM $ do - identifiers <- matches pattern . map unResource . resourceList <$> ask + => Compiler Resource a -> Rules +compile compiler = RulesM $ do + matcher <- rulesMatcher <$> ask + provider <- rulesResourceProvider <$> ask + let identifiers = filter matcher $ map unResource $ resourceList provider unRulesM $ do tellCompilers $ flip map identifiers $ \identifier -> (identifier, constA (Resource identifier) >>> compiler) tellResources $ map Resource identifiers - + -- | Add a compilation rule -- -- This sets a compiler for the given identifier. No resource is needed, since @@ -91,10 +109,12 @@ create identifier compiler = tellCompilers [(identifier, compiler)] -- | Add a route. -- --- This adds a route for all items matching the given pattern. +-- This adds a route for all items matching the current pattern. -- -route :: Pattern -> Routes -> Rules -route pattern route' = tellRoute $ ifMatch pattern route' +route :: Routes -> Rules +route route' = RulesM $ do + matcher <- rulesMatcher <$> ask + unRulesM $ tellRoute $ matchRoute matcher 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 2895257..dc669c1 100644 --- a/src/Hakyll/Core/Rules/Internal.hs +++ b/src/Hakyll/Core/Rules/Internal.hs @@ -5,6 +5,7 @@ module Hakyll.Core.Rules.Internal ( CompileRule (..) , RuleSet (..) , RuleState (..) + , RuleEnvironment (..) , RulesM (..) , Rules , runRules @@ -55,10 +56,17 @@ data RuleState = RuleState { rulesMetaCompilerIndex :: Int } deriving (Show) +-- | Rule environment +-- +data RuleEnvironment = RuleEnvironment + { rulesResourceProvider :: ResourceProvider + , rulesMatcher :: Identifier -> Bool + } + -- | The monad used to compose rules -- newtype RulesM a = RulesM - { unRulesM :: ReaderT ResourceProvider (WriterT RuleSet (State RuleState)) a + { unRulesM :: ReaderT RuleEnvironment (WriterT RuleSet (State RuleState)) a } deriving (Monad, Functor, Applicative) -- | Simplification of the RulesM type; usually, it will not return any @@ -70,6 +78,9 @@ type Rules = RulesM () -- runRules :: Rules -> ResourceProvider -> RuleSet runRules rules provider = - evalState (execWriterT $ runReaderT (unRulesM rules) provider) state + evalState (execWriterT $ runReaderT (unRulesM rules) env) state where state = RuleState {rulesMetaCompilerIndex = 0} + env = RuleEnvironment { rulesResourceProvider = provider + , rulesMatcher = const True + } |