185 lines
6.5 KiB
Haskell
185 lines
6.5 KiB
Haskell
--------------------------------------------------------------------------------
|
|
-- | This module provides a declarative DSL in which the user can specify the
|
|
-- different rules used to run the compilers.
|
|
--
|
|
-- The convention is to just list all items in the 'Rules' monad, routes and
|
|
-- compilation rules.
|
|
--
|
|
-- A typical usage example would be:
|
|
--
|
|
-- > main = hakyll $ do
|
|
-- > match "posts/*" $ do
|
|
-- > route (setExtension "html")
|
|
-- > compile someCompiler
|
|
-- > match "css/*" $ do
|
|
-- > route idRoute
|
|
-- > compile compressCssCompiler
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Hakyll.Core.Rules
|
|
( Rules
|
|
, match
|
|
, create
|
|
, version
|
|
, compile
|
|
, route
|
|
|
|
-- * Advanced usage
|
|
, preprocess
|
|
, Dependency (..)
|
|
, rulesExtraDependencies
|
|
) where
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
import Control.Applicative ((<$>))
|
|
import Control.Monad.Reader (ask, local)
|
|
import Control.Monad.State (get, modify, put)
|
|
import Control.Monad.Trans (liftIO)
|
|
import Control.Monad.Writer (censor, tell)
|
|
import Data.Maybe (fromMaybe)
|
|
import Data.Monoid (mempty)
|
|
import qualified Data.Set as S
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
import Data.Binary (Binary)
|
|
import Data.Typeable (Typeable)
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
import Hakyll.Core.Compiler.Internal
|
|
import Hakyll.Core.Dependencies
|
|
import Hakyll.Core.Identifier
|
|
import Hakyll.Core.Identifier.Pattern
|
|
import Hakyll.Core.Item
|
|
import Hakyll.Core.Item.SomeItem
|
|
import Hakyll.Core.Metadata
|
|
import Hakyll.Core.Routes
|
|
import Hakyll.Core.Rules.Internal
|
|
import Hakyll.Core.Writable
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | Add a route
|
|
tellRoute :: Routes -> Rules ()
|
|
tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | Add a number of compilers
|
|
tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()
|
|
tellCompilers compilers = Rules $ tell $ RuleSet mempty compilers mempty
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | Add resources
|
|
tellResources :: [Identifier] -> Rules ()
|
|
tellResources resources' = Rules $ tell $
|
|
RuleSet mempty mempty $ S.fromList resources'
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
flush :: Rules ()
|
|
flush = Rules $ do
|
|
mcompiler <- rulesCompiler <$> get
|
|
case mcompiler of
|
|
Nothing -> return ()
|
|
Just compiler -> do
|
|
matches' <- rulesMatches <$> ask
|
|
version' <- rulesVersion <$> ask
|
|
route' <- fromMaybe mempty . rulesRoute <$> get
|
|
|
|
-- The version is possibly not set correctly at this point (yet)
|
|
let ids = map (setVersion version') matches'
|
|
|
|
{-
|
|
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
|
|
-}
|
|
|
|
-- 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
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
match :: Pattern -> Rules () -> Rules ()
|
|
match pattern rules = do
|
|
flush
|
|
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
|
|
where
|
|
setMatches env = env {rulesMatches = ids}
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
version :: String -> Rules () -> Rules ()
|
|
version v rules = do
|
|
flush
|
|
Rules $ local setVersion' $ unRules $ rules >> flush
|
|
where
|
|
setVersion' env = env {rulesVersion = Just v}
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | Add a compilation rule to the rules.
|
|
--
|
|
-- This instructs all resources to be compiled using the given compiler.
|
|
compile :: (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules ()
|
|
compile compiler = Rules $ modify $ \s ->
|
|
s {rulesCompiler = Just (fmap SomeItem compiler)}
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | Add a route.
|
|
--
|
|
-- This adds a route for all items matching the current pattern.
|
|
route :: Routes -> Rules ()
|
|
route route' = Rules $ modify $ \s -> s {rulesRoute = Just route'}
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | 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
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | 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.
|
|
--
|
|
-- A useful utility for this purpose is 'makePatternDependency'.
|
|
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
|
|
]
|
|
}
|