@@ -1,5 +1,4 @@
11{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
32{-# LANGUAGE DeriveDataTypeable #-}
43{-# LANGUAGE DeriveFunctor #-}
54{-# LANGUAGE DeriveGeneric #-}
@@ -12,64 +11,38 @@
1211{-# LANGUAGE RecordWildCards #-}
1312{-# LANGUAGE ScopedTypeVariables #-}
1413{-# LANGUAGE StandaloneDeriving #-}
15−{-# LANGUAGE TemplateHaskell #-}
16−{-# LANGUAGE TypeFamilies #-}
1714{-# LANGUAGE UndecidableInstances #-}
18−#if __GLASGOW_HASKELL__ <710
19−{-# LANGUAGE PolyKinds #-}
20−#endif
2115#include "overlapping-compat.h"
2216module Data.Swagger.Internal where
2317
2418import Prelude ()
2519import Prelude.Compat
2620
27−import Control.Lens ((&), (.~), (?~))
2821import Control.Applicative
22+import Control.Monad
2923import Data.Aeson
3024import qualified Data.Aeson.Types as JSON
3125import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
32−import Data.Hashable (Hashable)
26+import Data.HashMap.Strict (HashMap)
3327import qualified Data.HashMap.Strict as HashMap
34−import Data.HashSet.InsOrd (InsOrdHashSet)
3528import Data.Map (Map)
3629import qualified Data.Map as Map
37−import Data.Monoid (Monoid (..))
38−import Data.Semigroup.Compat (Semigroup (..))
30+import Data.Monoid
3931import Data.Scientific (Scientific)
32+import Data.Set (Set)
4033import Data.String (IsString(..))
4134import Data.Text (Text)
4235import qualified Data.Text as Text
4336import GHC.Generics (Generic)
44−import Network.Socket (HostName, PortNumber)
37+import Network (HostName, PortNumber)
4538import Network.HTTP.Media (MediaType)
4639import Text.Read (readMaybe)
4740
4841import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
4942import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
5043
51−import Generics.SOP.TH (deriveGeneric)
52−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
53− ,sopSwaggerGenericToJSONWithOpts
54− ,sopSwaggerGenericParseJSON
55− ,HasSwaggerAesonOptions(..)
56− ,AesonDefaultValue(..)
57− ,mkSwaggerAesonOptions
58− ,saoAdditionalPairs
59− ,saoSubObject)
6044import Data.Swagger.Internal.Utils
6145
62−#if MIN_VERSION_aeson(0,10,0)
63−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
64−#define DEFINE_TOENCODING toEncoding = sopSwaggerGenericToEncoding
65−#else
66−#define DEFINE_TOENCODING
67−#endif
68−
69−-- $setup
70−-- >>> :seti -XDataKinds
71−-- >>> import Data.Aeson
72−
7346-- | A list of definitions that can be used in references.
7447type Definitions = InsOrdHashMap Text
7548
@@ -117,7 +90,7 @@ data Swagger = Swagger
11790 , _swaggerResponses :: Definitions Response
11891
11992 -- | Security scheme definitions that can be used across the specification.
120− , _swaggerSecurityDefinitions :: SecurityDefinitions
93+ , _swaggerSecurityDefinitions :: Definitions SecurityScheme
12194
12295 -- | A declaration of which security schemes are applied for the API as a whole.
12396 -- The list of values describes alternative security schemes that can be used
@@ -130,7 +103,7 @@ data Swagger = Swagger
130103 -- Not all tags that are used by the Operation Object must be declared.
131104 -- The tags that are not declared may be organized randomly or based on the tools' logic.
132105 -- Each tag name in the list MUST be unique.
133− , _swaggerTags :: InsOrdHashSet Tag
106+ , _swaggerTags :: Set Tag
134107
135108 -- | Additional external documentation.
136109 , _swaggerExternalDocs :: Maybe ExternalDocs
@@ -252,7 +225,7 @@ data PathItem = PathItem
252225data Operation = Operation
253226 { -- | A list of tags for API documentation control.
254227 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
255− _operationTags :: InsOrdHashSet TagName
228+ _operationTags :: Set TagName
256229
257230 -- | A short summary of what the operation does.
258231 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
@@ -309,7 +282,7 @@ data Operation = Operation
309282 } deriving (Eq, Show, Generic, Data, Typeable)
310283
311284newtype MimeList = MimeList { getMimeList :: [MediaType] }
312− deriving (Eq, Show, Semigroup, Monoid, Typeable)
285+ deriving (Eq, Show, Monoid, Typeable)
313286
314287mimeListConstr :: Constr
315288mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
@@ -360,8 +333,8 @@ data ParamOtherSchema = ParamOtherSchema
360333 -- Default value is @False@.
361334 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
362335
363− , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
364− } deriving (Eq, Show, Generic, Typeable, Data)
336+ , _paramOtherSchemaParamSchema :: ParamSchema ParamOtherSchema
337+ } deriving (Eq, Show, Generic, Data, Typeable)
365338
366339-- | Items for @'SwaggerArray'@ schemas.
367340--
@@ -374,9 +347,9 @@ data ParamOtherSchema = ParamOtherSchema
374347--
375348-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
376349data SwaggerItems t where
377− SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
378− SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
379− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
350+ SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
351+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema
352+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema
380353 deriving (Typeable)
381354
382355deriving instance Eq (SwaggerItems t)
@@ -386,66 +359,17 @@ deriving instance Show (SwaggerItems t)
386359swaggerItemsPrimitiveConstr :: Constr
387360swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
388361
389−swaggerItemsObjectConstr :: Constr
390−swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
391−
392−swaggerItemsArrayConstr :: Constr
393−swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
394−
395362swaggerItemsDataType :: DataType
396363swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
397364
398−-- Note: unfortunately we have to write these Data instances by hand,
399−-- to get better contexts / avoid duplicate name when using standalone deriving
400−
401−instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
402− -- TODO: define gfoldl
365+instance OVERLAPPABLE_ Data t => Data (SwaggerItems t) where
403366 gunfold k z c = case constrIndex c of
404367 1 -> k (k (z SwaggerItemsPrimitive))
405368 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
406369 toConstr _ = swaggerItemsPrimitiveConstr
407370 dataTypeOf _ = swaggerItemsDataType
408371
409−-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
410−instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
411− -- TODO: define gfoldl
412− gunfold k z c = case constrIndex c of
413− 1 -> k (k (z SwaggerItemsPrimitive))
414− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
415− toConstr _ = swaggerItemsPrimitiveConstr
416− dataTypeOf _ = swaggerItemsDataType
417−
418−instance Data (SwaggerItems 'SwaggerKindSchema) where
419− gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
420− gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
421− gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
422−
423− gunfold k z c = case constrIndex c of
424− 2 -> k (z SwaggerItemsObject)
425− 3 -> k (z SwaggerItemsArray)
426− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
427−
428− toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
429− toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
430− toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
431−
432− dataTypeOf _ = swaggerItemsDataType
433−
434−-- | Type used as a kind to avoid overlapping instances.
435−data SwaggerKind t
436− = SwaggerKindNormal t
437− | SwaggerKindParamOtherSchema
438− | SwaggerKindSchema
439− deriving (Typeable)
440−
441−deriving instance Typeable 'SwaggerKindNormal
442−deriving instance Typeable 'SwaggerKindParamOtherSchema
443−deriving instance Typeable 'SwaggerKindSchema
444−
445−type family SwaggerKindType (k :: SwaggerKind *) :: *
446−type instance SwaggerKindType ('SwaggerKindNormal t) = t
447−type instance SwaggerKindType 'SwaggerKindSchema = Schema
448−type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
372+deriving instance Data (SwaggerItems Schema)
449373
450374data SwaggerType t where
451375 SwaggerString :: SwaggerType t
@@ -453,9 +377,9 @@ data SwaggerType t where
453377 SwaggerInteger :: SwaggerType t
454378 SwaggerBoolean :: SwaggerType t
455379 SwaggerArray :: SwaggerType t
456− SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
457− SwaggerNull :: SwaggerType 'SwaggerKindSchema
458− SwaggerObject :: SwaggerType 'SwaggerKindSchema
380+ SwaggerFile :: SwaggerType ParamOtherSchema
381+ SwaggerNull :: SwaggerType Schema
382+ SwaggerObject :: SwaggerType Schema
459383 deriving (Typeable)
460384
461385deriving instance Eq (SwaggerType t)
@@ -464,33 +388,33 @@ deriving instance Show (SwaggerType t)
464388swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
465389swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
466390
467−swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
391+swaggerTypeDataType :: Data (SwaggerType t) => SwaggerType t -> DataType
468392swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
469393
470−swaggerCommonTypes :: [SwaggerType k]
394+swaggerCommonTypes :: [SwaggerType t]
471395swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
472396
473−swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
397+swaggerParamTypes :: [SwaggerType ParamOtherSchema]
474398swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
475399
476−swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
400+swaggerSchemaTypes :: [SwaggerType Schema]
477401swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
478402
479403swaggerTypeConstrs :: [Constr]
480−swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
404+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType Schema])
481405 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
482406
483−instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
407+instance OVERLAPPABLE_ Typeable t => Data (SwaggerType t) where
484408 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
485409 toConstr = swaggerTypeConstr
486410 dataTypeOf = swaggerTypeDataType
487411
488−instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
412+instance OVERLAPPABLE_ Data (SwaggerType ParamOtherSchema) where
489413 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
490414 toConstr = swaggerTypeConstr
491415 dataTypeOf = swaggerTypeDataType
492416
493−instance Data (SwaggerType 'SwaggerKindSchema) where
417+instance OVERLAPPABLE_ Data (SwaggerType Schema) where
494418 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
495419 toConstr = swaggerTypeConstr
496420 dataTypeOf = swaggerTypeDataType
@@ -530,7 +454,7 @@ data CollectionFormat t where
530454 -- Corresponds to multiple parameter instances
531455 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
532456 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
533− CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
457+ CollectionMulti :: CollectionFormat ParamOtherSchema
534458 deriving (Typeable)
535459
536460deriving instance Eq (CollectionFormat t)
@@ -546,12 +470,12 @@ collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
546470collectionCommonFormats :: [CollectionFormat t]
547471collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
548472
549−instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
473+instance OVERLAPPABLE_ Data t => Data (CollectionFormat t) where
550474 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
551475 toConstr = collectionFormatConstr
552476 dataTypeOf _ = collectionFormatDataType
553477
554−deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
478+deriving instance OVERLAPPABLE_ Data (CollectionFormat ParamOtherSchema)
555479
556480type ParamName = Text
557481
@@ -560,9 +484,9 @@ data Schema = Schema
560484 , _schemaDescription :: Maybe Text
561485 , _schemaRequired :: [ParamName]
562486
563− , _schemaAllOf :: Maybe [Referenced Schema]
487+ , _schemaAllOf :: Maybe [Schema]
564488 , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
565− , _schemaAdditionalProperties :: Maybe AdditionalProperties
489+ , _schemaAdditionalProperties :: Maybe (Referenced Schema)
566490
567491 , _schemaDiscriminator :: Maybe Text
568492 , _schemaReadOnly :: Maybe Bool
@@ -573,7 +497,7 @@ data Schema = Schema
573497 , _schemaMaxProperties :: Maybe Integer
574498 , _schemaMinProperties :: Maybe Integer
575499
576− , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
500+ , _schemaParamSchema :: ParamSchema Schema
577501 } deriving (Eq, Show, Generic, Data, Typeable)
578502
579503-- | A @'Schema'@ with an optional name.
@@ -586,7 +510,7 @@ data NamedSchema = NamedSchema
586510-- | Regex pattern for @string@ type.
587511type Pattern = Text
588512
589−data ParamSchema (t :: SwaggerKind *) = ParamSchema
513+data ParamSchema t = ParamSchema
590514 { -- | Declares the value of the parameter that the server will use if none is provided,
591515 -- for example a @"count"@ to control the number of results per page might default to @100@
592516 -- if not supplied by the client in the request.
@@ -594,7 +518,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
594518 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
595519 _paramSchemaDefault :: Maybe Value
596520
597− , _paramSchemaType :: Maybe (SwaggerType t)
521+ , _paramSchemaType :: SwaggerType t
598522 , _paramSchemaFormat :: Maybe Format
599523 , _paramSchemaItems :: Maybe (SwaggerItems t)
600524 , _paramSchemaMaximum :: Maybe Scientific
@@ -611,7 +535,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
611535 , _paramSchemaMultipleOf :: Maybe Scientific
612536 } deriving (Eq, Show, Generic, Typeable)
613537
614−deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
538+deriving instance (Data t, Data (SwaggerType t), Data (SwaggerItems t)) => Data (ParamSchema t)
615539
616540data Xml = Xml
617541 { -- | Replaces the name of the element/attribute used for the described schema property.
@@ -687,7 +611,7 @@ data Header = Header
687611 { -- | A short description of the header.
688612 _headerDescription :: Maybe Text
689613
690− , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
614+ , _headerParamSchema :: ParamSchema Header
691615 } deriving (Eq, Show, Generic, Data, Typeable)
692616
693617data Example = Example { getExample :: Map MediaType Value }
@@ -755,28 +679,12 @@ data SecurityScheme = SecurityScheme
755679 , _securitySchemeDescription :: Maybe Text
756680 } deriving (Eq, Show, Generic, Data, Typeable)
757681
758−
759−-- | merge scopes of two OAuth2 security schemes when their flows are identical.
760−-- In other case returns first security scheme
761−mergeSecurityScheme :: SecurityScheme -> SecurityScheme -> SecurityScheme
762−mergeSecurityScheme s1@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 scopes1)) desc)
763− s2@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow2 scopes2)) _)
764− = if flow1 == flow2 then
765− SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 (scopes1 <> scopes2))) desc
766− else
767− s1
768−mergeSecurityScheme s1 _ = s1
769−
770−newtype SecurityDefinitions
771− = SecurityDefinitions (Definitions SecurityScheme)
772− deriving (Eq, Show, Generic, Data, Typeable)
773−
774682-- | Lists the required security schemes to execute this operation.
775683-- The object can have multiple security schemes declared in it which are all required
776684-- (that is, there is a logical AND between the schemes).
777685newtype SecurityRequirement = SecurityRequirement
778686 { getSecurityRequirement :: InsOrdHashMap Text [Text]
779− } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
687+ } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable)
780688
781689-- | Tag name.
782690type TagName = Text
@@ -795,8 +703,6 @@ data Tag = Tag
795703 , _tagExternalDocs :: Maybe ExternalDocs
796704 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
797705
798−instance Hashable Tag
799−
800706instance IsString Tag where
801707 fromString s = Tag (fromString s) Nothing Nothing
802708
@@ -810,8 +716,6 @@ data ExternalDocs = ExternalDocs
810716 , _externalDocsUrl :: URL
811717 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
812718
813−instance Hashable ExternalDocs
814−
815719-- | A simple object to allow referencing other definitions in the specification.
816720-- It can be used to reference parameters and responses that are defined at the top level for reuse.
817721newtype Reference = Reference { getReference :: Text }
@@ -825,111 +729,67 @@ data Referenced a
825729instance IsString a => IsString (Referenced a) where
826730 fromString = Inline . fromString
827731
828−newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
829−
830−data AdditionalProperties
831− = AdditionalPropertiesAllowed Bool
832− | AdditionalPropertiesSchema (Referenced Schema)
833− deriving (Eq, Show, Data, Typeable)
732+newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, ToJSON, FromJSON, Data, Typeable)
834733
835734-- =======================================================================
836735-- Monoid instances
837736-- =======================================================================
838737
839−instance Semigroup Swagger where
840− (<>) = genericMappend
841738instance Monoid Swagger where
842739 mempty = genericMempty
843− mappend = (<>)
740+ mappend = genericMappend
844741
845−instance Semigroup Info where
846− (<>) = genericMappend
847742instance Monoid Info where
848743 mempty = genericMempty
849− mappend = (<>)
744+ mappend = genericMappend
850745
851−instance Semigroup Contact where
852− (<>) = genericMappend
853746instance Monoid Contact where
854747 mempty = genericMempty
855− mappend = (<>)
748+ mappend = genericMappend
856749
857−instance Semigroup PathItem where
858− (<>) = genericMappend
859750instance Monoid PathItem where
860751 mempty = genericMempty
861− mappend = (<>)
752+ mappend = genericMappend
862753
863−instance Semigroup Schema where
864− (<>) = genericMappend
865754instance Monoid Schema where
866755 mempty = genericMempty
867− mappend = (<>)
756+ mappend = genericMappend
868757
869−instance Semigroup (ParamSchema t) where
870− (<>) = genericMappend
871758instance Monoid (ParamSchema t) where
872759 mempty = genericMempty
873− mappend = (<>)
760+ mappend = genericMappend
874761
875−instance Semigroup Param where
876− (<>) = genericMappend
877762instance Monoid Param where
878763 mempty = genericMempty
879− mappend = (<>)
764+ mappend = genericMappend
880765
881−instance Semigroup ParamOtherSchema where
882− (<>) = genericMappend
883766instance Monoid ParamOtherSchema where
884767 mempty = genericMempty
885− mappend = (<>)
768+ mappend = genericMappend
886769
887−instance Semigroup Header where
888− (<>) = genericMappend
889770instance Monoid Header where
890771 mempty = genericMempty
891− mappend = (<>)
772+ mappend = genericMappend
892773
893−instance Semigroup Responses where
894− (<>) = genericMappend
895774instance Monoid Responses where
896775 mempty = genericMempty
897− mappend = (<>)
776+ mappend = genericMappend
898777
899−instance Semigroup Response where
900− (<>) = genericMappend
901778instance Monoid Response where
902779 mempty = genericMempty
903− mappend = (<>)
780+ mappend = genericMappend
904781
905−instance Semigroup ExternalDocs where
906− (<>) = genericMappend
907782instance Monoid ExternalDocs where
908783 mempty = genericMempty
909− mappend = (<>)
784+ mappend = genericMappend
910785
911−instance Semigroup Operation where
912− (<>) = genericMappend
913786instance Monoid Operation where
914787 mempty = genericMempty
915− mappend = (<>)
788+ mappend = genericMappend
916789
917−instance Semigroup Example where
918− (<>) = genericMappend
919790instance Monoid Example where
920791 mempty = genericMempty
921− mappend = (<>)
922−
923−instance Semigroup SecurityScheme where
924− (<>) = mergeSecurityScheme
925−
926−instance Semigroup SecurityDefinitions where
927− (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
928− SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
929−
930−instance Monoid SecurityDefinitions where
931− mempty = SecurityDefinitions $ InsOrdHashMap.empty
932− mappend = (<>)
792+ mappend = genericMappend
933793
934794-- =======================================================================
935795-- SwaggerMonoid helper instances
@@ -945,8 +805,6 @@ instance SwaggerMonoid Responses
945805instance SwaggerMonoid Response
946806instance SwaggerMonoid ExternalDocs
947807instance SwaggerMonoid Operation
948−instance SwaggerMonoid SecurityDefinitions
949−instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
950808
951809instance SwaggerMonoid MimeList
952810deriving instance SwaggerMonoid URL
@@ -959,13 +817,17 @@ instance SwaggerMonoid ParamLocation where
959817 swaggerMempty = ParamQuery
960818 swaggerMappend _ y = y
961819
820+instance OVERLAPPING_ SwaggerMonoid (HashMap FilePath PathItem) where
821+ swaggerMempty = HashMap.empty
822+ swaggerMappend = HashMap.unionWith mappend
823+
962824instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
963825 swaggerMempty = InsOrdHashMap.empty
964826 swaggerMappend = InsOrdHashMap.unionWith mappend
965827
966828instance Monoid a => SwaggerMonoid (Referenced a) where
967829 swaggerMempty = Inline mempty
968− swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
830+ swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
969831 swaggerMappend _ y = y
970832
971833instance SwaggerMonoid ParamAnySchema where
@@ -1059,8 +921,7 @@ instance ToJSON OAuth2Flow where
1059921 , "tokenUrl" .= tokenUrl ]
1060922
1061923instance ToJSON OAuth2Params where
1062− toJSON = sopSwaggerGenericToJSON
1063− DEFINE_TOENCODING
924+ toJSON = omitEmpties . genericToJSONWithSub "flow" (jsonPrefix "oauth2")
1064925
1065926instance ToJSON SecuritySchemeType where
1066927 toJSON SecuritySchemeBasic
@@ -1073,37 +934,28 @@ instance ToJSON SecuritySchemeType where
1073934 <+> object [ "type" .= ("oauth2" :: Text) ]
1074935
1075936instance ToJSON Swagger where
1076− toJSON = sopSwaggerGenericToJSON
1077− DEFINE_TOENCODING
937+ toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "swagger")
938+ where
939+ addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
940+ addVersion _ = error "impossible"
1078941
1079942instance ToJSON SecurityScheme where
1080− toJSON = sopSwaggerGenericToJSON
1081− DEFINE_TOENCODING
943+ toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
1082944
1083945instance ToJSON Schema where
1084− toJSON = sopSwaggerGenericToJSON
1085− DEFINE_TOENCODING
946+ toJSON = omitEmptiesExcept f . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")
947+ where
948+ f "items" (Array _) = True
949+ f _ _ = False
1086950
1087951instance ToJSON Header where
1088− toJSON = sopSwaggerGenericToJSON
1089− DEFINE_TOENCODING
952+ toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")
1090953
1091−-- | As for nullary schema for 0-arity type constructors, see
1092−-- <https://github.com/GetShopTV/swagger2/issues/167>.
1093−--
1094−-- >>> encode (SwaggerItemsArray [])
1095−-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1096−--
1097−instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
954+instance ToJSON (SwaggerItems t) where
1098955 toJSON (SwaggerItemsPrimitive fmt schema) = object
1099956 [ "collectionFormat" .= fmt
1100957 , "items" .= schema ]
1101958 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1102− toJSON (SwaggerItemsArray []) = object
1103− [ "items" .= object []
1104− , "maxItems" .= (0 :: Int)
1105− , "example" .= Array mempty
1106− ]
1107959 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1108960
1109961instance ToJSON Host where
@@ -1116,39 +968,30 @@ instance ToJSON MimeList where
1116968 toJSON (MimeList xs) = toJSON (map show xs)
1117969
1118970instance ToJSON Param where
1119− toJSON = sopSwaggerGenericToJSON
1120− DEFINE_TOENCODING
971+ toJSON = genericToJSONWithSub "schema" (jsonPrefix "param")
1121972
1122973instance ToJSON ParamAnySchema where
1123974 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1124975 toJSON (ParamOther s) = toJSON s
1125976
1126977instance ToJSON ParamOtherSchema where
1127− toJSON = sopSwaggerGenericToJSON
1128− DEFINE_TOENCODING
978+ toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
1129979
1130980instance ToJSON Responses where
1131− toJSON = sopSwaggerGenericToJSON
1132− DEFINE_TOENCODING
981+ toJSON = omitEmpties . genericToJSONWithSub "responses" (jsonPrefix "responses")
1133982
1134983instance ToJSON Response where
1135− toJSON = sopSwaggerGenericToJSON
1136− DEFINE_TOENCODING
984+ toJSON = omitEmpties . genericToJSON (jsonPrefix "response")
1137985
1138986instance ToJSON Operation where
1139− toJSON = sopSwaggerGenericToJSON
1140− DEFINE_TOENCODING
987+ toJSON = omitEmpties . genericToJSON (jsonPrefix "operation")
1141988
1142989instance ToJSON PathItem where
1143− toJSON = sopSwaggerGenericToJSON
1144− DEFINE_TOENCODING
990+ toJSON = omitEmpties . genericToJSON (jsonPrefix "pathItem")
1145991
1146992instance ToJSON Example where
1147993 toJSON = toJSON . Map.mapKeys show . getExample
1148994
1149−instance ToJSON SecurityDefinitions where
1150− toJSON (SecurityDefinitions sd) = toJSON sd
1151−
1152995instance ToJSON Reference where
1153996 toJSON (Reference ref) = object [ "$ref" .= ref ]
1154997
@@ -1177,14 +1020,11 @@ instance ToJSON (CollectionFormat t) where
11771020 toJSON CollectionPipes = "pipes"
11781021 toJSON CollectionMulti = "multi"
11791022
1180−instance ToJSON (ParamSchema k) where
1181− -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1182− toJSON = sopSwaggerGenericToJSONWithOpts $
1183− mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1184−
1185−instance ToJSON AdditionalProperties where
1186− toJSON (AdditionalPropertiesAllowed b) = toJSON b
1187− toJSON (AdditionalPropertiesSchema s) = toJSON s
1023+instance ToJSON (ParamSchema t) where
1024+ toJSON = omitEmptiesExcept f . genericToJSONWithSub "items" (jsonPrefix "paramSchema")
1025+ where
1026+ f "items" (Array _) = True
1027+ f _ _ = False
11881028
11891029-- =======================================================================
11901030-- Manual FromJSON instances
@@ -1204,7 +1044,7 @@ instance FromJSON OAuth2Flow where
12041044 parseJSON _ = empty
12051045
12061046instance FromJSON OAuth2Params where
1207− parseJSON = sopSwaggerGenericParseJSON
1047+ parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "oauth2")
12081048
12091049instance FromJSON SecuritySchemeType where
12101050 parseJSON js@(Object o) = do
@@ -1217,48 +1057,39 @@ instance FromJSON SecuritySchemeType where
12171057 parseJSON _ = empty
12181058
12191059instance FromJSON Swagger where
1220− parseJSON = sopSwaggerGenericParseJSON
1060+ parseJSON js@(Object o) = do
1061+ (version :: Text) <- o .: "swagger"
1062+ when (version /= "2.0") empty
1063+ (genericParseJSON (jsonPrefix "swagger")
1064+ `withDefaults` [ "consumes" .= (mempty :: MimeList)
1065+ , "produces" .= (mempty :: MimeList)
1066+ , "security" .= ([] :: [SecurityRequirement])
1067+ , "tags" .= ([] :: [Tag])
1068+ , "definitions" .= (mempty :: Definitions Schema)
1069+ , "parameters" .= (mempty :: Definitions Param)
1070+ , "responses" .= (mempty :: Definitions Response)
1071+ , "securityDefinitions" .= (mempty :: Definitions SecurityScheme)
1072+ ] ) js
1073+ parseJSON _ = empty
12211074
12221075instance FromJSON SecurityScheme where
1223− parseJSON = sopSwaggerGenericParseJSON
1076+ parseJSON = genericParseJSONWithSub "type" (jsonPrefix "securityScheme")
12241077
12251078instance FromJSON Schema where
1226− parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1227− where nullaryCleanup :: Schema -> Schema
1228− nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1229− if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1230− then s { _schemaExample = Nothing
1231− , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1232− else s
1079+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "schema")
1080+ `withDefaults` [ "properties" .= (mempty :: InsOrdHashMap Text Schema)
1081+ , "required" .= ([] :: [ParamName]) ]
12331082
12341083instance FromJSON Header where
1235− parseJSON = sopSwaggerGenericParseJSON
1084+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")
12361085
1237−instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1086+instance OVERLAPPABLE_ (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where
12381087 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
12391088 <$> o .:? "collectionFormat"
12401089 <*> (o .: "items" >>= parseJSON)
12411090
1242−instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1243− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1244− <$> o .:? "collectionFormat"
1245− <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1246−
1247−-- |
1248−--
1249−-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1250−-- Just (SwaggerItemsArray [])
1251−--
1252−-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1253−-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1254−--
1255−-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1256−-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1257−--
1258−instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1259− parseJSON js@(Object obj)
1260− | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1261− | otherwise = SwaggerItemsObject <$> parseJSON js
1091+instance OVERLAPPABLE_ FromJSON (SwaggerItems Schema) where
1092+ parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
12621093 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
12631094 parseJSON _ = empty
12641095
@@ -1275,7 +1106,7 @@ instance FromJSON MimeList where
12751106 parseJSON js = (MimeList . map fromString) <$> parseJSON js
12761107
12771108instance FromJSON Param where
1278− parseJSON = sopSwaggerGenericParseJSON
1109+ parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "param")
12791110
12801111instance FromJSON ParamAnySchema where
12811112 parseJSON js@(Object o) = do
@@ -1288,7 +1119,7 @@ instance FromJSON ParamAnySchema where
12881119 parseJSON _ = empty
12891120
12901121instance FromJSON ParamOtherSchema where
1291− parseJSON = sopSwaggerGenericParseJSON
1122+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
12921123
12931124instance FromJSON Responses where
12941125 parseJSON (Object o) = Responses
@@ -1302,16 +1133,18 @@ instance FromJSON Example where
13021133 pure $ Example (Map.mapKeys fromString m)
13031134
13041135instance FromJSON Response where
1305− parseJSON = sopSwaggerGenericParseJSON
1136+ parseJSON = genericParseJSON (jsonPrefix "response")
1137+ `withDefaults` [ "headers" .= (mempty :: InsOrdHashMap HeaderName Header) ]
13061138
13071139instance FromJSON Operation where
1308− parseJSON = sopSwaggerGenericParseJSON
1140+ parseJSON = genericParseJSON (jsonPrefix "operation")
1141+ `withDefaults` [ "security" .= ([] :: [SecurityRequirement])
1142+ , "tags" .= ([] :: [Tag])
1143+ , "parameters" .= ([] :: [Referenced Param]) ]
13091144
13101145instance FromJSON PathItem where
1311− parseJSON = sopSwaggerGenericParseJSON
1312−
1313−instance FromJSON SecurityDefinitions where
1314− parseJSON js = SecurityDefinitions <$> parseJSON js
1146+ parseJSON = genericParseJSON (jsonPrefix "pathItem")
1147+ `withDefaults` [ "parameters" .= ([] :: [Param]) ]
13151148
13161149instance FromJSON Reference where
13171150 parseJSON (Object o) = Reference <$> o .: "$ref"
@@ -1337,91 +1170,26 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#
13371170instance FromJSON Xml where
13381171 parseJSON = genericParseJSON (jsonPrefix "xml")
13391172
1340−instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1173+instance FromJSON (SwaggerType Schema) where
13411174 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
13421175
1343−instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1176+instance FromJSON (SwaggerType ParamOtherSchema) where
13441177 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
13451178
1346−instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1179+instance OVERLAPPABLE_ FromJSON (SwaggerType t) where
13471180 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
13481181
1349−instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1182+instance OVERLAPPABLE_ FromJSON (CollectionFormat t) where
13501183 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
13511184
1352−-- NOTE: There aren't collections of 'Schema'
1353−--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1354−-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1355−
1356−instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1185+instance FromJSON (CollectionFormat ParamOtherSchema) where
13571186 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
13581187
1359−instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1360− parseJSON = sopSwaggerGenericParseJSON
1361−instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1362− parseJSON = sopSwaggerGenericParseJSON
1363−instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1364− parseJSON = sopSwaggerGenericParseJSON
1365−
1366−instance FromJSON AdditionalProperties where
1367− parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1368− parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1369−
1370−-------------------------------------------------------------------------------
1371−-- TH splices
1372−-------------------------------------------------------------------------------
1373−
1374−deriveGeneric ''Header
1375−deriveGeneric ''OAuth2Params
1376−deriveGeneric ''Operation
1377−deriveGeneric ''Param
1378−deriveGeneric ''ParamOtherSchema
1379−deriveGeneric ''PathItem
1380−deriveGeneric ''Response
1381−deriveGeneric ''Responses
1382−deriveGeneric ''SecurityScheme
1383−deriveGeneric ''Schema
1384−deriveGeneric ''ParamSchema
1385−deriveGeneric ''Swagger
1386−
1387−instance HasSwaggerAesonOptions Header where
1388− swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
1389−instance HasSwaggerAesonOptions OAuth2Params where
1390− swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
1391−instance HasSwaggerAesonOptions Operation where
1392− swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
1393−instance HasSwaggerAesonOptions Param where
1394− swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
1395−instance HasSwaggerAesonOptions ParamOtherSchema where
1396− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
1397−instance HasSwaggerAesonOptions PathItem where
1398− swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
1399−instance HasSwaggerAesonOptions Response where
1400− swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
1401−instance HasSwaggerAesonOptions Responses where
1402− swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
1403−instance HasSwaggerAesonOptions SecurityScheme where
1404− swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1405−instance HasSwaggerAesonOptions Schema where
1406− swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1407−instance HasSwaggerAesonOptions Swagger where
1408− swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]
1409−
1410−instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1411− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1412−instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1413− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1414−-- NOTE: Schema doesn't have 'items' sub object!
1415−instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1416− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1417−
1418−instance AesonDefaultValue (ParamSchema s)
1419−instance AesonDefaultValue OAuth2Flow
1420−instance AesonDefaultValue Responses
1421−instance AesonDefaultValue ParamAnySchema
1422−instance AesonDefaultValue SecuritySchemeType
1423−instance AesonDefaultValue (SwaggerType a)
1424−instance AesonDefaultValue MimeList where defaultValue = Just mempty
1425−instance AesonDefaultValue Info
1426−instance AesonDefaultValue ParamLocation
1427−instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty
1188+-- NOTE: The constraints @FromJSON (SwaggerType t)@ and
1189+-- @FromJSON (SwaggerItems t)@ are necessary here!
1190+-- Without the constraint the general instance will be used
1191+-- that only accepts common types (i.e. NOT object, null or file)
1192+-- and primitive array items.
1193+instance (FromJSON (SwaggerType t), FromJSON (SwaggerItems t)) => FromJSON (ParamSchema t) where
1194+ parseJSON = genericParseJSONWithSub "items" (jsonPrefix "ParamSchema")
1195+