79 lines
2.1 KiB
Haskell
79 lines
2.1 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Dom (
|
|
page
|
|
) where
|
|
|
|
import Article (Article(..))
|
|
import ArticlesList (ArticlesList(..), otherLink, otherUrl, pageTitle)
|
|
import Blog (Blog(..))
|
|
import qualified Blog (get)
|
|
import Control.Monad.Reader (ReaderT)
|
|
import qualified Data.Map as Map (keys)
|
|
import Data.Text (pack, empty)
|
|
import Lucid
|
|
import System.FilePath.Posix ((</>), (<.>))
|
|
|
|
type HtmlGenerator = HtmlT (ReaderT Blog IO)
|
|
|
|
class Page a where
|
|
content :: a -> HtmlGenerator ()
|
|
|
|
instance Page Article where
|
|
content (Article {fullContents, urlPath}) =
|
|
article_ (do
|
|
a_ [href_ . pack $ "/" </> urlPath <.> "md"] "Raw"
|
|
pre_ $ toHtml fullContents
|
|
)
|
|
|
|
instance Page ArticlesList where
|
|
content al@(ArticlesList {featured}) =
|
|
div_ [id_ "contents"] (do
|
|
h2_ . toHtml $ pageTitle al
|
|
p_ . a_ [href_ $ otherUrl al] . toHtml $ otherLink al
|
|
div_ [class_ "articles"] (mapM_ previewArticle featured)
|
|
)
|
|
|
|
previewArticle :: Article -> HtmlGenerator ()
|
|
previewArticle (Article {urlPath, title, preview}) =
|
|
article_ (do
|
|
a_ [href_ . pack $ "/" </> urlPath <.> "html"] . h3_ $ toHtml title
|
|
pre_ $ toHtml preview
|
|
)
|
|
|
|
tag :: String -> HtmlGenerator ()
|
|
tag tagName = li_ (a_ [href_ $ pack ("/" </> tagName)] $ toHtml tagName)
|
|
|
|
banner :: HtmlGenerator ()
|
|
banner = do
|
|
maybe defaultBanner toHtmlRaw =<< Blog.get customBanner
|
|
|
|
defaultBanner :: HtmlGenerator ()
|
|
defaultBanner = do
|
|
div_ [id_ "header"] (
|
|
a_ [href_ "/"] (
|
|
h1_ . toHtml =<< Blog.get name
|
|
)
|
|
)
|
|
|
|
page :: Page a => a -> HtmlGenerator ()
|
|
page aPage =
|
|
doctypehtml_ (do
|
|
head_ (do
|
|
meta_ [charset_ "utf-8"]
|
|
title_ . toHtml =<< Blog.get name
|
|
script_ [src_ "/UnitJS/async.js"] empty
|
|
script_ [src_ "/UnitJS/dom.js"] empty
|
|
script_ [src_ "/js/main.js"] empty
|
|
maybe (toHtml empty) toHtmlRaw =<< Blog.get customHead
|
|
)
|
|
body_ (do
|
|
banner
|
|
div_ [id_ "navigator"] (do
|
|
h2_ "Tags"
|
|
ul_ . mapM_ tag . Map.keys =<< Blog.get tags
|
|
)
|
|
div_ [id_ "contents"] $ content aPage
|
|
)
|
|
)
|