swagger2 2.1.4.1 → 2.1.5

raw patch · 13 files changed

+198/−19 lines, 13 files

Files

• CHANGELOG.md +12/−2
• LICENSE +1/−1
• README.md +3/−1
• src/Data/Swagger.hs +38/−4
• src/Data/Swagger/Internal.hs +1/−1
• src/Data/Swagger/Internal/ParamSchema.hs +2/−0
• src/Data/Swagger/Internal/Schema.hs +31/−6
• src/Data/Swagger/Internal/TypeShape.hs +66/−0
• src/Data/Swagger/Schema.hs +4/−0
• swagger2.cabal +6/−2
• test/Data/Swagger/Schema/ValidationSpec.hs +2/−1
• test/Data/Swagger/SchemaSpec.hs +1/−1
• test/Data/SwaggerSpec.hs +31/−0

@@ -1,8 +1,18 @@+2.1.5+-----++* Type error by default when deriving Generic-based instances for mixed sum types (see [#118](https://github.com/GetShopTV/swagger2/pull/118));+* Adjust `allOf` to accept referenced schemas (see [#119](https://github.com/GetShopTV/swagger2/issues/119));+* Add instances for `Identity` (see [#116](https://github.com/GetShopTV/swagger2/pull/116));+* Add Gitter chat badge (see [#114](https://github.com/GetShopTV/swagger2/pull/114)).+ 2.1.4.1 ------- -* GHC-8.2 support (see [#95](https://github.com/GetShopTV/swagger2/issues/95))-* Documentation corrections (see [#105](https://github.com/GetShopTV/swagger2/pull/105))+* GHC-8.2 support (see [#95](https://github.com/GetShopTV/swagger2/issues/95), [#106](https://github.com/GetShopTV/swagger2/pull/106) and [#108](https://github.com/GetShopTV/swagger2/pull/108));+* Documentation corrections (see [#105](https://github.com/GetShopTV/swagger2/pull/105));+* Allow `generics-sop-0.3` (see [#102](https://github.com/GetShopTV/swagger2/pull/102));+* Fix `ToSchema` example in docs (see [#104](https://github.com/GetShopTV/swagger2/pull/104)).  2.1.4 -----

@@ -1,4 +1,4 @@-Copyright (c) 2015-2016, GetShopTV+Copyright (c) 2015-2017, GetShopTV All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,5 +1,7 @@ # swagger2 +[![Join the chat at https://gitter.im/haskell-swagger2/Lobby](https://badges.gitter.im/haskell-swagger2/Lobby.svg)](https://gitter.im/haskell-swagger2/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)+ [![Hackage](https://img.shields.io/hackage/v/swagger2.svg)](http://hackage.haskell.org/package/swagger2) [![Build Status](https://travis-ci.org/GetShopTV/swagger2.svg?branch=master)](https://travis-ci.org/GetShopTV/swagger2) [![Stackage LTS](http://stackage.org/package/swagger2/badge/lts)](http://stackage.org/lts/package/swagger2)@@ -11,7 +13,7 @@  ## Usage -This library is inteded to be used for decoding and encoding Swagger 2.0 API specifications as well as manipulating them.+This library is intended to be used for decoding and encoding Swagger 2.0 API specifications as well as manipulating them.  Please refer to [haddock documentation](http://hackage.haskell.org/package/swagger2). 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module:      Data.Swagger -- Maintainer:  Nickolay Kudasov <nickolay@getshoptv.com>@@ -286,13 +287,46 @@ -- >>> instance ToSchema SampleSumType -- >>> instance ToJSON SampleSumType ----- we can not derive a valid schema for a mix of the above. The following will result in a bad schema--- +-- we can not derive a valid schema for a mix of the above. The following will result in a type error+--+#if __GLASGOW_HASKELL__ < 800 -- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic -- >>> instance ToSchema BadMixedType--- >>> instance ToJSON BadMixedType+-- ...+-- ... error:+-- ... • No instance for (Data.Swagger.Internal.TypeShape.CannotDeriveSchemaForMixedSumType+-- ...                      BadMixedType)+-- ...     arising from a use of ‘Data.Swagger.Internal.Schema.$dmdeclareNamedSchema’+-- ... • In the expression:+-- ...     Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType+-- ...   In an equation for ‘declareNamedSchema’:+-- ...       declareNamedSchema+-- ...         = Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType+-- ...   In the instance declaration for ‘ToSchema BadMixedType’+#else+-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic+-- >>> instance ToSchema BadMixedType+-- ...+-- ... error:+-- ... • Cannot derive Generic-based Swagger Schema for BadMixedType+-- ...   BadMixedType is a mixed sum type (has both unit and non-unit constructors).+-- ...   Swagger does not have a good representation for these types.+-- ...   Use genericDeclareNamedSchemaUnrestricted if you want to derive schema+-- ...   that matches aeson's Generic-based toJSON,+-- ...   but that's not supported by some Swagger tools.+-- ... • In the expression:+-- ...     Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType+-- ...   In an equation for ‘declareNamedSchema’:+-- ...       declareNamedSchema+-- ...         = Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType+-- ...   In the instance declaration for ‘ToSchema BadMixedType’+#endif ----- This is due to the fact that @'ToJSON'@ encodes empty constructors with an empty list which can not be described in a swagger schema.+-- We can use 'genericDeclareNamedSchemaUnrestricted' to try our best to represent this type as a Swagger Schema and match 'ToJSON':+--+-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic+-- >>> instance ToSchema BadMixedType where declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions+-- >>> instance ToJSON BadMixedType --  -- $manipulation

@@ -554,7 +554,7 @@   , _schemaDescription :: Maybe Text   , _schemaRequired :: [ParamName] -  , _schemaAllOf :: Maybe [Schema]+  , _schemaAllOf :: Maybe [Referenced Schema]   , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)   , _schemaAdditionalProperties :: Maybe (Referenced Schema) 

@@ -225,6 +225,8 @@ instance ToParamSchema a => ToParamSchema (Last a)    where toParamSchema _ = toParamSchema (Proxy :: Proxy a) instance ToParamSchema a => ToParamSchema (Dual a)    where toParamSchema _ = toParamSchema (Proxy :: Proxy a) +instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)+ instance ToParamSchema a => ToParamSchema [a] where   toParamSchema _ = mempty     & type_ .~ SwaggerArray

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -64,6 +65,7 @@ import Data.Swagger.Lens hiding (name, schema) import qualified Data.Swagger.Lens as Swagger import Data.Swagger.SchemaOptions+import Data.Swagger.Internal.TypeShape  #if __GLASGOW_HASKELL__ < 800 #else@@ -137,7 +139,8 @@   -- Note that the schema itself is included in definitions   -- only if it is recursive (and thus needs its definition in scope).   declareNamedSchema :: proxy a -> Declare (Definitions Schema) NamedSchema-  default declareNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> Declare (Definitions Schema) NamedSchema+  default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>+    proxy a -> Declare (Definitions Schema) NamedSchema   declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions  -- | Convert a type into a schema and declare all used schema definitions.@@ -562,6 +565,8 @@ instance ToSchema a => ToSchema (Last a)    where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a) instance ToSchema a => ToSchema (Dual a)    where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a) +instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)+ -- | Default schema for @'Bounded'@, @'Integral'@ types. -- -- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)@@ -581,16 +586,33 @@   = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d)) (toSchemaBoundedIntegral proxy)  -- | A configurable generic @'Schema'@ creator.-genericDeclareSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema-genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy+genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>+  SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema+genericDeclareSchema = genericDeclareSchemaUnrestricted  -- | A configurable generic @'NamedSchema'@ creator. -- This function applied to @'defaultSchemaOptions'@ -- is used as the default for @'declareNamedSchema'@ -- when the type is an instance of @'Generic'@.-genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema-genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty+genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>+  SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema+genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted +-- | A configurable generic @'Schema'@ creator.+--+-- Unlike 'genericDeclareSchema' also works for mixed sum types.+-- Use with care since some Swagger tools do not support well schemas for mixed sum types.+genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema+genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy++-- | A configurable generic @'NamedSchema'@ creator.+--+-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.+-- Use with care since some Swagger tools do not support well schemas for mixed sum types.+genericDeclareNamedSchemaUnrestricted :: forall a proxy. (Generic a, GToSchema (Rep a)) =>+  SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema+genericDeclareNamedSchemaUnrestricted opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty+ gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text gdatatypeSchemaName opts _ = case name of   (c:_) | isAlpha c && isUpper c -> Just (T.pack name)@@ -708,7 +730,10 @@ instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where   gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c) -instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where+instance ( GSumToSchema f+         , GSumToSchema g+         ) => GToSchema (f :+: g)+   where   gdeclareNamedSchema = gdeclareNamedSumSchema  gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

@@ -0,0 +1,66 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Swagger.Internal.TypeShape where++import Data.Proxy+import GHC.Generics+import GHC.TypeLits+import GHC.Exts (Constraint)++-- | Shape of a datatype.+data TypeShape+  = Enumeration     -- ^ A simple enumeration.+  | SumOfProducts   -- ^ A product or a sum of non-unit products.+  | Mixed           -- ^ Mixed sum type with both unit and non-unit constructors.++-- | A combined shape for a product type.+type family ProdCombine (a :: TypeShape) (b :: TypeShape) :: TypeShape where+  ProdCombine Mixed b     = Mixed   -- technically this cannot happen since Haskell types are sums of products+  ProdCombine a     Mixed = Mixed   -- technically this cannot happen since Haskell types are sums of products+  ProdCombine a     b     = SumOfProducts++-- | A combined shape for a sum type.+type family SumCombine (a :: TypeShape) (b :: TypeShape) :: TypeShape where+  SumCombine Enumeration   Enumeration   = Enumeration+  SumCombine SumOfProducts SumOfProducts = SumOfProducts+  SumCombine a b = Mixed++type family TypeHasSimpleShape t (f :: Symbol) :: Constraint where+  TypeHasSimpleShape t f = GenericHasSimpleShape t f (GenericShape (Rep t))++type family GenericHasSimpleShape t (f :: Symbol) (s :: TypeShape) :: Constraint where+  GenericHasSimpleShape t f Enumeration   = ()+  GenericHasSimpleShape t f SumOfProducts = ()+#if __GLASGOW_HASKELL__ < 800+  GenericHasSimpleShape t f Mixed = CannotDeriveSchemaForMixedSumType t++class CannotDeriveSchemaForMixedSumType t where+#else+  GenericHasSimpleShape t f Mixed =+    TypeError+      (     Text "Cannot derive Generic-based Swagger Schema for " :<>: ShowType t+      :$$:  ShowType t :<>: Text " is a mixed sum type (has both unit and non-unit constructors)."+      :$$:  Text "Swagger does not have a good representation for these types."+      :$$:  Text "Use " :<>: Text f :<>: Text " if you want to derive schema"+      :$$:  Text "that matches aeson's Generic-based toJSON,"+      :$$:  Text "but that's not supported by some Swagger tools."+      )+#endif++-- | Infer a 'TypeShape' for a generic representation of a type.+type family GenericShape (g :: * -> *) :: TypeShape++type instance GenericShape (f :*: g)        = ProdCombine  (GenericShape f) (GenericShape g)+type instance GenericShape (f :+: g)        = SumCombine   (GenericShape f) (GenericShape g)+type instance GenericShape (D1  d f)        = GenericShape f+type instance GenericShape (C1 c U1)        = Enumeration+type instance GenericShape (C1 c (S1 s f))  = SumOfProducts+type instance GenericShape (C1 c (f :*: g)) = SumOfProducts++

@@ -22,6 +22,10 @@   paramSchemaToNamedSchema,   paramSchemaToSchema, +  -- ** Unrestricted versions+  genericDeclareNamedSchemaUnrestricted,+  genericDeclareSchemaUnrestricted,+   -- * Schema templates   passwordSchema,   binarySchema,

@@ -1,5 +1,5 @@ name:                swagger2-version:             2.1.4.1+version:             2.1.5 synopsis:            Swagger 2.0 data model description:   This library is inteded to be used for decoding and encoding Swagger 2.0 API@@ -13,7 +13,7 @@ author:              Nickolay Kudasov maintainer:          nickolay@getshoptv.com copyright:           (c) 2015-2016, GetShopTV-category:            Web+category:            Web, Swagger build-type:          Custom extra-source-files:     README.md@@ -47,6 +47,7 @@     Data.Swagger.Internal.ParamSchema     Data.Swagger.Internal.Utils     Data.Swagger.Internal.AesonUtils+    Data.Swagger.Internal.TypeShape   build-depends:       base        >=4.7   && <4.11                      , base-compat >=0.9.1 && <0.10                      , aeson       >=0.11.2.1@@ -100,6 +101,9 @@     Data.Swagger.SchemaSpec     Data.Swagger.Schema.ValidationSpec   default-language: Haskell2010+  -- https://github.com/haskell/cabal/issues/3708+  build-tool-depends:+    hspec-discover:hspec-discover  test-suite doctests   -- See QuickCheck note in https://github.com/phadej/cabal-doctest#notes

@@ -148,7 +148,8 @@  data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic) -instance ToSchema Light+instance ToSchema Light where+  declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions  instance ToJSON Light where   toJSON = genericToJSON defaultOptions { sumEncoding = ObjectWithSingleField }

@@ -599,7 +599,7 @@   deriving (Generic)  instance ToSchema Light where-  declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions+  declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions     { unwrapUnaryRecords = True }  lightSchemaJSON :: Value

@@ -42,6 +42,7 @@   describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON   describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON   describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON+  describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON   describe "Swagger Object" $ do     context "Todo Example" $ swaggerExample <=> swaggerExampleJSON     context "PetStore Example" $@@ -1612,5 +1613,35 @@       "description":"Find out more about Swagger",       "url":"http://swagger.io"    }+}+|]++compositionSchemaExample :: Schema+compositionSchemaExample = mempty+  & type_ .~ SwaggerObject+  & Data.Swagger.allOf ?~ [+      Ref (Reference "Other")+    , Inline (mempty+             & type_ .~ SwaggerObject+             & properties .~+                  [ ("greet", Inline $ mempty+                            & type_ .~ SwaggerString) ])+  ]++compositionSchemaExampleJSON :: Value+compositionSchemaExampleJSON = [aesonQQ|+{+  "type": "object",+  "allOf": [+      {+         "$ref": "#/definitions/Other"+      },+      {+        "type": "object",+        "properties": {+          "greet": { "type": "string" }+        }+      }+  ] } |]