git.iko.soy/typeable/openapi3
on master help sign in
Merge ParamType/ItemsType/SchemaType into SwaggerType
f9c8629Nickolay Kudasov
src/Data/Swagger.hs+1−3
compare with master
unifiedsplit
@@ -27,9 +27,7 @@ module Data.Swagger (
27 Operation(..),
27 Operation(..),
28
28
29 -- * Types and formats
29 -- * Types and formats
30− ParamType(..),
30+ SwaggerType(..),
31− ItemsType(..),
32− SchemaType(..),
33 Format,
31 Format,
34 CollectionFormat(..),
32 CollectionFormat(..),
35 ItemsCollectionFormat(..),
33 ItemsCollectionFormat(..),
src/Data/Swagger/Internal.hs+38−39
@@ -1,6 +1,7 @@
1{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveTraversable #-}
2{-# LANGUAGE DeriveTraversable #-}
3{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE GADTs #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE RecordWildCards #-}
7{-# LANGUAGE RecordWildCards #-}
@@ -293,17 +294,21 @@ data ParamOtherSchema = ParamOtherSchema
293 -- Default value is csv.
294 -- Default value is csv.
294 , _paramOtherSchemaCollectionFormat :: Maybe CollectionFormat
295 , _paramOtherSchemaCollectionFormat :: Maybe CollectionFormat
295
296
296− , _paramOtherSchemaCommon :: SchemaCommon ParamType Items
297+ , _paramOtherSchemaCommon :: SchemaCommon (SwaggerType Param) Items
297 } deriving (Eq, Show, Generic)
298 } deriving (Eq, Show, Generic)
298
299
299−data ParamType
300+data SwaggerType t where
300− = ParamString
301+ SwaggerString :: SwaggerType t
301− | ParamNumber
302+ SwaggerNumber :: SwaggerType t
302− | ParamInteger
303+ SwaggerInteger :: SwaggerType t
303− | ParamBoolean
304+ SwaggerBoolean :: SwaggerType t
304− | ParamArray
305+ SwaggerArray :: SwaggerType t
305− | ParamFile
306+ SwaggerFile :: SwaggerType Param
307+ SwaggerNull :: SwaggerType Schema
308+ SwaggerObject :: SwaggerType Schema
309+
306− deriving (Eq, Show)
310+deriving instance Eq (SwaggerType t)
311+deriving instance Show (SwaggerType t)
307
312
308data ParamLocation
313data ParamLocation
309 = -- | Parameters that are appended to the URL.
314 = -- | Parameters that are appended to the URL.
@@ -338,24 +343,6 @@ data CollectionFormat
338 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
343 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
339 deriving (Eq, Show)
344 deriving (Eq, Show)
340
345
341−data ItemsType
342− = ItemsString
343− | ItemsNumber
344− | ItemsInteger
345− | ItemsBoolean
346− | ItemsArray
347− deriving (Eq, Show)
348−
349−data SchemaType
350− = SchemaArray
351− | SchemaBoolean
352− | SchemaInteger
353− | SchemaNumber
354− | SchemaNull
355− | SchemaObject
356− | SchemaString
357− deriving (Eq, Show)
358−
359-- | Determines the format of the nested array.
346-- | Determines the format of the nested array.
360data ItemsCollectionFormat
347data ItemsCollectionFormat
361 = ItemsCollectionCSV -- ^ Comma separated values: @foo,bar@.
348 = ItemsCollectionCSV -- ^ Comma separated values: @foo,bar@.
@@ -384,7 +371,7 @@ data Schema = Schema
384 , _schemaMaxProperties :: Maybe Integer
371 , _schemaMaxProperties :: Maybe Integer
385 , _schemaMinProperties :: Maybe Integer
372 , _schemaMinProperties :: Maybe Integer
386
373
387− , _schemaSchemaCommon :: SchemaCommon SchemaType SchemaItems
374+ , _schemaSchemaCommon :: SchemaCommon (SwaggerType Schema) SchemaItems
388 } deriving (Eq, Show, Generic)
375 } deriving (Eq, Show, Generic)
389
376
390data SchemaItems
377data SchemaItems
@@ -450,7 +437,7 @@ data Items = Items
450 -- Default value is @'ItemsCollectionCSV'@.
437 -- Default value is @'ItemsCollectionCSV'@.
451 _itemsCollectionFormat :: Maybe ItemsCollectionFormat
438 _itemsCollectionFormat :: Maybe ItemsCollectionFormat
452
439
453− , _itemsCommon :: SchemaCommon ItemsType Items
440+ , _itemsCommon :: SchemaCommon (SwaggerType Items) Items
454 } deriving (Eq, Show, Generic)
441 } deriving (Eq, Show, Generic)
455
442
456-- | A container for the expected responses of an operation.
443-- | A container for the expected responses of an operation.
@@ -500,7 +487,7 @@ data Header = Header
500 -- Default value is @'ItemsCollectionCSV'@.
487 -- Default value is @'ItemsCollectionCSV'@.
501 , _headerCollectionFormat :: Maybe ItemsCollectionFormat
488 , _headerCollectionFormat :: Maybe ItemsCollectionFormat
502
489
503− , _headerCommon :: SchemaCommon ItemsType Items
490+ , _headerCommon :: SchemaCommon (SwaggerType Items) Items
504 } deriving (Eq, Show, Generic)
491 } deriving (Eq, Show, Generic)
505
492
506data Example = Example { getExample :: Map MediaType Value }
493data Example = Example { getExample :: Map MediaType Value }
@@ -669,12 +656,8 @@ instance SwaggerMonoid Operation
669instance SwaggerMonoid MimeList
656instance SwaggerMonoid MimeList
670deriving instance SwaggerMonoid URL
657deriving instance SwaggerMonoid URL
671
658
672−instance SwaggerMonoid SchemaType where
659+instance SwaggerMonoid (SwaggerType t) where
673− swaggerMempty = SchemaNull
674− swaggerMappend _ y = y
675−
676−instance SwaggerMonoid ParamType where
677− swaggerMempty = ParamString
660+ swaggerMempty = SwaggerString
678 swaggerMappend _ y = y
661 swaggerMappend _ y = y
679
662
680instance SwaggerMonoid ParamLocation where
663instance SwaggerMonoid ParamLocation where
@@ -729,12 +712,9 @@ instance SwaggerMonoid ParamSchema where
729-- =======================================================================
712-- =======================================================================
730
713
731deriveJSON (jsonPrefix "Param") ''ParamLocation
714deriveJSON (jsonPrefix "Param") ''ParamLocation
732−deriveJSON (jsonPrefix "Param") ''ParamType
733deriveJSON' ''Info
715deriveJSON' ''Info
734deriveJSON' ''Contact
716deriveJSON' ''Contact
735deriveJSON' ''License
717deriveJSON' ''License
736−deriveJSON (jsonPrefix "Schema") ''SchemaType
737−deriveJSON (jsonPrefix "Items") ''ItemsType
738deriveJSON (jsonPrefix "ItemsCollection") ''ItemsCollectionFormat
718deriveJSON (jsonPrefix "ItemsCollection") ''ItemsCollectionFormat
739deriveJSON (jsonPrefix "Collection") ''CollectionFormat
719deriveJSON (jsonPrefix "Collection") ''CollectionFormat
740deriveJSON (jsonPrefix "ApiKey") ''ApiKeyLocation
720deriveJSON (jsonPrefix "ApiKey") ''ApiKeyLocation
@@ -838,6 +818,16 @@ instance ToJSON a => ToJSON (Referenced a) where
838 toJSON (Ref ref) = toJSON ref
818 toJSON (Ref ref) = toJSON ref
839 toJSON (Inline x) = toJSON x
819 toJSON (Inline x) = toJSON x
840
820
821+instance ToJSON (SwaggerType t) where
822+ toJSON SwaggerArray = "array"
823+ toJSON SwaggerString = "string"
824+ toJSON SwaggerInteger = "integer"
825+ toJSON SwaggerNumber = "number"
826+ toJSON SwaggerBoolean = "boolean"
827+ toJSON SwaggerFile = "file"
828+ toJSON SwaggerNull = "null"
829+ toJSON SwaggerObject = "object"
830+
841-- =======================================================================
831-- =======================================================================
842-- Manual FromJSON instances
832-- Manual FromJSON instances
843-- =======================================================================
833-- =======================================================================
@@ -970,3 +960,12 @@ instance FromJSON a => FromJSON (Referenced a) where
970instance FromJSON Xml where
960instance FromJSON Xml where
971 parseJSON = genericParseJSON (jsonPrefix "xml")
961 parseJSON = genericParseJSON (jsonPrefix "xml")
972
962
963+instance FromJSON (SwaggerType Schema) where
964+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
965+
966+instance FromJSON (SwaggerType Param) where
967+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
968+
969+instance FromJSON (SwaggerType Items) where
970+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
971+
src/Data/Swagger/Internal/Param.hs+10−10
@@ -34,17 +34,17 @@ class ToParamSchema a where
34instance {-# OVERLAPPING #-} ToParamSchema String where
34instance {-# OVERLAPPING #-} ToParamSchema String where
35 toParamSchema _ loc = mempty
35 toParamSchema _ loc = mempty
36 & paramOtherSchemaIn .~ loc
36 & paramOtherSchemaIn .~ loc
37− & schemaType .~ ParamString
37+ & schemaType .~ SwaggerString
38
38
39instance ToParamSchema Bool where
39instance ToParamSchema Bool where
40 toParamSchema _ loc = mempty
40 toParamSchema _ loc = mempty
41 & paramOtherSchemaIn .~ loc
41 & paramOtherSchemaIn .~ loc
42− & schemaType .~ ParamBoolean
42+ & schemaType .~ SwaggerBoolean
43
43
44instance ToParamSchema Integer where
44instance ToParamSchema Integer where
45 toParamSchema _ loc = mempty
45 toParamSchema _ loc = mempty
46 & paramOtherSchemaIn .~ loc
46 & paramOtherSchemaIn .~ loc
47− & schemaType .~ ParamInteger
47+ & schemaType .~ SwaggerInteger
48
48
49instance ToParamSchema Int where toParamSchema = toParamSchemaBoundedIntegral
49instance ToParamSchema Int where toParamSchema = toParamSchemaBoundedIntegral
50instance ToParamSchema Int8 where toParamSchema = toParamSchemaBoundedIntegral
50instance ToParamSchema Int8 where toParamSchema = toParamSchemaBoundedIntegral
@@ -61,36 +61,36 @@ instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
61toParamSchemaBoundedIntegral :: forall proxy a. (Bounded a, Integral a) => proxy a -> ParamLocation -> ParamOtherSchema
61toParamSchemaBoundedIntegral :: forall proxy a. (Bounded a, Integral a) => proxy a -> ParamLocation -> ParamOtherSchema
62toParamSchemaBoundedIntegral _ loc = mempty
62toParamSchemaBoundedIntegral _ loc = mempty
63 & paramOtherSchemaIn .~ loc
63 & paramOtherSchemaIn .~ loc
64− & schemaType .~ ParamInteger
64+ & schemaType .~ SwaggerInteger
65 & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
65 & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
66 & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
66 & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
67
67
68instance ToParamSchema Char where
68instance ToParamSchema Char where
69 toParamSchema _ loc = mempty
69 toParamSchema _ loc = mempty
70 & paramOtherSchemaIn .~ loc
70 & paramOtherSchemaIn .~ loc
71− & schemaType .~ ParamString
71+ & schemaType .~ SwaggerString
72 & schemaMaxLength ?~ 1
72 & schemaMaxLength ?~ 1
73 & schemaMinLength ?~ 1
73 & schemaMinLength ?~ 1
74
74
75instance ToParamSchema Scientific where
75instance ToParamSchema Scientific where
76 toParamSchema _ loc = mempty
76 toParamSchema _ loc = mempty
77 & paramOtherSchemaIn .~ loc
77 & paramOtherSchemaIn .~ loc
78− & schemaType .~ ParamNumber
78+ & schemaType .~ SwaggerNumber
79
79
80instance ToParamSchema Double where
80instance ToParamSchema Double where
81 toParamSchema _ loc = mempty
81 toParamSchema _ loc = mempty
82 & paramOtherSchemaIn .~ loc
82 & paramOtherSchemaIn .~ loc
83− & schemaType .~ ParamNumber
83+ & schemaType .~ SwaggerNumber
84
84
85instance ToParamSchema Float where
85instance ToParamSchema Float where
86 toParamSchema _ loc = mempty
86 toParamSchema _ loc = mempty
87 & paramOtherSchemaIn .~ loc
87 & paramOtherSchemaIn .~ loc
88− & schemaType .~ ParamNumber
88+ & schemaType .~ SwaggerNumber
89
89
90timeParamSchema :: String -> ParamLocation -> ParamOtherSchema
90timeParamSchema :: String -> ParamLocation -> ParamOtherSchema
91timeParamSchema format loc = mempty
91timeParamSchema format loc = mempty
92 & paramOtherSchemaIn .~ loc
92 & paramOtherSchemaIn .~ loc
93− & schemaType .~ ParamString
93+ & schemaType .~ SwaggerString
94 & schemaFormat ?~ T.pack format
94 & schemaFormat ?~ T.pack format
95 & schemaMinLength ?~ toInteger (length format)
95 & schemaMinLength ?~ toInteger (length format)
96
96
@@ -162,7 +162,7 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g)
162instance Constructor c => GEnumParamSchema (C1 c U1) where
162instance Constructor c => GEnumParamSchema (C1 c U1) where
163 genumParamSchema opts _ loc s = s
163 genumParamSchema opts _ loc s = s
164 & paramOtherSchemaIn .~ loc
164 & paramOtherSchemaIn .~ loc
165− & schemaType .~ ParamString
165+ & schemaType .~ SwaggerString
166 & schemaEnum %~ addEnumValue tag
166 & schemaEnum %~ addEnumValue tag
167 where
167 where
168 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
168 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
src/Data/Swagger/Internal/Schema.hs+18−18
@@ -58,7 +58,7 @@ named name schema = (Just name, schema)
58--
58--
59-- instance ToSchema Coord where
59-- instance ToSchema Coord where
60-- toNamedSchema = (Just \"Coord\", mempty
60-- toNamedSchema = (Just \"Coord\", mempty
61−-- & schemaType .~ SchemaObject
61+-- & schemaType .~ SwaggerObject
62-- & schemaProperties .~
62-- & schemaProperties .~
63-- [ ("x", toSchemaRef (Proxy :: Proxy Double))
63-- [ ("x", toSchemaRef (Proxy :: Proxy Double))
64-- , ("y", toSchemaRef (Proxy :: Proxy Double))
64-- , ("y", toSchemaRef (Proxy :: Proxy Double))
@@ -113,17 +113,17 @@ gtoSchema opts proxy = snd . gtoNamedSchema opts proxy
113
113
114instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
114instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
115 toNamedSchema _ = unnamed $ mempty
115 toNamedSchema _ = unnamed $ mempty
116− & schemaType .~ SchemaArray
116+ & schemaType .~ SwaggerArray
117 & schemaItems ?~ SchemaItemsObject (toSchemaRef (Proxy :: Proxy a))
117 & schemaItems ?~ SchemaItemsObject (toSchemaRef (Proxy :: Proxy a))
118
118
119instance {-# OVERLAPPING #-} ToSchema String where
119instance {-# OVERLAPPING #-} ToSchema String where
120− toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaString
120+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SwaggerString
121
121
122instance ToSchema Bool where
122instance ToSchema Bool where
123− toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaBoolean
123+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SwaggerBoolean
124
124
125instance ToSchema Integer where
125instance ToSchema Integer where
126− toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaInteger
126+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SwaggerInteger
127
127
128instance ToSchema Int where toNamedSchema = unnamed . toSchemaBoundedIntegral
128instance ToSchema Int where toNamedSchema = unnamed . toSchemaBoundedIntegral
129instance ToSchema Int8 where toNamedSchema = unnamed . toSchemaBoundedIntegral
129instance ToSchema Int8 where toNamedSchema = unnamed . toSchemaBoundedIntegral
@@ -139,18 +139,18 @@ instance ToSchema Word64 where toNamedSchema = unnamed . toSchemaBoundedIntegral
139
139
140instance ToSchema Char where
140instance ToSchema Char where
141 toNamedSchema _ = unnamed $ mempty
141 toNamedSchema _ = unnamed $ mempty
142− & schemaType .~ SchemaString
142+ & schemaType .~ SwaggerString
143 & schemaMaxLength ?~ 1
143 & schemaMaxLength ?~ 1
144 & schemaMinLength ?~ 1
144 & schemaMinLength ?~ 1
145
145
146instance ToSchema Scientific where
146instance ToSchema Scientific where
147− toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaNumber
147+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SwaggerNumber
148
148
149instance ToSchema Double where
149instance ToSchema Double where
150− toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaNumber
150+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SwaggerNumber
151
151
152instance ToSchema Float where
152instance ToSchema Float where
153− toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaNumber
153+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SwaggerNumber
154
154
155instance ToSchema a => ToSchema (Maybe a) where
155instance ToSchema a => ToSchema (Maybe a) where
156 toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
156 toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
@@ -167,7 +167,7 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f
167
167
168timeNamedSchema :: String -> String -> NamedSchema
168timeNamedSchema :: String -> String -> NamedSchema
169timeNamedSchema name format = (Just name, mempty
169timeNamedSchema name format = (Just name, mempty
170− & schemaType .~ SchemaString
170+ & schemaType .~ SwaggerString
171 & schemaFormat ?~ T.pack format
171 & schemaFormat ?~ T.pack format
172 & schemaMinLength ?~ toInteger (length format))
172 & schemaMinLength ?~ toInteger (length format))
173
173
@@ -188,7 +188,7 @@ instance ToSchema LocalTime where
188-- Just "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
188-- Just "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
189instance ToSchema ZonedTime where
189instance ToSchema ZonedTime where
190 toNamedSchema _ = (Just "ZonedTime", mempty
190 toNamedSchema _ = (Just "ZonedTime", mempty
191− & schemaType .~ SchemaString
191+ & schemaType .~ SwaggerString
192 & schemaFormat ?~ "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
192 & schemaFormat ?~ "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
193 & schemaMinLength ?~ toInteger (length ("yyyy-mm-ddThh:MM:ssZ" :: String)))
193 & schemaMinLength ?~ toInteger (length ("yyyy-mm-ddThh:MM:ssZ" :: String)))
194
194
@@ -215,7 +215,7 @@ instance ToSchema a => ToSchema (IntMap a) where
215
215
216instance ToSchema a => ToSchema (Map String a) where
216instance ToSchema a => ToSchema (Map String a) where
217 toNamedSchema _ = unnamed $ mempty
217 toNamedSchema _ = unnamed $ mempty
218− & schemaType .~ SchemaObject
218+ & schemaType .~ SwaggerObject
219 & schemaAdditionalProperties ?~ toSchema (Proxy :: Proxy a)
219 & schemaAdditionalProperties ?~ toSchema (Proxy :: Proxy a)
220
220
221instance ToSchema a => ToSchema (Map T.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
221instance ToSchema a => ToSchema (Map T.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
@@ -295,7 +295,7 @@ defaultSchemaOptions = SchemaOptions
295-- | Default schema for @'Bounded'@, @'Integral'@ types.
295-- | Default schema for @'Bounded'@, @'Integral'@ types.
296toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
296toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
297toSchemaBoundedIntegral _ = mempty
297toSchemaBoundedIntegral _ = mempty
298− & schemaType .~ SchemaInteger
298+ & schemaType .~ SwaggerInteger
299 & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
299 & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
300 & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
300 & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
301
301
@@ -327,7 +327,7 @@ gdatatypeSchemaName opts _ = case name of
327
327
328nullarySchema :: Schema
328nullarySchema :: Schema
329nullarySchema = mempty
329nullarySchema = mempty
330− & schemaType .~ SchemaArray
330+ & schemaType .~ SwaggerArray
331 & schemaEnum ?~ [ toJSON () ]
331 & schemaEnum ?~ [ toJSON () ]
332
332
333instance GToSchema U1 where
333instance GToSchema U1 where
@@ -370,10 +370,10 @@ appendItem _ _ = error "GToSchema.appendItem: cannot append to SchemaItemsObject
370withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) => SchemaOptions -> proxy s f -> Bool -> Schema -> Schema
370withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) => SchemaOptions -> proxy s f -> Bool -> Schema -> Schema
371withFieldSchema opts _ isRequiredField schema
371withFieldSchema opts _ isRequiredField schema
372 | T.null fieldName = schema
372 | T.null fieldName = schema
373− & schemaType .~ SchemaArray
373+ & schemaType .~ SwaggerArray
374 & schemaItems %~ appendItem fieldSchemaRef
374 & schemaItems %~ appendItem fieldSchemaRef
375 | otherwise = schema
375 | otherwise = schema
376− & schemaType .~ SchemaObject
376+ & schemaType .~ SwaggerObject
377 & schemaProperties . at fieldName ?~ fieldSchemaRef
377 & schemaProperties . at fieldName ?~ fieldSchemaRef
378 & if isRequiredField
378 & if isRequiredField
379 then schemaRequired %~ (fieldName :)
379 then schemaRequired %~ (fieldName :)
@@ -401,7 +401,7 @@ instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
401 (All allNullary, sumSchema) = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s
401 (All allNullary, sumSchema) = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s
402
402
403 toStringTag schema = mempty
403 toStringTag schema = mempty
404− & schemaType .~ SchemaString
404+ & schemaType .~ SwaggerString
405 & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)
405 & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)
406
406
407type AllNullary = All
407type AllNullary = All
@@ -420,7 +420,7 @@ instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
420gsumConToSchema :: forall c f proxy. Constructor c =>
420gsumConToSchema :: forall c f proxy. Constructor c =>
421 Bool -> Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> (AllNullary, Schema)
421 Bool -> Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> (AllNullary, Schema)
422gsumConToSchema isNullary tagSchemaRef opts _ schema = (All isNullary, schema
422gsumConToSchema isNullary tagSchemaRef opts _ schema = (All isNullary, schema
423− & schemaType .~ SchemaObject
423+ & schemaType .~ SwaggerObject
424 & schemaProperties . at tag ?~ tagSchemaRef
424 & schemaProperties . at tag ?~ tagSchemaRef
425 & schemaMaxProperties ?~ 1
425 & schemaMaxProperties ?~ 1
426 & schemaMinProperties ?~ 1)
426 & schemaMinProperties ?~ 1)
src/Data/Swagger/Internal/Utils.hs+8
@@ -52,6 +52,14 @@ deriveJSONDefault = deriveJSON (jsonPrefix "")
52deriveJSON' :: Name -> Q [Dec]
52deriveJSON' :: Name -> Q [Dec]
53deriveJSON' name = deriveJSON (jsonPrefix (nameBase name)) name
53deriveJSON' name = deriveJSON (jsonPrefix (nameBase name)) name
54
54
55+parseOneOf :: ToJSON a => [a] -> Value -> Parser a
56+parseOneOf xs js =
57+ case lookup js ys of
58+ Nothing -> fail $ "invalid json: " ++ show js ++ " (expected one of " ++ show (map fst ys) ++ ")"
59+ Just x -> pure x
60+ where
61+ ys = zip (map toJSON xs) xs
62+
55genericToJSONWithSub :: (Generic a, GToJSON (Rep a)) => Text -> Options -> a -> Value
63genericToJSONWithSub :: (Generic a, GToJSON (Rep a)) => Text -> Options -> a -> Value
56genericToJSONWithSub sub opts x =
64genericToJSONWithSub sub opts x =
57 case genericToJSON opts x of
65 case genericToJSON opts x of
src/Data/Swagger/Lens.hs+4−4
@@ -60,10 +60,10 @@ instance HasDescription ExternalDocs (Maybe Text) where description = external
60class HasSchemaCommon s t i | s -> t i where
60class HasSchemaCommon s t i | s -> t i where
61 schemaCommon :: Lens' s (SchemaCommon t i)
61 schemaCommon :: Lens' s (SchemaCommon t i)
62
62
63−instance HasSchemaCommon Schema SchemaType SchemaItems where schemaCommon = schemaSchemaCommon
63+instance HasSchemaCommon Schema (SwaggerType Schema) SchemaItems where schemaCommon = schemaSchemaCommon
64−instance HasSchemaCommon ParamOtherSchema ParamType Items where schemaCommon = paramOtherSchemaCommon
64+instance HasSchemaCommon ParamOtherSchema (SwaggerType Param) Items where schemaCommon = paramOtherSchemaCommon
65−instance HasSchemaCommon Items ItemsType Items where schemaCommon = itemsCommon
65+instance HasSchemaCommon Items (SwaggerType Items) Items where schemaCommon = itemsCommon
66−instance HasSchemaCommon Header ItemsType Items where schemaCommon = headerCommon
66+instance HasSchemaCommon Header (SwaggerType Items) Items where schemaCommon = headerCommon
67instance HasSchemaCommon (SchemaCommon t i) t i where schemaCommon = id
67instance HasSchemaCommon (SchemaCommon t i) t i where schemaCommon = id
68
68
69schemaType :: HasSchemaCommon s t i => Lens' s t
69schemaType :: HasSchemaCommon s t i => Lens' s t
test/Data/SwaggerSpec.hs+22−22
@@ -154,7 +154,7 @@ operationExample = mempty
154 stringSchema :: ParamLocation -> ParamOtherSchema
154 stringSchema :: ParamLocation -> ParamOtherSchema
155 stringSchema i = mempty
155 stringSchema i = mempty
156 & paramOtherSchemaIn .~ i
156 & paramOtherSchemaIn .~ i
157− & schemaType .~ ParamString
157+ & schemaType .~ SwaggerString
158
158
159operationExampleJSON :: Value
159operationExampleJSON :: Value
160operationExampleJSON = [aesonQQ|
160operationExampleJSON = [aesonQQ|
@@ -220,7 +220,7 @@ operationExampleJSON = [aesonQQ|
220
220
221schemaPrimitiveExample :: Schema
221schemaPrimitiveExample :: Schema
222schemaPrimitiveExample = mempty
222schemaPrimitiveExample = mempty
223− & schemaType .~ SchemaString
223+ & schemaType .~ SwaggerString
224 & schemaFormat ?~ "email"
224 & schemaFormat ?~ "email"
225
225
226schemaPrimitiveExampleJSON :: Value
226schemaPrimitiveExampleJSON :: Value
@@ -233,14 +233,14 @@ schemaPrimitiveExampleJSON = [aesonQQ|
233
233
234schemaSimpleModelExample :: Schema
234schemaSimpleModelExample :: Schema
235schemaSimpleModelExample = mempty
235schemaSimpleModelExample = mempty
236− & schemaType .~ SchemaObject
236+ & schemaType .~ SwaggerObject
237 & schemaRequired .~ [ "name" ]
237 & schemaRequired .~ [ "name" ]
238 & schemaProperties .~
238 & schemaProperties .~
239− [ ("name", Inline (mempty & schemaType .~ SchemaString))
239+ [ ("name", Inline (mempty & schemaType .~ SwaggerString))
240 , ("address", Ref (Reference "#/definitions/Address"))
240 , ("address", Ref (Reference "#/definitions/Address"))
241 , ("age", Inline $ mempty
241 , ("age", Inline $ mempty
242 & schemaMinimum ?~ 0
242 & schemaMinimum ?~ 0
243− & schemaType .~ SchemaInteger
243+ & schemaType .~ SwaggerInteger
244 & schemaFormat ?~ "int32" ) ]
244 & schemaFormat ?~ "int32" ) ]
245
245
246schemaSimpleModelExampleJSON :: Value
246schemaSimpleModelExampleJSON :: Value
@@ -268,8 +268,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|
268
268
269schemaModelDictExample :: Schema
269schemaModelDictExample :: Schema
270schemaModelDictExample = mempty
270schemaModelDictExample = mempty
271− & schemaType .~ SchemaObject
271+ & schemaType .~ SwaggerObject
272− & schemaAdditionalProperties ?~ (mempty & schemaType .~ SchemaString)
272+ & schemaAdditionalProperties ?~ (mempty & schemaType .~ SwaggerString)
273
273
274schemaModelDictExampleJSON :: Value
274schemaModelDictExampleJSON :: Value
275schemaModelDictExampleJSON = [aesonQQ|
275schemaModelDictExampleJSON = [aesonQQ|
@@ -282,12 +282,12 @@ schemaModelDictExampleJSON = [aesonQQ|
282|]
282|]
283
283
284schemaWithExampleExample :: Schema
284schemaWithExampleExample :: Schema
285−schemaWithExampleExample = (mempty & schemaType .~ SchemaObject)
285+schemaWithExampleExample = (mempty & schemaType .~ SwaggerObject)
286 { _schemaProperties =
286 { _schemaProperties =
287 [ ("id", Inline $ mempty
287 [ ("id", Inline $ mempty
288− & schemaType .~ SchemaInteger
288+ & schemaType .~ SwaggerInteger
289 & schemaFormat ?~ "int64" )
289 & schemaFormat ?~ "int64" )
290− , ("name", Inline (mempty & schemaType .~ SchemaString)) ]
290+ , ("name", Inline (mempty & schemaType .~ SwaggerString)) ]
291 , _schemaRequired = [ "name" ]
291 , _schemaRequired = [ "name" ]
292 , _schemaExample = Just [aesonQQ|
292 , _schemaExample = Just [aesonQQ|
293 {
293 {
@@ -326,19 +326,19 @@ schemaWithExampleExampleJSON = [aesonQQ|
326definitionsExample :: HashMap Text Schema
326definitionsExample :: HashMap Text Schema
327definitionsExample =
327definitionsExample =
328 [ ("Category", mempty
328 [ ("Category", mempty
329− & schemaType .~ SchemaObject
329+ & schemaType .~ SwaggerObject
330 & schemaProperties .~
330 & schemaProperties .~
331 [ ("id", Inline $ mempty
331 [ ("id", Inline $ mempty
332− & schemaType .~ SchemaInteger
332+ & schemaType .~ SwaggerInteger
333 & schemaFormat ?~ "int64")
333 & schemaFormat ?~ "int64")
334− , ("name", Inline (mempty & schemaType .~ SchemaString)) ] )
334+ , ("name", Inline (mempty & schemaType .~ SwaggerString)) ] )
335 , ("Tag", mempty
335 , ("Tag", mempty
336− & schemaType .~ SchemaObject
336+ & schemaType .~ SwaggerObject
337 & schemaProperties .~
337 & schemaProperties .~
338 [ ("id", Inline $ mempty
338 [ ("id", Inline $ mempty
339− & schemaType .~ SchemaInteger
339+ & schemaType .~ SwaggerInteger
340 & schemaFormat ?~ "int64")
340 & schemaFormat ?~ "int64")
341− , ("name", Inline (mempty & schemaType .~ SchemaString)) ] ) ]
341+ , ("name", Inline (mempty & schemaType .~ SwaggerString)) ] ) ]
342
342
343definitionsExampleJSON :: Value
343definitionsExampleJSON :: Value
344definitionsExampleJSON = [aesonQQ|
344definitionsExampleJSON = [aesonQQ|
@@ -382,7 +382,7 @@ paramsDefinitionExample =
382 , _paramRequired = Just True
382 , _paramRequired = Just True
383 , _paramSchema = ParamOther $ mempty
383 , _paramSchema = ParamOther $ mempty
384 & paramOtherSchemaIn .~ ParamQuery
384 & paramOtherSchemaIn .~ ParamQuery
385− & schemaType .~ ParamInteger
385+ & schemaType .~ SwaggerInteger
386 & schemaFormat ?~ "int32" })
386 & schemaFormat ?~ "int32" })
387 , ("limitParam", mempty
387 , ("limitParam", mempty
388 { _paramName = "limit"
388 { _paramName = "limit"
@@ -390,7 +390,7 @@ paramsDefinitionExample =
390 , _paramRequired = Just True
390 , _paramRequired = Just True
391 , _paramSchema = ParamOther $ mempty
391 , _paramSchema = ParamOther $ mempty
392 & paramOtherSchemaIn .~ ParamQuery
392 & paramOtherSchemaIn .~ ParamQuery
393− & schemaType .~ ParamInteger
393+ & schemaType .~ SwaggerInteger
394 & schemaFormat ?~ "int32" }) ]
394 & schemaFormat ?~ "int32" }) ]
395
395
396paramsDefinitionExampleJSON :: Value
396paramsDefinitionExampleJSON :: Value
@@ -495,7 +495,7 @@ swaggerExample = mempty
495 { _operationResponses = mempty
495 { _operationResponses = mempty
496 { _responsesResponses =
496 { _responsesResponses =
497 [ (200, Inline mempty
497 [ (200, Inline mempty
498− { _responseSchema = Just $ Inline (mempty & schemaType .~ SchemaObject)
498+ { _responseSchema = Just $ Inline (mempty & schemaType .~ SwaggerObject)
499 { _schemaExample = Just [aesonQQ|
499 { _schemaExample = Just [aesonQQ|
500 {
500 {
501 "created": 100,
501 "created": 100,
@@ -504,9 +504,9 @@ swaggerExample = mempty
504 , _schemaDescription = Just "This is some real Todo right here"
504 , _schemaDescription = Just "This is some real Todo right here"
505 , _schemaProperties =
505 , _schemaProperties =
506 [ ("created", Inline $ mempty
506 [ ("created", Inline $ mempty
507− & schemaType .~ SchemaInteger
507+ & schemaType .~ SwaggerInteger
508 & schemaFormat ?~ "int32")
508 & schemaFormat ?~ "int32")
509− , ("description", Inline (mempty & schemaType .~ SchemaString)) ] }
509+ , ("description", Inline (mempty & schemaType .~ SwaggerString)) ] }
510 , _responseDescription = "OK" }) ] }
510 , _responseDescription = "OK" }) ] }
511 , _operationProduces = Just (MimeList [ "application/json" ])
511 , _operationProduces = Just (MimeList [ "application/json" ])
512 , _operationParameters =
512 , _operationParameters =
@@ -516,7 +516,7 @@ swaggerExample = mempty
516 , _paramDescription = Just "TodoId param"
516 , _paramDescription = Just "TodoId param"
517 , _paramSchema = ParamOther $ mempty
517 , _paramSchema = ParamOther $ mempty
518 & paramOtherSchemaIn .~ ParamPath
518 & paramOtherSchemaIn .~ ParamPath
519− & schemaType .~ ParamString } ]
519+ & schemaType .~ SwaggerString } ]
520 , _operationTags = [ "todo" ] } }) ] } }
520 , _operationTags = [ "todo" ] } }) ] } }
521
521
522swaggerExampleJSON :: Value
522swaggerExampleJSON :: Value