diff options
| -rw-r--r-- | src/Text/Hakyll/Tags.hs | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs index 98fda86..ff373eb 100644 --- a/src/Text/Hakyll/Tags.hs +++ b/src/Text/Hakyll/Tags.hs @@ -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 + |