Skip to content

Unable to use Headers with UVerb #132

Open
@brendanhay

Description

@brendanhay

Given the terminal instance for response Headers:

instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, AllToResponseHeader hs, KnownNat status, SwaggerMethod method)
=> HasSwagger (Verb method status cs (Headers hs a)) where
toSwagger = mkEndpoint "/"

And the singular instance for UVerb introduced in #127:

-- | @since <TODO>
instance
{-# OVERLAPPABLE #-}
( ToSchema a,
HasStatus a,
AllAccept cs,
SwaggerMethod method,
HasSwagger (UVerb method cs as)
) =>
HasSwagger (UVerb method cs (a ': as))
where
toSwagger _ =
toSwagger (Proxy :: Proxy (Verb method (StatusOf a) cs a))
`combineSwagger` toSwagger (Proxy :: Proxy (UVerb method cs as))
where
-- workaround for https://github.com/GetShopTV/swagger2/issues/218
-- We'd like to juse use (<>) but the instances are wrong
combinePathItem :: PathItem -> PathItem -> PathItem
combinePathItem s t = PathItem
{ _pathItemGet = _pathItemGet s <> _pathItemGet t
, _pathItemPut = _pathItemPut s <> _pathItemPut t
, _pathItemPost = _pathItemPost s <> _pathItemPost t
, _pathItemDelete = _pathItemDelete s <> _pathItemDelete t
, _pathItemOptions = _pathItemOptions s <> _pathItemOptions t
, _pathItemHead = _pathItemHead s <> _pathItemHead t
, _pathItemPatch = _pathItemPatch s <> _pathItemPatch t
, _pathItemParameters = _pathItemParameters s <> _pathItemParameters t
}
combineSwagger :: Swagger -> Swagger -> Swagger
combineSwagger s t = Swagger
{ _swaggerInfo = _swaggerInfo s <> _swaggerInfo t
, _swaggerHost = _swaggerHost s <|> _swaggerHost t
, _swaggerBasePath = _swaggerBasePath s <|> _swaggerBasePath t
, _swaggerSchemes = _swaggerSchemes s <> _swaggerSchemes t
, _swaggerConsumes = _swaggerConsumes s <> _swaggerConsumes t
, _swaggerProduces = _swaggerProduces s <> _swaggerProduces t
, _swaggerPaths = InsOrdHashMap.unionWith combinePathItem (_swaggerPaths s) (_swaggerPaths t)
, _swaggerDefinitions = _swaggerDefinitions s <> _swaggerDefinitions t
, _swaggerParameters = _swaggerParameters s <> _swaggerParameters t
, _swaggerResponses = _swaggerResponses s <> _swaggerResponses t
, _swaggerSecurityDefinitions = _swaggerSecurityDefinitions s <> _swaggerSecurityDefinitions t
, _swaggerSecurity = _swaggerSecurity s <> _swaggerSecurity t
, _swaggerTags = _swaggerTags s <> _swaggerTags t
, _swaggerExternalDocs = _swaggerExternalDocs s <|> _swaggerExternalDocs t
}

I'm not certain it's possible to declare an endpoint of the form:

type Redirect = Headers '[Header "Content-Location" Text] ()

type API = UVerb 'POST '[JSON] '[WithStatus 202 Redirect]
 • No instance for (Data.Swagger.Internal.Schema.ToSchema (Servant.WithStatus 202 Redirect)

Due to the instance's ToSchema a constraint and recursion via:

toSwagger (Proxy :: Proxy (Verb method (StatusOf a) cs a))

Am I missing something obvious?

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions