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

    --------------------------------------------------------------------------------
    import           Control.Monad.Fail             (MonadFail)
    import           Control.Monad.Reader           (ask)
    import           Control.Monad.RWS              (RWST, runRWST)
    import           Control.Monad.Trans            (liftIO)
    import qualified Data.Map                       as M
    #if MIN_VERSION_base(4,9,0)
    import           Data.Semigroup                 (Semigroup (..))
    #endif
    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
        }

    --------------------------------------------------------------------------------
    #if MIN_VERSION_base(4,9,0)
    instance Semigroup RuleSet where
        <> :: RuleSet -> RuleSet -> RuleSet
    (<>) (RuleSet r1 :: Routes
    r1 c1 :: [(Identifier, Compiler SomeItem)]
    c1 s1 :: Set Identifier
    s1 p1 :: Pattern
    p1) (RuleSet r2 :: Routes
    r2 c2 :: [(Identifier, Compiler SomeItem)]
    c2 s2 :: Set Identifier
    s2 p2 :: Pattern
    p2) =
            Routes
    -> [(Identifier, Compiler SomeItem)]
    -> Set Identifier
    -> Pattern
    -> RuleSet
    RuleSet (Routes -> Routes -> Routes
    forall a. Monoid a => a -> a -> a
    mappend Routes
    r1 Routes
    r2) ([(Identifier, Compiler SomeItem)]
    -> [(Identifier, Compiler SomeItem)]
    -> [(Identifier, Compiler SomeItem)]
    forall a. Monoid a => a -> a -> a
    mappend [(Identifier, Compiler SomeItem)]
    c1 [(Identifier, Compiler SomeItem)]
    c2) (Set Identifier -> Set Identifier -> Set Identifier
    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 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
    forall a. Monoid a => a
    mempty
        mappend :: RuleSet -> RuleSet -> RuleSet
    mappend = RuleSet -> RuleSet -> RuleSet
    forall a. Semigroup a => a -> a -> a
    (<>)
    #else
    instance Monoid RuleSet where
        mempty = RuleSet mempty mempty mempty mempty
        mappend (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =
            RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)
    #endif

    --------------------------------------------------------------------------------
    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 Maybe Routes
    forall a. Maybe a
    Nothing Maybe (Compiler SomeItem)
    forall a. Maybe a
    Nothing

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

    --------------------------------------------------------------------------------
    instance MonadMetadata Rules where
        getMetadata :: Identifier -> Rules Metadata
    getMetadata identifier :: Identifier
    identifier = RWST RulesRead RuleSet RulesState IO Metadata -> Rules Metadata
    forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
    Rules (RWST RulesRead RuleSet RulesState IO Metadata -> Rules Metadata)
    -> RWST RulesRead RuleSet RulesState IO Metadata -> Rules Metadata
    forall a b. (a -> b) -> a -> b
    $ do
            Provider
    provider <- RulesRead -> Provider
    rulesProvider (RulesRead -> Provider)
    -> RWST RulesRead RuleSet RulesState IO RulesRead
    -> RWST RulesRead RuleSet RulesState IO Provider
    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
            IO Metadata -> RWST RulesRead RuleSet RulesState IO Metadata
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Metadata -> RWST RulesRead RuleSet RulesState IO Metadata)
    -> IO Metadata -> RWST RulesRead RuleSet RulesState IO Metadata
    forall a b. (a -> b) -> a -> b
    $ Provider -> Identifier -> IO Metadata
    resourceMetadata Provider
    provider Identifier
    identifier

        getMatches :: Pattern -> Rules [Identifier]
    getMatches pattern :: Pattern
    pattern = RWST RulesRead RuleSet RulesState IO [Identifier]
    -> Rules [Identifier]
    forall a. RWST RulesRead RuleSet RulesState IO a -> Rules a
    Rules (RWST RulesRead RuleSet RulesState IO [Identifier]
     -> Rules [Identifier])
    -> RWST RulesRead RuleSet RulesState IO [Identifier]
    -> Rules [Identifier]
    forall a b. (a -> b) -> a -> b
    $ do
            Provider
    provider <- RulesRead -> Provider
    rulesProvider (RulesRead -> Provider)
    -> RWST RulesRead RuleSet RulesState IO RulesRead
    -> RWST RulesRead RuleSet RulesState IO Provider
    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
            [Identifier] -> RWST RulesRead RuleSet RulesState IO [Identifier]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Identifier] -> RWST RulesRead RuleSet RulesState IO [Identifier])
    -> [Identifier]
    -> RWST RulesRead RuleSet RulesState IO [Identifier]
    forall a b. (a -> b) -> a -> b
    $ Pattern -> [Identifier] -> [Identifier]
    filterMatches Pattern
    pattern ([Identifier] -> [Identifier]) -> [Identifier] -> [Identifier]
    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 :: Rules a -> Provider -> IO RuleSet
    runRules rules :: Rules a
    rules provider :: Provider
    provider = do
        (_, _, ruleSet :: RuleSet
    ruleSet) <- RWST RulesRead RuleSet RulesState IO a
    -> RulesRead -> RulesState -> IO (a, RulesState, RuleSet)
    forall r w s (m :: * -> *) a.
    RWST r w s m a -> r -> s -> m (a, s, w)
    runRWST (Rules a -> RWST RulesRead RuleSet RulesState IO a
    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 = Map Identifier (Compiler SomeItem)
    -> [(Identifier, Compiler SomeItem)]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map Identifier (Compiler SomeItem)
     -> [(Identifier, Compiler SomeItem)])
    -> Map Identifier (Compiler SomeItem)
    -> [(Identifier, Compiler SomeItem)]
    forall a b. (a -> b) -> a -> b
    $
                    (Compiler SomeItem -> Compiler SomeItem -> Compiler SomeItem)
    -> [(Identifier, Compiler SomeItem)]
    -> Map Identifier (Compiler SomeItem)
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    M.fromListWith ((Compiler SomeItem -> Compiler SomeItem -> Compiler SomeItem)
    -> Compiler SomeItem -> Compiler SomeItem -> Compiler SomeItem
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Compiler SomeItem -> Compiler SomeItem -> Compiler SomeItem
    forall a b. a -> b -> a
    const) (RuleSet -> [(Identifier, Compiler SomeItem)]
    rulesCompilers RuleSet
    ruleSet)
                }

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