git.iko.soy/typeable/openapi3
on master help sign in
Better parametric polymorphism type names
d7cd058iko
src/Data/OpenApi/Internal/Schema.hs+20−17
@@ -141,7 +141,7 @@ class ToSchema a where
141 -- Note that the schema itself is included in definitions
141 -- Note that the schema itself is included in definitions
142 -- only if it is recursive (and thus needs its definition in scope).
142 -- only if it is recursive (and thus needs its definition in scope).
143 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
143 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
144− default declareNamedSchema :: (Generic a, GToSchema (Rep a)) =>
144+ default declareNamedSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
145 Proxy a -> Declare (Definitions Schema) NamedSchema
145 Proxy a -> Declare (Definitions Schema) NamedSchema
146 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
146 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
147
147
@@ -615,7 +615,7 @@ instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain
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)
617
617
618−instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where
618+instance (ToSchema a, ToSchema b, Typeable a, Typeable b) => ToSchema (Either a b) where
619 -- To match Aeson instance
619 -- To match Aeson instance
620 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }
620 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }
621
621
@@ -627,12 +627,12 @@ 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)
629
629
630−instance (ToSchema a, ToSchema b) => ToSchema (a, b)
630+instance (ToSchema a, Typeable a, ToSchema b, Typeable b) => ToSchema (a, b)
631−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
631+instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c) => ToSchema (a, b, c)
632−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
632+instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c, ToSchema d, Typeable d) => ToSchema (a, b, c, d)
633−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
633+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)
634−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
634+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)
635−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
635+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)
636
636
637timeSchema :: T.Text -> Schema
637timeSchema :: T.Text -> Schema
638timeSchema fmt = mempty
638timeSchema fmt = mempty
@@ -683,10 +683,10 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
683instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
683instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
684
684
685-- | NOTE: This schema does not account for the uniqueness of keys.
685-- | NOTE: This schema does not account for the uniqueness of keys.
686−instance ToSchema a => ToSchema (IntMap a) where
686+instance (ToSchema a, Typeable a) => ToSchema (IntMap a) where
687 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
687 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
688
688
689−instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
689+instance (ToJSONKey k, ToSchema k, ToSchema v, Typeable k, Typeable v) => ToSchema (Map k v) where
690 declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of
690 declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of
691 ToJSONKeyText _ _ -> declareObjectMapSchema
691 ToJSONKeyText _ _ -> declareObjectMapSchema
692 ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])
692 ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])
@@ -697,7 +697,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
697 & type_ ?~ OpenApiObject
697 & type_ ?~ OpenApiObject
698 & additionalProperties ?~ AdditionalPropertiesSchema schema
698 & additionalProperties ?~ AdditionalPropertiesSchema schema
699
699
700−instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
700+instance (ToJSONKey k, ToSchema k, ToSchema v, Typeable k, Typeable v) => ToSchema (HashMap k v) where
701 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
701 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
702
702
703instance {-# OVERLAPPING #-} ToSchema Object where
703instance {-# OVERLAPPING #-} ToSchema Object where
@@ -801,7 +801,7 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
801-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
801-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
802-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
802-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
803declareSchemaBoundedEnumKeyMapping :: forall map key value.
803declareSchemaBoundedEnumKeyMapping :: forall map key value.
804− (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
804+ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value, Typeable key, Typeable value)
805 => Proxy (map key value) -> Declare (Definitions Schema) Schema
805 => Proxy (map key value) -> Declare (Definitions Schema) Schema
806declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
806declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
807 ToJSONKeyText keyToText _ -> objectSchema keyToText
807 ToJSONKeyText keyToText _ -> objectSchema keyToText
@@ -848,12 +848,12 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
848-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
848-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
849-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
849-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
850toSchemaBoundedEnumKeyMapping :: forall map key value.
850toSchemaBoundedEnumKeyMapping :: forall map key value.
851− (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
851+ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value, Typeable key, Typeable value)
852 => Proxy (map key value) -> Schema
852 => Proxy (map key value) -> Schema
853toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
853toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
854
854
855-- | A configurable generic @'Schema'@ creator.
855-- | A configurable generic @'Schema'@ creator.
856−genericDeclareSchema :: (Generic a, GToSchema (Rep a)) =>
856+genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
857 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
857 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
858genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
858genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
859
859
@@ -861,9 +861,12 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
861-- This function applied to @'defaultSchemaOptions'@
861-- This function applied to @'defaultSchemaOptions'@
862-- is used as the default for @'declareNamedSchema'@
862-- is used as the default for @'declareNamedSchema'@
863-- when the type is an instance of @'Generic'@.
863-- when the type is an instance of @'Generic'@.
864−genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a)) =>
864+genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
865 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
865 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
866+genericDeclareNamedSchema opts _ =
866−genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
867+ rename (Just tName) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
868+ where tName = T.replace " " "_" $ T.pack $ show $ typeRep @a
869+
867
870
868-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
871-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
869genericNameSchema :: forall a d f.
872genericNameSchema :: forall a d f.
@@ -1110,7 +1113,7 @@ class ToSchema1 (f :: * -> *) where
1110
1113
1111 -- It would be cleaner to have GToSchema constraint only on default signature and not in the class method
1114 -- 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.
1115 -- 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
1116+ default declareNamedSchema1 :: forall a. (ToSchema a, Generic (f a), GToSchema (Rep (f a)), Typeable (f a)) => Proxy f -> Proxy a -> Declare (Definitions Schema) NamedSchema
1114 declareNamedSchema1 _ _ = genericDeclareNamedSchema @(f a) defaultSchemaOptions Proxy
1117 declareNamedSchema1 _ _ = genericDeclareNamedSchema @(f a) defaultSchemaOptions Proxy
1115
1118
1116{- | For GHC 8.6+ it's more convenient to use @DerivingVia@ to derive instances of 'ToSchema'
1119{- | For GHC 8.6+ it's more convenient to use @DerivingVia@ to derive instances of 'ToSchema'