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

import Article (Article(..))
import qualified Article (preview)
import ArticlesList (
    ArticlesList(..), description, getArticles, otherURL, rssLinkTexts
  )
import Blog (Blog(..), Path(..), Skin(..), URL(..), template)
import Control.Monad.Reader (ReaderT, asks)
import qualified Data.Map as Map (keys)
import Data.Text (pack, empty)
import DOM.Card (HasCard)
import qualified DOM.Card as Card (make)
import Files (absoluteLink)
import Lucid (
      HtmlT, a_, article_, body_, charset_, class_, div_, doctypehtml_, h1_, h2_
    , head_, header_, href_, li_, link_, id_, meta_, pre_, rel_, script_, src_
    , title_, toHtml, toHtmlRaw, type_, ul_
  )
import Prelude hiding (head, lookup)
import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>))

type HtmlGenerator = HtmlT (ReaderT Blog IO)

class HasCard a => Page a where
  content :: a -> HtmlGenerator ()

instance Page Article where
  content = article True

instance Page ArticlesList where
  content al@(ArticlesList {full}) = do
    preview <- Article.preview <$> (asks $skin.$previewLinesCount)
    h2_ . toHtml =<< description al
    ul_ $ do
      asks hasRSS >>= rssLink
      li_ . a_ [href_ . pack $ otherURL al, class_ "other"] =<< otherLink
    div_ [class_ "articles"] (
        mapM_ (article False . preview) =<< getArticles al
      )
    where
      otherLink =
        toHtml <$> template (if full then "latestLink" else "allLink") []
      rssLink :: Bool -> HtmlGenerator ()
      rssLink True = do
        (text, title) <- rssLinkTexts al
        li_ . a_ [href_ "rss.xml", class_ "RSS", title_ title] $ toHtml text
      rssLink False = return ()

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

tag :: String -> HtmlGenerator ()
tag name = li_ (
    a_ [href_ . pack $ absoluteLink name ++ "/", class_ "tag"] $ toHtml name
  )

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

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

optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator ()
optional = maybe (return ()) 

page :: Page a => a -> HtmlGenerator ()
page aPage =
  doctypehtml_ (do
      head_ (do
          meta_ [charset_ "utf-8"]
          title_ . toHtml =<< asks name
          script_ [src_ "/js/unit.js"] empty
          script_ [src_ "/js/remarkable.min.js"] empty
          script_ [src_ "/js/hablo.js"] empty
          optional faviconLink =<< (asks $skin.$favicon)
          optional (Card.make aPage) =<< (asks $urls.$cards)
          optional toHtmlRaw =<< (asks $skin.$head)
        )
      body_ (do
          maybe defaultBanner toHtmlRaw =<< (asks $skin.$banner)
          div_ [id_ "navigator"] (do
              h2_ . toHtml =<< template "tagsList" []
              ul_ . mapM_ tag . Map.keys =<< asks tags
            )
          div_ [id_ "contents"] $ content aPage
        )
    )