X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FAbortion.hs;h=6f09f534429afc9a0f0428d228161e50c1b05744;hp=6c03e8b6732bf5332bbf14792edfda23631a03aa;hb=40c0d61e88920807a91b8f3c4419b08032988d76;hpb=854f6d1709d468f7e1bf0db2dcd2d30de6bd5f5e diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs index 6c03e8b..6f09f53 100644 --- 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