{-# LANGUAGE OverloadedStrings #-}

module Servant.Server.Lucid
  ( htmlResponse,
    htmlResponse',
  )
where

import Lucid (Html, ToHtml (..), renderBS)
import Network.HTTP.Types.Header
import Servant.Server

-- | Build a 'ServerError' with an HTML body.
--
-- Note that 'ServerError's, despite their name, can represent any type of
-- response, including successful ones.
htmlResponse ::
  -- | HTTP response status code
  Int ->
  [Header] ->
  Html () ->
  ServerError
htmlResponse :: Int -> [Header] -> Html () -> ServerError
htmlResponse = Int -> [Header] -> Html () -> ServerError
forall a. ToHtml a => Int -> [Header] -> a -> ServerError
htmlResponse'

-- | More general version of 'htmlResponse', that can have worse type
-- inference.
htmlResponse' ::
  (ToHtml a) =>
  -- | HTTP response status code
  Int ->
  [Header] ->
  a ->
  ServerError
htmlResponse' :: forall a. ToHtml a => Int -> [Header] -> a -> ServerError
htmlResponse' Int
errHTTPCode [Header]
extraHeaders a
a =
  ServerError
    { Int
errHTTPCode :: Int
errHTTPCode :: Int
errHTTPCode,
      errReasonPhrase :: String
errReasonPhrase = String
"",
      errBody :: ByteString
errBody = Html () -> ByteString
forall a. Html a -> ByteString
renderBS (a -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => a -> HtmlT m ()
toHtml a
a),
      errHeaders :: [Header]
errHeaders =
        [(HeaderName
"Content-Type", ByteString
"text/html;charset=utf-8")] [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
extraHeaders
    }