summaryrefslogtreecommitdiff
path: root/src/Hakyll/Core
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Core')
-rw-r--r--src/Hakyll/Core/Identifier.hs10
-rw-r--r--src/Hakyll/Core/Identifier/Pattern.hs7
-rw-r--r--src/Hakyll/Core/Rules.hs47
-rw-r--r--src/Hakyll/Core/Rules/Internal.hs2
4 files changed, 46 insertions, 20 deletions
diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs
index 1cb625f..f644951 100644
--- a/src/Hakyll/Core/Identifier.hs
+++ b/src/Hakyll/Core/Identifier.hs
@@ -26,7 +26,6 @@ module Hakyll.Core.Identifier
, parseIdentifier
, toFilePath
, setGroup
- , hasGroup
) where
import Control.Arrow (second)
@@ -78,10 +77,5 @@ toFilePath = identifierPath
-- | Set the identifier group for some identifier
--
-setGroup :: String -> Identifier -> Identifier
-setGroup g (Identifier _ p) = Identifier (Just g) p
-
--- | Check if an identifier belongs to a certain group
---
-hasGroup :: String -> Identifier -> Bool
-hasGroup g (Identifier g' _) = Just g == g'
+setGroup :: Maybe String -> Identifier -> Identifier
+setGroup g (Identifier _ p) = Identifier g p
diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
index 348ef46..cee4bbc 100644
--- a/src/Hakyll/Core/Identifier/Pattern.hs
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -36,6 +36,7 @@ module Hakyll.Core.Identifier.Pattern
, parseGlob
, predicate
, regex
+ , inGroup
, matches
, filterMatches
, capture
@@ -106,6 +107,12 @@ predicate = Predicate
regex :: String -> Pattern
regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath
+-- | Create a 'Pattern' which matches if the identifier is in a certain group
+-- (or in no group)
+--
+inGroup :: Maybe String -> Pattern
+inGroup group = predicate $ (== group) . identifierGroup
+
-- | Check if an identifier matches a pattern
--
matches :: Pattern -> Identifier -> Bool
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index 892cf7c..9f88b82 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -19,6 +19,7 @@ module Hakyll.Core.Rules
( RulesM
, Rules
, match
+ , group
, compile
, create
, route
@@ -29,7 +30,7 @@ module Hakyll.Core.Rules
import Control.Applicative ((<$>))
import Control.Monad.Writer (tell)
import Control.Monad.Reader (ask, local)
-import Control.Arrow (second, (>>>), arr, (>>^))
+import Control.Arrow (second, (>>>), arr, (>>^), (***))
import Control.Monad.State (get, put)
import Data.Monoid (mempty, mappend)
import qualified Data.Set as S
@@ -58,16 +59,21 @@ tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty
tellCompilers :: (Binary a, Typeable a, Writable a)
=> [(Identifier, Compiler () a)]
-> Rules
-tellCompilers compilers = RulesM $ tell $ RuleSet mempty compilers' mempty
+tellCompilers compilers = RulesM $ do
+ -- We box the compilers so they have a more simple type, and we apply the
+ -- current group to the corresponding identifiers
+ group' <- rulesGroup <$> ask
+ let compilers' = map (setGroup group' *** boxCompiler) compilers
+ tell $ RuleSet mempty compilers' mempty
where
- compilers' = map (second boxCompiler) compilers
boxCompiler = (>>> arr compiledItem >>> arr CompileRule)
-- | Add resources
--
tellResources :: [Resource]
-> 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 satisfying the given predicate
--
@@ -78,6 +84,13 @@ match pattern = RulesM . local addPredicate . unRulesM
{ rulesPattern = rulesPattern env `mappend` pattern
}
+-- | Greate a group of compilers
+--
+group :: String -> Rules -> Rules
+group g = RulesM . local setGroup' . unRulesM
+ where
+ setGroup' env = env { rulesGroup = Just g }
+
-- | Add a compilation rule to the rules.
--
-- This instructs all resources to be compiled using the given compiler. When
@@ -112,8 +125,11 @@ create identifier compiler = tellCompilers [(identifier, compiler)]
--
route :: Routes -> Rules
route route' = RulesM $ do
+ -- We want the route only to be applied if we match the current pattern and
+ -- group
pattern <- rulesPattern <$> ask
- unRulesM $ tellRoute $ matchRoute pattern route'
+ group' <- rulesGroup <$> ask
+ unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route'
-- | Apart from regular compilers, one is also able to specify metacompilers.
-- Metacompilers are a special class of compilers: they are compilers which
@@ -154,7 +170,7 @@ metaCompile compiler = RulesM $ do
-- Create an identifier from the state
state <- get
let index = rulesMetaCompilerIndex state
- id' = fromCaptureString "Hakyll.Core.Rules.metaCompile/*" (show index)
+ id' = fromCapture "Hakyll.Core.Rules.metaCompile/*" (show index)
-- Update the state with a new identifier
put $ state {rulesMetaCompilerIndex = index + 1}
@@ -172,9 +188,16 @@ metaCompileWith :: (Binary a, Typeable a, Writable a)
-- ^ Compiler generating the other compilers
-> Rules
-- ^ Resulting rules
-metaCompileWith identifier compiler = RulesM $ tell $
- RuleSet mempty compilers mempty
- where
- makeRule = MetaCompileRule . map (second box)
- compilers = [(identifier, compiler >>> arr makeRule )]
- box = (>>> fromDependency identifier >>^ CompileRule . compiledItem)
+metaCompileWith identifier compiler = RulesM $ do
+ group' <- rulesGroup <$> ask
+
+ let -- Set the correct group on the identifier
+ id' = setGroup group' identifier
+ -- Function to box an item into a rule
+ makeRule = MetaCompileRule . map (second box)
+ -- Entire boxing function
+ box = (>>> fromDependency id' >>^ CompileRule . compiledItem)
+ -- Resulting compiler list
+ compilers = [(id', compiler >>> arr makeRule )]
+
+ tell $ RuleSet mempty compilers mempty
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs
index 0e117ec..bcba414 100644
--- a/src/Hakyll/Core/Rules/Internal.hs
+++ b/src/Hakyll/Core/Rules/Internal.hs
@@ -63,6 +63,7 @@ data RuleState = RuleState
data RuleEnvironment = RuleEnvironment
{ rulesResourceProvider :: ResourceProvider
, rulesPattern :: Pattern
+ , rulesGroup :: Maybe String
}
-- | The monad used to compose rules
@@ -85,4 +86,5 @@ runRules rules provider =
state = RuleState {rulesMetaCompilerIndex = 0}
env = RuleEnvironment { rulesResourceProvider = provider
, rulesPattern = mempty
+ , rulesGroup = Nothing
}