X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FAbortion.hs;h=4e237c4fe1f220fad90e8aaf63060c788b52741a;hb=ea2b7838f1b3d9d4923a220a601be2e04cc559d7;hp=9ef433b15f99361a2e1dbf4f17d288de38ca743e;hpb=69686745233be9269796be9f26621040fb7d9d1c;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs
index 9ef433b..4e237c4 100644
--- a/Network/HTTP/Lucu/Abortion.hs
+++ b/Network/HTTP/Lucu/Abortion.hs
@@ -1,11 +1,9 @@
 {-# LANGUAGE
     Arrows
-  , BangPatterns
   , DeriveDataTypeable
   , TypeOperators
   , UnicodeSyntax
   #-}
-{-# OPTIONS_HADDOCK prune #-}
 
 -- |Aborting the computation of 'Network.HTTP.Lucu.Resource.Resource'
 -- in any 'Prelude.IO' monads or arrows.
@@ -27,6 +25,7 @@ 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
@@ -99,8 +98,8 @@ abortA = proc (status, (headers, msg)) →
 -- aboMessage が Just なら單に mkDefaultPage に渡すだけで良いので樂だが、
 -- Nothing の場合は getDefaultPage を使ってデフォルトのメッセージを得な
 -- ければならない。
-abortPage :: Config → Maybe Request → Response → Abortion → Text
-abortPage !conf !reqM !res !abo
+abortPage :: Config → Maybe Request → Response → Abortion → Lazy.Text
+abortPage conf reqM res abo
     = case aboMessage abo of
         Just msg
             → let [html] = runLA ( mkDefaultPage conf (aboStatus abo) (txt $ T.unpack msg)
@@ -108,7 +107,7 @@ abortPage !conf !reqM !res !abo
                                    writeDocumentToString [ withIndent True ]
                                  ) ()
               in
-                T.pack html
+                Lazy.pack html
         Nothing
             → let res'  = res { resStatus = aboStatus abo }
                   res'' = foldl (∘) id [setHeader name value