)
where
import Blaze.ByteString.Builder (Builder)
-import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
-import Control.Arrow.ListArrow
-import Control.Arrow.Unicode
import Control.Exception
+import Text.Blaze
import Data.Monoid.Unicode
import Data.Text (Text)
-import qualified Data.Text as T
import Data.Typeable
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.DefaultPage
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
-import Text.XML.HXT.Arrow.WriteDocument
-import Text.XML.HXT.Arrow.XmlArrow
-import Text.XML.HXT.Arrow.XmlState
-- |'Abortion' is an 'Exception' that aborts the execution of
-- 'Network.HTTP.Lucu.Rsrc' monad with a 'StatusCode', additional
setHeaders abo hdr = abo { aboHeaders = hdr }
abortPage ∷ Config → Maybe Request → Response → Abortion → Builder
-abortPage conf reqM res abo
+abortPage conf req res abo
= case aboMessage abo of
Just msg
- → let [html] = runLA ( mkDefaultPage conf (aboStatus abo) (txt $ T.unpack msg)
- ⋙
- writeDocumentToString [ withIndent True ]
- ) ()
- in
- BB.fromString html
+ → defaultPageWithMessage conf (aboStatus abo) $ toHtml msg
Nothing
→ let res' = res {
resStatus = aboStatus abo
, resHeaders = resHeaders res ⊕ aboHeaders abo
}
in
- getDefaultPage conf reqM res'
+ defaultPageForResponse conf req res'