content: --------------------------------------------------------------------------------
  {-# 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
      { rulesProvider :: Provider
      , rulesMatches  :: [Identifier]
      , rulesVersion  :: Maybe String
      }
  
  
  --------------------------------------------------------------------------------
  data RuleSet = RuleSet
      { -- | Accumulated routes
        rulesRoutes    :: Routes
      , -- | Accumulated compilers
        rulesCompilers :: [(Identifier, Compiler SomeItem)]
      , -- | A set of the actually used files
        rulesResources :: Set Identifier
      , -- | A pattern we can use to check if a file *would* be used. This is
        -- needed for the preview server.
        rulesPattern   :: Pattern
      }
  
  
  --------------------------------------------------------------------------------
  instance Semigroup RuleSet where
      (<>) (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =
          RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)
  
  instance Monoid RuleSet where
      mempty  = RuleSet mempty mempty mempty mempty
      mappend = (<>)
  
  
  --------------------------------------------------------------------------------
  data RulesState = RulesState
      { rulesRoute    :: Maybe Routes
      , rulesCompiler :: Maybe (Compiler SomeItem)
      }
  
  
  --------------------------------------------------------------------------------
  emptyRulesState :: RulesState
  emptyRulesState = RulesState Nothing Nothing
  
  
  --------------------------------------------------------------------------------
  -- | The monad used to compose rules
  newtype Rules a = Rules
      { unRules :: RWST RulesRead RuleSet RulesState IO a
      } deriving (Monad, MonadFail, Functor, Applicative)
  
  
  --------------------------------------------------------------------------------
  instance MonadMetadata Rules where
      getMetadata identifier = Rules $ do
          provider <- rulesProvider <$> ask
          liftIO $ resourceMetadata provider identifier
  
      getMatches pattern = Rules $ do
          provider <- rulesProvider <$> ask
          return $ filterMatches pattern $ resourceList provider
  
  
  --------------------------------------------------------------------------------
  -- | Run a Rules monad, resulting in a 'RuleSet'
  runRules :: Rules a -> Provider -> IO RuleSet
  runRules rules provider = do
      (_, _, ruleSet) <- runRWST (unRules rules) env emptyRulesState
  
      -- Ensure compiler uniqueness
      let ruleSet' = ruleSet
              { rulesCompilers = M.toList $
                  M.fromListWith (flip const) (rulesCompilers ruleSet)
              }
  
      return ruleSet'
    where
      env = RulesRead
          { rulesProvider = provider
          , rulesMatches  = []
          , rulesVersion  = Nothing
          }
  