Merge pull request #1077 from phadej/stream-body-mods

Add mods to StreamBody

servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs

@@ -40,7 +40,7 @@ import           Servant.API
                  Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender),
                  MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
                  QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
-                 ReqBody', SBoolI, Stream, StreamBody, Summary, ToHttpApiData,
+                 ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,
                  Vault, Verb, WithNamedContext, contentType, getHeadersHList,
                  getResponse, toQueryParam, toUrlPiece)
 import           Servant.API.ContentTypes
@@ -539,10 +539,10 @@ instance (MimeRender ct a, HasClient m api)
 
 instance
     ( HasClient m api
-    ) => HasClient m (StreamBody framing ctype a :> api)
+    ) => HasClient m (StreamBody' mods framing ctype a :> api)
   where
 
-    type Client m (StreamBody framing ctype a :> api) = a -> Client m api
+    type Client m (StreamBody' mods framing ctype a :> api) = a -> Client m api
 
     hoistClientMonad pm _ f cl = \a ->
       hoistClientMonad pm (Proxy :: Proxy api) f (cl a)

servant-docs/src/Servant/Docs/Internal.hs

@@ -980,7 +980,7 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
           p = Proxy :: Proxy a
 
 -- | TODO: this instance is incomplete.
-instance (HasDocs api, Accept ctype) => HasDocs (StreamBody framing ctype a :> api) where
+instance (HasDocs api, Accept ctype) => HasDocs (StreamBody' mods framing ctype a :> api) where
     docsFor Proxy (endpoint, action) opts =
         docsFor subApiP (endpoint, action') opts
       where

servant-foreign/src/Servant/Foreign/Internal.hs

@@ -328,9 +328,9 @@ instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype api
 
 instance
     ( HasForeign lang ftype api
-    ) =>  HasForeign lang ftype (StreamBody framing ctype a :> api)
+    ) =>  HasForeign lang ftype (StreamBody' mods framing ctype a :> api)
   where
-    type Foreign ftype (StreamBody framing ctype a :> api) = Foreign ftype api
+    type Foreign ftype (StreamBody' mods framing ctype a :> api) = Foreign ftype api
 
     foreignFor _lang Proxy Proxy _req = error "HasForeign @StreamBody"
 

servant-server/src/Servant/Server/Internal.hs

@@ -71,7 +71,7 @@ import           Servant.API
                  FramingUnrender (..), FromSourceIO (..), Header', If,
                  IsSecure (..), QueryFlag, QueryParam', QueryParams, Raw,
                  ReflectMethod (reflectMethod), RemoteHost, ReqBody',
-                 SBool (..), SBoolI (..), SourceIO, Stream, StreamBody,
+                 SBool (..), SBoolI (..), SourceIO, Stream, StreamBody',
                  Summary, ToSourceIO (..), Vault, Verb, WithNamedContext)
 import           Servant.API.ContentTypes
                  (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
@@ -610,9 +610,9 @@ instance ( AllCTUnrender list a, HasServer api context, SBoolI (FoldLenient mods
 instance
     ( FramingUnrender framing, FromSourceIO chunk a, MimeUnrender ctype chunk
     , HasServer api context
-    ) => HasServer (StreamBody framing ctype a :> api) context
+    ) => HasServer (StreamBody' mods framing ctype a :> api) context
   where
-    type ServerT (StreamBody framing ctype a :> api) m = a -> ServerT api m
+    type ServerT (StreamBody' mods framing ctype a :> api) m = a -> ServerT api m
 
     hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
 

servant-server/test/Servant/ServerSpec.hs

@@ -12,24 +12,26 @@
 
 module Servant.ServerSpec where
 
+import           Prelude ()
+import           Prelude.Compat
+
 import           Control.Monad
                  (forM_, unless, when)
 import           Control.Monad.Error.Class
                  (MonadError (..))
 import           Data.Aeson
                  (FromJSON, ToJSON, decode', encode)
-import qualified Data.ByteString                            as BS
+import qualified Data.ByteString                   as BS
-import qualified Data.ByteString.Base64                     as Base64
+import qualified Data.ByteString.Base64            as Base64
 import           Data.Char
                  (toUpper)
-import           Data.Monoid
 import           Data.Proxy
                  (Proxy (Proxy))
 import           Data.String
                  (fromString)
 import           Data.String.Conversions
                  (cs)
-import qualified Data.Text                                  as T
+import qualified Data.Text                         as T
 import           GHC.Generics
                  (Generic)
 import           Network.HTTP.Types
@@ -42,25 +44,25 @@ import           Network.Wai
 import           Network.Wai.Test
                  (defaultRequest, request, runSession, simpleBody,
                  simpleHeaders, simpleStatus)
-import qualified Servant.Types.SourceT as S
 import           Servant.API
                  ((:<|>) (..), (:>), AuthProtect, BasicAuth,
                  BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,
                  EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
                  JSON, NoContent (..), NoFraming, OctetStream, Patch,
                  PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
-                 RemoteHost, ReqBody, StdMethod (..), Stream,
+                 RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb,
-                 SourceIO, Verb, addHeader)
+                 addHeader)
-import           Servant.Test.ComprehensiveAPI
 import           Servant.Server
                  (Context ((:.), EmptyContext), Handler, Server, Tagged (..),
                  emptyServer, err401, err403, err404, serve, serveWithContext)
+import           Servant.Test.ComprehensiveAPI
+import qualified Servant.Types.SourceT             as S
 import           Test.Hspec
                  (Spec, context, describe, it, shouldBe, shouldContain)
 import           Test.Hspec.Wai
                  (get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
                  with, (<:>))
-import qualified Test.Hspec.Wai                             as THW
+import qualified Test.Hspec.Wai                    as THW
 
 import           Servant.Server.Experimental.Auth
                  (AuthHandler, AuthServerData, mkAuthHandler)

servant/src/Servant/API.hs

@@ -110,14 +110,14 @@ import           Servant.API.ReqBody
                  (ReqBody, ReqBody')
 import           Servant.API.ResponseHeaders
                  (AddHeader, BuildHeadersTo (buildHeadersTo),
-                 GetHeaders (getHeaders), HList (..), Headers (..),
+                 GetHeaders (getHeaders), HList (..), HasResponseHeader,
-                 ResponseHeader (..), addHeader, getHeadersHList, getResponse,
+                 Headers (..), ResponseHeader (..), addHeader, getHeadersHList,
-                 noHeader, HasResponseHeader, lookupResponseHeader)
+                 getResponse, lookupResponseHeader, noHeader)
 import           Servant.API.Stream
-                 (FramingRender (..), FramingUnrender (..),
+                 (FramingRender (..), FramingUnrender (..), FromSourceIO (..),
-                 FromSourceIO (..), NetstringFraming, NewlineFraming,
+                 NetstringFraming, NewlineFraming, NoFraming, SourceIO, Stream,
-                 NoFraming, SourceIO, Stream, StreamBody, SourceIO,
+                 StreamBody, StreamBody', StreamGet, StreamPost,
-                 StreamGet, StreamPost, ToSourceIO (..))
+                 ToSourceIO (..))
 import           Servant.API.Sub
                  ((:>))
 import           Servant.API.Vault

servant/src/Servant/API/Stream.hs

@@ -17,6 +17,7 @@ module Servant.API.Stream (
     StreamGet,
     StreamPost,
     StreamBody,
+    StreamBody',
     -- * Source
     --
     -- | 'SourceIO' are equivalent to some *source* in streaming libraries.
@@ -71,9 +72,9 @@ type StreamGet  = Stream 'GET 200
 type StreamPost = Stream 'POST 200
 
 -- | A stream request body.
---
+type StreamBody = StreamBody' '[]
--- TODO: add mods
+
-data StreamBody (framing :: *) (contentType :: *) (a :: *)
+data StreamBody' (mods :: [*]) (framing :: *) (contentType :: *) (a :: *)
   deriving (Typeable, Generic)
 
 -------------------------------------------------------------------------------

servant/src/Servant/Links.hs

@@ -170,7 +170,7 @@ import           Servant.API.RemoteHost
 import           Servant.API.ReqBody
                  (ReqBody')
 import           Servant.API.Stream
-                 (Stream, StreamBody)
+                 (Stream, StreamBody')
 import           Servant.API.Sub
                  (type (:>))
 import           Servant.API.TypeLevel
@@ -482,8 +482,8 @@ instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
     type MkLink (ReqBody' mods ct a :> sub) r = MkLink sub r
     toLink toA _ = toLink toA (Proxy :: Proxy sub)
 
-instance HasLink sub => HasLink (StreamBody framing ct a :> sub) where
+instance HasLink sub => HasLink (StreamBody' mods framing ct a :> sub) where
-    type MkLink (StreamBody framing ct a :> sub) r = MkLink sub r
+    type MkLink (StreamBody' mods framing ct a :> sub) r = MkLink sub r
     toLink toA _ = toLink toA (Proxy :: Proxy sub)
 
 instance (ToHttpApiData v, HasLink sub)

servant/src/Servant/Test/ComprehensiveAPI.hs

@@ -22,7 +22,7 @@ type RawEndpoint =
     "raw" :> Raw
 
 type StreamingEndpoint =
-    "streaming" :> StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int)
+    "streaming" :> StreamBody' '[Description "netstring"] NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int)
 
 type EmptyEndpoint =
     "empty-api" :> EmptyAPI