2912fcd · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Add metadataRoute

2912fcdJasper Van der Jeugt14 years ago

src/Hakyll/Core/Compiler.hs+7−2

compare with master

unifiedsplit

@@ -39,6 +39,7 @@ import System.FilePath (takeExtension)

39--------------------------------------------------------------------------------

40import Hakyll.Core.Compiler.Internal

41import qualified Hakyll.Core.Compiler.Require as Internal

42+import Hakyll.Core.Dependencies

42import Hakyll.Core.Identifier

43import Hakyll.Core.Identifier

43import Hakyll.Core.Item

44import Hakyll.Core.Item

44import Hakyll.Core.Logger as Logger

45import Hakyll.Core.Logger as Logger

@@ -71,8 +72,12 @@ makeItem x = do

71-- | Get the route for a specified item

72-- | Get the route for a specified item

72getRoute :: Identifier -> Compiler (Maybe FilePath)

73getRoute :: Identifier -> Compiler (Maybe FilePath)

73getRoute identifier = do

74getRoute identifier = do

75+ provider <- compilerProvider <$> compilerAsk

74− routes <- compilerRoutes <$> 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]

75− return $ runRoutes routes identifier

80+ compilerUnsafeIO $ runRoutes routes provider identifier

78--------------------------------------------------------------------------------

83--------------------------------------------------------------------------------

src/Hakyll/Core/Routes.hs+33−19

@@ -35,36 +35,42 @@ module Hakyll.Core.Routes

35 , customRoute

36 , constRoute

37 , gsubRoute

38+ , metadataRoute

38 , composeRoutes

39 , composeRoutes

39 ) where

40 ) where

42--------------------------------------------------------------------------------

43--------------------------------------------------------------------------------

43−import Data.Monoid (Monoid, mempty, mappend)

44+import Data.Monoid (Monoid, mappend, mempty)

44−import Control.Monad (mplus)

45−import System.FilePath (replaceExtension)

45+import System.FilePath (replaceExtension)

48--------------------------------------------------------------------------------

49−import Hakyll.Core.Identifier

49+import Hakyll.Core.Identifier

50−import Hakyll.Core.Identifier.Pattern

50+import Hakyll.Core.Identifier.Pattern

51+import Hakyll.Core.Metadata

52+import Hakyll.Core.Provider

51−import Hakyll.Core.Util.String

53+import Hakyll.Core.Util.String

54--------------------------------------------------------------------------------

56--------------------------------------------------------------------------------

55-- | Type used for a route

57-- | Type used for a route

58+newtype Routes = Routes

56−newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath}

59+ { unRoutes :: Provider -> Identifier -> IO (Maybe FilePath)

60+ }

59--------------------------------------------------------------------------------

63--------------------------------------------------------------------------------

60instance Monoid Routes where

64instance Monoid Routes where

61− mempty = Routes $ const Nothing

65+ mempty = Routes $ \_ _ -> return Nothing

62− mappend (Routes f) (Routes g) = Routes $ \id' -> f id' `mplus` g id'

66+ mappend (Routes f) (Routes g) = Routes $ \p id' -> do

67+ mfp <- f p id'

68+ maybe (g p id') (return . Just) mfp

65--------------------------------------------------------------------------------

71--------------------------------------------------------------------------------

66-- | Apply a route to an identifier

72-- | Apply a route to an identifier

67−runRoutes :: Routes -> Identifier -> Maybe FilePath

73+runRoutes :: Routes -> Provider -> Identifier -> IO (Maybe FilePath)

68runRoutes = unRoutes

74runRoutes = unRoutes

@@ -72,7 +78,7 @@ runRoutes = unRoutes

72-- | A route that uses the identifier as filepath. For example, the target with

78-- | A route that uses the identifier as filepath. For example, the target with

73-- ID @foo\/bar@ will be written to the file @foo\/bar@.

79-- ID @foo\/bar@ will be written to the file @foo\/bar@.

74idRoute :: Routes

80idRoute :: Routes

75−idRoute = Routes $ Just . toFilePath

81+idRoute = customRoute toFilePath

78--------------------------------------------------------------------------------

84--------------------------------------------------------------------------------

@@ -94,23 +100,23 @@ idRoute = Routes $ Just . toFilePath

94--

100--

95-- > Just "posts/the-art-of-trolling.html"

101-- > Just "posts/the-art-of-trolling.html"

96setExtension :: String -> Routes

102setExtension :: String -> Routes

97−setExtension extension = Routes $

103+setExtension extension = customRoute $

98− fmap (`replaceExtension` extension) . unRoutes idRoute

104+ (`replaceExtension` extension) . toFilePath

105

100

106

101--------------------------------------------------------------------------------

107--------------------------------------------------------------------------------

102-- | Apply the route if the identifier matches the given pattern, fail

108-- | Apply the route if the identifier matches the given pattern, fail

103-- otherwise

109-- otherwise

104matchRoute :: Pattern -> Routes -> Routes

110matchRoute :: Pattern -> Routes -> Routes

105−matchRoute pattern (Routes route) = Routes $ \id' ->

111+matchRoute pattern (Routes route) = Routes $ \p id' ->

106− if matches pattern id' then route id' else Nothing

112+ if matches pattern id' then route p id' else return Nothing

107

113

108

114

109--------------------------------------------------------------------------------

115--------------------------------------------------------------------------------

110-- | Create a custom route. This should almost always be used with

116-- | Create a custom route. This should almost always be used with

111-- 'matchRoute'

117-- 'matchRoute'

112customRoute :: (Identifier -> FilePath) -> Routes

118customRoute :: (Identifier -> FilePath) -> Routes

113−customRoute f = Routes $ Just . f

119+customRoute f = Routes $ const $ return . Just . f

114

120

115

121

116--------------------------------------------------------------------------------

122--------------------------------------------------------------------------------

@@ -137,6 +143,14 @@ gsubRoute pattern replacement = customRoute $

137 replaceAll pattern replacement . toFilePath

143 replaceAll pattern replacement . toFilePath

138

144

139

145

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+

140--------------------------------------------------------------------------------

154--------------------------------------------------------------------------------

141-- | Compose routes so that @f \`composeRoutes\` g@ is more or less equivalent

155-- | Compose routes so that @f \`composeRoutes\` g@ is more or less equivalent

142-- with @g . f@.

156-- with @g . f@.

@@ -154,6 +168,6 @@ gsubRoute pattern replacement = customRoute $

154composeRoutes :: Routes -- ^ First route to apply

168composeRoutes :: Routes -- ^ First route to apply

155 -> Routes -- ^ Second route to apply

169 -> Routes -- ^ Second route to apply

156 -> Routes -- ^ Resulting route

170 -> Routes -- ^ Resulting route

157−composeRoutes (Routes f) (Routes g) = Routes $ \i -> do

171+composeRoutes (Routes f) (Routes g) = Routes $ \p i -> do

158− p <- f i

172+ mfp <- f p i

159− g $ fromFilePath p

173+ maybe (return Nothing) (g p . fromFilePath) mfp

src/Hakyll/Core/Runtime.hs+5−4

@@ -218,10 +218,11 @@ chase trail id'

218 "(you probably want to call makeItem to solve this problem)"

219

220 -- Write if necessary

221− case runRoutes routes id' of

221+ mroute <- liftIO $ runRoutes routes provider id'

222+ case mroute of

222− Nothing -> return ()

223+ Nothing -> return ()

223− Just url -> do

224+ Just route -> do

224− let path = destinationDirectory config </> url

225+ let path = destinationDirectory config </> route

225 liftIO $ makeDirectories path

226 liftIO $ makeDirectories path

226 liftIO $ write path item

227 liftIO $ write path item

227 Logger.debug logger $ "Routed to " ++ path

228 Logger.debug logger $ "Routed to " ++ path

tests/Hakyll/Core/Routes/Tests.hs+19−13

@@ -7,7 +7,7 @@ module Hakyll.Core.Routes.Tests

8--------------------------------------------------------------------------------

9import Test.Framework (Test, testGroup)

10−import Test.HUnit ((@=?))

10+import Test.HUnit (Assertion, (@=?))

13--------------------------------------------------------------------------------

@@ -19,19 +19,25 @@ import TestSuite.Util

19--------------------------------------------------------------------------------

20tests :: Test

21tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes"

22− [ Just "foo.html" @=? runRoutes (setExtension "html") "foo"

22+ [ testRoutes "foo.html" (setExtension "html") "foo"

23− , Just "foo.html" @=? runRoutes (setExtension ".html") "foo"

23+ , testRoutes "foo.html" (setExtension ".html") "foo"

24− , Just "foo.html" @=? runRoutes (setExtension "html") "foo.markdown"

24+ , testRoutes "foo.html" (setExtension "html") "foo.markdown"

25− , Just "foo.html" @=? runRoutes (setExtension ".html") "foo.markdown"

25+ , testRoutes "foo.html" (setExtension ".html") "foo.markdown"

27− , Just "neve ro ddo reven" @=?

27+ , testRoutes "neve ro ddo reven"

28− runRoutes (customRoute (reverse . toFilePath )) "never odd or even"

28+ (customRoute (reverse . toFilePath )) "never odd or even"

30− , Just "foo" @=? runRoutes (constRoute "foo") "bar"

30+ , testRoutes "foo" (constRoute "foo") "bar"

32− , Just "tags/bar.xml" @=?

33− runRoutes (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"

32+ , testRoutes "tags/bar.xml" (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"

34− , Just "tags/bar.xml" @=?

33+ , testRoutes "tags/bar.xml"

35− runRoutes (gsubRoute "rss/" (const "") `composeRoutes`

34+ (gsubRoute "rss/" (const "") `composeRoutes` setExtension "xml")

36− setExtension "xml") "tags/rss/bar"

35+ "tags/rss/bar"

37 ]

36 ]

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

@@ -40,16 +40,18 @@ rulesTest = do

40 store <- newTestStore

41 provider <- newTestProvider store

42 ruleSet <- runRules (rules ioref) provider

43− let identifiers = S.fromList $ map fst $ rulesCompilers ruleSet

43+ let identifiers = S.fromList $ map fst $ rulesCompilers ruleSet

44− routes = rulesRoutes ruleSet

44+ routes = rulesRoutes ruleSet

45+ checkRoute ex i =

46+ runRoutes routes provider i >>= \r -> Just ex @=? r

46 -- Test that we have some identifiers and that the routes work out

48 -- Test that we have some identifiers and that the routes work out

47 assert $ all (`S.member` identifiers) expected

49 assert $ all (`S.member` identifiers) expected

48− Just "example.html" @=? runRoutes routes "example.md"

50+ checkRoute "example.html" "example.md"

49− Just "example.md" @=? runRoutes routes (sv "raw" "example.md")

51+ checkRoute "example.md" (sv "raw" "example.md")

50− Just "example.md" @=? runRoutes routes (sv "nav" "example.md")

52+ checkRoute "example.md" (sv "nav" "example.md")

51− Just "example.mv1" @=? runRoutes routes (sv "mv1" "example.md")

53+ checkRoute "example.mv1" (sv "mv1" "example.md")

52− Just "example.mv2" @=? runRoutes routes (sv "mv2" "example.md")

54+ checkRoute "example.mv2" (sv "mv2" "example.md")

53 readIORef ioref >>= assert

55 readIORef ioref >>= assert

54 where

56 where

55 sv g = setVersion (Just g)

57 sv g = setVersion (Just g)