Add mods to StreamBody

This commit is contained in:
Oleg Grenrus 2018-11-09 21:49:53 +02:00
parent bbf196717f
commit 3001ed7990
9 changed files with 35 additions and 32 deletions

View File

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

View File

@ -980,7 +980,7 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
p = Proxy :: Proxy a p = Proxy :: Proxy a
-- | TODO: this instance is incomplete. -- | 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 Proxy (endpoint, action) opts =
docsFor subApiP (endpoint, action') opts docsFor subApiP (endpoint, action') opts
where where

View File

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

View File

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

View File

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

View File

@ -110,14 +110,14 @@ import Servant.API.ReqBody
(ReqBody, ReqBody') (ReqBody, ReqBody')
import Servant.API.ResponseHeaders import Servant.API.ResponseHeaders
(AddHeader, BuildHeadersTo (buildHeadersTo), (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 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.Sub
((:>)) ((:>))
import Servant.API.Vault import Servant.API.Vault

View File

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

View File

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

View File

@ -22,7 +22,7 @@ type RawEndpoint =
"raw" :> Raw "raw" :> Raw
type StreamingEndpoint = 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 = type EmptyEndpoint =
"empty-api" :> EmptyAPI "empty-api" :> EmptyAPI