From 17f92379804622e75a24389fbe76c8361fcfa13c Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Sat, 10 Nov 2018 01:20:57 +0200
Subject: [PATCH 1/2] Add framingRender examples

---
 servant/servant.cabal                  |  1 +
 servant/test/Servant/API/StreamSpec.hs | 15 +++++++++++++++
 2 files changed, 16 insertions(+)

diff --git a/servant/servant.cabal b/servant/servant.cabal
index 99b1f7f7..2f756628 100644
--- a/servant/servant.cabal
+++ b/servant/servant.cabal
@@ -150,6 +150,7 @@ test-suite spec
     , base-compat
     , aeson
     , bytestring
+    , mtl
     , servant
     , string-conversions
     , text
diff --git a/servant/test/Servant/API/StreamSpec.hs b/servant/test/Servant/API/StreamSpec.hs
index f172f7a5..aa3d0626 100644
--- a/servant/test/Servant/API/StreamSpec.hs
+++ b/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"
 
         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]

From f1eb5f93a816d95d4b8ffe58adb691506aad2d08 Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Sat, 10 Nov 2018 00:22:04 +0200
Subject: [PATCH 2/2] Fix issue #1011: NewlineFraming encodes newline after
 each element

---
 servant/src/Servant/API/Stream.hs      | 13 +++----------
 servant/test/Servant/API/StreamSpec.hs |  2 +-
 2 files changed, 4 insertions(+), 11 deletions(-)

diff --git a/servant/src/Servant/API/Stream.hs b/servant/src/Servant/API/Stream.hs
index 379a8d47..64164f5a 100644
--- a/servant/src/Servant/API/Stream.hs
+++ b/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
diff --git a/servant/test/Servant/API/StreamSpec.hs b/servant/test/Servant/API/StreamSpec.hs
index aa3d0626..74eac52a 100644
--- a/servant/test/Servant/API/StreamSpec.hs
+++ b/servant/test/Servant/API/StreamSpec.hs
@@ -38,7 +38,7 @@ spec = describe "Servant.API.Stream" $ do
 
         it "framingRender examples" $ do
             runRenderFrames re [] `shouldBe` Right ""
-            runRenderFrames re ["foo", "bar", "baz"] `shouldBe` Right "foo\nbar\nbaz"
+            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"]