summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Core/Identifier/Pattern.hs14
-rw-r--r--src/Hakyll/Core/Rules.hs29
-rw-r--r--src/Hakyll/Core/Rules/Internal.hs4
-rw-r--r--src/Hakyll/Web/Tags.hs2
4 files changed, 26 insertions, 23 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