eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

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

Browse source 
Add mods to StreamBody
This commit is contained in:
Oleg Grenrus 2018-11-09 23:10:13 +02:00 committed by GitHub
commit ce83e4b404
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
9 changed files with 35 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

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

2
servant-docs/src/Servant/Docs/Internal.hs
View file

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

4
servant-foreign/src/Servant/Foreign/Internal.hs
View file

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

6
servant-server/src/Servant/Server/Internal.hs
View file

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

20
servant-server/test/Servant/ServerSpec.hs
View file

@ -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.Base64 as Base64
import qualified Data.ByteString as BS
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,
SourceIO, Verb, addHeader)
import Servant.Test.ComprehensiveAPI
RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb,
addHeader)
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)

14
servant/src/Servant/API.hs
View file

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

7
servant/src/Servant/API/Stream.hs
View file

@ -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.
--
-- TODO: add mods
data StreamBody (framing :: *) (contentType :: *) (a :: *)
type StreamBody = StreamBody' '[]
data StreamBody' (mods :: [*]) (framing :: *) (contentType :: *) (a :: *)
deriving (Typeable, Generic)
-------------------------------------------------------------------------------

6
servant/src/Servant/Links.hs
View file

@ -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
type MkLink (StreamBody framing ct a :> sub) r = MkLink sub r
instance HasLink sub => HasLink (StreamBody' mods framing ct a :> sub) where
type MkLink (StreamBody' mods framing ct a :> sub) r = MkLink sub r
toLink toA _ = toLink toA (Proxy :: Proxy sub)
instance (ToHttpApiData v, HasLink sub)

2
servant/src/Servant/Test/ComprehensiveAPI.hs
View file

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