Stack related updates and warnings cleanup

.gitignore

@@ -17,3 +17,4 @@ cabal.sandbox.config
 *.aux
 *.hp
 .stack-work/
+stack.yaml.lock

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,

src/Data/OpenApi/Declare.hs

@@ -44,15 +44,15 @@ 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
-  return x = DeclareT (\_ -> pure (mempty, x))
+instance (Monad m, Monoid d) => Monad (DeclareT d m) where
+  return = pure
   DeclareT dx >>= f = DeclareT $ \d -> do
     ~(d',  x) <- dx d
     ~(d'', y) <- runDeclareT (f x) (mappend d 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))
 

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
@@ -1147,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
 
@@ -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

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
@@ -114,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)

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

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
@@ -43,6 +42,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)
@@ -151,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
 
@@ -587,7 +587,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
@@ -770,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
@@ -869,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
 
@@ -885,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
@@ -898,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))
 
@@ -911,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)
 
@@ -947,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 =
@@ -1031,7 +1031,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,21 +1042,17 @@ 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
   gsumToSchema opts _ =
     (<>) <$> 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

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)

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)
 

src/Data/OpenApi/Optics.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -- |

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 -Wredundant-constraints