a8182c9 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Improve tag handling a bit

a8182c9Jasper Van der Jeugt14 years ago

src/Hakyll/Core/Configuration.hs+2−1

compare with master

unifiedsplit

@@ -1,7 +1,8 @@

1--------------------------------------------------------------------------------

2-- | Exports a datastructure for the top-level hakyll configuration

3module Hakyll.Core.Configuration

4+ ( Verbosity (..)

4− ( Configuration (..)

5+ , Configuration (..)

5 , shouldIgnoreFile

6 , shouldIgnoreFile

6 , defaultConfiguration

7 , defaultConfiguration

7 ) where

8 ) where

src/Hakyll/Core/Runtime.hs+1

@@ -175,6 +175,7 @@ chase trail id'

175 routes <- runtimeRoutes <$> ask

176 store <- runtimeStore <$> ask

177 config <- runtimeConfiguration <$> ask

178+ Logger.debug logger $ "Processing " ++ show id'

178

179

179 let compiler = todo M.! id'

180 let compiler = todo M.! id'

180 read' = CompilerRead

181 read' = CompilerRead

src/Hakyll/Web/Tags.hs+67−54

@@ -1,11 +1,11 @@

1--------------------------------------------------------------------------------

2−-- | Module containing some specialized functions to deal with tags.

2+-- | This module containing some specialized functions to deal with tags. It

3−-- This Module follows certain conventions. My advice is to stick with them if

3+-- assumes you follow some conventions.

4−-- possible.

5--

4--

6−-- More concrete: all functions in this module assume that the tags are

5+-- We support two types of tags: tags and categories.

7−-- located in the @tags@ field, and separated by commas. An example file

6+--

8−-- @foo.markdown@ could look like:

7+-- To use default tags, use 'buildTags'. Tags are placed in a comma-separated

8+-- metadata field like this:

9--

10-- > ---

11-- > author: Philip K. Dick

@@ -15,26 +15,38 @@

15-- > The novel is set in a post-apocalyptic near future, where the Earth and

16-- > its populations have been damaged greatly by Nuclear...

17--

18−-- All the following functions would work with such a format. In addition to

18+-- To use categories, use the 'buildCategories' function. Categories are

19−-- tags, Hakyll also supports categories. The convention when using categories

19+-- determined by the direcetory a page is in, for example, the post

20−-- is to place pages in subdirectories.

20+--

21+-- > posts/coding/2010-01-28-hakyll-categories.markdown

22+--

23+-- will receive the @coding@ category.

24+--

25+-- Advanced users may implement custom systems using 'buildTagsWith' if desired.

26+--

27+-- In the above example, we would want to create a page which lists all pages in

28+-- the @coding@ category, for example, with the 'Identifier':

21--

29--

22−-- An example, the page @posts\/coding\/2010-01-28-hakyll-categories.markdown@

30+-- > tags/coding.html

23−-- Tags or categories are read using the @buildTags@ and @buildCategory@

31+--

24−-- functions. This module only provides functions to work with tags:

32+-- This is where the first parameter of 'buildTags' and 'buildCategories' comes

25−-- categories are represented as tags. This is perfectly possible: categories

33+-- in. In the above case, we used the function:

26−-- only have an additional restriction that a page can only have one category

34+--

27−-- (instead of multiple tags).

35+-- > fromCapture "tags/*.html" :: String -> Identifier

36+--

37+-- The 'tagsRules' function lets you generate such a page for each tag in the

38+-- 'Rules' monad.

28{-# LANGUAGE Arrows #-}

39{-# LANGUAGE Arrows #-}

29{-# LANGUAGE DeriveDataTypeable #-}

40{-# LANGUAGE DeriveDataTypeable #-}

30{-# LANGUAGE GeneralizedNewtypeDeriving #-}

41{-# LANGUAGE GeneralizedNewtypeDeriving #-}

31{-# LANGUAGE OverloadedStrings #-}

42{-# LANGUAGE OverloadedStrings #-}

32module Hakyll.Web.Tags

43module Hakyll.Web.Tags

33− ( Tags (..)

44+ ( Tags

34 , getTags

45 , getTags

35 , buildTagsWith

46 , buildTagsWith

36 , buildTags

47 , buildTags

37− , buildCategory

48+ , buildCategories

49+ , tagsRules

38 , renderTagCloud

50 , renderTagCloud

39 , renderTagList

51 , renderTagList

40 , tagsField

52 , tagsField

@@ -46,8 +58,7 @@ module Hakyll.Web.Tags

47--------------------------------------------------------------------------------

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

48import Control.Arrow ((&&&))

60import Control.Arrow ((&&&))

49−import Control.Monad (foldM, forM)

61+import Control.Monad (foldM, forM, forM_)

50−import Data.Binary (Binary)

51import Data.Char (toLower)

62import Data.Char (toLower)

52import Data.List (intercalate, intersperse,

63import Data.List (intercalate, intersperse,

53 sortBy)

64 sortBy)

@@ -55,7 +66,6 @@ import qualified Data.Map as M

55import Data.Maybe (catMaybes, fromMaybe)

66import Data.Maybe (catMaybes, fromMaybe)

56import Data.Monoid (mconcat)

67import Data.Monoid (mconcat)

57import Data.Ord (comparing)

68import Data.Ord (comparing)

58−import Data.Typeable (Typeable)

59import System.FilePath (takeBaseName, takeDirectory)

69import System.FilePath (takeBaseName, takeDirectory)

60import Text.Blaze.Html (toHtml, toValue, (!))

70import Text.Blaze.Html (toHtml, toValue, (!))

61import Text.Blaze.Html.Renderer.String (renderHtml)

71import Text.Blaze.Html.Renderer.String (renderHtml)

@@ -69,23 +79,18 @@ import Hakyll.Core.Identifier

69import Hakyll.Core.Identifier.Pattern

79import Hakyll.Core.Identifier.Pattern

70import Hakyll.Core.Item

80import Hakyll.Core.Item

71import Hakyll.Core.Metadata

81import Hakyll.Core.Metadata

82+import Hakyll.Core.Rules

72import Hakyll.Core.Util.String

83import Hakyll.Core.Util.String

73−import Hakyll.Core.Writable

74import Hakyll.Web.Template.Context

84import Hakyll.Web.Template.Context

75import Hakyll.Web.Urls

85import Hakyll.Web.Urls

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

88--------------------------------------------------------------------------------

79-- | Data about tags

89-- | Data about tags

80−-- TODO Make this a map instead of a list?

81−newtype Tags = Tags

90+data Tags = Tags

82− { unTags :: [(String, [Identifier])]

91+ { tagsMap :: [(String, [Identifier])]

92+ , tagsMakeId :: String -> Identifier

83− } deriving (Binary, Show, Typeable)

93+ } deriving (Show)

84−

85−

86−--------------------------------------------------------------------------------

87−instance Writable Tags where

88− write _ _ = return ()

91--------------------------------------------------------------------------------

96--------------------------------------------------------------------------------

@@ -105,11 +110,14 @@ getCategory = return . return . takeBaseName . takeDirectory . toFilePath

105--------------------------------------------------------------------------------

110--------------------------------------------------------------------------------

106-- | Higher-order function to read tags

111-- | Higher-order function to read tags

107buildTagsWith :: MonadMetadata m

112buildTagsWith :: MonadMetadata m

108− => (Identifier -> m [String]) -> Pattern -> m Tags

113+ => (Identifier -> m [String])

114+ -> Pattern

115+ -> (String -> Identifier)

116+ -> m Tags

109−buildTagsWith f pattern = do

117+buildTagsWith f pattern makeId = do

110 ids <- getMatches pattern

118 ids <- getMatches pattern

111 tagMap <- foldM addTags M.empty ids

119 tagMap <- foldM addTags M.empty ids

112− return $ Tags $ M.toList tagMap

120+ return $ Tags (M.toList tagMap) makeId

113 where

121 where

114 -- Create a tag map for one page

122 -- Create a tag map for one page

115 addTags tagMap id' = do

123 addTags tagMap id' = do

@@ -117,34 +125,42 @@ buildTagsWith f pattern = do

117 let tagMap' = M.fromList $ zip tags $ repeat [id']

125 let tagMap' = M.fromList $ zip tags $ repeat [id']

118 return $ M.unionWith (++) tagMap tagMap'

126 return $ M.unionWith (++) tagMap tagMap'

119

127

128+

120--------------------------------------------------------------------------------

129--------------------------------------------------------------------------------

121−-- | Read a tagmap using the @tags@ metadata field

122−buildTags :: MonadMetadata m => Pattern -> m Tags

130+buildTags :: MonadMetadata m => Pattern -> (String -> Identifier) -> m Tags

123buildTags = buildTagsWith getTags

131buildTags = buildTagsWith getTags

124

132

125

133

126--------------------------------------------------------------------------------

134--------------------------------------------------------------------------------

127−-- | Read a tagmap using the @category@ metadata field

128−buildCategory :: MonadMetadata m => Pattern -> m Tags

135+buildCategories :: MonadMetadata m => Pattern -> (String -> Identifier)

136+ -> m Tags

129−buildCategory = buildTagsWith getCategory

137+buildCategories = buildTagsWith getCategory

138+

139+

140+--------------------------------------------------------------------------------

141+tagsRules :: Tags -> (String -> Pattern -> Rules ()) -> Rules ()

142+tagsRules tags rules =

143+ forM_ (tagsMap tags) $ \(tag, identifiers) ->

144+ match (fromGlob $ toFilePath $ tagsMakeId tags tag) $

145+ rules tag $ fromList identifiers

130

146

131

147

132--------------------------------------------------------------------------------

148--------------------------------------------------------------------------------

133-- | Render tags in HTML

149-- | Render tags in HTML

134−renderTags :: (String -> Identifier)

135− -- ^ Produce a tag page id

136− -> (String -> String -> Int -> Int -> Int -> String)

150+renderTags :: (String -> String -> Int -> Int -> Int -> String)

137 -- ^ Produce a tag item: tag, url, count, min count, max count

151 -- ^ Produce a tag item: tag, url, count, min count, max count

138 -> ([String] -> String)

152 -> ([String] -> String)

139 -- ^ Join items

153 -- ^ Join items

140 -> Tags

154 -> Tags

141 -- ^ Tag cloud renderer

155 -- ^ Tag cloud renderer

142 -> Compiler String

156 -> Compiler String

143−renderTags makeTagId makeHtml concatHtml (Tags tags) = do

157+renderTags makeHtml concatHtml (Tags tags makeTagId) = do

144 -- In tags' we create a list: [((tag, route), count)]

158 -- In tags' we create a list: [((tag, route), count)]

145 tags' <- forM tags $ \(tag, ids) -> do

159 tags' <- forM tags $ \(tag, ids) -> do

146− route <- getRoute $ makeTagId tag

160+ route' <- getRoute $ makeTagId tag

147− return ((tag, route), length ids)

161+ return ((tag, route'), length ids)

162+

163+ -- TODO: We actually need to tell a dependency here!

148

164

149 let -- Absolute frequencies of the pages

165 let -- Absolute frequencies of the pages

150 freqs = map snd tags'

166 freqs = map snd tags'

@@ -165,9 +181,7 @@ renderTags makeTagId makeHtml concatHtml (Tags tags) = do

165--------------------------------------------------------------------------------

181--------------------------------------------------------------------------------

166-- | Render a tag cloud in HTML

182-- | Render a tag cloud in HTML

167-- TODO: Maybe produce a Context here

183-- TODO: Maybe produce a Context here

168−renderTagCloud :: (String -> Identifier)

184+renderTagCloud :: Double

169− -- ^ Produce a link for a tag

170− -> Double

171 -- ^ Smallest font size, in percent

185 -- ^ Smallest font size, in percent

172 -> Double

186 -> Double

173 -- ^ Biggest font size, in percent

187 -- ^ Biggest font size, in percent

@@ -175,8 +189,7 @@ renderTagCloud :: (String -> Identifier)

175 -- ^ Input tags

189 -- ^ Input tags

176 -> Compiler String

190 -> Compiler String

177 -- ^ Rendered cloud

191 -- ^ Rendered cloud

178−renderTagCloud makeTagId minSize maxSize =

179− renderTags makeTagId makeLink (intercalate " ")

192+renderTagCloud minSize maxSize = renderTags makeLink (intercalate " ")

180 where

193 where

181 makeLink tag url count min' max' = renderHtml $

194 makeLink tag url count min' max' = renderHtml $

182 H.a ! A.style (toValue $ "font-size: " ++ size count min' max')

195 H.a ! A.style (toValue $ "font-size: " ++ size count min' max')

@@ -194,8 +207,8 @@ renderTagCloud makeTagId minSize maxSize =

194--------------------------------------------------------------------------------

207--------------------------------------------------------------------------------

195-- | Render a simple tag list in HTML, with the tag count next to the item

208-- | Render a simple tag list in HTML, with the tag count next to the item

196-- TODO: Maybe produce a Context here

209-- TODO: Maybe produce a Context here

197−renderTagList :: (String -> Identifier) -> Tags -> Compiler (String)

210+renderTagList :: Tags -> Compiler (String)

198−renderTagList makeTagId = renderTags makeTagId makeLink (intercalate ", ")

211+renderTagList = renderTags makeLink (intercalate ", ")

199 where

212 where

200 makeLink tag url count _ _ = renderHtml $

213 makeLink tag url count _ _ = renderHtml $

201 H.a ! A.href (toValue url) $ toHtml (tag ++ " (" ++ show count ++ ")")

214 H.a ! A.href (toValue url) $ toHtml (tag ++ " (" ++ show count ++ ")")

@@ -214,8 +227,8 @@ tagsFieldWith :: (Identifier -> Compiler [String]) -- ^ Get the tags

214tagsFieldWith getTags' key makeTagId = field key $ \item -> do

227tagsFieldWith getTags' key makeTagId = field key $ \item -> do

215 tags <- getTags' $ itemIdentifier item

228 tags <- getTags' $ itemIdentifier item

216 links <- forM tags $ \tag -> do

229 links <- forM tags $ \tag -> do

217− route <- getRoute $ makeTagId tag

230+ route' <- getRoute $ makeTagId tag

218− return $ renderLink tag route

231+ return $ renderLink tag route'

219

232

220 return $ renderHtml $ mconcat $ intersperse ", " $ catMaybes $ links

233 return $ renderHtml $ mconcat $ intersperse ", " $ catMaybes $ links

221 where

234 where

@@ -246,7 +259,7 @@ categoryField = tagsFieldWith getCategory

246-- the comparing function is the actual tag name.

259-- the comparing function is the actual tag name.

247sortTagsBy :: ((String, [Identifier]) -> (String, [Identifier]) -> Ordering)

260sortTagsBy :: ((String, [Identifier]) -> (String, [Identifier]) -> Ordering)

248 -> Tags -> Tags

261 -> Tags -> Tags

249−sortTagsBy f = Tags . sortBy f . unTags

262+sortTagsBy f t = t {tagsMap = sortBy f (tagsMap t)}

250

263

251

264

252--------------------------------------------------------------------------------

265--------------------------------------------------------------------------------