git.iko.soy/typeable/openapi3
on master help sign in
Fix ToSchema for unary records, add unwrapUnaryRecords option
443a0edNickolay Kudasov
src/Data/Swagger/Schema/Internal.hs+37−25
compare with master
unifiedsplit
@@ -108,11 +108,15 @@ instance ToSchema a => ToSchema (Last a) where toSchema _ = toSchema (Proxy :
108instance ToSchema a => ToSchema (Dual a) where toSchema _ = toSchema (Proxy :: Proxy a)
108instance ToSchema a => ToSchema (Dual a) where toSchema _ = toSchema (Proxy :: Proxy a)
109
109
110data SchemaOptions = SchemaOptions
110data SchemaOptions = SchemaOptions
111− { fieldLabelModifier :: String -> String }
111+ { fieldLabelModifier :: String -> String
112+ , unwrapUnaryRecords :: Bool
113+ }
112
114
113defaultSchemaOptions :: SchemaOptions
115defaultSchemaOptions :: SchemaOptions
114defaultSchemaOptions = SchemaOptions
116defaultSchemaOptions = SchemaOptions
115− { fieldLabelModifier = id }
117+ { fieldLabelModifier = id
118+ , unwrapUnaryRecords = False
119+ }
116
120
117toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
121toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
118toSchemaBoundedIntegral _ = mempty
122toSchemaBoundedIntegral _ = mempty
@@ -131,44 +135,52 @@ genericToSchema opts _ = gtoSchema opts (Proxy :: Proxy (Rep a)) mempty
131instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
135instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
132 gtoSchema opts _ = gtoSchema opts (Proxy :: Proxy f) . gtoSchema opts (Proxy :: Proxy g)
136 gtoSchema opts _ = gtoSchema opts (Proxy :: Proxy f) . gtoSchema opts (Proxy :: Proxy g)
133
137
134−-- | Single constructor data types.
138+-- | Single constructor data type.
135−instance GToSchema f => GToSchema (D1 d (C1 c f)) where
139+instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (D1 d (C1 c f)) where
136 gtoSchema opts _ = gtoSchema opts (Proxy :: Proxy f)
140 gtoSchema opts _ = gtoSchema opts (Proxy :: Proxy f)
137
141
142+-- | Single field single constructor data type.
143+instance (Selector s, GToSchema f) => GToSchema (D1 d (C1 c (S1 s f))) where
144+ gtoSchema opts _ s
145+ | unwrapUnaryRecords opts = gtoSchema opts (Proxy :: Proxy f) s
146+ | otherwise = case schema ^. schemaItems of
147+ Just (SchemaItemsArray [Inline fieldSchema]) -> fieldSchema
148+ _ -> schema
149+ where
150+ schema = gtoSchema opts (Proxy :: Proxy (S1 s f)) s
151+
138appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems
152appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems
139appendItem x Nothing = Just (SchemaItemsArray [x])
153appendItem x Nothing = Just (SchemaItemsArray [x])
140appendItem x (Just (SchemaItemsArray xs)) = Just (SchemaItemsArray (x:xs))
154appendItem x (Just (SchemaItemsArray xs)) = Just (SchemaItemsArray (x:xs))
141appendItem _ _ = error "GToSchema.appendItem: cannot append to SchemaItemsObject"
155appendItem _ _ = error "GToSchema.appendItem: cannot append to SchemaItemsObject"
142
156
157+withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) => SchemaOptions -> proxy s f -> Bool -> Schema -> Schema
158+withFieldSchema opts _ isRequiredField schema
159+ | T.null fieldName = schema
160+ & schemaType .~ SchemaArray
161+ & schemaItems %~ appendItem (Inline fieldSchema)
162+ | otherwise = schema
163+ & schemaType .~ SchemaObject
164+ & schemaProperties . at fieldName ?~ Inline fieldSchema
165+ & if isRequiredField
166+ then schemaRequired %~ (fieldName :)
167+ else id
168+ where
169+ fieldName = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
170+ fieldSchema = gtoSchema opts (Proxy :: Proxy f) mempty
171+
143-- | Optional record fields.
172-- | Optional record fields.
144instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
173instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
145− gtoSchema opts _ schema
174+ gtoSchema opts _ = withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
146− | T.null fieldName = schema
147− & schemaType .~ SchemaArray
148− & schemaItems %~ appendItem (Inline fieldSchema)
149− | otherwise = schema
150− & schemaType .~ SchemaObject
151− & schemaProperties . at fieldName ?~ Inline fieldSchema
152− where
153− fieldName = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
154− fieldSchema = toSchema (Proxy :: Proxy c)
155
175
156-- | Record fields.
176-- | Record fields.
157instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
177instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
158− gtoSchema opts _ schema
178+ gtoSchema opts _ = withFieldSchema opts (Proxy2 :: Proxy2 s f) True
159− | T.null fieldName = schema
160− & schemaType .~ SchemaArray
161− & schemaItems %~ appendItem (Inline fieldSchema)
162− | otherwise = schema
163− & schemaType .~ SchemaObject
164− & schemaProperties . at fieldName ?~ Inline fieldSchema
165− & schemaRequired %~ (fieldName :)
166− where
167− fieldName = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
168− fieldSchema = gtoSchema opts (Proxy :: Proxy f) mempty
169
179
170instance ToSchema c => GToSchema (K1 i c) where
180instance ToSchema c => GToSchema (K1 i c) where
171 gtoSchema _ _ _ = toSchema (Proxy :: Proxy c)
181 gtoSchema _ _ _ = toSchema (Proxy :: Proxy c)
172
182
183+data Proxy2 a b = Proxy2
184+
173data Proxy3 a b c = Proxy3
185data Proxy3 a b c = Proxy3
174
186