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
|
2013-01-06 08:51:09 +00:00
|
|
|
, create
|
2012-11-24 17:45:43 +00:00
|
|
|
, version
|
2010-12-25 18:37:21 +00:00
|
|
|
, compile
|
|
|
|
, route
|
2012-11-29 15:22:08 +00:00
|
|
|
|
|
|
|
-- * Advanced usage
|
2013-01-08 11:47:55 +00:00
|
|
|
, preprocess
|
|
|
|
, Dependency (..)
|
2012-11-29 15:22:08 +00:00
|
|
|
, rulesExtraDependencies
|
2010-12-25 18:37:21 +00:00
|
|
|
) where
|
|
|
|
|
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Control.Applicative ((<$>))
|
|
|
|
import Control.Monad.Reader (ask, local)
|
2012-12-26 16:06:40 +00:00
|
|
|
import Control.Monad.State (get, modify, put)
|
2013-01-08 11:47:55 +00:00
|
|
|
import Control.Monad.Trans (liftIO)
|
2012-11-29 15:22:08 +00:00
|
|
|
import Control.Monad.Writer (censor, tell)
|
2012-12-26 16:06:40 +00:00
|
|
|
import Data.Maybe (fromMaybe)
|
2013-01-06 08:51:09 +00:00
|
|
|
import Data.Monoid (mempty)
|
2012-11-08 12:50:08 +00:00
|
|
|
import qualified Data.Set as S
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Data.Binary (Binary)
|
|
|
|
import Data.Typeable (Typeable)
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Hakyll.Core.Compiler.Internal
|
2012-11-29 15:22:08 +00:00
|
|
|
import Hakyll.Core.Dependencies
|
2012-11-08 12:50:08 +00:00
|
|
|
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
|
2012-11-24 17:45:43 +00:00
|
|
|
import Hakyll.Core.Metadata
|
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 ()
|
2013-04-04 09:47:50 +00:00
|
|
|
tellRoute route' = Rules $ tell $ RuleSet route' mempty 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
|
2012-12-26 16:06:40 +00:00
|
|
|
tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()
|
2013-04-04 09:47:50 +00:00
|
|
|
tellCompilers compilers = Rules $ tell $ RuleSet mempty compilers mempty 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-12-26 16:06:40 +00:00
|
|
|
tellResources :: [Identifier] -> Rules ()
|
2012-11-13 12:13:17 +00:00
|
|
|
tellResources resources' = Rules $ tell $
|
2013-04-04 09:47:50 +00:00
|
|
|
RuleSet mempty mempty (S.fromList resources') mempty
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Add a pattern
|
|
|
|
tellPattern :: Pattern -> Rules ()
|
|
|
|
tellPattern pattern = Rules $ tell $ RuleSet mempty mempty mempty pattern
|
2011-02-15 17:32:55 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2012-12-26 16:06:40 +00:00
|
|
|
flush :: Rules ()
|
|
|
|
flush = Rules $ do
|
|
|
|
mcompiler <- rulesCompiler <$> get
|
|
|
|
case mcompiler of
|
|
|
|
Nothing -> return ()
|
|
|
|
Just compiler -> do
|
2013-01-06 08:51:09 +00:00
|
|
|
matches' <- rulesMatches <$> ask
|
2012-12-26 16:06:40 +00:00
|
|
|
version' <- rulesVersion <$> ask
|
|
|
|
route' <- fromMaybe mempty . rulesRoute <$> get
|
2013-01-06 08:51:09 +00:00
|
|
|
|
|
|
|
-- The version is possibly not set correctly at this point (yet)
|
|
|
|
let ids = map (setVersion version') matches'
|
|
|
|
|
|
|
|
{-
|
2012-12-26 16:06:40 +00:00
|
|
|
ids <- case fromLiteral pattern of
|
|
|
|
Just id' -> return [setVersion version' id']
|
|
|
|
Nothing -> do
|
|
|
|
ids <- unRules $ getMatches pattern
|
|
|
|
unRules $ tellResources ids
|
|
|
|
return $ map (setVersion version') ids
|
2013-01-06 08:51:09 +00:00
|
|
|
-}
|
2012-12-26 16:06:40 +00:00
|
|
|
|
|
|
|
-- Create a fast pattern for routing that matches exactly the
|
|
|
|
-- compilers created in the block given to match
|
|
|
|
let fastPattern = fromList ids
|
|
|
|
|
|
|
|
-- Write out the compilers and routes
|
|
|
|
unRules $ tellRoute $ matchRoute fastPattern route'
|
|
|
|
unRules $ tellCompilers $ [(id', compiler) | id' <- ids]
|
|
|
|
|
|
|
|
put $ emptyRulesState
|
2012-12-01 17:56:16 +00:00
|
|
|
|
|
|
|
|
2012-12-25 22:26:16 +00:00
|
|
|
--------------------------------------------------------------------------------
|
2012-12-26 16:06:40 +00:00
|
|
|
match :: Pattern -> Rules () -> Rules ()
|
|
|
|
match pattern rules = do
|
2013-04-04 09:47:50 +00:00
|
|
|
tellPattern pattern
|
2012-12-26 16:06:40 +00:00
|
|
|
flush
|
2013-01-06 08:51:09 +00:00
|
|
|
ids <- getMatches pattern
|
|
|
|
tellResources ids
|
|
|
|
Rules $ local (setMatches ids) $ unRules $ rules >> flush
|
|
|
|
where
|
|
|
|
setMatches ids env = env {rulesMatches = ids}
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
create :: [Identifier] -> Rules () -> Rules ()
|
|
|
|
create ids rules = do
|
|
|
|
flush
|
|
|
|
-- TODO Maybe check if the resources exist and call tellResources on that
|
|
|
|
Rules $ local setMatches $ unRules $ rules >> flush
|
2012-12-25 22:26:16 +00:00
|
|
|
where
|
2013-01-06 08:51:09 +00:00
|
|
|
setMatches env = env {rulesMatches = ids}
|
2012-12-25 22:26:16 +00:00
|
|
|
|
2012-11-08 12:50:08 +00:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2012-12-26 16:06:40 +00:00
|
|
|
version :: String -> Rules () -> Rules ()
|
|
|
|
version v rules = do
|
|
|
|
flush
|
|
|
|
Rules $ local setVersion' $ unRules $ rules >> flush
|
2011-04-11 19:57:33 +00:00
|
|
|
where
|
2012-11-24 17:45:43 +00:00
|
|
|
setVersion' env = env {rulesVersion = Just v}
|
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
|
|
|
--
|
2013-01-03 20:10:41 +00:00
|
|
|
-- This instructs all resources to be compiled using the given compiler.
|
2012-12-26 16:06:40 +00:00
|
|
|
compile :: (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules ()
|
|
|
|
compile compiler = Rules $ modify $ \s ->
|
|
|
|
s {rulesCompiler = Just (fmap SomeItem 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 ()
|
2012-12-26 16:06:40 +00:00
|
|
|
route route' = Rules $ modify $ \s -> s {rulesRoute = Just route'}
|
2012-11-29 15:22:08 +00:00
|
|
|
|
|
|
|
|
2013-01-08 11:47:55 +00:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Execute an 'IO' action immediately while the rules are being evaluated.
|
|
|
|
-- This should be avoided if possible, but occasionally comes in useful.
|
|
|
|
preprocess :: IO a -> Rules a
|
|
|
|
preprocess = Rules . liftIO
|
|
|
|
|
|
|
|
|
2012-11-29 15:22:08 +00:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Advanced usage: add extra dependencies to compilers. Basically this is
|
|
|
|
-- needed when you're doing unsafe tricky stuff in the rules monad, but you
|
|
|
|
-- still want correct builds.
|
2013-03-05 11:51:27 +00:00
|
|
|
--
|
|
|
|
-- A useful utility for this purpose is 'makePatternDependency'.
|
2012-11-29 15:22:08 +00:00
|
|
|
rulesExtraDependencies :: [Dependency] -> Rules a -> Rules a
|
|
|
|
rulesExtraDependencies deps = Rules . censor addDependencies . unRules
|
|
|
|
where
|
|
|
|
-- Adds the dependencies to the compilers in the ruleset
|
|
|
|
addDependencies ruleSet = ruleSet
|
|
|
|
{ rulesCompilers =
|
|
|
|
[ (i, compilerTellDependencies deps >> c)
|
|
|
|
| (i, c) <- rulesCompilers ruleSet
|
|
|
|
]
|
|
|
|
}
|