From 185e32115be51c0e275bcb7408de46041a5e9750 Mon Sep 17 00:00:00 2001 From: "Michael \"Gilli\" Gilliland" Date: Tue, 10 Mar 2026 15:55:52 -0400 Subject: [PATCH 1/4] Add golden test for discriminator key The example (I believe) is good. Changes that are made to the generated code will help me check that my changes to the generator are correct. This is documented/defined here: https://swagger.io/docs/specification/v3_0/data-models/inheritance-and-polymorphism/#discriminator --- .../z_complex_self_made_example.yml | 86 ++++++++++++++++++ testing/golden-output/openapi.cabal | 9 ++ testing/golden-output/src/OpenAPI.hs | 18 ++++ .../OpenAPI/Operations/WithDiscriminator.hs | 90 +++++++++++++++++++ .../WithDiscriminatorWithoutMapping.hs | 90 +++++++++++++++++++ testing/golden-output/src/OpenAPI/Types.hs | 14 +++ .../golden-output/src/OpenAPI/Types/Fish.hs | 66 ++++++++++++++ .../src/OpenAPI/Types/Fish.hs-boot | 9 ++ .../golden-output/src/OpenAPI/Types/Gecko.hs | 63 +++++++++++++ .../src/OpenAPI/Types/Gecko.hs-boot | 8 ++ .../src/OpenAPI/Types/GilaMonster.hs | 63 +++++++++++++ .../src/OpenAPI/Types/GilaMonster.hs-boot | 8 ++ .../golden-output/src/OpenAPI/Types/Guppie.hs | 63 +++++++++++++ .../src/OpenAPI/Types/Guppie.hs-boot | 8 ++ .../golden-output/src/OpenAPI/Types/Lizard.hs | 63 +++++++++++++ .../src/OpenAPI/Types/Lizard.hs-boot | 9 ++ .../golden-output/src/OpenAPI/Types/Minnow.hs | 63 +++++++++++++ .../src/OpenAPI/Types/Minnow.hs-boot | 8 ++ .../golden-output/src/OpenAPI/Types/Shark.hs | 63 +++++++++++++ .../src/OpenAPI/Types/Shark.hs-boot | 8 ++ 20 files changed, 809 insertions(+) create mode 100755 testing/golden-output/src/OpenAPI/Operations/WithDiscriminator.hs create mode 100755 testing/golden-output/src/OpenAPI/Operations/WithDiscriminatorWithoutMapping.hs create mode 100755 testing/golden-output/src/OpenAPI/Types/Fish.hs create mode 100755 testing/golden-output/src/OpenAPI/Types/Fish.hs-boot create mode 100755 testing/golden-output/src/OpenAPI/Types/Gecko.hs create mode 100755 testing/golden-output/src/OpenAPI/Types/Gecko.hs-boot create mode 100755 testing/golden-output/src/OpenAPI/Types/GilaMonster.hs create mode 100755 testing/golden-output/src/OpenAPI/Types/GilaMonster.hs-boot create mode 100755 testing/golden-output/src/OpenAPI/Types/Guppie.hs create mode 100755 testing/golden-output/src/OpenAPI/Types/Guppie.hs-boot create mode 100755 testing/golden-output/src/OpenAPI/Types/Lizard.hs create mode 100755 testing/golden-output/src/OpenAPI/Types/Lizard.hs-boot create mode 100755 testing/golden-output/src/OpenAPI/Types/Minnow.hs create mode 100755 testing/golden-output/src/OpenAPI/Types/Minnow.hs-boot create mode 100755 testing/golden-output/src/OpenAPI/Types/Shark.hs create mode 100755 testing/golden-output/src/OpenAPI/Types/Shark.hs-boot diff --git a/specifications/z_complex_self_made_example.yml b/specifications/z_complex_self_made_example.yml index dfeeb93..1d1ddfb 100644 --- a/specifications/z_complex_self_made_example.yml +++ b/specifications/z_complex_self_made_example.yml @@ -172,6 +172,28 @@ paths: application/json: schema: $ref: "#/components/schemas/Dog" + /pet/withdiscriminator: + get: + description: Operation that references a component with a discriminator key + operationId: withDiscriminator + responses: + '200': + description: successful operation + content: + application/json: + schema: + $ref: "#/components/schemas/Fish" + /pet/withdiscriminatorwithoutmapping: + get: + description: Operation that references a component with a discriminator key (without mapping) + operationId: withDiscriminatorWithoutMapping + responses: + '200': + description: successful operation + content: + application/json: + schema: + $ref: "#/components/schemas/Lizard" components: schemas: PetByAge: @@ -309,6 +331,70 @@ components: type: boolean age: type: integer + Fish: + type: object + oneOf: + - $ref: '#/components/schemas/Guppie' + - $ref: '#/components/schemas/Minnow' + - $ref: '#/components/schemas/Shark' + discriminator: + propertyName: fishType + mapping: + guppie: '#/components/schemas/Guppie' + minnow: '#/components/schemas/Minnow' + shark: '#/components/schemas/Shark' + Guppie: + type: object + properties: + color: + type: string + fishType: + type: string + required: + - fishType + Minnow: + type: object + properties: + color: + type: string + fishType: + type: string + required: + - fishType + Shark: + type: object + properties: + teethRemaining: + type: integer + fishType: + type: string + required: + - fishType + Lizard: + type: object + oneOf: + - $ref: '#/components/schemas/Gecko' + - $ref: '#/components/schemas/GilaMonster' + discriminator: + propertyName: lizardType + Gecko: + type: object + properties: + hasTail: + type: boolean + lizardType: + type: string + required: + - lizardType + GilaMonster: + type: object + properties: + hasTail: + type: boolean + lizardType: + type: string + required: + - lizardType Mischling: allOf: # Combines the main `Pet` schema with `Cat`-specific properties - $ref: '#/components/schemas/Dog' diff --git a/testing/golden-output/openapi.cabal b/testing/golden-output/openapi.cabal index 8aa500c..fe3fb7d 100755 --- a/testing/golden-output/openapi.cabal +++ b/testing/golden-output/openapi.cabal @@ -12,6 +12,8 @@ library OpenAPI.Operations.NoParam OpenAPI.Operations.SingleParam OpenAPI.Operations.SingleParamWithFixedEnum + OpenAPI.Operations.WithDiscriminator + OpenAPI.Operations.WithDiscriminatorWithoutMapping OpenAPI.Operations.Patch_pets OpenAPI.Operations.ShowPetById OpenAPI.Types @@ -19,9 +21,16 @@ library OpenAPI.Types.Cat OpenAPI.Types.CoverType OpenAPI.Types.Dog + OpenAPI.Types.Fish + OpenAPI.Types.Gecko + OpenAPI.Types.GilaMonster + OpenAPI.Types.Guppie + OpenAPI.Types.Lizard + OpenAPI.Types.Minnow OpenAPI.Types.Mischling OpenAPI.Types.PetByAge OpenAPI.Types.PetByType + OpenAPI.Types.Shark OpenAPI.Types.Test6 OpenAPI.Types.Test7 OpenAPI.Types.Test8 diff --git a/testing/golden-output/src/OpenAPI.hs b/testing/golden-output/src/OpenAPI.hs index 5b10b94..a8c9ff5 100755 --- a/testing/golden-output/src/OpenAPI.hs +++ b/testing/golden-output/src/OpenAPI.hs @@ -7,6 +7,8 @@ module OpenAPI ( module OpenAPI.Operations.NoParam, module OpenAPI.Operations.SingleParam, module OpenAPI.Operations.SingleParamWithFixedEnum, + module OpenAPI.Operations.WithDiscriminator, + module OpenAPI.Operations.WithDiscriminatorWithoutMapping, module OpenAPI.Operations.Patch_pets, module OpenAPI.Operations.ShowPetById, module OpenAPI.Types, @@ -14,9 +16,16 @@ module OpenAPI ( module OpenAPI.Types.Cat, module OpenAPI.Types.CoverType, module OpenAPI.Types.Dog, + module OpenAPI.Types.Fish, + module OpenAPI.Types.Gecko, + module OpenAPI.Types.GilaMonster, + module OpenAPI.Types.Guppie, + module OpenAPI.Types.Lizard, + module OpenAPI.Types.Minnow, module OpenAPI.Types.Mischling, module OpenAPI.Types.PetByAge, module OpenAPI.Types.PetByType, + module OpenAPI.Types.Shark, module OpenAPI.Types.Test6, module OpenAPI.Types.Test7, module OpenAPI.Types.Test8, @@ -32,6 +41,8 @@ import OpenAPI.Operations.MultiParamWithFixedEnum import OpenAPI.Operations.NoParam import OpenAPI.Operations.SingleParam import OpenAPI.Operations.SingleParamWithFixedEnum +import OpenAPI.Operations.WithDiscriminator +import OpenAPI.Operations.WithDiscriminatorWithoutMapping import OpenAPI.Operations.Patch_pets import OpenAPI.Operations.ShowPetById import OpenAPI.Types @@ -39,9 +50,16 @@ import OpenAPI.TypeAlias import OpenAPI.Types.Cat import OpenAPI.Types.CoverType import OpenAPI.Types.Dog +import OpenAPI.Types.Fish +import OpenAPI.Types.Gecko +import OpenAPI.Types.GilaMonster +import OpenAPI.Types.Guppie +import OpenAPI.Types.Lizard +import OpenAPI.Types.Minnow import OpenAPI.Types.Mischling import OpenAPI.Types.PetByAge import OpenAPI.Types.PetByType +import OpenAPI.Types.Shark import OpenAPI.Types.Test6 import OpenAPI.Types.Test7 import OpenAPI.Types.Test8 diff --git a/testing/golden-output/src/OpenAPI/Operations/WithDiscriminator.hs b/testing/golden-output/src/OpenAPI/Operations/WithDiscriminator.hs new file mode 100755 index 0000000..f3baf59 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Operations/WithDiscriminator.hs @@ -0,0 +1,90 @@ +-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator. + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Contains the different functions to run the operation withDiscriminator +module OpenAPI.Operations.WithDiscriminator where + +import qualified Prelude as GHC.Integer.Type +import qualified Prelude as GHC.Maybe +import qualified Prelude as GHC.Internal.Maybe +import qualified Control.Monad.Fail +import qualified Control.Monad.Fail as GHC.Internal.Control.Monad.Fail +import qualified Control.Monad.Trans.Reader +import qualified Data.Aeson +import qualified Data.Aeson as Data.Aeson.Decoding +import qualified Data.Aeson as Data.Aeson.Encoding.Internal +import qualified Data.Aeson as Data.Aeson.Types +import qualified Data.Aeson as Data.Aeson.Types.FromJSON +import qualified Data.Aeson as Data.Aeson.Types.Internal +import qualified Data.Aeson as Data.Aeson.Types.ToJSON +import qualified Data.ByteString +import qualified Data.ByteString as Data.ByteString.Internal +import qualified Data.ByteString as Data.ByteString.Internal.Type +import qualified Data.Either +import qualified Data.Either as GHC.Internal.Data.Either +import qualified Data.Foldable +import qualified Data.Foldable as GHC.Internal.Data.Foldable +import qualified Data.Functor +import qualified Data.Functor as GHC.Internal.Data.Functor +import qualified Data.Maybe +import qualified Data.Maybe as GHC.Internal.Data.Maybe +import qualified Data.Scientific +import qualified Data.Text +import qualified Data.Text as Data.Text.Internal +import qualified Data.Time.Calendar as Data.Time.Calendar.Days +import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime +import qualified Data.Vector +import qualified GHC.Base +import qualified GHC.Base as GHC.Internal.Base +import qualified GHC.Classes +import qualified GHC.Int +import qualified GHC.Int as GHC.Internal.Int +import qualified GHC.Show +import qualified GHC.Show as GHC.Internal.Show +import qualified GHC.Types +import qualified Network.HTTP.Client +import qualified Network.HTTP.Client as Network.HTTP.Client.Request +import qualified Network.HTTP.Client as Network.HTTP.Client.Types +import qualified Network.HTTP.Simple +import qualified Network.HTTP.Types +import qualified Network.HTTP.Types as Network.HTTP.Types.Status +import qualified Network.HTTP.Types as Network.HTTP.Types.URI +import qualified OpenAPI.Common +import OpenAPI.Types + +-- | > GET /pet/withdiscriminator +-- +-- Operation that references a component with a discriminator key +withDiscriminator :: forall m . OpenAPI.Common.MonadHTTP m => OpenAPI.Common.ClientT m (Network.HTTP.Client.Types.Response WithDiscriminatorResponse) -- ^ Monadic computation which returns the result of the operation +withDiscriminator = GHC.Base.fmap (\response_0 -> GHC.Base.fmap (Data.Either.either WithDiscriminatorResponseError GHC.Base.id GHC.Base.. (\response body -> if | (\status_1 -> Network.HTTP.Types.Status.statusCode status_1 GHC.Classes.== 200) (Network.HTTP.Client.Types.responseStatus response) -> WithDiscriminatorResponse200 Data.Functor.<$> (Data.Aeson.Decoding.eitherDecodeStrict body :: Data.Either.Either GHC.Base.String + Fish) + | GHC.Base.otherwise -> Data.Either.Left "Missing default response type") response_0) response_0) (OpenAPI.Common.doCallWithConfigurationM (Data.Text.toUpper GHC.Base.$ Data.Text.Internal.pack "GET") "/pet/withdiscriminator" GHC.Base.mempty) +-- | Represents a response of the operation 'withDiscriminator'. +-- +-- The response constructor is chosen by the status code of the response. If no case matches (no specific case for the response code, no range case, no default case), 'WithDiscriminatorResponseError' is used. +data WithDiscriminatorResponse = + WithDiscriminatorResponseError GHC.Base.String -- ^ Means either no matching case available or a parse error + | WithDiscriminatorResponse200 Fish -- ^ successful operation + deriving (GHC.Show.Show, GHC.Classes.Eq) +-- | > GET /pet/withdiscriminator +-- +-- The same as 'withDiscriminator' but accepts an explicit configuration. +withDiscriminatorWithConfiguration :: forall m . OpenAPI.Common.MonadHTTP m => OpenAPI.Common.Configuration -- ^ The configuration to use in the request + -> m (Network.HTTP.Client.Types.Response WithDiscriminatorResponse) -- ^ Monadic computation which returns the result of the operation +withDiscriminatorWithConfiguration config = GHC.Base.fmap (\response_2 -> GHC.Base.fmap (Data.Either.either WithDiscriminatorResponseError GHC.Base.id GHC.Base.. (\response body -> if | (\status_3 -> Network.HTTP.Types.Status.statusCode status_3 GHC.Classes.== 200) (Network.HTTP.Client.Types.responseStatus response) -> WithDiscriminatorResponse200 Data.Functor.<$> (Data.Aeson.Decoding.eitherDecodeStrict body :: Data.Either.Either GHC.Base.String + Fish) + | GHC.Base.otherwise -> Data.Either.Left "Missing default response type") response_2) response_2) (OpenAPI.Common.doCallWithConfiguration config (Data.Text.toUpper GHC.Base.$ Data.Text.Internal.pack "GET") "/pet/withdiscriminator" GHC.Base.mempty) +-- | > GET /pet/withdiscriminator +-- +-- The same as 'withDiscriminator' but returns the raw 'Data.ByteString.ByteString'. +withDiscriminatorRaw :: forall m . OpenAPI.Common.MonadHTTP m => OpenAPI.Common.ClientT m (Network.HTTP.Client.Types.Response Data.ByteString.Internal.Type.ByteString) -- ^ Monadic computation which returns the result of the operation +withDiscriminatorRaw = GHC.Base.id (OpenAPI.Common.doCallWithConfigurationM (Data.Text.toUpper GHC.Base.$ Data.Text.Internal.pack "GET") "/pet/withdiscriminator" GHC.Base.mempty) +-- | > GET /pet/withdiscriminator +-- +-- The same as 'withDiscriminator' but accepts an explicit configuration and returns the raw 'Data.ByteString.ByteString'. +withDiscriminatorWithConfigurationRaw :: forall m . OpenAPI.Common.MonadHTTP m => OpenAPI.Common.Configuration -- ^ The configuration to use in the request + -> m (Network.HTTP.Client.Types.Response Data.ByteString.Internal.Type.ByteString) -- ^ Monadic computation which returns the result of the operation +withDiscriminatorWithConfigurationRaw config = GHC.Base.id (OpenAPI.Common.doCallWithConfiguration config (Data.Text.toUpper GHC.Base.$ Data.Text.Internal.pack "GET") "/pet/withdiscriminator" GHC.Base.mempty) diff --git a/testing/golden-output/src/OpenAPI/Operations/WithDiscriminatorWithoutMapping.hs b/testing/golden-output/src/OpenAPI/Operations/WithDiscriminatorWithoutMapping.hs new file mode 100755 index 0000000..00cf7f5 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Operations/WithDiscriminatorWithoutMapping.hs @@ -0,0 +1,90 @@ +-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator. + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Contains the different functions to run the operation withDiscriminatorWithoutMapping +module OpenAPI.Operations.WithDiscriminatorWithoutMapping where + +import qualified Prelude as GHC.Integer.Type +import qualified Prelude as GHC.Maybe +import qualified Prelude as GHC.Internal.Maybe +import qualified Control.Monad.Fail +import qualified Control.Monad.Fail as GHC.Internal.Control.Monad.Fail +import qualified Control.Monad.Trans.Reader +import qualified Data.Aeson +import qualified Data.Aeson as Data.Aeson.Decoding +import qualified Data.Aeson as Data.Aeson.Encoding.Internal +import qualified Data.Aeson as Data.Aeson.Types +import qualified Data.Aeson as Data.Aeson.Types.FromJSON +import qualified Data.Aeson as Data.Aeson.Types.Internal +import qualified Data.Aeson as Data.Aeson.Types.ToJSON +import qualified Data.ByteString +import qualified Data.ByteString as Data.ByteString.Internal +import qualified Data.ByteString as Data.ByteString.Internal.Type +import qualified Data.Either +import qualified Data.Either as GHC.Internal.Data.Either +import qualified Data.Foldable +import qualified Data.Foldable as GHC.Internal.Data.Foldable +import qualified Data.Functor +import qualified Data.Functor as GHC.Internal.Data.Functor +import qualified Data.Maybe +import qualified Data.Maybe as GHC.Internal.Data.Maybe +import qualified Data.Scientific +import qualified Data.Text +import qualified Data.Text as Data.Text.Internal +import qualified Data.Time.Calendar as Data.Time.Calendar.Days +import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime +import qualified Data.Vector +import qualified GHC.Base +import qualified GHC.Base as GHC.Internal.Base +import qualified GHC.Classes +import qualified GHC.Int +import qualified GHC.Int as GHC.Internal.Int +import qualified GHC.Show +import qualified GHC.Show as GHC.Internal.Show +import qualified GHC.Types +import qualified Network.HTTP.Client +import qualified Network.HTTP.Client as Network.HTTP.Client.Request +import qualified Network.HTTP.Client as Network.HTTP.Client.Types +import qualified Network.HTTP.Simple +import qualified Network.HTTP.Types +import qualified Network.HTTP.Types as Network.HTTP.Types.Status +import qualified Network.HTTP.Types as Network.HTTP.Types.URI +import qualified OpenAPI.Common +import OpenAPI.Types + +-- | > GET /pet/withdiscriminatorwithoutmapping +-- +-- Operation that references a component with a discriminator key (without mapping) +withDiscriminatorWithoutMapping :: forall m . OpenAPI.Common.MonadHTTP m => OpenAPI.Common.ClientT m (Network.HTTP.Client.Types.Response WithDiscriminatorWithoutMappingResponse) -- ^ Monadic computation which returns the result of the operation +withDiscriminatorWithoutMapping = GHC.Base.fmap (\response_0 -> GHC.Base.fmap (Data.Either.either WithDiscriminatorWithoutMappingResponseError GHC.Base.id GHC.Base.. (\response body -> if | (\status_1 -> Network.HTTP.Types.Status.statusCode status_1 GHC.Classes.== 200) (Network.HTTP.Client.Types.responseStatus response) -> WithDiscriminatorWithoutMappingResponse200 Data.Functor.<$> (Data.Aeson.Decoding.eitherDecodeStrict body :: Data.Either.Either GHC.Base.String + Lizard) + | GHC.Base.otherwise -> Data.Either.Left "Missing default response type") response_0) response_0) (OpenAPI.Common.doCallWithConfigurationM (Data.Text.toUpper GHC.Base.$ Data.Text.Internal.pack "GET") "/pet/withdiscriminatorwithoutmapping" GHC.Base.mempty) +-- | Represents a response of the operation 'withDiscriminatorWithoutMapping'. +-- +-- The response constructor is chosen by the status code of the response. If no case matches (no specific case for the response code, no range case, no default case), 'WithDiscriminatorWithoutMappingResponseError' is used. +data WithDiscriminatorWithoutMappingResponse = + WithDiscriminatorWithoutMappingResponseError GHC.Base.String -- ^ Means either no matching case available or a parse error + | WithDiscriminatorWithoutMappingResponse200 Lizard -- ^ successful operation + deriving (GHC.Show.Show, GHC.Classes.Eq) +-- | > GET /pet/withdiscriminatorwithoutmapping +-- +-- The same as 'withDiscriminatorWithoutMapping' but accepts an explicit configuration. +withDiscriminatorWithoutMappingWithConfiguration :: forall m . OpenAPI.Common.MonadHTTP m => OpenAPI.Common.Configuration -- ^ The configuration to use in the request + -> m (Network.HTTP.Client.Types.Response WithDiscriminatorWithoutMappingResponse) -- ^ Monadic computation which returns the result of the operation +withDiscriminatorWithoutMappingWithConfiguration config = GHC.Base.fmap (\response_2 -> GHC.Base.fmap (Data.Either.either WithDiscriminatorWithoutMappingResponseError GHC.Base.id GHC.Base.. (\response body -> if | (\status_3 -> Network.HTTP.Types.Status.statusCode status_3 GHC.Classes.== 200) (Network.HTTP.Client.Types.responseStatus response) -> WithDiscriminatorWithoutMappingResponse200 Data.Functor.<$> (Data.Aeson.Decoding.eitherDecodeStrict body :: Data.Either.Either GHC.Base.String + Lizard) + | GHC.Base.otherwise -> Data.Either.Left "Missing default response type") response_2) response_2) (OpenAPI.Common.doCallWithConfiguration config (Data.Text.toUpper GHC.Base.$ Data.Text.Internal.pack "GET") "/pet/withdiscriminatorwithoutmapping" GHC.Base.mempty) +-- | > GET /pet/withdiscriminatorwithoutmapping +-- +-- The same as 'withDiscriminatorWithoutMapping' but returns the raw 'Data.ByteString.ByteString'. +withDiscriminatorWithoutMappingRaw :: forall m . OpenAPI.Common.MonadHTTP m => OpenAPI.Common.ClientT m (Network.HTTP.Client.Types.Response Data.ByteString.Internal.Type.ByteString) -- ^ Monadic computation which returns the result of the operation +withDiscriminatorWithoutMappingRaw = GHC.Base.id (OpenAPI.Common.doCallWithConfigurationM (Data.Text.toUpper GHC.Base.$ Data.Text.Internal.pack "GET") "/pet/withdiscriminatorwithoutmapping" GHC.Base.mempty) +-- | > GET /pet/withdiscriminatorwithoutmapping +-- +-- The same as 'withDiscriminatorWithoutMapping' but accepts an explicit configuration and returns the raw 'Data.ByteString.ByteString'. +withDiscriminatorWithoutMappingWithConfigurationRaw :: forall m . OpenAPI.Common.MonadHTTP m => OpenAPI.Common.Configuration -- ^ The configuration to use in the request + -> m (Network.HTTP.Client.Types.Response Data.ByteString.Internal.Type.ByteString) -- ^ Monadic computation which returns the result of the operation +withDiscriminatorWithoutMappingWithConfigurationRaw config = GHC.Base.id (OpenAPI.Common.doCallWithConfiguration config (Data.Text.toUpper GHC.Base.$ Data.Text.Internal.pack "GET") "/pet/withdiscriminatorwithoutmapping" GHC.Base.mempty) diff --git a/testing/golden-output/src/OpenAPI/Types.hs b/testing/golden-output/src/OpenAPI/Types.hs index d77d335..838911f 100755 --- a/testing/golden-output/src/OpenAPI/Types.hs +++ b/testing/golden-output/src/OpenAPI/Types.hs @@ -6,9 +6,16 @@ module OpenAPI.Types ( module OpenAPI.Types.Cat, module OpenAPI.Types.CoverType, module OpenAPI.Types.Dog, + module OpenAPI.Types.Fish, + module OpenAPI.Types.Gecko, + module OpenAPI.Types.GilaMonster, + module OpenAPI.Types.Guppie, + module OpenAPI.Types.Lizard, + module OpenAPI.Types.Minnow, module OpenAPI.Types.Mischling, module OpenAPI.Types.PetByAge, module OpenAPI.Types.PetByType, + module OpenAPI.Types.Shark, module OpenAPI.Types.Test6, module OpenAPI.Types.Test7, module OpenAPI.Types.Test8, @@ -20,9 +27,16 @@ import OpenAPI.TypeAlias import OpenAPI.Types.Cat import OpenAPI.Types.CoverType import OpenAPI.Types.Dog +import OpenAPI.Types.Fish +import OpenAPI.Types.Gecko +import OpenAPI.Types.GilaMonster +import OpenAPI.Types.Guppie +import OpenAPI.Types.Lizard +import OpenAPI.Types.Minnow import OpenAPI.Types.Mischling import OpenAPI.Types.PetByAge import OpenAPI.Types.PetByType +import OpenAPI.Types.Shark import OpenAPI.Types.Test6 import OpenAPI.Types.Test7 import OpenAPI.Types.Test8 diff --git a/testing/golden-output/src/OpenAPI/Types/Fish.hs b/testing/golden-output/src/OpenAPI/Types/Fish.hs new file mode 100755 index 0000000..aa354f4 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Fish.hs @@ -0,0 +1,66 @@ +-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator. + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Contains the types generated from the schema Fish +module OpenAPI.Types.Fish where + +import qualified Prelude as GHC.Integer.Type +import qualified Prelude as GHC.Maybe +import qualified Prelude as GHC.Internal.Maybe +import qualified Control.Monad.Fail +import qualified Control.Monad.Fail as GHC.Internal.Control.Monad.Fail +import qualified Data.Aeson +import qualified Data.Aeson as Data.Aeson.Encoding.Internal +import qualified Data.Aeson as Data.Aeson.Types +import qualified Data.Aeson as Data.Aeson.Types.FromJSON +import qualified Data.Aeson as Data.Aeson.Types.ToJSON +import qualified Data.Aeson as Data.Aeson.Types.Internal +import qualified Data.ByteString +import qualified Data.ByteString as Data.ByteString.Internal +import qualified Data.Foldable +import qualified Data.Foldable as GHC.Internal.Data.Foldable +import qualified Data.Functor +import qualified Data.Functor as GHC.Internal.Data.Functor +import qualified Data.Maybe +import qualified Data.Maybe as GHC.Internal.Data.Maybe +import qualified Data.Scientific +import qualified Data.Text +import qualified Data.Text as Data.Text.Internal +import qualified Data.Time.Calendar as Data.Time.Calendar.Days +import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime +import qualified GHC.Base +import qualified GHC.Base as GHC.Internal.Base +import qualified GHC.Classes +import qualified GHC.Int +import qualified GHC.Int as GHC.Internal.Int +import qualified GHC.Show +import qualified GHC.Show as GHC.Internal.Show +import qualified GHC.Types +import qualified OpenAPI.Common +import OpenAPI.TypeAlias +import {-# SOURCE #-} OpenAPI.Types.Guppie +import {-# SOURCE #-} OpenAPI.Types.Minnow +import {-# SOURCE #-} OpenAPI.Types.Shark + +-- | Defines the oneOf schema located at @components.schemas.Fish.oneOf@ in the specification. +-- +-- +data FishVariants = + FishGuppie Guppie + | FishMinnow Minnow + | FishShark Shark + deriving (GHC.Show.Show, GHC.Classes.Eq) +instance Data.Aeson.Types.ToJSON.ToJSON FishVariants + where {toJSON (FishGuppie a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (FishMinnow a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (FishShark a) = Data.Aeson.Types.ToJSON.toJSON a} +instance Data.Aeson.Types.FromJSON.FromJSON FishVariants + where {parseJSON val = case (FishGuppie Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((FishMinnow Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((FishShark Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched")) of + {Data.Aeson.Types.Internal.Success a -> GHC.Base.pure a; + Data.Aeson.Types.Internal.Error a -> Control.Monad.Fail.fail a}} +-- | Defines an alias for the schema located at @components.schemas.Fish.oneOf@ in the specification. +-- +-- +type Fish = FishVariants diff --git a/testing/golden-output/src/OpenAPI/Types/Fish.hs-boot b/testing/golden-output/src/OpenAPI/Types/Fish.hs-boot new file mode 100755 index 0000000..eb5a8ba --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Fish.hs-boot @@ -0,0 +1,9 @@ +module OpenAPI.Types.Fish where +import qualified Data.Aeson +import qualified OpenAPI.Common +data FishVariants +instance Show FishVariants +instance Eq FishVariants +instance Data.Aeson.FromJSON FishVariants +instance Data.Aeson.ToJSON FishVariants +type Fish = FishVariants diff --git a/testing/golden-output/src/OpenAPI/Types/Gecko.hs b/testing/golden-output/src/OpenAPI/Types/Gecko.hs new file mode 100755 index 0000000..2320566 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Gecko.hs @@ -0,0 +1,63 @@ +-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator. + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Contains the types generated from the schema Gecko +module OpenAPI.Types.Gecko where + +import qualified Prelude as GHC.Integer.Type +import qualified Prelude as GHC.Maybe +import qualified Prelude as GHC.Internal.Maybe +import qualified Control.Monad.Fail +import qualified Control.Monad.Fail as GHC.Internal.Control.Monad.Fail +import qualified Data.Aeson +import qualified Data.Aeson as Data.Aeson.Encoding.Internal +import qualified Data.Aeson as Data.Aeson.Types +import qualified Data.Aeson as Data.Aeson.Types.FromJSON +import qualified Data.Aeson as Data.Aeson.Types.ToJSON +import qualified Data.Aeson as Data.Aeson.Types.Internal +import qualified Data.ByteString +import qualified Data.ByteString as Data.ByteString.Internal +import qualified Data.Foldable +import qualified Data.Foldable as GHC.Internal.Data.Foldable +import qualified Data.Functor +import qualified Data.Functor as GHC.Internal.Data.Functor +import qualified Data.Maybe +import qualified Data.Maybe as GHC.Internal.Data.Maybe +import qualified Data.Scientific +import qualified Data.Text +import qualified Data.Text as Data.Text.Internal +import qualified Data.Time.Calendar as Data.Time.Calendar.Days +import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime +import qualified GHC.Base +import qualified GHC.Base as GHC.Internal.Base +import qualified GHC.Classes +import qualified GHC.Int +import qualified GHC.Int as GHC.Internal.Int +import qualified GHC.Show +import qualified GHC.Show as GHC.Internal.Show +import qualified GHC.Types +import qualified OpenAPI.Common +import OpenAPI.TypeAlias + +-- | Defines the object schema located at @components.schemas.Gecko@ in the specification. +-- +-- +data Gecko = Gecko { + -- | hasTail + geckoHasTail :: (GHC.Maybe.Maybe GHC.Types.Bool) + -- | lizardType + , geckoLizardType :: Data.Text.Internal.Text + } deriving (GHC.Show.Show + , GHC.Classes.Eq) +instance Data.Aeson.Types.ToJSON.ToJSON Gecko + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (geckoHasTail obj) : ["lizardType" Data.Aeson.Types.ToJSON..= geckoLizardType obj] : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (geckoHasTail obj) : ["lizardType" Data.Aeson.Types.ToJSON..= geckoLizardType obj] : GHC.Base.mempty)))} +instance Data.Aeson.Types.FromJSON.FromJSON Gecko + where {parseJSON = Data.Aeson.Types.FromJSON.withObject "Gecko" (\obj -> (GHC.Base.pure Gecko GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "hasTail")) GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "lizardType"))} +-- | Create a new 'Gecko' with all required fields. +mkGecko :: Data.Text.Internal.Text -- ^ 'geckoLizardType' + -> Gecko +mkGecko geckoLizardType = Gecko{geckoHasTail = GHC.Maybe.Nothing, + geckoLizardType = geckoLizardType} diff --git a/testing/golden-output/src/OpenAPI/Types/Gecko.hs-boot b/testing/golden-output/src/OpenAPI/Types/Gecko.hs-boot new file mode 100755 index 0000000..1e8ef27 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Gecko.hs-boot @@ -0,0 +1,8 @@ +module OpenAPI.Types.Gecko where +import qualified Data.Aeson +import qualified OpenAPI.Common +data Gecko +instance Show Gecko +instance Eq Gecko +instance Data.Aeson.FromJSON Gecko +instance Data.Aeson.ToJSON Gecko diff --git a/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs b/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs new file mode 100755 index 0000000..97836c8 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs @@ -0,0 +1,63 @@ +-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator. + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Contains the types generated from the schema GilaMonster +module OpenAPI.Types.GilaMonster where + +import qualified Prelude as GHC.Integer.Type +import qualified Prelude as GHC.Maybe +import qualified Prelude as GHC.Internal.Maybe +import qualified Control.Monad.Fail +import qualified Control.Monad.Fail as GHC.Internal.Control.Monad.Fail +import qualified Data.Aeson +import qualified Data.Aeson as Data.Aeson.Encoding.Internal +import qualified Data.Aeson as Data.Aeson.Types +import qualified Data.Aeson as Data.Aeson.Types.FromJSON +import qualified Data.Aeson as Data.Aeson.Types.ToJSON +import qualified Data.Aeson as Data.Aeson.Types.Internal +import qualified Data.ByteString +import qualified Data.ByteString as Data.ByteString.Internal +import qualified Data.Foldable +import qualified Data.Foldable as GHC.Internal.Data.Foldable +import qualified Data.Functor +import qualified Data.Functor as GHC.Internal.Data.Functor +import qualified Data.Maybe +import qualified Data.Maybe as GHC.Internal.Data.Maybe +import qualified Data.Scientific +import qualified Data.Text +import qualified Data.Text as Data.Text.Internal +import qualified Data.Time.Calendar as Data.Time.Calendar.Days +import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime +import qualified GHC.Base +import qualified GHC.Base as GHC.Internal.Base +import qualified GHC.Classes +import qualified GHC.Int +import qualified GHC.Int as GHC.Internal.Int +import qualified GHC.Show +import qualified GHC.Show as GHC.Internal.Show +import qualified GHC.Types +import qualified OpenAPI.Common +import OpenAPI.TypeAlias + +-- | Defines the object schema located at @components.schemas.GilaMonster@ in the specification. +-- +-- +data GilaMonster = GilaMonster { + -- | hasTail + gilaMonsterHasTail :: (GHC.Maybe.Maybe GHC.Types.Bool) + -- | lizardType + , gilaMonsterLizardType :: Data.Text.Internal.Text + } deriving (GHC.Show.Show + , GHC.Classes.Eq) +instance Data.Aeson.Types.ToJSON.ToJSON GilaMonster + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (gilaMonsterHasTail obj) : ["lizardType" Data.Aeson.Types.ToJSON..= gilaMonsterLizardType obj] : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (gilaMonsterHasTail obj) : ["lizardType" Data.Aeson.Types.ToJSON..= gilaMonsterLizardType obj] : GHC.Base.mempty)))} +instance Data.Aeson.Types.FromJSON.FromJSON GilaMonster + where {parseJSON = Data.Aeson.Types.FromJSON.withObject "GilaMonster" (\obj -> (GHC.Base.pure GilaMonster GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "hasTail")) GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "lizardType"))} +-- | Create a new 'GilaMonster' with all required fields. +mkGilaMonster :: Data.Text.Internal.Text -- ^ 'gilaMonsterLizardType' + -> GilaMonster +mkGilaMonster gilaMonsterLizardType = GilaMonster{gilaMonsterHasTail = GHC.Maybe.Nothing, + gilaMonsterLizardType = gilaMonsterLizardType} diff --git a/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs-boot b/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs-boot new file mode 100755 index 0000000..9682ec7 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs-boot @@ -0,0 +1,8 @@ +module OpenAPI.Types.GilaMonster where +import qualified Data.Aeson +import qualified OpenAPI.Common +data GilaMonster +instance Show GilaMonster +instance Eq GilaMonster +instance Data.Aeson.FromJSON GilaMonster +instance Data.Aeson.ToJSON GilaMonster diff --git a/testing/golden-output/src/OpenAPI/Types/Guppie.hs b/testing/golden-output/src/OpenAPI/Types/Guppie.hs new file mode 100755 index 0000000..2195695 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Guppie.hs @@ -0,0 +1,63 @@ +-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator. + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Contains the types generated from the schema Guppie +module OpenAPI.Types.Guppie where + +import qualified Prelude as GHC.Integer.Type +import qualified Prelude as GHC.Maybe +import qualified Prelude as GHC.Internal.Maybe +import qualified Control.Monad.Fail +import qualified Control.Monad.Fail as GHC.Internal.Control.Monad.Fail +import qualified Data.Aeson +import qualified Data.Aeson as Data.Aeson.Encoding.Internal +import qualified Data.Aeson as Data.Aeson.Types +import qualified Data.Aeson as Data.Aeson.Types.FromJSON +import qualified Data.Aeson as Data.Aeson.Types.ToJSON +import qualified Data.Aeson as Data.Aeson.Types.Internal +import qualified Data.ByteString +import qualified Data.ByteString as Data.ByteString.Internal +import qualified Data.Foldable +import qualified Data.Foldable as GHC.Internal.Data.Foldable +import qualified Data.Functor +import qualified Data.Functor as GHC.Internal.Data.Functor +import qualified Data.Maybe +import qualified Data.Maybe as GHC.Internal.Data.Maybe +import qualified Data.Scientific +import qualified Data.Text +import qualified Data.Text as Data.Text.Internal +import qualified Data.Time.Calendar as Data.Time.Calendar.Days +import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime +import qualified GHC.Base +import qualified GHC.Base as GHC.Internal.Base +import qualified GHC.Classes +import qualified GHC.Int +import qualified GHC.Int as GHC.Internal.Int +import qualified GHC.Show +import qualified GHC.Show as GHC.Internal.Show +import qualified GHC.Types +import qualified OpenAPI.Common +import OpenAPI.TypeAlias + +-- | Defines the object schema located at @components.schemas.Guppie@ in the specification. +-- +-- +data Guppie = Guppie { + -- | color + guppieColor :: (GHC.Maybe.Maybe Data.Text.Internal.Text) + -- | fishType + , guppieFishType :: Data.Text.Internal.Text + } deriving (GHC.Show.Show + , GHC.Classes.Eq) +instance Data.Aeson.Types.ToJSON.ToJSON Guppie + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("color" Data.Aeson.Types.ToJSON..=)) (guppieColor obj) : ["fishType" Data.Aeson.Types.ToJSON..= guppieFishType obj] : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("color" Data.Aeson.Types.ToJSON..=)) (guppieColor obj) : ["fishType" Data.Aeson.Types.ToJSON..= guppieFishType obj] : GHC.Base.mempty)))} +instance Data.Aeson.Types.FromJSON.FromJSON Guppie + where {parseJSON = Data.Aeson.Types.FromJSON.withObject "Guppie" (\obj -> (GHC.Base.pure Guppie GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "color")) GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "fishType"))} +-- | Create a new 'Guppie' with all required fields. +mkGuppie :: Data.Text.Internal.Text -- ^ 'guppieFishType' + -> Guppie +mkGuppie guppieFishType = Guppie{guppieColor = GHC.Maybe.Nothing, + guppieFishType = guppieFishType} diff --git a/testing/golden-output/src/OpenAPI/Types/Guppie.hs-boot b/testing/golden-output/src/OpenAPI/Types/Guppie.hs-boot new file mode 100755 index 0000000..406af62 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Guppie.hs-boot @@ -0,0 +1,8 @@ +module OpenAPI.Types.Guppie where +import qualified Data.Aeson +import qualified OpenAPI.Common +data Guppie +instance Show Guppie +instance Eq Guppie +instance Data.Aeson.FromJSON Guppie +instance Data.Aeson.ToJSON Guppie diff --git a/testing/golden-output/src/OpenAPI/Types/Lizard.hs b/testing/golden-output/src/OpenAPI/Types/Lizard.hs new file mode 100755 index 0000000..1dae28c --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Lizard.hs @@ -0,0 +1,63 @@ +-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator. + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Contains the types generated from the schema Lizard +module OpenAPI.Types.Lizard where + +import qualified Prelude as GHC.Integer.Type +import qualified Prelude as GHC.Maybe +import qualified Prelude as GHC.Internal.Maybe +import qualified Control.Monad.Fail +import qualified Control.Monad.Fail as GHC.Internal.Control.Monad.Fail +import qualified Data.Aeson +import qualified Data.Aeson as Data.Aeson.Encoding.Internal +import qualified Data.Aeson as Data.Aeson.Types +import qualified Data.Aeson as Data.Aeson.Types.FromJSON +import qualified Data.Aeson as Data.Aeson.Types.ToJSON +import qualified Data.Aeson as Data.Aeson.Types.Internal +import qualified Data.ByteString +import qualified Data.ByteString as Data.ByteString.Internal +import qualified Data.Foldable +import qualified Data.Foldable as GHC.Internal.Data.Foldable +import qualified Data.Functor +import qualified Data.Functor as GHC.Internal.Data.Functor +import qualified Data.Maybe +import qualified Data.Maybe as GHC.Internal.Data.Maybe +import qualified Data.Scientific +import qualified Data.Text +import qualified Data.Text as Data.Text.Internal +import qualified Data.Time.Calendar as Data.Time.Calendar.Days +import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime +import qualified GHC.Base +import qualified GHC.Base as GHC.Internal.Base +import qualified GHC.Classes +import qualified GHC.Int +import qualified GHC.Int as GHC.Internal.Int +import qualified GHC.Show +import qualified GHC.Show as GHC.Internal.Show +import qualified GHC.Types +import qualified OpenAPI.Common +import OpenAPI.TypeAlias +import {-# SOURCE #-} OpenAPI.Types.Gecko +import {-# SOURCE #-} OpenAPI.Types.GilaMonster + +-- | Defines the oneOf schema located at @components.schemas.Lizard.oneOf@ in the specification. +-- +-- +data LizardVariants = + LizardGecko Gecko + | LizardGilaMonster GilaMonster + deriving (GHC.Show.Show, GHC.Classes.Eq) +instance Data.Aeson.Types.ToJSON.ToJSON LizardVariants + where {toJSON (LizardGecko a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (LizardGilaMonster a) = Data.Aeson.Types.ToJSON.toJSON a} +instance Data.Aeson.Types.FromJSON.FromJSON LizardVariants + where {parseJSON val = case (LizardGecko Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((LizardGilaMonster Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched") of + {Data.Aeson.Types.Internal.Success a -> GHC.Base.pure a; + Data.Aeson.Types.Internal.Error a -> Control.Monad.Fail.fail a}} +-- | Defines an alias for the schema located at @components.schemas.Lizard.oneOf@ in the specification. +-- +-- +type Lizard = LizardVariants diff --git a/testing/golden-output/src/OpenAPI/Types/Lizard.hs-boot b/testing/golden-output/src/OpenAPI/Types/Lizard.hs-boot new file mode 100755 index 0000000..5852326 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Lizard.hs-boot @@ -0,0 +1,9 @@ +module OpenAPI.Types.Lizard where +import qualified Data.Aeson +import qualified OpenAPI.Common +data LizardVariants +instance Show LizardVariants +instance Eq LizardVariants +instance Data.Aeson.FromJSON LizardVariants +instance Data.Aeson.ToJSON LizardVariants +type Lizard = LizardVariants diff --git a/testing/golden-output/src/OpenAPI/Types/Minnow.hs b/testing/golden-output/src/OpenAPI/Types/Minnow.hs new file mode 100755 index 0000000..6a45666 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Minnow.hs @@ -0,0 +1,63 @@ +-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator. + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Contains the types generated from the schema Minnow +module OpenAPI.Types.Minnow where + +import qualified Prelude as GHC.Integer.Type +import qualified Prelude as GHC.Maybe +import qualified Prelude as GHC.Internal.Maybe +import qualified Control.Monad.Fail +import qualified Control.Monad.Fail as GHC.Internal.Control.Monad.Fail +import qualified Data.Aeson +import qualified Data.Aeson as Data.Aeson.Encoding.Internal +import qualified Data.Aeson as Data.Aeson.Types +import qualified Data.Aeson as Data.Aeson.Types.FromJSON +import qualified Data.Aeson as Data.Aeson.Types.ToJSON +import qualified Data.Aeson as Data.Aeson.Types.Internal +import qualified Data.ByteString +import qualified Data.ByteString as Data.ByteString.Internal +import qualified Data.Foldable +import qualified Data.Foldable as GHC.Internal.Data.Foldable +import qualified Data.Functor +import qualified Data.Functor as GHC.Internal.Data.Functor +import qualified Data.Maybe +import qualified Data.Maybe as GHC.Internal.Data.Maybe +import qualified Data.Scientific +import qualified Data.Text +import qualified Data.Text as Data.Text.Internal +import qualified Data.Time.Calendar as Data.Time.Calendar.Days +import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime +import qualified GHC.Base +import qualified GHC.Base as GHC.Internal.Base +import qualified GHC.Classes +import qualified GHC.Int +import qualified GHC.Int as GHC.Internal.Int +import qualified GHC.Show +import qualified GHC.Show as GHC.Internal.Show +import qualified GHC.Types +import qualified OpenAPI.Common +import OpenAPI.TypeAlias + +-- | Defines the object schema located at @components.schemas.Minnow@ in the specification. +-- +-- +data Minnow = Minnow { + -- | color + minnowColor :: (GHC.Maybe.Maybe Data.Text.Internal.Text) + -- | fishType + , minnowFishType :: Data.Text.Internal.Text + } deriving (GHC.Show.Show + , GHC.Classes.Eq) +instance Data.Aeson.Types.ToJSON.ToJSON Minnow + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("color" Data.Aeson.Types.ToJSON..=)) (minnowColor obj) : ["fishType" Data.Aeson.Types.ToJSON..= minnowFishType obj] : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("color" Data.Aeson.Types.ToJSON..=)) (minnowColor obj) : ["fishType" Data.Aeson.Types.ToJSON..= minnowFishType obj] : GHC.Base.mempty)))} +instance Data.Aeson.Types.FromJSON.FromJSON Minnow + where {parseJSON = Data.Aeson.Types.FromJSON.withObject "Minnow" (\obj -> (GHC.Base.pure Minnow GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "color")) GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "fishType"))} +-- | Create a new 'Minnow' with all required fields. +mkMinnow :: Data.Text.Internal.Text -- ^ 'minnowFishType' + -> Minnow +mkMinnow minnowFishType = Minnow{minnowColor = GHC.Maybe.Nothing, + minnowFishType = minnowFishType} diff --git a/testing/golden-output/src/OpenAPI/Types/Minnow.hs-boot b/testing/golden-output/src/OpenAPI/Types/Minnow.hs-boot new file mode 100755 index 0000000..9be2de0 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Minnow.hs-boot @@ -0,0 +1,8 @@ +module OpenAPI.Types.Minnow where +import qualified Data.Aeson +import qualified OpenAPI.Common +data Minnow +instance Show Minnow +instance Eq Minnow +instance Data.Aeson.FromJSON Minnow +instance Data.Aeson.ToJSON Minnow diff --git a/testing/golden-output/src/OpenAPI/Types/Shark.hs b/testing/golden-output/src/OpenAPI/Types/Shark.hs new file mode 100755 index 0000000..754d6c8 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Shark.hs @@ -0,0 +1,63 @@ +-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator. + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Contains the types generated from the schema Shark +module OpenAPI.Types.Shark where + +import qualified Prelude as GHC.Integer.Type +import qualified Prelude as GHC.Maybe +import qualified Prelude as GHC.Internal.Maybe +import qualified Control.Monad.Fail +import qualified Control.Monad.Fail as GHC.Internal.Control.Monad.Fail +import qualified Data.Aeson +import qualified Data.Aeson as Data.Aeson.Encoding.Internal +import qualified Data.Aeson as Data.Aeson.Types +import qualified Data.Aeson as Data.Aeson.Types.FromJSON +import qualified Data.Aeson as Data.Aeson.Types.ToJSON +import qualified Data.Aeson as Data.Aeson.Types.Internal +import qualified Data.ByteString +import qualified Data.ByteString as Data.ByteString.Internal +import qualified Data.Foldable +import qualified Data.Foldable as GHC.Internal.Data.Foldable +import qualified Data.Functor +import qualified Data.Functor as GHC.Internal.Data.Functor +import qualified Data.Maybe +import qualified Data.Maybe as GHC.Internal.Data.Maybe +import qualified Data.Scientific +import qualified Data.Text +import qualified Data.Text as Data.Text.Internal +import qualified Data.Time.Calendar as Data.Time.Calendar.Days +import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime +import qualified GHC.Base +import qualified GHC.Base as GHC.Internal.Base +import qualified GHC.Classes +import qualified GHC.Int +import qualified GHC.Int as GHC.Internal.Int +import qualified GHC.Show +import qualified GHC.Show as GHC.Internal.Show +import qualified GHC.Types +import qualified OpenAPI.Common +import OpenAPI.TypeAlias + +-- | Defines the object schema located at @components.schemas.Shark@ in the specification. +-- +-- +data Shark = Shark { + -- | fishType + sharkFishType :: Data.Text.Internal.Text + -- | teethRemaining + , sharkTeethRemaining :: (GHC.Maybe.Maybe GHC.Types.Int) + } deriving (GHC.Show.Show + , GHC.Classes.Eq) +instance Data.Aeson.Types.ToJSON.ToJSON Shark + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (["fishType" Data.Aeson.Types.ToJSON..= sharkFishType obj] : Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("teethRemaining" Data.Aeson.Types.ToJSON..=)) (sharkTeethRemaining obj) : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (["fishType" Data.Aeson.Types.ToJSON..= sharkFishType obj] : Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("teethRemaining" Data.Aeson.Types.ToJSON..=)) (sharkTeethRemaining obj) : GHC.Base.mempty)))} +instance Data.Aeson.Types.FromJSON.FromJSON Shark + where {parseJSON = Data.Aeson.Types.FromJSON.withObject "Shark" (\obj -> (GHC.Base.pure Shark GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "fishType")) GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "teethRemaining"))} +-- | Create a new 'Shark' with all required fields. +mkShark :: Data.Text.Internal.Text -- ^ 'sharkFishType' + -> Shark +mkShark sharkFishType = Shark{sharkFishType = sharkFishType, + sharkTeethRemaining = GHC.Maybe.Nothing} diff --git a/testing/golden-output/src/OpenAPI/Types/Shark.hs-boot b/testing/golden-output/src/OpenAPI/Types/Shark.hs-boot new file mode 100755 index 0000000..cade6d4 --- /dev/null +++ b/testing/golden-output/src/OpenAPI/Types/Shark.hs-boot @@ -0,0 +1,8 @@ +module OpenAPI.Types.Shark where +import qualified Data.Aeson +import qualified OpenAPI.Common +data Shark +instance Show Shark +instance Eq Shark +instance Data.Aeson.FromJSON Shark +instance Data.Aeson.ToJSON Shark From 2d1b0e4dee760c6ebe62c4ee95b11721b04d8af9 Mon Sep 17 00:00:00 2001 From: "Michael \"Gilli\" Gilliland" Date: Thu, 12 Mar 2026 09:17:26 -0400 Subject: [PATCH 2/4] Use `discriminator` to parse correct union type The docs that I'm referencing are here: https://swagger.io/docs/specification/v3_0/data-models/inheritance-and-polymorphism/#discriminator They are a little confusing, underly prescriptive (IMHO), and lack specificity so I may have gotten some things wrong here. I figure though, as a first usable pass, this might be "good enough" and we can iron out the edge cases should they appear. **What's `discriminator`?** It specifies a `propertyName` which is used as a key to discriminate between different types that a type might take (e.g. `oneOf`). I'm fixing this in my Freckle day job because we have a few types which don't have meaningful distinction in structure (e.g. `{ tag: 'comma' } | { tag: 'newline' }`). Without `discriminator`, or something like it, our generated parsers are just picking the first case when they should respect `tag`. `discriminator` is designed to give this hint to the clients. **Key notes** - The docs say this should work in `anyOf` but I can't really comprehend how that _could_ work. I'm just ignoring it for now and putting it in the "later improvement" bucket since Freckle doesn't need that feature. - The docs also say that `mappings` are optional. If they're not present, then the schema's name will be used as the property value that's checked. The `Lizard` test case tries this. - I don't really know how far to take schema validation in this codebase. For example, the docs don't really say what should happen if there's a `ref` in `mappings` that's not in the `oneOf` (or vice versa). I _could_ check this and log a warning but I opted for less until I hear otherwise. I really wish the schema was better structured to just eliminate these cases but here we are. - This is my first template Haskell so please lemme know if I should be doing something different. --- .../src/OpenAPI/Generate/Model.hs | 104 ++++++++++++------ .../src/OpenAPI/Generate/Types/Schema.hs | 4 +- .../z_complex_self_made_example.yml | 8 +- testing/golden-output/openapi.cabal | 4 +- testing/golden-output/src/OpenAPI.hs | 8 +- testing/golden-output/src/OpenAPI/Types.hs | 8 +- .../golden-output/src/OpenAPI/Types/Fish.hs | 11 +- .../golden-output/src/OpenAPI/Types/Gecko.hs | 2 +- .../src/OpenAPI/Types/GilaMonster.hs | 2 +- .../golden-output/src/OpenAPI/Types/Lizard.hs | 10 +- 10 files changed, 106 insertions(+), 55 deletions(-) diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs index 88522f3..82bac7c 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs @@ -244,7 +244,7 @@ defineModelForSchemaConcreteIgnoreEnum strategy schemaName schema = do anyOfNull = null $ OAS.schemaObjectAnyOf schema in case (allOfNull, oneOfNull, anyOfNull) of (False, _, _) -> OAM.nested "allOf" $ defineAllOfSchema schemaName schemaDescription $ OAS.schemaObjectAllOf schema - (_, False, _) -> OAM.nested "oneOf" $ typeAliasing $ defineOneOfSchema schemaName schemaDescription $ OAS.schemaObjectOneOf schema + (_, False, _) -> OAM.nested "oneOf" $ typeAliasing $ defineOneOfSchema schemaName schemaDescription (OAS.schemaObjectOneOf schema) $ OAS.schemaObjectDiscriminator schema (_, _, False) -> OAM.nested "anyOf" $ defineAnyOfSchema strategy schemaName schemaDescription $ OAS.schemaObjectAnyOf schema _ -> defineObjectModelForSchema strategy schemaName schema _ -> @@ -350,7 +350,7 @@ defineAnyOfSchema strategy schemaName description schemas = do addDependencies newDependencies $ defineAllOfSchema schemaName description (fmap OAT.Concrete schemasWithoutRequired) else do OAM.logTrace "anyOf does contain at least one schema which is not of type object and will therefore be defined as oneOf" - createAlias schemaName description strategy $ defineOneOfSchema schemaName description schemas + createAlias schemaName description strategy $ defineOneOfSchema schemaName description schemas Nothing -- this would be the correct implementation -- but it generates endless loop because some implementations use anyOf as a oneOf @@ -369,18 +369,19 @@ defineAnyOfSchema strategy schemaName description schemas = do -- -- creates types for all the subschemas and then creates an adt with constructors for the different -- subschemas. Constructors are numbered -defineOneOfSchema :: Text -> Text -> [OAS.Schema] -> OAM.Generator TypeWithDeclaration -defineOneOfSchema schemaName description allSchemas = do +defineOneOfSchema :: Text -> Text -> [OAS.Schema] -> Maybe OAS.DiscriminatorObject -> OAM.Generator TypeWithDeclaration +defineOneOfSchema schemaName description allSchemas discriminator = do when (null allSchemas) $ OAM.logWarning "oneOf does not contain any sub-schemas and will therefore be defined as a void type" settings <- OAM.getSettings let haskellifyConstructor = haskellifyName (OAO.settingConvertToCamelCase settings) True + haskellifyPartialConstructor = haskellifyText (OAO.settingConvertToCamelCase settings) True name = haskellifyConstructor $ schemaName <> "Variants" fixedValueStrategy = OAO.settingFixedValueStrategy settings (otherSchemas, fixedValueSchemas, singleFieldedSchemas) = let (s', fixedValue) = extractSchemasWithFixedValues fixedValueStrategy allSchemas (s'', singleFielded) = extractSchemasWithSingleField s' in (s'', fixedValue, singleFielded) - defineSingleFielded field = defineModelForSchemaNamed (schemaName <> haskellifyText (OAO.settingConvertToCamelCase settings) True field) + defineSingleFielded field = defineModelForSchemaNamed $ schemaName <> haskellifyPartialConstructor field indexedSchemas = zip otherSchemas ([1 ..] :: [Integer]) defineIndexed schema index = defineModelForSchemaNamed (schemaName <> "OneOf" <> T.pack (show index)) schema OAM.logInfo $ "Define as oneOf named '" <> T.pack (nameBase name) <> "'" @@ -416,32 +417,73 @@ defineOneOfSchema schemaName description allSchemas = do e = varE patternName fromJsonFn = let paramName = mkName "val" - body = do - constructorNames' <- sequence constructorNames - let resultExpr = - foldr - ( \constructorName expr -> - [|($(varE constructorName) <$> Aeson.fromJSON $(varE paramName)) <|> $expr|] - ) - [|Aeson.Error "No variant matched"|] - constructorNames' - parserExpr = - [| - case $resultExpr of - Aeson.Success $p -> pure $e - Aeson.Error $p -> fail $e - |] - case fixedValueSchemas of - [] -> parserExpr - _ -> - multiIfE $ - fmap - ( \value -> - let constructorName = createConstructorNameForSchemaWithFixedValue value - in normalGE [|$(varE paramName) == $(liftAesonValue value)|] [|pure $(varE constructorName)|] - ) - fixedValueSchemas - <> [normalGE [|otherwise|] parserExpr] + body = + case discriminator of + Just disc -> do + let + fnArgName = mkName "obj" + discriminatorPropertyName = mkName "propertyName" + nonFixedSchemas = zip ([1 .. ] :: [Integer]) $ do + schema <- allSchemas + guard $ E.isLeft $ extractSchemaWithFixedValue FixedValueStrategyExclude schema + pure schema + schemaLookupFromRef = Map.fromList $ do + (n, schema) <- nonFixedSchemas + case schema of + OAT.Reference ref -> [(ref, (n, getSchemaNameFromReference ref))] + OAT.Concrete _ -> [] + oneOfSchemaRefs = do + (ref, (_, name')) <- Map.toList schemaLookupFromRef + pure (name', ref) + propertyNamesWithReferences = maybe oneOfSchemaRefs Map.toList $ OAS.discriminatorObjectMapping disc + let + mkMatchedCase (propName, fullRef) = + case Map.lookup fullRef schemaLookupFromRef of + Nothing -> [] + Just (n, caseName) -> do + let + suffix = if OAO.settingUseNumberedVariantConstructors settings then "Variant" <> T.pack (show n) else "" + parseConstructor constructorName = [|($(varE constructorName) <$> Aeson.parseJSON $(varE paramName))|] + [match (litP $ stringL $ T.unpack propName) (normalB [|$(parseConstructor $ haskellifyConstructor $ schemaName <> haskellifyPartialConstructor caseName <> suffix)|]) []] + matchedCases = propertyNamesWithReferences >>= mkMatchedCase + unmatchedCase = match (varP $ mkName "_unmatched") (normalB [|fail "No match for discriminator property"|]) [] + propertyCases = matchedCases <> [unmatchedCase] + getDiscProp = [|$(varE fnArgName) Aeson..:? $(stringE $ T.unpack $ OAS.discriminatorObjectPropertyName disc)|] + annotatedDiscriminatorPropertyName = [|$(varE discriminatorPropertyName) :: Text|] + withObjectLamda = [| + do + result <- $getDiscProp + case result of + Nothing -> fail "Object lacks discriminator property" + Just $(varP discriminatorPropertyName) -> + $(caseE annotatedDiscriminatorPropertyName propertyCases) + |] + [|Aeson.withObject $(stringE $ T.unpack schemaName) $(lam1E (varP fnArgName) withObjectLamda) $(varE paramName)|] + Nothing -> do + constructorNames' <- sequence constructorNames + let resultExpr = + foldr + ( \constructorName expr -> [|($(varE constructorName) <$> Aeson.fromJSON $(varE paramName)) <|> $expr|] + ) + [|Aeson.Error "No variant matched"|] + constructorNames' + parserExpr = + [| + case $resultExpr of + Aeson.Success $p -> pure $e + Aeson.Error $p -> fail $e + |] + case fixedValueSchemas of + [] -> parserExpr + _ -> + multiIfE $ + fmap + ( \value -> + let constructorName = createConstructorNameForSchemaWithFixedValue value + in normalGE [|$(varE paramName) == $(liftAesonValue value)|] [|pure $(varE constructorName)|] + ) + fixedValueSchemas + <> [normalGE [|otherwise|] parserExpr] in funD (mkName "parseJSON") [ clause diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Types/Schema.hs b/openapi3-code-generator/src/OpenAPI/Generate/Types/Schema.hs index 0f02564..b21afb5 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Types/Schema.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Types/Schema.hs @@ -175,7 +175,7 @@ instance FromJSON SchemaType where data DiscriminatorObject = DiscriminatorObject { discriminatorObjectPropertyName :: Text, - discriminatorObjectMapping :: Map.Map Text Text + discriminatorObjectMapping :: Maybe (Map.Map Text Text) } deriving (Show, Eq, Ord, Generic) @@ -183,7 +183,7 @@ instance FromJSON DiscriminatorObject where parseJSON = withObject "DiscriminatorObject" $ \o -> DiscriminatorObject <$> o .: "propertyName" - <*> o .:? "mapping" .!= Map.empty + <*> o .:? "mapping" .!= Nothing data ConcreteValue = StringDefaultValue Text diff --git a/specifications/z_complex_self_made_example.yml b/specifications/z_complex_self_made_example.yml index 1d1ddfb..196690d 100644 --- a/specifications/z_complex_self_made_example.yml +++ b/specifications/z_complex_self_made_example.yml @@ -373,11 +373,11 @@ components: Lizard: type: object oneOf: - - $ref: '#/components/schemas/Gecko' - - $ref: '#/components/schemas/GilaMonster' + - $ref: '#/components/schemas/gecko' + - $ref: '#/components/schemas/gilaMonster' discriminator: propertyName: lizardType - Gecko: + gecko: type: object properties: hasTail: @@ -386,7 +386,7 @@ components: type: string required: - lizardType - GilaMonster: + gilaMonster: type: object properties: hasTail: diff --git a/testing/golden-output/openapi.cabal b/testing/golden-output/openapi.cabal index fe3fb7d..d44eaee 100755 --- a/testing/golden-output/openapi.cabal +++ b/testing/golden-output/openapi.cabal @@ -22,8 +22,6 @@ library OpenAPI.Types.CoverType OpenAPI.Types.Dog OpenAPI.Types.Fish - OpenAPI.Types.Gecko - OpenAPI.Types.GilaMonster OpenAPI.Types.Guppie OpenAPI.Types.Lizard OpenAPI.Types.Minnow @@ -36,6 +34,8 @@ library OpenAPI.Types.Test8 OpenAPI.Types.Test9 OpenAPI.Types.Value + OpenAPI.Types.Gecko + OpenAPI.Types.GilaMonster OpenAPI.Configuration OpenAPI.SecuritySchemes OpenAPI.Common diff --git a/testing/golden-output/src/OpenAPI.hs b/testing/golden-output/src/OpenAPI.hs index a8c9ff5..9c14d96 100755 --- a/testing/golden-output/src/OpenAPI.hs +++ b/testing/golden-output/src/OpenAPI.hs @@ -17,8 +17,6 @@ module OpenAPI ( module OpenAPI.Types.CoverType, module OpenAPI.Types.Dog, module OpenAPI.Types.Fish, - module OpenAPI.Types.Gecko, - module OpenAPI.Types.GilaMonster, module OpenAPI.Types.Guppie, module OpenAPI.Types.Lizard, module OpenAPI.Types.Minnow, @@ -31,6 +29,8 @@ module OpenAPI ( module OpenAPI.Types.Test8, module OpenAPI.Types.Test9, module OpenAPI.Types.Value, + module OpenAPI.Types.Gecko, + module OpenAPI.Types.GilaMonster, module OpenAPI.Configuration, module OpenAPI.SecuritySchemes, module OpenAPI.Common, @@ -51,8 +51,6 @@ import OpenAPI.Types.Cat import OpenAPI.Types.CoverType import OpenAPI.Types.Dog import OpenAPI.Types.Fish -import OpenAPI.Types.Gecko -import OpenAPI.Types.GilaMonster import OpenAPI.Types.Guppie import OpenAPI.Types.Lizard import OpenAPI.Types.Minnow @@ -65,6 +63,8 @@ import OpenAPI.Types.Test7 import OpenAPI.Types.Test8 import OpenAPI.Types.Test9 import OpenAPI.Types.Value +import OpenAPI.Types.Gecko +import OpenAPI.Types.GilaMonster import OpenAPI.Configuration import OpenAPI.SecuritySchemes import OpenAPI.Common diff --git a/testing/golden-output/src/OpenAPI/Types.hs b/testing/golden-output/src/OpenAPI/Types.hs index 838911f..6ef0906 100755 --- a/testing/golden-output/src/OpenAPI/Types.hs +++ b/testing/golden-output/src/OpenAPI/Types.hs @@ -7,8 +7,6 @@ module OpenAPI.Types ( module OpenAPI.Types.CoverType, module OpenAPI.Types.Dog, module OpenAPI.Types.Fish, - module OpenAPI.Types.Gecko, - module OpenAPI.Types.GilaMonster, module OpenAPI.Types.Guppie, module OpenAPI.Types.Lizard, module OpenAPI.Types.Minnow, @@ -21,6 +19,8 @@ module OpenAPI.Types ( module OpenAPI.Types.Test8, module OpenAPI.Types.Test9, module OpenAPI.Types.Value, + module OpenAPI.Types.Gecko, + module OpenAPI.Types.GilaMonster, ) where import OpenAPI.TypeAlias @@ -28,8 +28,6 @@ import OpenAPI.Types.Cat import OpenAPI.Types.CoverType import OpenAPI.Types.Dog import OpenAPI.Types.Fish -import OpenAPI.Types.Gecko -import OpenAPI.Types.GilaMonster import OpenAPI.Types.Guppie import OpenAPI.Types.Lizard import OpenAPI.Types.Minnow @@ -42,3 +40,5 @@ import OpenAPI.Types.Test7 import OpenAPI.Types.Test8 import OpenAPI.Types.Test9 import OpenAPI.Types.Value +import OpenAPI.Types.Gecko +import OpenAPI.Types.GilaMonster diff --git a/testing/golden-output/src/OpenAPI/Types/Fish.hs b/testing/golden-output/src/OpenAPI/Types/Fish.hs index aa354f4..8e07aad 100755 --- a/testing/golden-output/src/OpenAPI/Types/Fish.hs +++ b/testing/golden-output/src/OpenAPI/Types/Fish.hs @@ -57,9 +57,14 @@ instance Data.Aeson.Types.ToJSON.ToJSON FishVariants toJSON (FishMinnow a) = Data.Aeson.Types.ToJSON.toJSON a; toJSON (FishShark a) = Data.Aeson.Types.ToJSON.toJSON a} instance Data.Aeson.Types.FromJSON.FromJSON FishVariants - where {parseJSON val = case (FishGuppie Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((FishMinnow Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((FishShark Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched")) of - {Data.Aeson.Types.Internal.Success a -> GHC.Base.pure a; - Data.Aeson.Types.Internal.Error a -> Control.Monad.Fail.fail a}} + where {parseJSON val = Data.Aeson.Types.FromJSON.withObject "Fish" (\obj -> do {result_0 <- obj Data.Aeson.Types.FromJSON..:? "fishType"; + case result_0 of + {GHC.Maybe.Nothing -> Control.Monad.Fail.fail "Object lacks discriminator property"; + GHC.Maybe.Just propertyName -> case propertyName :: Data.Text.Internal.Text of + {"guppie" -> FishGuppie Data.Functor.<$> Data.Aeson.Types.FromJSON.parseJSON val; + "minnow" -> FishMinnow Data.Functor.<$> Data.Aeson.Types.FromJSON.parseJSON val; + "shark" -> FishShark Data.Functor.<$> Data.Aeson.Types.FromJSON.parseJSON val; + _unmatched -> Control.Monad.Fail.fail "No match for discriminator property"}}}) val} -- | Defines an alias for the schema located at @components.schemas.Fish.oneOf@ in the specification. -- -- diff --git a/testing/golden-output/src/OpenAPI/Types/Gecko.hs b/testing/golden-output/src/OpenAPI/Types/Gecko.hs index 2320566..6163b37 100755 --- a/testing/golden-output/src/OpenAPI/Types/Gecko.hs +++ b/testing/golden-output/src/OpenAPI/Types/Gecko.hs @@ -41,7 +41,7 @@ import qualified GHC.Types import qualified OpenAPI.Common import OpenAPI.TypeAlias --- | Defines the object schema located at @components.schemas.Gecko@ in the specification. +-- | Defines the object schema located at @components.schemas.gecko@ in the specification. -- -- data Gecko = Gecko { diff --git a/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs b/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs index 97836c8..ced4c11 100755 --- a/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs +++ b/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs @@ -41,7 +41,7 @@ import qualified GHC.Types import qualified OpenAPI.Common import OpenAPI.TypeAlias --- | Defines the object schema located at @components.schemas.GilaMonster@ in the specification. +-- | Defines the object schema located at @components.schemas.gilaMonster@ in the specification. -- -- data GilaMonster = GilaMonster { diff --git a/testing/golden-output/src/OpenAPI/Types/Lizard.hs b/testing/golden-output/src/OpenAPI/Types/Lizard.hs index 1dae28c..24690cb 100755 --- a/testing/golden-output/src/OpenAPI/Types/Lizard.hs +++ b/testing/golden-output/src/OpenAPI/Types/Lizard.hs @@ -54,9 +54,13 @@ instance Data.Aeson.Types.ToJSON.ToJSON LizardVariants where {toJSON (LizardGecko a) = Data.Aeson.Types.ToJSON.toJSON a; toJSON (LizardGilaMonster a) = Data.Aeson.Types.ToJSON.toJSON a} instance Data.Aeson.Types.FromJSON.FromJSON LizardVariants - where {parseJSON val = case (LizardGecko Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((LizardGilaMonster Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched") of - {Data.Aeson.Types.Internal.Success a -> GHC.Base.pure a; - Data.Aeson.Types.Internal.Error a -> Control.Monad.Fail.fail a}} + where {parseJSON val = Data.Aeson.Types.FromJSON.withObject "Lizard" (\obj -> do {result_0 <- obj Data.Aeson.Types.FromJSON..:? "lizardType"; + case result_0 of + {GHC.Maybe.Nothing -> Control.Monad.Fail.fail "Object lacks discriminator property"; + GHC.Maybe.Just propertyName -> case propertyName :: Data.Text.Internal.Text of + {"gecko" -> LizardGecko Data.Functor.<$> Data.Aeson.Types.FromJSON.parseJSON val; + "gilaMonster" -> LizardGilaMonster Data.Functor.<$> Data.Aeson.Types.FromJSON.parseJSON val; + _unmatched -> Control.Monad.Fail.fail "No match for discriminator property"}}}) val} -- | Defines an alias for the schema located at @components.schemas.Lizard.oneOf@ in the specification. -- -- From 4da1e37f14a507fc3359a382e26036ea0a7f966f Mon Sep 17 00:00:00 2001 From: "Michael \"Gilli\" Gilliland" Date: Mon, 16 Mar 2026 08:39:07 -0400 Subject: [PATCH 3/4] Use more distinct discriminator key **Why?** To show that we're not just following some incorrect convention. --- specifications/z_complex_self_made_example.yml | 10 +++++----- .../golden-output/src/OpenAPI/Types/Gecko.hs | 18 +++++++++--------- .../src/OpenAPI/Types/GilaMonster.hs | 18 +++++++++--------- .../golden-output/src/OpenAPI/Types/Lizard.hs | 2 +- 4 files changed, 24 insertions(+), 24 deletions(-) diff --git a/specifications/z_complex_self_made_example.yml b/specifications/z_complex_self_made_example.yml index 196690d..ef353af 100644 --- a/specifications/z_complex_self_made_example.yml +++ b/specifications/z_complex_self_made_example.yml @@ -376,25 +376,25 @@ components: - $ref: '#/components/schemas/gecko' - $ref: '#/components/schemas/gilaMonster' discriminator: - propertyName: lizardType + propertyName: discriminatorTag gecko: type: object properties: hasTail: type: boolean - lizardType: + discriminatorTag: type: string required: - - lizardType + - discriminatorTag gilaMonster: type: object properties: hasTail: type: boolean - lizardType: + discriminatorTag: type: string required: - - lizardType + - discriminatorTag Mischling: allOf: # Combines the main `Pet` schema with `Cat`-specific properties - $ref: '#/components/schemas/Dog' diff --git a/testing/golden-output/src/OpenAPI/Types/Gecko.hs b/testing/golden-output/src/OpenAPI/Types/Gecko.hs index 6163b37..cf9909d 100755 --- a/testing/golden-output/src/OpenAPI/Types/Gecko.hs +++ b/testing/golden-output/src/OpenAPI/Types/Gecko.hs @@ -45,19 +45,19 @@ import OpenAPI.TypeAlias -- -- data Gecko = Gecko { + -- | discriminatorTag + geckoDiscriminatorTag :: Data.Text.Internal.Text -- | hasTail - geckoHasTail :: (GHC.Maybe.Maybe GHC.Types.Bool) - -- | lizardType - , geckoLizardType :: Data.Text.Internal.Text + , geckoHasTail :: (GHC.Maybe.Maybe GHC.Types.Bool) } deriving (GHC.Show.Show , GHC.Classes.Eq) instance Data.Aeson.Types.ToJSON.ToJSON Gecko - where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (geckoHasTail obj) : ["lizardType" Data.Aeson.Types.ToJSON..= geckoLizardType obj] : GHC.Base.mempty)); - toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (geckoHasTail obj) : ["lizardType" Data.Aeson.Types.ToJSON..= geckoLizardType obj] : GHC.Base.mempty)))} + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (["discriminatorTag" Data.Aeson.Types.ToJSON..= geckoDiscriminatorTag obj] : Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (geckoHasTail obj) : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (["discriminatorTag" Data.Aeson.Types.ToJSON..= geckoDiscriminatorTag obj] : Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (geckoHasTail obj) : GHC.Base.mempty)))} instance Data.Aeson.Types.FromJSON.FromJSON Gecko - where {parseJSON = Data.Aeson.Types.FromJSON.withObject "Gecko" (\obj -> (GHC.Base.pure Gecko GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "hasTail")) GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "lizardType"))} + where {parseJSON = Data.Aeson.Types.FromJSON.withObject "Gecko" (\obj -> (GHC.Base.pure Gecko GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "discriminatorTag")) GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "hasTail"))} -- | Create a new 'Gecko' with all required fields. -mkGecko :: Data.Text.Internal.Text -- ^ 'geckoLizardType' +mkGecko :: Data.Text.Internal.Text -- ^ 'geckoDiscriminatorTag' -> Gecko -mkGecko geckoLizardType = Gecko{geckoHasTail = GHC.Maybe.Nothing, - geckoLizardType = geckoLizardType} +mkGecko geckoDiscriminatorTag = Gecko{geckoDiscriminatorTag = geckoDiscriminatorTag, + geckoHasTail = GHC.Maybe.Nothing} diff --git a/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs b/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs index ced4c11..cac2278 100755 --- a/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs +++ b/testing/golden-output/src/OpenAPI/Types/GilaMonster.hs @@ -45,19 +45,19 @@ import OpenAPI.TypeAlias -- -- data GilaMonster = GilaMonster { + -- | discriminatorTag + gilaMonsterDiscriminatorTag :: Data.Text.Internal.Text -- | hasTail - gilaMonsterHasTail :: (GHC.Maybe.Maybe GHC.Types.Bool) - -- | lizardType - , gilaMonsterLizardType :: Data.Text.Internal.Text + , gilaMonsterHasTail :: (GHC.Maybe.Maybe GHC.Types.Bool) } deriving (GHC.Show.Show , GHC.Classes.Eq) instance Data.Aeson.Types.ToJSON.ToJSON GilaMonster - where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (gilaMonsterHasTail obj) : ["lizardType" Data.Aeson.Types.ToJSON..= gilaMonsterLizardType obj] : GHC.Base.mempty)); - toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (gilaMonsterHasTail obj) : ["lizardType" Data.Aeson.Types.ToJSON..= gilaMonsterLizardType obj] : GHC.Base.mempty)))} + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (["discriminatorTag" Data.Aeson.Types.ToJSON..= gilaMonsterDiscriminatorTag obj] : Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (gilaMonsterHasTail obj) : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (["discriminatorTag" Data.Aeson.Types.ToJSON..= gilaMonsterDiscriminatorTag obj] : Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("hasTail" Data.Aeson.Types.ToJSON..=)) (gilaMonsterHasTail obj) : GHC.Base.mempty)))} instance Data.Aeson.Types.FromJSON.FromJSON GilaMonster - where {parseJSON = Data.Aeson.Types.FromJSON.withObject "GilaMonster" (\obj -> (GHC.Base.pure GilaMonster GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "hasTail")) GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "lizardType"))} + where {parseJSON = Data.Aeson.Types.FromJSON.withObject "GilaMonster" (\obj -> (GHC.Base.pure GilaMonster GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "discriminatorTag")) GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "hasTail"))} -- | Create a new 'GilaMonster' with all required fields. -mkGilaMonster :: Data.Text.Internal.Text -- ^ 'gilaMonsterLizardType' +mkGilaMonster :: Data.Text.Internal.Text -- ^ 'gilaMonsterDiscriminatorTag' -> GilaMonster -mkGilaMonster gilaMonsterLizardType = GilaMonster{gilaMonsterHasTail = GHC.Maybe.Nothing, - gilaMonsterLizardType = gilaMonsterLizardType} +mkGilaMonster gilaMonsterDiscriminatorTag = GilaMonster{gilaMonsterDiscriminatorTag = gilaMonsterDiscriminatorTag, + gilaMonsterHasTail = GHC.Maybe.Nothing} diff --git a/testing/golden-output/src/OpenAPI/Types/Lizard.hs b/testing/golden-output/src/OpenAPI/Types/Lizard.hs index 24690cb..e1454ce 100755 --- a/testing/golden-output/src/OpenAPI/Types/Lizard.hs +++ b/testing/golden-output/src/OpenAPI/Types/Lizard.hs @@ -54,7 +54,7 @@ instance Data.Aeson.Types.ToJSON.ToJSON LizardVariants where {toJSON (LizardGecko a) = Data.Aeson.Types.ToJSON.toJSON a; toJSON (LizardGilaMonster a) = Data.Aeson.Types.ToJSON.toJSON a} instance Data.Aeson.Types.FromJSON.FromJSON LizardVariants - where {parseJSON val = Data.Aeson.Types.FromJSON.withObject "Lizard" (\obj -> do {result_0 <- obj Data.Aeson.Types.FromJSON..:? "lizardType"; + where {parseJSON val = Data.Aeson.Types.FromJSON.withObject "Lizard" (\obj -> do {result_0 <- obj Data.Aeson.Types.FromJSON..:? "discriminatorTag"; case result_0 of {GHC.Maybe.Nothing -> Control.Monad.Fail.fail "Object lacks discriminator property"; GHC.Maybe.Just propertyName -> case propertyName :: Data.Text.Internal.Text of From 4975f2e0a84d6f7cf380ba0e6d915d947f1a30b3 Mon Sep 17 00:00:00 2001 From: "Michael \"Gilli\" Gilliland" Date: Mon, 16 Mar 2026 08:40:24 -0400 Subject: [PATCH 4/4] Run formatter --- .../src/OpenAPI/Generate/Model.hs | 74 +++++++++---------- 1 file changed, 36 insertions(+), 38 deletions(-) diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs index 82bac7c..d73b323 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs @@ -420,44 +420,42 @@ defineOneOfSchema schemaName description allSchemas discriminator = do body = case discriminator of Just disc -> do - let - fnArgName = mkName "obj" - discriminatorPropertyName = mkName "propertyName" - nonFixedSchemas = zip ([1 .. ] :: [Integer]) $ do - schema <- allSchemas - guard $ E.isLeft $ extractSchemaWithFixedValue FixedValueStrategyExclude schema - pure schema - schemaLookupFromRef = Map.fromList $ do - (n, schema) <- nonFixedSchemas - case schema of - OAT.Reference ref -> [(ref, (n, getSchemaNameFromReference ref))] - OAT.Concrete _ -> [] - oneOfSchemaRefs = do - (ref, (_, name')) <- Map.toList schemaLookupFromRef - pure (name', ref) - propertyNamesWithReferences = maybe oneOfSchemaRefs Map.toList $ OAS.discriminatorObjectMapping disc - let - mkMatchedCase (propName, fullRef) = - case Map.lookup fullRef schemaLookupFromRef of - Nothing -> [] - Just (n, caseName) -> do - let - suffix = if OAO.settingUseNumberedVariantConstructors settings then "Variant" <> T.pack (show n) else "" - parseConstructor constructorName = [|($(varE constructorName) <$> Aeson.parseJSON $(varE paramName))|] - [match (litP $ stringL $ T.unpack propName) (normalB [|$(parseConstructor $ haskellifyConstructor $ schemaName <> haskellifyPartialConstructor caseName <> suffix)|]) []] - matchedCases = propertyNamesWithReferences >>= mkMatchedCase - unmatchedCase = match (varP $ mkName "_unmatched") (normalB [|fail "No match for discriminator property"|]) [] - propertyCases = matchedCases <> [unmatchedCase] - getDiscProp = [|$(varE fnArgName) Aeson..:? $(stringE $ T.unpack $ OAS.discriminatorObjectPropertyName disc)|] - annotatedDiscriminatorPropertyName = [|$(varE discriminatorPropertyName) :: Text|] - withObjectLamda = [| - do - result <- $getDiscProp - case result of - Nothing -> fail "Object lacks discriminator property" - Just $(varP discriminatorPropertyName) -> - $(caseE annotatedDiscriminatorPropertyName propertyCases) - |] + let fnArgName = mkName "obj" + discriminatorPropertyName = mkName "propertyName" + nonFixedSchemas = zip ([1 ..] :: [Integer]) $ do + schema <- allSchemas + guard $ E.isLeft $ extractSchemaWithFixedValue FixedValueStrategyExclude schema + pure schema + schemaLookupFromRef = Map.fromList $ do + (n, schema) <- nonFixedSchemas + case schema of + OAT.Reference ref -> [(ref, (n, getSchemaNameFromReference ref))] + OAT.Concrete _ -> [] + oneOfSchemaRefs = do + (ref, (_, name')) <- Map.toList schemaLookupFromRef + pure (name', ref) + propertyNamesWithReferences = maybe oneOfSchemaRefs Map.toList $ OAS.discriminatorObjectMapping disc + let mkMatchedCase (propName, fullRef) = + case Map.lookup fullRef schemaLookupFromRef of + Nothing -> [] + Just (n, caseName) -> do + let suffix = if OAO.settingUseNumberedVariantConstructors settings then "Variant" <> T.pack (show n) else "" + parseConstructor constructorName = [|($(varE constructorName) <$> Aeson.parseJSON $(varE paramName))|] + [match (litP $ stringL $ T.unpack propName) (normalB [|$(parseConstructor $ haskellifyConstructor $ schemaName <> haskellifyPartialConstructor caseName <> suffix)|]) []] + matchedCases = propertyNamesWithReferences >>= mkMatchedCase + unmatchedCase = match (varP $ mkName "_unmatched") (normalB [|fail "No match for discriminator property"|]) [] + propertyCases = matchedCases <> [unmatchedCase] + getDiscProp = [|$(varE fnArgName) Aeson..:? $(stringE $ T.unpack $ OAS.discriminatorObjectPropertyName disc)|] + annotatedDiscriminatorPropertyName = [|$(varE discriminatorPropertyName) :: Text|] + withObjectLamda = + [| + do + result <- $getDiscProp + case result of + Nothing -> fail "Object lacks discriminator property" + Just $(varP discriminatorPropertyName) -> + $(caseE annotatedDiscriminatorPropertyName propertyCases) + |] [|Aeson.withObject $(stringE $ T.unpack schemaName) $(lam1E (varP fnArgName) withObjectLamda) $(varE paramName)|] Nothing -> do constructorNames' <- sequence constructorNames