Use nullable for Maybe schemas

CHANGELOG.md

@@ -1,6 +1,8 @@
 Unreleased
 ----------
 
+- (breaking) Use `nullable` for `Maybe` schemas [#113](https://github.com/biocad/openapi3/pull/113)
+
 3.2.4
 -----
 - Give `title` to sub schemas of sum types [#88](https://github.com/biocad/openapi3/pull/88).

openapi3.cabal

@@ -1,6 +1,6 @@
 cabal-version:       >=1.10
 name:                openapi3
-version:             3.2.4
+version:             3.3.0
 
 synopsis:            OpenAPI 3.0 data model
 category:            Web, Swagger, OpenApi

src/Data/OpenApi/Internal/Schema.hs

@@ -623,7 +623,22 @@ instance ToSchema Float       where declareNamedSchema = plain . paramSchemaToSc
 instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
 
 instance ToSchema a => ToSchema (Maybe a) where
-  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
+  declareNamedSchema _ = do
+    namedSchema <- declareNamedSchema (Proxy :: Proxy a)
+    pure
+      namedSchema
+      { _namedSchemaName = fmap ("Maybe_" <>) (_namedSchemaName namedSchema)
+      , _namedSchemaSchema =
+          _namedSchemaSchema namedSchema
+            & nullable ?~ True
+      }
+
+type NestedMaybeError =
+  Text "Nested " :<>: ShowType Maybe :<>: Text "s are not supported." :$$:
+  Text "OpenAPI 3 only supports a single level of nullability, so it can't distinguish between Nothing and Just Nothing."
+
+instance {-# OVERLAPPING #-} (TypeError NestedMaybeError, Typeable a) => ToSchema (Maybe (Maybe a)) where
+  declareNamedSchema _ = undefined
 
 instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where
   -- To match Aeson instance
@@ -1010,7 +1025,7 @@ withFieldSchema opts _ isRequiredField schema = do
 
 -- | Optional record fields.
 instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
-  gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
+  gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i c)) False
 
 -- | Record fields.
 instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where

test/Data/OpenApi/SchemaSpec.hs

@@ -102,7 +102,7 @@ spec = do
     context "Character" $ checkDefs (Proxy :: Proxy Character) ["Player", "Point"]
     context "MyRoseTree" $ checkDefs (Proxy :: Proxy MyRoseTree) ["RoseTree"]
     context "MyRoseTree'" $ checkDefs (Proxy :: Proxy MyRoseTree') ["myrosetree'"]
-    context "[Set (Unit, Maybe Color)]" $ checkDefs (Proxy :: Proxy [Set (Unit, Maybe Color)]) ["Unit", "Color"]
+    context "[Set (Unit, Maybe Color)]" $ checkDefs (Proxy :: Proxy [Set (Unit, Maybe Color)]) ["Unit", "Maybe_Color"]
     context "ResourceId" $ checkDefs (Proxy :: Proxy ResourceId) []
   describe "Inlining Schemas" $ do
     context "Paint" $ checkInlinedSchema (Proxy :: Proxy Paint) paintInlinedSchemaJSON

test/Data/OpenApiSpec.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE DeriveGeneric #-}
 module Data.OpenApiSpec where
 
 import Prelude ()
@@ -13,11 +14,13 @@ import Data.Aeson
 import Data.Aeson.QQ.Simple
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashSet.InsOrd as InsOrdHS
+import Data.Proxy (Proxy(..))
 import Data.Text (Text)
 
 import Data.OpenApi
 import SpecCommon
 import Test.Hspec hiding (example)
+import GHC.Generics (Generic)
 
 spec :: Spec
 spec = do
@@ -53,6 +56,8 @@ spec = do
       it "merged correctly" $ do
         let merged = oAuth2SecurityDefinitionsReadOpenApi <> oAuth2SecurityDefinitionsWriteOpenApi <> oAuth2SecurityDefinitionsEmptyOpenApi
         merged `shouldBe` oAuth2SecurityDefinitionsOpenApi
+  it "Type Parameters Example" $ do
+    toJSON typeParametersExample `shouldBe` typeParametersExampleJSON
 
 main :: IO ()
 main = hspec spec
@@ -1003,3 +1008,33 @@ compositionSchemaExampleJSON = [aesonQQ|
   ]
 }
 |]
+
+data TypeParameters a
+  = TypeParameters
+  { typeParametersField1 :: Maybe Double
+  , typeParametersField2 :: a
+  } deriving (Generic)
+
+instance ToSchema a => ToSchema (TypeParameters a)
+
+typeParametersExample :: Schema
+typeParametersExample = toSchema (Proxy :: Proxy (TypeParameters (Maybe Double)))
+
+typeParametersExampleJSON :: Value
+typeParametersExampleJSON = [aesonQQ|
+{
+  "properties": {
+    "typeParametersField1": {
+      "format": "double",
+      "type": "number"
+    },
+    "typeParametersField2": {
+      "format": "double",
+      "type": "number",
+      "nullable": true
+    }
+  },
+  "required": ["typeParametersField2"],
+  "type": "object"
+}
+|]