1d25fb1 · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Fix compilation issues and warnings

1d25fb1Oleg Grenrus11 years ago

src/Data/Swagger/Internal.hs+48−49

compare with master

unifiedsplit

@@ -1,4 +1,5 @@

1{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveFunctor #-}

4{-# LANGUAGE DeriveFunctor #-}

4{-# LANGUAGE DeriveGeneric #-}

5{-# LANGUAGE DeriveGeneric #-}

@@ -8,15 +9,15 @@

8{-# LANGUAGE GADTs #-}

9{-# LANGUAGE GADTs #-}

9{-# LANGUAGE GeneralizedNewtypeDeriving #-}

10{-# LANGUAGE GeneralizedNewtypeDeriving #-}

10{-# LANGUAGE OverloadedStrings #-}

11{-# LANGUAGE OverloadedStrings #-}

11−{-# LANGUAGE PolyKinds #-}

12{-# LANGUAGE RecordWildCards #-}

13{-# LANGUAGE ScopedTypeVariables #-}

14{-# LANGUAGE StandaloneDeriving #-}

15−{-# LANGUAGE UndecidableInstances #-}

16−

17−{-# LANGUAGE DataKinds #-}

18−{-# LANGUAGE TypeFamilies #-}

19{-# LANGUAGE TemplateHaskell #-}

15{-# LANGUAGE TemplateHaskell #-}

16+{-# LANGUAGE TypeFamilies #-}

17+{-# LANGUAGE UndecidableInstances #-}

18+#if __GLASGOW_HASKELL__ <710

19+{-# LANGUAGE PolyKinds #-}

20+#endif

20#include "overlapping-compat.h"

21#include "overlapping-compat.h"

21module Data.Swagger.Internal where

22module Data.Swagger.Internal where

@@ -25,11 +26,9 @@ import Prelude.Compat

26import Control.Lens ((&), (.~), (?~))

27import Control.Lens ((&), (.~), (?~))

27import Control.Applicative

28import Control.Applicative

28−import Control.Monad

29import Data.Aeson

30import qualified Data.Aeson.Types as JSON

31import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)

32−import Data.HashMap.Strict (HashMap)

33import qualified Data.HashMap.Strict as HashMap

32import qualified Data.HashMap.Strict as HashMap

34import Data.Map (Map)

33import Data.Map (Map)

35import qualified Data.Map as Map

34import qualified Data.Map as Map

@@ -355,7 +354,7 @@ data ParamOtherSchema = ParamOtherSchema

355 -- Default value is @False@.

354 -- Default value is @False@.

356 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool

355 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool

357

356

358− , _paramOtherSchemaParamSchema :: ParamSchema SwaggerKindParamOtherSchema

357+ , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema

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

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

360

359

361-- | Items for @'SwaggerArray'@ schemas.

360-- | Items for @'SwaggerArray'@ schemas.

@@ -370,8 +369,8 @@ data ParamOtherSchema = ParamOtherSchema

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

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

371data SwaggerItems t where

370data SwaggerItems t where

372 SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k

371 SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k

373− SwaggerItemsObject :: Referenced Schema -> SwaggerItems SwaggerKindSchema

372+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema

374− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems SwaggerKindSchema

373+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema

375 deriving (Typeable)

374 deriving (Typeable)

376

375

377deriving instance Eq (SwaggerItems t)

376deriving instance Eq (SwaggerItems t)

@@ -393,7 +392,7 @@ swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimi

393-- Note: unfortunately we have to write these Data instances by hand,

392-- Note: unfortunately we have to write these Data instances by hand,

394-- to get better contexts / avoid duplicate name when using standalone deriving

393-- to get better contexts / avoid duplicate name when using standalone deriving

395

394

396−instance Data t => Data (SwaggerItems (SwaggerKindNormal t)) where

395+instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where

397 -- TODO: define gfoldl

396 -- TODO: define gfoldl

398 gunfold k z c = case constrIndex c of

397 gunfold k z c = case constrIndex c of

399 1 -> k (k (z SwaggerItemsPrimitive))

398 1 -> k (k (z SwaggerItemsPrimitive))

@@ -402,7 +401,7 @@ instance Data t => Data (SwaggerItems (SwaggerKindNormal t)) where

402 dataTypeOf _ = swaggerItemsDataType

401 dataTypeOf _ = swaggerItemsDataType

403

402

404-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only

403-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only

405−instance Data (SwaggerItems SwaggerKindParamOtherSchema) where

404+instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where

406 -- TODO: define gfoldl

405 -- TODO: define gfoldl

407 gunfold k z c = case constrIndex c of

406 gunfold k z c = case constrIndex c of

408 1 -> k (k (z SwaggerItemsPrimitive))

407 1 -> k (k (z SwaggerItemsPrimitive))

@@ -410,18 +409,19 @@ instance Data (SwaggerItems SwaggerKindParamOtherSchema) where

410 toConstr _ = swaggerItemsPrimitiveConstr

409 toConstr _ = swaggerItemsPrimitiveConstr

411 dataTypeOf _ = swaggerItemsDataType

410 dataTypeOf _ = swaggerItemsDataType

412

411

413−instance Data (SwaggerItems SwaggerKindSchema) where

412+instance Data (SwaggerItems 'SwaggerKindSchema) where

414 gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"

413 gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"

415 gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref

414 gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref

416 gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref

415 gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref

417

416

418 gunfold k z c = case constrIndex c of

417 gunfold k z c = case constrIndex c of

419− 1 -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)"

420 2 -> k (z SwaggerItemsObject)

418 2 -> k (z SwaggerItemsObject)

421 3 -> k (z SwaggerItemsArray)

419 3 -> k (z SwaggerItemsArray)

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

422

421

422+ toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"

423− toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr

423+ toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr

424− toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr

424+ toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr

425

426 dataTypeOf _ = swaggerItemsDataType

427

@@ -430,17 +430,16 @@ data SwaggerKind t

430 = SwaggerKindNormal t

431 | SwaggerKindParamOtherSchema

432 | SwaggerKindSchema

433+ deriving (Typeable)

433

434

434−#if __GLASGLOW_HASKELL__ < 710

435deriving instance Typeable 'SwaggerKindNormal

436deriving instance Typeable 'SwaggerKindParamOtherSchema

437deriving instance Typeable 'SwaggerKindSchema

438−#endif

439

438

440type family SwaggerKindType (k :: SwaggerKind *) :: *

439type family SwaggerKindType (k :: SwaggerKind *) :: *

441−type instance SwaggerKindType (SwaggerKindNormal t) = t

440+type instance SwaggerKindType ('SwaggerKindNormal t) = t

442−type instance SwaggerKindType SwaggerKindSchema = Schema

441+type instance SwaggerKindType 'SwaggerKindSchema = Schema

443−type instance SwaggerKindType SwaggerKindParamOtherSchema = ParamOtherSchema

442+type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema

444

443

445data SwaggerType t where

444data SwaggerType t where

446 SwaggerString :: SwaggerType t

445 SwaggerString :: SwaggerType t

@@ -448,9 +447,9 @@ data SwaggerType t where

448 SwaggerInteger :: SwaggerType t

447 SwaggerInteger :: SwaggerType t

449 SwaggerBoolean :: SwaggerType t

448 SwaggerBoolean :: SwaggerType t

450 SwaggerArray :: SwaggerType t

449 SwaggerArray :: SwaggerType t

451− SwaggerFile :: SwaggerType SwaggerKindParamOtherSchema

450+ SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema

452− SwaggerNull :: SwaggerType SwaggerKindSchema

451+ SwaggerNull :: SwaggerType 'SwaggerKindSchema

453− SwaggerObject :: SwaggerType SwaggerKindSchema

452+ SwaggerObject :: SwaggerType 'SwaggerKindSchema

454 deriving (Typeable)

453 deriving (Typeable)

455

454

456deriving instance Eq (SwaggerType t)

455deriving instance Eq (SwaggerType t)

@@ -465,27 +464,27 @@ swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs

465swaggerCommonTypes :: [SwaggerType k]

464swaggerCommonTypes :: [SwaggerType k]

466swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]

465swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]

467

466

468−swaggerParamTypes :: [SwaggerType SwaggerKindParamOtherSchema]

467+swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]

469swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]

468swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]

470

469

471−swaggerSchemaTypes :: [SwaggerType SwaggerKindSchema]

470+swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]

472swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]

471swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]

473

472

474swaggerTypeConstrs :: [Constr]

473swaggerTypeConstrs :: [Constr]

475−swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType SwaggerKindSchema])

474+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])

476 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]

475 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]

477

476

478−instance Typeable t => Data (SwaggerType (SwaggerKindNormal t)) where

477+instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where

479 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes

478 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes

480 toConstr = swaggerTypeConstr

479 toConstr = swaggerTypeConstr

481 dataTypeOf = swaggerTypeDataType

480 dataTypeOf = swaggerTypeDataType

482

481

483−instance Data (SwaggerType SwaggerKindParamOtherSchema) where

482+instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where

484 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes

483 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes

485 toConstr = swaggerTypeConstr

484 toConstr = swaggerTypeConstr

486 dataTypeOf = swaggerTypeDataType

485 dataTypeOf = swaggerTypeDataType

487

486

488−instance Data (SwaggerType SwaggerKindSchema) where

487+instance Data (SwaggerType 'SwaggerKindSchema) where

489 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes

488 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes

490 toConstr = swaggerTypeConstr

489 toConstr = swaggerTypeConstr

491 dataTypeOf = swaggerTypeDataType

490 dataTypeOf = swaggerTypeDataType

@@ -525,7 +524,7 @@ data CollectionFormat t where

525 -- Corresponds to multiple parameter instances

524 -- Corresponds to multiple parameter instances

526 -- instead of multiple values for a single instance @foo=bar&foo=baz@.

525 -- instead of multiple values for a single instance @foo=bar&foo=baz@.

527 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.

526 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.

528− CollectionMulti :: CollectionFormat SwaggerKindParamOtherSchema

527+ CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema

529 deriving (Typeable)

528 deriving (Typeable)

530

529

531deriving instance Eq (CollectionFormat t)

530deriving instance Eq (CollectionFormat t)

@@ -541,12 +540,12 @@ collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $

541collectionCommonFormats :: [CollectionFormat t]

540collectionCommonFormats :: [CollectionFormat t]

542collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]

541collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]

543

542

544−instance Data t => Data (CollectionFormat (SwaggerKindNormal t)) where

543+instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where

545 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats

544 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats

546 toConstr = collectionFormatConstr

545 toConstr = collectionFormatConstr

547 dataTypeOf _ = collectionFormatDataType

546 dataTypeOf _ = collectionFormatDataType

548

547

549−deriving instance Data (CollectionFormat SwaggerKindParamOtherSchema)

548+deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)

550

549

551type ParamName = Text

550type ParamName = Text

552

551

@@ -568,7 +567,7 @@ data Schema = Schema

568 , _schemaMaxProperties :: Maybe Integer

567 , _schemaMaxProperties :: Maybe Integer

569 , _schemaMinProperties :: Maybe Integer

568 , _schemaMinProperties :: Maybe Integer

570

569

571− , _schemaParamSchema :: ParamSchema SwaggerKindSchema

570+ , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema

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

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

573

572

574-- | A @'Schema'@ with an optional name.

573-- | A @'Schema'@ with an optional name.

@@ -682,7 +681,7 @@ data Header = Header

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

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

683 _headerDescription :: Maybe Text

682 _headerDescription :: Maybe Text

684

683

685− , _headerParamSchema :: ParamSchema (SwaggerKindNormal Header)

684+ , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)

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

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

687

686

688data Example = Example { getExample :: Map MediaType Value }

687data Example = Example { getExample :: Map MediaType Value }

@@ -1139,17 +1138,17 @@ instance FromJSON Schema where

1139instance FromJSON Header where

1138instance FromJSON Header where

1140 parseJSON = sopSwaggerGenericParseJSON

1139 parseJSON = sopSwaggerGenericParseJSON

1141

1140

1142−instance (FromJSON (CollectionFormat (SwaggerKindNormal t)), FromJSON (ParamSchema (SwaggerKindNormal t))) => FromJSON (SwaggerItems (SwaggerKindNormal t)) where

1141+instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where

1143 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive

1142 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive

1144 <$> o .:? "collectionFormat"

1143 <$> o .:? "collectionFormat"

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

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

1146

1145

1147−instance FromJSON (SwaggerItems SwaggerKindParamOtherSchema) where

1146+instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where

1148 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive

1147 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive

1149 <$> o .:? "collectionFormat"

1148 <$> o .:? "collectionFormat"

1150 <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))

1149 <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))

1151

1150

1152−instance FromJSON (SwaggerItems SwaggerKindSchema) where

1151+instance FromJSON (SwaggerItems 'SwaggerKindSchema) where

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

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

1154 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js

1153 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js

1155 parseJSON _ = empty

1154 parseJSON _ = empty

@@ -1226,30 +1225,30 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#

1226instance FromJSON Xml where

1225instance FromJSON Xml where

1227 parseJSON = genericParseJSON (jsonPrefix "xml")

1226 parseJSON = genericParseJSON (jsonPrefix "xml")

1228

1227

1229−instance FromJSON (SwaggerType SwaggerKindSchema) where

1228+instance FromJSON (SwaggerType 'SwaggerKindSchema) where

1230 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]

1229 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]

1231

1230

1232−instance FromJSON (SwaggerType SwaggerKindParamOtherSchema) where

1231+instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where

1233 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]

1232 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]

1234

1233

1235−instance FromJSON (SwaggerType (SwaggerKindNormal t)) where

1234+instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where

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

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

1237

1236

1238−instance FromJSON (CollectionFormat (SwaggerKindNormal t)) where

1237+instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where

1239 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]

1238 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]

1240

1239

1241-- NOTE: There aren't collections of 'Schema'

1240-- NOTE: There aren't collections of 'Schema'

1242--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where

1241--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where

1243-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]

1242-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]

1244

1243

1245−instance FromJSON (CollectionFormat SwaggerKindParamOtherSchema) where

1244+instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where

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

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

1247

1246

1248−instance (FromJSON (SwaggerType (SwaggerKindNormal t)), FromJSON (SwaggerItems (SwaggerKindNormal t))) => FromJSON (ParamSchema (SwaggerKindNormal t)) where

1247+instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where

1249 parseJSON = sopSwaggerGenericParseJSON

1248 parseJSON = sopSwaggerGenericParseJSON

1250−instance FromJSON (ParamSchema SwaggerKindParamOtherSchema) where

1249+instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where

1251 parseJSON = sopSwaggerGenericParseJSON

1250 parseJSON = sopSwaggerGenericParseJSON

1252−instance FromJSON (ParamSchema SwaggerKindSchema) where

1251+instance FromJSON (ParamSchema 'SwaggerKindSchema) where

1253 parseJSON = sopSwaggerGenericParseJSON

1252 parseJSON = sopSwaggerGenericParseJSON

1254

1253

1255-------------------------------------------------------------------------------

1254-------------------------------------------------------------------------------

@@ -1292,12 +1291,12 @@ instance HasSwaggerAesonOptions Schema where

1292instance HasSwaggerAesonOptions Swagger where

1291instance HasSwaggerAesonOptions Swagger where

1293 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]

1292 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]

1294

1293

1295−instance HasSwaggerAesonOptions (ParamSchema (SwaggerKindNormal t)) where

1294+instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where

1296 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"

1295 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"

1297−instance HasSwaggerAesonOptions (ParamSchema SwaggerKindParamOtherSchema) where

1296+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where

1298 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"

1297 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"

1299-- NOTE: Schema doesn't have 'items' sub object!

1298-- NOTE: Schema doesn't have 'items' sub object!

1300−instance HasSwaggerAesonOptions (ParamSchema SwaggerKindSchema) where

1299+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where

1301 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"

1300 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"

1302

1301

1303instance AesonDefaultValue (ParamSchema s)

1302instance AesonDefaultValue (ParamSchema s)

src/Data/Swagger/Internal/AesonUtils.hs+14−2

@@ -32,6 +32,7 @@ import Control.Monad (unless)

32import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject)

33import Data.Aeson.Types (Parser, Pair)

34import Data.Char (toLower, isUpper)

35+import Data.Foldable (traverse_)

35import Data.Text (Text)

36import Data.Text (Text)

37import Generics.SOP

38import Generics.SOP

@@ -44,7 +45,6 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrd

44#if MIN_VERSION_aeson(0,10,0)

45#if MIN_VERSION_aeson(0,10,0)

45import Data.Aeson (Encoding, pairs, (.=), Series)

46import Data.Aeson (Encoding, pairs, (.=), Series)

46import Data.Monoid ((<>))

47import Data.Monoid ((<>))

47−import Data.Foldable (foldMap)

48#endif

50-------------------------------------------------------------------------------

@@ -145,6 +145,7 @@ sopSwaggerGenericToJSON'

145 -> [Pair]

146sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

147 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs

148+sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"

148

149

149sopSwaggerGenericToJSON''

150sopSwaggerGenericToJSON''

150 :: (All ToJSON xs, All Eq xs)

151 :: (All ToJSON xs, All Eq xs)

@@ -171,6 +172,9 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go

171 json = toJSON x

172 json = toJSON x

172 name' = fieldNameModifier name

173 name' = fieldNameModifier name

173 rest = go xs names defs

174 rest = go xs names defs

175+#if __GLASGOW_HASKELL__ < 800

176+ go _ _ _ = error "not empty"

177+#endif

174

178

175 fieldNameModifier = modifier . drop 1

179 fieldNameModifier = modifier . drop 1

176 modifier = lowerFirstUppers . drop (length prefix)

180 modifier = lowerFirstUppers . drop (length prefix)

@@ -195,7 +199,7 @@ sopSwaggerGenericParseJSON

195sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->

199sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->

196 let ps = sopSwaggerGenericParseJSON' opts obj (datatypeInfo proxy) (aesonDefaults proxy)

200 let ps = sopSwaggerGenericParseJSON' opts obj (datatypeInfo proxy) (aesonDefaults proxy)

197 in do

201 in do

198− traverse (parseAdditionalField obj) (opts ^. saoAdditionalPairs)

202+ traverse_ (parseAdditionalField obj) (opts ^. saoAdditionalPairs)

199 to <$> ps

203 to <$> ps

200 where

204 where

201 proxy = Proxy :: Proxy a

205 proxy = Proxy :: Proxy a

@@ -218,6 +222,7 @@ sopSwaggerGenericParseJSON'

218 -> Parser (SOP I '[xs])

222 -> Parser (SOP I '[xs])

219sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

223sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

220 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs

224 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs

225+sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"

221

226

222sopSwaggerGenericParseJSON''

227sopSwaggerGenericParseJSON''

223 :: (All FromJSON xs, All Eq xs)

228 :: (All FromJSON xs, All Eq xs)

@@ -245,6 +250,9 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go

245 withDef = case def of

250 withDef = case def of

246 Just def' -> (<|> pure def')

251 Just def' -> (<|> pure def')

247 Nothing -> id

252 Nothing -> id

253+#if __GLASGOW_HASKELL__ < 800

254+ go _ _ = error "not empty"

255+#endif

248

256

249 fieldNameModifier = modifier . drop 1

257 fieldNameModifier = modifier . drop 1

250 modifier = lowerFirstUppers . drop (length prefix)

258 modifier = lowerFirstUppers . drop (length prefix)

@@ -287,6 +295,7 @@ sopSwaggerGenericToEncoding'

287 -> Series

295 -> Series

288sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

296sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

289 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs

297 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs

298+sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"

290

299

291sopSwaggerGenericToEncoding''

300sopSwaggerGenericToEncoding''

292 :: (All ToJSON xs, All Eq xs)

301 :: (All ToJSON xs, All Eq xs)

@@ -312,6 +321,9 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go

312 where

321 where

313 name' = fieldNameModifier name

322 name' = fieldNameModifier name

314 rest = go xs names defs

323 rest = go xs names defs

324+#if __GLASGOW_HASKELL__ < 800

325+ go _ _ _ = error "not empty"

326+#endif

315

327

316 fieldNameModifier = modifier . drop 1

328 fieldNameModifier = modifier . drop 1

317 modifier = lowerFirstUppers . drop (length prefix)

329 modifier = lowerFirstUppers . drop (length prefix)

src/Data/Swagger/Internal/Utils.hs−3

@@ -9,8 +9,6 @@ module Data.Swagger.Internal.Utils where

9import Prelude ()

10import Prelude.Compat

12−import Control.Arrow (first)

13−import Control.Applicative

14import Control.Lens ((&), (%~))

12import Control.Lens ((&), (%~))

15import Control.Lens.TH

13import Control.Lens.TH

16import Data.Aeson

14import Data.Aeson

@@ -28,7 +26,6 @@ import Data.Set (Set)

28import Data.Text (Text)

26import Data.Text (Text)

29import GHC.Generics

27import GHC.Generics

30import Language.Haskell.TH (mkName)

28import Language.Haskell.TH (mkName)

31−import Text.Read (readMaybe)

33swaggerFieldRules :: LensRules

30swaggerFieldRules :: LensRules

34swaggerFieldRules = defaultFieldRules & lensField %~ swaggerFieldNamer

31swaggerFieldRules = defaultFieldRules & lensField %~ swaggerFieldNamer

src/Data/Swagger/Lens.hs+7−7

@@ -60,14 +60,14 @@ makePrisms ''Referenced

61-- ** 'SwaggerItems' prisms

63−_SwaggerItemsArray :: Review (SwaggerItems SwaggerKindSchema) [Referenced Schema]

63+_SwaggerItemsArray :: Review (SwaggerItems 'SwaggerKindSchema) [Referenced Schema]

64_SwaggerItemsArray

65 = prism (\x -> SwaggerItemsArray x) $ \x -> case x of

66 SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)

67 SwaggerItemsObject o -> Left (SwaggerItemsObject o)

68 SwaggerItemsArray a -> Right a

70−_SwaggerItemsObject :: Review (SwaggerItems SwaggerKindSchema) (Referenced Schema)

70+_SwaggerItemsObject :: Review (SwaggerItems 'SwaggerKindSchema) (Referenced Schema)

71_SwaggerItemsObject

72 = prism (\x -> SwaggerItemsObject x) $ \x -> case x of

73 SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)

@@ -92,13 +92,13 @@ instance At Responses where at n = responses . at n

92instance Ixed Operation where ix n = responses . ix n

93instance At Operation where at n = responses . at n

95−instance HasParamSchema NamedSchema (ParamSchema SwaggerKindSchema) where paramSchema = schema.paramSchema

95+instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema

97-- HasType instances

98−instance HasType Header (SwaggerType (SwaggerKindNormal Header)) where type_ = paramSchema.type_

98+instance HasType Header (SwaggerType ('SwaggerKindNormal Header)) where type_ = paramSchema.type_

99−instance HasType Schema (SwaggerType SwaggerKindSchema) where type_ = paramSchema.type_

99+instance HasType Schema (SwaggerType 'SwaggerKindSchema) where type_ = paramSchema.type_

100−instance HasType NamedSchema (SwaggerType SwaggerKindSchema) where type_ = paramSchema.type_

100+instance HasType NamedSchema (SwaggerType 'SwaggerKindSchema) where type_ = paramSchema.type_

101−instance HasType ParamOtherSchema (SwaggerType SwaggerKindParamOtherSchema) where type_ = paramSchema.type_

101+instance HasType ParamOtherSchema (SwaggerType 'SwaggerKindParamOtherSchema) where type_ = paramSchema.type_

102

103-- HasDefault instances

104instance HasDefault Header (Maybe Value) where default_ = paramSchema.default_