@@ -1,14 +1,17 @@
11-- | Module containing some specialized functions to deal with tags.
22module Text.Hakyll.Tags
33 ( readTagMap
4+ , renderTagCloud
45 ) where
56
67import qualified Data.Map as M
78import qualified Data.ByteString.Lazy.Char8 as B
9+import qualified Data.List as L
810import Control.Monad
911
1012import Text.Hakyll.Util
1113import Text.Hakyll.Page
14+import Control.Arrow
1215
1316-- | Read a tag map. This creates a map from tags to page paths. This function
1417-- assumes the tags are located in the `tags` metadata field, separated by
@@ -19,3 +22,30 @@ readTagMap paths = foldM addPaths M.empty paths
1922 page <- readPage path
2023 let tags = map trim $ split "," $ B.unpack $ getValue ("tags") page
2124 return $ foldr (\t -> M.insertWith (++) t [path]) current tags
25+
26+-- | Render a tag cloud.
27+renderTagCloud :: M.Map String [FilePath] -- ^ A tag map as produced by 'readTagMap'.
28+ -> (String -> String) -- ^ Function that produces an url for a tag.
29+ -> Float -- ^ Smallest font size, in percent.
30+ -> Float -- ^ Biggest font size, in percent.
31+ -> String -- ^ Result of the render.
32+renderTagCloud tagMap urlFunction minSize maxSize =
33+ L.intercalate " " $ map renderTag tagCount
34+ where renderTag :: (String, Float) -> String
35+ renderTag (tag, count) = "<a style=\"font-size: "
36+ ++ sizeTag count ++ "\" href=\""
37+ ++ urlFunction tag ++ "\">"
38+ ++ tag ++ "</a>"
39+
40+ sizeTag :: Float -> String
41+ sizeTag count = show size' ++ "%"
42+ where size' :: Int
43+ size' = floor (minSize + (relative count) * (maxSize - minSize))
44+
45+ minCount = minimum $ map snd $ tagCount
46+ maxCount = maximum $ map snd $ tagCount
47+ relative count = (count - minCount) / (maxCount - minCount)
48+
49+ tagCount :: [(String, Float)]
50+ tagCount = map (second $ fromIntegral . length) $ M.toList tagMap
51+