-mkDefaultPage ∷ (ArrowXml (⇝), StatusCode sc)
- ⇒ Config
- → sc
- → b ⇝ XmlTree
- → b ⇝ XmlTree
-{-# INLINEABLE mkDefaultPage #-}
-mkDefaultPage conf status msgA
- = let sStr = A.toString $ A.fromAsciiBuilder $ printStatusCode status
- sig = concat [ A.toString (cnfServerSoftware conf)
- , " at "
- , T.unpack (cnfServerHost conf)
- ]
- in ( eelem "/"
- += ( eelem "html"
- += sattr "xmlns" "http://www.w3.org/1999/xhtml"
- += ( eelem "head"
- += ( eelem "title"
- += txt sStr
- ))
- += ( eelem "body"
- += ( eelem "h1"
- += txt sStr
- )
- += ( eelem "p" += msgA )
- += eelem "hr"
- += ( eelem "address" += txt sig ))))
+defaultPageWithMessage ∷ ∀sc. StatusCode sc ⇒ Config → sc → Html → Builder
+{-# INLINEABLE defaultPageWithMessage #-}
+defaultPageWithMessage (Config {..}) sc msg
+ = renderHtmlBuilder $
+ do unsafeByteString "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
+ docType
+ html ! xmlns "http://www.w3.org/1999/xhtml" $
+ do let status = toHtml $ scText sc
+ head $ title status
+ body $ do h1 status
+ p msg
+ hr
+ address $ do toHtml (cs cnfServerSoftware ∷ Text)
+ unsafeByteString " at "
+ toHtml $ CI.original cnfServerHost
+ where
+ scText ∷ sc → Text
+ scText = convertSuccessVia ((⊥) ∷ Ascii) ∘ fromStatusCode