2012-11-08 12:50:08 +00:00
|
|
|
--------------------------------------------------------------------------------
|
2011-02-11 12:30:55 +00:00
|
|
|
-- | This module provides a declarative DSL in which the user can specify the
|
|
|
|
-- different rules used to run the compilers.
|
|
|
|
--
|
2012-11-13 12:13:17 +00:00
|
|
|
-- The convention is to just list all items in the 'Rules' monad, routes and
|
2011-02-11 12:30:55 +00:00
|
|
|
-- compilation rules.
|
|
|
|
--
|
|
|
|
-- A typical usage example would be:
|
|
|
|
--
|
|
|
|
-- > main = hakyll $ do
|
2011-04-05 09:58:26 +00:00
|
|
|
-- > match "posts/*" $ do
|
|
|
|
-- > route (setExtension "html")
|
|
|
|
-- > compile someCompiler
|
|
|
|
-- > match "css/*" $ do
|
|
|
|
-- > route idRoute
|
|
|
|
-- > compile compressCssCompiler
|
2012-11-08 12:50:08 +00:00
|
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2010-12-25 18:37:21 +00:00
|
|
|
module Hakyll.Core.Rules
|
2012-11-13 12:13:17 +00:00
|
|
|
( Rules
|
2011-04-05 09:58:26 +00:00
|
|
|
, match
|
2011-04-11 19:57:33 +00:00
|
|
|
, group
|
2010-12-25 18:37:21 +00:00
|
|
|
, compile
|
|
|
|
, create
|
|
|
|
, route
|
2011-04-14 08:17:08 +00:00
|
|
|
, resources
|
2012-01-16 13:35:43 +00:00
|
|
|
, freshIdentifier
|
2010-12-25 18:37:21 +00:00
|
|
|
) where
|
|
|
|
|
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Control.Applicative ((<$>))
|
2012-11-13 12:13:17 +00:00
|
|
|
import Control.Arrow (second)
|
2012-11-08 12:50:08 +00:00
|
|
|
import Control.Monad.Reader (ask, local)
|
|
|
|
import Control.Monad.State (get, put)
|
|
|
|
import Control.Monad.Writer (tell)
|
|
|
|
import Data.Monoid (mappend, mempty)
|
|
|
|
import qualified Data.Set as S
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Data.Binary (Binary)
|
|
|
|
import Data.Typeable (Typeable)
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Hakyll.Core.Compiler.Internal
|
|
|
|
import Hakyll.Core.Identifier
|
|
|
|
import Hakyll.Core.Identifier.Pattern
|
2012-11-18 20:56:52 +00:00
|
|
|
import Hakyll.Core.Item
|
|
|
|
import Hakyll.Core.Item.SomeItem
|
|
|
|
import Hakyll.Core.Provider
|
2012-11-08 12:50:08 +00:00
|
|
|
import Hakyll.Core.Routes
|
|
|
|
import Hakyll.Core.Rules.Internal
|
|
|
|
import Hakyll.Core.Writable
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2010-12-25 18:37:21 +00:00
|
|
|
-- | Add a route
|
2012-11-13 12:13:17 +00:00
|
|
|
tellRoute :: Routes -> Rules ()
|
|
|
|
tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty
|
2010-12-25 18:37:21 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2010-12-25 18:37:21 +00:00
|
|
|
-- | Add a number of compilers
|
2011-01-07 11:12:13 +00:00
|
|
|
tellCompilers :: (Binary a, Typeable a, Writable a)
|
2012-11-18 20:56:52 +00:00
|
|
|
=> [(Identifier, Compiler (Item a))]
|
2012-11-13 12:13:17 +00:00
|
|
|
-> Rules ()
|
|
|
|
tellCompilers compilers = Rules $ do
|
2011-05-24 12:39:21 +00:00
|
|
|
-- We box the compilers so they have a more simple type
|
2012-11-18 20:56:52 +00:00
|
|
|
let compilers' = map (second $ fmap SomeItem) compilers
|
2011-04-11 19:57:33 +00:00
|
|
|
tell $ RuleSet mempty compilers' mempty
|
2010-12-25 18:37:21 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-02-15 17:32:55 +00:00
|
|
|
-- | Add resources
|
2012-11-13 12:13:17 +00:00
|
|
|
tellResources :: [Identifier]
|
|
|
|
-> Rules ()
|
|
|
|
tellResources resources' = Rules $ tell $
|
|
|
|
RuleSet mempty mempty $ S.fromList resources'
|
2011-02-15 17:32:55 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-04-04 18:49:22 +00:00
|
|
|
-- | Only compile/route items satisfying the given predicate
|
2012-11-13 12:13:17 +00:00
|
|
|
match :: Pattern -> Rules b -> Rules b
|
|
|
|
match pattern = Rules . local addPredicate . unRules
|
2011-04-04 18:49:22 +00:00
|
|
|
where
|
|
|
|
addPredicate env = env
|
2012-11-13 12:13:17 +00:00
|
|
|
{ rulesPattern = rulesPattern env `mappend` pattern
|
2011-04-04 18:49:22 +00:00
|
|
|
}
|
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-04-11 19:57:33 +00:00
|
|
|
-- | Greate a group of compilers
|
2011-04-13 15:52:22 +00:00
|
|
|
-- Imagine you have a page that you want to render, but you also want the raw
|
|
|
|
-- content available on your site.
|
|
|
|
--
|
|
|
|
-- > match "test.markdown" $ do
|
|
|
|
-- > route $ setExtension "html"
|
|
|
|
-- > compile pageCompiler
|
|
|
|
-- >
|
|
|
|
-- > match "test.markdown" $ do
|
|
|
|
-- > route idRoute
|
|
|
|
-- > compile copyPageCompiler
|
|
|
|
--
|
|
|
|
-- Will of course conflict! In this case, Hakyll will pick the first matching
|
|
|
|
-- compiler (@pageCompiler@ in this case).
|
|
|
|
--
|
|
|
|
-- In case you want to have them both, you can use the 'group' function to
|
|
|
|
-- create a new group. For example,
|
|
|
|
--
|
|
|
|
-- > match "test.markdown" $ do
|
|
|
|
-- > route $ setExtension "html"
|
|
|
|
-- > compile pageCompiler
|
|
|
|
-- >
|
|
|
|
-- > group "raw" $ do
|
|
|
|
-- > match "test.markdown" $ do
|
|
|
|
-- > route idRoute
|
|
|
|
-- > compile copyPageCompiler
|
|
|
|
--
|
|
|
|
-- This will put the compiler for the raw content in a separate group
|
|
|
|
-- (@\"raw\"@), which causes it to be compiled as well.
|
2012-11-13 12:13:17 +00:00
|
|
|
group :: String -> Rules a -> Rules a
|
|
|
|
group g = Rules . local setVersion' . unRules
|
2011-04-11 19:57:33 +00:00
|
|
|
where
|
2012-11-12 15:10:06 +00:00
|
|
|
setVersion' env = env {rulesVersion = Just g}
|
2011-04-11 19:57:33 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-02-11 12:30:55 +00:00
|
|
|
-- | Add a compilation rule to the rules.
|
2010-12-25 18:37:21 +00:00
|
|
|
--
|
2011-04-04 18:49:22 +00:00
|
|
|
-- 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'.
|
2010-12-28 10:12:45 +00:00
|
|
|
compile :: (Binary a, Typeable a, Writable a)
|
2012-11-18 20:56:52 +00:00
|
|
|
=> Compiler (Item a) -> Rules ()
|
2011-04-14 08:17:08 +00:00
|
|
|
compile compiler = do
|
|
|
|
ids <- resources
|
2012-11-13 12:13:17 +00:00
|
|
|
tellCompilers [(id', compiler) | id' <- ids]
|
2012-11-09 15:34:45 +00:00
|
|
|
tellResources ids
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2010-12-25 18:37:21 +00:00
|
|
|
-- | Add a compilation rule
|
|
|
|
--
|
2011-02-11 12:30:55 +00:00
|
|
|
-- This sets a compiler for the given identifier. No resource is needed, since
|
2011-02-26 10:07:46 +00:00
|
|
|
-- we are creating the item from scratch. This is useful if you want to create a
|
|
|
|
-- page on your site that just takes content from other items -- but has no
|
2012-02-17 15:25:00 +00:00
|
|
|
-- actual content itself. Note that the group of the given identifier is
|
|
|
|
-- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been
|
|
|
|
-- used).
|
2010-12-28 10:12:45 +00:00
|
|
|
create :: (Binary a, Typeable a, Writable a)
|
2012-11-18 20:56:52 +00:00
|
|
|
=> Identifier -> Compiler (Item a) -> Rules ()
|
2012-11-13 12:13:17 +00:00
|
|
|
create id' compiler = Rules $ do
|
2012-11-12 15:10:06 +00:00
|
|
|
version' <- rulesVersion <$> ask
|
|
|
|
let id'' = setVersion version' id'
|
2012-11-13 12:13:17 +00:00
|
|
|
unRules $ tellCompilers [(id'', compiler)]
|
2010-12-25 18:37:21 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-02-11 12:30:55 +00:00
|
|
|
-- | Add a route.
|
|
|
|
--
|
2011-04-04 18:49:22 +00:00
|
|
|
-- This adds a route for all items matching the current pattern.
|
2012-11-13 12:13:17 +00:00
|
|
|
route :: Routes -> Rules ()
|
|
|
|
route route' = Rules $ do
|
2011-04-11 19:57:33 +00:00
|
|
|
-- We want the route only to be applied if we match the current pattern and
|
2012-11-12 15:10:06 +00:00
|
|
|
-- version
|
|
|
|
pattern <- rulesPattern <$> ask
|
|
|
|
version' <- rulesVersion <$> ask
|
2012-11-13 12:13:17 +00:00
|
|
|
unRules $ tellRoute $ matchRoute
|
2012-11-12 15:10:06 +00:00
|
|
|
(pattern `mappend` fromVersion version') route'
|
2011-01-07 11:12:13 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2011-05-24 12:39:21 +00:00
|
|
|
-- | Get a list of resources matching the current pattern. This will also set
|
|
|
|
-- the correct group to the identifiers.
|
2012-11-13 12:13:17 +00:00
|
|
|
resources :: Rules [Identifier]
|
|
|
|
resources = Rules $ do
|
2012-11-18 20:56:52 +00:00
|
|
|
pattern <- rulesPattern <$> ask
|
|
|
|
provider <- rulesProvider <$> ask
|
|
|
|
g <- rulesVersion <$> ask
|
2012-11-12 15:10:06 +00:00
|
|
|
return $ filterMatches pattern $ map (setVersion g) $ resourceList provider
|
2011-04-14 08:17:08 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2012-01-16 13:35:43 +00:00
|
|
|
-- | Generate a fresh Identifier with a given prefix
|
2012-11-10 18:56:45 +00:00
|
|
|
-- TODO: remove?
|
2012-11-13 12:13:17 +00:00
|
|
|
freshIdentifier :: String -- ^ Prefix
|
|
|
|
-> Rules Identifier -- ^ Fresh identifier
|
|
|
|
freshIdentifier prefix = Rules $ do
|
2012-01-16 13:35:43 +00:00
|
|
|
state <- get
|
|
|
|
let index = rulesNextIdentifier state
|
2012-11-12 15:10:06 +00:00
|
|
|
id' = fromFilePath $ prefix ++ "/" ++ show index
|
2012-01-16 13:35:43 +00:00
|
|
|
put $ state {rulesNextIdentifier = index + 1}
|
|
|
|
return id'
|