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

import Article (Article(..))
import ArticlesList (ArticlesList(..))
import qualified ArticlesList (description)
import Blog (Blog(..), Renderer, Skin(..))
import Collection (Collection(..))
import qualified Collection (title)
import Control.Applicative ((<|>))
import Control.Monad.Reader (asks)
import qualified Data.Map as Map (lookup)
import Data.Text (Text, pack)
import Lucid (HtmlT, content_, meta_)
import Lucid.Base (makeAttribute)
import qualified Markdown (Markdown(..))
import Page (Page(..))
import Pretty ((.$))

class HasCard a where
  cardType :: Renderer m => a -> m Text
  description :: Renderer m => a -> m Text
  image :: Renderer m => a -> m (Maybe String)
  title :: Renderer m => a -> m String
  urlPath :: Renderer m => a -> m String

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

make :: (HasCard a, Renderer m) => a -> String -> HtmlT m ()
make element siteURL = do
  og "url" . sitePrefix =<< urlPath element
  og "type" =<< cardType element
  og "title" . pack =<< title element
  og "description" =<< description element
  maybeImage =<< ((<|>) <$> image element <*> (asks $skin.$cardImage))
  og "site_name" =<< (asks $name.$pack)
  where
    maybeImage = maybe (return ()) (og "image" . sitePrefix)
    sitePrefix = pack . (siteURL ++)

instance HasCard Article where
  cardType _ = return "article"
  description (Article (Markdown.Markdown {Markdown.metadata})) =
    fmap pack . getDescription $ Map.lookup "summary" metadata
    where
      getDescription = maybe (asks $name.$("A new article on " <>)) return
  image (Article (Markdown.Markdown {Markdown.metadata})) =
    return $ Map.lookup "featuredImage" metadata
  title = return . Markdown.title . Article.getMarkdown
  urlPath = fmap (\t -> "/articles/" ++ t ++ ".html") . title

instance HasCard Page where
  cardType _ = return "website"
  description page@(Page (Markdown.Markdown {Markdown.metadata})) =
    fmap pack . getDescription $ Map.lookup "summary" metadata
    where
      getDescription = maybe (title page) return
  image (Page (Markdown.Markdown {Markdown.metadata})) =
    return $ Map.lookup "featuredImage" metadata
  title = return . Markdown.title . Page.getMarkdown
  urlPath = fmap (\t -> "/pages/" ++ t ++ ".html") . title

instance HasCard ArticlesList where
  cardType _ = return "website"
  description = ArticlesList.description
  image _ = return Nothing
  title (ArticlesList {collection}) = Collection.title collection
  urlPath al@(ArticlesList {collection}) =
    return $ maybe "" ('/':) (tag collection) ++ file
    where
      file = '/' : (if full al then "all" else "index") ++ ".html"