11f8f97 · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Merge ParamSchema into Schema

11f8f97Maxim Koltsov6 years ago

src/Data/Swagger.hs+2−3

compare with master

unifiedsplit

@@ -73,7 +73,6 @@ module Data.Swagger (

73 Encoding(..),

75 -- ** Schemas

76− ParamSchema(..),

77 Schema(..),

76 Schema(..),

78 NamedSchema(..),

77 NamedSchema(..),

79 SwaggerItems(..),

78 SwaggerItems(..),

@@ -220,7 +219,7 @@ import Data.Swagger.Internal

220-- & type_ ?~ SwaggerBoolean

219-- & type_ ?~ SwaggerBoolean

221-- & description ?~ "To be or not to be"

220-- & description ?~ "To be or not to be"

222-- :}

221-- :}

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

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

224--

223--

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

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

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

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

@@ -279,7 +278,7 @@ import Data.Swagger.Internal

279-- >>> BSL.putStrLn $ encode (Person "David" 28)

278-- >>> BSL.putStrLn $ encode (Person "David" 28)

280-- {"age":28,"name":"David"}

279-- {"age":28,"name":"David"}

281-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Person)

280-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Person)

282−-- {"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"type":"integer"}},"type":"object"}

281+-- {"required":["name","age"],"type":"object","properties":{"age":{"type":"integer"},"name":{"type":"string"}}}

283--

282--

284-- This package implements OpenAPI 3.0 spec, which supports @oneOf@ in schemas, allowing any sum types

283-- This package implements OpenAPI 3.0 spec, which supports @oneOf@ in schemas, allowing any sum types

285-- to be faithfully represented. All sum encodings supported by @aeson@ are supported here as well, with

284-- to be faithfully represented. All sum encodings supported by @aeson@ are supported here as well, with

src/Data/Swagger/Internal.hs+31−54

@@ -630,9 +630,33 @@ data Schema = Schema

630 , _schemaMaxProperties :: Maybe Integer

631 , _schemaMinProperties :: Maybe Integer

632

633− , _schemaParamSchema :: ParamSchema

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

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

635+ -- if not supplied by the client in the request.

636+ -- (Note: "default" has no meaning for required parameters.)

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

638+ _schemaDefault :: Maybe Value

639+

640+ , _schemaType :: Maybe SwaggerType

641+ , _schemaFormat :: Maybe Format

642+ , _schemaItems :: Maybe SwaggerItems

643+ , _schemaMaximum :: Maybe Scientific

644+ , _schemaExclusiveMaximum :: Maybe Bool

645+ , _schemaMinimum :: Maybe Scientific

646+ , _schemaExclusiveMinimum :: Maybe Bool

647+ , _schemaMaxLength :: Maybe Integer

648+ , _schemaMinLength :: Maybe Integer

649+ , _schemaPattern :: Maybe Pattern

650+ , _schemaMaxItems :: Maybe Integer

651+ , _schemaMinItems :: Maybe Integer

652+ , _schemaUniqueItems :: Maybe Bool

653+ , _schemaEnum :: Maybe [Value]

654+ , _schemaMultipleOf :: Maybe Scientific

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

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

635

656

657+-- | Regex pattern for @string@ type.

658+type Pattern = Text

659+

636data Discriminator = Discriminator

660data Discriminator = Discriminator

637 { -- | The name of the property in the payload that will hold the discriminator value.

661 { -- | The name of the property in the payload that will hold the discriminator value.

638 _discriminatorPropertyName :: Text

662 _discriminatorPropertyName :: Text

@@ -648,34 +672,6 @@ data NamedSchema = NamedSchema

648 , _namedSchemaSchema :: Schema

672 , _namedSchemaSchema :: Schema

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

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

650

674

651−-- | Regex pattern for @string@ type.

652−type Pattern = Text

653−

654−data ParamSchema = ParamSchema

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

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

657− -- if not supplied by the client in the request.

658− -- (Note: "default" has no meaning for required parameters.)

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

660− _paramSchemaDefault :: Maybe Value

661−

662− , _paramSchemaType :: Maybe SwaggerType

663− , _paramSchemaFormat :: Maybe Format

664− , _paramSchemaItems :: Maybe SwaggerItems

665− , _paramSchemaMaximum :: Maybe Scientific

666− , _paramSchemaExclusiveMaximum :: Maybe Bool

667− , _paramSchemaMinimum :: Maybe Scientific

668− , _paramSchemaExclusiveMinimum :: Maybe Bool

669− , _paramSchemaMaxLength :: Maybe Integer

670− , _paramSchemaMinLength :: Maybe Integer

671− , _paramSchemaPattern :: Maybe Pattern

672− , _paramSchemaMaxItems :: Maybe Integer

673− , _paramSchemaMinItems :: Maybe Integer

674− , _paramSchemaUniqueItems :: Maybe Bool

675− , _paramSchemaEnum :: Maybe [Value]

676− , _paramSchemaMultipleOf :: Maybe Scientific

677− } deriving (Eq, Show, Generic, Typeable, Data)

678−

679data Xml = Xml

675data Xml = Xml

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

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

681 -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.

677 -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.

@@ -934,7 +930,6 @@ deriveGeneric ''MediaTypeObject

934deriveGeneric ''Responses

930deriveGeneric ''Responses

935deriveGeneric ''SecurityScheme

931deriveGeneric ''SecurityScheme

936deriveGeneric ''Schema

932deriveGeneric ''Schema

937−deriveGeneric ''ParamSchema

938deriveGeneric ''Swagger

933deriveGeneric ''Swagger

939deriveGeneric ''Example

934deriveGeneric ''Example

940deriveGeneric ''Encoding

935deriveGeneric ''Encoding

@@ -980,12 +975,6 @@ instance Monoid Schema where

980 mempty = genericMempty

975 mempty = genericMempty

981 mappend = (<>)

976 mappend = (<>)

982

977

983−instance Semigroup ParamSchema where

984− (<>) = genericMappend

985−instance Monoid ParamSchema where

986− mempty = genericMempty

987− mappend = (<>)

988−

989instance Semigroup Param where

978instance Semigroup Param where

990 (<>) = genericMappend

979 (<>) = genericMappend

991instance Monoid Param where

980instance Monoid Param where

@@ -1080,7 +1069,6 @@ instance SwaggerMonoid Info

1080instance SwaggerMonoid Components

1069instance SwaggerMonoid Components

1081instance SwaggerMonoid PathItem

1070instance SwaggerMonoid PathItem

1082instance SwaggerMonoid Schema

1071instance SwaggerMonoid Schema

1083−instance SwaggerMonoid ParamSchema

1084instance SwaggerMonoid Param

1072instance SwaggerMonoid Param

1085instance SwaggerMonoid Responses

1073instance SwaggerMonoid Responses

1086instance SwaggerMonoid Response

1074instance SwaggerMonoid Response

@@ -1265,8 +1253,8 @@ instance ToJSON SecurityScheme where

1265 toEncoding = sopSwaggerGenericToEncoding

1253 toEncoding = sopSwaggerGenericToEncoding

1266

1254

1267instance ToJSON Schema where

1255instance ToJSON Schema where

1268− toJSON = sopSwaggerGenericToJSON

1256+ toJSON = sopSwaggerGenericToJSONWithOpts $

1269− toEncoding = sopSwaggerGenericToEncoding

1257+ mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"

1270

1258

1271instance ToJSON Header where

1259instance ToJSON Header where

1272 toJSON = sopSwaggerGenericToJSON

1260 toJSON = sopSwaggerGenericToJSON

@@ -1353,11 +1341,6 @@ instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/compone

1353instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"

1341instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"

1354instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"

1342instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"

1355

1343

1356−instance ToJSON ParamSchema where

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

1358− toJSON = sopSwaggerGenericToJSONWithOpts $

1359− mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"

1360−

1361instance ToJSON AdditionalProperties where

1344instance ToJSON AdditionalProperties where

1362 toJSON (AdditionalPropertiesAllowed b) = toJSON b

1345 toJSON (AdditionalPropertiesAllowed b) = toJSON b

1363 toJSON (AdditionalPropertiesSchema s) = toJSON s

1346 toJSON (AdditionalPropertiesSchema s) = toJSON s

@@ -1409,10 +1392,11 @@ instance FromJSON SecurityScheme where

1409instance FromJSON Schema where

1392instance FromJSON Schema where

1410 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON

1393 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON

1411 where nullaryCleanup :: Schema -> Schema

1394 where nullaryCleanup :: Schema -> Schema

1412− nullaryCleanup s@Schema{_schemaParamSchema=ps} =

1395+ nullaryCleanup s =

1413− if _paramSchemaItems ps == Just (SwaggerItemsArray [])

1396+ if _schemaItems s == Just (SwaggerItemsArray [])

1414 then s { _schemaExample = Nothing

1397 then s { _schemaExample = Nothing

1415− , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }

1398+ , _schemaMaxItems = Nothing

1399+ }

1416 else s

1400 else s

1417

1401

1418instance FromJSON Header where

1402instance FromJSON Header where

@@ -1496,9 +1480,6 @@ instance FromJSON (Referenced Callback) where parseJSON = referencedParseJSON "#

1496instance FromJSON Xml where

1480instance FromJSON Xml where

1497 parseJSON = genericParseJSON (jsonPrefix "xml")

1481 parseJSON = genericParseJSON (jsonPrefix "xml")

1498

1482

1499−instance FromJSON ParamSchema where

1500− parseJSON = sopSwaggerGenericParseJSON

1501−

1502instance FromJSON AdditionalProperties where

1483instance FromJSON AdditionalProperties where

1503 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b

1484 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b

1504 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js

1485 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js

@@ -1549,12 +1530,8 @@ instance HasSwaggerAesonOptions Encoding where

1549instance HasSwaggerAesonOptions Link where

1530instance HasSwaggerAesonOptions Link where

1550 swaggerAesonOptions _ = mkSwaggerAesonOptions "link"

1531 swaggerAesonOptions _ = mkSwaggerAesonOptions "link"

1551

1532

1552−instance HasSwaggerAesonOptions ParamSchema where

1553− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"

1554−

1555instance AesonDefaultValue Server

1533instance AesonDefaultValue Server

1556instance AesonDefaultValue Components

1534instance AesonDefaultValue Components

1557−instance AesonDefaultValue ParamSchema

1558instance AesonDefaultValue OAuth2ImplicitFlow

1535instance AesonDefaultValue OAuth2ImplicitFlow

1559instance AesonDefaultValue OAuth2PasswordFlow

1536instance AesonDefaultValue OAuth2PasswordFlow

1560instance AesonDefaultValue OAuth2ClientCredentialsFlow

1537instance AesonDefaultValue OAuth2ClientCredentialsFlow

src/Data/Swagger/Internal/ParamSchema.hs+22−16

@@ -50,25 +50,31 @@ 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

53+binarySchema :: Schema

54−binaryParamSchema = mempty

54+binarySchema = mempty

55 & type_ ?~ SwaggerString

56 & format ?~ "binary"

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

59−byteParamSchema :: ParamSchema

59+byteSchema :: Schema

60−byteParamSchema = mempty

60+byteSchema = 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

66+passwordSchema :: Schema

67−passwordParamSchema = mempty

67+passwordSchema = mempty

68 & type_ ?~ SwaggerString

69 & format ?~ "password"

71−-- | Convert a type into a plain @'ParamSchema'@.

71+-- | Convert a type into a plain @'Schema'@.

72+--

73+-- In previous versions of the package there was a separate type called @ParamSchema@, which was

74+-- included in a greater 'Schema'. Now this is a single class, but distinction for schema generators

75+-- for "simple" types is preserved.

76+--

77+-- 'ToParamSchema' is suited only for primitive-like types without nested fields and such.

72--

78--

73-- An example type and instance:

79-- An example type and instance:

74--

80--

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

108 --

114 --

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

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

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

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

111− toParamSchema :: Proxy a -> ParamSchema

117+ toParamSchema :: Proxy a -> Schema

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

118+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> Schema

113 toParamSchema = genericToParamSchema defaultSchemaOptions

119 toParamSchema = genericToParamSchema defaultSchemaOptions

114

120

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

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

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

151--

157--

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

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

153-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"

159-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"

154−toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema

160+toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema

155toParamSchemaBoundedIntegral _ = mempty

161toParamSchemaBoundedIntegral _ = mempty

156 & type_ ?~ SwaggerInteger

162 & type_ ?~ SwaggerInteger

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

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

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

181 & type_ ?~ SwaggerNumber

187 & type_ ?~ SwaggerNumber

182 & format ?~ "float"

188 & format ?~ "float"

183

189

184−timeParamSchema :: String -> ParamSchema

190+timeParamSchema :: String -> Schema

185timeParamSchema fmt = mempty

191timeParamSchema fmt = mempty

186 & type_ ?~ SwaggerString

192 & type_ ?~ SwaggerString

187 & format ?~ T.pack fmt

193 & format ?~ T.pack fmt

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

254instance ToParamSchema a => ToParamSchema [a] where

260instance ToParamSchema a => ToParamSchema [a] where

255 toParamSchema _ = mempty

261 toParamSchema _ = mempty

256 & type_ ?~ SwaggerArray

262 & type_ ?~ SwaggerArray

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

263+ & items ?~ SwaggerItemsObject (Inline $ toParamSchema (Proxy :: Proxy a))

258

264

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

265instance 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])

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

@@ -281,17 +287,17 @@ instance ToParamSchema UUID where

281 & type_ ?~ SwaggerString

287 & type_ ?~ SwaggerString

282 & format ?~ "uuid"

288 & format ?~ "uuid"

283

289

284−-- | A configurable generic @'ParamSchema'@ creator.

290+-- | A configurable generic @'Schema'@ creator.

285--

291--

286-- >>> :set -XDeriveGeneric

292-- >>> :set -XDeriveGeneric

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

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

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

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

289-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"

295-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"

290−genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema

296+genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> Schema

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

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

292

298

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

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

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

300+ gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema

295

301

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

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

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

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

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

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

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

310

316

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

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

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

318+ genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema

313

319

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

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

315 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)

321 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)

src/Data/Swagger/Internal/Schema.hs+7−26

@@ -289,25 +289,6 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

289 traverse_ usedNames (InsOrdHashMap.lookup name defs)

290 Inline subschema -> usedNames subschema

291

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

293−binarySchema :: Schema

294−binarySchema = mempty

295− & type_ ?~ SwaggerString

296− & format ?~ "binary"

297−

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

299−byteSchema :: Schema

300−byteSchema = mempty

301− & type_ ?~ SwaggerString

302− & format ?~ "byte"

303−

304−-- | Default schema for password string.

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

306−passwordSchema :: Schema

307−passwordSchema = mempty

308− & type_ ?~ SwaggerString

309− & format ?~ "password"

310−

311-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.

292-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.

312-- Produced schema can be used for further refinement.

293-- Produced schema can be used for further refinement.

313--

294--

@@ -323,7 +304,7 @@ passwordSchema = mempty

323-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)

304-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)

324-- >>> instance ToJSON Person

305-- >>> instance ToJSON Person

325-- >>> BSL.putStrLn $ encode $ sketchSchema (Person "Jack" 25)

306-- >>> BSL.putStrLn $ encode $ sketchSchema (Person "Jack" 25)

326−-- {"required":["age","name"],"properties":{"age":{"type":"number"},"name":{"type":"string"}},"example":{"age":25,"name":"Jack"},"type":"object"}

307+-- {"example":{"age":25,"name":"Jack"},"required":["age","name"],"type":"object","properties":{"age":{"type":"number"},"name":{"type":"string"}}}

327sketchSchema :: ToJSON a => a -> Schema

308sketchSchema :: ToJSON a => a -> Schema

328sketchSchema = sketch . toJSON

309sketchSchema = sketch . toJSON

329 where

310 where

@@ -367,7 +348,7 @@ sketchSchema = sketch . toJSON

367-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)

348-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)

368-- >>> instance ToJSON Person

349-- >>> instance ToJSON Person

369-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (Person "Jack" 25)

350-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (Person "Jack" 25)

370−-- {"required":["age","name"],"properties":{"age":{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]},"name":{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]}},"maxProperties":2,"minProperties":2,"type":"object","enum":[{"age":25,"name":"Jack"}]}

351+-- {"minProperties":2,"required":["age","name"],"maxProperties":2,"type":"object","enum":[{"age":25,"name":"Jack"}],"properties":{"age":{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]},"name":{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]}}}

371sketchStrictSchema :: ToJSON a => a -> Schema

352sketchStrictSchema :: ToJSON a => a -> Schema

372sketchStrictSchema = go . toJSON

353sketchStrictSchema = go . toJSON

373 where

354 where

@@ -603,7 +584,7 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>

603-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)

584-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)

604-- >>> type ImageUrl = T.Text

585-- >>> type ImageUrl = T.Text

605-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))

586-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))

606−-- {"properties":{"Neutral":{"type":"string"},"Focus":{"type":"string"},"Active":{"type":"string"},"Hover":{"type":"string"},"Disabled":{"type":"string"}},"type":"object"}

587+-- {"type":"object","properties":{"Focus":{"type":"string"},"Disabled":{"type":"string"},"Active":{"type":"string"},"Neutral":{"type":"string"},"Hover":{"type":"string"}}}

607--

588--

608-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

589-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

609-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

590-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

@@ -631,7 +612,7 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o

631-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)

612-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)

632-- >>> type ImageUrl = T.Text

613-- >>> type ImageUrl = T.Text

633-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))

614-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))

634−-- {"properties":{"Neutral":{"type":"string"},"Focus":{"type":"string"},"Active":{"type":"string"},"Hover":{"type":"string"},"Disabled":{"type":"string"}},"type":"object"}

615+-- {"type":"object","properties":{"Focus":{"type":"string"},"Disabled":{"type":"string"},"Active":{"type":"string"},"Neutral":{"type":"string"},"Hover":{"type":"string"}}}

635--

616--

636-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

617-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

637-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

618-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

@@ -667,14 +648,14 @@ gdatatypeSchemaName opts _ = case orig of

667 orig = datatypeName (Proxy3 :: Proxy3 d f a)

648 orig = datatypeName (Proxy3 :: Proxy3 d f a)

668 name = datatypeNameModifier opts orig

649 name = datatypeNameModifier opts orig

669

650

670−-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.

651+-- | Construct 'NamedSchema' usinng 'ToParamSchema'.

671paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>

652paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>

672 SchemaOptions -> Proxy a -> NamedSchema

653 SchemaOptions -> Proxy a -> NamedSchema

673paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)

654paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)

674

655

675−-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.

656+-- | Construct 'Schema' usinng 'ToParamSchema'.

676paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema

657paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema

677−paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy

658+paramSchemaToSchema = toParamSchema

678

659

679nullarySchema :: Schema

660nullarySchema :: Schema

680nullarySchema = mempty

661nullarySchema = mempty

src/Data/Swagger/Internal/Schema/Validation.hs+16−22

@@ -205,7 +205,7 @@ instance Monad Result where

205

206-- | Validation configuration.

207data Config = Config

208− { -- | Pattern checker for @'_paramSchemaPattern'@ validation.

208+ { -- | Pattern checker for @'_schemaPattern'@ validation.

209 configPatternChecker :: Pattern -> Text -> Bool

210 -- | Schema definitions in scope to resolve references.

211 , configDefinitions :: Definitions Schema

@@ -300,21 +300,15 @@ validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js)

300validateWithSchema :: Value -> Validation Schema ()

301validateWithSchema val = do

302 validateSchemaType val

303− sub_ paramSchema $ validateEnum val

304−

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

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

307−validateWithParamSchema val = do

308− validateParamSchemaType val

309 validateEnum val

303 validateEnum val

310

304

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

305+validateInteger :: Scientific -> Validation Schema ()

312validateInteger n = do

306validateInteger n = do

313 when (not (isInteger n)) $

307 when (not (isInteger n)) $

314 invalid ("not an integer")

308 invalid ("not an integer")

315 validateNumber n

309 validateNumber n

316

310

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

311+validateNumber :: Scientific -> Validation Schema ()

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

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

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

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

320 exMin = Just True == sch ^. exclusiveMinimum

314 exMin = Just True == sch ^. exclusiveMinimum

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

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

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

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

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

333

327

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

328+validateString :: Text -> Validation Schema ()

335validateString s = do

329validateString s = do

336 check maxLength $ \n ->

330 check maxLength $ \n ->

337 when (len > fromInteger n) $

331 when (len > fromInteger n) $

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

348 where

342 where

349 len = Text.length s

343 len = Text.length s

350

344

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

345+validateArray :: Vector Value -> Validation Schema ()

352validateArray xs = do

346validateArray xs = do

353 check maxItems $ \n ->

347 check maxItems $ \n ->

354 when (len > fromInteger n) $

348 when (len > fromInteger n) $

@@ -418,7 +412,7 @@ validateObject o = withSchema $ \sch ->

418 unknownProperty pname = invalid $

412 unknownProperty pname = invalid $

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

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

420

414

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

415+validateEnum :: Value -> Validation Schema ()

422validateEnum val = do

416validateEnum val = do

423 check enum_ $ \xs ->

417 check enum_ $ \xs ->

424 when (val `notElem` xs) $

418 when (val `notElem` xs) $

@@ -431,7 +425,7 @@ validateEnum val = do

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

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

432-- Just [SwaggerObject]

426-- Just [SwaggerObject]

433inferSchemaTypes :: Schema -> [SwaggerType]

427inferSchemaTypes :: Schema -> [SwaggerType]

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

428+inferSchemaTypes sch = inferParamSchemaTypes sch ++

435 [ SwaggerObject | any ($ sch)

429 [ SwaggerObject | any ($ sch)

436 [ has (additionalProperties._Just)

430 [ has (additionalProperties._Just)

437 , has (maxProperties._Just)

431 , has (maxProperties._Just)

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

452--

446--

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

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

454-- Just [SwaggerInteger]

448-- Just [SwaggerInteger]

455−inferParamSchemaTypes :: ParamSchema -> [SwaggerType]

449+inferParamSchemaTypes :: Schema -> [SwaggerType]

456inferParamSchemaTypes sch = concat

450inferParamSchemaTypes sch = concat

457 [ [ SwaggerArray | any ($ sch)

451 [ [ SwaggerArray | any ($ sch)

458 [ has (items._Just)

452 [ has (items._Just)

@@ -491,21 +485,21 @@ validateSchemaType val = withSchema $ \sch ->

491 case (sch ^. type_, val) of

485 case (sch ^. type_, val) of

492 (Just SwaggerNull, Null) -> valid

486 (Just SwaggerNull, Null) -> valid

493 (Just SwaggerBoolean, Bool _) -> valid

487 (Just SwaggerBoolean, Bool _) -> valid

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

488+ (Just SwaggerInteger, Number n) -> validateInteger n

495− (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)

489+ (Just SwaggerNumber, Number n) -> validateNumber n

496− (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)

490+ (Just SwaggerString, String s) -> validateString s

497− (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)

491+ (Just SwaggerArray, Array xs) -> validateArray xs

498 (Just SwaggerObject, Object o) -> validateObject o

492 (Just SwaggerObject, Object o) -> validateObject o

499 (Nothing, Null) -> valid

493 (Nothing, Null) -> valid

500 (Nothing, Bool _) -> valid

494 (Nothing, Bool _) -> valid

501 -- Number by default

495 -- Number by default

502− (Nothing, Number n) -> sub_ paramSchema (validateNumber n)

496+ (Nothing, Number n) -> validateNumber n

503− (Nothing, String s) -> sub_ paramSchema (validateString s)

497+ (Nothing, String s) -> validateString s

504− (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)

498+ (Nothing, Array xs) -> validateArray xs

505 (Nothing, Object o) -> validateObject o

499 (Nothing, Object o) -> validateObject o

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

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

507

501

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

502+validateParamSchemaType :: Value -> Validation Schema ()

509validateParamSchemaType val = withSchema $ \sch ->

503validateParamSchemaType val = withSchema $ \sch ->

510 case (sch ^. type_, val) of

504 case (sch ^. type_, val) of

511 (Just SwaggerBoolean, Bool _) -> valid

505 (Just SwaggerBoolean, Bool _) -> valid

src/Data/Swagger/Lens.hs+29−39

@@ -29,8 +29,6 @@ import Data.Text (Text)

29makeFields ''Swagger

30makeFields ''Components

31makeFields ''Server

32−-- conflict with enum of ParamSchema

33−--makeLensesWith swaggerFieldRules ''ServerVariable

34makeFields ''RequestBody

32makeFields ''RequestBody

35makeFields ''MediaTypeObject

33makeFields ''MediaTypeObject

36makeFields ''Info

34makeFields ''Info

@@ -43,7 +41,6 @@ makeLensesWith swaggerFieldRules ''Param

43makeFields ''Header

41makeFields ''Header

44makeLensesWith swaggerFieldRules ''Schema

42makeLensesWith swaggerFieldRules ''Schema

45makeFields ''NamedSchema

43makeFields ''NamedSchema

46−makeLensesWith swaggerFieldRules ''ParamSchema

47makeFields ''Xml

44makeFields ''Xml

48makeLensesWith swaggerFieldRules ''Responses

45makeLensesWith swaggerFieldRules ''Responses

49makeFields ''Response

46makeFields ''Response

@@ -102,75 +99,68 @@ instance At Responses where at n = responses . at n

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

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

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

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

104

101

105−instance HasParamSchema NamedSchema ParamSchema where paramSchema = schema.paramSchema

102+instance HasType NamedSchema (Maybe SwaggerType) where type_ = schema.type_

106−

107−-- HasType instances

108−instance HasType Schema (Maybe SwaggerType) where type_ = paramSchema.type_

109−instance HasType NamedSchema (Maybe SwaggerType) where type_ = paramSchema.type_

110−

111−-- HasDefault instances

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

113

103

114-- OVERLAPPABLE instances

104-- OVERLAPPABLE instances

115

105

116instance

106instance

117 {-# OVERLAPPABLE #-}

107 {-# OVERLAPPABLE #-}

118− HasParamSchema s ParamSchema

108+ HasSchema s Schema

119 => HasFormat s (Maybe Format) where

109 => HasFormat s (Maybe Format) where

120− format = paramSchema.format

110+ format = schema.format

121

111

122instance

112instance

123 {-# OVERLAPPABLE #-}

113 {-# OVERLAPPABLE #-}

124− HasParamSchema s ParamSchema

114+ HasSchema s Schema

125 => HasItems s (Maybe SwaggerItems) where

115 => HasItems s (Maybe SwaggerItems) where

126− items = paramSchema.items

116+ items = schema.items

127

117

128instance

118instance

129 {-# OVERLAPPABLE #-}

119 {-# OVERLAPPABLE #-}

130− HasParamSchema s ParamSchema

120+ HasSchema s Schema

131 => HasMaximum s (Maybe Scientific) where

121 => HasMaximum s (Maybe Scientific) where

132− maximum_ = paramSchema.maximum_

122+ maximum_ = schema.maximum_

133

123

134−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

124+instance {-# OVERLAPPABLE #-} HasSchema s Schema

135 => HasExclusiveMaximum s (Maybe Bool) where

125 => HasExclusiveMaximum s (Maybe Bool) where

136− exclusiveMaximum = paramSchema.exclusiveMaximum

126+ exclusiveMaximum = schema.exclusiveMaximum

137

127

138−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

128+instance {-# OVERLAPPABLE #-} HasSchema s Schema

139 => HasMinimum s (Maybe Scientific) where

129 => HasMinimum s (Maybe Scientific) where

140− minimum_ = paramSchema.minimum_

130+ minimum_ = schema.minimum_

141

131

142−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

132+instance {-# OVERLAPPABLE #-} HasSchema s Schema

143 => HasExclusiveMinimum s (Maybe Bool) where

133 => HasExclusiveMinimum s (Maybe Bool) where

144− exclusiveMinimum = paramSchema.exclusiveMinimum

134+ exclusiveMinimum = schema.exclusiveMinimum

145

135

146−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

136+instance {-# OVERLAPPABLE #-} HasSchema s Schema

147 => HasMaxLength s (Maybe Integer) where

137 => HasMaxLength s (Maybe Integer) where

148− maxLength = paramSchema.maxLength

138+ maxLength = schema.maxLength

149

139

150−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

140+instance {-# OVERLAPPABLE #-} HasSchema s Schema

151 => HasMinLength s (Maybe Integer) where

141 => HasMinLength s (Maybe Integer) where

152− minLength = paramSchema.minLength

142+ minLength = schema.minLength

153

143

154−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

144+instance {-# OVERLAPPABLE #-} HasSchema s Schema

155 => HasPattern s (Maybe Text) where

145 => HasPattern s (Maybe Text) where

156− pattern = paramSchema.pattern

146+ pattern = schema.pattern

157

147

158−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

148+instance {-# OVERLAPPABLE #-} HasSchema s Schema

159 => HasMaxItems s (Maybe Integer) where

149 => HasMaxItems s (Maybe Integer) where

160− maxItems = paramSchema.maxItems

150+ maxItems = schema.maxItems

161

151

162−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

152+instance {-# OVERLAPPABLE #-} HasSchema s Schema

163 => HasMinItems s (Maybe Integer) where

153 => HasMinItems s (Maybe Integer) where

164− minItems = paramSchema.minItems

154+ minItems = schema.minItems

165

155

166−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

156+instance {-# OVERLAPPABLE #-} HasSchema s Schema

167 => HasUniqueItems s (Maybe Bool) where

157 => HasUniqueItems s (Maybe Bool) where

168− uniqueItems = paramSchema.uniqueItems

158+ uniqueItems = schema.uniqueItems

169

159

170−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

160+instance {-# OVERLAPPABLE #-} HasSchema s Schema

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

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

172− enum_ = paramSchema.enum_

162+ enum_ = schema.enum_

173

163

174−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

164+instance {-# OVERLAPPABLE #-} HasSchema s Schema

175 => HasMultipleOf s (Maybe Scientific) where

165 => HasMultipleOf s (Maybe Scientific) where

176− multipleOf = paramSchema.multipleOf

166+ multipleOf = schema.multipleOf

src/Data/Swagger/Optics.hs+17−125

@@ -43,7 +43,7 @@

43-- & #type ?~ SwaggerBoolean

44-- & #description ?~ "To be or not to be"

45-- :}

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

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

47--

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

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

@@ -81,7 +81,6 @@ makeFieldLabels ''Param

81makeFieldLabels ''Header

82makeFieldLabels ''Schema

83makeFieldLabels ''NamedSchema

84−makeFieldLabels ''ParamSchema

85makeFieldLabels ''Xml

84makeFieldLabels ''Xml

86makeFieldLabels ''Responses

85makeFieldLabels ''Responses

87makeFieldLabels ''Response

86makeFieldLabels ''Response

@@ -153,239 +152,132 @@ instance At Operation where

153 at n = #responses % at n

152 at n = #responses % at n

154 {-# INLINE at #-}

153 {-# INLINE at #-}

155

154

156−-- #paramSchema

157−

158−instance

159− ( a ~ ParamSchema

160− , b ~ ParamSchema

161− ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where

162− labelOptic = #schema % #paramSchema

163− {-# INLINE labelOptic #-}

164−

165-- #type

155-- #type

166

156

167−instance

168− ( a ~ Maybe SwaggerType

169− , b ~ Maybe SwaggerType

170− ) => LabelOptic "type" A_Lens Schema Schema a b where

171− labelOptic = #paramSchema % #type

172− {-# INLINE labelOptic #-}

173−

174instance

157instance

175 ( a ~ Maybe SwaggerType

158 ( a ~ Maybe SwaggerType

176 , b ~ Maybe SwaggerType

159 , b ~ Maybe SwaggerType

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

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

178− labelOptic = #paramSchema % #type

161+ labelOptic = #schema % #type

179 {-# INLINE labelOptic #-}

162 {-# INLINE labelOptic #-}

180

163

181-- #default

164-- #default

182

165

183−instance

184− ( a ~ Maybe Value, b ~ Maybe Value

185− ) => LabelOptic "default" A_Lens Schema Schema a b where

186− labelOptic = #paramSchema % #default

187− {-# INLINE labelOptic #-}

188−

189instance

166instance

190 ( a ~ Maybe Value, b ~ Maybe Value

167 ( a ~ Maybe Value, b ~ Maybe Value

191 ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where

168 ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where

192− labelOptic = #paramSchema % #default

169+ labelOptic = #schema % #default

193 {-# INLINE labelOptic #-}

170 {-# INLINE labelOptic #-}

194

171

195-- #format

172-- #format

196

173

197−instance

198− ( a ~ Maybe Format, b ~ Maybe Format

199− ) => LabelOptic "format" A_Lens Schema Schema a b where

200− labelOptic = #paramSchema % #format

201− {-# INLINE labelOptic #-}

202−

203instance

174instance

204 ( a ~ Maybe Format, b ~ Maybe Format

175 ( a ~ Maybe Format, b ~ Maybe Format

205 ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where

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

206− labelOptic = #paramSchema % #format

177+ labelOptic = #schema % #format

207 {-# INLINE labelOptic #-}

178 {-# INLINE labelOptic #-}

208

179

209-- #items

180-- #items

210

181

211−instance

212− ( a ~ Maybe SwaggerItems

213− , b ~ Maybe SwaggerItems

214− ) => LabelOptic "items" A_Lens Schema Schema a b where

215− labelOptic = #paramSchema % #items

216− {-# INLINE labelOptic #-}

217−

218instance

182instance

219 ( a ~ Maybe SwaggerItems

183 ( a ~ Maybe SwaggerItems

220 , b ~ Maybe SwaggerItems

184 , b ~ Maybe SwaggerItems

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

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

222− labelOptic = #paramSchema % #items

186+ labelOptic = #schema % #items

223 {-# INLINE labelOptic #-}

187 {-# INLINE labelOptic #-}

224

188

225-- #maximum

189-- #maximum

226

190

227−instance

228− ( a ~ Maybe Scientific, b ~ Maybe Scientific

229− ) => LabelOptic "maximum" A_Lens Schema Schema a b where

230− labelOptic = #paramSchema % #maximum

231− {-# INLINE labelOptic #-}

232−

233instance

191instance

234 ( a ~ Maybe Scientific, b ~ Maybe Scientific

192 ( a ~ Maybe Scientific, b ~ Maybe Scientific

235 ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where

193 ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where

236− labelOptic = #paramSchema % #maximum

194+ labelOptic = #schema % #maximum

237 {-# INLINE labelOptic #-}

195 {-# INLINE labelOptic #-}

238

196

239-- #exclusiveMaximum

197-- #exclusiveMaximum

240

198

241−instance

242− ( a ~ Maybe Bool, b ~ Maybe Bool

243− ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where

244− labelOptic = #paramSchema % #exclusiveMaximum

245− {-# INLINE labelOptic #-}

246−

247instance

199instance

248 ( a ~ Maybe Bool, b ~ Maybe Bool

200 ( a ~ Maybe Bool, b ~ Maybe Bool

249 ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where

201 ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where

250− labelOptic = #paramSchema % #exclusiveMaximum

202+ labelOptic = #schema % #exclusiveMaximum

251 {-# INLINE labelOptic #-}

203 {-# INLINE labelOptic #-}

252

204

253-- #minimum

205-- #minimum

254

206

255−instance

256− ( a ~ Maybe Scientific, b ~ Maybe Scientific

257− ) => LabelOptic "minimum" A_Lens Schema Schema a b where

258− labelOptic = #paramSchema % #minimum

259− {-# INLINE labelOptic #-}

260−

261instance

207instance

262 ( a ~ Maybe Scientific, b ~ Maybe Scientific

208 ( a ~ Maybe Scientific, b ~ Maybe Scientific

263 ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where

209 ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where

264− labelOptic = #paramSchema % #minimum

210+ labelOptic = #schema % #minimum

265 {-# INLINE labelOptic #-}

211 {-# INLINE labelOptic #-}

266

212

267-- #exclusiveMinimum

213-- #exclusiveMinimum

268

214

269−instance

270− ( a ~ Maybe Bool, b ~ Maybe Bool

271− ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where

272− labelOptic = #paramSchema % #exclusiveMinimum

273− {-# INLINE labelOptic #-}

274−

275instance

215instance

276 ( a ~ Maybe Bool, b ~ Maybe Bool

216 ( a ~ Maybe Bool, b ~ Maybe Bool

277 ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where

217 ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where

278− labelOptic = #paramSchema % #exclusiveMinimum

218+ labelOptic = #schema % #exclusiveMinimum

279 {-# INLINE labelOptic #-}

219 {-# INLINE labelOptic #-}

280

220

281-- #maxLength

221-- #maxLength

282

222

283−instance

284− ( a ~ Maybe Integer, b ~ Maybe Integer

285− ) => LabelOptic "maxLength" A_Lens Schema Schema a b where

286− labelOptic = #paramSchema % #maxLength

287− {-# INLINE labelOptic #-}

288−

289instance

223instance

290 ( a ~ Maybe Integer, b ~ Maybe Integer

224 ( a ~ Maybe Integer, b ~ Maybe Integer

291 ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where

225 ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where

292− labelOptic = #paramSchema % #maxLength

226+ labelOptic = #schema % #maxLength

293 {-# INLINE labelOptic #-}

227 {-# INLINE labelOptic #-}

294

228

295-- #minLength

229-- #minLength

296

230

297−instance

298− ( a ~ Maybe Integer, b ~ Maybe Integer

299− ) => LabelOptic "minLength" A_Lens Schema Schema a b where

300− labelOptic = #paramSchema % #minLength

301− {-# INLINE labelOptic #-}

302−

303instance

231instance

304 ( a ~ Maybe Integer, b ~ Maybe Integer

232 ( a ~ Maybe Integer, b ~ Maybe Integer

305 ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where

233 ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where

306− labelOptic = #paramSchema % #minLength

234+ labelOptic = #schema % #minLength

307 {-# INLINE labelOptic #-}

235 {-# INLINE labelOptic #-}

308

236

309-- #pattern

237-- #pattern

310

238

311−instance

312− ( a ~ Maybe Text, b ~ Maybe Text

313− ) => LabelOptic "pattern" A_Lens Schema Schema a b where

314− labelOptic = #paramSchema % #pattern

315− {-# INLINE labelOptic #-}

316−

317instance

239instance

318 ( a ~ Maybe Text, b ~ Maybe Text

240 ( a ~ Maybe Text, b ~ Maybe Text

319 ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where

241 ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where

320− labelOptic = #paramSchema % #pattern

242+ labelOptic = #schema % #pattern

321 {-# INLINE labelOptic #-}

243 {-# INLINE labelOptic #-}

322

244

323-- #maxItems

245-- #maxItems

324

246

325−instance

326− ( a ~ Maybe Integer, b ~ Maybe Integer

327− ) => LabelOptic "maxItems" A_Lens Schema Schema a b where

328− labelOptic = #paramSchema % #maxItems

329− {-# INLINE labelOptic #-}

330−

331instance

247instance

332 ( a ~ Maybe Integer, b ~ Maybe Integer

248 ( a ~ Maybe Integer, b ~ Maybe Integer

333 ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where

249 ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where

334− labelOptic = #paramSchema % #maxItems

250+ labelOptic = #schema % #maxItems

335 {-# INLINE labelOptic #-}

251 {-# INLINE labelOptic #-}

336

252

337-- #minItems

253-- #minItems

338

254

339−instance

340− ( a ~ Maybe Integer, b ~ Maybe Integer

341− ) => LabelOptic "minItems" A_Lens Schema Schema a b where

342− labelOptic = #paramSchema % #minItems

343− {-# INLINE labelOptic #-}

344−

345instance

255instance

346 ( a ~ Maybe Integer, b ~ Maybe Integer

256 ( a ~ Maybe Integer, b ~ Maybe Integer

347 ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where

257 ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where

348− labelOptic = #paramSchema % #minItems

258+ labelOptic = #schema % #minItems

349 {-# INLINE labelOptic #-}

259 {-# INLINE labelOptic #-}

350

260

351-- #uniqueItems

261-- #uniqueItems

352

262

353−instance

354− ( a ~ Maybe Bool, b ~ Maybe Bool

355− ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where

356− labelOptic = #paramSchema % #uniqueItems

357− {-# INLINE labelOptic #-}

358−

359instance

263instance

360 ( a ~ Maybe Bool, b ~ Maybe Bool

264 ( a ~ Maybe Bool, b ~ Maybe Bool

361 ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where

265 ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where

362− labelOptic = #paramSchema % #uniqueItems

266+ labelOptic = #schema % #uniqueItems

363 {-# INLINE labelOptic #-}

267 {-# INLINE labelOptic #-}

364

268

365-- #enum

269-- #enum

366

270

367−instance

368− ( a ~ Maybe [Value], b ~ Maybe [Value]

369− ) => LabelOptic "enum" A_Lens Schema Schema a b where

370− labelOptic = #paramSchema % #enum

371− {-# INLINE labelOptic #-}

372−

373instance

271instance

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

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

375 ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where

273 ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where

376− labelOptic = #paramSchema % #enum

274+ labelOptic = #schema % #enum

377 {-# INLINE labelOptic #-}

275 {-# INLINE labelOptic #-}

378

276

379-- #multipleOf

277-- #multipleOf

380

278

381−instance

382− ( a ~ Maybe Scientific, b ~ Maybe Scientific

383− ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where

384− labelOptic = #paramSchema % #multipleOf

385− {-# INLINE labelOptic #-}

386−

387instance

279instance

388 ( a ~ Maybe Scientific, b ~ Maybe Scientific

280 ( a ~ Maybe Scientific, b ~ Maybe Scientific

389 ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where

281 ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where

390− labelOptic = #paramSchema % #multipleOf

282+ labelOptic = #schema % #multipleOf

391 {-# INLINE labelOptic #-}

283 {-# INLINE labelOptic #-}

src/Data/Swagger/ParamSchema.hs+3−3

@@ -13,9 +13,9 @@ module Data.Swagger.ParamSchema (

13 toParamSchemaBoundedIntegral,

15 -- * Schema templates

16− passwordParamSchema,

16+ passwordSchema,

17− binaryParamSchema,

17+ binarySchema,

18− byteParamSchema,

18+ byteSchema,

20 -- * Generic encoding configuration

21 SchemaOptions(..),

src/Data/Swagger/Schema.hs−5

@@ -32,11 +32,6 @@ module Data.Swagger.Schema (

32 paramSchemaToNamedSchema,

33 paramSchemaToSchema,

35− -- * Schema templates

36− passwordSchema,

37− binarySchema,

38− byteSchema,

39−

40 -- * Sketching @'Schema'@s using @'ToJSON'@

35 -- * Sketching @'Schema'@s using @'ToJSON'@

41 sketchSchema,

36 sketchSchema,

42 sketchStrictSchema,

37 sketchStrictSchema,

src/Data/Swagger/Schema/Generator.hs+1−1

@@ -29,7 +29,7 @@ import Test.QuickCheck.Property

29-- and cannot be inferred.

30schemaGen :: Definitions Schema -> Schema -> Gen Value

31schemaGen _ schema

32− | Just cases <- schema ^. paramSchema . enum_ = elements cases

32+ | Just cases <- schema ^. enum_ = elements cases

33schemaGen defns schema

34 | Just variants <- schema ^. oneOf = schemaGen defns =<< elements (dereference defns <$> variants)

35schemaGen defns schema =

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

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

22import qualified Data.HashMap.Strict as HM

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

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

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

27spec :: Spec

28spec = do