]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/Abortion/Internal.hs
Use blaze-html instead of HXT.
[Lucu.git] / Network / HTTP / Lucu / Abortion / Internal.hs
index 69d7a9e9b247ce23a7b725afca47964e70ca616d..a1ff54c5be0d209cf4cfcb30867d8b4d04982441 100644 (file)
@@ -8,22 +8,16 @@ module Network.HTTP.Lucu.Abortion.Internal
     )
     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
@@ -59,19 +53,14 @@ instance HasHeaders Abortion where
     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'