ba83080 · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Merge pull request #36 from GetShopTV/unit-#35

ba83080Nickolay Kudasov11 years ago

CHANGELOG.md+9

compare with master

unifiedsplit

@@ -1,3 +1,12 @@

1+* Minor changes:

2+ * Change default `ToSchema` instance for unit data types (i.e. types with one nullable constructor like `data Unit = Unit`):

3+ now these types are treated like sum types with only one alternative;

4+ * Add generic `ToParamSchema` instance for unit data types;

5+ * Add `items: []` to schema for `()` (making it a valid schema).

7+* Fixes:

8+ * `items: []` is not omitted from `Schema` JSON.

11.1.1

101.1.1

2---

11---

3* Fixes:

12* Fixes:

src/Data/Swagger/Internal.hs+8−2

@@ -906,7 +906,10 @@ instance ToJSON SecurityScheme where

906 toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")

907

908instance ToJSON Schema where

909− toJSON = omitEmpties . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")

909+ toJSON = omitEmptiesExcept f . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")

910+ where

911+ f "items" (Array _) = True

912+ f _ _ = False

910

913

911instance ToJSON Header where

914instance ToJSON Header where

912 toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")

915 toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")

@@ -985,7 +988,10 @@ instance ToJSON (CollectionFormat t) where

985 toJSON CollectionMulti = "multi"

988 toJSON CollectionMulti = "multi"

986

989

987instance ToJSON (ParamSchema t) where

990instance ToJSON (ParamSchema t) where

988− toJSON = omitEmpties . genericToJSONWithSub "items" (jsonPrefix "paramSchema")

991+ toJSON = omitEmptiesExcept f . genericToJSONWithSub "items" (jsonPrefix "paramSchema")

992+ where

993+ f "items" (Array _) = True

994+ f _ _ = False

989

995

990-- =======================================================================

996-- =======================================================================

991-- Manual FromJSON instances

997-- Manual FromJSON instances

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

@@ -206,6 +206,9 @@ class GToParamSchema (f :: * -> *) where

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

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

208

209+instance Constructor c => GToParamSchema (C1 c U1) where

210+ gtoParamSchema = genumParamSchema

211+

209instance GToParamSchema f => GToParamSchema (C1 c (S1 s f)) where

212instance GToParamSchema f => GToParamSchema (C1 c (S1 s f)) where

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

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

211

214

src/Data/Swagger/Internal/Schema.hs+19−13

@@ -292,7 +292,9 @@ instance ToSchema a => ToSchema (Maybe a) where

292

293instance (ToSchema a, ToSchema b) => ToSchema (Either a b)

294

295−instance ToSchema ()

295+instance ToSchema () where

296+ declareNamedSchema _ = pure (Nothing, nullarySchema)

297+

296instance (ToSchema a, ToSchema b) => ToSchema (a, b)

298instance (ToSchema a, ToSchema b) => ToSchema (a, b)

297instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)

299instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)

298instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)

300instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)

@@ -418,6 +420,7 @@ nullarySchema :: Schema

418nullarySchema = mempty

420nullarySchema = mempty

419 & schemaType .~ SwaggerArray

421 & schemaType .~ SwaggerArray

420 & schemaEnum ?~ [ toJSON () ]

422 & schemaEnum ?~ [ toJSON () ]

423+ & schemaItems ?~ SwaggerItemsArray []

421

424

422gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema

425gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema

423gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

426gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

@@ -425,9 +428,6 @@ gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

425gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare Definitions Schema

428gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare Definitions Schema

426gdeclareSchema opts proxy = snd <$> gdeclareNamedSchema opts proxy mempty

429gdeclareSchema opts proxy = snd <$> gdeclareNamedSchema opts proxy mempty

427

430

428−instance GToSchema U1 where

429− gdeclareNamedSchema _ _ _ = plain nullarySchema

430−

431instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where

432 gdeclareNamedSchema opts _ schema = do

433 (_, gschema) <- gdeclareNamedSchema opts (Proxy :: Proxy g) schema

@@ -441,6 +441,9 @@ instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where

441instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where

442 gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)

443

444+instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where

445+ gdeclareNamedSchema = gdeclareNamedSumSchema

446+

444-- | Single field constructor.

447-- | Single field constructor.

445instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where

448instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where

446 gdeclareNamedSchema opts _ s

449 gdeclareNamedSchema opts _ s

@@ -511,16 +514,19 @@ instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where

511 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)

514 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)

512

515

513instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where

516instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where

514− gdeclareNamedSchema opts _ s

517+ gdeclareNamedSchema = gdeclareNamedSumSchema

518+

519+gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare Definitions NamedSchema

520+gdeclareNamedSumSchema opts proxy s

515− | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)

521+ | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)

516− | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema

522+ | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema

517− where

523+ where

518− declareSumSchema = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s

524+ declareSumSchema = gsumToSchema opts proxy s

519− (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)

525+ (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)

520

526

521− toStringTag schema = mempty

527+ toStringTag schema = mempty

522− & schemaType .~ SwaggerString

528+ & schemaType .~ SwaggerString

523− & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)

529+ & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)

524

530

525type AllNullary = All

531type AllNullary = All

526

532

src/Data/Swagger/Internal/Utils.hs+7−4

@@ -58,11 +58,14 @@ parseOneOf xs js =

58 where

59 ys = zip (map toJSON xs) xs

61−omitEmpties :: Value -> Value

61+omitEmptiesExcept :: (Text -> Value -> Bool) -> Value -> Value

62−omitEmpties (Object o) = Object (HashMap.filter nonEmpty o)

62+omitEmptiesExcept f (Object o) = Object (HashMap.filterWithKey nonEmpty o)

63 where

64− nonEmpty js = (js /= Object mempty) && (js /= Array mempty) && (js /= Null)

64+ nonEmpty k js = f k js || (js /= Object mempty) && (js /= Array mempty) && (js /= Null)

65−omitEmpties js = js

65+omitEmptiesExcept _ js = js

66+

67+omitEmpties :: Value -> Value

68+omitEmpties = omitEmptiesExcept (\_ _ -> False)

67genericToJSONWithSub :: (Generic a, GToJSON (Rep a)) => Text -> Options -> a -> Value

70genericToJSONWithSub :: (Generic a, GToJSON (Rep a)) => Text -> Options -> a -> Value

68genericToJSONWithSub sub opts x =

71genericToJSONWithSub sub opts x =

test/Data/Swagger/ParamSchemaSpec.hs+15

@@ -23,6 +23,7 @@ checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema Param) <=> js

23spec :: Spec

24spec = do

25 describe "Generic ToParamSchema" $ do

26+ context "Unit" $ checkToParamSchema (Proxy :: Proxy Unit) unitSchemaJSON

26 context "Color (bounded enum)" $ checkToParamSchema (Proxy :: Proxy Color) colorSchemaJSON

27 context "Color (bounded enum)" $ checkToParamSchema (Proxy :: Proxy Color) colorSchemaJSON

27 context "Status (constructorTagModifier)" $ checkToParamSchema (Proxy :: Proxy Status) statusSchemaJSON

28 context "Status (constructorTagModifier)" $ checkToParamSchema (Proxy :: Proxy Status) statusSchemaJSON

28 context "Unary records" $ do

29 context "Unary records" $ do

@@ -32,6 +33,20 @@ spec = do

32main :: IO ()

33main :: IO ()

33main = hspec spec

34main = hspec spec

36+-- ========================================================================

37+-- Unit type

38+-- ========================================================================

39+

40+data Unit = Unit deriving (Generic, ToParamSchema)

41+

42+unitSchemaJSON :: Value

43+unitSchemaJSON = [aesonQQ|

44+{

45+ "type": "string",

46+ "enum": ["Unit"]

47+}

48+|]

49+

35-- ========================================================================

50-- ========================================================================

36-- Color (enum)

51-- Color (enum)

37-- ========================================================================

52-- ========================================================================

test/Data/Swagger/SchemaSpec.hs+2−2

@@ -404,8 +404,8 @@ data Unit = Unit deriving (Generic, ToSchema)

404unitSchemaJSON :: Value

405unitSchemaJSON = [aesonQQ|

406{

407− "type": "array",

407+ "type": "string",

408− "enum": [[]]

408+ "enum": ["Unit"]

409}

410|]

411