diff --git a/src/Blog.hs b/src/Blog.hs index 964791c..3a6701b 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -54,7 +54,7 @@ data Blog = Blog { , pages :: Collection Page , path :: Path , skin :: Skin - , tags :: Map String (Set String) + , tags :: Collection (Set String) , templates :: Templates , urls :: URL , wording :: Wording diff --git a/src/DOM.hs b/src/DOM.hs index b57810c..aff7749 100644 --- a/src/DOM.hs +++ b/src/DOM.hs @@ -12,8 +12,8 @@ import ArticlesList ( ) import Blog (Blog(..), Skin(..), URL(..), template) import Control.Monad.Reader (ReaderT, asks) -import qualified Data.Map as Map (elems, keys) -import Data.Text (pack, empty) +import Data.Map as Map (Map, toList) +import Data.Text (Text, pack, empty) import DOM.Card (HasCard) import qualified DOM.Card as Card (make) import Files (absoluteLink) @@ -92,6 +92,16 @@ faviconLink url = link_ [ optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator () optional = maybe (return ()) +navigationSection :: + Text -> String -> ((String, a) -> HtmlGenerator ()) -> Map String a -> HtmlGenerator () +navigationSection sectionId templateKey generator collection + | null collection = return () + | otherwise = + div_ [id_ sectionId, class_ "navigator"] (do + h2_ . toHtml =<< template templateKey [] + ul_ . mapM_ generator $ Map.toList collection + ) + htmlDocument :: HasContent a => a -> HtmlGenerator () htmlDocument someContent = doctypehtml_ (do @@ -106,14 +116,10 @@ htmlDocument someContent = ) body_ (do maybe defaultBanner toHtmlRaw =<< (asks $skin.$banner) - div_ [id_ "tags"] (do - h2_ . toHtml =<< template "tagsList" [] - ul_ . mapM_ tag . Map.keys =<< asks tags - ) - div_ [id_ "pages"] (do - h2_ . toHtml =<< template "pagesList" [] - ul_ . mapM_ (mDLink False . getMarkdown) . Map.elems =<< asks pages - ) + asks tags >>= navigationSection "tags" "tagsList" + (\(key, _) -> tag key) + asks pages >>= navigationSection "pages" "pagesList" + (\(_, page) -> mDLink False $ getMarkdown page) div_ [id_ "contents"] $ content someContent ) )