module Text.Hakyll.Tags
( readTagMap
, renderTagCloud
, renderTagLinks
) where
import qualified Data.Map as M
import Data.List (intercalate)
import Control.Monad (foldM)
import Control.Arrow (second)
import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.Context (ContextManipulation, renderValue)
import Text.Hakyll.Render.Internal (finalSubstitute)
import Text.Hakyll.Regex
import Text.Hakyll.Util
import Text.Hakyll.Page
readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath])
readTagMap paths = foldM addPaths M.empty paths
where
addPaths current path = do
page <- readPage path
let tags = map trim $ splitRegex "," $ getValue "tags" page
return $ foldr (flip (M.insertWith (++)) [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) =
finalSubstitute "<a style=\"font-size: $size\" href=\"$url\">$tag</a>" $
M.fromList [ ("size", sizeTag count)
, ("url", urlFunction tag)
, ("tag", tag)
]
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' = intercalate ", "
. map ((\t -> link t $ urlFunction t) . trim)
. splitRegex ","