ee9223e · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Add style for parameters, remove kinds

ee9223eMaxim Koltsov6 years ago

src/Data/Swagger.hs+1−11

compare with master

unifiedsplit

@@ -59,7 +59,7 @@ module Data.Swagger (

59 SwaggerType(..),

60 Format,

61 Definitions,

62− CollectionFormat(..),

62+ Style(..),

64 -- ** Parameters

65 Param(..),

@@ -220,16 +220,6 @@ import Data.Swagger.Internal

220-- :}

221-- {"description":"To be or not to be","type":"boolean"}

222--

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−--

233-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@

223-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@

234-- have direct access to it via @'at' code@. Example:

224-- have direct access to it via @'at' code@. Example:

235--

225--

src/Data/Swagger/Internal.hs+101−253

@@ -338,6 +338,29 @@ data MediaTypeObject = MediaTypeObject

338 , _mediaTypeObjectEncoding :: InsOrdHashMap Text Encoding

339 } deriving (Eq, Show, Generic, Data, Typeable)

340

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+

341data Encoding = Encoding

364data Encoding = Encoding

342 { -- | The Content-Type for encoding a specific property.

365 { -- | The Content-Type for encoding a specific property.

343 -- Default value depends on the property type: for @string@

366 -- Default value depends on the property type: for @string@

@@ -355,11 +378,11 @@ data Encoding = Encoding

355 , _encodingHeaders :: InsOrdHashMap Text (Referenced Header)

378 , _encodingHeaders :: InsOrdHashMap Text (Referenced Header)

356

379

357 -- | Describes how a specific property value will be serialized depending on its type.

380 -- | 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.

359 -- The behavior follows the same values as query parameters, including default values.

382 -- The behavior follows the same values as query parameters, including default values.

360 -- This property SHALL be ignored if the request body media type

383 -- This property SHALL be ignored if the request body media type

361 -- is not @application/x-www-form-urlencoded@.

384 -- is not @application/x-www-form-urlencoded@.

362− , _encodingStyle :: Maybe Text -- TODO enum

385+ , _encodingStyle :: Maybe Style

363

386

364 -- | When this is true, property values of type @array@ or @object@ generate

387 -- | When this is true, property values of type @array@ or @object@ generate

365 -- separate parameters for each value of the array,

388 -- separate parameters for each value of the array,

@@ -424,10 +447,38 @@ data Param = Param

424 -- | Sets the ability to pass empty-valued parameters.

447 -- | Sets the ability to pass empty-valued parameters.

425 -- This is valid only for 'ParamQuery' parameters and allows sending

448 -- This is valid only for 'ParamQuery' parameters and allows sending

426 -- a parameter with an empty value. Default value is @false@.

449 -- a parameter with an empty value. Default value is @false@.

427− , _paramOtherSchemaAllowEmptyValue :: Maybe Bool

450+ , _paramAllowEmptyValue :: Maybe Bool

428

451

429 -- | Parameter schema.

452 -- | Parameter schema.

430 , _paramSchema :: Maybe (Referenced Schema)

453 , _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)

431 } deriving (Eq, Show, Generic, Data, Typeable)

482 } deriving (Eq, Show, Generic, Data, Typeable)

432

483

433data Example = Example

484data Example = Example

@@ -454,136 +505,26 @@ data Example = Example

454

505

455-- | Items for @'SwaggerArray'@ schemas.

506-- | Items for @'SwaggerArray'@ schemas.

456--

507--

457−-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.

508+-- __Warning__: OpenAPI 3.0 does not support tuple arrays. However, OpenAPI 3.1 will, as

458−-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.

509+-- it will incorporate Json Schema mostly verbatim.

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>.

461--

510--

462-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.

511-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.

463--

512--

464-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.

513-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.

465−data SwaggerItems t where

514+data SwaggerItems where

466− SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k

467− SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema

515+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems

468− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema

516+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems

469− deriving (Typeable)

517+ deriving (Eq, Show, Typeable, Data)

470−

518+

471−deriving instance Eq (SwaggerItems t)

519+data SwaggerType where

472−deriving instance Show (SwaggerItems t)

520+ SwaggerString :: SwaggerType

473−--deriving instance Typeable (SwaggerItems t)

521+ SwaggerNumber :: SwaggerType

474−

522+ SwaggerInteger :: SwaggerType

475−swaggerItemsPrimitiveConstr :: Constr

523+ SwaggerBoolean :: SwaggerType

476−swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix

524+ SwaggerArray :: SwaggerType

477−

525+ SwaggerNull :: SwaggerType

478−swaggerItemsObjectConstr :: Constr

526+ SwaggerObject :: SwaggerType

479−swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix

527+ deriving (Eq, Show, Typeable, Generic, Data)

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

587

528

588data ParamLocation

529data ParamLocation

589 = -- | Parameters that are appended to the URL.

530 = -- | Parameters that are appended to the URL.

@@ -601,42 +542,6 @@ data ParamLocation

601

542

602type Format = Text

543type Format = Text

603

544

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−

640type ParamName = Text

545type ParamName = Text

641

546

642data Schema = Schema

547data Schema = Schema

@@ -663,7 +568,7 @@ data Schema = Schema

663 , _schemaMaxProperties :: Maybe Integer

568 , _schemaMaxProperties :: Maybe Integer

664 , _schemaMinProperties :: Maybe Integer

569 , _schemaMinProperties :: Maybe Integer

665

570

666− , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema

571+ , _schemaParamSchema :: ParamSchema

667 } deriving (Eq, Show, Generic, Data, Typeable)

572 } deriving (Eq, Show, Generic, Data, Typeable)

668

573

669data Discriminator = Discriminator

574data Discriminator = Discriminator

@@ -684,7 +589,7 @@ data NamedSchema = NamedSchema

684-- | Regex pattern for @string@ type.

589-- | Regex pattern for @string@ type.

685type Pattern = Text

590type Pattern = Text

686

591

687−data ParamSchema (t :: SwaggerKind *) = ParamSchema

592+data ParamSchema = ParamSchema

688 { -- | Declares the value of the parameter that the server will use if none is provided,

593 { -- | Declares the value of the parameter that the server will use if none is provided,

689 -- for example a @"count"@ to control the number of results per page might default to @100@

594 -- for example a @"count"@ to control the number of results per page might default to @100@

690 -- if not supplied by the client in the request.

595 -- if not supplied by the client in the request.

@@ -692,9 +597,9 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema

692 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.

597 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.

693 _paramSchemaDefault :: Maybe Value

598 _paramSchemaDefault :: Maybe Value

694

599

695− , _paramSchemaType :: Maybe (SwaggerType t)

600+ , _paramSchemaType :: Maybe SwaggerType

696 , _paramSchemaFormat :: Maybe Format

601 , _paramSchemaFormat :: Maybe Format

697− , _paramSchemaItems :: Maybe (SwaggerItems t)

602+ , _paramSchemaItems :: Maybe SwaggerItems

698 , _paramSchemaMaximum :: Maybe Scientific

603 , _paramSchemaMaximum :: Maybe Scientific

699 , _paramSchemaExclusiveMaximum :: Maybe Bool

604 , _paramSchemaExclusiveMaximum :: Maybe Bool

700 , _paramSchemaMinimum :: Maybe Scientific

605 , _paramSchemaMinimum :: Maybe Scientific

@@ -707,9 +612,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema

707 , _paramSchemaUniqueItems :: Maybe Bool

612 , _paramSchemaUniqueItems :: Maybe Bool

708 , _paramSchemaEnum :: Maybe [Value]

613 , _paramSchemaEnum :: Maybe [Value]

709 , _paramSchemaMultipleOf :: Maybe Scientific

614 , _paramSchemaMultipleOf :: Maybe Scientific

710− } deriving (Eq, Show, Generic, Typeable)

615+ } deriving (Eq, Show, Generic, Typeable, Data)

711−

712−deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)

713

616

714data Xml = Xml

617data Xml = Xml

715 { -- | Replaces the name of the element/attribute used for the described schema property.

618 { -- | Replaces the name of the element/attribute used for the described schema property.

@@ -779,11 +682,13 @@ instance IsString Response where

779

682

780type HeaderName = Text

683type HeaderName = Text

781

684

685+

686+-- TODO this is mostly a copy of 'Param'.

782data Header = Header

687data Header = Header

783 { -- | A short description of the header.

688 { -- | A short description of the header.

784 _headerDescription :: Maybe Text

689 _headerDescription :: Maybe Text

785

690

786− , _headerSchema :: ParamSchema ('SwaggerKindNormal Header)

691+ , _headerSchema :: Maybe (Referenced Schema)

787 } deriving (Eq, Show, Generic, Data, Typeable)

692 } deriving (Eq, Show, Generic, Data, Typeable)

788

693

789-- | The location of the API key.

694-- | The location of the API key.

@@ -993,9 +898,9 @@ instance Monoid Schema where

993 mempty = genericMempty

898 mempty = genericMempty

994 mappend = (<>)

899 mappend = (<>)

995

900

996−instance Semigroup (ParamSchema t) where

901+instance Semigroup ParamSchema where

997 (<>) = genericMappend

902 (<>) = genericMappend

998−instance Monoid (ParamSchema t) where

903+instance Monoid ParamSchema where

999 mempty = genericMempty

904 mempty = genericMempty

1000 mappend = (<>)

905 mappend = (<>)

1001

906

@@ -1093,7 +998,7 @@ instance SwaggerMonoid Info

1093instance SwaggerMonoid Components

998instance SwaggerMonoid Components

1094instance SwaggerMonoid PathItem

999instance SwaggerMonoid PathItem

1095instance SwaggerMonoid Schema

1000instance SwaggerMonoid Schema

1096−instance SwaggerMonoid (ParamSchema t)

1001+instance SwaggerMonoid ParamSchema

1097instance SwaggerMonoid Param

1002instance SwaggerMonoid Param

1098instance SwaggerMonoid Responses

1003instance SwaggerMonoid Responses

1099instance SwaggerMonoid Response

1004instance SwaggerMonoid Response

@@ -1104,7 +1009,7 @@ instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)

1104instance SwaggerMonoid MimeList

1009instance SwaggerMonoid MimeList

1105deriving instance SwaggerMonoid URL

1010deriving instance SwaggerMonoid URL

1106

1011

1107−instance SwaggerMonoid (SwaggerType t) where

1012+instance SwaggerMonoid SwaggerType where

1108 swaggerMempty = SwaggerString

1013 swaggerMempty = SwaggerString

1109 swaggerMappend _ y = y

1014 swaggerMappend _ y = y

1110

1015

@@ -1125,6 +1030,12 @@ instance Monoid a => SwaggerMonoid (Referenced a) where

1125-- Simple Generic-based ToJSON instances

1030-- Simple Generic-based ToJSON instances

1126-- =======================================================================

1031-- =======================================================================

1127

1032

1033+instance ToJSON Style where

1034+ toJSON = genericToJSON (jsonPrefix "Style")

1035+

1036+instance ToJSON SwaggerType where

1037+ toJSON = genericToJSON (jsonPrefix "Swagger")

1038+

1128instance ToJSON ParamLocation where

1039instance ToJSON ParamLocation where

1129 toJSON = genericToJSON (jsonPrefix "Param")

1040 toJSON = genericToJSON (jsonPrefix "Param")

1130

1041

@@ -1174,6 +1085,12 @@ instance ToJSON OAuth2AuthorizationCodeFlow where

1174-- Simple Generic-based FromJSON instances

1085-- Simple Generic-based FromJSON instances

1175-- =======================================================================

1086-- =======================================================================

1176

1087

1088+instance FromJSON Style where

1089+ parseJSON = genericParseJSON (jsonPrefix "Style")

1090+

1091+instance FromJSON SwaggerType where

1092+ parseJSON = genericParseJSON (jsonPrefix "Swagger")

1093+

1177instance FromJSON ParamLocation where

1094instance FromJSON ParamLocation where

1178 parseJSON = genericParseJSON (jsonPrefix "Param")

1095 parseJSON = genericParseJSON (jsonPrefix "Param")

1179

1096

@@ -1272,10 +1189,7 @@ instance ToJSON Header where

1272-- >>> encode (SwaggerItemsArray [])

1189-- >>> encode (SwaggerItemsArray [])

1273-- "{\"example\":[],\"items\":{},\"maxItems\":0}"

1190-- "{\"example\":[],\"items\":{},\"maxItems\":0}"

1274--

1191--

1275−instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where

1192+instance ToJSON SwaggerItems where

1276− toJSON (SwaggerItemsPrimitive fmt schema) = object

1277− [ "collectionFormat" .= fmt

1278− , "items" .= schema ]

1279 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]

1193 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]

1280 toJSON (SwaggerItemsArray []) = object

1194 toJSON (SwaggerItemsArray []) = object

1281 [ "items" .= object []

1195 [ "items" .= object []

@@ -1344,24 +1258,7 @@ instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/comp

1344instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"

1258instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"

1345instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"

1259instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"

1346

1260

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

1365 -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?

1262 -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?

1366 toJSON = sopSwaggerGenericToJSONWithOpts $

1263 toJSON = sopSwaggerGenericToJSONWithOpts $

1367 mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"

1264 mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"

@@ -1412,28 +1309,7 @@ instance FromJSON Schema where

1412instance FromJSON Header where

1309instance FromJSON Header where

1413 parseJSON = sopSwaggerGenericParseJSON

1310 parseJSON = sopSwaggerGenericParseJSON

1414

1311

1415−instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where

1312+instance FromJSON SwaggerItems 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

1437 parseJSON js@(Object obj)

1313 parseJSON js@(Object obj)

1438 | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.

1314 | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.

1439 | otherwise = SwaggerItemsObject <$> parseJSON js

1315 | otherwise = SwaggerItemsObject <$> parseJSON js

@@ -1506,30 +1382,7 @@ instance FromJSON (Referenced Header) where parseJSON = referencedParseJSON "#

1506instance FromJSON Xml where

1382instance FromJSON Xml where

1507 parseJSON = genericParseJSON (jsonPrefix "xml")

1383 parseJSON = genericParseJSON (jsonPrefix "xml")

1508

1384

1509−instance FromJSON (SwaggerType 'SwaggerKindSchema) where

1385+instance FromJSON ParamSchema 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

1533 parseJSON = sopSwaggerGenericParseJSON

1386 parseJSON = sopSwaggerGenericParseJSON

1534

1387

1535instance FromJSON AdditionalProperties where

1388instance FromJSON AdditionalProperties where

@@ -1571,17 +1424,12 @@ instance HasSwaggerAesonOptions Example where

1571instance HasSwaggerAesonOptions Encoding where

1424instance HasSwaggerAesonOptions Encoding where

1572 swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"

1425 swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"

1573

1426

1574−instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where

1427+instance HasSwaggerAesonOptions ParamSchema 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

1580 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"

1428 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"

1581

1429

1582instance AesonDefaultValue Server

1430instance AesonDefaultValue Server

1583instance AesonDefaultValue Components

1431instance AesonDefaultValue Components

1584−instance AesonDefaultValue (ParamSchema s)

1432+instance AesonDefaultValue ParamSchema

1585instance AesonDefaultValue OAuth2ImplicitFlow

1433instance AesonDefaultValue OAuth2ImplicitFlow

1586instance AesonDefaultValue OAuth2PasswordFlow

1434instance AesonDefaultValue OAuth2PasswordFlow

1587instance AesonDefaultValue OAuth2ClientCredentialsFlow

1435instance AesonDefaultValue OAuth2ClientCredentialsFlow

@@ -1589,7 +1437,7 @@ instance AesonDefaultValue OAuth2AuthorizationCodeFlow

1589instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)

1437instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)

1590instance AesonDefaultValue Responses

1438instance AesonDefaultValue Responses

1591instance AesonDefaultValue SecuritySchemeType

1439instance AesonDefaultValue SecuritySchemeType

1592−instance AesonDefaultValue (SwaggerType a)

1440+instance AesonDefaultValue SwaggerType

1593instance AesonDefaultValue MimeList where defaultValue = Just mempty

1441instance AesonDefaultValue MimeList where defaultValue = Just mempty

1594instance AesonDefaultValue Info

1442instance AesonDefaultValue Info

1595instance AesonDefaultValue ParamLocation

1443instance AesonDefaultValue ParamLocation

src/Data/Swagger/Internal/ParamSchema.hs+12−12

@@ -50,20 +50,20 @@ import qualified Data.ByteString.Lazy as BSL

50import GHC.TypeLits (TypeError, ErrorMessage(..))

52-- | Default schema for binary data (any sequence of octets).

53−binaryParamSchema :: ParamSchema t

53+binaryParamSchema :: ParamSchema

54binaryParamSchema = mempty

55 & type_ ?~ SwaggerString

56 & format ?~ "binary"

58-- | Default schema for binary data (base64 encoded).

59−byteParamSchema :: ParamSchema t

59+byteParamSchema :: ParamSchema

60byteParamSchema = mempty

61 & type_ ?~ SwaggerString

62 & format ?~ "byte"

64-- | Default schema for password string.

65-- @"password"@ format is used to hint UIs the input needs to be obscured.

66−passwordParamSchema :: ParamSchema t

66+passwordParamSchema :: ParamSchema

67passwordParamSchema = mempty

68 & type_ ?~ SwaggerString

69 & format ?~ "password"

@@ -108,8 +108,8 @@ class ToParamSchema a where

108 --

109 -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)

110 -- "{\"type\":\"integer\"}"

111− toParamSchema :: Proxy a -> ParamSchema t

111+ toParamSchema :: Proxy a -> ParamSchema

112− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema t

112+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema

113 toParamSchema = genericToParamSchema defaultSchemaOptions

114

115instance {-# OVERLAPPING #-} ToParamSchema String where

@@ -151,7 +151,7 @@ instance ToParamSchema Word64 where

151--

152-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)

153-- "{\"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

155toParamSchemaBoundedIntegral _ = mempty

156 & type_ ?~ SwaggerInteger

157 & minimum_ ?~ fromInteger (toInteger (minBound :: a))

@@ -181,7 +181,7 @@ instance ToParamSchema Float where

181 & type_ ?~ SwaggerNumber

182 & format ?~ "float"

183

184−timeParamSchema :: String -> ParamSchema t

184+timeParamSchema :: String -> ParamSchema

185timeParamSchema fmt = mempty

186 & type_ ?~ SwaggerString

187 & format ?~ T.pack fmt

@@ -236,7 +236,7 @@ type family ToParamSchemaByteStringError bs where

236 ToParamSchemaByteStringError bs = TypeError

237 ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."

238 :$$: '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." )

240

241instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"

242instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible"

@@ -254,7 +254,7 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t

254instance ToParamSchema a => ToParamSchema [a] where

255 toParamSchema _ = mempty

256 & type_ ?~ SwaggerArray

257− & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))

257+ & items ?~ SwaggerItemsObject (Inline $ mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a))

258

259instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])

260instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])

@@ -287,11 +287,11 @@ instance ToParamSchema UUID where

287-- >>> data Color = Red | Blue deriving Generic

288-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)

289-- "{\"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

291genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty

292

293class GToParamSchema (f :: * -> *) where

294− gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t

294+ gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema -> ParamSchema

295

296instance GToParamSchema f => GToParamSchema (D1 d f) where

297 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)

@@ -309,7 +309,7 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh

309 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))

310

311class GEnumParamSchema (f :: * -> *) where

312− genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t

312+ genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema -> ParamSchema

313

314instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where

315 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

737 return $ Ref (Reference name)

738 _ -> Inline <$> gdeclareSchema opts proxy

739

740−appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema)

740+appendItem :: Referenced Schema -> Maybe SwaggerItems -> Maybe SwaggerItems

741appendItem x Nothing = Just (SwaggerItemsArray [x])

742appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))

743appendItem _ _ = 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)

298

299-- | Validate JSON @'Value'@ with Swagger @'Schema'@.

300validateWithSchema :: Value -> Validation Schema ()

301−validateWithSchema value = do

301+validateWithSchema val = do

302− validateSchemaType value

302+ validateSchemaType val

303− sub_ paramSchema $ validateEnum value

303+ sub_ paramSchema $ validateEnum val

304

305-- | Validate JSON @'Value'@ with Swagger @'ParamSchema'@.

306−validateWithParamSchema :: Value -> Validation (ParamSchema t) ()

306+validateWithParamSchema :: Value -> Validation ParamSchema ()

307−validateWithParamSchema value = do

307+validateWithParamSchema val = do

308− validateParamSchemaType value

308+ validateParamSchemaType val

309− validateEnum value

309+ validateEnum val

310

311−validateInteger :: Scientific -> Validation (ParamSchema t) ()

311+validateInteger :: Scientific -> Validation ParamSchema ()

312validateInteger n = do

313 when (not (isInteger n)) $

314 invalid ("not an integer")

315 validateNumber n

316

317−validateNumber :: Scientific -> Validation (ParamSchema t) ()

317+validateNumber :: Scientific -> Validation ParamSchema ()

318validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do

319 let exMax = Just True == sch ^. exclusiveMaximum

320 exMin = Just True == sch ^. exclusiveMinimum

@@ -331,7 +331,7 @@ validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do

331 when (not (isInteger (n / k))) $

332 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)

333

334−validateString :: Text -> Validation (ParamSchema t) ()

334+validateString :: Text -> Validation ParamSchema ()

335validateString s = do

336 check maxLength $ \n ->

337 when (len > fromInteger n) $

@@ -348,7 +348,7 @@ validateString s = do

348 where

349 len = Text.length s

350

351−validateArray :: Vector Value -> Validation (ParamSchema t) ()

351+validateArray :: Vector Value -> Validation ParamSchema ()

352validateArray xs = do

353 check maxItems $ \n ->

354 when (len > fromInteger n) $

@@ -359,7 +359,6 @@ validateArray xs = do

359 invalid ("array is too short (size should be >=" ++ show n ++ ")")

360

361 check items $ \case

362− SwaggerItemsPrimitive _ itemSchema -> sub itemSchema $ traverse_ validateWithParamSchema xs

363 SwaggerItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs

362 SwaggerItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs

364 SwaggerItemsArray itemSchemas -> do

363 SwaggerItemsArray itemSchemas -> do

365 when (len /= length itemSchemas) $

364 when (len /= length itemSchemas) $

@@ -419,11 +418,11 @@ validateObject o = withSchema $ \sch ->

419 unknownProperty pname = invalid $

418 unknownProperty pname = invalid $

420 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"

419 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"

421

420

422−validateEnum :: Value -> Validation (ParamSchema t) ()

421+validateEnum :: Value -> Validation ParamSchema ()

423−validateEnum value = do

422+validateEnum val = do

424 check enum_ $ \xs ->

423 check enum_ $ \xs ->

425− when (value `notElem` xs) $

424+ when (val `notElem` xs) $

426− invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)

425+ invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show val)

427

426

428-- | Infer schema type based on used properties.

427-- | Infer schema type based on used properties.

429--

428--

@@ -431,7 +430,7 @@ validateEnum value = do

431--

430--

432-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"

431-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"

433-- Just [SwaggerObject]

432-- Just [SwaggerObject]

434−inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]

433+inferSchemaTypes :: Schema -> [SwaggerType]

435inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++

434inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++

436 [ SwaggerObject | any ($ sch)

435 [ SwaggerObject | any ($ sch)

437 [ has (additionalProperties._Just)

436 [ has (additionalProperties._Just)

@@ -453,7 +452,7 @@ inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++

453--

452--

454-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"

453-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"

455-- Just [SwaggerInteger]

454-- Just [SwaggerInteger]

456−inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]

455+inferParamSchemaTypes :: ParamSchema -> [SwaggerType]

457inferParamSchemaTypes sch = concat

456inferParamSchemaTypes sch = concat

458 [ [ SwaggerArray | any ($ sch)

457 [ [ SwaggerArray | any ($ sch)

459 [ has (items._Just)

458 [ has (items._Just)

@@ -473,23 +472,23 @@ inferParamSchemaTypes sch = concat

473 ]

472 ]

474

473

475validateSchemaType :: Value -> Validation Schema ()

474validateSchemaType :: Value -> Validation Schema ()

476−validateSchemaType value = withSchema $ \sch ->

475+validateSchemaType val = withSchema $ \sch ->

477 case sch of

476 case sch of

478 (view oneOf -> Just variants) -> do

477 (view oneOf -> Just variants) -> do

479 res <- forM variants $ \var ->

478 res <- forM variants $ \var ->

480− (True <$ validateWithSchemaRef var value) <|> (return False)

479+ (True <$ validateWithSchemaRef var val) <|> (return False)

481 case length $ filter id res of

480 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

483 1 -> valid

482 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

485 (view allOf -> Just variants) -> do

484 (view allOf -> Just variants) -> do

486 -- Default semantics for Validation Monad will abort when at least one

485 -- Default semantics for Validation Monad will abort when at least one

487 -- variant does not match.

486 -- variant does not match.

488 forM_ variants $ \var ->

487 forM_ variants $ \var ->

489− validateWithSchemaRef var value

488+ validateWithSchemaRef var val

490

489

491 _ ->

490 _ ->

492− case (sch ^. type_, value) of

491+ case (sch ^. type_, val) of

493 (Just SwaggerNull, Null) -> valid

492 (Just SwaggerNull, Null) -> valid

494 (Just SwaggerBoolean, Bool _) -> valid

493 (Just SwaggerBoolean, Bool _) -> valid

495 (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)

494 (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)

@@ -506,9 +505,9 @@ validateSchemaType value = withSchema $ \sch ->

506 (Nothing, Object o) -> validateObject o

505 (Nothing, Object o) -> validateObject o

507 bad -> invalid $ "expected JSON value of type " ++ showType bad

506 bad -> invalid $ "expected JSON value of type " ++ showType bad

508

507

509−validateParamSchemaType :: Value -> Validation (ParamSchema t) ()

508+validateParamSchemaType :: Value -> Validation ParamSchema ()

510−validateParamSchemaType value = withSchema $ \sch ->

509+validateParamSchemaType val = withSchema $ \sch ->

511− case (sch ^. type_, value) of

510+ case (sch ^. type_, val) of

512 (Just SwaggerBoolean, Bool _) -> valid

511 (Just SwaggerBoolean, Bool _) -> valid

513 (Just SwaggerInteger, Number n) -> validateInteger n

512 (Just SwaggerInteger, Number n) -> validateInteger n

514 (Just SwaggerNumber, Number n) -> validateNumber n

513 (Just SwaggerNumber, Number n) -> validateNumber n

@@ -521,7 +520,7 @@ validateParamSchemaType value = withSchema $ \sch ->

521 (Nothing, Array xs) -> validateArray xs

520 (Nothing, Array xs) -> validateArray xs

522 bad -> invalid $ "expected JSON value of type " ++ showType bad

521 bad -> invalid $ "expected JSON value of type " ++ showType bad

523

522

524−showType :: (Maybe (SwaggerType t), Value) -> String

523+showType :: (Maybe SwaggerType, Value) -> String

525showType (Just ty, _) = show ty

524showType (Just ty, _) = show ty

526showType (Nothing, Null) = "SwaggerNull"

525showType (Nothing, Null) = "SwaggerNull"

527showType (Nothing, Bool _) = "SwaggerBoolean"

526showType (Nothing, Bool _) = "SwaggerBoolean"

src/Data/Swagger/Lens.hs+20−25

@@ -68,7 +68,7 @@ makePrisms ''Referenced

69-- ** 'SwaggerItems' prisms

71−_SwaggerItemsArray :: Review (SwaggerItems 'SwaggerKindSchema) [Referenced Schema]

71+_SwaggerItemsArray :: Review SwaggerItems [Referenced Schema]

72_SwaggerItemsArray

73 = unto (\x -> SwaggerItemsArray x)

74{- \x -> case x of

@@ -77,7 +77,7 @@ _SwaggerItemsArray

77 SwaggerItemsArray a -> Right a

78-}

80−_SwaggerItemsObject :: Review (SwaggerItems 'SwaggerKindSchema) (Referenced Schema)

80+_SwaggerItemsObject :: Review SwaggerItems (Referenced Schema)

81_SwaggerItemsObject

82 = unto (\x -> SwaggerItemsObject x)

83{- \x -> case x of

@@ -86,9 +86,6 @@ _SwaggerItemsObject

86 SwaggerItemsArray a -> Left (SwaggerItemsArray a)

87-}

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−

92-- =============================================================

89-- =============================================================

93-- More helpful instances for easier access to schema properties

90-- More helpful instances for easier access to schema properties

@@ -104,77 +101,75 @@ instance At Responses where at n = responses . at n

104instance Ixed Operation where ix n = responses . ix n

101instance Ixed Operation where ix n = responses . ix n

105instance At Operation where at n = responses . at n

102instance At Operation where at n = responses . at n

106

103

107−instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema

104+instance HasParamSchema NamedSchema ParamSchema where paramSchema = schema.paramSchema

108

105

109-- HasType instances

106-- 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_

107+instance HasType Schema (Maybe SwaggerType) where type_ = paramSchema.type_

112−instance HasType NamedSchema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_

108+instance HasType NamedSchema (Maybe SwaggerType) where type_ = paramSchema.type_

113

109

114-- HasDefault instances

110-- HasDefault instances

115−instance HasDefault Header (Maybe Value) where default_ = schema.default_

116instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_

111instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_

117

112

118-- OVERLAPPABLE instances

113-- OVERLAPPABLE instances

119

114

120instance

115instance

121 {-# OVERLAPPABLE #-}

116 {-# OVERLAPPABLE #-}

122− HasParamSchema s (ParamSchema t)

117+ HasParamSchema s ParamSchema

123 => HasFormat s (Maybe Format) where

118 => HasFormat s (Maybe Format) where

124 format = paramSchema.format

119 format = paramSchema.format

125

120

126instance

121instance

127 {-# OVERLAPPABLE #-}

122 {-# OVERLAPPABLE #-}

128− HasParamSchema s (ParamSchema t)

123+ HasParamSchema s ParamSchema

129− => HasItems s (Maybe (SwaggerItems t)) where

124+ => HasItems s (Maybe SwaggerItems) where

130 items = paramSchema.items

125 items = paramSchema.items

131

126

132instance

127instance

133 {-# OVERLAPPABLE #-}

128 {-# OVERLAPPABLE #-}

134− HasParamSchema s (ParamSchema t)

129+ HasParamSchema s ParamSchema

135 => HasMaximum s (Maybe Scientific) where

130 => HasMaximum s (Maybe Scientific) where

136 maximum_ = paramSchema.maximum_

131 maximum_ = paramSchema.maximum_

137

132

138−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

133+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

139 => HasExclusiveMaximum s (Maybe Bool) where

134 => HasExclusiveMaximum s (Maybe Bool) where

140 exclusiveMaximum = paramSchema.exclusiveMaximum

135 exclusiveMaximum = paramSchema.exclusiveMaximum

141

136

142−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

137+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

143 => HasMinimum s (Maybe Scientific) where

138 => HasMinimum s (Maybe Scientific) where

144 minimum_ = paramSchema.minimum_

139 minimum_ = paramSchema.minimum_

145

140

146−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

141+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

147 => HasExclusiveMinimum s (Maybe Bool) where

142 => HasExclusiveMinimum s (Maybe Bool) where

148 exclusiveMinimum = paramSchema.exclusiveMinimum

143 exclusiveMinimum = paramSchema.exclusiveMinimum

149

144

150−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

145+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

151 => HasMaxLength s (Maybe Integer) where

146 => HasMaxLength s (Maybe Integer) where

152 maxLength = paramSchema.maxLength

147 maxLength = paramSchema.maxLength

153

148

154−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

149+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

155 => HasMinLength s (Maybe Integer) where

150 => HasMinLength s (Maybe Integer) where

156 minLength = paramSchema.minLength

151 minLength = paramSchema.minLength

157

152

158−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

153+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

159 => HasPattern s (Maybe Text) where

154 => HasPattern s (Maybe Text) where

160 pattern = paramSchema.pattern

155 pattern = paramSchema.pattern

161

156

162−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

157+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

163 => HasMaxItems s (Maybe Integer) where

158 => HasMaxItems s (Maybe Integer) where

164 maxItems = paramSchema.maxItems

159 maxItems = paramSchema.maxItems

165

160

166−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

161+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

167 => HasMinItems s (Maybe Integer) where

162 => HasMinItems s (Maybe Integer) where

168 minItems = paramSchema.minItems

163 minItems = paramSchema.minItems

169

164

170−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

165+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

171 => HasUniqueItems s (Maybe Bool) where

166 => HasUniqueItems s (Maybe Bool) where

172 uniqueItems = paramSchema.uniqueItems

167 uniqueItems = paramSchema.uniqueItems

173

168

174−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

169+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

175 => HasEnum s (Maybe [Value]) where

170 => HasEnum s (Maybe [Value]) where

176 enum_ = paramSchema.enum_

171 enum_ = paramSchema.enum_

177

172

178−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

173+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

179 => HasMultipleOf s (Maybe Scientific) where

174 => HasMultipleOf s (Maybe Scientific) where

180 multipleOf = paramSchema.multipleOf

175 multipleOf = paramSchema.multipleOf

src/Data/Swagger/Optics.hs+14−133

@@ -45,15 +45,6 @@

45-- :}

46-- {"description":"To be or not to be","type":"boolean"}

47--

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−--

57-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and

48-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and

58-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:

49-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:

59--

50--

@@ -119,8 +110,8 @@ instance

119 , b ~ [Referenced Schema]

110 , b ~ [Referenced Schema]

120 ) => LabelOptic "_SwaggerItemsArray"

111 ) => LabelOptic "_SwaggerItemsArray"

121 A_Review

112 A_Review

122− (SwaggerItems 'SwaggerKindSchema)

113+ SwaggerItems

123− (SwaggerItems 'SwaggerKindSchema)

114+ SwaggerItems

124 a

115 a

125 b where

116 b where

126 labelOptic = unto (\x -> SwaggerItemsArray x)

117 labelOptic = unto (\x -> SwaggerItemsArray x)

@@ -131,25 +122,13 @@ instance

131 , b ~ Referenced Schema

122 , b ~ Referenced Schema

132 ) => LabelOptic "_SwaggerItemsObject"

123 ) => LabelOptic "_SwaggerItemsObject"

133 A_Review

124 A_Review

134− (SwaggerItems 'SwaggerKindSchema)

125+ SwaggerItems

135− (SwaggerItems 'SwaggerKindSchema)

126+ SwaggerItems

136 a

127 a

137 b where

128 b where

138 labelOptic = unto (\x -> SwaggerItemsObject x)

129 labelOptic = unto (\x -> SwaggerItemsObject x)

139 {-# INLINE labelOptic #-}

130 {-# INLINE labelOptic #-}

140

131

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−

153-- =============================================================

132-- =============================================================

154-- More helpful instances for easier access to schema properties

133-- More helpful instances for easier access to schema properties

155

134

@@ -176,8 +155,8 @@ instance At Operation where

176-- #paramSchema

155-- #paramSchema

177

156

178instance

157instance

179− ( a ~ ParamSchema 'SwaggerKindSchema

158+ ( a ~ ParamSchema

180− , b ~ ParamSchema 'SwaggerKindSchema

159+ , b ~ ParamSchema

181 ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where

160 ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where

182 labelOptic = #schema % #paramSchema

161 labelOptic = #schema % #paramSchema

183 {-# INLINE labelOptic #-}

162 {-# INLINE labelOptic #-}

@@ -185,34 +164,21 @@ instance

185-- #type

164-- #type

186

165

187instance

166instance

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)

167+ ( a ~ Maybe SwaggerType

196− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)

168+ , b ~ Maybe SwaggerType

197 ) => LabelOptic "type" A_Lens Schema Schema a b where

169 ) => LabelOptic "type" A_Lens Schema Schema a b where

198 labelOptic = #paramSchema % #type

170 labelOptic = #paramSchema % #type

199 {-# INLINE labelOptic #-}

171 {-# INLINE labelOptic #-}

200

172

201instance

173instance

202− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)

174+ ( a ~ Maybe SwaggerType

203− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)

175+ , b ~ Maybe SwaggerType

204 ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where

176 ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where

205 labelOptic = #paramSchema % #type

177 labelOptic = #paramSchema % #type

206 {-# INLINE labelOptic #-}

178 {-# INLINE labelOptic #-}

207

179

208-- #default

180-- #default

209

181

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−

216instance

182instance

217 ( a ~ Maybe Value, b ~ Maybe Value

183 ( a ~ Maybe Value, b ~ Maybe Value

218 ) => LabelOptic "default" A_Lens Schema Schema a b where

184 ) => LabelOptic "default" A_Lens Schema Schema a b where

@@ -227,12 +193,6 @@ instance

227

193

228-- #format

194-- #format

229

195

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−

236instance

196instance

237 ( a ~ Maybe Format, b ~ Maybe Format

197 ( a ~ Maybe Format, b ~ Maybe Format

238 ) => LabelOptic "format" A_Lens Schema Schema a b where

198 ) => LabelOptic "format" A_Lens Schema Schema a b where

@@ -248,34 +208,21 @@ instance

248-- #items

208-- #items

249

209

250instance

210instance

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)

211+ ( a ~ Maybe SwaggerItems

259− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)

212+ , b ~ Maybe SwaggerItems

260 ) => LabelOptic "items" A_Lens Schema Schema a b where

213 ) => LabelOptic "items" A_Lens Schema Schema a b where

261 labelOptic = #paramSchema % #items

214 labelOptic = #paramSchema % #items

262 {-# INLINE labelOptic #-}

215 {-# INLINE labelOptic #-}

263

216

264instance

217instance

265− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)

218+ ( a ~ Maybe SwaggerItems

266− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)

219+ , b ~ Maybe SwaggerItems

267 ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where

220 ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where

268 labelOptic = #paramSchema % #items

221 labelOptic = #paramSchema % #items

269 {-# INLINE labelOptic #-}

222 {-# INLINE labelOptic #-}

270

223

271-- #maximum

224-- #maximum

272

225

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−

279instance

226instance

280 ( a ~ Maybe Scientific, b ~ Maybe Scientific

227 ( a ~ Maybe Scientific, b ~ Maybe Scientific

281 ) => LabelOptic "maximum" A_Lens Schema Schema a b where

228 ) => LabelOptic "maximum" A_Lens Schema Schema a b where

@@ -290,12 +237,6 @@ instance

290

237

291-- #exclusiveMaximum

238-- #exclusiveMaximum

292

239

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−

299instance

240instance

300 ( a ~ Maybe Bool, b ~ Maybe Bool

241 ( a ~ Maybe Bool, b ~ Maybe Bool

301 ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where

242 ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where

@@ -310,12 +251,6 @@ instance

310

251

311-- #minimum

252-- #minimum

312

253

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−

319instance

254instance

320 ( a ~ Maybe Scientific, b ~ Maybe Scientific

255 ( a ~ Maybe Scientific, b ~ Maybe Scientific

321 ) => LabelOptic "minimum" A_Lens Schema Schema a b where

256 ) => LabelOptic "minimum" A_Lens Schema Schema a b where

@@ -330,12 +265,6 @@ instance

330

265

331-- #exclusiveMinimum

266-- #exclusiveMinimum

332

267

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−

339instance

268instance

340 ( a ~ Maybe Bool, b ~ Maybe Bool

269 ( a ~ Maybe Bool, b ~ Maybe Bool

341 ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where

270 ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where

@@ -350,12 +279,6 @@ instance

350

279

351-- #maxLength

280-- #maxLength

352

281

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−

359instance

282instance

360 ( a ~ Maybe Integer, b ~ Maybe Integer

283 ( a ~ Maybe Integer, b ~ Maybe Integer

361 ) => LabelOptic "maxLength" A_Lens Schema Schema a b where

284 ) => LabelOptic "maxLength" A_Lens Schema Schema a b where

@@ -370,12 +293,6 @@ instance

370

293

371-- #minLength

294-- #minLength

372

295

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−

379instance

296instance

380 ( a ~ Maybe Integer, b ~ Maybe Integer

297 ( a ~ Maybe Integer, b ~ Maybe Integer

381 ) => LabelOptic "minLength" A_Lens Schema Schema a b where

298 ) => LabelOptic "minLength" A_Lens Schema Schema a b where

@@ -390,12 +307,6 @@ instance

390

307

391-- #pattern

308-- #pattern

392

309

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−

399instance

310instance

400 ( a ~ Maybe Text, b ~ Maybe Text

311 ( a ~ Maybe Text, b ~ Maybe Text

401 ) => LabelOptic "pattern" A_Lens Schema Schema a b where

312 ) => LabelOptic "pattern" A_Lens Schema Schema a b where

@@ -410,12 +321,6 @@ instance

410

321

411-- #maxItems

322-- #maxItems

412

323

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−

419instance

324instance

420 ( a ~ Maybe Integer, b ~ Maybe Integer

325 ( a ~ Maybe Integer, b ~ Maybe Integer

421 ) => LabelOptic "maxItems" A_Lens Schema Schema a b where

326 ) => LabelOptic "maxItems" A_Lens Schema Schema a b where

@@ -430,12 +335,6 @@ instance

430

335

431-- #minItems

336-- #minItems

432

337

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−

439instance

338instance

440 ( a ~ Maybe Integer, b ~ Maybe Integer

339 ( a ~ Maybe Integer, b ~ Maybe Integer

441 ) => LabelOptic "minItems" A_Lens Schema Schema a b where

340 ) => LabelOptic "minItems" A_Lens Schema Schema a b where

@@ -450,12 +349,6 @@ instance

450

349

451-- #uniqueItems

350-- #uniqueItems

452

351

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−

459instance

352instance

460 ( a ~ Maybe Bool, b ~ Maybe Bool

353 ( a ~ Maybe Bool, b ~ Maybe Bool

461 ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where

354 ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where

@@ -470,12 +363,6 @@ instance

470

363

471-- #enum

364-- #enum

472

365

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−

479instance

366instance

480 ( a ~ Maybe [Value], b ~ Maybe [Value]

367 ( a ~ Maybe [Value], b ~ Maybe [Value]

481 ) => LabelOptic "enum" A_Lens Schema Schema a b where

368 ) => LabelOptic "enum" A_Lens Schema Schema a b where

@@ -490,12 +377,6 @@ instance

490

377

491-- #multipleOf

378-- #multipleOf

492

379

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−

499instance

380instance

500 ( a ~ Maybe Scientific, b ~ Maybe Scientific

381 ( a ~ Maybe Scientific, b ~ Maybe Scientific

501 ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where

382 ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where

test/Data/Swagger/ParamSchemaSpec.hs+1−2

@@ -13,7 +13,6 @@ import Data.Proxy

13import GHC.Generics

15import Data.Swagger

16−import Data.Swagger.Internal (SwaggerKind(..))

18import Data.Swagger.CommonTestTypes

17import Data.Swagger.CommonTestTypes

19import SpecCommon

18import SpecCommon

@@ -23,7 +22,7 @@ import Data.Time.LocalTime

23import qualified Data.HashMap.Strict as HM

22import qualified Data.HashMap.Strict as HM

25checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec

24checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec

26−checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js

25+checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema) <=> js

28spec :: Spec

27spec :: Spec

29spec = do

28spec = do