Improve tag handling API
Expose function tagsFieldWith and renderTagCloudWith to provide more flexible tag rendering APIs; add tagCloudField and tagCloudFieldWith to provide context-based facility for tag cloud rendering.
This commit is contained in:
Ian Ross
parent
ce745bcfe4
commit
ef9c610d3c
1 changed files with 97 additions and 24 deletions
|
|
@ -49,8 +49,12 @@ module Hakyll.Web.Tags
|
|||
, tagsRules
|
||||
, renderTags
|
||||
, renderTagCloud
|
||||
, renderTagCloudWith
|
||||
, tagCloudField
|
||||
, tagCloudFieldWith
|
||||
, renderTagList
|
||||
, tagsField
|
||||
, tagsFieldWith
|
||||
, categoryField
|
||||
, sortTagsBy
|
||||
, caseInsensitiveTags
|
||||
|
|
@ -184,7 +188,6 @@ renderTags makeHtml concatHtml tags = do
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Render a tag cloud in HTML
|
||||
-- TODO: Maybe produce a Context here
|
||||
renderTagCloud :: Double
|
||||
-- ^ Smallest font size, in percent
|
||||
-> Double
|
||||
|
|
@ -193,13 +196,13 @@ renderTagCloud :: Double
|
|||
-- ^ Input tags
|
||||
-> Compiler String
|
||||
-- ^ Rendered cloud
|
||||
renderTagCloud minSize maxSize = renderTags makeLink (intercalate " ")
|
||||
renderTagCloud = renderTagCloudWith makeLink (intercalate " ")
|
||||
where
|
||||
makeLink tag url count min' max' = renderHtml $
|
||||
makeLink minSize maxSize tag url count min' max' = renderHtml $
|
||||
H.a ! A.style (toValue $ "font-size: " ++ size count min' max')
|
||||
! A.href (toValue url)
|
||||
$ toHtml tag
|
||||
|
||||
where
|
||||
-- Show the relative size of one 'count' in percent
|
||||
size count min' max' =
|
||||
let diff = 1 + fromIntegral max' - fromIntegral min'
|
||||
|
|
@ -208,6 +211,62 @@ renderTagCloud minSize maxSize = renderTags makeLink (intercalate " ")
|
|||
in show (size' :: Int) ++ "%"
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Render a tag cloud in HTML
|
||||
renderTagCloudWith :: (Double -> Double ->
|
||||
String -> String -> Int -> Int -> Int -> String)
|
||||
-- ^ Render a single tag link
|
||||
-> ([String] -> String)
|
||||
-- ^ Concatenate links
|
||||
-> Double
|
||||
-- ^ Smallest font size, in percent
|
||||
-> Double
|
||||
-- ^ Biggest font size, in percent
|
||||
-> Tags
|
||||
-- ^ Input tags
|
||||
-> Compiler String
|
||||
-- ^ Rendered cloud
|
||||
renderTagCloudWith makeLink cat minSize maxSize =
|
||||
renderTags (makeLink minSize maxSize) cat
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Render a tag cloud in HTML as a context
|
||||
tagCloudField :: String
|
||||
-- ^ Destination key
|
||||
-> Double
|
||||
-- ^ Smallest font size, in percent
|
||||
-> Double
|
||||
-- ^ Biggest font size, in percent
|
||||
-> Tags
|
||||
-- ^ Input tags
|
||||
-> Context a
|
||||
-- ^ Context
|
||||
tagCloudField key minSize maxSize tags =
|
||||
field key $ \_ -> renderTagCloud minSize maxSize tags
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Render a tag cloud in HTML as a context
|
||||
tagCloudFieldWith :: String
|
||||
-- ^ Destination key
|
||||
-> (Double -> Double ->
|
||||
String -> String -> Int -> Int -> Int -> String)
|
||||
-- ^ Render a single tag link
|
||||
-> ([String] -> String)
|
||||
-- ^ Concatenate links
|
||||
-> Double
|
||||
-- ^ Smallest font size, in percent
|
||||
-> Double
|
||||
-- ^ Biggest font size, in percent
|
||||
-> Tags
|
||||
-- ^ Input tags
|
||||
-> Context a
|
||||
-- ^ Context
|
||||
tagCloudFieldWith key makeLink cat minSize maxSize tags =
|
||||
field key $ \_ -> renderTagCloudWith makeLink cat minSize maxSize tags
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Render a simple tag list in HTML, with the tag count next to the item
|
||||
-- TODO: Maybe produce a Context here
|
||||
|
|
@ -219,23 +278,27 @@ renderTagList = renderTags makeLink (intercalate ", ")
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Render tags with links with custom function to get tags
|
||||
tagsFieldWith :: (Identifier -> Compiler [String]) -- ^ Get the tags
|
||||
-> String -- ^ Destination field
|
||||
-> Tags -- ^ Tags structure
|
||||
-> Context a -- ^ Resulting context
|
||||
tagsFieldWith getTags' key tags = field key $ \item -> do
|
||||
-- | Render tags with links with custom functions to get tags and to
|
||||
-- render links
|
||||
tagsFieldWith :: (Identifier -> Compiler [String])
|
||||
-- ^ Get the tags
|
||||
-> (String -> (Maybe FilePath) -> Maybe H.Html)
|
||||
-- ^ Render link for one tag
|
||||
-> ([H.Html] -> H.Html)
|
||||
-- ^ Concatenate tag links
|
||||
-> String
|
||||
-- ^ Destination field
|
||||
-> Tags
|
||||
-- ^ Tags structure
|
||||
-> Context a
|
||||
-- ^ Resulting context
|
||||
tagsFieldWith getTags' renderLink cat key tags = field key $ \item -> do
|
||||
tags' <- getTags' $ itemIdentifier item
|
||||
links <- forM tags' $ \tag -> do
|
||||
route' <- getRoute $ tagsMakeId tags tag
|
||||
return $ renderLink tag route'
|
||||
|
||||
return $ renderHtml $ mconcat $ intersperse ", " $ catMaybes $ links
|
||||
where
|
||||
-- Render one tag link
|
||||
renderLink _ Nothing = Nothing
|
||||
renderLink tag (Just filePath) = Just $
|
||||
H.a ! A.href (toValue $ toUrl filePath) $ toHtml tag
|
||||
return $ renderHtml $ cat $ catMaybes $ links
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -243,7 +306,8 @@ tagsFieldWith getTags' key tags = field key $ \item -> do
|
|||
tagsField :: String -- ^ Destination key
|
||||
-> Tags -- ^ Tags
|
||||
-> Context a -- ^ Context
|
||||
tagsField = tagsFieldWith getTags
|
||||
tagsField =
|
||||
tagsFieldWith getTags simpleRenderLink (mconcat . intersperse ", ")
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -251,7 +315,16 @@ tagsField = tagsFieldWith getTags
|
|||
categoryField :: String -- ^ Destination key
|
||||
-> Tags -- ^ Tags
|
||||
-> Context a -- ^ Context
|
||||
categoryField = tagsFieldWith getCategory
|
||||
categoryField =
|
||||
tagsFieldWith getCategory simpleRenderLink (mconcat . intersperse ", ")
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Render one tag link
|
||||
simpleRenderLink :: String -> (Maybe FilePath) -> Maybe H.Html
|
||||
simpleRenderLink _ Nothing = Nothing
|
||||
simpleRenderLink tag (Just filePath) =
|
||||
Just $ H.a ! A.href (toValue $ toUrl filePath) $ toHtml tag
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
|||
Loading…
Reference in a new issue