@@ -135,7 +135,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
136-- instance ToSchema Coord
136-- instance ToSchema Coord
138−class ToSchema a where
138+class Typeable a => ToSchema a where
139 -- | Convert a type into an optionally named schema
139 -- | Convert a type into an optionally named schema
140 -- together with all used definitions.
140 -- together with all used definitions.
141 -- Note that the schema itself is included in definitions
141 -- Note that the schema itself is included in definitions
@@ -610,7 +610,7 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
610instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
610instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
611instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
611instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
613−instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
613+instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
615instance ToSchema a => ToSchema (Maybe a) where
615instance ToSchema a => ToSchema (Maybe a) where
616 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
616 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -627,12 +627,18 @@ instance ToSchema UUID.UUID where
627 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
627 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
628 & example ?~ toJSON (UUID.toText UUID.nil)
628 & example ?~ toJSON (UUID.toText UUID.nil)
630−instance (ToSchema a, ToSchema b) => ToSchema (a, b)
630+instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
631+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
631−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
632+instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where
633+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
632−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
634+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where
635+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
633−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
636+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e) where
637+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
634−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
638+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f) where
639+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
635−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
640+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g) where
641+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
637timeSchema :: T.Text -> Schema
643timeSchema :: T.Text -> Schema
638timeSchema fmt = mempty
644timeSchema fmt = mempty
@@ -683,7 +689,7 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
683instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
689instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
685-- | NOTE: This schema does not account for the uniqueness of keys.
691-- | NOTE: This schema does not account for the uniqueness of keys.
686−instance ToSchema a => ToSchema (IntMap a) where
692+instance (ToSchema a) => ToSchema (IntMap a) where
687 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
693 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
689instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
695instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
@@ -853,7 +859,7 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
853toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
859toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
855-- | A configurable generic @'Schema'@ creator.
861-- | A configurable generic @'Schema'@ creator.
856−genericDeclareSchema :: (Generic a, GToSchema (Rep a)) =>
862+genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
857 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
863 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
858genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
864genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
@@ -861,9 +867,24 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
861-- This function applied to @'defaultSchemaOptions'@
867-- This function applied to @'defaultSchemaOptions'@
862-- is used as the default for @'declareNamedSchema'@
868-- is used as the default for @'declareNamedSchema'@
863-- when the type is an instance of @'Generic'@.
869-- when the type is an instance of @'Generic'@.
871+-- Default implementation will use the name from 'Typeable' instance, including concrete
872+-- instantioations of type variables.
876+-- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))
877+-- Just "Either_Int_Bool"
864−genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a)) =>
878+genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
865 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
879 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
880+genericDeclareNamedSchema opts _ =
866−genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
881+ rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
885+ orig = fmap unspace $ show $ typeRep @a
886+ name = datatypeNameModifier opts orig
868-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
889-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
869genericNameSchema :: forall a d f.
890genericNameSchema :: forall a d f.
@@ -1089,49 +1110,6 @@ data Proxy2 a b = Proxy2
1090data Proxy3 a b c = Proxy3
1111data Proxy3 a b c = Proxy3
1092−-- | This class allows to generate schemas for polymorphic types (of kind @Type -> Type@).
1096−-- >>> data Foo a = Foo { foo :: a, bar :: Int } deriving (Eq, Show, Generic, ToSchema1)
1098−-- instance (ToSchema a, Typeable a) => ToSchema (Foo a) where
1099−-- declareNamedSchema _ = declareNamedSchema @(BySchema1 Foo a) Proxy
1102−-- >>> toNamedSchema @(Foo Int) Proxy ^. name
1104−-- >>> toNamedSchema @(Foo Bool) Proxy ^. name
1106−-- >>> toNamedSchema @(Foo (Foo T.Text)) Proxy ^. name
1107−-- Just "Foo_(Foo_Text)"
1108−class ToSchema1 (f :: * -> *) where
1109− declareNamedSchema1 :: (Generic (f a), GToSchema (Rep (f a)), ToSchema a) => Proxy f -> Proxy a -> Declare (Definitions Schema) NamedSchema
1111− -- It would be cleaner to have GToSchema constraint only on default signature and not in the class method
1112− -- above, however sadly GHC does not like it.
1113− default declareNamedSchema1 :: forall a. (ToSchema a, Generic (f a), GToSchema (Rep (f a))) => Proxy f -> Proxy a -> Declare (Definitions Schema) NamedSchema
1114− declareNamedSchema1 _ _ = genericDeclareNamedSchema @(f a) defaultSchemaOptions Proxy
1116−{- | For GHC 8.6+ it's more convenient to use @DerivingVia@ to derive instances of 'ToSchema'
1117−using 'ToSchema1' instance, like this:
1119−#if __GLASGOW_HASKELL__ >= 806
1120−>>> data Foo a = Foo { foo :: a, bar :: Int } deriving (Eq, Show, Generic, ToSchema1)
1121−>>> deriving via BySchema1 Foo a instance (ToSchema a, Typeable a) => ToSchema (Foo a)
1123−> data Foo a = Foo { foo :: a, bar :: Int } deriving (Eq, Show, Generic, ToSchema1)
1124−> deriving via BySchema1 Foo a instance (ToSchema a, Typeable a) => ToSchema (Foo a)
1127−newtype BySchema1 f a = BySchema1 (f a)
1129−instance (ToSchema1 f, Generic (f a), GToSchema (Rep (f a)), Typeable (f a), ToSchema a) => ToSchema (BySchema1 f a) where
1130− declareNamedSchema _ = do
1131− sch <- declareNamedSchema1 @f @a Proxy Proxy
1132− let tName = T.replace " " "_" $ T.pack $ show $ typeRep @(f a)
1133− return $ rename (Just tName) sch
1135{- $setup
1113{- $setup
1136>>> import Data.OpenApi
1114>>> import Data.OpenApi
1137>>> import Data.Aeson (encode)
1115>>> import Data.Aeson (encode)
@@ -1141,7 +1119,4 @@ instance (ToSchema1 f, Generic (f a), GToSchema (Rep (f a)), Typeable (f a), ToS
1141>>> :set -XDeriveAnyClass
1119>>> :set -XDeriveAnyClass
1142>>> :set -XStandaloneDeriving
1120>>> :set -XStandaloneDeriving
1143>>> :set -XTypeApplications
1121>>> :set -XTypeApplications
1144−#if __GLASGOW_HASKELL__ >= 806
1145−>>> :set -XDerivingVia