diff options
Diffstat (limited to 'src/Hakyll/Core/Rules.hs')
-rw-r--r-- | src/Hakyll/Core/Rules.hs | 39 |
1 files changed, 26 insertions, 13 deletions
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index d15b3b9..021af5d 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -15,57 +15,69 @@ module Hakyll.Core.Rules import Control.Applicative (Applicative, (<$>)) import Control.Monad.Writer import Control.Monad.Reader +import Control.Arrow (second) + +import Data.Typeable (Typeable) +import Data.Binary (Binary) import Hakyll.Core.ResourceProvider import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern import Hakyll.Core.Compiler import Hakyll.Core.Route +import Hakyll.Core.CompiledItem +import Hakyll.Core.Writable -- | A collection of rules for the compilation process -- -data RuleSet a = RuleSet +data RuleSet = RuleSet { rulesRoute :: Route - , rulesCompilers :: [(Identifier, Compiler a)] + , rulesCompilers :: [(Identifier, Compiler CompiledItem)] } -instance Monoid (RuleSet a) where +instance Monoid RuleSet where mempty = RuleSet mempty mempty mappend (RuleSet r1 c1) (RuleSet r2 c2) = RuleSet (mappend r1 r2) (mappend c1 c2) -- | The monad used to compose rules -- -newtype RulesM a b = RulesM - { unRulesM :: ReaderT ResourceProvider (Writer (RuleSet a)) b +newtype RulesM a = RulesM + { unRulesM :: ReaderT ResourceProvider (Writer RuleSet) a } deriving (Monad, Functor, Applicative) -- | Simplification of the RulesM type; usually, it will not return any -- result. -- -type Rules a = RulesM a () +type Rules = RulesM () -- | Run a Rules monad, resulting in a 'RuleSet' -- -runRules :: Rules a -> ResourceProvider -> RuleSet a +runRules :: Rules -> ResourceProvider -> RuleSet runRules rules provider = execWriter $ runReaderT (unRulesM rules) provider -- | Add a route -- -addRoute :: Route -> Rules a +addRoute :: Route -> Rules addRoute route' = RulesM $ tell $ RuleSet route' mempty -- | Add a number of compilers -- -addCompilers :: [(Identifier, Compiler a)] -> Rules a -addCompilers compilers = RulesM $ tell $ RuleSet mempty compilers +addCompilers :: (Binary a, Typeable a, Writable a) + => [(Identifier, Compiler a)] + -> Rules +addCompilers compilers = RulesM $ tell $ RuleSet mempty $ + map (second boxCompiler) compilers + where + boxCompiler = fmap (fmap compiledItem) -- | Add a compilation rule -- -- This instructs all resources matching the given pattern to be compiled using -- the given compiler -- -compile :: Pattern -> Compiler a -> Rules a +compile :: (Binary a, Typeable a, Writable a) + => Pattern -> Compiler a -> Rules compile pattern compiler = RulesM $ do identifiers <- matches pattern . resourceList <$> ask unRulesM $ addCompilers $ zip identifiers (repeat compiler) @@ -74,10 +86,11 @@ compile pattern compiler = RulesM $ do -- -- This sets a compiler for the given identifier -- -create :: Identifier -> Compiler a -> RulesM a () +create :: (Binary a, Typeable a, Writable a) + => Identifier -> Compiler a -> Rules create identifier compiler = addCompilers [(identifier, compiler)] -- | Add a route -- -route :: Pattern -> Route -> RulesM a () +route :: Pattern -> Route -> Rules route pattern route' = addRoute $ ifMatch pattern route' |