@@ -1,17 +1,52 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
1+-- | Module containing some specialized functions to deal with tags.
2+-- This Module follows certain conventions. My advice is to stick with them if
3+-- possible.
4+--
5+-- More concrete: all functions in this module assume that the tags are
6+-- located in the @tags@ field, and separated by commas. An example file
7+-- @foo.markdown@ could look like:
8+--
9+-- > ---
10+-- > author: Philip K. Dick
11+-- > title: Do androids dream of electric sheep?
12+-- > tags: future, science fiction, humanoid
13+-- > ---
14+-- > The novel is set in a post-apocalyptic near future, where the Earth and
15+-- > its populations have been damaged greatly by Nuclear...
16+--
17+-- All the following functions would work with such a format. In addition to
18+-- tags, Hakyll also supports categories. The convention when using categories
19+-- is to place pages in subdirectories.
20+--
21+-- An example, the page @posts\/coding\/2010-01-28-hakyll-categories.markdown@
22+-- Tags or categories are read using the @readTags@ and @readCategories@
23+-- functions. This module only provides functions to work with tags:
24+-- categories are represented as tags. This is perfectly possible: categories
25+-- only have an additional restriction that a page can only have one category
26+-- (instead of multiple tags).
27+--
28+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
229module Hakyll.Web.Tags
330 ( Tags (..)
431 , readTagsWith
532 , readTags
633 , readCategories
34+ , renderTagCloud
735 ) where
836
937import Control.Applicative ((<$>))
1038import Data.Map (Map)
1139import qualified Data.Map as M
40+import Data.List (intersperse)
41+import Control.Arrow (second, (&&&))
1242
1343import Data.Typeable (Typeable)
1444import Data.Binary (Binary, get, put)
45+import Data.Monoid (mconcat)
46+import Text.Blaze.Renderer.String (renderHtml)
47+import Text.Blaze (Html, (!), toHtml, toValue)
48+import qualified Text.Blaze.Html5 as H
49+import qualified Text.Blaze.Html5.Attributes as A
1550
1651import Hakyll.Web.Page
1752import Hakyll.Web.Util.String
@@ -53,3 +88,36 @@ readTags = readTagsWith $ map trim . splitAll "," . getField "tags"
5388--
5489readCategories :: [Page a] -> Tags a
5590readCategories = readTagsWith $ return . getField "category"
91+
92+-- | Render a tag cloud in HTML
93+--
94+renderTagCloud :: (String -> String) -- ^ Function to produce an url for a tag
95+ -> Double -- ^ Smallest font size, in percent
96+ -> Double -- ^ Biggest font size, in percent
97+ -> Tags a -- ^ Tags structure to render
98+ -> String -- ^ Resulting HTML
99+renderTagCloud urlFunction minSize maxSize (Tags tags) = renderHtml $
100+ mconcat $ intersperse " " $ map (uncurry renderTag) withCount
101+ where
102+ -- Tags composed with their count
103+ withCount = map (second $ fromIntegral . length) $ M.toList tags
104+
105+ -- Render one tag, given it's count
106+ renderTag :: String -> Int -> Html
107+ renderTag tag count =
108+ H.a ! A.style (toValue $ "font-size: " ++ size count)
109+ ! A.href (toValue $ urlFunction tag)
110+ $ toHtml tag
111+
112+ -- Show the relative size of one 'count' in percent
113+ size count =
114+ let size' = floor $ minSize + relative count * (maxSize - minSize)
115+ in show (size' :: Int) ++ "%"
116+
117+ -- Find out the relative count of a tag: on a scale from 0 to 1
118+ relative count = (fromIntegral count - minCount) / (maxCount - minCount)
119+
120+ -- The minimum and maximum count found, as doubles
121+ (minCount, maxCount)
122+ | null withCount = (0, 1)
123+ | otherwise = (minimum &&& maximum) $ map (fromIntegral . snd) withCount