git.iko.soy/typeable/openapi3
on master help sign in
Introduce NamedSchema for a schema with an optional name
5e4dd04Nickolay Kudasov
src/Data/Swagger/Schema.hs+8−2
compare with master
unifiedsplit
@@ -1,10 +1,16 @@
1module Data.Swagger.Schema (
1module Data.Swagger.Schema (
2+ toSchema,
2 ToSchema(..),
3 ToSchema(..),
3− toSchemaBoundedIntegral,
4+
4− toSchemaBoundedEnum,
5 SchemaOptions(..),
5 SchemaOptions(..),
6 defaultSchemaOptions,
6 defaultSchemaOptions,
7+
7 genericToSchema,
8 genericToSchema,
9+ genericToNamedSchema,
10+ genericToNamedSchemaBoundedEnum,
11+
12+ toSchemaBoundedIntegral,
13+ toSchemaBoundedEnum,
8) where
14) where
9
15
10import Data.Swagger.Schema.Internal
16import Data.Swagger.Schema.Internal
src/Data/Swagger/Schema/Internal.hs+78−52
@@ -25,48 +25,62 @@ import GHC.Generics
25import Data.Swagger.Internal
25import Data.Swagger.Internal
26import Data.Swagger.Lens
26import Data.Swagger.Lens
27
27
28+type NamedSchema = (Maybe String, Schema)
29+
30+unnamed :: Schema -> NamedSchema
31+unnamed schema = (Nothing, schema)
32+
33+named :: String -> Schema -> NamedSchema
34+named name schema = (Just name, schema)
35+
28class ToSchema a where
36class ToSchema a where
29− toSchema :: proxy a -> Schema
37+ toNamedSchema :: proxy a -> NamedSchema
30− default toSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> Schema
38+ default toNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> NamedSchema
31− toSchema = genericToSchema defaultSchemaOptions
39+ toNamedSchema = unnamed . genericToSchema defaultSchemaOptions
40+
41+toSchema :: ToSchema a => proxy a -> Schema
42+toSchema = snd . toNamedSchema
32
43
33class GToSchema (f :: * -> *) where
44class GToSchema (f :: * -> *) where
45+ gtoNamedSchema :: SchemaOptions -> proxy f -> Schema -> NamedSchema
46+
34− gtoSchema :: SchemaOptions -> proxy f -> Schema -> Schema
47+gtoSchema :: GToSchema f => SchemaOptions -> proxy f -> Schema -> Schema
48+gtoSchema opts proxy = snd . gtoNamedSchema opts proxy
35
49
36instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
50instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
37− toSchema _ = mempty
51+ toNamedSchema _ = unnamed $ mempty
38 & schemaType .~ SchemaArray
52 & schemaType .~ SchemaArray
39 & schemaItems ?~ SchemaItemsObject (Inline (toSchema (Proxy :: Proxy a)))
53 & schemaItems ?~ SchemaItemsObject (Inline (toSchema (Proxy :: Proxy a)))
40
54
41instance {-# OVERLAPPING #-} ToSchema String where
55instance {-# OVERLAPPING #-} ToSchema String where
42− toSchema _ = mempty & schemaType .~ SchemaString
56+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaString
43
57
44instance ToSchema Bool where
58instance ToSchema Bool where
45− toSchema _ = mempty & schemaType .~ SchemaBoolean
59+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaBoolean
46
60
47instance ToSchema Integer where
61instance ToSchema Integer where
48− toSchema _ = mempty & schemaType .~ SchemaInteger
62+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaInteger
49
63
50−instance ToSchema Int where toSchema = toSchemaBoundedIntegral
64+instance ToSchema Int where toNamedSchema = unnamed . toSchemaBoundedIntegral
51−instance ToSchema Int8 where toSchema = toSchemaBoundedIntegral
65+instance ToSchema Int8 where toNamedSchema = unnamed . toSchemaBoundedIntegral
52−instance ToSchema Int16 where toSchema = toSchemaBoundedIntegral
66+instance ToSchema Int16 where toNamedSchema = unnamed . toSchemaBoundedIntegral
53−instance ToSchema Int32 where toSchema = toSchemaBoundedIntegral
67+instance ToSchema Int32 where toNamedSchema = unnamed . toSchemaBoundedIntegral
54−instance ToSchema Int64 where toSchema = toSchemaBoundedIntegral
68+instance ToSchema Int64 where toNamedSchema = unnamed . toSchemaBoundedIntegral
55
69
56−instance ToSchema Word where toSchema = toSchemaBoundedIntegral
70+instance ToSchema Word where toNamedSchema = unnamed . toSchemaBoundedIntegral
57−instance ToSchema Word8 where toSchema = toSchemaBoundedIntegral
71+instance ToSchema Word8 where toNamedSchema = unnamed . toSchemaBoundedIntegral
58−instance ToSchema Word16 where toSchema = toSchemaBoundedIntegral
72+instance ToSchema Word16 where toNamedSchema = unnamed . toSchemaBoundedIntegral
59−instance ToSchema Word32 where toSchema = toSchemaBoundedIntegral
73+instance ToSchema Word32 where toNamedSchema = unnamed . toSchemaBoundedIntegral
60−instance ToSchema Word64 where toSchema = toSchemaBoundedIntegral
74+instance ToSchema Word64 where toNamedSchema = unnamed . toSchemaBoundedIntegral
61
75
62instance ToSchema Double where
76instance ToSchema Double where
63− toSchema _ = mempty & schemaType .~ SchemaNumber
77+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaNumber
64
78
65instance ToSchema Float where
79instance ToSchema Float where
66− toSchema _ = mempty & schemaType .~ SchemaNumber
80+ toNamedSchema _ = unnamed $ mempty & schemaType .~ SchemaNumber
67
81
68instance ToSchema a => ToSchema (Maybe a) where
82instance ToSchema a => ToSchema (Maybe a) where
69− toSchema _ = toSchema (Proxy :: Proxy a)
83+ toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
70
84
71instance (ToSchema a, ToSchema b) => ToSchema (a, b)
85instance (ToSchema a, ToSchema b) => ToSchema (a, b)
72instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
86instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
@@ -76,45 +90,47 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f
76instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
90instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
77
91
78instance ToSchema T.Text where
92instance ToSchema T.Text where
79− toSchema _ = toSchema (Proxy :: Proxy String)
93+ toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy String)
80
94
81instance ToSchema TL.Text where
95instance ToSchema TL.Text where
82− toSchema _ = toSchema (Proxy :: Proxy String)
96+ toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy String)
83
97
84instance ToSchema a => ToSchema (Map String a) where
98instance ToSchema a => ToSchema (Map String a) where
85− toSchema _ = mempty
99+ toNamedSchema _ = unnamed $ mempty
86 & schemaType .~ SchemaObject
100 & schemaType .~ SchemaObject
87 & schemaAdditionalProperties ?~ toSchema (Proxy :: Proxy a)
101 & schemaAdditionalProperties ?~ toSchema (Proxy :: Proxy a)
88
102
89−instance ToSchema a => ToSchema (Map T.Text a) where toSchema _ = toSchema (Proxy :: Proxy (Map String a))
103+instance ToSchema a => ToSchema (Map T.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
90−instance ToSchema a => ToSchema (Map TL.Text a) where toSchema _ = toSchema (Proxy :: Proxy (Map String a))
104+instance ToSchema a => ToSchema (Map TL.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
91
105
92−instance ToSchema a => ToSchema (HashMap String a) where toSchema _ = toSchema (Proxy :: Proxy (Map String a))
106+instance ToSchema a => ToSchema (HashMap String a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
93−instance ToSchema a => ToSchema (HashMap T.Text a) where toSchema _ = toSchema (Proxy :: Proxy (Map String a))
107+instance ToSchema a => ToSchema (HashMap T.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
94−instance ToSchema a => ToSchema (HashMap TL.Text a) where toSchema _ = toSchema (Proxy :: Proxy (Map String a))
108+instance ToSchema a => ToSchema (HashMap TL.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
95
109
96instance ToSchema a => ToSchema (Set a) where
110instance ToSchema a => ToSchema (Set a) where
97− toSchema _ = toSchema (Proxy :: Proxy [a])
111+ toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy [a])
98 & schemaUniqueItems ?~ True
112 & schemaUniqueItems ?~ True
99
113
100−instance ToSchema a => ToSchema (HashSet a) where toSchema _ = toSchema (Proxy :: Proxy (Set a))
114+instance ToSchema a => ToSchema (HashSet a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Set a))
101
115
102−instance ToSchema All where toSchema _ = toSchema (Proxy :: Proxy Bool)
116+instance ToSchema All where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy Bool)
103−instance ToSchema Any where toSchema _ = toSchema (Proxy :: Proxy Bool)
117+instance ToSchema Any where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy Bool)
104−instance ToSchema a => ToSchema (Sum a) where toSchema _ = toSchema (Proxy :: Proxy a)
118+instance ToSchema a => ToSchema (Sum a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
105−instance ToSchema a => ToSchema (Product a) where toSchema _ = toSchema (Proxy :: Proxy a)
119+instance ToSchema a => ToSchema (Product a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
106−instance ToSchema a => ToSchema (First a) where toSchema _ = toSchema (Proxy :: Proxy a)
120+instance ToSchema a => ToSchema (First a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
107−instance ToSchema a => ToSchema (Last a) where toSchema _ = toSchema (Proxy :: Proxy a)
121+instance ToSchema a => ToSchema (Last a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
108−instance ToSchema a => ToSchema (Dual a) where toSchema _ = toSchema (Proxy :: Proxy a)
122+instance ToSchema a => ToSchema (Dual a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
109
123
110data SchemaOptions = SchemaOptions
124data SchemaOptions = SchemaOptions
111 { fieldLabelModifier :: String -> String
125 { fieldLabelModifier :: String -> String
126+ , datatypeNameModifier :: String -> String
112 , unwrapUnaryRecords :: Bool
127 , unwrapUnaryRecords :: Bool
113 }
128 }
114
129
115defaultSchemaOptions :: SchemaOptions
130defaultSchemaOptions :: SchemaOptions
116defaultSchemaOptions = SchemaOptions
131defaultSchemaOptions = SchemaOptions
117 { fieldLabelModifier = id
132 { fieldLabelModifier = id
133+ , datatypeNameModifier = id
118 , unwrapUnaryRecords = False
134 , unwrapUnaryRecords = False
119 }
135 }
120
136
@@ -129,25 +145,35 @@ toSchemaBoundedEnum _ = mempty
129 & schemaType .~ SchemaString
145 & schemaType .~ SchemaString
130 & schemaEnum ?~ map toJSON [minBound..maxBound :: a]
146 & schemaEnum ?~ map toJSON [minBound..maxBound :: a]
131
147
148+genericToNamedSchemaBoundedEnum :: (ToJSON a, Bounded a, Enum a, Generic a) => proxy a -> NamedSchema
149+genericToNamedSchemaBoundedEnum = unnamed . toSchemaBoundedEnum
150+
151+genericToSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Schema
152+genericToSchema opts = snd . genericToNamedSchema opts
153+
132−genericToSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Schema
154+genericToNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> NamedSchema
133−genericToSchema opts _ = gtoSchema opts (Proxy :: Proxy (Rep a)) mempty
155+genericToNamedSchema opts _ = gtoNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
134
156
135instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
157instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
136− gtoSchema opts _ = gtoSchema opts (Proxy :: Proxy f) . gtoSchema opts (Proxy :: Proxy g)
158+ gtoNamedSchema opts _ = unnamed . gtoSchema opts (Proxy :: Proxy f) . gtoSchema opts (Proxy :: Proxy g)
137
159
138-- | Single constructor data type.
160-- | Single constructor data type.
139−instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (D1 d (C1 c f)) where
161+instance {-# OVERLAPPABLE #-} (Datatype d, GToSchema f) => GToSchema (D1 d (C1 c f)) where
140− gtoSchema opts _ = gtoSchema opts (Proxy :: Proxy f)
162+ gtoNamedSchema opts _ = named schemaName . gtoSchema opts (Proxy :: Proxy f)
163+ where
164+ schemaName = datatypeNameModifier opts $ datatypeName (Proxy3 :: Proxy3 d f p)
141
165
142-- | Single field single constructor data type.
166-- | Single field single constructor data type.
143−instance (Selector s, GToSchema f) => GToSchema (D1 d (C1 c (S1 s f))) where
167+instance (Datatype d, Selector s, GToSchema f) => GToSchema (D1 d (C1 c (S1 s f))) where
144− gtoSchema opts _ s
168+ gtoNamedSchema opts _ s
145− | unwrapUnaryRecords opts = gtoSchema opts (Proxy :: Proxy f) s
169+ | unwrapUnaryRecords opts = named schemaName $ gtoSchema opts (Proxy :: Proxy f) s
170+ | otherwise = named schemaName $
146− | otherwise = case schema ^. schemaItems of
171+ case schema ^. schemaItems of
147− Just (SchemaItemsArray [Inline fieldSchema]) -> fieldSchema
172+ Just (SchemaItemsArray [Inline fieldSchema]) -> fieldSchema
148− _ -> schema
173+ _ -> schema
149 where
174 where
150 schema = gtoSchema opts (Proxy :: Proxy (S1 s f)) s
175 schema = gtoSchema opts (Proxy :: Proxy (S1 s f)) s
176+ schemaName = datatypeNameModifier opts $ datatypeName (Proxy3 :: Proxy3 d f p)
151
177
152appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems
178appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems
153appendItem x Nothing = Just (SchemaItemsArray [x])
179appendItem x Nothing = Just (SchemaItemsArray [x])
@@ -171,14 +197,14 @@ withFieldSchema opts _ isRequiredField schema
171
197
172-- | Optional record fields.
198-- | Optional record fields.
173instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
199instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
174− gtoSchema opts _ = withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
200+ gtoNamedSchema opts _ = unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
175
201
176-- | Record fields.
202-- | Record fields.
177instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
203instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
178− gtoSchema opts _ = withFieldSchema opts (Proxy2 :: Proxy2 s f) True
204+ gtoNamedSchema opts _ = unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
179
205
180instance ToSchema c => GToSchema (K1 i c) where
206instance ToSchema c => GToSchema (K1 i c) where
181− gtoSchema _ _ _ = toSchema (Proxy :: Proxy c)
207+ gtoNamedSchema _ _ _ = unnamed $ toSchema (Proxy :: Proxy c)
182
208
183data Proxy2 a b = Proxy2
209data Proxy2 a b = Proxy2
184
210