summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2011-01-17 10:04:09 +0100
committerJasper Van der Jeugt <jaspervdj@gmail.com>2011-01-17 10:04:09 +0100
commite3f8856665befcb8d9d3677b625c8959e68153b0 (patch)
tree8abf136817eb8d85635102408dc693d36875ab79
parentd569ae515606d45b931201cc464fd49b111cb3c9 (diff)
downloadhakyll-e3f8856665befcb8d9d3677b625c8959e68153b0.tar.gz
Add renderTagCloud prototype
-rw-r--r--src/Hakyll/Web/Tags.hs70
1 files changed, 69 insertions, 1 deletions
diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
index cf0d9a5..14aaab5 100644
--- a/src/Hakyll/Web/Tags.hs
+++ b/src/Hakyll/Web/Tags.hs
@@ -1,17 +1,52 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+-- | Module containing some specialized functions to deal with tags.
+-- This Module follows certain conventions. My advice is to stick with them if
+-- possible.
+--
+-- More concrete: all functions in this module assume that the tags are
+-- located in the @tags@ field, and separated by commas. An example file
+-- @foo.markdown@ could look like:
+--
+-- > ---
+-- > author: Philip K. Dick
+-- > title: Do androids dream of electric sheep?
+-- > tags: future, science fiction, humanoid
+-- > ---
+-- > The novel is set in a post-apocalyptic near future, where the Earth and
+-- > its populations have been damaged greatly by Nuclear...
+--
+-- All the following functions would work with such a format. In addition to
+-- tags, Hakyll also supports categories. The convention when using categories
+-- is to place pages in subdirectories.
+--
+-- An example, the page @posts\/coding\/2010-01-28-hakyll-categories.markdown@
+-- Tags or categories are read using the @readTags@ and @readCategories@
+-- functions. This module only provides functions to work with tags:
+-- categories are represented as tags. This is perfectly possible: categories
+-- only have an additional restriction that a page can only have one category
+-- (instead of multiple tags).
+--
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
module Hakyll.Web.Tags
( Tags (..)
, readTagsWith
, readTags
, readCategories
+ , renderTagCloud
) where
import Control.Applicative ((<$>))
import Data.Map (Map)
import qualified Data.Map as M
+import Data.List (intersperse)
+import Control.Arrow (second, (&&&))
import Data.Typeable (Typeable)
import Data.Binary (Binary, get, put)
+import Data.Monoid (mconcat)
+import Text.Blaze.Renderer.String (renderHtml)
+import Text.Blaze (Html, (!), toHtml, toValue)
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as A
import Hakyll.Web.Page
import Hakyll.Web.Util.String
@@ -53,3 +88,36 @@ readTags = readTagsWith $ map trim . splitAll "," . getField "tags"
--
readCategories :: [Page a] -> Tags a
readCategories = readTagsWith $ return . getField "category"
+
+-- | Render a tag cloud in HTML
+--
+renderTagCloud :: (String -> String) -- ^ Function to produce an url for a tag
+ -> Double -- ^ Smallest font size, in percent
+ -> Double -- ^ Biggest font size, in percent
+ -> Tags a -- ^ Tags structure to render
+ -> String -- ^ Resulting HTML
+renderTagCloud urlFunction minSize maxSize (Tags tags) = renderHtml $
+ mconcat $ intersperse " " $ map (uncurry renderTag) withCount
+ where
+ -- Tags composed with their count
+ withCount = map (second $ fromIntegral . length) $ M.toList tags
+
+ -- Render one tag, given it's count
+ renderTag :: String -> Int -> Html
+ renderTag tag count =
+ H.a ! A.style (toValue $ "font-size: " ++ size count)
+ ! A.href (toValue $ urlFunction tag)
+ $ toHtml tag
+
+ -- Show the relative size of one 'count' in percent
+ size count =
+ let size' = floor $ minSize + relative count * (maxSize - minSize)
+ in show (size' :: Int) ++ "%"
+
+ -- Find out the relative count of a tag: on a scale from 0 to 1
+ relative count = (fromIntegral count - minCount) / (maxCount - minCount)
+
+ -- The minimum and maximum count found, as doubles
+ (minCount, maxCount)
+ | null withCount = (0, 1)
+ | otherwise = (minimum &&& maximum) $ map (fromIntegral . snd) withCount