git.iko.soy/typeable/swagger2
on master help sign in
Merge pull request #36 from GetShopTV/unit-#35

Better support for unit types

commitba830803f7761005fc7d5ea68310d7edbad0ee4e authorNickolay Kudasov <fizruk@users.noreply.github.com> dateMon 18 Jan 2016, 15:29 (11 years ago) parent6eb4cb30b69e89
7 files changed+63−21
compare with master
unifiedsplit
CHANGELOG.md+9 src/Data/Swagger/Internal.hs+8−2 src/Data/Swagger/Internal/ParamSchema.hs+3 src/Data/Swagger/Internal/Schema.hs+19−13 src/Data/Swagger/Internal/Utils.hs+7−4 test/Data/Swagger/ParamSchemaSpec.hs+15 test/Data/Swagger/SchemaSpec.hs+2−2
CHANGELOG.md+9
@@ -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).
6+
7+* Fixes:
8+ * `items: []` is not omitted from `Schema` JSON.
9+
1101.1.1
211---
312* Fixes:
src/Data/Swagger/Internal.hs+8−2
@@ -906,7 +906,10 @@ instance ToJSON SecurityScheme where
906906 toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
907907
908908instance 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
910913
911914instance ToJSON Header where
912915 toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")
@@ -985,7 +988,10 @@ instance ToJSON (CollectionFormat t) where
985988 toJSON CollectionMulti = "multi"
986989
987990instance 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
989995
990996-- =======================================================================
991997-- Manual FromJSON instances
src/Data/Swagger/Internal/ParamSchema.hs+3
@@ -206,6 +206,9 @@ class GToParamSchema (f :: * -> *) where
206206instance GToParamSchema f => GToParamSchema (D1 d f) where
207207 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
208208
209+instance Constructor c => GToParamSchema (C1 c U1) where
210+ gtoParamSchema = genumParamSchema
211+
209212instance GToParamSchema f => GToParamSchema (C1 c (S1 s f)) where
210213 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
211214
src/Data/Swagger/Internal/Schema.hs+19−13
@@ -292,7 +292,9 @@ instance ToSchema a => ToSchema (Maybe a) where
292292
293293instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
294294
295−instance ToSchema ()
295+instance ToSchema () where
296+ declareNamedSchema _ = pure (Nothing, nullarySchema)
297+
296298instance (ToSchema a, ToSchema b) => ToSchema (a, b)
297299instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
298300instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
@@ -418,6 +420,7 @@ nullarySchema :: Schema
418420nullarySchema = mempty
419421 & schemaType .~ SwaggerArray
420422 & schemaEnum ?~ [ toJSON () ]
423+ & schemaItems ?~ SwaggerItemsArray []
421424
422425gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema
423426gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -425,9 +428,6 @@ gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
425428gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare Definitions Schema
426429gdeclareSchema opts proxy = snd <$> gdeclareNamedSchema opts proxy mempty
427430
428−instance GToSchema U1 where
429− gdeclareNamedSchema _ _ _ = plain nullarySchema
430−
431431instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
432432 gdeclareNamedSchema opts _ schema = do
433433 (_, gschema) <- gdeclareNamedSchema opts (Proxy :: Proxy g) schema
@@ -441,6 +441,9 @@ instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
441441instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
442442 gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)
443443
444+instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where
445+ gdeclareNamedSchema = gdeclareNamedSumSchema
446+
444447-- | Single field constructor.
445448instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where
446449 gdeclareNamedSchema opts _ s
@@ -511,16 +514,19 @@ instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where
511514 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
512515
513516instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
514− gdeclareNamedSchema opts _ s
515− | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
516− | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
517− where
518− declareSumSchema = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s
519− (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
517+ gdeclareNamedSchema = gdeclareNamedSumSchema
518+
519+gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare Definitions NamedSchema
520+gdeclareNamedSumSchema opts proxy s
521+ | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
522+ | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
523+ where
524+ declareSumSchema = gsumToSchema opts proxy s
525+ (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
520526
521− toStringTag schema = mempty
522− & schemaType .~ SwaggerString
523− & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)
527+ toStringTag schema = mempty
528+ & schemaType .~ SwaggerString
529+ & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)
524530
525531type AllNullary = All
526532
src/Data/Swagger/Internal/Utils.hs+7−4
@@ -58,11 +58,14 @@ parseOneOf xs js =
5858 where
5959 ys = zip (map toJSON xs) xs
6060
61−omitEmpties :: Value -> Value
62−omitEmpties (Object o) = Object (HashMap.filter nonEmpty o)
61+omitEmptiesExcept :: (Text -> Value -> Bool) -> Value -> Value
62+omitEmptiesExcept f (Object o) = Object (HashMap.filterWithKey nonEmpty o)
6363 where
64− nonEmpty js = (js /= Object mempty) && (js /= Array mempty) && (js /= Null)
65−omitEmpties js = js
64+ nonEmpty k js = f k js || (js /= Object mempty) && (js /= Array mempty) && (js /= Null)
65+omitEmptiesExcept _ js = js
66+
67+omitEmpties :: Value -> Value
68+omitEmpties = omitEmptiesExcept (\_ _ -> False)
6669
6770genericToJSONWithSub :: (Generic a, GToJSON (Rep a)) => Text -> Options -> a -> Value
6871genericToJSONWithSub sub opts x =
test/Data/Swagger/ParamSchemaSpec.hs+15
@@ -23,6 +23,7 @@ checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema Param) <=> js
2323spec :: Spec
2424spec = do
2525 describe "Generic ToParamSchema" $ do
26+ context "Unit" $ checkToParamSchema (Proxy :: Proxy Unit) unitSchemaJSON
2627 context "Color (bounded enum)" $ checkToParamSchema (Proxy :: Proxy Color) colorSchemaJSON
2728 context "Status (constructorTagModifier)" $ checkToParamSchema (Proxy :: Proxy Status) statusSchemaJSON
2829 context "Unary records" $ do
@@ -32,6 +33,20 @@ spec = do
3233main :: IO ()
3334main = hspec spec
3435
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+
3550-- ========================================================================
3651-- Color (enum)
3752-- ========================================================================
test/Data/Swagger/SchemaSpec.hs+2−2
@@ -404,8 +404,8 @@ data Unit = Unit deriving (Generic, ToSchema)
404404unitSchemaJSON :: Value
405405unitSchemaJSON = [aesonQQ|
406406{
407− "type": "array",
408− "enum": [[]]
407+ "type": "string",
408+ "enum": ["Unit"]
409409}
410410|]
411411