{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Dom (
      Page(..)
    , render
  ) where

import Article (Article(..))
import Blog (Blog(..))
import Control.Monad.Reader (MonadReader(..), 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)

data Page = Page {
      category :: Maybe String
    , full :: Bool
    , articlesFeatured :: [Article]
  }

blog :: (Blog -> a) -> HtmlGenerator a
blog = (<$> ask)

previewArticle :: Article -> HtmlGenerator ()
previewArticle (Article {urlPath, title, preview}) =
  article_ (do
    a_ [href_ urlPath] . 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 customBanner

defaultBanner :: HtmlGenerator ()
defaultBanner = do
  div_ [id_ "header"] (
      a_ [href_ "/"] (
          h1_ . toHtml =<< blog name
        )
    )

render :: Page -> HtmlGenerator ()
render (Page {category, full, articlesFeatured}) =
  doctypehtml_ (do
      head_ (do
          meta_ [charset_ "utf-8"]
          title_ . toHtml =<< blog name
          script_ [src_ "/UnitJS/async.js"] empty
          script_ [src_ "/UnitJS/dom.js"] empty
          maybe (toHtml empty) toHtmlRaw =<< blog customHead
        )
      body_ (do
          banner
          div_ [id_ "navigator"] (do
              h2_ "Tags"
              ul_ . mapM_ tag . Map.keys =<< blog tags
            )
          div_ [id_ "contents"] (do
              h2_ $ toHtml pageTitle
              p_ $ if full
                then a_ [href_ . pack $ url category] "See only latest"
                else a_ [href_ . pack $ url category </> "all.html"] "See all"
              div_ [class_ "articles"] (mapM_ previewArticle articlesFeatured)
            )
        )
    )
  where
    pageTitle =
      (if full then "All" else "Latest") ++ " articles" ++ maybe "" (" tagged " ++) category
    url = maybe "/" ("/" </>)