{-# LANGUAGE QuasiQuotes #-} module Hack.Contrib.ShowStatus where import Hack import Hack.Utils import Hack.Constants import Hack.Request hiding (body) import Hack.Response import MPSUTF8 import Prelude hiding ((.), (^), (>), head) import Data.Maybe show_status :: MiddleWare show_status app = \env -> do response <- app env let content_length = response.header _ContentLength .fromMaybe "0" let content_empty = content_length .read .(<= 0) if response.status >= 400 && content_empty then let i = response.status message = i.show_status_code .fromMaybe (i.show) detail = env.custom_"hack.showstatus.detail" .fromMaybe message result = template message detail env response size = result.bytesize in return $ response .set_body result .set_content_type _TextHtml .set_content_length size else return response template message detail env response = let h = escape_html in [$here| #{h message } at #{h (env.path.url2unicode) }

#{h message } (#{ response.status })

Request Method: #{ env.request_method }
Request URL: #{h (env.url.url2unicode) }

#{h detail }

You're seeing this error because you use Hack.Contrib.ShowStatus.

|]