From cda1a64e12560861eade0f4859e6fbc720c25682 Mon Sep 17 00:00:00 2001 From: Janus Troelsen Date: Wed, 18 Sep 2024 10:07:09 -0600 Subject: [PATCH] Add typeOptions support for oneOf/Unions --- .../src/Fleece/CodeGenUtil.hs | 15 ++++++----- .../TestCases/Types/DateTimeFormats.hs | 5 +++- .../DateTimeFormats/ZonedTimeInUnionField.hs | 27 +++++++++++++++++++ .../examples/test-cases/codegen.dhall | 6 +++++ .../examples/test-cases/test-cases.cabal | 1 + .../examples/test-cases/test-cases.yaml | 5 ++++ .../json-fleece-openapi3.cabal | 1 + json-fleece-openapi3/src/Fleece/OpenApi3.hs | 10 ++++--- 8 files changed, 58 insertions(+), 12 deletions(-) create mode 100644 json-fleece-openapi3/examples/test-cases/TestCases/Types/DateTimeFormats/ZonedTimeInUnionField.hs diff --git a/json-fleece-codegen-util/src/Fleece/CodeGenUtil.hs b/json-fleece-codegen-util/src/Fleece/CodeGenUtil.hs index 0d76a2f..b508b3d 100644 --- a/json-fleece-codegen-util/src/Fleece/CodeGenUtil.hs +++ b/json-fleece-codegen-util/src/Fleece/CodeGenUtil.hs @@ -241,7 +241,7 @@ mkReferencesMap = <> maybe mempty mkAdditionalPropertiesReferences mbAdditionalProperties CodeGenArray _options _mbMaxLength ref -> mkSingletonReference ArrayItemSource ref - CodeGenUnion members -> + CodeGenUnion _options members -> foldMap mkUnionMemberReferences members CodeGenTaggedUnion discriminatorProperty members -> foldMap @@ -335,7 +335,7 @@ data CodeGenDataFormat | CodeGenEnum TypeOptions [T.Text] | CodeGenObject TypeOptions [CodeGenObjectField] (Maybe CodeGenAdditionalProperties) | CodeGenArray TypeOptions (Maybe Integer) CodeGenRefType - | CodeGenUnion [CodeGenUnionMember] + | CodeGenUnion TypeOptions [CodeGenUnionMember] | CodeGenTaggedUnion T.Text [CodeGenTaggedUnionMember] codeGenNewTypeSchemaTypeInfo :: TypeOptions -> SchemaTypeInfo -> CodeGenDataFormat @@ -1235,8 +1235,8 @@ generateCodeGenDataFormat typeMap references typeName format = do generateFleeceObject typeMap references typeName fields mbAdditionalProperties typeOptions CodeGenArray typeOptions mbMinItems itemType -> generateFleeceArray typeMap typeName mbMinItems itemType typeOptions - CodeGenUnion members -> - generateFleeceUnion typeMap typeName members + CodeGenUnion typeOptions members -> + generateFleeceUnion typeMap typeName members typeOptions CodeGenTaggedUnion tagProperty members -> generateFleeceTaggedUnion typeMap typeName tagProperty members @@ -1249,7 +1249,7 @@ requiredPragmasForFormat format = CodeGenEnum _ _ -> [] CodeGenObject _ _ _ -> [] CodeGenArray _ _ _ -> [] - CodeGenUnion _ -> + CodeGenUnion _ _ -> [ "{-# LANGUAGE DataKinds #-}" ] CodeGenTaggedUnion _ _ -> @@ -1467,8 +1467,9 @@ generateFleeceUnion :: CodeGenMap -> HC.TypeName -> [CodeGenUnionMember] -> + TypeOptions -> CodeGen ([HC.VarName], HC.HaskellCode) -generateFleeceUnion typeMap typeName members = do +generateFleeceUnion typeMap typeName members typeOptions = do typeInfos <- traverse (schemaInfoOrRefToSchemaTypeInfo typeMap . codeGenUnionMemberType) @@ -1512,7 +1513,7 @@ generateFleeceUnion typeMap typeName members = do HC.newtype_ typeName ("(" <> HC.union (schemaTypeExpr <$> typeInfos) <> ")") - Nothing + (deriveClassNames typeOptions) extraExports = [] diff --git a/json-fleece-openapi3/examples/test-cases/TestCases/Types/DateTimeFormats.hs b/json-fleece-openapi3/examples/test-cases/TestCases/Types/DateTimeFormats.hs index b2ac7e6..d7cc318 100644 --- a/json-fleece-openapi3/examples/test-cases/TestCases/Types/DateTimeFormats.hs +++ b/json-fleece-openapi3/examples/test-cases/TestCases/Types/DateTimeFormats.hs @@ -15,6 +15,7 @@ import qualified TestCases.Types.DateTimeFormats.DefaultTimeField as DefaultTime import qualified TestCases.Types.DateTimeFormats.LocalTimeField as LocalTimeField import qualified TestCases.Types.DateTimeFormats.UtcTimeField as UtcTimeField import qualified TestCases.Types.DateTimeFormats.ZonedTimeField as ZonedTimeField +import qualified TestCases.Types.DateTimeFormats.ZonedTimeInUnionField as ZonedTimeInUnionField data DateTimeFormats = DateTimeFormats { zonedTimeField :: Maybe ZonedTimeField.ZonedTimeField @@ -24,6 +25,7 @@ data DateTimeFormats = DateTimeFormats , utcTimeField :: Maybe UtcTimeField.UtcTimeField , customZonedTimeField :: Maybe CustomZonedTimeField.CustomZonedTimeField , customUtcTimeField :: Maybe CustomUtcTimeField.CustomUtcTimeField + , zonedTimeInUnionField :: Maybe ZonedTimeInUnionField.ZonedTimeInUnionField } deriving (Show) @@ -37,4 +39,5 @@ dateTimeFormatsSchema = #+ FC.optional "customLocalTimeField" customLocalTimeField CustomLocalTimeField.customLocalTimeFieldSchema #+ FC.optional "utcTimeField" utcTimeField UtcTimeField.utcTimeFieldSchema #+ FC.optional "customZonedTimeField" customZonedTimeField CustomZonedTimeField.customZonedTimeFieldSchema - #+ FC.optional "customUtcTimeField" customUtcTimeField CustomUtcTimeField.customUtcTimeFieldSchema \ No newline at end of file + #+ FC.optional "customUtcTimeField" customUtcTimeField CustomUtcTimeField.customUtcTimeFieldSchema + #+ FC.optional "zonedTimeInUnionField" zonedTimeInUnionField ZonedTimeInUnionField.zonedTimeInUnionFieldSchema \ No newline at end of file diff --git a/json-fleece-openapi3/examples/test-cases/TestCases/Types/DateTimeFormats/ZonedTimeInUnionField.hs b/json-fleece-openapi3/examples/test-cases/TestCases/Types/DateTimeFormats/ZonedTimeInUnionField.hs new file mode 100644 index 0000000..459ed64 --- /dev/null +++ b/json-fleece-openapi3/examples/test-cases/TestCases/Types/DateTimeFormats/ZonedTimeInUnionField.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DataKinds #-} + +module TestCases.Types.DateTimeFormats.ZonedTimeInUnionField + ( ZonedTimeInUnionField(..) + , zonedTimeInUnionFieldSchema + ) where + +import qualified Data.Text as T +import Fleece.Core ((#|)) +import qualified Fleece.Core as FC +import Prelude (($), Show) +import qualified Shrubbery as Shrubbery +import qualified TestCases.Types.ZonedTimeType as ZonedTimeType + +newtype ZonedTimeInUnionField = ZonedTimeInUnionField (Shrubbery.Union + '[ ZonedTimeType.ZonedTimeType + , T.Text + ]) + deriving (Show) + +zonedTimeInUnionFieldSchema :: FC.Fleece schema => schema ZonedTimeInUnionField +zonedTimeInUnionFieldSchema = + FC.coerceSchema $ + FC.unionNamed (FC.qualifiedName "TestCases.Types.DateTimeFormats.ZonedTimeInUnionField" "ZonedTimeInUnionField") $ + FC.unionMember ZonedTimeType.zonedTimeTypeSchema + #| FC.unionMember FC.text \ No newline at end of file diff --git a/json-fleece-openapi3/examples/test-cases/codegen.dhall b/json-fleece-openapi3/examples/test-cases/codegen.dhall index 4014def..6c39460 100644 --- a/json-fleece-openapi3/examples/test-cases/codegen.dhall +++ b/json-fleece-openapi3/examples/test-cases/codegen.dhall @@ -63,6 +63,12 @@ in , formatSpecifier = Some "local" } } + , { type = "TestCases.Types.DateTimeFormats.ZonedTimeInUnionField.ZonedTimeInUnionField" + , options = + CodeGen.TypeOptions:: + { deriveClasses = CodeGen.derive [ CodeGen.show ] + } + } , { type = "TestCases.Types.UtcTimeType.UtcTimeType" , options = CodeGen.TypeOptions:: diff --git a/json-fleece-openapi3/examples/test-cases/test-cases.cabal b/json-fleece-openapi3/examples/test-cases/test-cases.cabal index c9d6730..41effe3 100644 --- a/json-fleece-openapi3/examples/test-cases/test-cases.cabal +++ b/json-fleece-openapi3/examples/test-cases/test-cases.cabal @@ -93,6 +93,7 @@ library TestCases.Types.DateTimeFormats.LocalTimeField TestCases.Types.DateTimeFormats.UtcTimeField TestCases.Types.DateTimeFormats.ZonedTimeField + TestCases.Types.DateTimeFormats.ZonedTimeInUnionField TestCases.Types.DefaultTimeType TestCases.Types.DerivingNothing TestCases.Types.EnumIntParam diff --git a/json-fleece-openapi3/examples/test-cases/test-cases.yaml b/json-fleece-openapi3/examples/test-cases/test-cases.yaml index 54d561a..f7af01b 100644 --- a/json-fleece-openapi3/examples/test-cases/test-cases.yaml +++ b/json-fleece-openapi3/examples/test-cases/test-cases.yaml @@ -746,6 +746,11 @@ components: customLocalTimeField: type: string format: date-time + zonedTimeInUnionField: + oneOf: + - $ref: '#/components/schemas/ZonedTimeType' + - type: string + format: date-time # Bug: This doesn't actually change it from being a Text in the generated code DefaultTimeType: type: string diff --git a/json-fleece-openapi3/json-fleece-openapi3.cabal b/json-fleece-openapi3/json-fleece-openapi3.cabal index ed31133..371171b 100644 --- a/json-fleece-openapi3/json-fleece-openapi3.cabal +++ b/json-fleece-openapi3/json-fleece-openapi3.cabal @@ -1940,6 +1940,7 @@ extra-source-files: examples/test-cases/TestCases/Types/DateTimeFormats/LocalTimeField.hs examples/test-cases/TestCases/Types/DateTimeFormats/UtcTimeField.hs examples/test-cases/TestCases/Types/DateTimeFormats/ZonedTimeField.hs + examples/test-cases/TestCases/Types/DateTimeFormats/ZonedTimeInUnionField.hs examples/test-cases/TestCases/Types/DefaultTimeType.hs examples/test-cases/TestCases/Types/DerivingNothing.hs examples/test-cases/TestCases/Types/EnumIntParam.hs diff --git a/json-fleece-openapi3/src/Fleece/OpenApi3.hs b/json-fleece-openapi3/src/Fleece/OpenApi3.hs index 39d836f..d16034c 100644 --- a/json-fleece-openapi3/src/Fleece/OpenApi3.hs +++ b/json-fleece-openapi3/src/Fleece/OpenApi3.hs @@ -906,8 +906,9 @@ mkOpenApiDataFormat schemaKey typeName schema = case OA._schemaOneOf schema of Just schemas -> case OA._schemaDiscriminator schema of - Nothing -> - Just <$> mkOneOfUnion schemaKey schemas + Nothing -> do + typeOptions <- CGU.lookupTypeOptions typeName + Just <$> mkOneOfUnion schemaKey typeOptions schemas Just discriminator -> Just <$> mkOneOfTaggedUnion discriminator schemaKey Nothing -> @@ -938,9 +939,10 @@ mkOpenApiDataFormat schemaKey typeName schema = mkOneOfUnion :: T.Text -> + CGU.TypeOptions -> [OA.Referenced OA.Schema] -> CGU.CodeGen (SchemaMap, CGU.CodeGenDataFormat) -mkOneOfUnion schemaKey refSchemas = do +mkOneOfUnion schemaKey typeOptions refSchemas = do let processRefSchema refSchema = case refSchema of @@ -967,7 +969,7 @@ mkOneOfUnion schemaKey refSchemas = do (maps, codeGenUnionMembers) <- fmap unzip . traverse processRefSchema $ refSchemas schemaMap <- unionsErrorOnConflict maps - pure (schemaMap, CGU.CodeGenUnion codeGenUnionMembers) + pure (schemaMap, CGU.CodeGenUnion typeOptions codeGenUnionMembers) mkOneOfTaggedUnion :: OA.Discriminator ->