git.iko.soy/hakyll
on master help sign in
Added some tag cloud code.
2648115Jasper Van der Jeugt
src/Text/Hakyll/Tags.hs+30
compare with master
unifiedsplit
@@ -1,14 +1,17 @@
1-- | Module containing some specialized functions to deal with tags.
1-- | Module containing some specialized functions to deal with tags.
2module Text.Hakyll.Tags
2module Text.Hakyll.Tags
3 ( readTagMap
3 ( readTagMap
4+ , renderTagCloud
4 ) where
5 ) where
5
6
6import qualified Data.Map as M
7import qualified Data.Map as M
7import qualified Data.ByteString.Lazy.Char8 as B
8import qualified Data.ByteString.Lazy.Char8 as B
9+import qualified Data.List as L
8import Control.Monad
10import Control.Monad
9
11
10import Text.Hakyll.Util
12import Text.Hakyll.Util
11import Text.Hakyll.Page
13import Text.Hakyll.Page
14+import Control.Arrow
12
15
13-- | Read a tag map. This creates a map from tags to page paths. This function
16-- | Read a tag map. This creates a map from tags to page paths. This function
14-- assumes the tags are located in the `tags` metadata field, separated by
17-- assumes the tags are located in the `tags` metadata field, separated by
@@ -19,3 +22,30 @@ readTagMap paths = foldM addPaths M.empty paths
19 page <- readPage path
22 page <- readPage path
20 let tags = map trim $ split "," $ B.unpack $ getValue ("tags") page
23 let tags = map trim $ split "," $ B.unpack $ getValue ("tags") page
21 return $ foldr (\t -> M.insertWith (++) t [path]) current tags
24 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+