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

import Article (Article(..))
import qualified Article (preview)
import ArticlesList (ArticlesList(..), otherUrl, pageTitle)
import Blog (Blog(..), Path(..), Skin(..), Wording(..))
import qualified Blog (get)
import Control.Monad.Reader (ReaderT)
import qualified Data.Map as Map (keys)
import Data.Monoid ((<>))
import Data.Text (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}) =
    makeCard title =<< (Blog.get $name.$("A new article on " <>).$pack)

  content = article True

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

  content al@(ArticlesList {featured, full}) = do
    preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount)
    h2_ . toHtml =<< pageTitle al
    navigationA [href_ . pack $ otherUrl al] . toHtml =<< otherLink
    div_ [class_ "articles"] (
        mapM_ (article False . preview) featured
      )
    where
      otherLink = Blog.get $wording.$(if full then latestLink else allLink)

article :: Bool -> Article -> HtmlGenerator ()
article raw (Article {key, body, title}) = do
  url <- ("/" </>) . (</> key <.> extension) <$> (Blog.get $path.$articlesPath)
  article_ (do
      header_ (do
          aElem [href_ . pack $ url] . h1_ $ toHtml title
        )
      pre_ . toHtml $ unlines body
    )
  where
    (aElem, extension) = if raw then (a_, "md") else (navigationA, "html")

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

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

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_ "/js/unit.js"] empty
          script_ [src_ "/js/remarkable.min.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
          maybe defaultBanner toHtmlRaw =<< (Blog.get $skin.$banner)
          div_ [id_ "navigator"] (do
              h2_ =<< (Blog.get $wording.$tagsList.$toHtml)
              ul_ . mapM_ tag . Map.keys =<< Blog.get tags
            )
          div_ [id_ "contents"] $ content aPage
        )
    )