git.iko.soy/typeable/swagger2
on master help sign in
Check for all nullary data types, remove bounded enum helpers
commit11ac9da99c06b519c5c15b7305327ea22648a304 authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateWed 25 Nov 2015, 14:05 (11 years ago) parent3e75720
3 files changed+32−30
compare with master
unifiedsplit
src/Data/Swagger/Schema.hs−2 src/Data/Swagger/Schema/Internal.hs+30−21 test/Data/Swagger/SchemaSpec.hs+2−7
src/Data/Swagger/Schema.hs−2
@@ -10,11 +10,9 @@ module Data.Swagger.Schema (
1010
1111 genericToSchema,
1212 genericToNamedSchema,
13− genericToNamedSchemaBoundedEnum,
1413 genericToNamedSchemaBoundedIntegral,
1514
1615 toSchemaBoundedIntegral,
17− toSchemaBoundedEnum,
1816) where
1917
2018import Data.Swagger.Schema.Internal
src/Data/Swagger/Schema/Internal.hs+30−21
@@ -157,11 +157,6 @@ toSchemaBoundedIntegral _ = mempty
157157 & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
158158 & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
159159
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−
165160genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
166161 ( Bounded a, Integral a
167162 , Generic a, Rep a ~ D1 d f, Datatype d)
@@ -169,13 +164,6 @@ genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
169164genericToNamedSchemaBoundedIntegral opts proxy
170165 = (gdatatypeSchemaName opts (Proxy :: Proxy d), toSchemaBoundedIntegral proxy)
171166
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−
179167genericToSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Schema
180168genericToSchema opts = snd . genericToNamedSchema opts
181169
@@ -258,30 +246,51 @@ instance ToSchema c => GToSchema (K1 i c) where
258246 gtoNamedSchema _ _ _ = toNamedSchema (Proxy :: Proxy c)
259247
260248instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
261− gtoNamedSchema opts _ = unnamed . gsumToSchema opts (Proxy :: Proxy (f :+: g))
249+ gtoNamedSchema opts _ s
250+ | allNullary = unnamed (toStringTag sumSchema)
251+ | otherwise = unnamed sumSchema
252+ where
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
262260
263261class GSumToSchema f where
264− gsumToSchema :: SchemaOptions -> proxy f -> Schema -> Schema
262+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> (AllNullary, Schema)
265263
266264instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
267− gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) . gsumToSchema opts (Proxy :: Proxy g)
268−
269−gsumConToSchema :: forall c f proxy. Constructor c => Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema
270−gsumConToSchema tagSchemaRef opts _ schema = schema
265+ gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) <.> gsumToSchema opts (Proxy :: Proxy g)
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 =>
273+ Bool -> Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> (AllNullary, Schema)
274+gsumConToSchema isNullary tagSchemaRef opts _ schema = (All isNullary, schema
271275 & schemaType .~ SchemaObject
272276 & schemaProperties . at tag ?~ tagSchemaRef
273277 & schemaMaxProperties ?~ 1
274− & schemaMinProperties ?~ 1
278+ & schemaMinProperties ?~ 1)
275279 where
276280 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
277281
278282instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
279− gsumToSchema opts = gsumConToSchema tagSchemaRef opts
283+ gsumToSchema opts = gsumConToSchema False tagSchemaRef opts
280284 where
281285 tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c f))
282286
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+
283292instance (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
285294 where
286295 tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c (S1 s f)))
287296
test/Data/Swagger/SchemaSpec.hs+2−7
@@ -48,8 +48,6 @@ spec = do
4848 context "String" $ checkSchemaName Nothing (Proxy :: Proxy String)
4949 context "(Int, Float)" $ checkSchemaName Nothing (Proxy :: Proxy (Int, Float))
5050 context "Person" $ checkSchemaName (Just "Person") (Proxy :: Proxy Person)
51− describe "toSchemaBoundedEnum" $ do
52− context "Color" $ checkToSchema (Proxy :: Proxy Color) colorSchemaJSON
5351
5452main :: IO ()
5553main = hspec spec
@@ -122,16 +120,13 @@ pointSchemaJSON = [aesonQQ|
122120
123121
124122-- ========================================================================
125−-- Color (bounded enum)
123+-- Color (enum)
126124-- ========================================================================
127125data Color
128126 = Red
129127 | Green
130128 | Blue
131− deriving (Generic, Enum, Bounded, ToJSON)
132−
133−instance ToSchema Color where
134− toNamedSchema = genericToNamedSchemaBoundedEnum defaultSchemaOptions
129+ deriving (Generic, ToSchema)
135130
136131colorSchemaJSON :: Value
137132colorSchemaJSON = [aesonQQ|