0ccfe21 · typeable/swagger2

git.iko.soy/typeable/swagger2

on master help sign in

Fix #138 schema type becomes optional

0ccfe21Andrey Prokopenko8 years ago

examples/hackage.hs+1−1

compare with master

unifiedsplit

@@ -27,7 +27,7 @@ instance ToSchema UserSummary where

27 usernameSchema <- declareSchemaRef (Proxy :: Proxy Username)

28 useridSchema <- declareSchemaRef (Proxy :: Proxy Int)

29 return $ NamedSchema (Just "UserSummary") $ mempty

30− & type_ .~ SwaggerObject

30+ & type_ ?~ SwaggerObject

31 & properties .~

32 [ ("summaryUsername", usernameSchema )

33 , ("summaryUserid" , useridSchema )

src/Data/Swagger/Internal.hs+1−1

@@ -610,7 +610,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema

610 , _paramSchemaMultipleOf :: Maybe Scientific

611 } deriving (Eq, Show, Generic, Typeable)

612

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

613+deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)

614

615data Xml = Xml

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

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

@@ -335,7 +335,7 @@ sketchSchema = sketch . toJSON

335

336 go Null = mempty & type_ ?~ SwaggerNull

337 go (Bool _) = mempty & type_ ?~ SwaggerBoolean

338− go (String _) = mempty & type_ ?~ SwaggerString

338+ go (String _) = mempty & type_ ?~ SwaggerString

339 go (Number _) = mempty & type_ ?~ SwaggerNumber

340 go (Array xs) = mempty

341 & type_ ?~ SwaggerArray

src/Data/Swagger/Internal/Schema/Validation.hs+38−39

@@ -382,45 +382,44 @@ inferParamSchemaTypes sch = concat

382

383validateSchemaType :: Value -> Validation Schema ()

384validateSchemaType value = withSchema $ \sch ->

385− case sch ^. type_ of

385+ case (sch ^. type_, value) of

386− Just explicitType -> validateSchemaTypeAs explicitType value

387− Nothing ->

388− case inferSchemaTypes sch of

389− [t] -> validateSchemaTypeAs t value

390− [] -> invalid $ "unable to infer type for schema, please provide type explicitly"

391− ts -> invalid $ "unable to infer type for schema, possible candidates: " ++ intercalate ", " (map show ts)

392−

393−validateSchemaTypeAs

394− :: SwaggerType 'SwaggerKindSchema -> Value -> Validation Schema ()

395−validateSchemaTypeAs t value =

396− case (t, value) of

397− (SwaggerNull, Null) -> valid

386+ (Just SwaggerNull, Null) -> valid

398− (SwaggerBoolean, Bool _) -> valid

387+ (Just SwaggerBoolean, Bool _) -> valid

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

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

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

389+ (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)

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

390+ (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)

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

391+ (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)

403− (SwaggerObject, Object o) -> validateObject o

392+ (Just SwaggerObject, Object o) -> validateObject o

393+ (Nothing, Null) -> valid

394+ (Nothing, Bool _) -> valid

395+ -- Number by default

396+ (Nothing, Number n) -> sub_ paramSchema (validateNumber n)

397+ (Nothing, String s) -> sub_ paramSchema (validateString s)

398+ (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)

399+ (Nothing, Object o) -> validateObject o

404− _ -> invalid $ "expected JSON value of type " ++ show t

400+ param@(t, _) -> invalid $ "expected JSON value of type " ++ showType param

405

401

406validateParamSchemaType :: Value -> Validation (ParamSchema t) ()

402validateParamSchemaType :: Value -> Validation (ParamSchema t) ()

407validateParamSchemaType value = withSchema $ \sch ->

403validateParamSchemaType value = withSchema $ \sch ->

408− case sch ^. type_ of

404+ case (sch ^. type_, value) of

409− Just explicitType -> validateParamSchemaTypeAs explicitType value

405+ (Just SwaggerBoolean, Bool _) -> valid

410− Nothing ->

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

411− case inferParamSchemaTypes sch of

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

412− [t] -> validateParamSchemaTypeAs t value

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

413− [] -> invalid $ "unable to infer type for schema, please provide type explicitly"

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

414− ts -> invalid $ "unable to infer type for schema, possible candidates: " ++ intercalate ", " (map show ts)

410+ (Nothing, Bool _) -> valid

415−

411+ -- Number by default

416−validateParamSchemaTypeAs

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

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

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

415+ (t, _) -> invalid $ "expected JSON value of type " ++ show t

416+ param@(t, _) -> invalid $ "expected JSON value of type " ++ showType param

417+

417− :: SwaggerType t -> Value -> Validation (ParamSchema t) ()

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

418−validateParamSchemaTypeAs t value =

419+showType (Just type_, _) = show type_

419− case (t, value) of

420+showType (Nothing, Null) = "SwaggerNull"

420− (SwaggerBoolean, Bool _) -> valid

421+showType (Nothing, Bool _) = "SwaggerBoolean"

421− (SwaggerInteger, Number n) -> validateInteger n

422+showType (Nothing, Number _) = "SwaggerNumber"

422− (SwaggerNumber, Number n) -> validateNumber n

423+showType (Nothing, String _) = "SwaggerString"

423− (SwaggerString, String s) -> validateString s

424+showType (Nothing, Array _) = "SwaggerArray"

424− (SwaggerArray, Array xs) -> validateArray xs

425+showType (Nothing, Object _) = "SwaggerObject"

425− _ -> invalid $ "expected JSON value of type " ++ show t

426−