git.iko.soy/typeable/swagger2
on master help sign in
Fix ToSchema for unary records, add unwrapUnaryRecords option
commit443a0ed858b59d66ceb3ae44a0b1e498a4bc170d authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateTue 24 Nov 2015, 00:11 (11 years ago) parent474cbda
1 file changed+37−25
src/Data/Swagger/Schema/Internal.hs+37−25
src/Data/Swagger/Schema/Internal.hs+37−25
@@ -108,11 +108,15 @@ instance ToSchema a => ToSchema (Last a) where toSchema _ = toSchema (Proxy :
108108instance ToSchema a => ToSchema (Dual a) where toSchema _ = toSchema (Proxy :: Proxy a)
109109
110110data SchemaOptions = SchemaOptions
111− { fieldLabelModifier :: String -> String }
111+ { fieldLabelModifier :: String -> String
112+ , unwrapUnaryRecords :: Bool
113+ }
112114
113115defaultSchemaOptions :: SchemaOptions
114116defaultSchemaOptions = SchemaOptions
115− { fieldLabelModifier = id }
117+ { fieldLabelModifier = id
118+ , unwrapUnaryRecords = False
119+ }
116120
117121toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
118122toSchemaBoundedIntegral _ = mempty
@@ -131,44 +135,52 @@ genericToSchema opts _ = gtoSchema opts (Proxy :: Proxy (Rep a)) mempty
131135instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
132136 gtoSchema opts _ = gtoSchema opts (Proxy :: Proxy f) . gtoSchema opts (Proxy :: Proxy g)
133137
134−-- | Single constructor data types.
135−instance GToSchema f => GToSchema (D1 d (C1 c f)) where
138+-- | Single constructor data type.
139+instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (D1 d (C1 c f)) where
136140 gtoSchema opts _ = gtoSchema opts (Proxy :: Proxy f)
137141
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+
138152appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems
139153appendItem x Nothing = Just (SchemaItemsArray [x])
140154appendItem x (Just (SchemaItemsArray xs)) = Just (SchemaItemsArray (x:xs))
141155appendItem _ _ = error "GToSchema.appendItem: cannot append to SchemaItemsObject"
142156
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+
143172-- | Optional record fields.
144173instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
145− gtoSchema opts _ schema
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)
174+ gtoSchema opts _ = withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
155175
156176-- | Record fields.
157177instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
158− gtoSchema opts _ 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− & schemaRequired %~ (fieldName :)
166− where
167− fieldName = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
168− fieldSchema = gtoSchema opts (Proxy :: Proxy f) mempty
178+ gtoSchema opts _ = withFieldSchema opts (Proxy2 :: Proxy2 s f) True
169179
170180instance ToSchema c => GToSchema (K1 i c) where
171181 gtoSchema _ _ _ = toSchema (Proxy :: Proxy c)
172182
183+data Proxy2 a b = Proxy2
184+
173185data Proxy3 a b c = Proxy3
174186