@@ -49,8 +49,12 @@ module Hakyll.Web.Tags
4949 , tagsRules
5050 , renderTags
5151 , renderTagCloud
52+ , renderTagCloudWith
53+ , tagCloudField
54+ , tagCloudFieldWith
5255 , renderTagList
5356 , tagsField
57+ , tagsFieldWith
5458 , categoryField
5559 , sortTagsBy
5660 , caseInsensitiveTags
@@ -184,7 +188,6 @@ renderTags makeHtml concatHtml tags = do
184188
185189--------------------------------------------------------------------------------
186190-- | Render a tag cloud in HTML
187−-- TODO: Maybe produce a Context here
188191renderTagCloud :: Double
189192 -- ^ Smallest font size, in percent
190193 -> Double
@@ -193,19 +196,75 @@ renderTagCloud :: Double
193196 -- ^ Input tags
194197 -> Compiler String
195198 -- ^ Rendered cloud
196−renderTagCloud minSize maxSize = renderTags makeLink (intercalate " ")
199+renderTagCloud = renderTagCloudWith makeLink (intercalate " ")
197200 where
198− makeLink tag url count min' max' = renderHtml $
201+ makeLink minSize maxSize tag url count min' max' = renderHtml $
199202 H.a ! A.style (toValue $ "font-size: " ++ size count min' max')
200203 ! A.href (toValue url)
201204 $ toHtml tag
205+ where
206+ -- Show the relative size of one 'count' in percent
207+ size count min' max' =
208+ let diff = 1 + fromIntegral max' - fromIntegral min'
209+ relative = (fromIntegral count - fromIntegral min') / diff
210+ size' = floor $ minSize + relative * (maxSize - minSize)
211+ in show (size' :: Int) ++ "%"
212+
213+
214+--------------------------------------------------------------------------------
215+-- | Render a tag cloud in HTML
216+renderTagCloudWith :: (Double -> Double ->
217+ String -> String -> Int -> Int -> Int -> String)
218+ -- ^ Render a single tag link
219+ -> ([String] -> String)
220+ -- ^ Concatenate links
221+ -> Double
222+ -- ^ Smallest font size, in percent
223+ -> Double
224+ -- ^ Biggest font size, in percent
225+ -> Tags
226+ -- ^ Input tags
227+ -> Compiler String
228+ -- ^ Rendered cloud
229+renderTagCloudWith makeLink cat minSize maxSize =
230+ renderTags (makeLink minSize maxSize) cat
231+
232+
233+--------------------------------------------------------------------------------
234+-- | Render a tag cloud in HTML as a context
235+tagCloudField :: String
236+ -- ^ Destination key
237+ -> Double
238+ -- ^ Smallest font size, in percent
239+ -> Double
240+ -- ^ Biggest font size, in percent
241+ -> Tags
242+ -- ^ Input tags
243+ -> Context a
244+ -- ^ Context
245+tagCloudField key minSize maxSize tags =
246+ field key $ \_ -> renderTagCloud minSize maxSize tags
247+
202248
203− -- Show the relative size of one 'count' in percent
204− size count min' max' =
205− let diff = 1 + fromIntegral max' - fromIntegral min'
206− relative = (fromIntegral count - fromIntegral min') / diff
207− size' = floor $ minSize + relative * (maxSize - minSize)
208− in show (size' :: Int) ++ "%"
249+--------------------------------------------------------------------------------
250+-- | Render a tag cloud in HTML as a context
251+tagCloudFieldWith :: String
252+ -- ^ Destination key
253+ -> (Double -> Double ->
254+ String -> String -> Int -> Int -> Int -> String)
255+ -- ^ Render a single tag link
256+ -> ([String] -> String)
257+ -- ^ Concatenate links
258+ -> Double
259+ -- ^ Smallest font size, in percent
260+ -> Double
261+ -- ^ Biggest font size, in percent
262+ -> Tags
263+ -- ^ Input tags
264+ -> Context a
265+ -- ^ Context
266+tagCloudFieldWith key makeLink cat minSize maxSize tags =
267+ field key $ \_ -> renderTagCloudWith makeLink cat minSize maxSize tags
209268
210269
211270--------------------------------------------------------------------------------
@@ -215,27 +274,31 @@ renderTagList :: Tags -> Compiler (String)
215274renderTagList = renderTags makeLink (intercalate ", ")
216275 where
217276 makeLink tag url count _ _ = renderHtml $
218− H.a ! A.href (toValue url) $ toHtml (tag ++ " (" ++ show count ++ ")")
277+ H.a ! A.href (toValue url) $ toHtml (tag ++ " (" ++ show count ++ ")")
219278
220279
221280--------------------------------------------------------------------------------
222−-- | Render tags with links with custom function to get tags
223−tagsFieldWith :: (Identifier -> Compiler [String]) -- ^ Get the tags
224− -> String -- ^ Destination field
225− -> Tags -- ^ Tags structure
226− -> Context a -- ^ Resulting context
227−tagsFieldWith getTags' key tags = field key $ \item -> do
281+-- | Render tags with links with custom functions to get tags and to
282+-- render links
283+tagsFieldWith :: (Identifier -> Compiler [String])
284+ -- ^ Get the tags
285+ -> (String -> (Maybe FilePath) -> Maybe H.Html)
286+ -- ^ Render link for one tag
287+ -> ([H.Html] -> H.Html)
288+ -- ^ Concatenate tag links
289+ -> String
290+ -- ^ Destination field
291+ -> Tags
292+ -- ^ Tags structure
293+ -> Context a
294+ -- ^ Resulting context
295+tagsFieldWith getTags' renderLink cat key tags = field key $ \item -> do
228296 tags' <- getTags' $ itemIdentifier item
229297 links <- forM tags' $ \tag -> do
230298 route' <- getRoute $ tagsMakeId tags tag
231299 return $ renderLink tag route'
232300
233− return $ renderHtml $ mconcat $ intersperse ", " $ catMaybes $ links
234− where
235− -- Render one tag link
236− renderLink _ Nothing = Nothing
237− renderLink tag (Just filePath) = Just $
238− H.a ! A.href (toValue $ toUrl filePath) $ toHtml tag
301+ return $ renderHtml $ cat $ catMaybes $ links
239302
240303
241304--------------------------------------------------------------------------------
@@ -243,7 +306,8 @@ tagsFieldWith getTags' key tags = field key $ \item -> do
243306tagsField :: String -- ^ Destination key
244307 -> Tags -- ^ Tags
245308 -> Context a -- ^ Context
246−tagsField = tagsFieldWith getTags
309+tagsField =
310+ tagsFieldWith getTags simpleRenderLink (mconcat . intersperse ", ")
247311
248312
249313--------------------------------------------------------------------------------
@@ -251,7 +315,16 @@ tagsField = tagsFieldWith getTags
251315categoryField :: String -- ^ Destination key
252316 -> Tags -- ^ Tags
253317 -> Context a -- ^ Context
254−categoryField = tagsFieldWith getCategory
318+categoryField =
319+ tagsFieldWith getCategory simpleRenderLink (mconcat . intersperse ", ")
320+
321+
322+--------------------------------------------------------------------------------
323+-- | Render one tag link
324+simpleRenderLink :: String -> (Maybe FilePath) -> Maybe H.Html
325+simpleRenderLink _ Nothing = Nothing
326+simpleRenderLink tag (Just filePath) =
327+ Just $ H.a ! A.href (toValue $ toUrl filePath) $ toHtml tag
255328
256329
257330--------------------------------------------------------------------------------