Added some tag cloud code.
This commit is contained in:
parent
beeac9b101
commit
2648115e87
1 changed files with 30 additions and 0 deletions
|
@ -1,14 +1,17 @@
|
|||
-- | Module containing some specialized functions to deal with tags.
|
||||
module Text.Hakyll.Tags
|
||||
( readTagMap
|
||||
, renderTagCloud
|
||||
) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.ByteString.Lazy.Char8 as B
|
||||
import qualified Data.List as L
|
||||
import Control.Monad
|
||||
|
||||
import Text.Hakyll.Util
|
||||
import Text.Hakyll.Page
|
||||
import Control.Arrow
|
||||
|
||||
-- | Read a tag map. This creates a map from tags to page paths. This function
|
||||
-- assumes the tags are located in the `tags` metadata field, separated by
|
||||
|
@ -19,3 +22,30 @@ readTagMap paths = foldM addPaths M.empty paths
|
|||
page <- readPage path
|
||||
let tags = map trim $ split "," $ B.unpack $ getValue ("tags") page
|
||||
return $ foldr (\t -> M.insertWith (++) t [path]) current tags
|
||||
|
||||
-- | Render a tag cloud.
|
||||
renderTagCloud :: M.Map String [FilePath] -- ^ A tag map as produced by 'readTagMap'.
|
||||
-> (String -> String) -- ^ Function that produces an url for a tag.
|
||||
-> Float -- ^ Smallest font size, in percent.
|
||||
-> Float -- ^ Biggest font size, in percent.
|
||||
-> String -- ^ Result of the render.
|
||||
renderTagCloud tagMap urlFunction minSize maxSize =
|
||||
L.intercalate " " $ map renderTag tagCount
|
||||
where renderTag :: (String, Float) -> String
|
||||
renderTag (tag, count) = "<a style=\"font-size: "
|
||||
++ sizeTag count ++ "\" href=\""
|
||||
++ urlFunction tag ++ "\">"
|
||||
++ tag ++ "</a>"
|
||||
|
||||
sizeTag :: Float -> String
|
||||
sizeTag count = show size' ++ "%"
|
||||
where size' :: Int
|
||||
size' = floor (minSize + (relative count) * (maxSize - minSize))
|
||||
|
||||
minCount = minimum $ map snd $ tagCount
|
||||
maxCount = maximum $ map snd $ tagCount
|
||||
relative count = (count - minCount) / (maxCount - minCount)
|
||||
|
||||
tagCount :: [(String, Float)]
|
||||
tagCount = map (second $ fromIntegral . length) $ M.toList tagMap
|
||||
|
||||
|
|
Loading…
Reference in a new issue