@@ -33,6 +33,7 @@ module Text.Hakyll.Tags
3333 ( TagMap
3434 , readTagMap
3535 , readCategoryMap
36+ , withTagMap
3637 , renderTagCloud
3738 , renderTagLinks
3839 ) where
@@ -41,12 +42,12 @@ import qualified Data.Map as M
4142import Data.List (intercalate)
4243import Data.Maybe (fromMaybe, maybeToList)
4344import Control.Monad (foldM)
44−import Control.Arrow (second)
45+import Control.Arrow (second, (>>>))
4546import Control.Applicative ((<$>))
4647import System.FilePath
4748
4849import Text.Hakyll.Context
49−import Text.Hakyll.Hakyll
50+import Text.Hakyll.Hakyll (Hakyll)
5051import Text.Hakyll.Regex
5152import Text.Hakyll.Renderables
5253import Text.Hakyll.RenderAction
@@ -77,14 +78,16 @@ readMap getTagsFunction identifier paths = RenderAction
7778
7879 actionFunction' _ = do
7980 isCacheMoreRecent' <- isCacheMoreRecent fileName paths
80− if isCacheMoreRecent' then M.fromAscList <$> getFromCache fileName
81− else do tagMap <- readTagMap'
82− storeInCache (M.toAscList tagMap) fileName
83− return tagMap
81+ assocMap <- if isCacheMoreRecent'
82+ then M.fromAscList <$> getFromCache fileName
83+ else do assocMap' <- readTagMap'
84+ storeInCache (M.toAscList assocMap') fileName
85+ return assocMap'
86+ return $ M.map (map createPagePath) assocMap
8487
8588 readTagMap' = foldM addPaths M.empty paths
8689 addPaths current path = do
87− createPagePath path >>>
90+ context <- runRenderAction $ createPagePath path
8891 let tags = getTagsFunction context
8992 addPaths' = flip (M.insertWith (++)) [path]
9093 return $ foldr addPaths' current tags
@@ -92,7 +95,7 @@ readMap getTagsFunction identifier paths = RenderAction
9295-- | Read a @TagMap@, using the @tags@ metadata field.
9396readTagMap :: String -- ^ Unique identifier for the map.
9497 -> [FilePath] -- ^ Paths to get tags from.
95− -> Hakyll TagMap
98+ -> RenderAction () TagMap
9699readTagMap = readMap getTagsFunction
97100 where
98101 getTagsFunction = map trim . splitRegex ","
@@ -101,39 +104,46 @@ readTagMap = readMap getTagsFunction
101104-- | Read a @TagMap@, using the subdirectories the pages are placed in.
102105readCategoryMap :: String -- ^ Unique identifier for the map.
103106 -> [FilePath] -- ^ Paths to get tags from.
104− -> Hakyll TagMap
107+ -> RenderAction () TagMap
105108readCategoryMap = readMap $ maybeToList . M.lookup "category"
106109
110+withTagMap :: RenderAction () TagMap
111+ -> (String -> [Renderable] -> Hakyll ())
112+ -> Hakyll ()
113+withTagMap tagMap function = runRenderActionIfNeeded (tagMap >>> action)
114+ where
115+ action = createRenderAction (mapM_ (uncurry function) . M.toList)
116+
107117-- | Render a tag cloud.
108−renderTagCloud :: TagMap -- ^ Map as produced by @readTagMap@.
109− -> (String -> String) -- ^ Function to produce an url for a tag.
118+renderTagCloud :: (String -> String) -- ^ Function to produce an url for a tag.
110119 -> Float -- ^ Smallest font size, in percent.
111120 -> Float -- ^ Biggest font size, in percent.
112− -> String -- ^ Result of the render.
113−renderTagCloud tagMap urlFunction minSize maxSize =
114− intercalate " " $ map renderTag tagCount
121+ -> RenderAction TagMap String
122+renderTagCloud urlFunction minSize maxSize = createRenderAction renderTagCloud'
115123 where
116− renderTag :: (String, Float) -> String
117− renderTag (tag, count) =
118− finalSubstitute linkTemplate $ M.fromList [ ("size", sizeTag count)
119− , ("url", urlFunction tag)
120− , ("tag", tag)
121− ]
124+ renderTagCloud' tagMap =
125+ return $ intercalate " " $ map (renderTag tagMap) (tagCount tagMap)
126+
127+ renderTag tagMap (tag, count) =
128+ finalSubstitute linkTemplate $ M.fromList
129+ [ ("size", sizeTag tagMap count)
130+ , ("url", urlFunction tag)
131+ , ("tag", tag)
132+ ]
133+
122134 linkTemplate =
123135 fromString "<a style=\"font-size: $size\" href=\"$url\">$tag</a>"
124136
125− sizeTag :: Float -> String
126− sizeTag count = show size' ++ "%"
137+ sizeTag tagMap count = show (size' :: Int) ++ "%"
127138 where
128− size' :: Int
129− size' = floor $ minSize + relative count * (maxSize - minSize)
139+ size' = floor $ minSize + relative tagMap count * (maxSize - minSize)
130140
131− minCount = minimum $ map snd tagCount
132− maxCount = maximum $ map snd tagCount
133− relative count = (count - minCount) / (maxCount - minCount)
141+ minCount = minimum . map snd . tagCount
142+ maxCount = maximum . map snd . tagCount
143+ relative tagMap count = (count - minCount tagMap) /
144+ (maxCount tagMap - minCount tagMap)
134145
135− tagCount :: [(String, Float)]
136− tagCount = map (second $ fromIntegral . length) $ M.toList tagMap
146+ tagCount = map (second $ fromIntegral . length) . M.toList
137147
138148-- | Render all tags to links.
139149--