{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Module copied and adapted from https://hackage.haskell.org/package/servant-lucid-0.9.0.6
--
-- An @HTML@ empty data type with 'Servant.API.MimeRender' instances for
-- any type which is an instance of @lucid2@'s 'Lucid.ToHtml':
--
-- >>> type Example = Get '[HTML] a
--
-- (Here the type @a@ should have a 'Lucid.ToHtml' instance.)
module Servant.API.ContentTypes.Lucid
  ( HTML,
  )
where

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

data HTML deriving stock (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 ()
forall (m :: * -> *). Monad m => a -> HtmlT m ()
toHtml