Tissevert
/
hablo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/DOM.hs
View File

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