git.iko.soy/typeable/servant
on master help sign in
Merge pull request #1079 from haskell-servant/issue-1011

Fix issue #1011: NewlineFraming encodes newline after each element

commit44aabebb04b47d1049319704180e832f51abc4fc authorOleg Grenrus <oleg.grenrus@iki.fi> dateMon 12 Nov 2018, 22:01 (8 years ago) parentd64c232f1eb5f9
3 files changed+19−10
compare with master
unifiedsplit
servant/servant.cabal+1 servant/src/Servant/API/Stream.hs+3−10 servant/test/Servant/API/StreamSpec.hs+15
servant/servant.cabal+1
@@ -155,6 +155,7 @@ test-suite spec
155155 , base-compat
156156 , aeson
157157 , bytestring
158+ , mtl
158159 , servant
159160 , string-conversions
160161 , text
servant/src/Servant/API/Stream.hs+3−10
@@ -187,20 +187,13 @@ instance FramingUnrender NoFraming where
187187-- NewlineFraming
188188-------------------------------------------------------------------------------
189189
190−-- | A simple framing strategy that has no header or termination, and inserts a
191−-- newline character between each frame. This assumes that it is used with a
190+-- | A simple framing strategy that has no header, and inserts a
191+-- newline character after each frame. This assumes that it is used with a
192192-- Content-Type that encodes without newlines (e.g. JSON).
193193data NewlineFraming
194194
195195instance FramingRender NewlineFraming where
196− framingRender _ f = mapStepT go0 where
197− go0 Stop = Stop
198− go0 (Error err) = Error err
199− go0 (Skip s) = Skip (go0 s)
200− go0 (Yield x s) = Yield (f x) (go s)
201− go0 (Effect ms) = Effect (fmap go0 ms)
202−
203− go = fmap (\x -> "\n" <> f x)
196+ framingRender _ f = fmap (\x -> f x <> "\n")
204197
205198instance FramingUnrender NewlineFraming where
206199 framingUnrender _ f = transformWithAtto $ do
servant/test/Servant/API/StreamSpec.hs+15
@@ -1,6 +1,8 @@
11{-# LANGUAGE OverloadedStrings #-}
22module Servant.API.StreamSpec where
33
4+import Control.Monad.Except
5+ (runExcept)
46import qualified Data.Aeson as Aeson
57import qualified Data.ByteString as BS
68import qualified Data.ByteString.Lazy as LBS
@@ -32,6 +34,11 @@ spec = describe "Servant.API.Stream" $ do
3234
3335 describe "NewlineFraming" $ do
3436 let tp = framingUnrender (Proxy :: Proxy NewlineFraming) (Right . LBS.toStrict)
37+ let re = framingRender (Proxy :: Proxy NewlineFraming) id
38+
39+ it "framingRender examples" $ do
40+ runRenderFrames re [] `shouldBe` Right ""
41+ runRenderFrames re ["foo", "bar", "baz"] `shouldBe` Right "foo\nbar\nbaz\n"
3542
3643 it "framingUnrender examples" $ do
3744 let expected n = map Right [fromString ("foo" ++ show (n :: Int)), "bar", "baz"]
@@ -51,6 +58,11 @@ spec = describe "Servant.API.Stream" $ do
5158
5259 describe "NetstringFraming" $ do
5360 let tp = framingUnrender (Proxy :: Proxy NetstringFraming) (Right . LBS.toStrict)
61+ let re = framingRender (Proxy :: Proxy NetstringFraming) id
62+
63+ it "framingRender examples" $ do
64+ runRenderFrames re [] `shouldBe` Right ""
65+ runRenderFrames re ["foo", "bar", "baz"] `shouldBe` Right "3:foo,3:bar,3:baz,"
5466
5567 it "framingUnrender examples" $ do
5668 let expected n = map Right [fromString ("foo" ++ show (n :: Int)), "bar", "baz"]
@@ -74,6 +86,9 @@ roundtrip
7486roundtrip render unrender xs =
7587 map Right xs === runUnrenderFrames (unrender . fmap LBS.toStrict . render) xs
7688
89+runRenderFrames :: (SourceT Identity a -> SourceT Identity LBS.ByteString) -> [a] -> Either String LBS.ByteString
90+runRenderFrames f = fmap mconcat . runExcept . runSourceT . f . source
91+
7792runUnrenderFrames :: (SourceT Identity b -> SourceT Identity a) -> [b] -> [Either String a]
7893runUnrenderFrames f = go . Effect . flip unSourceT return . f . source where
7994 go :: StepT Identity a -> [Either String a]