@@ -78,27 +78,40 @@ genericToSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => proxy a ->
7878genericToSchema _ = gtoSchema (Proxy :: Proxy (Rep a)) mempty
7979
8080instance (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)
8282
8383-- | Single constructor data types.
8484instance GToSchema f => GToSchema (D1 d (C1 c f)) where
8585 gtoSchema _ = gtoSchema (Proxy :: Proxy f)
8686
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+
8792-- | Optional record fields.
8893instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
89− gtoSchema _ schema = schema
90− & schemaType .~ SchemaObject
91− & schemaProperties . at fieldName ?~ Inline fieldSchema
94+ gtoSchema _ schema
95+ | Text.null fieldName = schema
96+ & schemaType .~ SchemaArray
97+ & schemaItems %~ appendItem (Inline fieldSchema)
98+ | otherwise = schema
99+ & schemaType .~ SchemaObject
100+ & schemaProperties . at fieldName ?~ Inline fieldSchema
92101 where
93102 fieldName = Text.pack (selName (undefined :: S1 s f p))
94103 fieldSchema = toSchema (Proxy :: Proxy c)
95104
96105-- | Record fields.
97106instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
98− gtoSchema _ schema = schema
99− & schemaType .~ SchemaObject
100− & schemaProperties . at fieldName ?~ Inline fieldSchema
101− & schemaRequired %~ (fieldName :)
107+ gtoSchema _ schema
108+ | Text.null fieldName = schema
109+ & schemaType .~ SchemaArray
110+ & schemaItems %~ appendItem (Inline fieldSchema)
111+ | otherwise = schema
112+ & schemaType .~ SchemaObject
113+ & schemaProperties . at fieldName ?~ Inline fieldSchema
114+ & schemaRequired %~ (fieldName :)
102115 where
103116 fieldName = Text.pack (selName (undefined :: S1 s f p))
104117 fieldSchema = gtoSchema (Proxy :: Proxy f) mempty