summaryrefslogtreecommitdiff
path: root/src/Hakyll/Core/Rules
diff options
context:
space:
mode:
authorJasper Van der Jeugt <m@jaspervdj.be>2017-06-19 11:57:23 +0200
committerJasper Van der Jeugt <m@jaspervdj.be>2017-06-19 11:57:23 +0200
commit67ecff7ad383640bc73d64edc2506c7cc648a134 (patch)
tree6d328e43c3ab86c29a2d775fabaa23618c16fb51 /src/Hakyll/Core/Rules
parent2df3209bafa08e6b77ee4a8598fc503269513527 (diff)
downloadhakyll-67ecff7ad383640bc73d64edc2506c7cc648a134.tar.gz
Move src/ to lib/, put Init.hs in src/
Diffstat (limited to 'src/Hakyll/Core/Rules')
-rw-r--r--src/Hakyll/Core/Rules/Internal.hs109
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
- }