Reuse new mDLink function to simplify mDContent

This commit is contained in:
Tissevert 2020-06-21 21:46:35 +02:00
parent 47f5c70e21
commit 8382dc11f2
1 changed files with 11 additions and 15 deletions

View File

@ -34,10 +34,10 @@ class HasCard a => HasContent a where
content :: a -> HtmlGenerator ()
instance HasContent Article where
content = markdown True . getMarkdown
content = mDContent True . getMarkdown
instance HasContent Page where
content = markdown True . getMarkdown
content = mDContent True . getMarkdown
instance HasContent ArticlesList where
content al@(ArticlesList {full}) = do
@ -47,7 +47,7 @@ instance HasContent ArticlesList where
asks hasRSS >>= rssLink
li_ . a_ [href_ . pack $ otherURL al, class_ "other"] =<< otherLink
div_ [class_ "articles"] (
mapM_ (markdown False . preview) =<< getArticles al
mapM_ (mDContent False . preview) =<< getArticles al
)
where
otherLink =
@ -58,21 +58,17 @@ instance HasContent ArticlesList where
li_ . a_ [href_ "rss.xml", class_ "RSS", title_ title] $ toHtml text
rssLink False = return ()
markdown :: Bool -> Markdown -> HtmlGenerator ()
markdown raw (Markdown {key, Markdown.path, body, title}) =
let url = absoluteLink $ path <.> extension in
mDContent :: Bool -> Markdown -> HtmlGenerator ()
mDContent raw markdown@(Markdown {key, body}) =
article_ [id_ $ pack key] (do
header_ (do
h1_ . a_ [href_ $ pack url] $ toHtml title
)
header_ . h1_ $ mDLink raw markdown
pre_ . toHtml $ unlines body
)
where extension = if raw then "md" else "html"
mDLink :: MarkdownContent a => Bool -> a -> HtmlGenerator ()
mDLink raw a = a_ [href_ $ pack url] $ toHtml title
mDLink :: Bool -> Markdown -> HtmlGenerator ()
mDLink raw (Markdown {Markdown.path, title}) =
a_ [href_ $ pack url] $ toHtml title
where
Markdown {Markdown.path, title} = getMarkdown a
url = absoluteLink $ path <.> (if raw then "md" else "html")
tag :: String -> HtmlGenerator ()
@ -81,7 +77,7 @@ tag name = li_ (
)
defaultBanner :: HtmlGenerator ()
defaultBanner = do
defaultBanner =
div_ [id_ "header"] (
a_ [href_ "/"] (
h1_ . toHtml =<< asks name
@ -116,7 +112,7 @@ htmlDocument someContent =
)
div_ [id_ "pages"] (do
h2_ . toHtml =<< template "pagesList" []
ul_ . mapM_ (mDLink False) . Map.elems =<< asks pages
ul_ . mapM_ (mDLink False . getMarkdown) . Map.elems =<< asks pages
)
div_ [id_ "contents"] $ content someContent
)