Ignores additional properties by default

This adds a config field `ignoreAdditionalProperties` which is
defaulted to `True`. When code gen encounters
`additionalProperties: false`, we now ignore it or produce an
error based on the value of that config field.

json-fleece-codegen-util/codegen-prelude.dhall

@@ -34,6 +34,7 @@ let
   baseConfig =
     { defaultTypeOptions = TypeOptions.default
     , typeOptions = [] : List SpecificTypeOptions
+    , ignoreAdditionalProperties = True
     }
 
 in

json-fleece-codegen-util/src/Fleece/CodeGenUtil.hs

@@ -93,6 +93,7 @@ data CodeGenOptions = CodeGenOptions
   { moduleBaseName :: T.Text
   , defaultTypeOptions :: TypeOptions
   , typeOptionsMap :: Map.Map T.Text TypeOptions
+  , ignoreAdditionalProperties :: Bool
   }
 
 data TypeOptions = TypeOptions

json-fleece-codegen-util/src/Fleece/CodeGenUtil/Config.hs

@@ -26,6 +26,7 @@ decoder =
                 <$> Dhall.field "moduleBaseName" Dhall.strictText
                 <*> Dhall.field "defaultTypeOptions" typeOptionsDecoder
                 <*> Dhall.field "typeOptions" typeOptionsMapDecoder
+                <*> Dhall.field "ignoreAdditionalProperties" Dhall.bool
             )
         <*> Dhall.field "inputFileName" Dhall.string
         <*> Dhall.field "destination" Dhall.string

json-fleece-openapi3/examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesFalse.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module TestCases.Types.MixedInAdditionalPropertiesFalse
+  ( MixedInAdditionalPropertiesFalse(..)
+  , mixedInAdditionalPropertiesFalseSchema
+  ) where
+
+import qualified Data.Map as Map
+import qualified Data.Text as T
+import Fleece.Core ((#*), (#+))
+import qualified Fleece.Core as FC
+import Prelude (($), Eq, Maybe, Show)
+import qualified TestCases.Types.MixedInAdditionalPropertiesFalse.Bar as Bar
+import qualified TestCases.Types.MixedInAdditionalPropertiesFalse.Foo as Foo
+
+data MixedInAdditionalPropertiesFalse = MixedInAdditionalPropertiesFalse
+  { bar :: Maybe Bar.Bar
+  , foo :: Maybe Foo.Foo
+  , additionalProperties :: (Map.Map T.Text FC.AnyJSON)
+  }
+  deriving (Eq, Show)
+
+mixedInAdditionalPropertiesFalseSchema :: FC.Fleece schema => schema MixedInAdditionalPropertiesFalse
+mixedInAdditionalPropertiesFalseSchema =
+  FC.object $
+    FC.constructor MixedInAdditionalPropertiesFalse
+      #+ FC.optional "bar" bar Bar.barSchema
+      #+ FC.optional "foo" foo Foo.fooSchema
+      #* FC.additionalFields additionalProperties FC.anyJSON

json-fleece-openapi3/examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesFalse/Bar.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module TestCases.Types.MixedInAdditionalPropertiesFalse.Bar
+  ( Bar(..)
+  , barSchema
+  ) where
+
+import qualified Data.Text as T
+import qualified Fleece.Core as FC
+import Prelude (Eq, Show)
+
+newtype Bar = Bar T.Text
+  deriving (Show, Eq)
+
+barSchema :: FC.Fleece schema => schema Bar
+barSchema =
+  FC.coerceSchema FC.text

json-fleece-openapi3/examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesFalse/Foo.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module TestCases.Types.MixedInAdditionalPropertiesFalse.Foo
+  ( Foo(..)
+  , fooSchema
+  ) where
+
+import qualified Data.Text as T
+import qualified Fleece.Core as FC
+import Prelude (Eq, Show)
+
+newtype Foo = Foo T.Text
+  deriving (Show, Eq)
+
+fooSchema :: FC.Fleece schema => schema Foo
+fooSchema =
+  FC.coerceSchema FC.text

json-fleece-openapi3/examples/test-cases/test-cases.cabal

@@ -104,6 +104,9 @@ library
       TestCases.Types.JustAdditionalPropertiesSchemaRef
       TestCases.Types.JustAdditionalPropertiesTrue
       TestCases.Types.LocalTimeType
+      TestCases.Types.MixedInAdditionalPropertiesFalse
+      TestCases.Types.MixedInAdditionalPropertiesFalse.Bar
+      TestCases.Types.MixedInAdditionalPropertiesFalse.Foo
       TestCases.Types.MixedInAdditionalPropertiesTrue
       TestCases.Types.MixedInAdditionalPropertiesTrue.Bar
       TestCases.Types.MixedInAdditionalPropertiesTrue.Foo

json-fleece-openapi3/examples/test-cases/test-cases.yaml

@@ -715,6 +715,16 @@ components:
           type: string
       additionalProperties: true
 
+    MixedInAdditionalPropertiesFalse:
+      type: object
+      description: An object with additionalProperties = false mixed in with other properties. This will produce an error if `ignoreAdditionalProperties` is set to `False`.
+      properties:
+        foo:
+          type: string
+        bar:
+          type: string
+      additionalProperties: false
+
     MixedInJustAdditionalPropertiesSchemaRef:
       type: object
       description: An object with additionalProperties as a schema ref mixed in with other properties

json-fleece-openapi3/json-fleece-openapi3.cabal

@@ -1951,6 +1951,9 @@ extra-source-files:
     examples/test-cases/TestCases/Types/JustAdditionalPropertiesSchemaRef.hs
     examples/test-cases/TestCases/Types/JustAdditionalPropertiesTrue.hs
     examples/test-cases/TestCases/Types/LocalTimeType.hs
+    examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesFalse.hs
+    examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesFalse/Bar.hs
+    examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesFalse/Foo.hs
     examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesTrue.hs
     examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesTrue/Bar.hs
     examples/test-cases/TestCases/Types/MixedInAdditionalPropertiesTrue/Foo.hs
@@ -2025,6 +2028,7 @@ library
     , containers ==0.6.*
     , insert-ordered-containers ==0.2.*
     , json-fleece-codegen-util ==0.8.*
+    , mtl ==2.2.*
     , non-empty-text ==0.2.*
     , openapi3 ==3.2.*
     , text >=1.2 && <2.1

json-fleece-openapi3/package.yaml

@@ -63,6 +63,7 @@ library:
     - aeson >= 2.0 && < 2.2
     - insert-ordered-containers >= 0.2 && < 0.3
     - containers >= 0.6 && < 0.7
+    - mtl >= 2.2 && < 2.3
     - non-empty-text >= 0.2 && < 0.3
     - openapi3 >= 3.2 && < 3.3
     - text >= 1.2 && < 2.1

json-fleece-openapi3/src/Fleece/OpenApi3.hs

@@ -6,6 +6,7 @@ module Fleece.OpenApi3
   ) where
 
 import Control.Monad (join, (<=<))
+import Control.Monad.Reader (asks)
 import qualified Data.Aeson as Aeson
 import Data.Bifunctor (bimap, first)
 import qualified Data.HashMap.Strict.InsOrd as IOHM
@@ -1257,8 +1258,19 @@ mkAdditionalPropertiesSchema raiseError schemaKey mkInlineItemSchema mbAdditiona
       pure
         . schemaInfoWithoutDependencies
         $ CGU.anyJSONSchemaTypeInfo
-    Just (OA.AdditionalPropertiesAllowed False) ->
-      raiseError "Schemas for objects with additional properties disallowed are not yet supported."
+    Just (OA.AdditionalPropertiesAllowed False) -> do
+      ignoreAdditionalProperties <- asks CGU.ignoreAdditionalProperties
+      if ignoreAdditionalProperties
+        then
+          pure
+            . schemaInfoWithoutDependencies
+            $ CGU.anyJSONSchemaTypeInfo
+        else
+          raiseError $
+            "Schemas for objects with additional properties disallowed are"
+              <> " not yet supported. `additionalProperties: false` can be"
+              <> " ignored by setting the `ignoreAdditionalProperties` field"
+              <> " in the Fleece code gen config to false."
     Just (OA.AdditionalPropertiesSchema (OA.Ref ref)) ->
       pure $
         SchemaTypeInfoWithDeps