diff options
Diffstat (limited to 'src/Hakyll/Core/Rules.hs')
| -rw-r--r-- | src/Hakyll/Core/Rules.hs | 45 |
1 files changed, 26 insertions, 19 deletions
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index fe2c59c..eb75a2e 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -31,7 +31,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 ((>>>), arr, (>>^), (***)) import Control.Monad.State (get, put) import Data.Monoid (mempty, mappend) import qualified Data.Set as S @@ -58,13 +58,11 @@ tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty -- | Add a number of compilers -- tellCompilers :: (Binary a, Typeable a, Writable a) - => [(Identifier, Compiler () a)] + => [(Identifier a, Compiler () a)] -> Rules 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 + -- We box the compilers so they have a more simple type + let compilers' = map (castIdentifier *** boxCompiler) compilers tell $ RuleSet mempty compilers' mempty where boxCompiler = (>>> arr compiledItem >>> arr CompileRule) @@ -78,11 +76,11 @@ tellResources resources' = RulesM $ tell $ -- | Only compile/route items satisfying the given predicate -- -match :: Pattern -> Rules -> Rules +match :: Pattern a -> RulesM b -> RulesM b match pattern = RulesM . local addPredicate . unRulesM where addPredicate env = env - { rulesPattern = rulesPattern env `mappend` pattern + { rulesPattern = rulesPattern env `mappend` castPattern pattern } -- | Greate a group of compilers @@ -116,7 +114,7 @@ match pattern = RulesM . local addPredicate . unRulesM -- This will put the compiler for the raw content in a separate group -- (@\"raw\"@), which causes it to be compiled as well. -- -group :: String -> Rules -> Rules +group :: String -> RulesM a -> RulesM a group g = RulesM . local setGroup' . unRulesM where setGroup' env = env { rulesGroup = Just g } @@ -128,12 +126,13 @@ group g = RulesM . local setGroup' . unRulesM -- you might want to have a look at 'create'. -- compile :: (Binary a, Typeable a, Writable a) - => Compiler Resource a -> Rules + => Compiler Resource a -> RulesM (Pattern a) compile compiler = do ids <- resources tellCompilers $ flip map ids $ \identifier -> (identifier, constA (fromIdentifier identifier) >>> compiler) tellResources $ map fromIdentifier ids + return $ list ids -- | Add a compilation rule -- @@ -143,8 +142,12 @@ compile compiler = do -- actual content itself. -- create :: (Binary a, Typeable a, Writable a) - => Identifier -> Compiler () a -> Rules -create identifier compiler = tellCompilers [(identifier, compiler)] + => Identifier a -> Compiler () a -> RulesM (Identifier a) +create id' compiler = RulesM $ do + group' <- rulesGroup <$> ask + let id'' = setGroup group' id' + unRulesM $ tellCompilers [(id'', compiler)] + return id'' -- | Add a route. -- @@ -158,13 +161,17 @@ route route' = RulesM $ do group' <- rulesGroup <$> ask unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route' --- | Get a list of resources matching the current pattern +-- | Get a list of resources matching the current pattern. This will also set +-- the correct group to the identifiers. -- -resources :: RulesM [Identifier] +resources :: RulesM [Identifier a] resources = RulesM $ do pattern <- rulesPattern <$> ask provider <- rulesResourceProvider <$> ask - return $ filterMatches pattern $ map toIdentifier $ resourceList provider + group' <- rulesGroup <$> ask + return $ filterMatches pattern $ map (toId group') $ resourceList provider + where + toId g = setGroup g . toIdentifier -- | Apart from regular compilers, one is also able to specify metacompilers. -- Metacompilers are a special class of compilers: they are compilers which @@ -197,7 +204,7 @@ resources = RulesM $ do -- which items must be rendered. -- metaCompile :: (Binary a, Typeable a, Writable a) - => Compiler () [(Identifier, Compiler () a)] + => Compiler () [(Identifier a, Compiler () a)] -- ^ Compiler generating the other compilers -> Rules -- ^ Resulting rules @@ -217,9 +224,9 @@ metaCompile compiler = RulesM $ do -- the metacompiler. -- metaCompileWith :: (Binary a, Typeable a, Writable a) - => Identifier + => Identifier () -- ^ Identifier for this compiler - -> Compiler () [(Identifier, Compiler () a)] + -> Compiler () [(Identifier a, Compiler () a)] -- ^ Compiler generating the other compilers -> Rules -- ^ Resulting rules @@ -229,7 +236,7 @@ metaCompileWith identifier compiler = RulesM $ do 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) + makeRule = MetaCompileRule . map (castIdentifier *** box) -- Entire boxing function box = (>>> fromDependency id' >>^ CompileRule . compiledItem) -- Resulting compiler list |