3cc860d · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Put CollectionFormat in one place (closes #28).

3cc860dNickolay Kudasov11 years ago

src/Data/Swagger.hs−1

compare with master

unifiedsplit

@@ -52,7 +52,6 @@ module Data.Swagger (

52 ParamOtherSchema(..),

53 ParamLocation(..),

54 ParamName,

55− Items(..),

56 Header(..),

55 Header(..),

57 HeaderName,

56 HeaderName,

58 Example(..),

57 Example(..),

src/Data/Swagger/Internal.hs+29−36

@@ -319,15 +319,21 @@ data ParamOtherSchema = ParamOtherSchema

319 -- Default value is @False@.

320 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool

321

322− -- | Determines the format of the array if @'ParamArray'@ is used.

323− -- Default value is csv.

324− , _paramOtherSchemaCollectionFormat :: Maybe (CollectionFormat Param)

325−

326 , _paramOtherSchemaParamSchema :: ParamSchema ParamOtherSchema

322 , _paramOtherSchemaParamSchema :: ParamSchema ParamOtherSchema

327 } deriving (Eq, Show, Generic, Data, Typeable)

323 } deriving (Eq, Show, Generic, Data, Typeable)

328

324

325+-- | Items for @'SwaggerArray'@ schemas.

326+--

327+-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.

328+-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.

329+-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.

330+-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.

331+--

332+-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.

333+--

334+-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.

329data SwaggerItems t where

335data SwaggerItems t where

330− SwaggerItemsPrimitive :: Items -> SwaggerItems t

336+ SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t

331 SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema

337 SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema

332 SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema

338 SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema

333

339

@@ -341,9 +347,9 @@ swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimiti

341swaggerItemsDataType :: DataType

347swaggerItemsDataType :: DataType

342swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]

348swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]

343

349

344−instance {-# OVERLAPPABLE #-} Typeable t => Data (SwaggerItems t) where

350+instance {-# OVERLAPPABLE #-} Data t => Data (SwaggerItems t) where

345 gunfold k z c = case constrIndex c of

351 gunfold k z c = case constrIndex c of

346− 1 -> k (z SwaggerItemsPrimitive)

352+ 1 -> k (k (z SwaggerItemsPrimitive))

347 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."

353 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."

348 toConstr _ = swaggerItemsPrimitiveConstr

354 toConstr _ = swaggerItemsPrimitiveConstr

349 dataTypeOf _ = swaggerItemsDataType

355 dataTypeOf _ = swaggerItemsDataType

@@ -508,7 +514,7 @@ deriving instance (Data t, Data (SwaggerType t), Data (SwaggerItems t)) => Data

508

514

509data Xml = Xml

515data Xml = Xml

510 { -- | Replaces the name of the element/attribute used for the described schema property.

516 { -- | Replaces the name of the element/attribute used for the described schema property.

511− -- When defined within the @'Items'@ (items), it will affect the name of the individual XML elements within the list.

517+ -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.

512 -- When defined alongside type being array (outside the items),

518 -- When defined alongside type being array (outside the items),

513 -- it will affect the wrapping element and only if wrapped is true.

519 -- it will affect the wrapping element and only if wrapped is true.

514 -- If wrapped is false, it will be ignored.

520 -- If wrapped is false, it will be ignored.

@@ -534,14 +540,6 @@ data Xml = Xml

534 , _xmlWrapped :: Maybe Bool

540 , _xmlWrapped :: Maybe Bool

535 } deriving (Eq, Show, Generic, Data, Typeable)

541 } deriving (Eq, Show, Generic, Data, Typeable)

536

542

537−data Items = Items

538− { -- | Determines the format of the array if type array is used.

539− -- Default value is @'ItemsCollectionCSV'@.

540− _itemsCollectionFormat :: Maybe (CollectionFormat Items)

541−

542− , _itemsParamSchema :: ParamSchema Items

543− } deriving (Eq, Show, Generic, Data, Typeable)

544−

545-- | A container for the expected responses of an operation.

543-- | A container for the expected responses of an operation.

546-- The container maps a HTTP response code to the expected response.

544-- The container maps a HTTP response code to the expected response.

547-- It is not expected from the documentation to necessarily cover all possible HTTP response codes,

545-- It is not expected from the documentation to necessarily cover all possible HTTP response codes,

@@ -585,10 +583,6 @@ data Header = Header

585 { -- | A short description of the header.

583 { -- | A short description of the header.

586 _headerDescription :: Maybe Text

584 _headerDescription :: Maybe Text

587

585

588− -- | Determines the format of the array if type array is used.

589− -- Default value is @'ItemsCollectionCSV'@.

590− , _headerCollectionFormat :: Maybe (CollectionFormat Items)

591−

592 , _headerParamSchema :: ParamSchema Header

586 , _headerParamSchema :: ParamSchema Header

593 } deriving (Eq, Show, Generic, Data, Typeable)

587 } deriving (Eq, Show, Generic, Data, Typeable)

594

588

@@ -942,13 +936,12 @@ instance ToJSON Schema where

942instance ToJSON Header where

936instance ToJSON Header where

943 toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")

937 toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")

944

938

945−instance ToJSON Items where

946− toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "items")

947−

948instance ToJSON (SwaggerItems t) where

939instance ToJSON (SwaggerItems t) where

949− toJSON (SwaggerItemsPrimitive x) = toJSON x

940+ toJSON (SwaggerItemsPrimitive fmt schema) = object

941+ [ "collectionFormat" .= fmt

942+ , "items" .= schema ]

950− toJSON (SwaggerItemsObject x) = toJSON x

943+ toJSON (SwaggerItemsObject x) = object [ "items" .= x ]

951− toJSON (SwaggerItemsArray x) = toJSON x

944+ toJSON (SwaggerItemsArray x) = object [ "items" .= x ]

952

945

953instance ToJSON Host where

946instance ToJSON Host where

954 toJSON (Host host mport) = toJSON $

947 toJSON (Host host mport) = toJSON $

@@ -1017,7 +1010,7 @@ instance ToJSON (CollectionFormat t) where

1017 toJSON CollectionMulti = "multi"

1010 toJSON CollectionMulti = "multi"

1018

1011

1019instance ToJSON (ParamSchema t) where

1012instance ToJSON (ParamSchema t) where

1020− toJSON = genericToJSON (jsonPrefix "paramSchema")

1013+ toJSON = omitEmpties . genericToJSONWithSub "items" (jsonPrefix "paramSchema")

1021

1014

1022-- =======================================================================

1015-- =======================================================================

1023-- Manual FromJSON instances

1016-- Manual FromJSON instances

@@ -1076,11 +1069,10 @@ instance FromJSON Schema where

1076instance FromJSON Header where

1069instance FromJSON Header where

1077 parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")

1070 parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")

1078

1071

1079−instance FromJSON Items where

1080− parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "items")

1081−

1082−instance {-# OVERLAPPABLE #-} FromJSON (SwaggerItems t) where

1072+instance {-# OVERLAPPABLE #-} (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where

1083− parseJSON js = SwaggerItemsPrimitive <$> parseJSON js

1073+ parseJSON (Object o) = SwaggerItemsPrimitive

1074+ <$> o .:? "collectionFormat"

1075+ <*> (o .: "items" >>= parseJSON)

1084

1076

1085instance {-# OVERLAPPING #-} FromJSON (SwaggerItems Schema) where

1077instance {-# OVERLAPPING #-} FromJSON (SwaggerItems Schema) where

1086 parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js

1078 parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js

@@ -1174,16 +1166,17 @@ instance FromJSON (SwaggerType ParamOtherSchema) where

1174instance {-# OVERLAPPABLE #-} FromJSON (SwaggerType t) where

1166instance {-# OVERLAPPABLE #-} FromJSON (SwaggerType t) where

1175 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]

1167 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]

1176

1168

1169+instance {-# OVERLAPPABLE #-} FromJSON (CollectionFormat t) where

1170+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]

1171+

1177instance FromJSON (CollectionFormat Param) where

1172instance FromJSON (CollectionFormat Param) where

1178 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]

1173 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]

1179

1174

1180−instance FromJSON (CollectionFormat Items) where

1181− parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]

1182−

1183-- NOTE: The constraints @FromJSON (SwaggerType t)@ and

1175-- NOTE: The constraints @FromJSON (SwaggerType t)@ and

1184-- @FromJSON (SwaggerItems t)@ are necessary here!

1176-- @FromJSON (SwaggerItems t)@ are necessary here!

1185-- Without the constraint the general instance will be used

1177-- Without the constraint the general instance will be used

1186-- that only accepts common types (i.e. NOT object, null or file)

1178-- that only accepts common types (i.e. NOT object, null or file)

1187-- and primitive array items.

1179-- and primitive array items.

1188instance (FromJSON (SwaggerType t), FromJSON (SwaggerItems t)) => FromJSON (ParamSchema t) where

1180instance (FromJSON (SwaggerType t), FromJSON (SwaggerItems t)) => FromJSON (ParamSchema t) where

1189− parseJSON = genericParseJSON (jsonPrefix "ParamSchema")

1181+ parseJSON = genericParseJSONWithSub "items" (jsonPrefix "ParamSchema")

1182+

src/Data/Swagger/Internal/ParamSchema.hs+1−1

@@ -174,7 +174,7 @@ instance ToParamSchema a => ToParamSchema (Dual a) where toParamSchema _ = to

174instance ToParamSchema a => ToParamSchema [a] where

175 toParamSchema _ = mempty

176 & schemaType .~ SwaggerArray

177− & schemaItems ?~ SwaggerItemsPrimitive (Items Nothing (toParamSchema (Proxy :: Proxy a)))

177+ & schemaItems ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))

178

179instance ToParamSchema a => ToParamSchema (Set a) where

180 toParamSchema _ = toParamSchema (Proxy :: Proxy [a])

src/Data/Swagger/Internal/Utils.hs+9−4

@@ -14,6 +14,7 @@ import Data.Data

14import Data.Hashable (Hashable)

15import Data.HashMap.Strict (HashMap)

16import qualified Data.HashMap.Strict as HashMap

17+import Data.Map (Map)

17import Data.Monoid

18import Data.Monoid

18import Data.Text (Text)

19import Data.Text (Text)

19import GHC.Generics

20import GHC.Generics

@@ -66,14 +67,17 @@ genericToJSONWithSub :: (Generic a, GToJSON (Rep a)) => Text -> Options -> a ->

66genericToJSONWithSub sub opts x =

67genericToJSONWithSub sub opts x =

67 case genericToJSON opts x of

68 case genericToJSON opts x of

68 Object o ->

69 Object o ->

69− let so = HashMap.lookupDefault (error "impossible") sub o

70+ case HashMap.lookup sub o of

70− in Object (HashMap.delete sub o) <+> so

71+ Just so -> Object (HashMap.delete sub o) <+> so

72+ Nothing -> Object o -- no subjson, leaving object as is

71 _ -> error "genericToJSONWithSub: subjson is not an object"

73 _ -> error "genericToJSONWithSub: subjson is not an object"

73genericParseJSONWithSub :: (Generic a, GFromJSON (Rep a)) => Text -> Options -> Value -> Parser a

75genericParseJSONWithSub :: (Generic a, GFromJSON (Rep a)) => Text -> Options -> Value -> Parser a

74−genericParseJSONWithSub sub opts (Object o) = genericParseJSON opts js

76+genericParseJSONWithSub sub opts js@(Object o)

77+ = genericParseJSON opts js -- try without subjson

78+ <|> genericParseJSON opts js' -- try with subjson

75 where

79 where

76− js = Object (HashMap.insert sub (Object o) o)

80+ js' = Object (HashMap.insert sub (Object o) o)

77genericParseJSONWithSub _ _ _ = error "genericParseJSONWithSub: given json is not an object"

81genericParseJSONWithSub _ _ _ = error "genericParseJSONWithSub: given json is not an object"

79(<+>) :: Value -> Value -> Value

83(<+>) :: Value -> Value -> Value

@@ -119,6 +123,7 @@ class SwaggerMonoid m where

119 swaggerMappend = mappend

123 swaggerMappend = mappend

120

124

121instance SwaggerMonoid [a]

125instance SwaggerMonoid [a]

126+instance Ord k => SwaggerMonoid (Map k v)

122

127

123instance SwaggerMonoid Text where

128instance SwaggerMonoid Text where

124 swaggerMempty = mempty

129 swaggerMempty = mempty

src/Data/Swagger/Lens.hs−3

@@ -38,8 +38,6 @@ makeLenses ''Param

38makePrisms ''ParamAnySchema

39-- ** 'ParamOtherSchema' lenses

40makeLenses ''ParamOtherSchema

41−-- ** 'Items' lenses

42−makeLenses ''Items

43-- ** 'Header' lenses

41-- ** 'Header' lenses

44makeLenses ''Header

42makeLenses ''Header

45-- ** 'Schema' lenses

43-- ** 'Schema' lenses

@@ -86,7 +84,6 @@ class HasParamSchema s t | s -> t where

87instance HasParamSchema Schema Schema where parameterSchema = schemaParamSchema

85instance HasParamSchema Schema Schema where parameterSchema = schemaParamSchema

88instance HasParamSchema ParamOtherSchema ParamOtherSchema where parameterSchema = paramOtherSchemaParamSchema

86instance HasParamSchema ParamOtherSchema ParamOtherSchema where parameterSchema = paramOtherSchemaParamSchema

89−instance HasParamSchema Items Items where parameterSchema = itemsParamSchema

90instance HasParamSchema Header Header where parameterSchema = headerParamSchema

87instance HasParamSchema Header Header where parameterSchema = headerParamSchema

91instance HasParamSchema (ParamSchema t) t where parameterSchema = id

88instance HasParamSchema (ParamSchema t) t where parameterSchema = id