--------------------------------------------------------------------------------
-- | 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
    , matchMetadata
    , create
    , version
    , compile
    , route

      -- * Advanced usage
    , 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


--------------------------------------------------------------------------------
-- | Add a route
tellRoute :: Routes -> Rules ()
tellRoute :: Routes -> Rules ()
tellRoute Routes
route' = RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO () -> Rules ())
-> RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ RuleSet -> RWST RulesRead RuleSet RulesState IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (RuleSet -> RWST RulesRead RuleSet RulesState IO ())
-> RuleSet -> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ Routes
-> [(Identifier, Compiler SomeItem)]
-> Set Identifier
-> Pattern
-> RuleSet
RuleSet Routes
route' [(Identifier, Compiler SomeItem)]
forall a. Monoid a => a
mempty Set Identifier
forall a. Monoid a => a
mempty Pattern
forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
-- | Add a number of compilers
tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()
tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()
tellCompilers [(Identifier, Compiler SomeItem)]
compilers = RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO () -> Rules ())
-> RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ RuleSet -> RWST RulesRead RuleSet RulesState IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (RuleSet -> RWST RulesRead RuleSet RulesState IO ())
-> RuleSet -> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ Routes
-> [(Identifier, Compiler SomeItem)]
-> Set Identifier
-> Pattern
-> RuleSet
RuleSet Routes
forall a. Monoid a => a
mempty [(Identifier, Compiler SomeItem)]
compilers Set Identifier
forall a. Monoid a => a
mempty Pattern
forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
-- | Add resources
tellResources :: [Identifier] -> Rules ()
tellResources :: [Identifier] -> Rules ()
tellResources [Identifier]
resources' = RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO () -> Rules ())
-> RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ RuleSet -> RWST RulesRead RuleSet RulesState IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (RuleSet -> RWST RulesRead RuleSet RulesState IO ())
-> RuleSet -> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$
    Routes
-> [(Identifier, Compiler SomeItem)]
-> Set Identifier
-> Pattern
-> RuleSet
RuleSet Routes
forall a. Monoid a => a
mempty [(Identifier, Compiler SomeItem)]
forall a. Monoid a => a
mempty ([Identifier] -> Set Identifier
forall a. Ord a => [a] -> Set a
S.fromList [Identifier]
resources') Pattern
forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
-- | Add a pattern
tellPattern :: Pattern -> Rules ()
tellPattern :: Pattern -> Rules ()
tellPattern Pattern
pattern = RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO () -> Rules ())
-> RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ RuleSet -> RWST RulesRead RuleSet RulesState IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (RuleSet -> RWST RulesRead RuleSet RulesState IO ())
-> RuleSet -> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ Routes
-> [(Identifier, Compiler SomeItem)]
-> Set Identifier
-> Pattern
-> RuleSet
RuleSet Routes
forall a. Monoid a => a
mempty [(Identifier, Compiler SomeItem)]
forall a. Monoid a => a
mempty Set Identifier
forall a. Monoid a => a
mempty Pattern
pattern


--------------------------------------------------------------------------------
flush :: Rules ()
flush :: Rules ()
flush = RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO () -> Rules ())
-> RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe (Compiler SomeItem)
mcompiler <- RulesState -> Maybe (Compiler SomeItem)
rulesCompiler (RulesState -> Maybe (Compiler SomeItem))
-> RWST RulesRead RuleSet RulesState IO RulesState
-> RWST RulesRead RuleSet RulesState IO (Maybe (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RulesRead RuleSet RulesState IO RulesState
forall s (m :: * -> *). MonadState s m => m s
get
    case Maybe (Compiler SomeItem)
mcompiler of
        Maybe (Compiler SomeItem)
Nothing       -> () -> RWST RulesRead RuleSet RulesState IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Compiler SomeItem
compiler -> do
            [Identifier]
matches' <- RulesRead -> [Identifier]
rulesMatches                  (RulesRead -> [Identifier])
-> RWST RulesRead RuleSet RulesState IO RulesRead
-> RWST RulesRead RuleSet RulesState IO [Identifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RulesRead RuleSet RulesState IO RulesRead
forall r (m :: * -> *). MonadReader r m => m r
ask
            Maybe String
version' <- RulesRead -> Maybe String
rulesVersion                  (RulesRead -> Maybe String)
-> RWST RulesRead RuleSet RulesState IO RulesRead
-> RWST RulesRead RuleSet RulesState IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RulesRead RuleSet RulesState IO RulesRead
forall r (m :: * -> *). MonadReader r m => m r
ask
            Routes
route'   <- Routes -> Maybe Routes -> Routes
forall a. a -> Maybe a -> a
fromMaybe Routes
forall a. Monoid a => a
mempty (Maybe Routes -> Routes)
-> (RulesState -> Maybe Routes) -> RulesState -> Routes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RulesState -> Maybe Routes
rulesRoute (RulesState -> Routes)
-> RWST RulesRead RuleSet RulesState IO RulesState
-> RWST RulesRead RuleSet RulesState IO Routes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RulesRead RuleSet RulesState IO RulesState
forall s (m :: * -> *). MonadState s m => m s
get

            -- The version is possibly not set correctly at this point (yet)
            let ids :: [Identifier]
ids = (Identifier -> Identifier) -> [Identifier] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe String -> Identifier -> Identifier
setVersion Maybe String
version') [Identifier]
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 :: Pattern
fastPattern = [Identifier] -> Pattern
fromList [Identifier]
ids

            -- Write out the compilers and routes
            Rules () -> RWST RulesRead RuleSet RulesState IO ()
forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules (Rules () -> RWST RulesRead RuleSet RulesState IO ())
-> Rules () -> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ Routes -> Rules ()
tellRoute (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ Pattern -> Routes -> Routes
matchRoute Pattern
fastPattern Routes
route'
            Rules () -> RWST RulesRead RuleSet RulesState IO ()
forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules (Rules () -> RWST RulesRead RuleSet RulesState IO ())
-> Rules () -> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ [(Identifier, Compiler SomeItem)] -> Rules ()
tellCompilers ([(Identifier, Compiler SomeItem)] -> Rules ())
-> [(Identifier, Compiler SomeItem)] -> Rules ()
forall a b. (a -> b) -> a -> b
$ [(Identifier
id', Compiler SomeItem
compiler) | Identifier
id' <- [Identifier]
ids]

    RulesState -> RWST RulesRead RuleSet RulesState IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RulesState -> RWST RulesRead RuleSet RulesState IO ())
-> RulesState -> RWST RulesRead RuleSet RulesState IO ()
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
    RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO () -> Rules ())
-> RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ (RulesRead -> RulesRead)
-> RWST RulesRead RuleSet RulesState IO ()
-> RWST RulesRead RuleSet RulesState IO ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ([Identifier] -> RulesRead -> RulesRead
setMatches [Identifier]
ids) (RWST RulesRead RuleSet RulesState IO ()
 -> RWST RulesRead RuleSet RulesState IO ())
-> RWST RulesRead RuleSet RulesState IO ()
-> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ Rules () -> RWST RulesRead RuleSet RulesState IO ()
forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules (Rules () -> RWST RulesRead RuleSet RulesState IO ())
-> Rules () -> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ Rules ()
rules Rules () -> 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 (Rules [Identifier] -> Rules () -> Rules ())
-> Rules [Identifier] -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Pattern -> Rules [Identifier]
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 (Rules [Identifier] -> Rules () -> Rules ())
-> Rules [Identifier] -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
    ((Identifier, Metadata) -> Identifier)
-> [(Identifier, Metadata)] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, Metadata) -> Identifier
forall a b. (a, b) -> a
fst ([(Identifier, Metadata)] -> [Identifier])
-> ([(Identifier, Metadata)] -> [(Identifier, Metadata)])
-> [(Identifier, Metadata)]
-> [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Identifier, Metadata) -> Bool)
-> [(Identifier, Metadata)] -> [(Identifier, Metadata)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Metadata -> Bool
metadataPred (Metadata -> Bool)
-> ((Identifier, Metadata) -> Metadata)
-> (Identifier, Metadata)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier, Metadata) -> Metadata
forall a b. (a, b) -> b
snd) ([(Identifier, Metadata)] -> [Identifier])
-> Rules [(Identifier, Metadata)] -> Rules [Identifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> Rules [(Identifier, Metadata)]
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
    -- TODO Maybe check if the resources exist and call tellResources on that
    RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO () -> Rules ())
-> RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ (RulesRead -> RulesRead)
-> RWST RulesRead RuleSet RulesState IO ()
-> RWST RulesRead RuleSet RulesState IO ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RulesRead -> RulesRead
setMatches (RWST RulesRead RuleSet RulesState IO ()
 -> RWST RulesRead RuleSet RulesState IO ())
-> RWST RulesRead RuleSet RulesState IO ()
-> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ Rules () -> RWST RulesRead RuleSet RulesState IO ()
forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules (Rules () -> RWST RulesRead RuleSet RulesState IO ())
-> Rules () -> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ Rules ()
rules Rules () -> 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
    RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO () -> Rules ())
-> RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ (RulesRead -> RulesRead)
-> RWST RulesRead RuleSet RulesState IO ()
-> RWST RulesRead RuleSet RulesState IO ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RulesRead -> RulesRead
setVersion' (RWST RulesRead RuleSet RulesState IO ()
 -> RWST RulesRead RuleSet RulesState IO ())
-> RWST RulesRead RuleSet RulesState IO ()
-> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ Rules () -> RWST RulesRead RuleSet RulesState IO ()
forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules (Rules () -> RWST RulesRead RuleSet RulesState IO ())
-> Rules () -> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ Rules ()
rules Rules () -> 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 = String -> Maybe String
forall a. a -> Maybe a
Just String
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 (Item a) -> Rules ()
compile Compiler (Item a)
compiler = RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO () -> Rules ())
-> RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ (RulesState -> RulesState)
-> RWST RulesRead RuleSet RulesState IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RulesState -> RulesState)
 -> RWST RulesRead RuleSet RulesState IO ())
-> (RulesState -> RulesState)
-> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ \RulesState
s ->
    RulesState
s {rulesCompiler :: Maybe (Compiler SomeItem)
rulesCompiler = Compiler SomeItem -> Maybe (Compiler SomeItem)
forall a. a -> Maybe a
Just ((Item a -> SomeItem) -> Compiler (Item a) -> Compiler SomeItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Item a -> SomeItem
forall a. (Binary a, Typeable a, Writable a) => Item a -> SomeItem
SomeItem Compiler (Item a)
compiler)}


--------------------------------------------------------------------------------
-- | Add a route.
--
-- This adds a route for all items matching the current pattern.
route :: Routes -> Rules ()
route :: Routes -> Rules ()
route Routes
route' = RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO () -> Rules ())
-> RWST RulesRead RuleSet RulesState IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ (RulesState -> RulesState)
-> RWST RulesRead RuleSet RulesState IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RulesState -> RulesState)
 -> RWST RulesRead RuleSet RulesState IO ())
-> (RulesState -> RulesState)
-> RWST RulesRead RuleSet RulesState IO ()
forall a b. (a -> b) -> a -> b
$ \RulesState
s -> RulesState
s {rulesRoute :: Maybe Routes
rulesRoute = Routes -> Maybe Routes
forall a. a -> Maybe a
Just Routes
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 :: IO a -> Rules a
preprocess = RWST RulesRead RuleSet RulesState IO a -> Rules a
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO a -> Rules a)
-> (IO a -> RWST RulesRead RuleSet RulesState IO a)
-> IO a
-> Rules a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> RWST RulesRead RuleSet RulesState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 :: [Dependency] -> Rules a -> Rules a
rulesExtraDependencies [Dependency]
deps Rules a
rules =
    -- Note that we add the dependencies seemingly twice here. However, this is
    -- done so that 'rulesExtraDependencies' works both if we have something
    -- like:
    --
    -- > match "*.css" $ rulesExtraDependencies [foo] $ ...
    --
    -- and something like:
    --
    -- > rulesExtraDependencies [foo] $ match "*.css" $ ...
    --
    -- (1) takes care of the latter and (2) of the former.
    RWST RulesRead RuleSet RulesState IO a -> Rules a
forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules (RWST RulesRead RuleSet RulesState IO a -> Rules a)
-> RWST RulesRead RuleSet RulesState IO a -> Rules a
forall a b. (a -> b) -> a -> b
$ (RuleSet -> RuleSet)
-> RWST RulesRead RuleSet RulesState IO a
-> RWST RulesRead RuleSet RulesState IO a
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor RuleSet -> RuleSet
fixRuleSet (RWST RulesRead RuleSet RulesState IO a
 -> RWST RulesRead RuleSet RulesState IO a)
-> RWST RulesRead RuleSet RulesState IO a
-> RWST RulesRead RuleSet RulesState IO a
forall a b. (a -> b) -> a -> b
$ do
        a
x <- Rules a -> RWST RulesRead RuleSet RulesState IO a
forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules Rules a
rules
        RWST RulesRead RuleSet RulesState IO ()
fixCompiler
        a -> RWST RulesRead RuleSet RulesState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  where
    -- (1) Adds the dependencies to the compilers we are yet to create
    fixCompiler :: RWST RulesRead RuleSet RulesState IO ()
fixCompiler = (RulesState -> RulesState)
-> RWST RulesRead RuleSet RulesState IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RulesState -> RulesState)
 -> RWST RulesRead RuleSet RulesState IO ())
-> (RulesState -> RulesState)
-> RWST RulesRead RuleSet RulesState IO ()
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 = Compiler SomeItem -> Maybe (Compiler SomeItem)
forall a. a -> Maybe a
Just (Compiler SomeItem -> Maybe (Compiler SomeItem))
-> Compiler SomeItem -> Maybe (Compiler SomeItem)
forall a b. (a -> b) -> a -> b
$ [Dependency] -> Compiler ()
compilerTellDependencies [Dependency]
deps Compiler () -> Compiler SomeItem -> Compiler SomeItem
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Compiler SomeItem
c
            }

    -- (2) Adds the dependencies to the compilers that are already in the ruleset
    fixRuleSet :: RuleSet -> RuleSet
fixRuleSet RuleSet
ruleSet = RuleSet
ruleSet
        { rulesCompilers :: [(Identifier, Compiler SomeItem)]
rulesCompilers =
            [ (Identifier
i, [Dependency] -> Compiler ()
compilerTellDependencies [Dependency]
deps Compiler () -> Compiler SomeItem -> Compiler SomeItem
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
            ]
        }