@@ -1,11 +1,11 @@
11--------------------------------------------------------------------------------
2−-- | Module containing some specialized functions to deal with tags.
3−-- This Module follows certain conventions. My advice is to stick with them if
4−-- possible.
2+-- | This module containing some specialized functions to deal with tags. It
3+-- assumes you follow some conventions.
54--
6−-- More concrete: all functions in this module assume that the tags are
7−-- located in the @tags@ field, and separated by commas. An example file
8−-- @foo.markdown@ could look like:
5+-- We support two types of tags: tags and categories.
6+--
7+-- To use default tags, use 'buildTags'. Tags are placed in a comma-separated
8+-- metadata field like this:
99--
1010-- > ---
1111-- > author: Philip K. Dick
@@ -15,26 +15,38 @@
1515-- > The novel is set in a post-apocalyptic near future, where the Earth and
1616-- > its populations have been damaged greatly by Nuclear...
1717--
18−-- All the following functions would work with such a format. In addition to
19−-- tags, Hakyll also supports categories. The convention when using categories
20−-- is to place pages in subdirectories.
18+-- To use categories, use the 'buildCategories' function. Categories are
19+-- determined by the direcetory a page is in, for example, the post
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':
2129--
22−-- An example, the page @posts\/coding\/2010-01-28-hakyll-categories.markdown@
23−-- Tags or categories are read using the @buildTags@ and @buildCategory@
24−-- functions. This module only provides functions to work with tags:
25−-- categories are represented as tags. This is perfectly possible: categories
26−-- only have an additional restriction that a page can only have one category
27−-- (instead of multiple tags).
30+-- > tags/coding.html
31+--
32+-- This is where the first parameter of 'buildTags' and 'buildCategories' comes
33+-- in. In the above case, we used the function:
34+--
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.
2839{-# LANGUAGE Arrows #-}
2940{-# LANGUAGE DeriveDataTypeable #-}
3041{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3142{-# LANGUAGE OverloadedStrings #-}
3243module Hakyll.Web.Tags
33− ( Tags (..)
44+ ( Tags
3445 , getTags
3546 , buildTagsWith
3647 , buildTags
37− , buildCategory
48+ , buildCategories
49+ , tagsRules
3850 , renderTagCloud
3951 , renderTagList
4052 , tagsField
@@ -46,8 +58,7 @@ module Hakyll.Web.Tags
4658
4759--------------------------------------------------------------------------------
4860import Control.Arrow ((&&&))
49−import Control.Monad (foldM, forM)
50−import Data.Binary (Binary)
61+import Control.Monad (foldM, forM, forM_)
5162import Data.Char (toLower)
5263import Data.List (intercalate, intersperse,
5364 sortBy)
@@ -55,7 +66,6 @@ import qualified Data.Map as M
5566import Data.Maybe (catMaybes, fromMaybe)
5667import Data.Monoid (mconcat)
5768import Data.Ord (comparing)
58−import Data.Typeable (Typeable)
5969import System.FilePath (takeBaseName, takeDirectory)
6070import Text.Blaze.Html (toHtml, toValue, (!))
6171import Text.Blaze.Html.Renderer.String (renderHtml)
@@ -69,23 +79,18 @@ import Hakyll.Core.Identifier
6979import Hakyll.Core.Identifier.Pattern
7080import Hakyll.Core.Item
7181import Hakyll.Core.Metadata
82+import Hakyll.Core.Rules
7283import Hakyll.Core.Util.String
73−import Hakyll.Core.Writable
7484import Hakyll.Web.Template.Context
7585import Hakyll.Web.Urls
7686
7787
7888--------------------------------------------------------------------------------
7989-- | Data about tags
80−-- TODO Make this a map instead of a list?
81−newtype Tags = Tags
82− { unTags :: [(String, [Identifier])]
83− } deriving (Binary, Show, Typeable)
84−
85−
86−--------------------------------------------------------------------------------
87−instance Writable Tags where
88− write _ _ = return ()
90+data Tags = Tags
91+ { tagsMap :: [(String, [Identifier])]
92+ , tagsMakeId :: String -> Identifier
93+ } deriving (Show)
8994
9095
9196--------------------------------------------------------------------------------
@@ -105,11 +110,14 @@ getCategory = return . return . takeBaseName . takeDirectory . toFilePath
105110--------------------------------------------------------------------------------
106111-- | Higher-order function to read tags
107112buildTagsWith :: MonadMetadata m
108− => (Identifier -> m [String]) -> Pattern -> m Tags
109−buildTagsWith f pattern = do
113+ => (Identifier -> m [String])
114+ -> Pattern
115+ -> (String -> Identifier)
116+ -> m Tags
117+buildTagsWith f pattern makeId = do
110118 ids <- getMatches pattern
111119 tagMap <- foldM addTags M.empty ids
112− return $ Tags $ M.toList tagMap
120+ return $ Tags (M.toList tagMap) makeId
113121 where
114122 -- Create a tag map for one page
115123 addTags tagMap id' = do
@@ -117,34 +125,42 @@ buildTagsWith f pattern = do
117125 let tagMap' = M.fromList $ zip tags $ repeat [id']
118126 return $ M.unionWith (++) tagMap tagMap'
119127
128+
120129--------------------------------------------------------------------------------
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
123131buildTags = buildTagsWith getTags
124132
125133
126134--------------------------------------------------------------------------------
127−-- | Read a tagmap using the @category@ metadata field
128−buildCategory :: MonadMetadata m => Pattern -> m Tags
129−buildCategory = buildTagsWith getCategory
135+buildCategories :: MonadMetadata m => Pattern -> (String -> Identifier)
136+ -> m Tags
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
130146
131147
132148--------------------------------------------------------------------------------
133149-- | 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)
137151 -- ^ Produce a tag item: tag, url, count, min count, max count
138152 -> ([String] -> String)
139153 -- ^ Join items
140154 -> Tags
141155 -- ^ Tag cloud renderer
142156 -> Compiler String
143−renderTags makeTagId makeHtml concatHtml (Tags tags) = do
157+renderTags makeHtml concatHtml (Tags tags makeTagId) = do
144158 -- In tags' we create a list: [((tag, route), count)]
145159 tags' <- forM tags $ \(tag, ids) -> do
146− route <- getRoute $ makeTagId tag
147− return ((tag, route), length ids)
160+ route' <- getRoute $ makeTagId tag
161+ return ((tag, route'), length ids)
162+
163+ -- TODO: We actually need to tell a dependency here!
148164
149165 let -- Absolute frequencies of the pages
150166 freqs = map snd tags'
@@ -165,9 +181,7 @@ renderTags makeTagId makeHtml concatHtml (Tags tags) = do
165181--------------------------------------------------------------------------------
166182-- | Render a tag cloud in HTML
167183-- TODO: Maybe produce a Context here
168−renderTagCloud :: (String -> Identifier)
169− -- ^ Produce a link for a tag
170− -> Double
184+renderTagCloud :: Double
171185 -- ^ Smallest font size, in percent
172186 -> Double
173187 -- ^ Biggest font size, in percent
@@ -175,8 +189,7 @@ renderTagCloud :: (String -> Identifier)
175189 -- ^ Input tags
176190 -> Compiler String
177191 -- ^ Rendered cloud
178−renderTagCloud makeTagId minSize maxSize =
179− renderTags makeTagId makeLink (intercalate " ")
192+renderTagCloud minSize maxSize = renderTags makeLink (intercalate " ")
180193 where
181194 makeLink tag url count min' max' = renderHtml $
182195 H.a ! A.style (toValue $ "font-size: " ++ size count min' max')
@@ -194,8 +207,8 @@ renderTagCloud makeTagId minSize maxSize =
194207--------------------------------------------------------------------------------
195208-- | Render a simple tag list in HTML, with the tag count next to the item
196209-- TODO: Maybe produce a Context here
197−renderTagList :: (String -> Identifier) -> Tags -> Compiler (String)
198−renderTagList makeTagId = renderTags makeTagId makeLink (intercalate ", ")
210+renderTagList :: Tags -> Compiler (String)
211+renderTagList = renderTags makeLink (intercalate ", ")
199212 where
200213 makeLink tag url count _ _ = renderHtml $
201214 H.a ! A.href (toValue url) $ toHtml (tag ++ " (" ++ show count ++ ")")
@@ -214,8 +227,8 @@ tagsFieldWith :: (Identifier -> Compiler [String]) -- ^ Get the tags
214227tagsFieldWith getTags' key makeTagId = field key $ \item -> do
215228 tags <- getTags' $ itemIdentifier item
216229 links <- forM tags $ \tag -> do
217− route <- getRoute $ makeTagId tag
218− return $ renderLink tag route
230+ route' <- getRoute $ makeTagId tag
231+ return $ renderLink tag route'
219232
220233 return $ renderHtml $ mconcat $ intersperse ", " $ catMaybes $ links
221234 where
@@ -246,7 +259,7 @@ categoryField = tagsFieldWith getCategory
246259-- the comparing function is the actual tag name.
247260sortTagsBy :: ((String, [Identifier]) -> (String, [Identifier]) -> Ordering)
248261 -> Tags -> Tags
249−sortTagsBy f = Tags . sortBy f . unTags
262+sortTagsBy f t = t {tagsMap = sortBy f (tagsMap t)}
250263
251264
252265--------------------------------------------------------------------------------