diff --git a/servant/servant.cabal b/servant/servant.cabal index 94e0ad1e..7ad0ff40 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -155,6 +155,7 @@ test-suite spec , base-compat , aeson , bytestring + , mtl , servant , string-conversions , text 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 f172f7a5..74eac52a 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\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]