@@ -32,6 +32,7 @@ module Hakyll.Web.Tags
3232 , readTags
3333 , readCategory
3434 , renderTagCloud
35+ , renderTagList
3536 , renderTagsField
3637 , renderCategoryField
3738 ) where
@@ -41,7 +42,7 @@ import Control.Category (id)
4142import Control.Applicative ((<$>))
4243import Data.Map (Map)
4344import qualified Data.Map as M
44−import Data.List (intersperse)
45+import Data.List (intersperse, intercalate)
4546import Control.Arrow (arr, (&&&), (>>>), (***), (<<^), returnA)
4647import Data.Maybe (catMaybes, fromMaybe)
4748import Data.Monoid (mconcat)
@@ -108,13 +109,17 @@ readTags = readTagsWith getTags
108109readCategory :: [Page a] -> Tags a
109110readCategory = readTagsWith getCategory
110111
111−-- | Render a tag cloud in HTML
112+-- | Render tags in HTML
112113--
113−renderTagCloud :: (String -> Identifier) -- ^ Produce a link for a tag
114− -> Double -- ^ Smallest font size, in percent
115− -> Double -- ^ Biggest font size, in percent
116− -> Compiler (Tags a) String -- ^ Tag cloud renderer
117−renderTagCloud makeUrl minSize maxSize = proc (Tags tags) -> do
114+renderTags :: (String -> Identifier)
115+ -- ^ Produce a link
116+ -> (String -> String -> Int -> Int -> Int -> String)
117+ -- ^ Produce a tag item: tag, url, count, min count, max count
118+ -> ([String] -> String)
119+ -- ^ Join items
120+ -> Compiler (Tags a) String
121+ -- ^ Tag cloud renderer
122+renderTags makeUrl makeItem concatItems = proc (Tags tags) -> do
118123 -- In tags' we create a list: [((tag, route), count)]
119124 tags' <- mapCompiler ((id &&& (getRouteFor <<^ makeUrl)) *** arr length)
120125 -< M.toList tags
@@ -122,27 +127,46 @@ renderTagCloud makeUrl minSize maxSize = proc (Tags tags) -> do
122127 let -- Absolute frequencies of the pages
123128 freqs = map snd tags'
124129
125− -- Find out the relative count of a tag: on a scale from 0 to 1
126− relative count = (fromIntegral count - min') / (1 + max' - min')
127−
128− -- Show the relative size of one 'count' in percent
129− size count =
130− let size' = floor $ minSize + relative count * (maxSize - minSize)
131− in show (size' :: Int) ++ "%"
132−
133− -- The minimum and maximum count found, as doubles
130+ -- The minimum and maximum count found
134131 (min', max')
135132 | null freqs = (0, 1)
136− | otherwise = (minimum &&& maximum) $ map fromIntegral freqs
133+ | otherwise = (minimum &&& maximum) freqs
137134
138135 -- Create a link for one item
139− makeLink ((tag, url), count) =
140− H.a ! A.style (toValue $ "font-size: " ++ size count)
141− ! A.href (toValue $ toUrl $ fromMaybe "/" url)
142− $ toHtml tag
136+ makeItem' ((tag, url), count) =
137+ makeItem tag (toUrl $ fromMaybe "/" url) count min' max'
143138
144139 -- Render and return the HTML
145− returnA -< renderHtml $ mconcat $ intersperse " " $ map makeLink tags'
140+ returnA -< concatItems $ map makeItem' tags'
141+
142+-- | Render a tag cloud in HTML
143+--
144+renderTagCloud :: (String -> Identifier) -- ^ Produce a link for a tag
145+ -> Double -- ^ Smallest font size, in percent
146+ -> Double -- ^ Biggest font size, in percent
147+ -> Compiler (Tags a) String -- ^ Tag cloud renderer
148+renderTagCloud makeUrl minSize maxSize =
149+ renderTags makeUrl makeLink (intercalate " ")
150+ where
151+ makeLink tag url count min' max' = renderHtml $
152+ H.a ! A.style (toValue $ "font-size: " ++ size count min' max')
153+ ! A.href (toValue url)
154+ $ toHtml tag
155+
156+ -- Show the relative size of one 'count' in percent
157+ size count min' max' =
158+ let diff = 1 + fromIntegral max' - fromIntegral min'
159+ relative = (fromIntegral count - fromIntegral min') / diff
160+ size' = floor $ minSize + relative * (maxSize - minSize)
161+ in show (size' :: Int) ++ "%"
162+
163+-- | Render a simple tag list in HTML, with the tag count next to the item
164+--
165+renderTagList :: (String -> Identifier) -> Compiler (Tags a) (String)
166+renderTagList makeUrl = renderTags makeUrl makeLink (intercalate ", ")
167+ where
168+ makeLink tag url count _ _ = renderHtml $
169+ H.a ! A.href (toValue url) $ toHtml (tag ++ "(" ++ show count ++ ")")
146170
147171-- | Render tags with links
148172--
@@ -151,14 +175,14 @@ renderTagsFieldWith :: (Page a -> [String]) -- ^ Function to get the tags
151175 -> (String -> Identifier) -- ^ Create a link for a tag
152176 -> Compiler (Page a) (Page a) -- ^ Resulting compiler
153177renderTagsFieldWith tags destination makeUrl =
154− id &&& arr tags >>> setFieldA destination renderTags
178+ id &&& arr tags >>> setFieldA destination renderTags'
155179 where
156180 -- Compiler creating a comma-separated HTML string for a list of tags
157− renderTags :: Compiler [String] String
158− renderTags = arr (map $ id &&& makeUrl)
159− >>> mapCompiler (id *** getRouteFor)
160− >>> arr (map $ uncurry renderLink)
161− >>> arr (renderHtml . mconcat . intersperse ", " . catMaybes)
181+ renderTags' :: Compiler [String] String
182+ renderTags' = arr (map $ id &&& makeUrl)
183+ >>> mapCompiler (id *** getRouteFor)
184+ >>> arr (map $ uncurry renderLink)
185+ >>> arr (renderHtml . mconcat . intersperse ", " . catMaybes)
162186
163187 -- Render one tag link
164188 renderLink _ Nothing = Nothing