1 module Network.HTTP.Lucu.Abortion
3 , abort -- MonadIO m => StatusCode -> [ (String, String) ] -> String -> m a
4 , abortSTM -- StatusCode -> [ (String, String) ] -> String -> STM a
5 , abortA -- ArrowIO a => StatusCode -> [ (String, String) ] -> String -> a b c
6 , aboPage -- Config -> Abortion -> String
11 import Control.Arrow.ArrowIO
12 import Control.Concurrent.STM
13 import Control.Exception
14 import Control.Monad.Trans
15 import GHC.Conc (unsafeIOToSTM)
17 import Network.HTTP.Lucu.Config
18 import Network.HTTP.Lucu.DefaultPage
19 import Network.HTTP.Lucu.Headers
20 import Network.HTTP.Lucu.Response
21 import System.IO.Unsafe
22 import Text.XML.HXT.Arrow.WriteDocument
23 import Text.XML.HXT.Arrow.XmlArrow
24 import Text.XML.HXT.Arrow.XmlIOStateArrow
25 import Text.XML.HXT.DOM.XmlKeywords
28 data Abortion = Abortion {
29 aboStatus :: StatusCode
30 , aboHeaders :: Headers
31 , aboMessage :: String
32 } deriving (Show, Typeable)
35 abort :: MonadIO m => StatusCode -> [ (String, String) ] -> String -> m a
36 abort status headers msg
37 = let abo = Abortion status headers msg
38 exc = DynException (toDyn abo)
43 abortSTM :: StatusCode -> [ (String, String) ] -> String -> STM a
44 abortSTM status headers msg
45 = unsafeIOToSTM $ abort status headers msg
48 abortA :: ArrowIO a => StatusCode -> [ (String, String) ] -> String -> a b c
49 abortA status headers msg
50 = arrIO0 $ abort status headers msg
53 aboPage :: Config -> Abortion -> String
55 = let [html] = unsafePerformIO
56 $ runX ( mkDefaultPage conf (aboStatus abo) (txt $ aboMessage abo)
58 writeDocumentToString [(a_indent, v_1)]