git.iko.soy/typeable/openapi3
on master help sign in
Add style for parameters, remove kinds

OpenAPI 3.0 unified schemas for parameters, now Parameter object directly references Schema object, and ParamSchema becomes not needed. Moreover, encoding of arrays and objects in parameters is now more uniform, using `style` property on the parameter itself.

commitee9223ec692f1ba6d2b7c7f420ccb7e54d144480 authorMaxim Koltsov <kolmax94@gmail.com> dateThu 9 Jul 2020, 14:27 (6 years ago) parent55662c8
8 files changed+177−465
compare with master
unifiedsplit
src/Data/Swagger.hs+1−11 src/Data/Swagger/Internal.hs+101−253 src/Data/Swagger/Internal/ParamSchema.hs+12−12 src/Data/Swagger/Internal/Schema.hs+1−1 src/Data/Swagger/Internal/Schema/Validation.hs+27−28 src/Data/Swagger/Lens.hs+20−25 src/Data/Swagger/Optics.hs+14−133 test/Data/Swagger/ParamSchemaSpec.hs+1−2
src/Data/Swagger.hs+1−11
@@ -59,7 +59,7 @@ module Data.Swagger (
5959 SwaggerType(..),
6060 Format,
6161 Definitions,
62− CollectionFormat(..),
62+ Style(..),
6363
6464 -- ** Parameters
6565 Param(..),
@@ -220,16 +220,6 @@ import Data.Swagger.Internal
220220-- :}
221221-- {"description":"To be or not to be","type":"boolean"}
222222--
223−-- @'ParamSchema'@ is basically the /base schema specification/ and many types contain it (see @'HasParamSchema'@).
224−-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
225−-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
226−--
227−-- >>> BSL.putStrLn $ encode $ (mempty :: Header) & type_ ?~ SwaggerNumber
228−-- {"schema":{"type":"number"}}
229−--
230−-- TODO this is no up-to-date ^, since in openapi 3 there is no ParamSchema madness, all objects
231−-- have Schemas as fields.
232−--
233223-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
234224-- have direct access to it via @'at' code@. Example:
235225--
src/Data/Swagger/Internal.hs+101−253
@@ -338,6 +338,29 @@ data MediaTypeObject = MediaTypeObject
338338 , _mediaTypeObjectEncoding :: InsOrdHashMap Text Encoding
339339 } deriving (Eq, Show, Generic, Data, Typeable)
340340
341+-- | In order to support common ways of serializing simple parameters, a set of style values are defined.
342+data Style
343+ = StyleMatrix
344+ -- ^ Path-style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
345+ | StyleLabel
346+ -- ^ Label style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
347+ | StyleForm
348+ -- ^ Form style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
349+ -- This option replaces @collectionFormat@ with a @csv@ (when @explode@ is false) or @multi@
350+ -- (when explode is true) value from OpenAPI 2.0.
351+ | StyleSimple
352+ -- ^ Simple style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
353+ -- This option replaces @collectionFormat@ with a @csv@ value from OpenAPI 2.0.
354+ | StyleSpaceDelimited
355+ -- ^ Space separated array values.
356+ -- This option replaces @collectionFormat@ equal to @ssv@ from OpenAPI 2.0.
357+ | StylePipeDelimited
358+ -- ^ Pipe separated array values.
359+ -- This option replaces @collectionFormat@ equal to @pipes@ from OpenAPI 2.0.
360+ | StyleDeepObject
361+ -- ^ Provides a simple way of rendering nested objects using form parameters.
362+ deriving (Eq, Show, Generic, Data, Typeable)
363+
341364data Encoding = Encoding
342365 { -- | The Content-Type for encoding a specific property.
343366 -- Default value depends on the property type: for @string@
@@ -355,11 +378,11 @@ data Encoding = Encoding
355378 , _encodingHeaders :: InsOrdHashMap Text (Referenced Header)
356379
357380 -- | Describes how a specific property value will be serialized depending on its type.
358− -- See Parameter Object for details on the style property.
381+ -- See 'Param' Object for details on the style property.
359382 -- The behavior follows the same values as query parameters, including default values.
360383 -- This property SHALL be ignored if the request body media type
361384 -- is not @application/x-www-form-urlencoded@.
362− , _encodingStyle :: Maybe Text -- TODO enum
385+ , _encodingStyle :: Maybe Style
363386
364387 -- | When this is true, property values of type @array@ or @object@ generate
365388 -- separate parameters for each value of the array,
@@ -424,10 +447,38 @@ data Param = Param
424447 -- | Sets the ability to pass empty-valued parameters.
425448 -- This is valid only for 'ParamQuery' parameters and allows sending
426449 -- a parameter with an empty value. Default value is @false@.
427− , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
450+ , _paramAllowEmptyValue :: Maybe Bool
428451
429452 -- | Parameter schema.
430453 , _paramSchema :: Maybe (Referenced Schema)
454+
455+ -- | Describes how the parameter value will be serialized depending
456+ -- on the type of the parameter value. Default values (based on value of '_paramIn'):
457+ -- for 'ParamQuery' - 'StyleForm'; for 'ParamPath' - 'StyleSimple'; for 'ParamHeader' - 'StyleSimple';
458+ -- for 'ParamCookie' - 'StyleForm'.
459+ , _paramStyle :: Maybe Style
460+
461+ -- | When this is true, parameter values of type @array@ or @object@
462+ -- generate separate parameters for each value of the array or key-value pair of the map.
463+ -- For other types of parameters this property has no effect.
464+ -- When style is @form@, the default value is true. For all other styles, the default value is false.
465+ , _paramExplode :: Maybe Bool
466+
467+ -- | Example of the parameter's potential value.
468+ -- The example SHOULD match the specified schema and encoding properties if present.
469+ -- The '_paramExample' field is mutually exclusive of the '_paramExamples' field.
470+ -- Furthermore, if referencing a schema that contains an example, the example value
471+ -- SHALL override the example provided by the schema. To represent examples of media types
472+ -- that cannot naturally be represented in JSON or YAML, a string value can contain
473+ -- the example with escaping where necessary.
474+ , _paramExample :: Maybe Value
475+
476+ -- | Examples of the parameter's potential value.
477+ -- Each example SHOULD contain a value in the correct format as specified
478+ -- in the parameter encoding. The '_paramExamples' field is mutually exclusive of the '_paramExample' field.
479+ -- Furthermore, if referencing a schema that contains an example,
480+ -- the examples value SHALL override the example provided by the schema.
481+ , _paramExamples :: InsOrdHashMap Text (Referenced Example)
431482 } deriving (Eq, Show, Generic, Data, Typeable)
432483
433484data Example = Example
@@ -454,136 +505,26 @@ data Example = Example
454505
455506-- | Items for @'SwaggerArray'@ schemas.
456507--
457−-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
458−-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
459−-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
460−-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
508+-- __Warning__: OpenAPI 3.0 does not support tuple arrays. However, OpenAPI 3.1 will, as
509+-- it will incorporate Json Schema mostly verbatim.
461510--
462511-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
463512--
464513-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
465−data SwaggerItems t where
466− SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
467− SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
468− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
469− deriving (Typeable)
470−
471−deriving instance Eq (SwaggerItems t)
472−deriving instance Show (SwaggerItems t)
473−--deriving instance Typeable (SwaggerItems t)
474−
475−swaggerItemsPrimitiveConstr :: Constr
476−swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
477−
478−swaggerItemsObjectConstr :: Constr
479−swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
480−
481−swaggerItemsArrayConstr :: Constr
482−swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
483−
484−swaggerItemsDataType :: DataType
485−swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
486−
487−-- Note: unfortunately we have to write these Data instances by hand,
488−-- to get better contexts / avoid duplicate name when using standalone deriving
489−
490−instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
491− -- TODO: define gfoldl
492− gunfold k z c = case constrIndex c of
493− 1 -> k (k (z SwaggerItemsPrimitive))
494− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
495− toConstr _ = swaggerItemsPrimitiveConstr
496− dataTypeOf _ = swaggerItemsDataType
497−
498−-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
499−instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
500− -- TODO: define gfoldl
501− gunfold k z c = case constrIndex c of
502− 1 -> k (k (z SwaggerItemsPrimitive))
503− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
504− toConstr _ = swaggerItemsPrimitiveConstr
505− dataTypeOf _ = swaggerItemsDataType
506−
507−instance Data (SwaggerItems 'SwaggerKindSchema) where
508− gfoldl _ _ (SwaggerItemsPrimitive _ _) = error " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
509− gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
510− gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
511−
512− gunfold k z c = case constrIndex c of
513− 2 -> k (z SwaggerItemsObject)
514− 3 -> k (z SwaggerItemsArray)
515− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
516−
517− toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
518− toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
519− toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
520−
521− dataTypeOf _ = swaggerItemsDataType
522−
523−-- | Type used as a kind to avoid overlapping instances.
524−data SwaggerKind t
525− = SwaggerKindNormal t
526− | SwaggerKindParamOtherSchema
527− | SwaggerKindSchema
528− deriving (Typeable)
529−
530−deriving instance Typeable 'SwaggerKindNormal
531−deriving instance Typeable 'SwaggerKindParamOtherSchema
532−deriving instance Typeable 'SwaggerKindSchema
533−
534−-- TODO remove
535−type family SwaggerKindType (k :: SwaggerKind *) :: *
536−type instance SwaggerKindType ('SwaggerKindNormal t) = t
537−type instance SwaggerKindType 'SwaggerKindSchema = Schema
538−--type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
539−
540−data SwaggerType t where
541− SwaggerString :: SwaggerType t
542− SwaggerNumber :: SwaggerType t
543− SwaggerInteger :: SwaggerType t
544− SwaggerBoolean :: SwaggerType t
545− SwaggerArray :: SwaggerType t
546− SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
547− SwaggerNull :: SwaggerType 'SwaggerKindSchema
548− SwaggerObject :: SwaggerType 'SwaggerKindSchema
549− deriving (Typeable)
550−
551−deriving instance Eq (SwaggerType t)
552−deriving instance Show (SwaggerType t)
553−
554−swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
555−swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
556−
557−swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
558−swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
559−
560−swaggerCommonTypes :: [SwaggerType k]
561−swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
562−
563−swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
564−swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
565−
566−swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
567−swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
568−
569−swaggerTypeConstrs :: [Constr]
570−swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
571− ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
572−
573−instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
574− gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
575− toConstr = swaggerTypeConstr
576− dataTypeOf = swaggerTypeDataType
577−
578−instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
579− gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
580− toConstr = swaggerTypeConstr
581− dataTypeOf = swaggerTypeDataType
582−
583−instance Data (SwaggerType 'SwaggerKindSchema) where
584− gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
585− toConstr = swaggerTypeConstr
586− dataTypeOf = swaggerTypeDataType
514+data SwaggerItems where
515+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems
516+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems
517+ deriving (Eq, Show, Typeable, Data)
518+
519+data SwaggerType where
520+ SwaggerString :: SwaggerType
521+ SwaggerNumber :: SwaggerType
522+ SwaggerInteger :: SwaggerType
523+ SwaggerBoolean :: SwaggerType
524+ SwaggerArray :: SwaggerType
525+ SwaggerNull :: SwaggerType
526+ SwaggerObject :: SwaggerType
527+ deriving (Eq, Show, Typeable, Generic, Data)
587528
588529data ParamLocation
589530 = -- | Parameters that are appended to the URL.
@@ -601,42 +542,6 @@ data ParamLocation
601542
602543type Format = Text
603544
604−-- | Determines the format of the array.
605−data CollectionFormat t where
606− -- Comma separated values: @foo,bar@.
607− CollectionCSV :: CollectionFormat t
608− -- Space separated values: @foo bar@.
609− CollectionSSV :: CollectionFormat t
610− -- Tab separated values: @foo\\tbar@.
611− CollectionTSV :: CollectionFormat t
612− -- Pipe separated values: @foo|bar@.
613− CollectionPipes :: CollectionFormat t
614− -- Corresponds to multiple parameter instances
615− -- instead of multiple values for a single instance @foo=bar&foo=baz@.
616− -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
617− CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
618− deriving (Typeable)
619−
620−deriving instance Eq (CollectionFormat t)
621−deriving instance Show (CollectionFormat t)
622−
623−collectionFormatConstr :: CollectionFormat t -> Constr
624−collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
625−
626−collectionFormatDataType :: DataType
627−collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
628− map collectionFormatConstr collectionCommonFormats
629−
630−collectionCommonFormats :: [CollectionFormat t]
631−collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
632−
633−instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
634− gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
635− toConstr = collectionFormatConstr
636− dataTypeOf _ = collectionFormatDataType
637−
638−deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
639−
640545type ParamName = Text
641546
642547data Schema = Schema
@@ -663,7 +568,7 @@ data Schema = Schema
663568 , _schemaMaxProperties :: Maybe Integer
664569 , _schemaMinProperties :: Maybe Integer
665570
666− , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
571+ , _schemaParamSchema :: ParamSchema
667572 } deriving (Eq, Show, Generic, Data, Typeable)
668573
669574data Discriminator = Discriminator
@@ -684,7 +589,7 @@ data NamedSchema = NamedSchema
684589-- | Regex pattern for @string@ type.
685590type Pattern = Text
686591
687−data ParamSchema (t :: SwaggerKind *) = ParamSchema
592+data ParamSchema = ParamSchema
688593 { -- | Declares the value of the parameter that the server will use if none is provided,
689594 -- for example a @"count"@ to control the number of results per page might default to @100@
690595 -- if not supplied by the client in the request.
@@ -692,9 +597,9 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
692597 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
693598 _paramSchemaDefault :: Maybe Value
694599
695− , _paramSchemaType :: Maybe (SwaggerType t)
600+ , _paramSchemaType :: Maybe SwaggerType
696601 , _paramSchemaFormat :: Maybe Format
697− , _paramSchemaItems :: Maybe (SwaggerItems t)
602+ , _paramSchemaItems :: Maybe SwaggerItems
698603 , _paramSchemaMaximum :: Maybe Scientific
699604 , _paramSchemaExclusiveMaximum :: Maybe Bool
700605 , _paramSchemaMinimum :: Maybe Scientific
@@ -707,9 +612,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
707612 , _paramSchemaUniqueItems :: Maybe Bool
708613 , _paramSchemaEnum :: Maybe [Value]
709614 , _paramSchemaMultipleOf :: Maybe Scientific
710− } deriving (Eq, Show, Generic, Typeable)
711−
712−deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
615+ } deriving (Eq, Show, Generic, Typeable, Data)
713616
714617data Xml = Xml
715618 { -- | Replaces the name of the element/attribute used for the described schema property.
@@ -779,11 +682,13 @@ instance IsString Response where
779682
780683type HeaderName = Text
781684
685+
686+-- TODO this is mostly a copy of 'Param'.
782687data Header = Header
783688 { -- | A short description of the header.
784689 _headerDescription :: Maybe Text
785690
786− , _headerSchema :: ParamSchema ('SwaggerKindNormal Header)
691+ , _headerSchema :: Maybe (Referenced Schema)
787692 } deriving (Eq, Show, Generic, Data, Typeable)
788693
789694-- | The location of the API key.
@@ -993,9 +898,9 @@ instance Monoid Schema where
993898 mempty = genericMempty
994899 mappend = (<>)
995900
996−instance Semigroup (ParamSchema t) where
901+instance Semigroup ParamSchema where
997902 (<>) = genericMappend
998−instance Monoid (ParamSchema t) where
903+instance Monoid ParamSchema where
999904 mempty = genericMempty
1000905 mappend = (<>)
1001906
@@ -1093,7 +998,7 @@ instance SwaggerMonoid Info
1093998instance SwaggerMonoid Components
1094999instance SwaggerMonoid PathItem
10951000instance SwaggerMonoid Schema
1096−instance SwaggerMonoid (ParamSchema t)
1001+instance SwaggerMonoid ParamSchema
10971002instance SwaggerMonoid Param
10981003instance SwaggerMonoid Responses
10991004instance SwaggerMonoid Response
@@ -1104,7 +1009,7 @@ instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
11041009instance SwaggerMonoid MimeList
11051010deriving instance SwaggerMonoid URL
11061011
1107−instance SwaggerMonoid (SwaggerType t) where
1012+instance SwaggerMonoid SwaggerType where
11081013 swaggerMempty = SwaggerString
11091014 swaggerMappend _ y = y
11101015
@@ -1125,6 +1030,12 @@ instance Monoid a => SwaggerMonoid (Referenced a) where
11251030-- Simple Generic-based ToJSON instances
11261031-- =======================================================================
11271032
1033+instance ToJSON Style where
1034+ toJSON = genericToJSON (jsonPrefix "Style")
1035+
1036+instance ToJSON SwaggerType where
1037+ toJSON = genericToJSON (jsonPrefix "Swagger")
1038+
11281039instance ToJSON ParamLocation where
11291040 toJSON = genericToJSON (jsonPrefix "Param")
11301041
@@ -1174,6 +1085,12 @@ instance ToJSON OAuth2AuthorizationCodeFlow where
11741085-- Simple Generic-based FromJSON instances
11751086-- =======================================================================
11761087
1088+instance FromJSON Style where
1089+ parseJSON = genericParseJSON (jsonPrefix "Style")
1090+
1091+instance FromJSON SwaggerType where
1092+ parseJSON = genericParseJSON (jsonPrefix "Swagger")
1093+
11771094instance FromJSON ParamLocation where
11781095 parseJSON = genericParseJSON (jsonPrefix "Param")
11791096
@@ -1272,10 +1189,7 @@ instance ToJSON Header where
12721189-- >>> encode (SwaggerItemsArray [])
12731190-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
12741191--
1275−instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1276− toJSON (SwaggerItemsPrimitive fmt schema) = object
1277− [ "collectionFormat" .= fmt
1278− , "items" .= schema ]
1192+instance ToJSON SwaggerItems where
12791193 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
12801194 toJSON (SwaggerItemsArray []) = object
12811195 [ "items" .= object []
@@ -1344,24 +1258,7 @@ instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/comp
13441258instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"
13451259instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
13461260
1347−instance ToJSON (SwaggerType t) where
1348− toJSON SwaggerArray = "array"
1349− toJSON SwaggerString = "string"
1350− toJSON SwaggerInteger = "integer"
1351− toJSON SwaggerNumber = "number"
1352− toJSON SwaggerBoolean = "boolean"
1353− toJSON SwaggerFile = "file"
1354− toJSON SwaggerNull = "null"
1355− toJSON SwaggerObject = "object"
1356−
1357−instance ToJSON (CollectionFormat t) where
1358− toJSON CollectionCSV = "csv"
1359− toJSON CollectionSSV = "ssv"
1360− toJSON CollectionTSV = "tsv"
1361− toJSON CollectionPipes = "pipes"
1362− toJSON CollectionMulti = "multi"
1363−
1364−instance ToJSON (ParamSchema k) where
1261+instance ToJSON ParamSchema where
13651262 -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
13661263 toJSON = sopSwaggerGenericToJSONWithOpts $
13671264 mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
@@ -1412,28 +1309,7 @@ instance FromJSON Schema where
14121309instance FromJSON Header where
14131310 parseJSON = sopSwaggerGenericParseJSON
14141311
1415−instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1416− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1417− <$> o .:? "collectionFormat"
1418− <*> (o .: "items" >>= parseJSON)
1419−
1420−instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1421− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1422− <$> o .:? "collectionFormat"
1423− <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1424−
1425−-- |
1426−--
1427−-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1428−-- Just (SwaggerItemsArray [])
1429−--
1430−-- >>> eitherDecode "{\"$ref\":\"#/components/schemas/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1431−-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1432−--
1433−-- >>> eitherDecode "[{\"$ref\":\"#/components/schemas/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1434−-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1435−--
1436−instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1312+instance FromJSON SwaggerItems where
14371313 parseJSON js@(Object obj)
14381314 | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
14391315 | otherwise = SwaggerItemsObject <$> parseJSON js
@@ -1506,30 +1382,7 @@ instance FromJSON (Referenced Header) where parseJSON = referencedParseJSON "#
15061382instance FromJSON Xml where
15071383 parseJSON = genericParseJSON (jsonPrefix "xml")
15081384
1509−instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1510− parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1511−
1512−instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1513− parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1514−
1515−instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1516− parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1517−
1518−instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1519− parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1520−
1521−-- NOTE: There aren't collections of 'Schema'
1522−--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1523−-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1524−
1525−instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1526− parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1527−
1528−instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1529− parseJSON = sopSwaggerGenericParseJSON
1530−instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1531− parseJSON = sopSwaggerGenericParseJSON
1532−instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1385+instance FromJSON ParamSchema where
15331386 parseJSON = sopSwaggerGenericParseJSON
15341387
15351388instance FromJSON AdditionalProperties where
@@ -1571,17 +1424,12 @@ instance HasSwaggerAesonOptions Example where
15711424instance HasSwaggerAesonOptions Encoding where
15721425 swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"
15731426
1574−instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1575− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1576−instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1577− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1578−-- NOTE: Schema doesn't have 'items' sub object!
1579−instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1427+instance HasSwaggerAesonOptions ParamSchema where
15801428 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
15811429
15821430instance AesonDefaultValue Server
15831431instance AesonDefaultValue Components
1584−instance AesonDefaultValue (ParamSchema s)
1432+instance AesonDefaultValue ParamSchema
15851433instance AesonDefaultValue OAuth2ImplicitFlow
15861434instance AesonDefaultValue OAuth2PasswordFlow
15871435instance AesonDefaultValue OAuth2ClientCredentialsFlow
@@ -1589,7 +1437,7 @@ instance AesonDefaultValue OAuth2AuthorizationCodeFlow
15891437instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)
15901438instance AesonDefaultValue Responses
15911439instance AesonDefaultValue SecuritySchemeType
1592−instance AesonDefaultValue (SwaggerType a)
1440+instance AesonDefaultValue SwaggerType
15931441instance AesonDefaultValue MimeList where defaultValue = Just mempty
15941442instance AesonDefaultValue Info
15951443instance AesonDefaultValue ParamLocation
src/Data/Swagger/Internal/ParamSchema.hs+12−12
@@ -50,20 +50,20 @@ import qualified Data.ByteString.Lazy as BSL
5050import GHC.TypeLits (TypeError, ErrorMessage(..))
5151
5252-- | Default schema for binary data (any sequence of octets).
53−binaryParamSchema :: ParamSchema t
53+binaryParamSchema :: ParamSchema
5454binaryParamSchema = mempty
5555 & type_ ?~ SwaggerString
5656 & format ?~ "binary"
5757
5858-- | Default schema for binary data (base64 encoded).
59−byteParamSchema :: ParamSchema t
59+byteParamSchema :: ParamSchema
6060byteParamSchema = mempty
6161 & type_ ?~ SwaggerString
6262 & format ?~ "byte"
6363
6464-- | Default schema for password string.
6565-- @"password"@ format is used to hint UIs the input needs to be obscured.
66−passwordParamSchema :: ParamSchema t
66+passwordParamSchema :: ParamSchema
6767passwordParamSchema = mempty
6868 & type_ ?~ SwaggerString
6969 & format ?~ "password"
@@ -108,8 +108,8 @@ class ToParamSchema a where
108108 --
109109 -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)
110110 -- "{\"type\":\"integer\"}"
111− toParamSchema :: Proxy a -> ParamSchema t
112− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema t
111+ toParamSchema :: Proxy a -> ParamSchema
112+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema
113113 toParamSchema = genericToParamSchema defaultSchemaOptions
114114
115115instance {-# OVERLAPPING #-} ToParamSchema String where
@@ -151,7 +151,7 @@ instance ToParamSchema Word64 where
151151--
152152-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
153153-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
154−toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema t
154+toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema
155155toParamSchemaBoundedIntegral _ = mempty
156156 & type_ ?~ SwaggerInteger
157157 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
@@ -181,7 +181,7 @@ instance ToParamSchema Float where
181181 & type_ ?~ SwaggerNumber
182182 & format ?~ "float"
183183
184−timeParamSchema :: String -> ParamSchema t
184+timeParamSchema :: String -> ParamSchema
185185timeParamSchema fmt = mempty
186186 & type_ ?~ SwaggerString
187187 & format ?~ T.pack fmt
@@ -236,7 +236,7 @@ type family ToParamSchemaByteStringError bs where
236236 ToParamSchemaByteStringError bs = TypeError
237237 ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."
238238 :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
239− :$$: 'Text "Consider using byteParamSchema or binaryParamSchema templates." )
239+ :$$: 'Text "Consider using byteParamSchema or binaryParamSchemaemplates." )
240240
241241instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"
242242instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible"
@@ -254,7 +254,7 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t
254254instance ToParamSchema a => ToParamSchema [a] where
255255 toParamSchema _ = mempty
256256 & type_ ?~ SwaggerArray
257− & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
257+ & items ?~ SwaggerItemsObject (Inline $ mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a))
258258
259259instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
260260instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
@@ -287,11 +287,11 @@ instance ToParamSchema UUID where
287287-- >>> data Color = Red | Blue deriving Generic
288288-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
289289-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"
290−genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema t
290+genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema
291291genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
292292
293293class GToParamSchema (f :: * -> *) where
294− gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
294+ gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema -> ParamSchema
295295
296296instance GToParamSchema f => GToParamSchema (D1 d f) where
297297 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
@@ -309,7 +309,7 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh
309309 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
310310
311311class GEnumParamSchema (f :: * -> *) where
312− genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
312+ genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema -> ParamSchema
313313
314314instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
315315 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
src/Data/Swagger/Internal/Schema.hs+1−1
@@ -737,7 +737,7 @@ gdeclareSchemaRef opts proxy = do
737737 return $ Ref (Reference name)
738738 _ -> Inline <$> gdeclareSchema opts proxy
739739
740−appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema)
740+appendItem :: Referenced Schema -> Maybe SwaggerItems -> Maybe SwaggerItems
741741appendItem x Nothing = Just (SwaggerItemsArray [x])
742742appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
743743appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
src/Data/Swagger/Internal/Schema/Validation.hs+27−28
@@ -298,23 +298,23 @@ validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js)
298298
299299-- | Validate JSON @'Value'@ with Swagger @'Schema'@.
300300validateWithSchema :: Value -> Validation Schema ()
301−validateWithSchema value = do
302− validateSchemaType value
303− sub_ paramSchema $ validateEnum value
301+validateWithSchema val = do
302+ validateSchemaType val
303+ sub_ paramSchema $ validateEnum val
304304
305305-- | Validate JSON @'Value'@ with Swagger @'ParamSchema'@.
306−validateWithParamSchema :: Value -> Validation (ParamSchema t) ()
307−validateWithParamSchema value = do
308− validateParamSchemaType value
309− validateEnum value
306+validateWithParamSchema :: Value -> Validation ParamSchema ()
307+validateWithParamSchema val = do
308+ validateParamSchemaType val
309+ validateEnum val
310310
311−validateInteger :: Scientific -> Validation (ParamSchema t) ()
311+validateInteger :: Scientific -> Validation ParamSchema ()
312312validateInteger n = do
313313 when (not (isInteger n)) $
314314 invalid ("not an integer")
315315 validateNumber n
316316
317−validateNumber :: Scientific -> Validation (ParamSchema t) ()
317+validateNumber :: Scientific -> Validation ParamSchema ()
318318validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
319319 let exMax = Just True == sch ^. exclusiveMaximum
320320 exMin = Just True == sch ^. exclusiveMinimum
@@ -331,7 +331,7 @@ validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
331331 when (not (isInteger (n / k))) $
332332 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
333333
334−validateString :: Text -> Validation (ParamSchema t) ()
334+validateString :: Text -> Validation ParamSchema ()
335335validateString s = do
336336 check maxLength $ \n ->
337337 when (len > fromInteger n) $
@@ -348,7 +348,7 @@ validateString s = do
348348 where
349349 len = Text.length s
350350
351−validateArray :: Vector Value -> Validation (ParamSchema t) ()
351+validateArray :: Vector Value -> Validation ParamSchema ()
352352validateArray xs = do
353353 check maxItems $ \n ->
354354 when (len > fromInteger n) $
@@ -359,7 +359,6 @@ validateArray xs = do
359359 invalid ("array is too short (size should be >=" ++ show n ++ ")")
360360
361361 check items $ \case
362− SwaggerItemsPrimitive _ itemSchema -> sub itemSchema $ traverse_ validateWithParamSchema xs
363362 SwaggerItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
364363 SwaggerItemsArray itemSchemas -> do
365364 when (len /= length itemSchemas) $
@@ -419,11 +418,11 @@ validateObject o = withSchema $ \sch ->
419418 unknownProperty pname = invalid $
420419 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
421420
422−validateEnum :: Value -> Validation (ParamSchema t) ()
423−validateEnum value = do
421+validateEnum :: Value -> Validation ParamSchema ()
422+validateEnum val = do
424423 check enum_ $ \xs ->
425− when (value `notElem` xs) $
426− invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)
424+ when (val `notElem` xs) $
425+ invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show val)
427426
428427-- | Infer schema type based on used properties.
429428--
@@ -431,7 +430,7 @@ validateEnum value = do
431430--
432431-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
433432-- Just [SwaggerObject]
434−inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
433+inferSchemaTypes :: Schema -> [SwaggerType]
435434inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
436435 [ SwaggerObject | any ($ sch)
437436 [ has (additionalProperties._Just)
@@ -453,7 +452,7 @@ inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
453452--
454453-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
455454-- Just [SwaggerInteger]
456−inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]
455+inferParamSchemaTypes :: ParamSchema -> [SwaggerType]
457456inferParamSchemaTypes sch = concat
458457 [ [ SwaggerArray | any ($ sch)
459458 [ has (items._Just)
@@ -473,23 +472,23 @@ inferParamSchemaTypes sch = concat
473472 ]
474473
475474validateSchemaType :: Value -> Validation Schema ()
476−validateSchemaType value = withSchema $ \sch ->
475+validateSchemaType val = withSchema $ \sch ->
477476 case sch of
478477 (view oneOf -> Just variants) -> do
479478 res <- forM variants $ \var ->
480− (True <$ validateWithSchemaRef var value) <|> (return False)
479+ (True <$ validateWithSchemaRef var val) <|> (return False)
481480 case length $ filter id res of
482− 0 -> invalid $ "Value not valid under any of 'oneOf' schemas: " ++ show value
481+ 0 -> invalid $ "Value not valid under any of 'oneOf' schemas: " ++ show val
483482 1 -> valid
484− _ -> invalid $ "Value matches more than one of 'oneOf' schemas: " ++ show value
483+ _ -> invalid $ "Value matches more than one of 'oneOf' schemas: " ++ show val
485484 (view allOf -> Just variants) -> do
486485 -- Default semantics for Validation Monad will abort when at least one
487486 -- variant does not match.
488487 forM_ variants $ \var ->
489− validateWithSchemaRef var value
488+ validateWithSchemaRef var val
490489
491490 _ ->
492− case (sch ^. type_, value) of
491+ case (sch ^. type_, val) of
493492 (Just SwaggerNull, Null) -> valid
494493 (Just SwaggerBoolean, Bool _) -> valid
495494 (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)
@@ -506,9 +505,9 @@ validateSchemaType value = withSchema $ \sch ->
506505 (Nothing, Object o) -> validateObject o
507506 bad -> invalid $ "expected JSON value of type " ++ showType bad
508507
509−validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
510−validateParamSchemaType value = withSchema $ \sch ->
511− case (sch ^. type_, value) of
508+validateParamSchemaType :: Value -> Validation ParamSchema ()
509+validateParamSchemaType val = withSchema $ \sch ->
510+ case (sch ^. type_, val) of
512511 (Just SwaggerBoolean, Bool _) -> valid
513512 (Just SwaggerInteger, Number n) -> validateInteger n
514513 (Just SwaggerNumber, Number n) -> validateNumber n
@@ -521,7 +520,7 @@ validateParamSchemaType value = withSchema $ \sch ->
521520 (Nothing, Array xs) -> validateArray xs
522521 bad -> invalid $ "expected JSON value of type " ++ showType bad
523522
524−showType :: (Maybe (SwaggerType t), Value) -> String
523+showType :: (Maybe SwaggerType, Value) -> String
525524showType (Just ty, _) = show ty
526525showType (Nothing, Null) = "SwaggerNull"
527526showType (Nothing, Bool _) = "SwaggerBoolean"
src/Data/Swagger/Lens.hs+20−25
@@ -68,7 +68,7 @@ makePrisms ''Referenced
6868
6969-- ** 'SwaggerItems' prisms
7070
71−_SwaggerItemsArray :: Review (SwaggerItems 'SwaggerKindSchema) [Referenced Schema]
71+_SwaggerItemsArray :: Review SwaggerItems [Referenced Schema]
7272_SwaggerItemsArray
7373 = unto (\x -> SwaggerItemsArray x)
7474{- \x -> case x of
@@ -77,7 +77,7 @@ _SwaggerItemsArray
7777 SwaggerItemsArray a -> Right a
7878-}
7979
80−_SwaggerItemsObject :: Review (SwaggerItems 'SwaggerKindSchema) (Referenced Schema)
80+_SwaggerItemsObject :: Review SwaggerItems (Referenced Schema)
8181_SwaggerItemsObject
8282 = unto (\x -> SwaggerItemsObject x)
8383{- \x -> case x of
@@ -86,9 +86,6 @@ _SwaggerItemsObject
8686 SwaggerItemsArray a -> Left (SwaggerItemsArray a)
8787-}
8888
89−_SwaggerItemsPrimitive :: forall t p f. (Profunctor p, Bifunctor p, Functor f) => Optic' p f (SwaggerItems t) (Maybe (CollectionFormat t), ParamSchema t)
90−_SwaggerItemsPrimitive = unto (\(c, p) -> SwaggerItemsPrimitive c p)
91−
9289-- =============================================================
9390-- More helpful instances for easier access to schema properties
9491
@@ -104,77 +101,75 @@ instance At Responses where at n = responses . at n
104101instance Ixed Operation where ix n = responses . ix n
105102instance At Operation where at n = responses . at n
106103
107−instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema
104+instance HasParamSchema NamedSchema ParamSchema where paramSchema = schema.paramSchema
108105
109106-- HasType instances
110−instance HasType Header (Maybe (SwaggerType ('SwaggerKindNormal Header))) where type_ = schema.type_
111−instance HasType Schema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
112−instance HasType NamedSchema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
107+instance HasType Schema (Maybe SwaggerType) where type_ = paramSchema.type_
108+instance HasType NamedSchema (Maybe SwaggerType) where type_ = paramSchema.type_
113109
114110-- HasDefault instances
115−instance HasDefault Header (Maybe Value) where default_ = schema.default_
116111instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_
117112
118113-- OVERLAPPABLE instances
119114
120115instance
121116 {-# OVERLAPPABLE #-}
122− HasParamSchema s (ParamSchema t)
117+ HasParamSchema s ParamSchema
123118 => HasFormat s (Maybe Format) where
124119 format = paramSchema.format
125120
126121instance
127122 {-# OVERLAPPABLE #-}
128− HasParamSchema s (ParamSchema t)
129− => HasItems s (Maybe (SwaggerItems t)) where
123+ HasParamSchema s ParamSchema
124+ => HasItems s (Maybe SwaggerItems) where
130125 items = paramSchema.items
131126
132127instance
133128 {-# OVERLAPPABLE #-}
134− HasParamSchema s (ParamSchema t)
129+ HasParamSchema s ParamSchema
135130 => HasMaximum s (Maybe Scientific) where
136131 maximum_ = paramSchema.maximum_
137132
138−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
133+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
139134 => HasExclusiveMaximum s (Maybe Bool) where
140135 exclusiveMaximum = paramSchema.exclusiveMaximum
141136
142−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
137+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
143138 => HasMinimum s (Maybe Scientific) where
144139 minimum_ = paramSchema.minimum_
145140
146−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
141+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
147142 => HasExclusiveMinimum s (Maybe Bool) where
148143 exclusiveMinimum = paramSchema.exclusiveMinimum
149144
150−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
145+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
151146 => HasMaxLength s (Maybe Integer) where
152147 maxLength = paramSchema.maxLength
153148
154−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
149+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
155150 => HasMinLength s (Maybe Integer) where
156151 minLength = paramSchema.minLength
157152
158−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
153+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
159154 => HasPattern s (Maybe Text) where
160155 pattern = paramSchema.pattern
161156
162−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
157+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
163158 => HasMaxItems s (Maybe Integer) where
164159 maxItems = paramSchema.maxItems
165160
166−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
161+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
167162 => HasMinItems s (Maybe Integer) where
168163 minItems = paramSchema.minItems
169164
170−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
165+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
171166 => HasUniqueItems s (Maybe Bool) where
172167 uniqueItems = paramSchema.uniqueItems
173168
174−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
169+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
175170 => HasEnum s (Maybe [Value]) where
176171 enum_ = paramSchema.enum_
177172
178−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
173+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
179174 => HasMultipleOf s (Maybe Scientific) where
180175 multipleOf = paramSchema.multipleOf
src/Data/Swagger/Optics.hs+14−133
@@ -45,15 +45,6 @@
4545-- :}
4646-- {"description":"To be or not to be","type":"boolean"}
4747--
48−-- @'ParamSchema'@ is basically the /base schema specification/ and many types
49−-- contain it. So for convenience, all @'ParamSchema'@ fields are transitively
50−-- made fields of the type that has it. For example, you can use @#type@ to
51−-- access @'SwaggerType'@ of @'Header'@ schema without having to use
52−-- @#paramSchema@:
53−--
54−-- >>> BSL.putStrLn $ encode $ (mempty :: Header) & #type ?~ SwaggerNumber
55−-- {"schema":{"type":"number"}}
56−--
5748-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
5849-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
5950--
@@ -119,8 +110,8 @@ instance
119110 , b ~ [Referenced Schema]
120111 ) => LabelOptic "_SwaggerItemsArray"
121112 A_Review
122− (SwaggerItems 'SwaggerKindSchema)
123− (SwaggerItems 'SwaggerKindSchema)
113+ SwaggerItems
114+ SwaggerItems
124115 a
125116 b where
126117 labelOptic = unto (\x -> SwaggerItemsArray x)
@@ -131,25 +122,13 @@ instance
131122 , b ~ Referenced Schema
132123 ) => LabelOptic "_SwaggerItemsObject"
133124 A_Review
134− (SwaggerItems 'SwaggerKindSchema)
135− (SwaggerItems 'SwaggerKindSchema)
125+ SwaggerItems
126+ SwaggerItems
136127 a
137128 b where
138129 labelOptic = unto (\x -> SwaggerItemsObject x)
139130 {-# INLINE labelOptic #-}
140131
141−instance
142− ( a ~ (Maybe (CollectionFormat t), ParamSchema t)
143− , b ~ (Maybe (CollectionFormat t), ParamSchema t)
144− ) => LabelOptic "_SwaggerItemsPrimitive"
145− A_Review
146− (SwaggerItems t)
147− (SwaggerItems t)
148− a
149− b where
150− labelOptic = unto (\(c, p) -> SwaggerItemsPrimitive c p)
151− {-# INLINE labelOptic #-}
152−
153132-- =============================================================
154133-- More helpful instances for easier access to schema properties
155134
@@ -176,8 +155,8 @@ instance At Operation where
176155-- #paramSchema
177156
178157instance
179− ( a ~ ParamSchema 'SwaggerKindSchema
180− , b ~ ParamSchema 'SwaggerKindSchema
158+ ( a ~ ParamSchema
159+ , b ~ ParamSchema
181160 ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where
182161 labelOptic = #schema % #paramSchema
183162 {-# INLINE labelOptic #-}
@@ -185,34 +164,21 @@ instance
185164-- #type
186165
187166instance
188− ( a ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
189− , b ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
190− ) => LabelOptic "type" A_Lens Header Header a b where
191− labelOptic = #schema % #type
192− {-# INLINE labelOptic #-}
193−
194−instance
195− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
196− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
167+ ( a ~ Maybe SwaggerType
168+ , b ~ Maybe SwaggerType
197169 ) => LabelOptic "type" A_Lens Schema Schema a b where
198170 labelOptic = #paramSchema % #type
199171 {-# INLINE labelOptic #-}
200172
201173instance
202− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
203− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
174+ ( a ~ Maybe SwaggerType
175+ , b ~ Maybe SwaggerType
204176 ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
205177 labelOptic = #paramSchema % #type
206178 {-# INLINE labelOptic #-}
207179
208180-- #default
209181
210−instance
211− ( a ~ Maybe Value, b ~ Maybe Value
212− ) => LabelOptic "default" A_Lens Header Header a b where
213− labelOptic = #schema % #default
214− {-# INLINE labelOptic #-}
215−
216182instance
217183 ( a ~ Maybe Value, b ~ Maybe Value
218184 ) => LabelOptic "default" A_Lens Schema Schema a b where
@@ -227,12 +193,6 @@ instance
227193
228194-- #format
229195
230−instance
231− ( a ~ Maybe Format, b ~ Maybe Format
232− ) => LabelOptic "format" A_Lens Header Header a b where
233− labelOptic = #schema % #format
234− {-# INLINE labelOptic #-}
235−
236196instance
237197 ( a ~ Maybe Format, b ~ Maybe Format
238198 ) => LabelOptic "format" A_Lens Schema Schema a b where
@@ -248,34 +208,21 @@ instance
248208-- #items
249209
250210instance
251− ( a ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
252− , b ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
253− ) => LabelOptic "items" A_Lens Header Header a b where
254− labelOptic = #schema % #items
255− {-# INLINE labelOptic #-}
256−
257−instance
258− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
259− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
211+ ( a ~ Maybe SwaggerItems
212+ , b ~ Maybe SwaggerItems
260213 ) => LabelOptic "items" A_Lens Schema Schema a b where
261214 labelOptic = #paramSchema % #items
262215 {-# INLINE labelOptic #-}
263216
264217instance
265− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
266− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
218+ ( a ~ Maybe SwaggerItems
219+ , b ~ Maybe SwaggerItems
267220 ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
268221 labelOptic = #paramSchema % #items
269222 {-# INLINE labelOptic #-}
270223
271224-- #maximum
272225
273−instance
274− ( a ~ Maybe Scientific, b ~ Maybe Scientific
275− ) => LabelOptic "maximum" A_Lens Header Header a b where
276− labelOptic = #schema % #maximum
277− {-# INLINE labelOptic #-}
278−
279226instance
280227 ( a ~ Maybe Scientific, b ~ Maybe Scientific
281228 ) => LabelOptic "maximum" A_Lens Schema Schema a b where
@@ -290,12 +237,6 @@ instance
290237
291238-- #exclusiveMaximum
292239
293−instance
294− ( a ~ Maybe Bool, b ~ Maybe Bool
295− ) => LabelOptic "exclusiveMaximum" A_Lens Header Header a b where
296− labelOptic = #schema % #exclusiveMaximum
297− {-# INLINE labelOptic #-}
298−
299240instance
300241 ( a ~ Maybe Bool, b ~ Maybe Bool
301242 ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where
@@ -310,12 +251,6 @@ instance
310251
311252-- #minimum
312253
313−instance
314− ( a ~ Maybe Scientific, b ~ Maybe Scientific
315− ) => LabelOptic "minimum" A_Lens Header Header a b where
316− labelOptic = #schema % #minimum
317− {-# INLINE labelOptic #-}
318−
319254instance
320255 ( a ~ Maybe Scientific, b ~ Maybe Scientific
321256 ) => LabelOptic "minimum" A_Lens Schema Schema a b where
@@ -330,12 +265,6 @@ instance
330265
331266-- #exclusiveMinimum
332267
333−instance
334− ( a ~ Maybe Bool, b ~ Maybe Bool
335− ) => LabelOptic "exclusiveMinimum" A_Lens Header Header a b where
336− labelOptic = #schema % #exclusiveMinimum
337− {-# INLINE labelOptic #-}
338−
339268instance
340269 ( a ~ Maybe Bool, b ~ Maybe Bool
341270 ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where
@@ -350,12 +279,6 @@ instance
350279
351280-- #maxLength
352281
353−instance
354− ( a ~ Maybe Integer, b ~ Maybe Integer
355− ) => LabelOptic "maxLength" A_Lens Header Header a b where
356− labelOptic = #schema % #maxLength
357− {-# INLINE labelOptic #-}
358−
359282instance
360283 ( a ~ Maybe Integer, b ~ Maybe Integer
361284 ) => LabelOptic "maxLength" A_Lens Schema Schema a b where
@@ -370,12 +293,6 @@ instance
370293
371294-- #minLength
372295
373−instance
374− ( a ~ Maybe Integer, b ~ Maybe Integer
375− ) => LabelOptic "minLength" A_Lens Header Header a b where
376− labelOptic = #schema % #minLength
377− {-# INLINE labelOptic #-}
378−
379296instance
380297 ( a ~ Maybe Integer, b ~ Maybe Integer
381298 ) => LabelOptic "minLength" A_Lens Schema Schema a b where
@@ -390,12 +307,6 @@ instance
390307
391308-- #pattern
392309
393−instance
394− ( a ~ Maybe Text, b ~ Maybe Text
395− ) => LabelOptic "pattern" A_Lens Header Header a b where
396− labelOptic = #schema % #pattern
397− {-# INLINE labelOptic #-}
398−
399310instance
400311 ( a ~ Maybe Text, b ~ Maybe Text
401312 ) => LabelOptic "pattern" A_Lens Schema Schema a b where
@@ -410,12 +321,6 @@ instance
410321
411322-- #maxItems
412323
413−instance
414− ( a ~ Maybe Integer, b ~ Maybe Integer
415− ) => LabelOptic "maxItems" A_Lens Header Header a b where
416− labelOptic = #schema % #maxItems
417− {-# INLINE labelOptic #-}
418−
419324instance
420325 ( a ~ Maybe Integer, b ~ Maybe Integer
421326 ) => LabelOptic "maxItems" A_Lens Schema Schema a b where
@@ -430,12 +335,6 @@ instance
430335
431336-- #minItems
432337
433−instance
434− ( a ~ Maybe Integer, b ~ Maybe Integer
435− ) => LabelOptic "minItems" A_Lens Header Header a b where
436− labelOptic = #schema % #minItems
437− {-# INLINE labelOptic #-}
438−
439338instance
440339 ( a ~ Maybe Integer, b ~ Maybe Integer
441340 ) => LabelOptic "minItems" A_Lens Schema Schema a b where
@@ -450,12 +349,6 @@ instance
450349
451350-- #uniqueItems
452351
453−instance
454− ( a ~ Maybe Bool, b ~ Maybe Bool
455− ) => LabelOptic "uniqueItems" A_Lens Header Header a b where
456− labelOptic = #schema % #uniqueItems
457− {-# INLINE labelOptic #-}
458−
459352instance
460353 ( a ~ Maybe Bool, b ~ Maybe Bool
461354 ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where
@@ -470,12 +363,6 @@ instance
470363
471364-- #enum
472365
473−instance
474− ( a ~ Maybe [Value], b ~ Maybe [Value]
475− ) => LabelOptic "enum" A_Lens Header Header a b where
476− labelOptic = #schema % #enum
477− {-# INLINE labelOptic #-}
478−
479366instance
480367 ( a ~ Maybe [Value], b ~ Maybe [Value]
481368 ) => LabelOptic "enum" A_Lens Schema Schema a b where
@@ -490,12 +377,6 @@ instance
490377
491378-- #multipleOf
492379
493−instance
494− ( a ~ Maybe Scientific, b ~ Maybe Scientific
495− ) => LabelOptic "multipleOf" A_Lens Header Header a b where
496− labelOptic = #schema % #multipleOf
497− {-# INLINE labelOptic #-}
498−
499380instance
500381 ( a ~ Maybe Scientific, b ~ Maybe Scientific
501382 ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where
test/Data/Swagger/ParamSchemaSpec.hs+1−2
@@ -13,7 +13,6 @@ import Data.Proxy
1313import GHC.Generics
1414
1515import Data.Swagger
16−import Data.Swagger.Internal (SwaggerKind(..))
1716
1817import Data.Swagger.CommonTestTypes
1918import SpecCommon
@@ -23,7 +22,7 @@ import Data.Time.LocalTime
2322import qualified Data.HashMap.Strict as HM
2423
2524checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
26−checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js
25+checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema) <=> js
2726
2827spec :: Spec
2928spec = do