{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

-- | An @HTML@ empty data type with `MimeRender` instances for @lucid@'s
-- `ToHtml` class and `Html` datatype.
-- You should only need to import this module for it's instances and the
-- `HTML` datatype.:
--
-- >>> type Eg = Get '[HTML] a
--
-- Will then check that @a@ has a `ToHtml` instance, or is `Html`.
module Servant.HTML.Lucid where

import qualified Data.List.NonEmpty as NE
import           Data.Typeable      (Typeable)
import           Lucid              (ToHtml (..), renderBS)
import qualified Network.HTTP.Media as M
import           Servant.API        (Accept (..), MimeRender (..))

data HTML deriving Typeable

-- | @text/html;charset=utf-8@
instance Accept HTML where
    contentTypes :: Proxy HTML -> NonEmpty MediaType
contentTypes Proxy HTML
_ =
      ByteString
"text" ByteString -> ByteString -> MediaType
M.// ByteString
"html" MediaType -> (ByteString, ByteString) -> MediaType
M./: (ByteString
"charset", ByteString
"utf-8") MediaType -> [MediaType] -> NonEmpty MediaType
forall a. a -> [a] -> NonEmpty a
NE.:|
      [ByteString
"text" ByteString -> ByteString -> MediaType
M.// ByteString
"html"]

instance ToHtml a => MimeRender HTML a where
    mimeRender :: Proxy HTML -> a -> ByteString
mimeRender Proxy HTML
_ = Html () -> ByteString
forall a. Html a -> ByteString
renderBS (Html () -> ByteString) -> (a -> Html ()) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml