Network.HTTP.Lucu

[Lucu.git] / Network / HTTP / Lucu / Abortion.hs

diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs
index 6c03e8b6732bf5332bbf14792edfda23631a03aa..6f09f534429afc9a0f0428d228161e50c1b05744 100644 (file)
--- a/Network/HTTP/Lucu/Abortion.hs
+++ b/Network/HTTP/Lucu/Abortion.hs
@@ -58,24 +58,25 @@ abortA status headers msg
 -- がある。
 abortPage :: Config -> Maybe Request -> Maybe Response -> Abortion -> String
 abortPage conf reqM resM abo
-    = let msg    = case aboMessage abo of
-                     Just msg -> msg
-                     Nothing  -> let res' = case resM of
-                                              Just res -> res { resStatus = aboStatus abo }
-                                              Nothing  -> Response {
-                                                            resVersion = HttpVersion 1 1
-                                                          , resStatus  = aboStatus abo
-                                                          , resHeaders = []
-                                                          }
-                                     res  = foldl (.) id [setHeader name value
-                                                              | (name, value) <- aboHeaders abo]
-                                            $ res'
-                                 in
-                                   getDefaultPage conf reqM res
-          [html] = unsafePerformIO 
-                   $ runX ( mkDefaultPage conf (aboStatus abo) (txt msg)
-                            >>>
-                            writeDocumentToString [(a_indent, v_1)]
-                          )
-      in
-        html
+    = case aboMessage abo of
+        Just msg
+            -> let [html] = unsafePerformIO 
+                            $ runX ( mkDefaultPage conf (aboStatus abo) (txt msg)
+                                     >>>
+                                     writeDocumentToString [(a_indent, v_1)]
+                                   )
+               in
+                 html
+        Nothing
+            -> let res' = case resM of
+                            Just res -> res { resStatus = aboStatus abo }
+                            Nothing  -> Response {
+                                          resVersion = HttpVersion 1 1
+                                        , resStatus  = aboStatus abo
+                                        , resHeaders = []
+                                        }
+                   res  = foldl (.) id [setHeader name value
+                                            | (name, value) <- aboHeaders abo]
+                          $ res'
+               in
+                 getDefaultPage conf reqM res