sendChunk/sendFlush

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

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

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 $
+app = dispatchTo $ respondSource typeHtml $ do
-    yield $ Chunk $ fromByteString "Hello World!"
+    sendChunk ("Hello " :: String)
+    sendChunk ("World" :: ByteString)
+    sendChunk ("!" :: Text)
 
 test :: String
      -> (SResponse -> Session ())