{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module DOM.Card (
      Card(..)
    , HasCard(..)
    , make
  ) where

import qualified Article (Article(..))
import ArticlesList (ArticlesList(..), pageTitle)
import Blog (Blog(..), Skin(..))
import qualified Blog (get)
import Control.Applicative ((<|>))
import Control.Monad.Reader (MonadReader)
import qualified Data.Map as Map (lookup)
import Data.Text (Text, pack)
import Lucid (HtmlT, content_, meta_)
import Lucid.Base (makeAttribute)
import Pretty ((.$))

data Card = Card {
      cardType :: Text
    , description :: Text
    , image :: Maybe String
    , title :: String
    , urlPath :: String
  }

class HasCard a where
  getCard :: MonadReader Blog m => a -> m Card

og :: Applicative m => Text -> Text -> HtmlT m ()
og attribute value =
  meta_ [
        makeAttribute "property" $ "og:" <> attribute
      , content_ value
    ]

make :: (HasCard a, MonadReader Blog m) => a -> String -> HtmlT m ()
make element siteURL = do
  Card {cardType, description, image, title, urlPath} <- getCard element
  og "url" . pack $ siteURL ++ urlPath
  og "type" cardType
  og "title" $ pack title
  og "description" description
  maybeImage =<< ((image <|>) <$> (Blog.get $skin.$cardImage))
  og "site_name" =<< (Blog.get $name.$pack)
  where
    maybeImage = maybe (return ()) (og "image" . pack . (siteURL++))

instance HasCard Article.Article where
  getCard (Article.Article {Article.title, Article.metadata}) = do
    description <- pack <$> getDescription (Map.lookup "summary" metadata)
    return $ Card {
          cardType = "article"
        , description
        , image = (Map.lookup "featuredImage" metadata)
        , DOM.Card.title
        , urlPath = "/articles/" ++ title ++ ".html"
      }
    where
      getDescription = maybe (Blog.get $name.$("A new article on " <>)) return

instance HasCard ArticlesList where
  getCard al = do
    cardTitle <- getTitle <$> Blog.get name
    description <- pageTitle al
    return $ Card {
          cardType = "website"
        , description
        , image = Nothing
        , DOM.Card.title = cardTitle
        , urlPath = maybe "" ('/':) (tagged al) ++ file
      }
    where
      getTitle name = maybe name ((name ++ " - ") ++) $ tagged al
      file = '/' : (if full al then "all" else "index") ++ ".html"