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
, aeson
, bytestring
, mtl
, servant
, string-conversions
, text

View file

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

View file

@ -1,6 +1,8 @@
{-# LANGUAGE OverloadedStrings #-}
module Servant.API.StreamSpec where
import Control.Monad.Except
(runExcept)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
@ -32,6 +34,11 @@ spec = describe "Servant.API.Stream" $ do
describe "NewlineFraming" $ do
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
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
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
let expected n = map Right [fromString ("foo" ++ show (n :: Int)), "bar", "baz"]
@ -74,6 +86,9 @@ roundtrip
roundtrip render unrender 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 f = go . Effect . flip unSourceT return . f . source where
go :: StepT Identity a -> [Either String a]