diff options
| -rw-r--r-- | src/Hakyll/Core/Identifier/Pattern.hs | 14 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules.hs | 29 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules/Internal.hs | 4 | ||||
| -rw-r--r-- | src/Hakyll/Web/Tags.hs | 2 | ||||
| -rw-r--r-- | tests/Hakyll/Core/Identifier/Tests.hs | 13 | ||||
| -rw-r--r-- | tests/Hakyll/Core/Runtime/Tests.hs | 2 | ||||
| -rw-r--r-- | web/site.hs | 5 |
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" } |