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

Add a test for the overlapping WithStatus MimeRender instances

Browse source
This commit is contained in:
Fraser Murray 2020-11-24 16:04:05 +00:00
parent 57badc7c74
commit ebc7d40e70
1 changed files with 5 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -53,7 +53,7 @@ import Servant.API
NoContent (..), NoContentVerb, NoFraming, OctetStream, Patch, NoContent (..), NoContentVerb, NoFraming, OctetStream, Patch,
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw, PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Strict, RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Strict,
UVerb, Union, Verb, addHeader) UVerb, Union, Verb, WithStatus (..), addHeader)
import Servant.Server import Servant.Server
(Context ((:.), EmptyContext), Handler, Server, Tagged (..), (Context ((:.), EmptyContext), Handler, Server, Tagged (..),
emptyServer, err401, err403, err404, respond, serve, emptyServer, err401, err403, err404, respond, serve,
@ -841,7 +841,7 @@ instance HasStatus AnimalResponse where
type UVerbApi type UVerbApi
= "person" :> Capture "shouldRedirect" Bool :> UVerb 'GET '[JSON] '[PersonResponse, RedirectResponse] = "person" :> Capture "shouldRedirect" Bool :> UVerb 'GET '[JSON] '[PersonResponse, RedirectResponse]
:<|> "animal" :> UVerb 'GET '[JSON] '[AnimalResponse] :<|> "animal" :> UVerb 'GET '[JSON] '[WithStatus 203 AnimalResponse]
uverbSpec :: Spec uverbSpec :: Spec
uverbSpec = describe "Servant.API.UVerb " $ do uverbSpec = describe "Servant.API.UVerb " $ do
@ -856,7 +856,9 @@ uverbSpec = describe "Servant.API.UVerb " $ do
personHandler True = respond $ RedirectResponse "over there!" personHandler True = respond $ RedirectResponse "over there!"
personHandler False = respond $ PersonResponse joe personHandler False = respond $ PersonResponse joe
animalHandler = respond $ AnimalResponse mouse animalHandler :: Handler (Union '[WithStatus 203 AnimalResponse])
animalHandler = respond $
(WithStatus $ AnimalResponse mouse :: WithStatus 203 AnimalResponse)
server :: Server UVerbApi server :: Server UVerbApi
server = personHandler :<|> animalHandler server = personHandler :<|> animalHandler