@@ -135,13 +135,13 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
135135--
136136-- instance ToSchema Coord
137137-- @
138−class ToSchema a where
138+class Typeable a => ToSchema a where
139139 -- | Convert a type into an optionally named schema
140140 -- together with all used definitions.
141141 -- Note that the schema itself is included in definitions
142142 -- only if it is recursive (and thus needs its definition in scope).
143143 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
144− default declareNamedSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
144+ default declareNamedSchema :: (Generic a, GToSchema (Rep a)) =>
145145 Proxy a -> Declare (Definitions Schema) NamedSchema
146146 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
147147
@@ -610,12 +610,12 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
610610instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
611611instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
612612
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
614614
615615instance ToSchema a => ToSchema (Maybe a) where
616616 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
617617
618−instance (ToSchema a, ToSchema b, Typeable a, Typeable b) => ToSchema (Either a b) where
618+instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where
619619 -- To match Aeson instance
620620 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }
621621
@@ -627,17 +627,17 @@ instance ToSchema UUID.UUID where
627627 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
628628 & example ?~ toJSON (UUID.toText UUID.nil)
629629
630−instance (ToSchema a, Typeable a, ToSchema b, Typeable b) => ToSchema (a, b) where
630+instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
631631 declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
632−instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c) => ToSchema (a, b, c) where
632+instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where
633633 declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
634−instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c, ToSchema d, Typeable d) => ToSchema (a, b, c, d) where
634+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where
635635 declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
636−instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c, ToSchema d, Typeable d, ToSchema e, Typeable e) => ToSchema (a, b, c, d, e) where
636+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e) where
637637 declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
638−instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c, ToSchema d, Typeable d, ToSchema e, Typeable e, ToSchema f, Typeable f) => ToSchema (a, b, c, d, e, f) where
638+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f) where
639639 declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
640−instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c, ToSchema d, Typeable d, ToSchema e, Typeable e, ToSchema f, Typeable f, ToSchema g, Typeable g) => ToSchema (a, b, c, d, e, f, g) where
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
641641 declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
642642
643643timeSchema :: T.Text -> Schema
@@ -689,10 +689,10 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
689689instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
690690
691691-- | NOTE: This schema does not account for the uniqueness of keys.
692−instance (ToSchema a, Typeable a) => ToSchema (IntMap a) where
692+instance (ToSchema a) => ToSchema (IntMap a) where
693693 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
694694
695−instance (ToJSONKey k, ToSchema k, ToSchema v, Typeable k, Typeable v) => ToSchema (Map k v) where
695+instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
696696 declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of
697697 ToJSONKeyText _ _ -> declareObjectMapSchema
698698 ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])
@@ -703,7 +703,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v, Typeable k, Typeable v) => ToSche
703703 & type_ ?~ OpenApiObject
704704 & additionalProperties ?~ AdditionalPropertiesSchema schema
705705
706−instance (ToJSONKey k, ToSchema k, ToSchema v, Typeable k, Typeable v) => ToSchema (HashMap k v) where
706+instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
707707 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
708708
709709instance {-# OVERLAPPING #-} ToSchema Object where
@@ -807,7 +807,7 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
807807-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
808808-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
809809declareSchemaBoundedEnumKeyMapping :: forall map key value.
810− (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value, Typeable key, Typeable value)
810+ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
811811 => Proxy (map key value) -> Declare (Definitions Schema) Schema
812812declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
813813 ToJSONKeyText keyToText _ -> objectSchema keyToText
@@ -854,7 +854,7 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
854854-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
855855-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
856856toSchemaBoundedEnumKeyMapping :: forall map key value.
857− (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value, Typeable key, Typeable value)
857+ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
858858 => Proxy (map key value) -> Schema
859859toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
860860
@@ -867,6 +867,14 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
867867-- This function applied to @'defaultSchemaOptions'@
868868-- is used as the default for @'declareNamedSchema'@
869869-- when the type is an instance of @'Generic'@.
870+--
871+-- Default implementation will use the name from 'Typeable' instance, including concrete
872+-- instantioations of type variables.
873+--
874+-- For example:
875+--
876+-- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))
877+-- Just "Either_Int_Bool"
870878genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
871879 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
872880genericDeclareNamedSchema opts _ =
@@ -1102,49 +1110,6 @@ data Proxy2 a b = Proxy2
11021110
11031111data Proxy3 a b c = Proxy3
11041112
1105−-- | This class allows to generate schemas for polymorphic types (of kind @Type -> Type@).
1106−--
1107−-- Intended usage:
1108−--
1109−-- >>> data Foo a = Foo { foo :: a, bar :: Int } deriving (Eq, Show, Generic, ToSchema1)
1110−-- >>> :{
1111−-- instance (ToSchema a, Typeable a) => ToSchema (Foo a) where
1112−-- declareNamedSchema _ = declareNamedSchema @(BySchema1 Foo a) Proxy
1113−-- :}
1114−--
1115−-- >>> toNamedSchema @(Foo Int) Proxy ^. name
1116−-- Just "Foo_Int"
1117−-- >>> toNamedSchema @(Foo Bool) Proxy ^. name
1118−-- Just "Foo_Bool"
1119−-- >>> toNamedSchema @(Foo (Foo T.Text)) Proxy ^. name
1120−-- Just "Foo_(Foo_Text)"
1121−class ToSchema1 (f :: * -> *) where
1122− declareNamedSchema1 :: (Generic (f a), GToSchema (Rep (f a)), ToSchema a, Typeable a) => Proxy f -> Proxy a -> Declare (Definitions Schema) NamedSchema
1123−
1124− -- It would be cleaner to have GToSchema constraint only on default signature and not in the class method
1125− -- above, however sadly GHC does not like it.
1126− default declareNamedSchema1 :: forall a. (ToSchema a, Generic (f a), GToSchema (Rep (f a)), Typeable (f a)) => Proxy f -> Proxy a -> Declare (Definitions Schema) NamedSchema
1127− declareNamedSchema1 _ _ = genericDeclareNamedSchema @(f a) defaultSchemaOptions Proxy
1128−
1129−{- | For GHC 8.6+ it's more convenient to use @DerivingVia@ to derive instances of 'ToSchema'
1130−using 'ToSchema1' instance, like this:
1131−
1132−#if __GLASGOW_HASKELL__ >= 806
1133−>>> data Foo a = Foo { foo :: a, bar :: Int } deriving (Eq, Show, Generic, ToSchema1)
1134−>>> deriving via BySchema1 Foo a instance (ToSchema a, Typeable a) => ToSchema (Foo a)
1135−#else
1136−> data Foo a = Foo { foo :: a, bar :: Int } deriving (Eq, Show, Generic, ToSchema1)
1137−> deriving via BySchema1 Foo a instance (ToSchema a, Typeable a) => ToSchema (Foo a)
1138−#endif
1139−-}
1140−newtype BySchema1 f a = BySchema1 (f a)
1141−
1142−instance (ToSchema1 f, Generic (f a), GToSchema (Rep (f a)), Typeable (f a), ToSchema a, Typeable a) => ToSchema (BySchema1 f a) where
1143− declareNamedSchema _ = do
1144− sch <- declareNamedSchema1 @f @a Proxy Proxy
1145− let tName = T.replace " " "_" $ T.pack $ show $ typeRep @(f a)
1146− return $ rename (Just tName) sch
1147−
11481113{- $setup
11491114>>> import Data.OpenApi
11501115>>> import Data.Aeson (encode)
@@ -1154,7 +1119,4 @@ instance (ToSchema1 f, Generic (f a), GToSchema (Rep (f a)), Typeable (f a), ToS
11541119>>> :set -XDeriveAnyClass
11551120>>> :set -XStandaloneDeriving
11561121>>> :set -XTypeApplications
1157−#if __GLASGOW_HASKELL__ >= 806
1158−>>> :set -XDerivingVia
1159−#endif
11601122-}