{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Dom ( article , articlesList , 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) 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 ) ) article :: Article -> HtmlGenerator () article (Article {fullContents, urlPath}) = article_ (do a_ [href_ . pack $ "/" urlPath <.> "md"] "Raw" pre_ $ toHtml fullContents ) articlesList :: ArticlesList -> HtmlGenerator () articlesList 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) ) page :: HtmlGenerator () -> HtmlGenerator () page contents = 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 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"] contents ) )