X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FAbortion.hs;h=6c2d14dd8c9e00cb09923df93b2097975d736ac7;hp=0099576e62e04c631ae00a528ea0c55cb02eb6c5;hb=1f0a19cbad7c4b64a773d7f1c1ae9180448624e6;hpb=1789cee5ee66d2f7f2b26280be2f13eac4df7980 diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs index 0099576..6c2d14d 100644 --- a/Network/HTTP/Lucu/Abortion.hs +++ b/Network/HTTP/Lucu/Abortion.hs @@ -17,6 +17,8 @@ module Network.HTTP.Lucu.Abortion , abortPage ) where +import Blaze.ByteString.Builder (Builder) +import qualified Blaze.ByteString.Builder.Char.Utf8 as BB import Control.Arrow.ArrowIO import Control.Arrow.ListArrow import Control.Arrow.Unicode @@ -26,7 +28,6 @@ import Control.Monad.Trans import Data.Ascii (Ascii, CIAscii) import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.Lazy as Lazy import Data.Typeable import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.DefaultPage @@ -50,9 +51,8 @@ instance Exception Abortion -- 'Network.HTTP.Lucu.Resource.Resource' monad with given status, -- additional response headers, and optional message string. -- --- What this really does is to throw a special --- 'Control.Exception.Exception'. The exception will be caught by the --- Lucu system. +-- What this really does is to throw an instance of 'Exception'. The +-- exception will be caught by the Lucu system. -- -- 1. If the 'Network.HTTP.Lucu.Resource.Resource' is in the /Deciding -- Header/ or any precedent states, it is possible to use the @@ -61,11 +61,11 @@ instance Exception Abortion -- -- 2. Otherwise the HTTP response can't be modified anymore so the -- only possible thing the system can do is to dump it to the --- stderr. See --- 'Network.HTTP.Lucu.Config.cnfDumpTooLateAbortionToStderr'. +-- stderr. See 'cnfDumpTooLateAbortionToStderr'. -- --- Note that the status code doesn't have to be an error code so you --- can use this action for redirection as well as error reporting e.g. +-- Note that the status code doesn't necessarily have to be an error +-- code so you can use this action for redirection as well as error +-- reporting e.g. -- -- > abort MovedPermanently -- > [("Location", "http://example.net/")] @@ -99,7 +99,7 @@ abortA = proc (status, (headers, msg)) → -- aboMessage が Just なら單に mkDefaultPage に渡すだけで良いので樂だが、 -- Nothing の場合は getDefaultPage を使ってデフォルトのメッセージを得な -- ければならない。 -abortPage ∷ Config → Maybe Request → Response → Abortion → Lazy.Text +abortPage ∷ Config → Maybe Request → Response → Abortion → Builder abortPage conf reqM res abo = case aboMessage abo of Just msg @@ -108,7 +108,7 @@ abortPage conf reqM res abo writeDocumentToString [ withIndent True ] ) () in - Lazy.pack html + BB.fromString html Nothing → let res' = res { resStatus = aboStatus abo } res'' = foldl (∘) id [setHeader name value