on master help sign in
Merge branch 'dev-metadata-route'
commit151c142960d41833f72d0ac06ee5710a42639384 authorJasper Van der Jeugt <m@jaspervdj.be> dateSun 24 Feb 2013, 11:37 (14 years ago) parent5ec7f264c40cea
5 files changed+73−45
src/Hakyll/Core/Compiler.hs+7−2 src/Hakyll/Core/Routes.hs+33−19 src/Hakyll/Core/Runtime.hs+5−4 tests/Hakyll/Core/Routes/Tests.hs+19−13 tests/Hakyll/Core/Rules/Tests.hs+9−7
src/Hakyll/Core/Compiler.hs+7−2
@@ -39,6 +39,7 @@ import System.FilePath (takeExtension)
3939--------------------------------------------------------------------------------
4040import Hakyll.Core.Compiler.Internal
4141import qualified Hakyll.Core.Compiler.Require as Internal
42+import Hakyll.Core.Dependencies
4243import Hakyll.Core.Identifier
4344import Hakyll.Core.Item
4445import Hakyll.Core.Logger as Logger
@@ -71,8 +72,12 @@ makeItem x = do
7172-- | Get the route for a specified item
7273getRoute :: Identifier -> Compiler (Maybe FilePath)
7374getRoute identifier = do
74− routes <- compilerRoutes <$> compilerAsk
75− return $ runRoutes routes identifier
75+ provider <- compilerProvider <$> compilerAsk
76+ routes <- compilerRoutes <$> compilerAsk
77+ -- Note that this makes us dependend on that identifier: when the metadata
78+ -- of that item changes, the route may change, hence we have to recompile
79+ compilerTellDependencies [IdentifierDependency identifier]
80+ compilerUnsafeIO $ runRoutes routes provider identifier
7681
7782
7883--------------------------------------------------------------------------------
src/Hakyll/Core/Routes.hs+33−19
@@ -35,36 +35,42 @@ module Hakyll.Core.Routes
3535 , customRoute
3636 , constRoute
3737 , gsubRoute
38+ , metadataRoute
3839 , composeRoutes
3940 ) where
4041
4142
4243--------------------------------------------------------------------------------
43−import Data.Monoid (Monoid, mempty, mappend)
44−import Control.Monad (mplus)
45−import System.FilePath (replaceExtension)
44+import Data.Monoid (Monoid, mappend, mempty)
45+import System.FilePath (replaceExtension)
4646
4747
4848--------------------------------------------------------------------------------
49−import Hakyll.Core.Identifier
50−import Hakyll.Core.Identifier.Pattern
51−import Hakyll.Core.Util.String
49+import Hakyll.Core.Identifier
50+import Hakyll.Core.Identifier.Pattern
51+import Hakyll.Core.Metadata
52+import Hakyll.Core.Provider
53+import Hakyll.Core.Util.String
5254
5355
5456--------------------------------------------------------------------------------
5557-- | Type used for a route
56−newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath}
58+newtype Routes = Routes
59+ { unRoutes :: Provider -> Identifier -> IO (Maybe FilePath)
60+ }
5761
5862
5963--------------------------------------------------------------------------------
6064instance Monoid Routes where
61− mempty = Routes $ const Nothing
62− mappend (Routes f) (Routes g) = Routes $ \id' -> f id' `mplus` g id'
65+ mempty = Routes $ \_ _ -> return Nothing
66+ mappend (Routes f) (Routes g) = Routes $ \p id' -> do
67+ mfp <- f p id'
68+ maybe (g p id') (return . Just) mfp
6369
6470
6571--------------------------------------------------------------------------------
6672-- | Apply a route to an identifier
67−runRoutes :: Routes -> Identifier -> Maybe FilePath
73+runRoutes :: Routes -> Provider -> Identifier -> IO (Maybe FilePath)
6874runRoutes = unRoutes
6975
7076
@@ -72,7 +78,7 @@ runRoutes = unRoutes
7278-- | A route that uses the identifier as filepath. For example, the target with
7379-- ID @foo\/bar@ will be written to the file @foo\/bar@.
7480idRoute :: Routes
75−idRoute = Routes $ Just . toFilePath
81+idRoute = customRoute toFilePath
7682
7783
7884--------------------------------------------------------------------------------
@@ -94,23 +100,23 @@ idRoute = Routes $ Just . toFilePath
94100--
95101-- > Just "posts/the-art-of-trolling.html"
96102setExtension :: String -> Routes
97−setExtension extension = Routes $
98− fmap (`replaceExtension` extension) . unRoutes idRoute
103+setExtension extension = customRoute $
104+ (`replaceExtension` extension) . toFilePath
99105
100106
101107--------------------------------------------------------------------------------
102108-- | Apply the route if the identifier matches the given pattern, fail
103109-- otherwise
104110matchRoute :: Pattern -> Routes -> Routes
105−matchRoute pattern (Routes route) = Routes $ \id' ->
106− if matches pattern id' then route id' else Nothing
111+matchRoute pattern (Routes route) = Routes $ \p id' ->
112+ if matches pattern id' then route p id' else return Nothing
107113
108114
109115--------------------------------------------------------------------------------
110116-- | Create a custom route. This should almost always be used with
111117-- 'matchRoute'
112118customRoute :: (Identifier -> FilePath) -> Routes
113−customRoute f = Routes $ Just . f
119+customRoute f = Routes $ const $ return . Just . f
114120
115121
116122--------------------------------------------------------------------------------
@@ -137,6 +143,14 @@ gsubRoute pattern replacement = customRoute $
137143 replaceAll pattern replacement . toFilePath
138144
139145
146+--------------------------------------------------------------------------------
147+-- | Get access to the metadata in order to determine the route
148+metadataRoute :: (Metadata -> Routes) -> Routes
149+metadataRoute f = Routes $ \p i -> do
150+ metadata <- resourceMetadata p i
151+ unRoutes (f metadata) p i
152+
153+
140154--------------------------------------------------------------------------------
141155-- | Compose routes so that @f \`composeRoutes\` g@ is more or less equivalent
142156-- with @g . f@.
@@ -154,6 +168,6 @@ gsubRoute pattern replacement = customRoute $
154168composeRoutes :: Routes -- ^ First route to apply
155169 -> Routes -- ^ Second route to apply
156170 -> Routes -- ^ Resulting route
157−composeRoutes (Routes f) (Routes g) = Routes $ \i -> do
158− p <- f i
159− g $ fromFilePath p
171+composeRoutes (Routes f) (Routes g) = Routes $ \p i -> do
172+ mfp <- f p i
173+ maybe (return Nothing) (g p . fromFilePath) mfp
src/Hakyll/Core/Runtime.hs+5−4
@@ -219,10 +219,11 @@ chase trail id'
219219 "(you probably want to call makeItem to solve this problem)"
220220
221221 -- Write if necessary
222− case runRoutes routes id' of
223− Nothing -> return ()
224− Just url -> do
225− let path = destinationDirectory config </> url
222+ mroute <- liftIO $ runRoutes routes provider id'
223+ case mroute of
224+ Nothing -> return ()
225+ Just route -> do
226+ let path = destinationDirectory config </> route
226227 liftIO $ makeDirectories path
227228 liftIO $ write path item
228229 Logger.debug logger $ "Routed to " ++ path
tests/Hakyll/Core/Routes/Tests.hs+19−13
@@ -7,7 +7,7 @@ module Hakyll.Core.Routes.Tests
77
88--------------------------------------------------------------------------------
99import Test.Framework (Test, testGroup)
10−import Test.HUnit ((@=?))
10+import Test.HUnit (Assertion, (@=?))
1111
1212
1313--------------------------------------------------------------------------------
@@ -19,19 +19,25 @@ import TestSuite.Util
1919--------------------------------------------------------------------------------
2020tests :: Test
2121tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes"
22− [ Just "foo.html" @=? runRoutes (setExtension "html") "foo"
23− , Just "foo.html" @=? runRoutes (setExtension ".html") "foo"
24− , Just "foo.html" @=? runRoutes (setExtension "html") "foo.markdown"
25− , Just "foo.html" @=? runRoutes (setExtension ".html") "foo.markdown"
22+ [ testRoutes "foo.html" (setExtension "html") "foo"
23+ , testRoutes "foo.html" (setExtension ".html") "foo"
24+ , testRoutes "foo.html" (setExtension "html") "foo.markdown"
25+ , testRoutes "foo.html" (setExtension ".html") "foo.markdown"
2626
27− , Just "neve ro ddo reven" @=?
28− runRoutes (customRoute (reverse . toFilePath )) "never odd or even"
27+ , testRoutes "neve ro ddo reven"
28+ (customRoute (reverse . toFilePath )) "never odd or even"
2929
30− , Just "foo" @=? runRoutes (constRoute "foo") "bar"
30+ , testRoutes "foo" (constRoute "foo") "bar"
3131
32− , Just "tags/bar.xml" @=?
33− runRoutes (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"
34− , Just "tags/bar.xml" @=?
35− runRoutes (gsubRoute "rss/" (const "") `composeRoutes`
36− setExtension "xml") "tags/rss/bar"
32+ , testRoutes "tags/bar.xml" (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"
33+ , testRoutes "tags/bar.xml"
34+ (gsubRoute "rss/" (const "") `composeRoutes` setExtension "xml")
35+ "tags/rss/bar"
3736 ]
37+
38+
39+--------------------------------------------------------------------------------
40+testRoutes :: FilePath -> Routes -> Identifier -> Assertion
41+testRoutes expected r id' = do
42+ route <- runRoutes r (error "Hakyll.Core.Routes.Tests: no provider") id'
43+ Just expected @=? route
tests/Hakyll/Core/Rules/Tests.hs+9−7
@@ -38,16 +38,18 @@ case01 = do
3838 store <- newTestStore
3939 provider <- newTestProvider store
4040 ruleSet <- runRules (rules01 ioref) provider
41− let identifiers = S.fromList $ map fst $ rulesCompilers ruleSet
42− routes = rulesRoutes ruleSet
41+ let identifiers = S.fromList $ map fst $ rulesCompilers ruleSet
42+ routes = rulesRoutes ruleSet
43+ checkRoute ex i =
44+ runRoutes routes provider i >>= \r -> Just ex @=? r
4345
4446 -- Test that we have some identifiers and that the routes work out
4547 assert $ all (`S.member` identifiers) expected
46− Just "example.html" @=? runRoutes routes "example.md"
47− Just "example.md" @=? runRoutes routes (sv "raw" "example.md")
48− Just "example.md" @=? runRoutes routes (sv "nav" "example.md")
49− Just "example.mv1" @=? runRoutes routes (sv "mv1" "example.md")
50− Just "example.mv2" @=? runRoutes routes (sv "mv2" "example.md")
48+ checkRoute "example.html" "example.md"
49+ checkRoute "example.md" (sv "raw" "example.md")
50+ checkRoute "example.md" (sv "nav" "example.md")
51+ checkRoute "example.mv1" (sv "mv1" "example.md")
52+ checkRoute "example.mv2" (sv "mv2" "example.md")
5153 readIORef ioref >>= assert
5254 cleanTestEnv
5355 where