{-# 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
        )
    )