diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Hakyll/Core/Identifier.hs | 10 | ||||
| -rw-r--r-- | src/Hakyll/Core/Identifier/Pattern.hs | 7 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules.hs | 47 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules/Internal.hs | 2 |
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 } |