Add preprocess rule

2 files changed, 20 insertions, 3 deletions

diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index 450df83..8037ffb 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -25,6 +25,8 @@ module Hakyll.Core.Rules
     , route
 
       -- * Advanced usage
+    , preprocess
+    , Dependency (..)
     , rulesExtraDependencies
     ) where
 
@@ -33,6 +35,7 @@ module Hakyll.Core.Rules
 import           Control.Applicative            ((<$>))
 import           Control.Monad.Reader           (ask, local)
 import           Control.Monad.State            (get, modify, put)
+import           Control.Monad.Trans            (liftIO)
 import           Control.Monad.Writer           (censor, tell)
 import           Data.Maybe                     (fromMaybe)
 import           Data.Monoid                    (mempty)
@@ -158,6 +161,13 @@ route route' = Rules $ modify $ \s -> s {rulesRoute = Just route'}
 
 
 --------------------------------------------------------------------------------
+-- | Execute an 'IO' action immediately while the rules are being evaluated.
+-- This should be avoided if possible, but occasionally comes in useful.
+preprocess :: IO a -> Rules a
+preprocess = Rules . liftIO
+
+
+--------------------------------------------------------------------------------
 -- | Advanced usage: add extra dependencies to compilers. Basically this is
 -- needed when you're doing unsafe tricky stuff in the rules monad, but you
 -- still want correct builds.
diff --git a/tests/Hakyll/Core/Rules/Tests.hs b/tests/Hakyll/Core/Rules/Tests.hs
index 631e082..d43772d 100644
--- a/tests/Hakyll/Core/Rules/Tests.hs
+++ b/tests/Hakyll/Core/Rules/Tests.hs
@@ -6,6 +6,8 @@ module Hakyll.Core.Rules.Tests
 
 
 --------------------------------------------------------------------------------
+import           Data.IORef                     (IORef, newIORef, readIORef,
+                                                 writeIORef)
 import qualified Data.Set                       as S
 import           Test.Framework                 (Test, testGroup)
 import           Test.Framework.Providers.HUnit (testCase)
@@ -34,9 +36,10 @@ tests = testGroup "Hakyll.Core.Rules.Tests"
 --------------------------------------------------------------------------------
 rulesTest :: Assertion
 rulesTest = do
+    ioref    <- newIORef False
     store    <- newTestStore
     provider <- newTestProvider store
-    ruleSet  <- runRules rules provider
+    ruleSet  <- runRules (rules ioref) provider
     let identifiers = S.fromList $ map fst $ rulesCompilers ruleSet
         routes      = rulesRoutes ruleSet
 
@@ -47,6 +50,7 @@ rulesTest = do
     Just "example.md"   @=? runRoutes routes (sv "nav" "example.md")
     Just "example.mv1"  @=? runRoutes routes (sv "mv1" "example.md")
     Just "example.mv2"  @=? runRoutes routes (sv "mv2" "example.md")
+    readIORef ioref >>= assert
   where
     sv g     = setVersion (Just g)
     expected =
@@ -59,13 +63,16 @@ rulesTest = do
 
 
 --------------------------------------------------------------------------------
-rules :: Rules ()
-rules = do
+rules :: IORef Bool -> Rules ()
+rules ioref = do
     -- Compile some posts
     match "*.md" $ do
         route $ setExtension "html"
         compile pandocCompiler
 
+    -- Yeah. I don't know how else to test this stuff?
+    preprocess $ writeIORef ioref True
+
     -- Compile them, raw
     match "*.md" $ version "raw" $ do
         route idRoute