git.iko.soy/typeable/openapi3
on master help sign in
Add ToSchema instance for Maybe, fix derived Schema type for records
83d4aecNickolay Kudasov
src/Data/Swagger/Schema/Internal.hs+13−7
@@ -45,6 +45,9 @@ instance ToSchema Int where toSchema = toSchemaBoundedIntegral
45instance ToSchema Double where
45instance ToSchema Double where
46 toSchema _ = mempty { _schemaType = SchemaNumber }
46 toSchema _ = mempty { _schemaType = SchemaNumber }
47
47
48+instance ToSchema a => ToSchema (Maybe a) where
49+ toSchema _ = toSchema (Proxy :: Proxy a)
50+
48toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
51toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
49toSchemaBoundedIntegral _ = mempty
52toSchemaBoundedIntegral _ = mempty
50 & schemaType .~ SchemaInteger
53 & schemaType .~ SchemaInteger
@@ -66,22 +69,25 @@ instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
66instance GToSchema f => GToSchema (D1 d (C1 c f)) where
69instance GToSchema f => GToSchema (D1 d (C1 c f)) where
67 gtoSchema _ = gtoSchema (Proxy :: Proxy f)
70 gtoSchema _ = gtoSchema (Proxy :: Proxy f)
68
71
72+-- | Optional record fields.
73+instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
74+ gtoSchema _ schema = schema
75+ & schemaType .~ SchemaObject
76+ & schemaProperties . at fieldName ?~ Inline fieldSchema
77+ where
78+ fieldName = Text.pack (selName (undefined :: S1 s f p))
79+ fieldSchema = toSchema (Proxy :: Proxy c)
80+
69-- | Record fields.
81-- | Record fields.
70instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
82instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
71 gtoSchema _ schema = schema
83 gtoSchema _ schema = schema
84+ & schemaType .~ SchemaObject
72 & schemaProperties . at fieldName ?~ Inline fieldSchema
85 & schemaProperties . at fieldName ?~ Inline fieldSchema
73 & schemaRequired %~ (fieldName :)
86 & schemaRequired %~ (fieldName :)
74 where
87 where
75 fieldName = Text.pack (selName (undefined :: S1 s f p))
88 fieldName = Text.pack (selName (undefined :: S1 s f p))
76 fieldSchema = gtoSchema (Proxy :: Proxy f) mempty
89 fieldSchema = gtoSchema (Proxy :: Proxy f) mempty
77
90
78−-- | Optional record fields.
79−instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
80− gtoSchema _ = schemaProperties . at fieldName ?~ Inline fieldSchema
81− where
82− fieldName = Text.pack (selName (undefined :: S1 s f p))
83− fieldSchema = toSchema (Proxy :: Proxy c)
84−
85instance ToSchema c => GToSchema (K1 i c) where
91instance ToSchema c => GToSchema (K1 i c) where
86 gtoSchema _ _ = toSchema (Proxy :: Proxy c)
92 gtoSchema _ _ = toSchema (Proxy :: Proxy c)
87
93