diff options
author | Jasper Van der Jeugt <m@jaspervdj.be> | 2017-06-19 11:57:23 +0200 |
---|---|---|
committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2017-06-19 11:57:23 +0200 |
commit | 67ecff7ad383640bc73d64edc2506c7cc648a134 (patch) | |
tree | 6d328e43c3ab86c29a2d775fabaa23618c16fb51 /src/Hakyll/Core/Rules/Internal.hs | |
parent | 2df3209bafa08e6b77ee4a8598fc503269513527 (diff) | |
download | hakyll-67ecff7ad383640bc73d64edc2506c7cc648a134.tar.gz |
Move src/ to lib/, put Init.hs in src/
Diffstat (limited to 'src/Hakyll/Core/Rules/Internal.hs')
-rw-r--r-- | src/Hakyll/Core/Rules/Internal.hs | 109 |
1 files changed, 0 insertions, 109 deletions
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs deleted file mode 100644 index 0641dcf..0000000 --- a/src/Hakyll/Core/Rules/Internal.hs +++ /dev/null @@ -1,109 +0,0 @@ --------------------------------------------------------------------------------- -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE Rank2Types #-} -module Hakyll.Core.Rules.Internal - ( RulesRead (..) - , RuleSet (..) - , RulesState (..) - , emptyRulesState - , Rules (..) - , runRules - ) where - - --------------------------------------------------------------------------------- -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 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) - - --------------------------------------------------------------------------------- -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, 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 - } |