X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FAbortion%2FInternal.hs;h=a1ff54c5be0d209cf4cfcb30867d8b4d04982441;hp=69d7a9e9b247ce23a7b725afca47964e70ca616d;hb=c060bff37e29f06e105c0ec2b1f844f55b48906c;hpb=0eeff925cd64a4f38ad6f0e882f9c3bcb9c3f364

diff --git a/Network/HTTP/Lucu/Abortion/Internal.hs b/Network/HTTP/Lucu/Abortion/Internal.hs
index 69d7a9e..a1ff54c 100644
--- a/Network/HTTP/Lucu/Abortion/Internal.hs
+++ b/Network/HTTP/Lucu/Abortion/Internal.hs
@@ -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'