From 968b96e0b13b74f964bcd7d82cec2c0e74e9dddd Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 21 Mar 2013 08:42:10 +0200 Subject: [PATCH] sendChunk/sendFlush --- yesod-core/Yesod/Core/Content.hs | 21 ++++++++++++++++++--- yesod-core/Yesod/Core/Handler.hs | 20 ++++++++++++++++++-- yesod-core/test/YesodCoreTest/Streaming.hs | 8 ++++++-- 3 files changed, 42 insertions(+), 7 deletions(-) diff --git a/yesod-core/Yesod/Core/Content.hs b/yesod-core/Yesod/Core/Content.hs index a456d0a7..c697dd31 100644 --- a/yesod-core/Yesod/Core/Content.hs +++ b/yesod-core/Yesod/Core/Content.hs @@ -10,6 +10,7 @@ module Yesod.Core.Content Content (..) , emptyContent , ToContent (..) + , ToFlushBuilder (..) -- * Mime types -- ** Data type , ContentType @@ -94,11 +95,11 @@ instance ToContent B.ByteString where instance ToContent L.ByteString where toContent = flip ContentBuilder Nothing . fromLazyByteString instance ToContent T.Text where - toContent = toContent . Data.Text.Encoding.encodeUtf8 + toContent = toContent . Blaze.fromText instance ToContent Text where - toContent = toContent . Data.Text.Lazy.Encoding.encodeUtf8 + toContent = toContent . Blaze.fromLazyText instance ToContent String where - toContent = toContent . pack + toContent = toContent . Blaze.fromString instance ToContent Html where toContent bs = ContentBuilder (renderHtmlBuilder bs) Nothing instance ToContent () where @@ -113,11 +114,25 @@ instance ToFlushBuilder builder => ToContent (Source (ResourceT IO) builder) whe instance ToFlushBuilder builder => ToContent (ResumableSource (ResourceT IO) builder) where toContent (ResumableSource src _) = toContent src +-- | A class for all data which can be sent in a streaming response. Note that +-- for textual data, instances must use UTF-8 encoding. +-- +-- Since 1.2.0 class ToFlushBuilder a where toFlushBuilder :: a -> Flush Builder instance ToFlushBuilder (Flush Builder) where toFlushBuilder = id instance ToFlushBuilder Builder where toFlushBuilder = Chunk instance ToFlushBuilder (Flush B.ByteString) where toFlushBuilder = fmap fromByteString instance ToFlushBuilder B.ByteString where toFlushBuilder = Chunk . fromByteString +instance ToFlushBuilder (Flush L.ByteString) where toFlushBuilder = fmap fromLazyByteString +instance ToFlushBuilder L.ByteString where toFlushBuilder = Chunk . fromLazyByteString +instance ToFlushBuilder (Flush Text) where toFlushBuilder = fmap Blaze.fromLazyText +instance ToFlushBuilder Text where toFlushBuilder = Chunk . Blaze.fromLazyText +instance ToFlushBuilder (Flush T.Text) where toFlushBuilder = fmap Blaze.fromText +instance ToFlushBuilder T.Text where toFlushBuilder = Chunk . Blaze.fromText +instance ToFlushBuilder (Flush String) where toFlushBuilder = fmap Blaze.fromString +instance ToFlushBuilder String where toFlushBuilder = Chunk . Blaze.fromString +instance ToFlushBuilder (Flush Html) where toFlushBuilder = fmap renderHtmlBuilder +instance ToFlushBuilder Html where toFlushBuilder = Chunk . renderHtmlBuilder repJson :: ToContent a => a -> RepJson repJson = RepJson . toContent diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index 8a0f4745..32a7b3f8 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -56,6 +56,8 @@ module Yesod.Core.Handler -- * Special responses -- ** Streaming , respondSource + , sendChunk + , sendFlush -- ** Redirecting , RedirectUrl (..) , redirect @@ -141,7 +143,7 @@ import Control.Monad.Trans.Resource (MonadResource, liftResourceT) import qualified Network.HTTP.Types as H import qualified Network.Wai as W import Control.Monad.Trans.Class (lift) -import Data.Conduit (transPipe, Flush) +import Data.Conduit (transPipe, Flush (Flush), yield) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With, encodeUtf8) @@ -162,7 +164,7 @@ import Data.Text (Text) import qualified Network.Wai.Parse as NWP import Text.Shakespeare.I18N (RenderMessage (..)) import Web.Cookie (SetCookie (..)) -import Yesod.Core.Content (ToTypedContent (..), simpleContentType, HasContentType (..), ToContent (..)) +import Yesod.Core.Content (ToTypedContent (..), simpleContentType, HasContentType (..), ToContent (..), ToFlushBuilder (..)) import Yesod.Core.Internal.Util (formatRFC1123) import Text.Blaze.Html (preEscapedToMarkup, toHtml) @@ -925,3 +927,17 @@ respondSource ctype src = HandlerT $ \hd -> -- This is a safe assumption assuming the HandlerT is run correctly. return $ TypedContent ctype $ ContentSource $ transPipe (lift . flip unHandlerT hd) src + +-- | In a streaming response, send a single chunk of data. This function works +-- on most datatypes, such as @ByteString@ and @Html@. +-- +-- Since 1.2.0 +sendChunk :: ToFlushBuilder a => a -> Source (HandlerT site IO) (Flush Builder) +sendChunk = yield . toFlushBuilder + +-- | In a streaming response, send a flush command, causing all buffered data +-- to be immediately sent to the client. +-- +-- Since 1.2.0 +sendFlush :: Source (HandlerT site IO) (Flush Builder) +sendFlush = yield Flush diff --git a/yesod-core/test/YesodCoreTest/Streaming.hs b/yesod-core/test/YesodCoreTest/Streaming.hs index 27236f01..090adb6e 100644 --- a/yesod-core/test/YesodCoreTest/Streaming.hs +++ b/yesod-core/test/YesodCoreTest/Streaming.hs @@ -5,11 +5,15 @@ import Yesod.Core import Test.Hspec import Network.Wai.Test import Data.Conduit +import Data.Text (Text) +import Data.ByteString (ByteString) import Blaze.ByteString.Builder (fromByteString) app :: LiteApp -app = dispatchTo $ respondSource typeHtml $ - yield $ Chunk $ fromByteString "Hello World!" +app = dispatchTo $ respondSource typeHtml $ do + sendChunk ("Hello " :: String) + sendChunk ("World" :: ByteString) + sendChunk ("!" :: Text) test :: String -> (SResponse -> Session ())