summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt <m@jaspervdj.be>2013-02-24 11:37:24 +0100
committerJasper Van der Jeugt <m@jaspervdj.be>2013-02-24 11:37:24 +0100
commit151c142960d41833f72d0ac06ee5710a42639384 (patch)
tree2e332303a581f694169aa3aedfc5e06975959efd
parent5ec7f26b2995b45e17cf8e9a459004d8a7044e1b (diff)
parent4c40cea9e1ddef01e25f135656551ef8d494cffb (diff)
downloadhakyll-151c142960d41833f72d0ac06ee5710a42639384.tar.gz
Merge branch 'dev-metadata-route'
-rw-r--r--src/Hakyll/Core/Compiler.hs9
-rw-r--r--src/Hakyll/Core/Routes.hs52
-rw-r--r--src/Hakyll/Core/Runtime.hs9
-rw-r--r--tests/Hakyll/Core/Routes/Tests.hs32
-rw-r--r--tests/Hakyll/Core/Rules/Tests.hs16
5 files changed, 73 insertions, 45 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index b23b69b..b711719 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -39,6 +39,7 @@ import System.FilePath (takeExtension)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler.Internal
import qualified Hakyll.Core.Compiler.Require as Internal
+import Hakyll.Core.Dependencies
import Hakyll.Core.Identifier
import Hakyll.Core.Item
import Hakyll.Core.Logger as Logger
@@ -71,8 +72,12 @@ makeItem x = do
-- | Get the route for a specified item
getRoute :: Identifier -> Compiler (Maybe FilePath)
getRoute identifier = do
- routes <- compilerRoutes <$> compilerAsk
- return $ runRoutes routes identifier
+ provider <- compilerProvider <$> compilerAsk
+ routes <- compilerRoutes <$> compilerAsk
+ -- Note that this makes us dependend on that identifier: when the metadata
+ -- of that item changes, the route may change, hence we have to recompile
+ compilerTellDependencies [IdentifierDependency identifier]
+ compilerUnsafeIO $ runRoutes routes provider identifier
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs
index f653fa5..fe5fb1f 100644
--- a/src/Hakyll/Core/Routes.hs
+++ b/src/Hakyll/Core/Routes.hs
@@ -35,36 +35,42 @@ module Hakyll.Core.Routes
, customRoute
, constRoute
, gsubRoute
+ , metadataRoute
, composeRoutes
) where
--------------------------------------------------------------------------------
-import Data.Monoid (Monoid, mempty, mappend)
-import Control.Monad (mplus)
-import System.FilePath (replaceExtension)
+import Data.Monoid (Monoid, mappend, mempty)
+import System.FilePath (replaceExtension)
--------------------------------------------------------------------------------
-import Hakyll.Core.Identifier
-import Hakyll.Core.Identifier.Pattern
-import Hakyll.Core.Util.String
+import Hakyll.Core.Identifier
+import Hakyll.Core.Identifier.Pattern
+import Hakyll.Core.Metadata
+import Hakyll.Core.Provider
+import Hakyll.Core.Util.String
--------------------------------------------------------------------------------
-- | Type used for a route
-newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath}
+newtype Routes = Routes
+ { unRoutes :: Provider -> Identifier -> IO (Maybe FilePath)
+ }
--------------------------------------------------------------------------------
instance Monoid Routes where
- mempty = Routes $ const Nothing
- mappend (Routes f) (Routes g) = Routes $ \id' -> f id' `mplus` g id'
+ mempty = Routes $ \_ _ -> return Nothing
+ mappend (Routes f) (Routes g) = Routes $ \p id' -> do
+ mfp <- f p id'
+ maybe (g p id') (return . Just) mfp
--------------------------------------------------------------------------------
-- | Apply a route to an identifier
-runRoutes :: Routes -> Identifier -> Maybe FilePath
+runRoutes :: Routes -> Provider -> Identifier -> IO (Maybe FilePath)
runRoutes = unRoutes
@@ -72,7 +78,7 @@ runRoutes = unRoutes
-- | A route that uses the identifier as filepath. For example, the target with
-- ID @foo\/bar@ will be written to the file @foo\/bar@.
idRoute :: Routes
-idRoute = Routes $ Just . toFilePath
+idRoute = customRoute toFilePath
--------------------------------------------------------------------------------
@@ -94,23 +100,23 @@ idRoute = Routes $ Just . toFilePath
--
-- > Just "posts/the-art-of-trolling.html"
setExtension :: String -> Routes
-setExtension extension = Routes $
- fmap (`replaceExtension` extension) . unRoutes idRoute
+setExtension extension = customRoute $
+ (`replaceExtension` extension) . toFilePath
--------------------------------------------------------------------------------
-- | Apply the route if the identifier matches the given pattern, fail
-- otherwise
matchRoute :: Pattern -> Routes -> Routes
-matchRoute pattern (Routes route) = Routes $ \id' ->
- if matches pattern id' then route id' else Nothing
+matchRoute pattern (Routes route) = Routes $ \p id' ->
+ if matches pattern id' then route p id' else return Nothing
--------------------------------------------------------------------------------
-- | Create a custom route. This should almost always be used with
-- 'matchRoute'
customRoute :: (Identifier -> FilePath) -> Routes
-customRoute f = Routes $ Just . f
+customRoute f = Routes $ const $ return . Just . f
--------------------------------------------------------------------------------
@@ -138,6 +144,14 @@ gsubRoute pattern replacement = customRoute $
--------------------------------------------------------------------------------
+-- | Get access to the metadata in order to determine the route
+metadataRoute :: (Metadata -> Routes) -> Routes
+metadataRoute f = Routes $ \p i -> do
+ metadata <- resourceMetadata p i
+ unRoutes (f metadata) p i
+
+
+--------------------------------------------------------------------------------
-- | Compose routes so that @f \`composeRoutes\` g@ is more or less equivalent
-- with @g . f@.
--
@@ -154,6 +168,6 @@ gsubRoute pattern replacement = customRoute $
composeRoutes :: Routes -- ^ First route to apply
-> Routes -- ^ Second route to apply
-> Routes -- ^ Resulting route
-composeRoutes (Routes f) (Routes g) = Routes $ \i -> do
- p <- f i
- g $ fromFilePath p
+composeRoutes (Routes f) (Routes g) = Routes $ \p i -> do
+ mfp <- f p i
+ maybe (return Nothing) (g p . fromFilePath) mfp
diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs
index 150cc60..9f27969 100644
--- a/src/Hakyll/Core/Runtime.hs
+++ b/src/Hakyll/Core/Runtime.hs
@@ -219,10 +219,11 @@ chase trail id'
"(you probably want to call makeItem to solve this problem)"
-- Write if necessary
- case runRoutes routes id' of
- Nothing -> return ()
- Just url -> do
- let path = destinationDirectory config </> url
+ mroute <- liftIO $ runRoutes routes provider id'
+ case mroute of
+ Nothing -> return ()
+ Just route -> do
+ let path = destinationDirectory config </> route
liftIO $ makeDirectories path
liftIO $ write path item
Logger.debug logger $ "Routed to " ++ path
diff --git a/tests/Hakyll/Core/Routes/Tests.hs b/tests/Hakyll/Core/Routes/Tests.hs
index 8bdbe85..c14a878 100644
--- a/tests/Hakyll/Core/Routes/Tests.hs
+++ b/tests/Hakyll/Core/Routes/Tests.hs
@@ -7,7 +7,7 @@ module Hakyll.Core.Routes.Tests
--------------------------------------------------------------------------------
import Test.Framework (Test, testGroup)
-import Test.HUnit ((@=?))
+import Test.HUnit (Assertion, (@=?))
--------------------------------------------------------------------------------
@@ -19,19 +19,25 @@ import TestSuite.Util
--------------------------------------------------------------------------------
tests :: Test
tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes"
- [ Just "foo.html" @=? runRoutes (setExtension "html") "foo"
- , Just "foo.html" @=? runRoutes (setExtension ".html") "foo"
- , Just "foo.html" @=? runRoutes (setExtension "html") "foo.markdown"
- , Just "foo.html" @=? runRoutes (setExtension ".html") "foo.markdown"
+ [ testRoutes "foo.html" (setExtension "html") "foo"
+ , testRoutes "foo.html" (setExtension ".html") "foo"
+ , testRoutes "foo.html" (setExtension "html") "foo.markdown"
+ , testRoutes "foo.html" (setExtension ".html") "foo.markdown"
- , Just "neve ro ddo reven" @=?
- runRoutes (customRoute (reverse . toFilePath )) "never odd or even"
+ , testRoutes "neve ro ddo reven"
+ (customRoute (reverse . toFilePath )) "never odd or even"
- , Just "foo" @=? runRoutes (constRoute "foo") "bar"
+ , testRoutes "foo" (constRoute "foo") "bar"
- , Just "tags/bar.xml" @=?
- runRoutes (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"
- , Just "tags/bar.xml" @=?
- runRoutes (gsubRoute "rss/" (const "") `composeRoutes`
- setExtension "xml") "tags/rss/bar"
+ , testRoutes "tags/bar.xml" (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"
+ , testRoutes "tags/bar.xml"
+ (gsubRoute "rss/" (const "") `composeRoutes` setExtension "xml")
+ "tags/rss/bar"
]
+
+
+--------------------------------------------------------------------------------
+testRoutes :: FilePath -> Routes -> Identifier -> Assertion
+testRoutes expected r id' = do
+ route <- runRoutes r (error "Hakyll.Core.Routes.Tests: no provider") id'
+ Just expected @=? route
diff --git a/tests/Hakyll/Core/Rules/Tests.hs b/tests/Hakyll/Core/Rules/Tests.hs
index 47d3b3b..6461b9d 100644
--- a/tests/Hakyll/Core/Rules/Tests.hs
+++ b/tests/Hakyll/Core/Rules/Tests.hs
@@ -38,16 +38,18 @@ case01 = do
store <- newTestStore
provider <- newTestProvider store
ruleSet <- runRules (rules01 ioref) provider
- let identifiers = S.fromList $ map fst $ rulesCompilers ruleSet
- routes = rulesRoutes ruleSet
+ let identifiers = S.fromList $ map fst $ rulesCompilers ruleSet
+ routes = rulesRoutes ruleSet
+ checkRoute ex i =
+ runRoutes routes provider i >>= \r -> Just ex @=? r
-- Test that we have some identifiers and that the routes work out
assert $ all (`S.member` identifiers) expected
- Just "example.html" @=? runRoutes routes "example.md"
- Just "example.md" @=? runRoutes routes (sv "raw" "example.md")
- 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")
+ checkRoute "example.html" "example.md"
+ checkRoute "example.md" (sv "raw" "example.md")
+ checkRoute "example.md" (sv "nav" "example.md")
+ checkRoute "example.mv1" (sv "mv1" "example.md")
+ checkRoute "example.mv2" (sv "mv2" "example.md")
readIORef ioref >>= assert
cleanTestEnv
where