From 6b6a78ea4163bd6b5f843ca9a671aa29f9c29ad9 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Sat, 25 Dec 2010 19:37:21 +0100
Subject: Add rules module

---
 src/Hakyll/Core/Rules.hs | 83 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 83 insertions(+)
 create mode 100644 src/Hakyll/Core/Rules.hs

diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
new file mode 100644
index 0000000..d15b3b9
--- /dev/null
+++ b/src/Hakyll/Core/Rules.hs
@@ -0,0 +1,83 @@
+-- | This module provides a monadic DSL in which the user can specify the
+-- different rules used to run the compilers
+--
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Hakyll.Core.Rules
+    ( RuleSet (..)
+    , RulesM
+    , Rules
+    , runRules
+    , compile
+    , create
+    , route
+    ) where
+
+import Control.Applicative (Applicative, (<$>))
+import Control.Monad.Writer
+import Control.Monad.Reader
+
+import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Identifier
+import Hakyll.Core.Identifier.Pattern
+import Hakyll.Core.Compiler
+import Hakyll.Core.Route
+
+-- | A collection of rules for the compilation process
+--
+data RuleSet a = RuleSet
+    { rulesRoute     :: Route
+    , rulesCompilers :: [(Identifier, Compiler a)]
+    }
+
+instance Monoid (RuleSet a) 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
+    } deriving (Monad, Functor, Applicative)
+
+-- | Simplification of the RulesM type; usually, it will not return any
+-- result.
+--
+type Rules a = RulesM a ()
+
+-- | Run a Rules monad, resulting in a 'RuleSet'
+--
+runRules :: Rules a -> ResourceProvider -> RuleSet a
+runRules rules provider = execWriter $ runReaderT (unRulesM rules) provider
+
+-- | Add a route
+--
+addRoute :: Route -> Rules a
+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
+
+-- | 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 pattern compiler = RulesM $ do
+    identifiers <- matches pattern . resourceList <$> ask
+    unRulesM $ addCompilers $ zip identifiers (repeat compiler)
+
+-- | Add a compilation rule
+--
+-- This sets a compiler for the given identifier
+--
+create :: Identifier -> Compiler a -> RulesM a ()
+create identifier compiler = addCompilers [(identifier, compiler)]
+
+-- | Add a route
+--
+route :: Pattern -> Route -> RulesM a ()
+route pattern route' = addRoute $ ifMatch pattern route'
-- 
cgit v1.2.3