From a19fa7dbe9bfcd75db8b42e113fabcf97e40d8bd Mon Sep 17 00:00:00 2001 From: PHO Date: Tue, 4 Oct 2011 15:01:52 +0900 Subject: [PATCH] Bugfix Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa --- Network/HTTP/Lucu/DefaultPage.hs | 6 ++---- Network/HTTP/Lucu/RFC2231.hs | 2 +- Network/HTTP/Lucu/Resource.hs | 6 ++++-- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs index c315424..360a268 100644 --- a/Network/HTTP/Lucu/DefaultPage.hs +++ b/Network/HTTP/Lucu/DefaultPage.hs @@ -10,7 +10,7 @@ module Network.HTTP.Lucu.DefaultPage , mkDefaultPage ) where -import qualified Blaze.ByteString.Builder.ByteString as BB +import qualified Blaze.ByteString.Builder.Char.Utf8 as BB import Control.Arrow import Control.Arrow.ArrowList import Control.Arrow.ListArrow @@ -21,7 +21,6 @@ import qualified Data.Ascii as A import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Lazy as Lazy -import qualified Data.Text.Lazy.Encoding as Lazy import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.Headers import Network.HTTP.Lucu.Interaction @@ -55,8 +54,7 @@ writeDefaultPage !itr let conf = itrConfig itr page = getDefaultPage conf reqM res - putTMVar (itrBodyToSend itr) - (BB.fromLazyByteString $ Lazy.encodeUtf8 page) + putTMVar (itrBodyToSend itr) (BB.fromLazyText page) mkDefaultPage ∷ (ArrowXml a) ⇒ Config → StatusCode → a b XmlTree → a b XmlTree {-# INLINEABLE mkDefaultPage #-} diff --git a/Network/HTTP/Lucu/RFC2231.hs b/Network/HTTP/Lucu/RFC2231.hs index 0f2eb13..9856f47 100644 --- a/Network/HTTP/Lucu/RFC2231.hs +++ b/Network/HTTP/Lucu/RFC2231.hs @@ -32,8 +32,8 @@ import Data.Sequence.Unicode hiding ((∅)) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.ICU.Convert as TC -import Data.Text.ICU.Error import Data.Text.Encoding +import Data.Text.ICU.Error import Data.Traversable import Data.Word import Network.HTTP.Lucu.Parser.Http diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index 0caf6ce..a54e040 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -652,7 +652,8 @@ input limit -- 成功。itr 内にチャンクを置いたままにする -- とメモリの無駄になるので除去。 chunk ← readItr itrReceivedBody seqToLBS itr - writeItr itrReceivedBody (∅) itr + writeItr itrReceivedBody (∅) itr + writeItr itrReceivedBodyLen 0 itr return chunk driftTo DecidingHeader @@ -715,7 +716,8 @@ inputChunk limit $ retry -- 成功 chunk ← readItr itrReceivedBody seqToLBS itr - writeItr itrReceivedBody (∅) itr + writeItr itrReceivedBody (∅) itr + writeItr itrReceivedBodyLen 0 itr return chunk when (Lazy.null chunk) $ driftTo DecidingHeader -- 2.40.0