git.iko.soy/typeable/openapi3
on master help sign in
Fix generic ToSchema instance for non-record data types
581fb6cNickolay Kudasov
src/Data/Swagger/Schema/Internal.hs+21−8
compare with master
unifiedsplit
@@ -78,27 +78,40 @@ genericToSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => proxy a ->
78genericToSchema _ = gtoSchema (Proxy :: Proxy (Rep a)) mempty
78genericToSchema _ = gtoSchema (Proxy :: Proxy (Rep a)) mempty
79
79
80instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
80instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
81− gtoSchema _ = gtoSchema (Proxy :: Proxy f) <> gtoSchema (Proxy :: Proxy g)
81+ gtoSchema _ = gtoSchema (Proxy :: Proxy f) . gtoSchema (Proxy :: Proxy g)
82
82
83-- | Single constructor data types.
83-- | Single constructor data types.
84instance GToSchema f => GToSchema (D1 d (C1 c f)) where
84instance GToSchema f => GToSchema (D1 d (C1 c f)) where
85 gtoSchema _ = gtoSchema (Proxy :: Proxy f)
85 gtoSchema _ = gtoSchema (Proxy :: Proxy f)
86
86
87+appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems
88+appendItem x Nothing = Just (SchemaItemsArray [x])
89+appendItem x (Just (SchemaItemsArray xs)) = Just (SchemaItemsArray (x:xs))
90+appendItem _ _ = error "GToSchema.appendItem: cannot append to SchemaItemsObject"
91+
87-- | Optional record fields.
92-- | Optional record fields.
88instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
93instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
89− gtoSchema _ schema = schema
94+ gtoSchema _ schema
95+ | Text.null fieldName = schema
96+ & schemaType .~ SchemaArray
97+ & schemaItems %~ appendItem (Inline fieldSchema)
98+ | otherwise = schema
90− & schemaType .~ SchemaObject
99+ & schemaType .~ SchemaObject
91− & schemaProperties . at fieldName ?~ Inline fieldSchema
100+ & schemaProperties . at fieldName ?~ Inline fieldSchema
92 where
101 where
93 fieldName = Text.pack (selName (undefined :: S1 s f p))
102 fieldName = Text.pack (selName (undefined :: S1 s f p))
94 fieldSchema = toSchema (Proxy :: Proxy c)
103 fieldSchema = toSchema (Proxy :: Proxy c)
95
104
96-- | Record fields.
105-- | Record fields.
97instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
106instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
98− gtoSchema _ schema = schema
107+ gtoSchema _ schema
108+ | Text.null fieldName = schema
109+ & schemaType .~ SchemaArray
110+ & schemaItems %~ appendItem (Inline fieldSchema)
111+ | otherwise = schema
99− & schemaType .~ SchemaObject
112+ & schemaType .~ SchemaObject
100− & schemaProperties . at fieldName ?~ Inline fieldSchema
113+ & schemaProperties . at fieldName ?~ Inline fieldSchema
101− & schemaRequired %~ (fieldName :)
114+ & schemaRequired %~ (fieldName :)
102 where
115 where
103 fieldName = Text.pack (selName (undefined :: S1 s f p))
116 fieldName = Text.pack (selName (undefined :: S1 s f p))
104 fieldSchema = gtoSchema (Proxy :: Proxy f) mempty
117 fieldSchema = gtoSchema (Proxy :: Proxy f) mempty