{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Core.Rules
( Rules
, match
, matchMetadata
, create
, version
, compile
, route
, preprocess
, Dependency (..)
, rulesExtraDependencies
) where
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 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
tellRoute :: Routes -> Rules ()
tellRoute :: Routes -> Rules ()
tellRoute Routes
route' = forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ Routes
-> [(Identifier, Compiler SomeItem)]
-> Set Identifier
-> Pattern
-> RuleSet
RuleSet Routes
route' forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()
tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()
tellCompilers [(Identifier, Compiler SomeItem)]
compilers = forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ Routes
-> [(Identifier, Compiler SomeItem)]
-> Set Identifier
-> Pattern
-> RuleSet
RuleSet forall a. Monoid a => a
mempty [(Identifier, Compiler SomeItem)]
compilers forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
tellResources :: [Identifier] -> Rules ()
tellResources :: [Identifier] -> Rules ()
tellResources [Identifier]
resources' = forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$
Routes
-> [(Identifier, Compiler SomeItem)]
-> Set Identifier
-> Pattern
-> RuleSet
RuleSet forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (forall a. Ord a => [a] -> Set a
S.fromList [Identifier]
resources') forall a. Monoid a => a
mempty
tellPattern :: Pattern -> Rules ()
tellPattern :: Pattern -> Rules ()
tellPattern Pattern
pattern = forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ Routes
-> [(Identifier, Compiler SomeItem)]
-> Set Identifier
-> Pattern
-> RuleSet
RuleSet forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty Pattern
pattern
flush :: Rules ()
flush :: Rules ()
flush = forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ do
Maybe (Compiler SomeItem)
mcompiler <- RulesState -> Maybe (Compiler SomeItem)
rulesCompiler forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
case Maybe (Compiler SomeItem)
mcompiler of
Maybe (Compiler SomeItem)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Compiler SomeItem
compiler -> do
[Identifier]
matches' <- RulesRead -> [Identifier]
rulesMatches forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe String
version' <- RulesRead -> Maybe String
rulesVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
Routes
route' <- forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. RulesState -> Maybe Routes
rulesRoute forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
let ids :: [Identifier]
ids = forall a b. (a -> b) -> [a] -> [b]
map (Maybe String -> Identifier -> Identifier
setVersion Maybe String
version') [Identifier]
matches'
let fastPattern :: Pattern
fastPattern = [Identifier] -> Pattern
fromList [Identifier]
ids
forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules forall a b. (a -> b) -> a -> b
$ Routes -> Rules ()
tellRoute forall a b. (a -> b) -> a -> b
$ Pattern -> Routes -> Routes
matchRoute Pattern
fastPattern Routes
route'
forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules forall a b. (a -> b) -> a -> b
$ [(Identifier, Compiler SomeItem)] -> Rules ()
tellCompilers forall a b. (a -> b) -> a -> b
$ [(Identifier
id', Compiler SomeItem
compiler) | Identifier
id' <- [Identifier]
ids]
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ RulesState
emptyRulesState
matchInternal :: Pattern -> Rules [Identifier] -> Rules () -> Rules ()
matchInternal :: Pattern -> Rules [Identifier] -> Rules () -> Rules ()
matchInternal Pattern
pattern Rules [Identifier]
getIDs Rules ()
rules = do
Pattern -> Rules ()
tellPattern Pattern
pattern
Rules ()
flush
[Identifier]
ids <- Rules [Identifier]
getIDs
[Identifier] -> Rules ()
tellResources [Identifier]
ids
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ([Identifier] -> RulesRead -> RulesRead
setMatches [Identifier]
ids) forall a b. (a -> b) -> a -> b
$ forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules forall a b. (a -> b) -> a -> b
$ Rules ()
rules forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rules ()
flush
where
setMatches :: [Identifier] -> RulesRead -> RulesRead
setMatches [Identifier]
ids RulesRead
env = RulesRead
env {rulesMatches :: [Identifier]
rulesMatches = [Identifier]
ids}
match :: Pattern -> Rules () -> Rules ()
match :: Pattern -> Rules () -> Rules ()
match Pattern
pattern = Pattern -> Rules [Identifier] -> Rules () -> Rules ()
matchInternal Pattern
pattern forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches Pattern
pattern
matchMetadata :: Pattern -> (Metadata -> Bool) -> Rules () -> Rules ()
matchMetadata :: Pattern -> (Metadata -> Bool) -> Rules () -> Rules ()
matchMetadata Pattern
pattern Metadata -> Bool
metadataPred = Pattern -> Rules [Identifier] -> Rules () -> Rules ()
matchInternal Pattern
pattern forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Metadata -> Bool
metadataPred forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadMetadata m =>
Pattern -> m [(Identifier, Metadata)]
getAllMetadata Pattern
pattern
create :: [Identifier] -> Rules () -> Rules ()
create :: [Identifier] -> Rules () -> Rules ()
create [Identifier]
ids Rules ()
rules = do
Rules ()
flush
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RulesRead -> RulesRead
setMatches forall a b. (a -> b) -> a -> b
$ forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules forall a b. (a -> b) -> a -> b
$ Rules ()
rules forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rules ()
flush
where
setMatches :: RulesRead -> RulesRead
setMatches RulesRead
env = RulesRead
env {rulesMatches :: [Identifier]
rulesMatches = [Identifier]
ids}
version :: String -> Rules () -> Rules ()
version :: String -> Rules () -> Rules ()
version String
v Rules ()
rules = do
Rules ()
flush
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RulesRead -> RulesRead
setVersion' forall a b. (a -> b) -> a -> b
$ forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules forall a b. (a -> b) -> a -> b
$ Rules ()
rules forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rules ()
flush
where
setVersion' :: RulesRead -> RulesRead
setVersion' RulesRead
env = RulesRead
env {rulesVersion :: Maybe String
rulesVersion = forall a. a -> Maybe a
Just String
v}
compile :: (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules ()
compile :: forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item a)
compiler = forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \RulesState
s ->
RulesState
s {rulesCompiler :: Maybe (Compiler SomeItem)
rulesCompiler = forall a. a -> Maybe a
Just (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Binary a, Typeable a, Writable a) => Item a -> SomeItem
SomeItem Compiler (Item a)
compiler)}
route :: Routes -> Rules ()
route :: Routes -> Rules ()
route Routes
route' = forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \RulesState
s -> RulesState
s {rulesRoute :: Maybe Routes
rulesRoute = forall a. a -> Maybe a
Just Routes
route'}
preprocess :: IO a -> Rules a
preprocess :: forall a. IO a -> Rules a
preprocess = forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
rulesExtraDependencies :: [Dependency] -> Rules a -> Rules a
[Dependency]
deps Rules a
rules =
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor RuleSet -> RuleSet
fixRuleSet forall a b. (a -> b) -> a -> b
$ do
a
x <- forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules Rules a
rules
RWST RulesRead RuleSet RulesState IO ()
fixCompiler
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
where
fixCompiler :: RWST RulesRead RuleSet RulesState IO ()
fixCompiler = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \RulesState
s -> case RulesState -> Maybe (Compiler SomeItem)
rulesCompiler RulesState
s of
Maybe (Compiler SomeItem)
Nothing -> RulesState
s
Just Compiler SomeItem
c -> RulesState
s
{ rulesCompiler :: Maybe (Compiler SomeItem)
rulesCompiler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Dependency] -> Compiler ()
compilerTellDependencies [Dependency]
deps forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Compiler SomeItem
c
}
fixRuleSet :: RuleSet -> RuleSet
fixRuleSet RuleSet
ruleSet = RuleSet
ruleSet
{ rulesCompilers :: [(Identifier, Compiler SomeItem)]
rulesCompilers =
[ (Identifier
i, [Dependency] -> Compiler ()
compilerTellDependencies [Dependency]
deps forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Compiler SomeItem
c)
| (Identifier
i, Compiler SomeItem
c) <- RuleSet -> [(Identifier, Compiler SomeItem)]
rulesCompilers RuleSet
ruleSet
]
}