--------------------------------------------------------------------------------
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Rank2Types                 #-}
module Hakyll.Core.Rules.Internal
    ( RulesRead (..)
    , RuleSet (..)
    , RulesState (..)
    , emptyRulesState
    , Rules (..)
    , runRules
    ) where


--------------------------------------------------------------------------------
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             (MonadFail)
#endif
import           Control.Monad.Reader           (ask)
import           Control.Monad.RWS              (RWST, runRWST)
import           Control.Monad.Trans            (liftIO)
import qualified Data.Map                       as M
import           Data.Set                       (Set)


--------------------------------------------------------------------------------
import           Hakyll.Core.Compiler.Internal
import           Hakyll.Core.Identifier
import           Hakyll.Core.Identifier.Pattern
import           Hakyll.Core.Item.SomeItem
import           Hakyll.Core.Metadata
import           Hakyll.Core.Provider
import           Hakyll.Core.Routes


--------------------------------------------------------------------------------
data RulesRead = RulesRead
    { RulesRead -> Provider
rulesProvider :: Provider
    , RulesRead -> [Identifier]
rulesMatches  :: [Identifier]
    , RulesRead -> Maybe String
rulesVersion  :: Maybe String
    }


--------------------------------------------------------------------------------
data RuleSet = RuleSet
    { -- | Accumulated routes
      RuleSet -> Routes
rulesRoutes    :: Routes
    , -- | Accumulated compilers
      RuleSet -> [(Identifier, Compiler SomeItem)]
rulesCompilers :: [(Identifier, Compiler SomeItem)]
    , -- | A set of the actually used files
      RuleSet -> Set Identifier
rulesResources :: Set Identifier
    , -- | A pattern we can use to check if a file *would* be used. This is
      -- needed for the preview server.
      RuleSet -> Pattern
rulesPattern   :: Pattern
    }


--------------------------------------------------------------------------------
instance Semigroup RuleSet where
    <> :: RuleSet -> RuleSet -> RuleSet
(<>) (RuleSet Routes
r1 [(Identifier, Compiler SomeItem)]
c1 Set Identifier
s1 Pattern
p1) (RuleSet Routes
r2 [(Identifier, Compiler SomeItem)]
c2 Set Identifier
s2 Pattern
p2) =
        Routes
-> [(Identifier, Compiler SomeItem)]
-> Set Identifier
-> Pattern
-> RuleSet
RuleSet (forall a. Monoid a => a -> a -> a
mappend Routes
r1 Routes
r2) (forall a. Monoid a => a -> a -> a
mappend [(Identifier, Compiler SomeItem)]
c1 [(Identifier, Compiler SomeItem)]
c2) (forall a. Monoid a => a -> a -> a
mappend Set Identifier
s1 Set Identifier
s2) (Pattern
p1 Pattern -> Pattern -> Pattern
.||. Pattern
p2)

instance Monoid RuleSet where
    mempty :: RuleSet
mempty  = 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 forall a. Monoid a => a
mempty
    mappend :: RuleSet -> RuleSet -> RuleSet
mappend = forall a. Semigroup a => a -> a -> a
(<>)


--------------------------------------------------------------------------------
data RulesState = RulesState
    { RulesState -> Maybe Routes
rulesRoute    :: Maybe Routes
    , RulesState -> Maybe (Compiler SomeItem)
rulesCompiler :: Maybe (Compiler SomeItem)
    }


--------------------------------------------------------------------------------
emptyRulesState :: RulesState
emptyRulesState :: RulesState
emptyRulesState = Maybe Routes -> Maybe (Compiler SomeItem) -> RulesState
RulesState forall a. Maybe a
Nothing forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
-- | The monad used to compose rules
newtype Rules a = Rules
    { forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules :: RWST RulesRead RuleSet RulesState IO a
    } deriving (Applicative Rules
forall a. a -> Rules a
forall a b. Rules a -> Rules b -> Rules b
forall a b. Rules a -> (a -> Rules b) -> Rules b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Rules a
$creturn :: forall a. a -> Rules a
>> :: forall a b. Rules a -> Rules b -> Rules b
$c>> :: forall a b. Rules a -> Rules b -> Rules b
>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
$c>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
Monad, Monad Rules
forall a. String -> Rules a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> Rules a
$cfail :: forall a. String -> Rules a
MonadFail, forall a b. a -> Rules b -> Rules a
forall a b. (a -> b) -> Rules a -> Rules b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Rules b -> Rules a
$c<$ :: forall a b. a -> Rules b -> Rules a
fmap :: forall a b. (a -> b) -> Rules a -> Rules b
$cfmap :: forall a b. (a -> b) -> Rules a -> Rules b
Functor, Functor Rules
forall a. a -> Rules a
forall a b. Rules a -> Rules b -> Rules a
forall a b. Rules a -> Rules b -> Rules b
forall a b. Rules (a -> b) -> Rules a -> Rules b
forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Rules a -> Rules b -> Rules a
$c<* :: forall a b. Rules a -> Rules b -> Rules a
*> :: forall a b. Rules a -> Rules b -> Rules b
$c*> :: forall a b. Rules a -> Rules b -> Rules b
liftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
$cliftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
$c<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
pure :: forall a. a -> Rules a
$cpure :: forall a. a -> Rules a
Applicative)


--------------------------------------------------------------------------------
instance MonadMetadata Rules where
    getMetadata :: Identifier -> Rules Metadata
getMetadata Identifier
identifier = forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ do
        Provider
provider <- RulesRead -> Provider
rulesProvider forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Provider -> Identifier -> IO Metadata
resourceMetadata Provider
provider Identifier
identifier

    getMatches :: Pattern -> Rules [Identifier]
getMatches Pattern
pattern = forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ do
        Provider
provider <- RulesRead -> Provider
rulesProvider forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Pattern -> [Identifier] -> [Identifier]
filterMatches Pattern
pattern forall a b. (a -> b) -> a -> b
$ Provider -> [Identifier]
resourceList Provider
provider


--------------------------------------------------------------------------------
-- | Run a Rules monad, resulting in a 'RuleSet'
runRules :: Rules a -> Provider -> IO RuleSet
runRules :: forall a. Rules a -> Provider -> IO RuleSet
runRules Rules a
rules Provider
provider = do
    (a
_, RulesState
_, RuleSet
ruleSet) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (forall a. Rules a -> RWST RulesRead RuleSet RulesState IO a
unRules Rules a
rules) RulesRead
env RulesState
emptyRulesState

    -- Ensure compiler uniqueness
    let ruleSet' :: RuleSet
ruleSet' = RuleSet
ruleSet
            { rulesCompilers :: [(Identifier, Compiler SomeItem)]
rulesCompilers = forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$
                forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const) (RuleSet -> [(Identifier, Compiler SomeItem)]
rulesCompilers RuleSet
ruleSet)
            }

    forall (m :: * -> *) a. Monad m => a -> m a
return RuleSet
ruleSet'
  where
    env :: RulesRead
env = RulesRead
        { rulesProvider :: Provider
rulesProvider = Provider
provider
        , rulesMatches :: [Identifier]
rulesMatches  = []
        , rulesVersion :: Maybe String
rulesVersion  = forall a. Maybe a
Nothing
        }