Merge pull request #1079 from haskell-servant/issue-1011

Fix issue #1011: NewlineFraming encodes newline after each element
This commit is contained in:
Oleg Grenrus 2018-11-12 22:01:14 +02:00 committed by GitHub
commit 44aabebb04
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
3 changed files with 19 additions and 10 deletions

View file

@ -155,6 +155,7 @@ test-suite spec
, base-compat , base-compat
, aeson , aeson
, bytestring , bytestring
, mtl
, servant , servant
, string-conversions , string-conversions
, text , text

View file

@ -187,20 +187,13 @@ instance FramingUnrender NoFraming where
-- NewlineFraming -- NewlineFraming
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- | A simple framing strategy that has no header or termination, and inserts a -- | A simple framing strategy that has no header, and inserts a
-- newline character between each frame. This assumes that it is used with a -- newline character after each frame. This assumes that it is used with a
-- Content-Type that encodes without newlines (e.g. JSON). -- Content-Type that encodes without newlines (e.g. JSON).
data NewlineFraming data NewlineFraming
instance FramingRender NewlineFraming where instance FramingRender NewlineFraming where
framingRender _ f = mapStepT go0 where framingRender _ f = fmap (\x -> f x <> "\n")
go0 Stop = Stop
go0 (Error err) = Error err
go0 (Skip s) = Skip (go0 s)
go0 (Yield x s) = Yield (f x) (go s)
go0 (Effect ms) = Effect (fmap go0 ms)
go = fmap (\x -> "\n" <> f x)
instance FramingUnrender NewlineFraming where instance FramingUnrender NewlineFraming where
framingUnrender _ f = transformWithAtto $ do framingUnrender _ f = transformWithAtto $ do

View file

@ -1,6 +1,8 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Servant.API.StreamSpec where module Servant.API.StreamSpec where
import Control.Monad.Except
(runExcept)
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
@ -32,6 +34,11 @@ spec = describe "Servant.API.Stream" $ do
describe "NewlineFraming" $ do describe "NewlineFraming" $ do
let tp = framingUnrender (Proxy :: Proxy NewlineFraming) (Right . LBS.toStrict) let tp = framingUnrender (Proxy :: Proxy NewlineFraming) (Right . LBS.toStrict)
let re = framingRender (Proxy :: Proxy NewlineFraming) id
it "framingRender examples" $ do
runRenderFrames re [] `shouldBe` Right ""
runRenderFrames re ["foo", "bar", "baz"] `shouldBe` Right "foo\nbar\nbaz\n"
it "framingUnrender examples" $ do it "framingUnrender examples" $ do
let expected n = map Right [fromString ("foo" ++ show (n :: Int)), "bar", "baz"] let expected n = map Right [fromString ("foo" ++ show (n :: Int)), "bar", "baz"]
@ -51,6 +58,11 @@ spec = describe "Servant.API.Stream" $ do
describe "NetstringFraming" $ do describe "NetstringFraming" $ do
let tp = framingUnrender (Proxy :: Proxy NetstringFraming) (Right . LBS.toStrict) let tp = framingUnrender (Proxy :: Proxy NetstringFraming) (Right . LBS.toStrict)
let re = framingRender (Proxy :: Proxy NetstringFraming) id
it "framingRender examples" $ do
runRenderFrames re [] `shouldBe` Right ""
runRenderFrames re ["foo", "bar", "baz"] `shouldBe` Right "3:foo,3:bar,3:baz,"
it "framingUnrender examples" $ do it "framingUnrender examples" $ do
let expected n = map Right [fromString ("foo" ++ show (n :: Int)), "bar", "baz"] let expected n = map Right [fromString ("foo" ++ show (n :: Int)), "bar", "baz"]
@ -74,6 +86,9 @@ roundtrip
roundtrip render unrender xs = roundtrip render unrender xs =
map Right xs === runUnrenderFrames (unrender . fmap LBS.toStrict . render) xs map Right xs === runUnrenderFrames (unrender . fmap LBS.toStrict . render) xs
runRenderFrames :: (SourceT Identity a -> SourceT Identity LBS.ByteString) -> [a] -> Either String LBS.ByteString
runRenderFrames f = fmap mconcat . runExcept . runSourceT . f . source
runUnrenderFrames :: (SourceT Identity b -> SourceT Identity a) -> [b] -> [Either String a] runUnrenderFrames :: (SourceT Identity b -> SourceT Identity a) -> [b] -> [Either String a]
runUnrenderFrames f = go . Effect . flip unSourceT return . f . source where runUnrenderFrames f = go . Effect . flip unSourceT return . f . source where
go :: StepT Identity a -> [Either String a] go :: StepT Identity a -> [Either String a]