{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Dom (
    page
  ) where

import Article (Article(..))
import ArticlesList (ArticlesList(..), otherLink, otherUrl, pageTitle)
import Blog (Blog(..), Skin(..))
import qualified Blog (get)
import Control.Monad.Reader (ReaderT)
import qualified Data.Map as Map (keys)
import Data.Monoid ((<>))
import Data.Text (pack, empty)
import Lucid
import Lucid.Base (makeAttribute)
import Prelude hiding (head)
import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>))

type HtmlGenerator = HtmlT (ReaderT Blog IO)

class Page a where
  card :: a -> HtmlGenerator ()
  content :: a -> HtmlGenerator ()

instance Page Article where
  card (Article {title}) =
    ("A new article on " <>) <$> Blog.get name
    >>= makeCard title

  content (Article {fullContents, urlPath}) =
    article_ (do
        a_ [href_ . pack $ "/" </> urlPath <.> "md"] "Raw"
        pre_ $ toHtml fullContents
      )

instance Page ArticlesList where
  card al = do
    blogName <- Blog.get name
    makeCard (maybe blogName ((blogName ++ " - ") ++) $ tagged al) (pageTitle al)

  content al@(ArticlesList {featured}) = do
    h2_ . toHtml . pack $ pageTitle al
    p_ . navigationA [href_ . pack $ otherUrl al] . toHtml . pack $ otherLink al
    div_ [class_ "articles"] (mapM_ previewArticle featured)

makeCard :: String -> String -> HtmlGenerator ()
makeCard title description = do
  og "title" title
  og "description" description
  og "image" =<< (Blog.get $skin.$cardImage)
  og "site_name" =<< Blog.get name
  where
    og attribute value = meta_ [makeAttribute "property" $ "og:" <> attribute , content_ $ pack value]

navigationA :: Term arg result => arg -> result
navigationA = "a" `termWith` [class_ "navigation"]

previewArticle :: Article -> HtmlGenerator ()
previewArticle (Article {urlPath, title, preview}) =
  article_ (do
    navigationA [href_ . pack $ "/" </> urlPath <.> "html"] . h3_ $ toHtml title
    pre_ $ toHtml preview
  )

tag :: String -> HtmlGenerator ()
tag tagName = li_ (navigationA [href_ $ pack ("/" </> tagName)] $ toHtml tagName)

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

faviconLink :: FilePath -> HtmlGenerator ()
faviconLink url = link_ [rel_ "shortcut icon", href_ $ pack url, type_ "image/x-icon"]

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/hablo.js"] empty
          maybe (toHtml empty) faviconLink =<< (Blog.get $skin.$favicon)
          card aPage
          (Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw
        )
      body_ (do
          (Blog.get $skin.$banner) >>= maybe defaultBanner toHtmlRaw
          div_ [id_ "navigator"] (do
              h2_ "Tags"
              ul_ . mapM_ tag . Map.keys =<< Blog.get tags
            )
          div_ [id_ "contents"] $ content aPage
        )
    )