Allow omitting type and infer it when validating

src/Data/Swagger.hs

@@ -181,7 +181,7 @@ import Data.Swagger.Internal
 --
 -- >>> :{
 -- encode $ (mempty :: Swagger)
---   & definitions .~ [ ("User", mempty & type_ .~ SwaggerString) ]
+--   & definitions .~ [ ("User", mempty & type_ ?~ SwaggerString) ]
 --   & paths .~
 --     [ ("/user", mempty & get ?~ (mempty
 --         & produces ?~ MimeList ["application/json"]
@@ -204,7 +204,7 @@ import Data.Swagger.Internal
 -- "{\"description\":\"No content\"}"
 -- >>> :{
 -- encode $ (mempty :: Schema)
---   & type_       .~ SwaggerBoolean
+--   & type_       ?~ SwaggerBoolean
 --   & description ?~ "To be or not to be"
 -- :}
 -- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
@@ -213,7 +213,7 @@ import Data.Swagger.Internal
 -- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
 -- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
 --
--- >>> encode $ (mempty :: Header) & type_ .~ SwaggerNumber
+-- >>> encode $ (mempty :: Header) & type_ ?~ SwaggerNumber
 -- "{\"type\":\"number\"}"
 --
 -- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@

src/Data/Swagger/Internal.hs

@@ -593,7 +593,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
     -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
     _paramSchemaDefault :: Maybe Value
 
-  , _paramSchemaType :: SwaggerType t
+  , _paramSchemaType :: Maybe (SwaggerType t)
   , _paramSchemaFormat :: Maybe Format
   , _paramSchemaItems :: Maybe (SwaggerItems t)
   , _paramSchemaMaximum :: Maybe Scientific

src/Data/Swagger/Internal/ParamSchema.hs

@@ -59,20 +59,20 @@ import GHC.TypeLits (TypeError, ErrorMessage(..))
 -- | Default schema for binary data (any sequence of octets).
 binaryParamSchema :: ParamSchema t
 binaryParamSchema = mempty
-  & type_ .~ SwaggerString
+  & type_ ?~ SwaggerString
   & format ?~ "binary"
 
 -- | Default schema for binary data (base64 encoded).
 byteParamSchema :: ParamSchema t
 byteParamSchema = mempty
-  & type_ .~ SwaggerString
+  & type_ ?~ SwaggerString
   & format ?~ "byte"
 
 -- | Default schema for password string.
 -- @"password"@ format is used to hint UIs the input needs to be obscured.
 passwordParamSchema :: ParamSchema t
 passwordParamSchema = mempty
-  & type_ .~ SwaggerString
+  & type_ ?~ SwaggerString
   & format ?~ "password"
 
 -- | Convert a type into a plain @'ParamSchema'@.
@@ -88,7 +88,7 @@ passwordParamSchema = mempty
 --
 -- instance ToParamSchema Direction where
 --   toParamSchema _ = mempty
---      & type_ .~ SwaggerString
+--      & type_ ?~ SwaggerString
 --      & enum_ ?~ [ \"Up\", \"Down\" ]
 -- @
 --
@@ -120,17 +120,17 @@ class ToParamSchema a where
   toParamSchema = genericToParamSchema defaultSchemaOptions
 
 instance OVERLAPPING_ ToParamSchema String where
-  toParamSchema _ = mempty & type_ .~ SwaggerString
+  toParamSchema _ = mempty & type_ ?~ SwaggerString
 
 instance ToParamSchema Bool where
-  toParamSchema _ = mempty & type_ .~ SwaggerBoolean
+  toParamSchema _ = mempty & type_ ?~ SwaggerBoolean
 
 instance ToParamSchema Integer where
-  toParamSchema _ = mempty & type_ .~ SwaggerInteger
+  toParamSchema _ = mempty & type_ ?~ SwaggerInteger
 
 instance ToParamSchema Natural where
   toParamSchema _ = mempty
-    & type_            .~ SwaggerInteger
+    & type_            ?~ SwaggerInteger
     & minimum_         ?~ 0
     & exclusiveMinimum ?~ False
 
@@ -156,37 +156,37 @@ instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
 -- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
 toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema t
 toParamSchemaBoundedIntegral _ = mempty
-  & type_ .~ SwaggerInteger
+  & type_ ?~ SwaggerInteger
   & minimum_ ?~ fromInteger (toInteger (minBound :: a))
   & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
 
 instance ToParamSchema Char where
   toParamSchema _ = mempty
-    & type_ .~ SwaggerString
+    & type_ ?~ SwaggerString
     & maxLength ?~ 1
     & minLength ?~ 1
 
 instance ToParamSchema Scientific where
-  toParamSchema _ = mempty & type_ .~ SwaggerNumber
+  toParamSchema _ = mempty & type_ ?~ SwaggerNumber
 
 instance HasResolution a => ToParamSchema (Fixed a) where
   toParamSchema _ = mempty
-    & type_      .~ SwaggerNumber
+    & type_      ?~ SwaggerNumber
     & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
 
 instance ToParamSchema Double where
   toParamSchema _ = mempty
-    & type_  .~ SwaggerNumber
+    & type_  ?~ SwaggerNumber
     & format ?~ "double"
 
 instance ToParamSchema Float where
   toParamSchema _ = mempty
-    & type_  .~ SwaggerNumber
+    & type_  ?~ SwaggerNumber
     & format ?~ "float"
 
 timeParamSchema :: String -> ParamSchema t
 timeParamSchema fmt = mempty
-  & type_  .~ SwaggerString
+  & type_  ?~ SwaggerString
   & format ?~ T.pack fmt
 
 -- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -222,12 +222,12 @@ instance ToParamSchema TL.Text where
 
 instance ToParamSchema Version where
   toParamSchema _ = mempty
-    & type_ .~ SwaggerString
+    & type_ ?~ SwaggerString
     & pattern ?~ "^\\d+(\\.\\d+)*$"
 
 instance ToParamSchema SetCookie where
   toParamSchema _ = mempty
-    & type_ .~ SwaggerString
+    & type_ ?~ SwaggerString
 
 
 #if __GLASGOW_HASKELL__ < 800
@@ -254,7 +254,7 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t
 
 instance ToParamSchema a => ToParamSchema [a] where
   toParamSchema _ = mempty
-    & type_ .~ SwaggerArray
+    & type_ ?~ SwaggerArray
     & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
 
 instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
@@ -274,12 +274,12 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
 -- "{\"type\":\"string\",\"enum\":[\"_\"]}"
 instance ToParamSchema () where
   toParamSchema _ = mempty
-    & type_ .~ SwaggerString
+    & type_ ?~ SwaggerString
     & enum_ ?~ ["_"]
 
 instance ToParamSchema UUID where
   toParamSchema _ = mempty
-    & type_ .~ SwaggerString
+    & type_ ?~ SwaggerString
     & format ?~ "uuid"
 
 -- | A configurable generic @'ParamSchema'@ creator.
@@ -317,7 +317,7 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g)
 
 instance Constructor c => GEnumParamSchema (C1 c U1) where
   genumParamSchema opts _ s = s
-    & type_ .~ SwaggerString
+    & type_ ?~ SwaggerString
     & enum_ %~ addEnumValue tag
     where
       tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))

src/Data/Swagger/Internal/Schema.hs

@@ -111,7 +111,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
 --   declareNamedSchema _ = do
 --     doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
 --     return $ NamedSchema (Just \"Coord\") $ mempty
---       & type_ .~ SwaggerObject
+--       & type_ ?~ SwaggerObject
 --       & properties .~
 --           [ (\"x\", doubleSchema)
 --           , (\"y\", doubleSchema)
@@ -294,20 +294,20 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
 -- | Default schema for binary data (any sequence of octets).
 binarySchema :: Schema
 binarySchema = mempty
-  & type_ .~ SwaggerString
+  & type_ ?~ SwaggerString
   & format ?~ "binary"
 
 -- | Default schema for binary data (base64 encoded).
 byteSchema :: Schema
 byteSchema = mempty
-  & type_ .~ SwaggerString
+  & type_ ?~ SwaggerString
   & format ?~ "byte"
 
 -- | Default schema for password string.
 -- @"password"@ format is used to hint UIs the input needs to be obscured.
 passwordSchema :: Schema
 passwordSchema = mempty
-  & type_ .~ SwaggerString
+  & type_ ?~ SwaggerString
   & format ?~ "password"
 
 -- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
@@ -333,12 +333,12 @@ sketchSchema = sketch . toJSON
     sketch js@(Bool _) = go js
     sketch js = go js & example ?~ js
 
-    go Null       = mempty & type_ .~ SwaggerNull
-    go (Bool _)   = mempty & type_ .~ SwaggerBoolean
-    go (String _) = mempty & type_   .~ SwaggerString
-    go (Number _) = mempty & type_ .~ SwaggerNumber
+    go Null       = mempty & type_ ?~ SwaggerNull
+    go (Bool _)   = mempty & type_ ?~ SwaggerBoolean
+    go (String _) = mempty & type_   ?~ SwaggerString
+    go (Number _) = mempty & type_ ?~ SwaggerNumber
     go (Array xs) = mempty
-      & type_   .~ SwaggerArray
+      & type_   ?~ SwaggerArray
       & items ?~ case ischema of
           Just s -> SwaggerItemsObject (Inline s)
           _      -> SwaggerItemsArray (map Inline ys)
@@ -350,7 +350,7 @@ sketchSchema = sketch . toJSON
           (z:_) | allSame -> Just z
           _               -> Nothing
     go (Object o) = mempty
-      & type_         .~ SwaggerObject
+      & type_         ?~ SwaggerObject
       & required      .~ HashMap.keys o
       & properties    .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
 
@@ -373,24 +373,24 @@ sketchSchema = sketch . toJSON
 sketchStrictSchema :: ToJSON a => a -> Schema
 sketchStrictSchema = go . toJSON
   where
-    go Null       = mempty & type_ .~ SwaggerNull
+    go Null       = mempty & type_ ?~ SwaggerNull
     go js@(Bool _) = mempty
-      & type_ .~ SwaggerBoolean
+      & type_ ?~ SwaggerBoolean
       & enum_ ?~ [js]
     go js@(String s) = mempty
-      & type_ .~ SwaggerString
+      & type_ ?~ SwaggerString
       & maxLength ?~ fromIntegral (T.length s)
       & minLength ?~ fromIntegral (T.length s)
       & pattern   ?~ s
       & enum_     ?~ [js]
     go js@(Number n) = mempty
-      & type_       .~ SwaggerNumber
+      & type_       ?~ SwaggerNumber
       & maximum_    ?~ n
       & minimum_    ?~ n
       & multipleOf  ?~ n
       & enum_       ?~ [js]
     go js@(Array xs) = mempty
-      & type_       .~ SwaggerArray
+      & type_       ?~ SwaggerArray
       & maxItems    ?~ fromIntegral sz
       & minItems    ?~ fromIntegral sz
       & items       ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
@@ -400,7 +400,7 @@ sketchStrictSchema = go . toJSON
         sz = length xs
         allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
     go js@(Object o) = mempty
-      & type_         .~ SwaggerObject
+      & type_         ?~ SwaggerObject
       & required      .~ names
       & properties    .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
       & maxProperties ?~ fromIntegral (length names)
@@ -416,7 +416,7 @@ instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
   declareNamedSchema _ = do
     ref <- declareSchemaRef (Proxy :: Proxy a)
     return $ unnamed $ mempty
-      & type_ .~ SwaggerArray
+      & type_ ?~ SwaggerArray
       & items ?~ SwaggerItemsObject ref
 
 instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
@@ -466,7 +466,7 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f
 
 timeSchema :: T.Text -> Schema
 timeSchema fmt = mempty
-  & type_ .~ SwaggerString
+  & type_ ?~ SwaggerString
   & format ?~ fmt
 
 -- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -528,7 +528,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
       declareObjectMapSchema = do
         schema <- declareSchemaRef (Proxy :: Proxy v)
         return $ unnamed $ mempty
-          & type_ .~ SwaggerObject
+          & type_ ?~ SwaggerObject
           & additionalProperties ?~ AdditionalPropertiesSchema schema
 
 instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
@@ -540,7 +540,7 @@ instance ToSchema a => ToSchema (Map String a) where
   declareNamedSchema _ = do
     schema <- declareSchemaRef (Proxy :: Proxy a)
     return $ unnamed $ mempty
-      & type_ .~ SwaggerObject
+      & type_ ?~ SwaggerObject
       & additionalProperties ?~ schema
 
 instance ToSchema a => ToSchema (Map T.Text  a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
@@ -554,7 +554,7 @@ instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ =
 
 instance OVERLAPPING_ ToSchema Object where
   declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
-    & type_ .~ SwaggerObject
+    & type_ ?~ SwaggerObject
     & description ?~ "Arbitrary JSON object."
     & additionalProperties ?~ AdditionalPropertiesAllowed True
 
@@ -595,7 +595,7 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
 -- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
 toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
 toSchemaBoundedIntegral _ = mempty
-  & type_ .~ SwaggerInteger
+  & type_ ?~ SwaggerInteger
   & minimum_ ?~ fromInteger (toInteger (minBound :: a))
   & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
 
@@ -641,7 +641,7 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
       let allKeys   = [minBound..maxBound :: key]
           mkPair k  =  (keyToText k, valueRef)
       return $ mempty
-        & type_ .~ SwaggerObject
+        & type_ ?~ SwaggerObject
         & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
 
 -- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -715,7 +715,7 @@ paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
 
 nullarySchema :: Schema
 nullarySchema = mempty
-  & type_ .~ SwaggerArray
+  & type_ ?~ SwaggerArray
   & items ?~ SwaggerItemsArray []
 
 gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
@@ -786,12 +786,12 @@ withFieldSchema opts _ isRequiredField schema = do
   return $
     if T.null fname
       then schema
-        & type_ .~ SwaggerArray
+        & type_ ?~ SwaggerArray
         & items %~ appendItem ref
         & maxItems %~ Just . maybe 1 (+1)   -- increment maxItems
         & minItems %~ Just . maybe 1 (+1)   -- increment minItems
       else schema
-        & type_ .~ SwaggerObject
+        & type_ ?~ SwaggerObject
         & properties . at fname ?~ ref
         & if isRequiredField
             then required %~ (++ [fname])
@@ -828,7 +828,7 @@ gdeclareNamedSumSchema opts proxy s
     (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
 
     toStringTag schema = mempty
-      & type_ .~ SwaggerString
+      & type_ ?~ SwaggerString
       & enum_ ?~ map toJSON  (schema ^.. properties.ifolded.asIndex)
 
 type AllNullary = All
@@ -842,7 +842,7 @@ instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
 gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
   Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
 gsumConToSchemaWith ref opts _ schema = schema
-  & type_ .~ SwaggerObject
+  & type_ ?~ SwaggerObject
   & properties . at tag ?~ ref
   & maxProperties ?~ 1
   & minProperties ?~ 1