module Text.Hakyll.Tags
( readTagMap
, renderTagCloud
, renderTagLinks
) where
import qualified Data.Map as M
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (intercalate)
import Control.Monad (foldM)
import Text.Hakyll.Context (ContextManipulation, renderValue)
import Text.Hakyll.Regex
import Text.Hakyll.Util
import Text.Hakyll.Page
import Control.Arrow (second)
readTagMap :: [FilePath] -> IO (M.Map String [FilePath])
readTagMap paths = foldM addPaths M.empty paths
where addPaths current path = do
page <- readPage path
let tags = map trim $ split "," $ B.unpack $ getValue ("tags") page
return $ foldr (\t -> M.insertWith (++) t [path]) current tags
renderTagCloud :: M.Map String [FilePath]
-> (String -> String)
-> Float
-> Float
-> String
renderTagCloud tagMap urlFunction minSize maxSize =
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
renderTagLinks :: (String -> String)
-> ContextManipulation
renderTagLinks urlFunction = renderValue "tags" "tags" renderTagLinks'
where renderTagLinks' = B.pack . intercalate ", "
. map (\t -> link t $ urlFunction t)
. map trim . split "," . B.unpack