Skip to content

Commit

Permalink
Merge pull request #88 from biocad/maksbotan/one-of-title
Browse files Browse the repository at this point in the history
Give title to sub-schemas of oneOf for sum types
  • Loading branch information
maksbotan authored Nov 20, 2023
2 parents 95a0309 + 51a8580 commit 65968b9
Show file tree
Hide file tree
Showing 5 changed files with 40 additions and 7 deletions.
4 changes: 4 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,6 +1,10 @@
Unreleased
----------

3.2.4
-----
- Give `title` to sub schemas of sum types [#88](https://github.com/biocad/openapi3/pull/88).

3.2.3
-----

Expand Down
2 changes: 1 addition & 1 deletion openapi3.cabal
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: >=1.10
name: openapi3
version: 3.2.3
version: 3.2.4

synopsis: OpenAPI 3.0 data model
category: Web, Swagger, OpenApi
Expand Down
2 changes: 2 additions & 0 deletions src/Data/OpenApi.hs
Original file line number Diff line number Diff line change
Expand Up @@ -392,6 +392,7 @@ import Data.OpenApi.Internal
-- "userId",
-- "tag"
-- ],
-- "title": "ErrorNoUser",
-- "type": "object"
-- },
-- {
Expand All @@ -410,6 +411,7 @@ import Data.OpenApi.Internal
-- "requiredPermission",
-- "tag"
-- ],
-- "title": "ErrorAccessDenied",
-- "type": "object"
-- }
-- ]
Expand Down
21 changes: 15 additions & 6 deletions src/Data/OpenApi/Internal/Schema.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@ import Prelude.Compat
import Control.Lens hiding (allOf)
import Data.Data.Lens (template)

import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.Writer hiding (First, Last)
import Data.Aeson (Object (..), SumEncoding (..), ToJSON (..), ToJSONKey (..),
Expand Down Expand Up @@ -1026,7 +1027,7 @@ instance ( GSumToSchema f
) => GToSchema (f :+: g)
where
-- Aeson does not unwrap unary record in sum types.
gdeclareNamedSchema opts p s = gdeclareNamedSumSchema (opts { unwrapUnaryRecords = False } )p s
gdeclareNamedSchema opts = gdeclareNamedSumSchema (opts { unwrapUnaryRecords = False })

gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSumSchema opts proxy _
Expand Down Expand Up @@ -1055,22 +1056,29 @@ instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
-- | Convert one component of the sum to schema, to be later combined with @oneOf@.
gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> (T.Text, Referenced Schema)
gsumConToSchemaWith ref opts _ = (tag, schema)
gsumConToSchemaWith ref opts _ = (tag, withTitle)
where
-- Give sub-schemas @title@ attribute with constructor name, if none present.
-- This will look prettier in swagger-ui.
withTitle = case schema of
Inline sub -> Inline $ sub
& title %~ (<|> Just (T.pack constructorName))
s -> s

schema = case sumEncoding opts of
TaggedObject tagField contentsField ->
case ref of
-- If subschema is an object and constructor is a record, we add tag directly
-- to the record, as Aeson does it.
Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub
& required <>~ [T.pack tagField]
& properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
& properties . at (T.pack tagField) ?~ Inline (mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])

-- If it is not a record, we need to put subschema into "contents" field.
_ | not isRecord -> Inline $ mempty
& type_ ?~ OpenApiObject
& required .~ [T.pack tagField]
& properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
& properties . at (T.pack tagField) ?~ Inline (mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
-- If constructor is nullary, there is no content.
& case ref of
Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
Expand All @@ -1081,7 +1089,7 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
& allOf ?~ [Inline $ mempty
& type_ ?~ OpenApiObject
& required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
& properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])]
& properties . at (T.pack tagField) ?~ Inline (mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])]
& if isRecord
then allOf . _Just <>~ [refOrNullary]
else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary]
Expand All @@ -1092,7 +1100,8 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
& properties . at tag ?~ refOrNullary
TwoElemArray -> error "unrepresentable in OpenAPI 3"

tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
constructorName = conName (Proxy3 :: Proxy3 c f p)
tag = T.pack (constructorTagModifier opts constructorName)
isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)
refOrNullary = fromMaybe (Inline nullarySchema) ref
refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref
Expand Down
18 changes: 18 additions & 0 deletions test/Data/OpenApi/CommonTestTypes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -277,6 +277,7 @@ characterSchemaJSON = [aesonQQ|
"tag",
"contents"
],
"title": "PC",
"type": "object",
"properties": {
"tag": {
Expand All @@ -296,6 +297,7 @@ characterSchemaJSON = [aesonQQ|
"npcPosition",
"tag"
],
"title": "NPC",
"type": "object",
"properties": {
"tag": {
Expand Down Expand Up @@ -326,6 +328,7 @@ characterInlinedSchemaJSON = [aesonQQ|
"tag",
"contents"
],
"title": "PC",
"type": "object",
"properties": {
"tag": {
Expand Down Expand Up @@ -367,6 +370,7 @@ characterInlinedSchemaJSON = [aesonQQ|
"npcPosition",
"tag"
],
"title": "NPC",
"type": "object",
"properties": {
"tag": {
Expand Down Expand Up @@ -410,6 +414,7 @@ characterInlinedPlayerSchemaJSON = [aesonQQ|
"tag",
"contents"
],
"title": "PC",
"type": "object",
"properties": {
"tag": {
Expand Down Expand Up @@ -437,6 +442,7 @@ characterInlinedPlayerSchemaJSON = [aesonQQ|
"npcPosition",
"tag"
],
"title": "NPC",
"type": "object",
"properties": {
"tag": {
Expand Down Expand Up @@ -636,6 +642,7 @@ lightSchemaJSON = [aesonQQ|
"required": [
"tag"
],
"title": "NoLight",
"type": "object",
"properties": {
"tag": {
Expand All @@ -651,6 +658,7 @@ lightSchemaJSON = [aesonQQ|
"tag",
"contents"
],
"title": "LightFreq",
"type": "object",
"properties": {
"tag": {
Expand All @@ -670,6 +678,7 @@ lightSchemaJSON = [aesonQQ|
"tag",
"contents"
],
"title": "LightColor",
"type": "object",
"properties": {
"tag": {
Expand All @@ -688,6 +697,7 @@ lightSchemaJSON = [aesonQQ|
"waveLength",
"tag"
],
"title": "LightWaveLength",
"type": "object",
"properties": {
"tag": {
Expand All @@ -714,6 +724,7 @@ lightInlinedSchemaJSON = [aesonQQ|
"required": [
"tag"
],
"title": "NoLight",
"type": "object",
"properties": {
"tag": {
Expand All @@ -729,6 +740,7 @@ lightInlinedSchemaJSON = [aesonQQ|
"tag",
"contents"
],
"title": "LightFreq",
"type": "object",
"properties": {
"tag": {
Expand All @@ -748,6 +760,7 @@ lightInlinedSchemaJSON = [aesonQQ|
"tag",
"contents"
],
"title": "LightColor",
"type": "object",
"properties": {
"tag": {
Expand All @@ -771,6 +784,7 @@ lightInlinedSchemaJSON = [aesonQQ|
"waveLength",
"tag"
],
"title": "LightWaveLength",
"type": "object",
"properties": {
"tag": {
Expand Down Expand Up @@ -914,6 +928,7 @@ predicateSchemaDeclareJSON = [aesonQQ|
"tag": { "enum": ["PredicateNoun"], "type": "string" }
},
"required": ["tag", "contents"],
"title": "PredicateNoun",
"type": "object"
},
{
Expand All @@ -922,6 +937,7 @@ predicateSchemaDeclareJSON = [aesonQQ|
"tag": { "enum": ["PredicateOmitted"], "type": "string" }
},
"required": ["tag", "contents"],
"title": "PredicateOmitted",
"type": "object"
}
]
Expand Down Expand Up @@ -953,6 +969,7 @@ predicateSchemaDeclareJSON = [aesonQQ|
"tag": { "enum": ["ModifierNoun"], "type": "string" }
},
"required": ["tag", "contents"],
"title": "ModifierNoun",
"type": "object"
},
{
Expand All @@ -961,6 +978,7 @@ predicateSchemaDeclareJSON = [aesonQQ|
"tag": { "enum": ["ModifierOmitted"], "type": "string" }
},
"required": ["tag", "contents"],
"title": "ModifierOmitted",
"type": "object"
}
]
Expand Down

0 comments on commit 65968b9

Please sign in to comment.