Skip to content

Commit

Permalink
Simplified ErrorResponse
Browse files Browse the repository at this point in the history
  • Loading branch information
theophile-scrive committed Aug 28, 2024
1 parent a3f8ef7 commit 046d35f
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 22 deletions.
43 changes: 23 additions & 20 deletions servant-client/test/Servant/ClientTestUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -145,30 +145,33 @@ instance ToDeepQuery Filter where
, (["name"], Just (Text.pack name'))
]

-- MultiVerb test endpoint
-----------------------------
-- MultiVerb test endpoint --
-----------------------------

data ErrorResponse a
-- Possible errors

data UserNotFound
type GetUserMultiVerbErrors =
'[RespondEmpty 404 "User not found"]

type instance ResponseType (ErrorResponse a) = a
-- This is the concatenation of possible responses
type GetUserMultiVerbResponses =
GetUserMultiVerbErrors
.++ '[Respond 200 "User found" Person]

-- A 'AsUnion' instance
instance (res ~ GetUserMultiVerbResponses) => AsUnion res (Maybe Person) where
toUnion = maybeToUnion (toUnion @GetUserMultiVerbErrors)
fromUnion = maybeFromUnion (fromUnion @GetUserMultiVerbErrors)

-- This is our endpoint description
type GetUserMultiVerb =
Capture "personId" Int
:> MultiVerb
'GET
'[JSON]
'[ ErrorResponse UserNotFound,
Respond 200 "User found" Person
]
(Either UserNotFound Person)

type GetUserMultiVerbResponses =
[ErrorResponse UserNotFound, RespondAs JSON 200 "Person" Person]

instance (res ~ GetUserMultiVerbResponses) => AsUnion res (Either UserNotFound Person) where
toUnion = eitherToUnion (toUnion @_) (Z . I)
fromUnion = eitherFromUnion (fromUnion @_) (unI . unZ)
GetUserMultiVerbResponses
(Maybe Person)

type Api =
Get '[JSON] Person
Expand Down Expand Up @@ -212,8 +215,8 @@ type Api =
WithStatus 301 Text]
:<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]
:<|> NamedRoutes RecordRoutes
:<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text
:<|> GetUserMultiVerb
:<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text

api :: Proxy Api
api = Proxy
Expand Down Expand Up @@ -247,8 +250,8 @@ uverbGetSuccessOrRedirect :: Bool
WithStatus 301 Text])
uverbGetCreated :: ClientM (Union '[WithStatus 201 Person])
recordRoutes :: RecordRoutes (AsClientT ClientM)
captureVerbatim :: Verbatim -> ClientM Text
getUserMultiVerb :: Int -> ClientM (Maybe Person)
captureVerbatim :: Verbatim -> ClientM Text

getRoot
:<|> getGet
Expand Down Expand Up @@ -277,8 +280,8 @@ getRoot
:<|> uverbGetSuccessOrRedirect
:<|> uverbGetCreated
:<|> recordRoutes
:<|> captureVerbatim
:<|> getUserMultiVerb = client api
:<|> getUserMultiVerb
:<|> captureVerbatim = client api

server :: Application
server = serve api (
Expand Down Expand Up @@ -332,8 +335,8 @@ server = serve api (
{ something = pure ["foo", "bar", "pweet"]
}
}
:<|> (\_ -> pure $ Just $ Person "Name" 30)
:<|> pure . decodeUtf8 . unVerbatim
:<|> undefined --pure $ Just $ Person "Name" 30
)

-- * api for testing failures
Expand Down
2 changes: 0 additions & 2 deletions servant-server/src/Servant/Server/Internal/ResponseRender.hs
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,6 @@ instance IsWaiBody (SourceIO ByteString) where

data SomeResponse = forall a. (IsWaiBody a) => SomeResponse (InternalResponse a)


class ResponseListRender cs as where
responseListRender
:: AcceptHeader
Expand All @@ -66,7 +65,6 @@ instance ResponseListRender cs '[] where
responseListRender _ x = case x of {}
responseListStatuses = []


class (IsWaiBody (ResponseBody a)) => ResponseRender cs a where
type ResponseStatus a :: Nat
type ResponseBody a :: Type
Expand Down

0 comments on commit 046d35f

Please sign in to comment.