git.iko.soy/typeable/openapi3
on master help sign in
Check for all nullary data types, remove bounded enum helpers
11ac9daNickolay Kudasov
src/Data/Swagger/Schema.hs−2
compare with master
unifiedsplit
@@ -10,11 +10,9 @@ module Data.Swagger.Schema (
10
10
11 genericToSchema,
11 genericToSchema,
12 genericToNamedSchema,
12 genericToNamedSchema,
13− genericToNamedSchemaBoundedEnum,
14 genericToNamedSchemaBoundedIntegral,
13 genericToNamedSchemaBoundedIntegral,
15
14
16 toSchemaBoundedIntegral,
15 toSchemaBoundedIntegral,
17− toSchemaBoundedEnum,
18) where
16) where
19
17
20import Data.Swagger.Schema.Internal
18import Data.Swagger.Schema.Internal
src/Data/Swagger/Schema/Internal.hs+30−21
@@ -157,11 +157,6 @@ toSchemaBoundedIntegral _ = mempty
157 & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
157 & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
158 & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
158 & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
159
159
160−toSchemaBoundedEnum :: forall a proxy. (ToJSON a, Bounded a, Enum a) => proxy a -> Schema
161−toSchemaBoundedEnum _ = mempty
162− & schemaType .~ SchemaString
163− & schemaEnum ?~ map toJSON [minBound..maxBound :: a]
164−
165genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
160genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
166 ( Bounded a, Integral a
161 ( Bounded a, Integral a
167 , Generic a, Rep a ~ D1 d f, Datatype d)
162 , Generic a, Rep a ~ D1 d f, Datatype d)
@@ -169,13 +164,6 @@ genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
169genericToNamedSchemaBoundedIntegral opts proxy
164genericToNamedSchemaBoundedIntegral opts proxy
170 = (gdatatypeSchemaName opts (Proxy :: Proxy d), toSchemaBoundedIntegral proxy)
165 = (gdatatypeSchemaName opts (Proxy :: Proxy d), toSchemaBoundedIntegral proxy)
171
166
172−genericToNamedSchemaBoundedEnum :: forall a d f proxy.
173− ( ToJSON a, Bounded a, Enum a
174− , Generic a, Rep a ~ D1 d f, Datatype d)
175− => SchemaOptions -> proxy a -> NamedSchema
176−genericToNamedSchemaBoundedEnum opts proxy
177− = (gdatatypeSchemaName opts (Proxy :: Proxy d), toSchemaBoundedEnum proxy)
178−
179genericToSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Schema
167genericToSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Schema
180genericToSchema opts = snd . genericToNamedSchema opts
168genericToSchema opts = snd . genericToNamedSchema opts
181
169
@@ -258,30 +246,51 @@ instance ToSchema c => GToSchema (K1 i c) where
258 gtoNamedSchema _ _ _ = toNamedSchema (Proxy :: Proxy c)
246 gtoNamedSchema _ _ _ = toNamedSchema (Proxy :: Proxy c)
259
247
260instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
248instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
249+ gtoNamedSchema opts _ s
250+ | allNullary = unnamed (toStringTag sumSchema)
251+ | otherwise = unnamed sumSchema
252+ where
261− gtoNamedSchema opts _ = unnamed . gsumToSchema opts (Proxy :: Proxy (f :+: g))
253+ (All allNullary, sumSchema) = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s
254+
255+ toStringTag schema = mempty
256+ & schemaType .~ SchemaString
257+ & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)
258+
259+type AllNullary = All
262
260
263class GSumToSchema f where
261class GSumToSchema f where
264− gsumToSchema :: SchemaOptions -> proxy f -> Schema -> Schema
262+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> (AllNullary, Schema)
265
263
266instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
264instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
267− gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) . gsumToSchema opts (Proxy :: Proxy g)
265+ gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) <.> gsumToSchema opts (Proxy :: Proxy g)
268−
266+ where
267+ (f <.> g) s = (a <> b, s'')
268+ where
269+ (a, s') = f s
270+ (b, s'') = g s'
271+
272+gsumConToSchema :: forall c f proxy. Constructor c =>
269−gsumConToSchema :: forall c f proxy. Constructor c => Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema
273+ Bool -> Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> (AllNullary, Schema)
270−gsumConToSchema tagSchemaRef opts _ schema = schema
274+gsumConToSchema isNullary tagSchemaRef opts _ schema = (All isNullary, schema
271 & schemaType .~ SchemaObject
275 & schemaType .~ SchemaObject
272 & schemaProperties . at tag ?~ tagSchemaRef
276 & schemaProperties . at tag ?~ tagSchemaRef
273 & schemaMaxProperties ?~ 1
277 & schemaMaxProperties ?~ 1
274− & schemaMinProperties ?~ 1
278+ & schemaMinProperties ?~ 1)
275 where
279 where
276 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
280 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
277
281
278instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
282instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
279− gsumToSchema opts = gsumConToSchema tagSchemaRef opts
283+ gsumToSchema opts = gsumConToSchema False tagSchemaRef opts
280 where
284 where
281 tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c f))
285 tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c f))
282
286
287+instance Constructor c => GSumToSchema (C1 c U1) where
288+ gsumToSchema opts = gsumConToSchema True tagSchemaRef opts
289+ where
290+ tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c U1))
291+
283instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
292instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
284− gsumToSchema opts = gsumConToSchema tagSchemaRef opts
293+ gsumToSchema opts = gsumConToSchema False tagSchemaRef opts
285 where
294 where
286 tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c (S1 s f)))
295 tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c (S1 s f)))
287
296
test/Data/Swagger/SchemaSpec.hs+2−7
@@ -48,8 +48,6 @@ spec = do
48 context "String" $ checkSchemaName Nothing (Proxy :: Proxy String)
48 context "String" $ checkSchemaName Nothing (Proxy :: Proxy String)
49 context "(Int, Float)" $ checkSchemaName Nothing (Proxy :: Proxy (Int, Float))
49 context "(Int, Float)" $ checkSchemaName Nothing (Proxy :: Proxy (Int, Float))
50 context "Person" $ checkSchemaName (Just "Person") (Proxy :: Proxy Person)
50 context "Person" $ checkSchemaName (Just "Person") (Proxy :: Proxy Person)
51− describe "toSchemaBoundedEnum" $ do
52− context "Color" $ checkToSchema (Proxy :: Proxy Color) colorSchemaJSON
53
51
54main :: IO ()
52main :: IO ()
55main = hspec spec
53main = hspec spec
@@ -122,16 +120,13 @@ pointSchemaJSON = [aesonQQ|
122
120
123
121
124-- ========================================================================
122-- ========================================================================
125−-- Color (bounded enum)
123+-- Color (enum)
126-- ========================================================================
124-- ========================================================================
127data Color
125data Color
128 = Red
126 = Red
129 | Green
127 | Green
130 | Blue
128 | Blue
131− deriving (Generic, Enum, Bounded, ToJSON)
129+ deriving (Generic, ToSchema)
132−
133−instance ToSchema Color where
134− toNamedSchema = genericToNamedSchemaBoundedEnum defaultSchemaOptions
135
130
136colorSchemaJSON :: Value
131colorSchemaJSON :: Value
137colorSchemaJSON = [aesonQQ|
132colorSchemaJSON = [aesonQQ|