X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FAbortion.hs;h=6c2d14dd8c9e00cb09923df93b2097975d736ac7;hp=eeb1c6b7675ec1e40ba369c8c25035042d657ec3;hb=1f0a19cbad7c4b64a773d7f1c1ae9180448624e6;hpb=72a3e24a952616e32845eeb4fc05048e841c91a2 diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs index eeb1c6b..6c2d14d 100644 --- a/Network/HTTP/Lucu/Abortion.hs +++ b/Network/HTTP/Lucu/Abortion.hs @@ -9,6 +9,7 @@ -- in any 'Prelude.IO' monads or arrows. module Network.HTTP.Lucu.Abortion ( Abortion(..) + , abort , abortPurely , abortSTM @@ -16,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 @@ -25,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 @@ -49,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 @@ -60,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/")] @@ -98,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 @@ -107,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