Add create in addition to match

7 files changed, 30 insertions, 39 deletions

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
@@ -235,19 +234,6 @@ 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
 matches Everything     _ = True
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
         }
 
diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
index bf2b9d7..4566db6 100644
--- a/src/Hakyll/Web/Tags.hs
+++ b/src/Hakyll/Web/Tags.hs
@@ -143,7 +143,7 @@ buildCategories = buildTagsWith getCategory
 tagsRules :: Tags -> (String -> Pattern -> Rules ()) -> Rules ()
 tagsRules tags rules =
     forM_ (tagsMap tags) $ \(tag, identifiers) ->
-        match (fromGlob $ toFilePath $ tagsMakeId tags tag) $
+        create [tagsMakeId tags tag] $
             rulesExtraDependencies [tagsDependency tags] $
                 rules tag $ fromList identifiers
 
diff --git a/tests/Hakyll/Core/Identifier/Tests.hs b/tests/Hakyll/Core/Identifier/Tests.hs
index 8a8ed7c..2518022 100644
--- a/tests/Hakyll/Core/Identifier/Tests.hs
+++ b/tests/Hakyll/Core/Identifier/Tests.hs
@@ -6,7 +6,6 @@ module Hakyll.Core.Identifier.Tests
 
 
 --------------------------------------------------------------------------------
-import           Data.Monoid                    (mappend, mempty)
 import           Test.Framework                 (Test, testGroup)
 import           Test.HUnit                     ((@=?))
 
@@ -20,22 +19,12 @@ import           TestSuite.Util
 --------------------------------------------------------------------------------
 tests :: Test
 tests = testGroup "Hakyll.Core.Identifier.Tests" $ concat
-    [ isLiteralTests
-    , captureTests
+    [ captureTests
     , matchesTests
     ]
 
 
 --------------------------------------------------------------------------------
-isLiteralTests :: [Test]
-isLiteralTests = fromAssertions "isLiteral"
-    [ Just "index.html" @=? fromLiteral "index.html"
-    , Nothing           @=? fromLiteral "posts/*.markdown"
-    , Just "test.txt"   @=? fromLiteral ("test.txt" `mappend` mempty)
-    ]
-
-
---------------------------------------------------------------------------------
 captureTests :: [Test]
 captureTests = fromAssertions "capture"
     [ Just ["bar"]              @=? capture "foo/**" "foo/bar"
diff --git a/tests/Hakyll/Core/Runtime/Tests.hs b/tests/Hakyll/Core/Runtime/Tests.hs
index fa1446f..4b41bf5 100644
--- a/tests/Hakyll/Core/Runtime/Tests.hs
+++ b/tests/Hakyll/Core/Runtime/Tests.hs
@@ -34,7 +34,7 @@ case01 = withTestConfiguration $ \config -> do
                     >>= saveSnapshot "raw"
                     >>= return . renderPandoc
 
-        match "bodies.txt" $ do
+        create ["bodies.txt"] $ do
             route idRoute
             compile $ do
                 items <- loadAllSnapshots "*.md" "raw"
diff --git a/web/site.hs b/web/site.hs
index aac6368..79578dd 100644
--- a/web/site.hs
+++ b/web/site.hs
@@ -48,7 +48,7 @@ main = hakyllWith config $ do
             >>= relativizeUrls
 
     -- Tutorial list
-    match "tutorials.html" $ do
+    create ["tutorials.html"] $ do
         route idRoute
         compile $ do
             tutorials <- loadAll "tutorials/*"
@@ -79,8 +79,7 @@ main = hakyllWith config $ do
 --------------------------------------------------------------------------------
 config :: Configuration
 config = defaultConfiguration
-    { verbosity     = Debug
-    , deployCommand = "rsync --checksum -ave 'ssh -p 2222' \
+    { deployCommand = "rsync --checksum -ave 'ssh -p 2222' \
                       \_site/* jaspervdj@jaspervdj.be:jaspervdj.be/tmp/hakyll4"
     }