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

Fix issue #1011: NewlineFraming encodes newline after each element

servant/servant.cabal

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

servant/src/Servant/API/Stream.hs

@@ -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

servant/test/Servant/API/StreamSpec.hs

@@ -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]