{-# 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, lookup)
import Data.Monoid ((<>))
import Data.Text (Text, pack, empty)
import Lucid
import Lucid.Base (makeAttribute)
import Prelude hiding (head, lookup)
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, metadata}) = do
    description <- getDescription (Map.lookup "summary" metadata)
    makeCard title (pack description) (Map.lookup "featuredImage" metadata)
    where
      getDescription = maybe (Blog.get $name.$("A new article on " <>)) return

  content = article True

instance Page ArticlesList where
  card al = do
    cardTitle <- getTitle <$> Blog.get name
    description <- pageTitle al
    makeCard cardTitle description Nothing
    where
      getTitle name = maybe name ((name ++ " - ") ++) $ tagged 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 -> Maybe String -> HtmlGenerator ()
makeCard title description image = do
  og "title" $ pack title
  og "description" description
  og "image" =<< pack <$> maybe (Blog.get $skin.$cardImage) return image
  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
        )
    )