From 18b6ac5ad42e50e75b9ee9fcfc8aef00f5a00957 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <m@jaspervdj.be>
Date: Sun, 6 Jan 2013 09:51:09 +0100
Subject: Add create in addition to match

---
 src/Hakyll/Core/Identifier/Pattern.hs | 14 --------------
 src/Hakyll/Core/Rules.hs              | 29 +++++++++++++++++++++++------
 src/Hakyll/Core/Rules/Internal.hs     |  4 ++--
 3 files changed, 25 insertions(+), 22 deletions(-)

(limited to 'src/Hakyll/Core')

diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
index 3a07219..fb9c4b8 100644
--- a/src/Hakyll/Core/Identifier/Pattern.hs
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -44,7 +44,6 @@ module Hakyll.Core.Identifier.Pattern
     , complement
     , withVersion
     , noVersion
-    , fromLiteral
 
       -- * Applying patterns
     , matches
@@ -234,19 +233,6 @@ noVersion :: Pattern -> Pattern
 noVersion p = optimize $ And p $ fromVersion Nothing
 
 
---------------------------------------------------------------------------------
--- | Check if a pattern is a literal. @\"*.markdown\"@ is not a literal but
--- @\"posts.markdown\"@ is.
-fromLiteral :: Pattern -> Maybe Identifier
-fromLiteral pattern = case pattern of
-    Glob p -> fmap fromFilePath $ foldr fromLiteral' (Just "") p
-    _      -> Nothing
-  where
-    fromLiteral' (Literal x) (Just y) = Just $ x ++ y
-    fromLiteral' _           _        = Nothing
-
-
-
 --------------------------------------------------------------------------------
 -- | Check if an identifier matches a pattern
 matches :: Pattern -> Identifier -> Bool
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index 8231422..450df83 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -19,6 +19,7 @@
 module Hakyll.Core.Rules
     ( Rules
     , match
+    , create
     , version
     , compile
     , route
@@ -34,7 +35,7 @@ import           Control.Monad.Reader           (ask, local)
 import           Control.Monad.State            (get, modify, put)
 import           Control.Monad.Writer           (censor, tell)
 import           Data.Maybe                     (fromMaybe)
-import           Data.Monoid                    (mappend, mempty)
+import           Data.Monoid                    (mempty)
 import qualified Data.Set                       as S
 
 
@@ -82,15 +83,21 @@ flush = Rules $ do
     case mcompiler of
         Nothing       -> return ()
         Just compiler -> do
-            pattern  <- rulesPattern                  <$> ask
+            matches' <- rulesMatches                  <$> ask
             version' <- rulesVersion                  <$> ask
             route'   <- fromMaybe mempty . rulesRoute <$> get
+
+            -- The version is possibly not set correctly at this point (yet)
+            let ids = map (setVersion version') matches'
+
+            {-
             ids      <- case fromLiteral pattern of
                 Just id' -> return [setVersion version' id']
                 Nothing  -> do
                     ids <- unRules $ getMatches pattern
                     unRules $ tellResources ids
                     return $ map (setVersion version') ids
+            -}
 
             -- Create a fast pattern for routing that matches exactly the
             -- compilers created in the block given to match
@@ -107,11 +114,21 @@ flush = Rules $ do
 match :: Pattern -> Rules () -> Rules ()
 match pattern rules = do
     flush
-    Rules $ local addPattern $ unRules $ rules >> flush
+    ids <- getMatches pattern
+    tellResources ids
+    Rules $ local (setMatches ids) $ unRules $ rules >> flush
   where
-    addPattern env = env
-        { rulesPattern = rulesPattern env `mappend` pattern
-        }
+    setMatches ids env = env {rulesMatches = ids}
+
+
+--------------------------------------------------------------------------------
+create :: [Identifier] -> Rules () -> Rules ()
+create ids rules = do
+    flush
+    -- TODO Maybe check if the resources exist and call tellResources on that
+    Rules $ local setMatches $ unRules $ rules >> flush
+  where
+    setMatches env = env {rulesMatches = ids}
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs
index 825edf4..10ca919 100644
--- a/src/Hakyll/Core/Rules/Internal.hs
+++ b/src/Hakyll/Core/Rules/Internal.hs
@@ -34,7 +34,7 @@ import           Hakyll.Core.Routes
 --------------------------------------------------------------------------------
 data RulesRead = RulesRead
     { rulesProvider :: Provider
-    , rulesPattern  :: Pattern
+    , rulesMatches  :: [Identifier]
     , rulesVersion  :: Maybe String
     }
 
@@ -96,7 +96,7 @@ runRules rules provider = do
   where
     env = RulesRead
         { rulesProvider = provider
-        , rulesPattern  = mempty
+        , rulesMatches  = []
         , rulesVersion  = Nothing
         }
 
-- 
cgit v1.2.3