X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FAbortion.hs;h=26ea8b01e9bc4c6f5da8735e2af12046493dd324;hb=70bf5bd248aa426ca4e410b3fb9a0529354aedaf;hp=52e7e23d6047b2e0fb6d824fa500e1f393269414;hpb=1196f43ecedbb123515065f0440844864af906fb;p=Lucu.git diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs index 52e7e23..26ea8b0 100644 --- a/Network/HTTP/Lucu/Abortion.hs +++ b/Network/HTTP/Lucu/Abortion.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + DeriveDataTypeable + , UnicodeSyntax + #-} {-# OPTIONS_HADDOCK prune #-} -- |Aborting the computation of 'Network.HTTP.Lucu.Resource.Resource' @@ -18,7 +22,7 @@ import Control.Concurrent.STM import Control.Exception import Control.Monad.Trans import qualified Data.ByteString.Char8 as C8 -import Data.Dynamic +import Data.Typeable import GHC.Conc (unsafeIOToSTM) import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.DefaultPage @@ -28,8 +32,7 @@ import Network.HTTP.Lucu.Response import System.IO.Unsafe import Text.XML.HXT.Arrow.WriteDocument import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.Arrow.XmlIOStateArrow -import Text.XML.HXT.DOM.XmlKeywords +import Text.XML.HXT.Arrow.XmlState data Abortion = Abortion { @@ -38,9 +41,7 @@ data Abortion = Abortion { , aboMessage :: !(Maybe String) } deriving (Show, Typeable) -instance Exception Abortion where - toException = SomeException - fromException (SomeException e) = cast e +instance Exception Abortion -- |Computation of @'abort' status headers msg@ aborts the -- 'Network.HTTP.Lucu.Resource.Resource' monad with given status, @@ -104,14 +105,13 @@ abortPage conf reqM res abo -> let [html] = unsafePerformIO $ runX ( mkDefaultPage conf (aboStatus abo) (txt msg) >>> - writeDocumentToString [(a_indent, v_1)] + writeDocumentToString [ withIndent True ] ) in html Nothing -> let res' = res { resStatus = aboStatus abo } res'' = foldl (.) id [setHeader name value - | (name, value) <- fromHeaders $ aboHeaders abo] - $ res' + | (name, value) <- fromHeaders $ aboHeaders abo] res' in getDefaultPage conf reqM res''