From 6eebf12d2dfafc009d9f2fb2ab67fb07bb94e8fe Mon Sep 17 00:00:00 2001 From: Uladzimir Stsepchanka Date: Sat, 16 Dec 2023 09:30:59 +0300 Subject: [PATCH 1/3] Use GHC-9.4.8 snapshot and fix few warnings --- src/Data/OpenApi.hs | 1 - src/Data/OpenApi/Declare.hs | 2 +- src/Data/OpenApi/Internal.hs | 20 ++++++++++++-------- src/Data/OpenApi/Internal/AesonUtils.hs | 1 + src/Data/OpenApi/Internal/ParamSchema.hs | 9 +++++---- src/Data/OpenApi/Internal/Schema.hs | 13 ++++++------- src/Data/OpenApi/Internal/TypeShape.hs | 4 +++- src/Data/OpenApi/Optics.hs | 1 + stack.yaml | 10 +++------- 9 files changed, 32 insertions(+), 29 deletions(-) diff --git a/src/Data/OpenApi.hs b/src/Data/OpenApi.hs index a9ce8f3d..3b1e775f 100644 --- a/src/Data/OpenApi.hs +++ b/src/Data/OpenApi.hs @@ -30,7 +30,6 @@ module Data.OpenApi ( -- * Re-exports module Data.OpenApi.Lens, - module Data.OpenApi.Optics, module Data.OpenApi.Operation, module Data.OpenApi.ParamSchema, module Data.OpenApi.Schema, diff --git a/src/Data/OpenApi/Declare.hs b/src/Data/OpenApi/Declare.hs index a302bb0a..6158bb9f 100644 --- a/src/Data/OpenApi/Declare.hs +++ b/src/Data/OpenApi/Declare.hs @@ -52,7 +52,7 @@ instance (Applicative m, Monad m, Monoid d) => Applicative (DeclareT d m) where return (mappend d' d'', f x) instance (Applicative m, Monad m, Monoid d) => Monad (DeclareT d m) where - return x = DeclareT (\_ -> pure (mempty, x)) + return = pure DeclareT dx >>= f = DeclareT $ \d -> do ~(d', x) <- dx d ~(d'', y) <- runDeclareT (f x) (mappend d d') diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs index b9be5292..aea8a654 100644 --- a/src/Data/OpenApi/Internal.hs +++ b/src/Data/OpenApi/Internal.hs @@ -14,6 +14,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Data.OpenApi.Internal where import Prelude () @@ -335,7 +337,9 @@ instance Data MediaType where dataTypeOf _ = mediaTypeData +mediaTypeConstr :: Constr mediaTypeConstr = mkConstr mediaTypeData "MediaType" [] Prefix +mediaTypeData :: DataType mediaTypeData = mkDataType "MediaType" [mediaTypeConstr] instance Hashable MediaType where @@ -1006,12 +1010,12 @@ deriveGeneric ''OpenApiSpecVersion -- ======================================================================= instance Semigroup OpenApiSpecVersion where - (<>) (OpenApiSpecVersion a) (OpenApiSpecVersion b) = OpenApiSpecVersion $ max a b - + (<>) (OpenApiSpecVersion a) (OpenApiSpecVersion b) = OpenApiSpecVersion $ max a b + instance Monoid OpenApiSpecVersion where mempty = OpenApiSpecVersion (makeVersion [3,0,0]) mappend = (<>) - + instance Semigroup OpenApi where (<>) = genericMappend instance Monoid OpenApi where @@ -1282,7 +1286,7 @@ instance FromJSON OAuth2AuthorizationCodeFlow where -- Manual ToJSON instances -- ======================================================================= -instance ToJSON OpenApiSpecVersion where +instance ToJSON OpenApiSpecVersion where toJSON (OpenApiSpecVersion v)= toJSON . showVersion $ v instance ToJSON MediaType where @@ -1456,15 +1460,15 @@ instance FromJSON OpenApiSpecVersion where parseJSON = withText "OpenApiSpecVersion" $ \str -> let validatedVersion :: Either String Version validatedVersion = do - parsedVersion <- readVersion str + parsedVersion <- readVersion str unless ((parsedVersion >= lowerOpenApiSpecVersion) && (parsedVersion <= upperOpenApiSpecVersion)) $ Left ("The provided version " <> showVersion parsedVersion <> " is out of the allowed range >=" <> showVersion lowerOpenApiSpecVersion <> " && <=" <> showVersion upperOpenApiSpecVersion) return parsedVersion - in + in either fail (return . OpenApiSpecVersion) validatedVersion where readVersion :: Text -> Either String Version - readVersion v = case readP_to_S parseVersion (Text.unpack v) of + readVersion v = case readP_to_S parseVersion (Text.unpack v) of [] -> Left $ "Failed to parse as a version string " <> Text.unpack v solutions -> Right (fst . last $ solutions) @@ -1649,7 +1653,7 @@ instance HasSwaggerAesonOptions Encoding where instance HasSwaggerAesonOptions Link where swaggerAesonOptions _ = mkSwaggerAesonOptions "link" -instance AesonDefaultValue Version where +instance AesonDefaultValue Version where defaultValue = Just (makeVersion [3,0,0]) instance AesonDefaultValue OpenApiSpecVersion instance AesonDefaultValue Server diff --git a/src/Data/OpenApi/Internal/AesonUtils.hs b/src/Data/OpenApi/Internal/AesonUtils.hs index 3804ab32..786226a1 100644 --- a/src/Data/OpenApi/Internal/AesonUtils.hs +++ b/src/Data/OpenApi/Internal/AesonUtils.hs @@ -4,6 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableSuperClasses #-} module Data.OpenApi.Internal.AesonUtils ( -- * Generic functions diff --git a/src/Data/OpenApi/Internal/ParamSchema.hs b/src/Data/OpenApi/Internal/ParamSchema.hs index 75b637a2..a841b3ad 100644 --- a/src/Data/OpenApi/Internal/ParamSchema.hs +++ b/src/Data/OpenApi/Internal/ParamSchema.hs @@ -19,6 +19,7 @@ module Data.OpenApi.Internal.ParamSchema where import Control.Lens import Data.Aeson (ToJSON (..)) +import Data.Kind import Data.Proxy import GHC.Generics @@ -163,7 +164,7 @@ instance ToParamSchema Word64 where -- "minimum": -128, -- "type": "integer" -- } -toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema +toParamSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema toParamSchemaBoundedIntegral _ = mempty & type_ ?~ OpenApiInteger & minimum_ ?~ fromInteger (toInteger (minBound :: a)) @@ -310,10 +311,10 @@ instance ToParamSchema UUID where -- ], -- "type": "string" -- } -genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> Schema +genericToParamSchema :: forall a. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> Schema genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty -class GToParamSchema (f :: * -> *) where +class GToParamSchema (f :: Type -> Type) where gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema instance GToParamSchema f => GToParamSchema (D1 d f) where @@ -331,7 +332,7 @@ instance ToParamSchema c => GToParamSchema (K1 i c) where instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) where gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g)) -class GEnumParamSchema (f :: * -> *) where +class GEnumParamSchema (f :: Type -> Type) where genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where diff --git a/src/Data/OpenApi/Internal/Schema.hs b/src/Data/OpenApi/Internal/Schema.hs index da56acf0..3a340994 100644 --- a/src/Data/OpenApi/Internal/Schema.hs +++ b/src/Data/OpenApi/Internal/Schema.hs @@ -43,6 +43,7 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import Data.Int import Data.IntSet (IntSet) import Data.IntMap (IntMap) +import Data.Kind import Data.List (sort) import Data.List.NonEmpty.Compat (NonEmpty) import Data.Map (Map) @@ -587,7 +588,7 @@ sketchStrictSchema = go . toJSON where names = objectKeys o -class GToSchema (f :: * -> *) where +class GToSchema (f :: Type -> Type) where gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where @@ -1031,7 +1032,9 @@ instance ( GSumToSchema f gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema gdeclareNamedSumSchema opts proxy _ - | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchemas) + | allNullaryToStringTag opts && allNullary = pure $ unnamed $ mempty + & type_ ?~ OpenApiString + & enum_ ?~ map (String . fst) sumSchemas | otherwise = do (schemas, _) <- runWriterT declareSumSchema return $ unnamed $ mempty @@ -1040,13 +1043,9 @@ gdeclareNamedSumSchema opts proxy _ declareSumSchema = gsumToSchema opts proxy (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema) - toStringTag schemas = mempty - & type_ ?~ OpenApiString - & enum_ ?~ map (String . fst) sumSchemas - type AllNullary = All -class GSumToSchema (f :: * -> *) where +class GSumToSchema (f :: Type -> Type) where gsumToSchema :: SchemaOptions -> Proxy f -> WriterT AllNullary (Declare (Definitions Schema)) [(T.Text, Referenced Schema)] instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where diff --git a/src/Data/OpenApi/Internal/TypeShape.hs b/src/Data/OpenApi/Internal/TypeShape.hs index 89230e21..cf3a1c6a 100644 --- a/src/Data/OpenApi/Internal/TypeShape.hs +++ b/src/Data/OpenApi/Internal/TypeShape.hs @@ -3,9 +3,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} module Data.OpenApi.Internal.TypeShape where +import Data.Kind import Data.Proxy import GHC.Generics import GHC.TypeLits @@ -46,7 +48,7 @@ type family GenericHasSimpleShape t (f :: Symbol) (s :: TypeShape) :: Constraint ) -- | Infer a 'TypeShape' for a generic representation of a type. -type family GenericShape (g :: * -> *) :: TypeShape +type family GenericShape (g :: Type -> Type) :: TypeShape type instance GenericShape (f :*: g) = ProdCombine (GenericShape f) (GenericShape g) type instance GenericShape (f :+: g) = SumCombine (GenericShape f) (GenericShape g) diff --git a/src/Data/OpenApi/Optics.hs b/src/Data/OpenApi/Optics.hs index 3d0a42e8..588b50ee 100644 --- a/src/Data/OpenApi/Optics.hs +++ b/src/Data/OpenApi/Optics.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | diff --git a/stack.yaml b/stack.yaml index 7ab2f4e0..16179a8d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,9 +1,5 @@ -resolver: lts-16.31 +resolver: lts-21.24 packages: - '.' -extra-deps: -- optics-core-0.3 -- optics-th-0.3 -- optics-extra-0.3 -- indexed-profunctors-0.1 -- insert-ordered-containers-0.2.3.1 +ghc-options: + $locals: -Wall -Wno-unused-imports -Wno-dodgy-imports -Wno-name-shadowing From 5eff1a19f00ca5a81004bbe93f8db348720d9b3d Mon Sep 17 00:00:00 2001 From: Uladzimir Stsepchanka Date: Sat, 16 Dec 2023 11:42:07 +0300 Subject: [PATCH 2/3] gitignore stack.yaml.lock --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 4a277591..c2cab955 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,4 @@ cabal.sandbox.config *.aux *.hp .stack-work/ +stack.yaml.lock From f7e6d9756a6081f2016a9cbacc96d0b2bce10ec8 Mon Sep 17 00:00:00 2001 From: Uladzimir Stsepchanka Date: Sun, 4 Feb 2024 10:12:03 +0300 Subject: [PATCH 3/3] Even more --- src/Data/OpenApi/Declare.hs | 6 +++--- src/Data/OpenApi/Internal.hs | 2 +- src/Data/OpenApi/Internal/AesonUtils.hs | 3 +-- src/Data/OpenApi/Internal/Schema.hs | 19 +++++++++---------- src/Data/OpenApi/Internal/Utils.hs | 4 ++-- stack.yaml | 2 +- 6 files changed, 17 insertions(+), 19 deletions(-) diff --git a/src/Data/OpenApi/Declare.hs b/src/Data/OpenApi/Declare.hs index 6158bb9f..1259b940 100644 --- a/src/Data/OpenApi/Declare.hs +++ b/src/Data/OpenApi/Declare.hs @@ -44,14 +44,14 @@ import Data.Functor.Identity newtype DeclareT d m a = DeclareT { runDeclareT :: d -> m (d, a) } deriving (Functor) -instance (Applicative m, Monad m, Monoid d) => Applicative (DeclareT d m) where +instance (Monad m, Monoid d) => Applicative (DeclareT d m) where pure x = DeclareT (\_ -> pure (mempty, x)) DeclareT df <*> DeclareT dx = DeclareT $ \d -> do ~(d', f) <- df d ~(d'', x) <- dx (mappend d d') return (mappend d' d'', f x) -instance (Applicative m, Monad m, Monoid d) => Monad (DeclareT d m) where +instance (Monad m, Monoid d) => Monad (DeclareT d m) where return = pure DeclareT dx >>= f = DeclareT $ \d -> do ~(d', x) <- dx d @@ -84,7 +84,7 @@ class (Applicative m, Monad m) => MonadDeclare d m | m -> d where -- | @'look'@ is an action that returns all the output so far. look :: m d -instance (Applicative m, Monad m, Monoid d) => MonadDeclare d (DeclareT d m) where +instance (Monad m, Monoid d) => MonadDeclare d (DeclareT d m) where declare d = DeclareT (\_ -> return (d, ())) look = DeclareT (\d -> return (mempty, d)) diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs index aea8a654..431723d3 100644 --- a/src/Data/OpenApi/Internal.hs +++ b/src/Data/OpenApi/Internal.hs @@ -1151,7 +1151,7 @@ instance SwaggerMonoid Responses instance SwaggerMonoid Response instance SwaggerMonoid ExternalDocs instance SwaggerMonoid Operation -instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a) +instance (Hashable a) => SwaggerMonoid (InsOrdHashSet a) instance SwaggerMonoid SecurityDefinitions instance SwaggerMonoid OpenApiSpecVersion diff --git a/src/Data/OpenApi/Internal/AesonUtils.hs b/src/Data/OpenApi/Internal/AesonUtils.hs index 786226a1..4ac76463 100644 --- a/src/Data/OpenApi/Internal/AesonUtils.hs +++ b/src/Data/OpenApi/Internal/AesonUtils.hs @@ -115,8 +115,7 @@ sopSwaggerGenericToJSON x = -- Also uses default `aesonDefaults` sopSwaggerGenericToJSONWithOpts :: forall a xs. - ( Generic a - , All2 AesonDefaultValue (Code a) + ( All2 AesonDefaultValue (Code a) , HasDatatypeInfo a , All2 ToJSON (Code a) , All2 Eq (Code a) diff --git a/src/Data/OpenApi/Internal/Schema.hs b/src/Data/OpenApi/Internal/Schema.hs index 3a340994..40c2390c 100644 --- a/src/Data/OpenApi/Internal/Schema.hs +++ b/src/Data/OpenApi/Internal/Schema.hs @@ -16,7 +16,6 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For TypeErrors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} module Data.OpenApi.Internal.Schema where @@ -152,7 +151,7 @@ class Typeable a => ToSchema a where -- 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)) => + default declareNamedSchema :: (GToSchema (Rep a)) => Proxy a -> Declare (Definitions Schema) NamedSchema declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions @@ -771,14 +770,14 @@ toSchemaBoundedIntegral _ = mempty -- | Default generic named schema for @'Bounded'@, @'Integral'@ types. genericToNamedSchemaBoundedIntegral :: forall a d f. ( Bounded a, Integral a - , Generic a, Rep a ~ D1 d f, Datatype d) + , Rep a ~ D1 d f, Datatype d) => SchemaOptions -> Proxy a -> NamedSchema genericToNamedSchemaBoundedIntegral opts proxy = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy) -- | Declare a named schema for a @newtype@ wrapper. genericDeclareNamedSchemaNewtype :: forall a d c s i inner. - (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner)))) + (Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner)))) => SchemaOptions -- ^ How to derive the name. -> (Proxy inner -> Declare (Definitions Schema) Schema) -- ^ How to create a schema for the wrapped type. -> Proxy a @@ -870,7 +869,7 @@ toSchemaBoundedEnumKeyMapping :: forall map key value. toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping -- | A configurable generic @'Schema'@ creator. -genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) => +genericDeclareSchema :: (GToSchema (Rep a), Typeable a) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy @@ -886,7 +885,7 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche -- -- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool)) -- Just "Either_Int_Bool" -genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) => +genericDeclareNamedSchema :: forall a. (GToSchema (Rep a), Typeable a) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema genericDeclareNamedSchema opts _ = rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty @@ -899,7 +898,7 @@ genericDeclareNamedSchema opts _ = -- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'. genericNameSchema :: forall a d f. - (Generic a, Rep a ~ D1 d f, Datatype d) + (Rep a ~ D1 d f, Datatype d) => SchemaOptions -> Proxy a -> Schema -> NamedSchema genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d)) @@ -912,7 +911,7 @@ gdatatypeSchemaName opts _ = case orig of name = datatypeNameModifier opts orig -- | Construct 'NamedSchema' usinng 'ToParamSchema'. -paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) => +paramSchemaToNamedSchema :: (ToParamSchema a, Rep a ~ D1 d f, Datatype d) => SchemaOptions -> Proxy a -> NamedSchema paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy) @@ -948,7 +947,7 @@ instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where gdeclareNamedSchema = gdeclareNamedSumSchema -- | Single field constructor. -instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s f)) where +instance (GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s f)) where gdeclareNamedSchema opts _ s | unwrapUnaryRecords opts = fieldSchema | otherwise = @@ -1053,7 +1052,7 @@ instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where (<>) <$> gsumToSchema opts (Proxy :: Proxy f) <*> gsumToSchema opts (Proxy :: Proxy g) -- | Convert one component of the sum to schema, to be later combined with @oneOf@. -gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) => +gsumConToSchemaWith :: forall c f. (Constructor c) => Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> (T.Text, Referenced Schema) gsumConToSchemaWith ref opts _ = (tag, withTitle) where diff --git a/src/Data/OpenApi/Internal/Utils.hs b/src/Data/OpenApi/Internal/Utils.hs index 8bcdd3b1..3fca56b1 100644 --- a/src/Data/OpenApi/Internal/Utils.hs +++ b/src/Data/OpenApi/Internal/Utils.hs @@ -117,11 +117,11 @@ instance SwaggerMonoid [a] instance Ord a => SwaggerMonoid (Set a) instance Ord k => SwaggerMonoid (Map k v) -instance (Eq k, Hashable k) => SwaggerMonoid (HashMap k v) where +instance (Hashable k) => SwaggerMonoid (HashMap k v) where swaggerMempty = mempty swaggerMappend = HashMap.unionWith (\_old new -> new) -instance (Eq k, Hashable k) => SwaggerMonoid (InsOrdHashMap k v) where +instance (Hashable k) => SwaggerMonoid (InsOrdHashMap k v) where swaggerMempty = mempty swaggerMappend = InsOrdHashMap.unionWith (\_old new -> new) diff --git a/stack.yaml b/stack.yaml index 16179a8d..0553d1b4 100644 --- a/stack.yaml +++ b/stack.yaml @@ -2,4 +2,4 @@ resolver: lts-21.24 packages: - '.' ghc-options: - $locals: -Wall -Wno-unused-imports -Wno-dodgy-imports -Wno-name-shadowing + $locals: -Wall -Wno-unused-imports -Wno-dodgy-imports -Wno-name-shadowing -Wredundant-constraints