Add typeOptions support for oneOf/Unions

flipstone · Sep 18, 2024 · cda1a64 · cda1a64
1 parent 21c4214
commit cda1a64
Show file tree

Hide file tree

Showing 8 changed files with 58 additions and 12 deletions.
diff --git 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
@@ -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
+      #+ FC.optional "customUtcTimeField" customUtcTimeField CustomUtcTimeField.customUtcTimeFieldSchema
+      #+ FC.optional "zonedTimeInUnionField" zonedTimeInUnionField ZonedTimeInUnionField.zonedTimeInUnionFieldSchema
diff --git a/...ece-openapi3/examples/test-cases/TestCases/Types/DateTimeFormats/ZonedTimeInUnionField.hs b/...ece-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
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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 ->