@@ -4,649 +4,649 @@
44
55module Data.Swagger.CommonTestTypes where
66
7− import Prelude ()
8− import Prelude.Compat
9−
10− import Data.Aeson (Value, ToJSON(..), ToJSONKey(..))
11− import Data.Aeson.Types (toJSONKeyText)
12− import Data.Aeson.QQ
13− import Data.Char
14− import Data.Proxy
15− import Data.Set (Set)
16− import Data.Map (Map)
17− import qualified Data.Text as Text
18− import GHC.Generics
19−
20− import Data.Swagger
21− import Data.Swagger.Declare
22− import Data.Swagger.Internal (SwaggerKind(..))
23−
24− -- ========================================================================
25− -- Unit type
26− -- ========================================================================
27−
28− data Unit = Unit deriving (Generic)
29− instance ToParamSchema Unit
30− instance ToSchema Unit
31−
32− unitSchemaJSON :: Value
33− unitSchemaJSON = [aesonQQ|
34− {
35− "type": "string",
36− "enum": ["Unit"]
37− }
38− |]
39−
40− -- ========================================================================
41− -- Color (enum)
42− -- ========================================================================
43− data Color
44− = Red
45− | Green
46− | Blue
47− deriving (Generic)
48− instance ToParamSchema Color
49− instance ToSchema Color
50−
51− colorSchemaJSON :: Value
52− colorSchemaJSON = [aesonQQ|
53− {
54− "type": "string",
55− "enum": ["Red", "Green", "Blue"]
56− }
57− |]
58−
59− -- ========================================================================
60− -- Shade (paramSchemaToNamedSchema)
61− -- ========================================================================
62−
63− data Shade = Dim | Bright deriving (Generic)
64− instance ToParamSchema Shade
65−
66− instance ToSchema Shade where declareNamedSchema = pure . paramSchemaToNamedSchema defaultSchemaOptions
67−
68− shadeSchemaJSON :: Value
69− shadeSchemaJSON = [aesonQQ|
70− {
71− "type": "string",
72− "enum": ["Dim", "Bright"]
73− }
74− |]
75−
76− -- ========================================================================
77− -- Paint (record with bounded enum property)
78− -- ========================================================================
79−
80− newtype Paint = Paint { color :: Color }
81− deriving (Generic)
82− instance ToSchema Paint
83−
84− paintSchemaJSON :: Value
85− paintSchemaJSON = [aesonQQ|
86− {
87− "type": "object",
88− "properties":
89− {
90− "color":
91− {
92− "$ref": "#/definitions/Color"
93− }
94− },
95− "required": ["color"]
96− }
97− |]
98−
99− paintInlinedSchemaJSON :: Value
100− paintInlinedSchemaJSON = [aesonQQ|
101− {
102− "type": "object",
103− "properties":
104− {
105− "color":
106− {
107− "type": "string",
108− "enum": ["Red", "Green", "Blue"]
109− }
110− },
111− "required": ["color"]
112− }
113− |]
114−
115− -- ========================================================================
116− -- Status (constructorTagModifier)
117− -- ========================================================================
118−
119− data Status
120− = StatusOk
121− | StatusError
122− deriving (Generic)
123−
124− instance ToParamSchema Status where
125− toParamSchema = genericToParamSchema defaultSchemaOptions
126− { constructorTagModifier = map toLower . drop (length "Status") }
127− instance ToSchema Status where
128− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
129− { constructorTagModifier = map toLower . drop (length "Status") }
130−
131− statusSchemaJSON :: Value
132− statusSchemaJSON = [aesonQQ|
133− {
134− "type": "string",
135− "enum": ["ok", "error"]
136− }
137− |]
138−
139− -- ========================================================================
140− -- Email (newtype with unwrapUnaryRecords set to True)
141− -- ========================================================================
142−
143− newtype Email = Email { getEmail :: String }
144− deriving (Generic)
145− instance ToParamSchema Email
146− instance ToSchema Email where
147− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
148− { unwrapUnaryRecords = True }
149−
150− emailSchemaJSON :: Value
151− emailSchemaJSON = [aesonQQ|
152− {
153− "type": "string"
154− }
155− |]
156−
157− -- ========================================================================
158− -- UserId (non-record newtype)
159− -- ========================================================================
160−
161− newtype UserId = UserId Integer
162− deriving (Eq, Ord, Generic)
163− instance ToParamSchema UserId
164− instance ToSchema UserId
165−
166− userIdSchemaJSON :: Value
167− userIdSchemaJSON = [aesonQQ|
168− {
169− "type": "integer"
170− }
171− |]
172−
173− -- ========================================================================
174− -- UserGroup (set newtype)
175− -- ========================================================================
176−
177− newtype UserGroup = UserGroup (Set UserId)
178− deriving (Generic)
179− instance ToSchema UserGroup
180−
181− userGroupSchemaJSON :: Value
182− userGroupSchemaJSON = [aesonQQ|
183− {
184− "type": "array",
185− "items": { "$ref": "#/definitions/UserId" },
186− "uniqueItems": true
187− }
188− |]
189−
190− -- ========================================================================
191− -- Person (simple record with optional fields)
192− -- ========================================================================
193− data Person = Person
194− { name :: String
195− , phone :: Integer
196− , email :: Maybe String
197− } deriving (Generic)
198−
199− instance ToSchema Person
200−
201− personSchemaJSON :: Value
202− personSchemaJSON = [aesonQQ|
203− {
204− "type": "object",
205− "properties":
206− {
207− "name": { "type": "string" },
208− "phone": { "type": "integer" },
209− "email": { "type": "string" }
210− },
211− "required": ["name", "phone"]
212− }
213− |]
214−
215− -- ========================================================================
216− -- Player (record newtype)
217− -- ========================================================================
218−
219− newtype Player = Player
220− { position :: Point
221− } deriving (Generic)
222− instance ToSchema Player
223−
224− playerSchemaJSON :: Value
225− playerSchemaJSON = [aesonQQ|
226− {
227− "type": "object",
228− "properties":
229− {
230− "position":
231− {
232− "$ref": "#/definitions/Point"
233− }
234− },
235− "required": ["position"]
236− }
237− |]
238−
239− newtype Players = Players [Inlined Player]
240− deriving (Generic)
241− instance ToSchema Players
242−
243− playersSchemaJSON :: Value
244− playersSchemaJSON = [aesonQQ|
245− {
246− "type": "array",
247− "items":
248− {
249− "type": "object",
250− "properties":
251− {
252− "position":
253− {
254− "$ref": "#/definitions/Point"
255− }
256− },
257− "required": ["position"]
258− }
259− }
260− |]
261−
262− -- ========================================================================
263− -- Character (sum type with ref and record in alternative)
264− -- ========================================================================
265−
266− data Character
267− = PC Player
268− | NPC { npcName :: String, npcPosition :: Point }
269− deriving (Generic)
270− instance ToSchema Character
271−
272− characterSchemaJSON :: Value
273− characterSchemaJSON = [aesonQQ|
274− {
275− "type": "object",
276− "properties":
277− {
278− "PC": { "$ref": "#/definitions/Player" },
279− "NPC":
280− {
281− "type": "object",
282− "properties":
283− {
284− "npcName": { "type": "string" },
285− "npcPosition": { "$ref": "#/definitions/Point" }
286− },
287− "required": ["npcName", "npcPosition"]
288− }
289− },
290− "maxProperties": 1,
291− "minProperties": 1
292− }
293− |]
294−
295− characterInlinedSchemaJSON :: Value
296− characterInlinedSchemaJSON = [aesonQQ|
297− {
298− "type": "object",
299− "properties":
300− {
301− "PC":
302− {
303− "type": "object",
304− "properties":
305− {
306− "position":
307− {
308− "type": "object",
309− "properties":
310− {
311− "x": { "type": "number", "format": "double" },
312− "y": { "type": "number", "format": "double" }
313− },
314− "required": ["x", "y"]
315− }
316− },
317− "required": ["position"]
318− },
319− "NPC":
320− {
321− "type": "object",
322− "properties":
323− {
324− "npcName": { "type": "string" },
325− "npcPosition":
326− {
327− "type": "object",
328− "properties":
329− {
330− "x": { "type": "number", "format": "double" },
331− "y": { "type": "number", "format": "double" }
332− },
333− "required": ["x", "y"]
334− }
335− },
336− "required": ["npcName", "npcPosition"]
337− }
338− },
339− "maxProperties": 1,
340− "minProperties": 1
341− }
342− |]
343−
344− characterInlinedPlayerSchemaJSON :: Value
345− characterInlinedPlayerSchemaJSON = [aesonQQ|
346− {
347− "type": "object",
348− "properties":
349− {
350− "PC":
351− {
352− "type": "object",
353− "properties":
354− {
355− "position":
356− {
357− "$ref": "#/definitions/Point"
358− }
359− },
360− "required": ["position"]
361− },
362− "NPC":
363− {
364− "type": "object",
365− "properties":
366− {
367− "npcName": { "type": "string" },
368− "npcPosition": { "$ref": "#/definitions/Point" }
369− },
370− "required": ["npcName", "npcPosition"]
371− }
372− },
373− "maxProperties": 1,
374− "minProperties": 1
375− }
376− |]
377−
378− -- ========================================================================
379− -- ISPair (non-record product data type)
380− -- ========================================================================
381− data ISPair = ISPair Integer String
382− deriving (Generic)
383−
384− instance ToSchema ISPair
385−
386− ispairSchemaJSON :: Value
387− ispairSchemaJSON = [aesonQQ|
388− {
389− "type": "array",
390− "items":
391− [
392− { "type": "integer" },
393− { "type": "string" }
394− ],
395− "minItems": 2,
396− "maxItems": 2
397− }
398− |]
399−
400− -- ========================================================================
401− -- Point (record data type with custom fieldLabelModifier)
402− -- ========================================================================
403−
404− data Point = Point
405− { pointX :: Double
406− , pointY :: Double
407− } deriving (Generic)
408−
409− instance ToSchema Point where
410− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
411− { fieldLabelModifier = map toLower . drop (length "point") }
412−
413− pointSchemaJSON :: Value
414− pointSchemaJSON = [aesonQQ|
415− {
416− "type": "object",
417− "properties":
418− {
419− "x": { "type": "number", "format": "double" },
420− "y": { "type": "number", "format": "double" }
421− },
422− "required": ["x", "y"]
423− }
424− |]
425−
426− -- ========================================================================
427− -- Point (record data type with multiple fields)
428− -- ========================================================================
429−
430− data Point5 = Point5
431− { point5X :: Double
432− , point5Y :: Double
433− , point5Z :: Double
434− , point5U :: Double
435− , point5V :: Double -- 5 dimensional!
436− } deriving (Generic)
437−
438− instance ToSchema Point5 where
439− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
440− { fieldLabelModifier = map toLower . drop (length "point5") }
441−
442− point5SchemaJSON :: Value
443− point5SchemaJSON = [aesonQQ|
444− {
445− "type": "object",
446− "properties":
447− {
448− "x": { "type": "number", "format": "double" },
449− "y": { "type": "number", "format": "double" },
450− "z": { "type": "number", "format": "double" },
451− "u": { "type": "number", "format": "double" },
452− "v": { "type": "number", "format": "double" }
453− },
454− "required": ["x", "y", "z", "u", "v"]
455− }
456− |]
457−
458− point5Properties :: [String]
459− point5Properties = ["x", "y", "z", "u", "v"]
460−
461− -- ========================================================================
462− -- MyRoseTree (custom datatypeNameModifier)
463− -- ========================================================================
464−
465− data MyRoseTree = MyRoseTree
466− { root :: String
467− , trees :: [MyRoseTree]
468− } deriving (Generic)
469−
470− instance ToSchema MyRoseTree where
471− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
472− { datatypeNameModifier = drop (length "My") }
473−
474− myRoseTreeSchemaJSON :: Value
475− myRoseTreeSchemaJSON = [aesonQQ|
476− {
477− "type": "object",
478− "properties":
479− {
480− "root": { "type": "string" },
481− "trees":
482− {
483− "type": "array",
484− "items":
485− {
486− "$ref": "#/definitions/RoseTree"
487− }
488− }
489− },
490− "required": ["root", "trees"]
491− }
492− |]
493−
494− data MyRoseTree' = MyRoseTree'
495− { root' :: String
496− , trees' :: [MyRoseTree']
497− } deriving (Generic)
498−
499− instance ToSchema MyRoseTree' where
500− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
501− { datatypeNameModifier = map toLower }
502−
503− myRoseTreeSchemaJSON' :: Value
504− myRoseTreeSchemaJSON' = [aesonQQ|
505− {
506− "type": "object",
507− "properties":
508− {
509− "root'": { "type": "string" },
510− "trees'":
511− {
512− "type": "array",
513− "items":
514− {
515− "$ref": "#/definitions/myrosetree'"
516− }
517− }
518− },
519− "required": ["root'", "trees'"]
520− }
521− |]
522−
523− -- ========================================================================
524− -- Inlined (newtype for inlining schemas)
525− -- ========================================================================
526−
527− newtype Inlined a = Inlined { getInlined :: a }
528−
529− instance ToSchema a => ToSchema (Inlined a) where
530− declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
531− where
532− unname (NamedSchema _ s) = NamedSchema Nothing s
533−
534− -- ========================================================================
535− -- Light (sum type with unwrapUnaryRecords)
536− -- ========================================================================
537−
538− data Light
539− = NoLight
540− | LightFreq Double
541− | LightColor Color
542− | LightWaveLength { waveLength :: Double }
543− deriving (Generic)
544−
545− instance ToSchema Light where
546− declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
547− { unwrapUnaryRecords = True }
548−
549− lightSchemaJSON :: Value
550− lightSchemaJSON = [aesonQQ|
551− {
552− "type": "object",
553− "properties":
554− {
555− "NoLight": { "type": "array", "items": [] },
556− "LightFreq": { "type": "number", "format": "double" },
557− "LightColor": { "$ref": "#/definitions/Color" },
558− "LightWaveLength": { "type": "number", "format": "double" }
559− },
560− "maxProperties": 1,
561− "minProperties": 1
562− }
563− |]
564−
565− lightInlinedSchemaJSON :: Value
566− lightInlinedSchemaJSON = [aesonQQ|
567− {
568− "type": "object",
569− "properties":
570− {
571− "NoLight": { "type": "array", "items": [] },
572− "LightFreq": { "type": "number", "format": "double" },
573− "LightColor":
574− {
575− "type": "string",
576− "enum": ["Red", "Green", "Blue"]
577− },
578− "LightWaveLength": { "type": "number", "format": "double" }
579− },
580− "maxProperties": 1,
581− "minProperties": 1
582− }
583− |]
584−
585− -- ========================================================================
586− -- ResourceId (series of newtypes)
587− -- ========================================================================
588−
589− newtype Id = Id String deriving (Generic)
590− instance ToSchema Id
591−
592− newtype ResourceId = ResourceId Id deriving (Generic)
593− instance ToSchema ResourceId
594−
595− -- ========================================================================
596− -- ButtonImages (bounded enum key mapping)
597− -- ========================================================================
598−
599− data ButtonState = Neutral | Focus | Active | Hover | Disabled
600− deriving (Show, Bounded, Enum, Generic)
601−
602− instance ToJSON ButtonState
603− instance ToSchema ButtonState
604− instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (Text.pack . show)
605−
606− type ImageUrl = Text.Text
607−
608− newtype ButtonImages = ButtonImages { getButtonImages :: Map ButtonState ImageUrl }
609− deriving (Generic)
610−
611− instance ToJSON ButtonImages where
612− toJSON = toJSON . getButtonImages
613−
614− instance ToSchema ButtonImages where
615− declareNamedSchema = genericDeclareNamedSchemaNewtype defaultSchemaOptions
616− declareSchemaBoundedEnumKeyMapping
617−
618− buttonImagesSchemaJSON :: Value
619− buttonImagesSchemaJSON = [aesonQQ|
620− {
621− "type": "object",
622− "properties":
623− {
624− "Neutral": { "type": "string" },
625− "Focus": { "type": "string" },
626− "Active": { "type": "string" },
627− "Hover": { "type": "string" },
628− "Disabled": { "type": "string" }
629− }
630− }
631− |]
632−
633− -- ========================================================================
634− -- SingleMaybeField (single field data with optional field)
635− -- ========================================================================
636−
637− data SingleMaybeField = SingleMaybeField { singleMaybeField :: Maybe String }
638− deriving (Show, Generic)
639−
640− instance ToJSON SingleMaybeField
641− instance ToSchema SingleMaybeField
642−
643− singleMaybeFieldSchemaJSON :: Value
644− singleMaybeFieldSchemaJSON = [aesonQQ|
645− {
646− "type": "object",
647− "properties":
648− {
649− "singleMaybeField": { "type": "string" }
650− }
651− }
652− |]
7+import Prelude ()
8+import Prelude.Compat
9+
10+import Data.Aeson (Value, ToJSON(..), ToJSONKey(..))
11+import Data.Aeson.Types (toJSONKeyText)
12+import Data.Aeson.QQ
13+import Data.Char
14+import Data.Proxy
15+import Data.Set (Set)
16+import Data.Map (Map)
17+import qualified Data.Text as Text
18+import GHC.Generics
19+
20+import Data.Swagger
21+import Data.Swagger.Declare
22+import Data.Swagger.Internal (SwaggerKind(..))
23+
24+-- ========================================================================
25+-- Unit type
26+-- ========================================================================
27+
28+data Unit = Unit deriving (Generic)
29+instance ToParamSchema Unit
30+instance ToSchema Unit
31+
32+unitSchemaJSON :: Value
33+unitSchemaJSON = [aesonQQ|
34+{
35+ "type": "string",
36+ "enum": ["Unit"]
37+}
38+|]
39+
40+-- ========================================================================
41+-- Color (enum)
42+-- ========================================================================
43+data Color
44+ = Red
45+ | Green
46+ | Blue
47+ deriving (Generic)
48+instance ToParamSchema Color
49+instance ToSchema Color
50+
51+colorSchemaJSON :: Value
52+colorSchemaJSON = [aesonQQ|
53+{
54+ "type": "string",
55+ "enum": ["Red", "Green", "Blue"]
56+}
57+|]
58+
59+-- ========================================================================
60+-- Shade (paramSchemaToNamedSchema)
61+-- ========================================================================
62+
63+data Shade = Dim | Bright deriving (Generic)
64+instance ToParamSchema Shade
65+
66+instance ToSchema Shade where declareNamedSchema = pure . paramSchemaToNamedSchema defaultSchemaOptions
67+
68+shadeSchemaJSON :: Value
69+shadeSchemaJSON = [aesonQQ|
70+{
71+ "type": "string",
72+ "enum": ["Dim", "Bright"]
73+}
74+|]
75+
76+-- ========================================================================
77+-- Paint (record with bounded enum property)
78+-- ========================================================================
79+
80+newtype Paint = Paint { color :: Color }
81+ deriving (Generic)
82+instance ToSchema Paint
83+
84+paintSchemaJSON :: Value
85+paintSchemaJSON = [aesonQQ|
86+{
87+ "type": "object",
88+ "properties":
89+ {
90+ "color":
91+ {
92+ "$ref": "#/definitions/Color"
93+ }
94+ },
95+ "required": ["color"]
96+}
97+|]
98+
99+paintInlinedSchemaJSON :: Value
100+paintInlinedSchemaJSON = [aesonQQ|
101+{
102+ "type": "object",
103+ "properties":
104+ {
105+ "color":
106+ {
107+ "type": "string",
108+ "enum": ["Red", "Green", "Blue"]
109+ }
110+ },
111+ "required": ["color"]
112+}
113+|]
114+
115+-- ========================================================================
116+-- Status (constructorTagModifier)
117+-- ========================================================================
118+
119+data Status
120+ = StatusOk
121+ | StatusError
122+ deriving (Generic)
123+
124+instance ToParamSchema Status where
125+ toParamSchema = genericToParamSchema defaultSchemaOptions
126+ { constructorTagModifier = map toLower . drop (length "Status") }
127+instance ToSchema Status where
128+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
129+ { constructorTagModifier = map toLower . drop (length "Status") }
130+
131+statusSchemaJSON :: Value
132+statusSchemaJSON = [aesonQQ|
133+{
134+ "type": "string",
135+ "enum": ["ok", "error"]
136+}
137+|]
138+
139+-- ========================================================================
140+-- Email (newtype with unwrapUnaryRecords set to True)
141+-- ========================================================================
142+
143+newtype Email = Email { getEmail :: String }
144+ deriving (Generic)
145+instance ToParamSchema Email
146+instance ToSchema Email where
147+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
148+ { unwrapUnaryRecords = True }
149+
150+emailSchemaJSON :: Value
151+emailSchemaJSON = [aesonQQ|
152+{
153+ "type": "string"
154+}
155+|]
156+
157+-- ========================================================================
158+-- UserId (non-record newtype)
159+-- ========================================================================
160+
161+newtype UserId = UserId Integer
162+ deriving (Eq, Ord, Generic)
163+instance ToParamSchema UserId
164+instance ToSchema UserId
165+
166+userIdSchemaJSON :: Value
167+userIdSchemaJSON = [aesonQQ|
168+{
169+ "type": "integer"
170+}
171+|]
172+
173+-- ========================================================================
174+-- UserGroup (set newtype)
175+-- ========================================================================
176+
177+newtype UserGroup = UserGroup (Set UserId)
178+ deriving (Generic)
179+instance ToSchema UserGroup
180+
181+userGroupSchemaJSON :: Value
182+userGroupSchemaJSON = [aesonQQ|
183+{
184+ "type": "array",
185+ "items": { "$ref": "#/definitions/UserId" },
186+ "uniqueItems": true
187+}
188+|]
189+
190+-- ========================================================================
191+-- Person (simple record with optional fields)
192+-- ========================================================================
193+data Person = Person
194+ { name :: String
195+ , phone :: Integer
196+ , email :: Maybe String
197+ } deriving (Generic)
198+
199+instance ToSchema Person
200+
201+personSchemaJSON :: Value
202+personSchemaJSON = [aesonQQ|
203+{
204+ "type": "object",
205+ "properties":
206+ {
207+ "name": { "type": "string" },
208+ "phone": { "type": "integer" },
209+ "email": { "type": "string" }
210+ },
211+ "required": ["name", "phone"]
212+}
213+|]
214+
215+-- ========================================================================
216+-- Player (record newtype)
217+-- ========================================================================
218+
219+newtype Player = Player
220+ { position :: Point
221+ } deriving (Generic)
222+instance ToSchema Player
223+
224+playerSchemaJSON :: Value
225+playerSchemaJSON = [aesonQQ|
226+{
227+ "type": "object",
228+ "properties":
229+ {
230+ "position":
231+ {
232+ "$ref": "#/definitions/Point"
233+ }
234+ },
235+ "required": ["position"]
236+}
237+|]
238+
239+newtype Players = Players [Inlined Player]
240+ deriving (Generic)
241+instance ToSchema Players
242+
243+playersSchemaJSON :: Value
244+playersSchemaJSON = [aesonQQ|
245+{
246+ "type": "array",
247+ "items":
248+ {
249+ "type": "object",
250+ "properties":
251+ {
252+ "position":
253+ {
254+ "$ref": "#/definitions/Point"
255+ }
256+ },
257+ "required": ["position"]
258+ }
259+}
260+|]
261+
262+-- ========================================================================
263+-- Character (sum type with ref and record in alternative)
264+-- ========================================================================
265+
266+data Character
267+ = PC Player
268+ | NPC { npcName :: String, npcPosition :: Point }
269+ deriving (Generic)
270+instance ToSchema Character
271+
272+characterSchemaJSON :: Value
273+characterSchemaJSON = [aesonQQ|
274+{
275+ "type": "object",
276+ "properties":
277+ {
278+ "PC": { "$ref": "#/definitions/Player" },
279+ "NPC":
280+ {
281+ "type": "object",
282+ "properties":
283+ {
284+ "npcName": { "type": "string" },
285+ "npcPosition": { "$ref": "#/definitions/Point" }
286+ },
287+ "required": ["npcName", "npcPosition"]
288+ }
289+ },
290+ "maxProperties": 1,
291+ "minProperties": 1
292+}
293+|]
294+
295+characterInlinedSchemaJSON :: Value
296+characterInlinedSchemaJSON = [aesonQQ|
297+{
298+ "type": "object",
299+ "properties":
300+ {
301+ "PC":
302+ {
303+ "type": "object",
304+ "properties":
305+ {
306+ "position":
307+ {
308+ "type": "object",
309+ "properties":
310+ {
311+ "x": { "type": "number", "format": "double" },
312+ "y": { "type": "number", "format": "double" }
313+ },
314+ "required": ["x", "y"]
315+ }
316+ },
317+ "required": ["position"]
318+ },
319+ "NPC":
320+ {
321+ "type": "object",
322+ "properties":
323+ {
324+ "npcName": { "type": "string" },
325+ "npcPosition":
326+ {
327+ "type": "object",
328+ "properties":
329+ {
330+ "x": { "type": "number", "format": "double" },
331+ "y": { "type": "number", "format": "double" }
332+ },
333+ "required": ["x", "y"]
334+ }
335+ },
336+ "required": ["npcName", "npcPosition"]
337+ }
338+ },
339+ "maxProperties": 1,
340+ "minProperties": 1
341+}
342+|]
343+
344+characterInlinedPlayerSchemaJSON :: Value
345+characterInlinedPlayerSchemaJSON = [aesonQQ|
346+{
347+ "type": "object",
348+ "properties":
349+ {
350+ "PC":
351+ {
352+ "type": "object",
353+ "properties":
354+ {
355+ "position":
356+ {
357+ "$ref": "#/definitions/Point"
358+ }
359+ },
360+ "required": ["position"]
361+ },
362+ "NPC":
363+ {
364+ "type": "object",
365+ "properties":
366+ {
367+ "npcName": { "type": "string" },
368+ "npcPosition": { "$ref": "#/definitions/Point" }
369+ },
370+ "required": ["npcName", "npcPosition"]
371+ }
372+ },
373+ "maxProperties": 1,
374+ "minProperties": 1
375+}
376+|]
377+
378+-- ========================================================================
379+-- ISPair (non-record product data type)
380+-- ========================================================================
381+data ISPair = ISPair Integer String
382+ deriving (Generic)
383+
384+instance ToSchema ISPair
385+
386+ispairSchemaJSON :: Value
387+ispairSchemaJSON = [aesonQQ|
388+{
389+ "type": "array",
390+ "items":
391+ [
392+ { "type": "integer" },
393+ { "type": "string" }
394+ ],
395+ "minItems": 2,
396+ "maxItems": 2
397+}
398+|]
399+
400+-- ========================================================================
401+-- Point (record data type with custom fieldLabelModifier)
402+-- ========================================================================
403+
404+data Point = Point
405+ { pointX :: Double
406+ , pointY :: Double
407+ } deriving (Generic)
408+
409+instance ToSchema Point where
410+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
411+ { fieldLabelModifier = map toLower . drop (length "point") }
412+
413+pointSchemaJSON :: Value
414+pointSchemaJSON = [aesonQQ|
415+{
416+ "type": "object",
417+ "properties":
418+ {
419+ "x": { "type": "number", "format": "double" },
420+ "y": { "type": "number", "format": "double" }
421+ },
422+ "required": ["x", "y"]
423+}
424+|]
425+
426+-- ========================================================================
427+-- Point (record data type with multiple fields)
428+-- ========================================================================
429+
430+data Point5 = Point5
431+ { point5X :: Double
432+ , point5Y :: Double
433+ , point5Z :: Double
434+ , point5U :: Double
435+ , point5V :: Double -- 5 dimensional!
436+ } deriving (Generic)
437+
438+instance ToSchema Point5 where
439+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
440+ { fieldLabelModifier = map toLower . drop (length "point5") }
441+
442+point5SchemaJSON :: Value
443+point5SchemaJSON = [aesonQQ|
444+{
445+ "type": "object",
446+ "properties":
447+ {
448+ "x": { "type": "number", "format": "double" },
449+ "y": { "type": "number", "format": "double" },
450+ "z": { "type": "number", "format": "double" },
451+ "u": { "type": "number", "format": "double" },
452+ "v": { "type": "number", "format": "double" }
453+ },
454+ "required": ["x", "y", "z", "u", "v"]
455+}
456+|]
457+
458+point5Properties :: [String]
459+point5Properties = ["x", "y", "z", "u", "v"]
460+
461+-- ========================================================================
462+-- MyRoseTree (custom datatypeNameModifier)
463+-- ========================================================================
464+
465+data MyRoseTree = MyRoseTree
466+ { root :: String
467+ , trees :: [MyRoseTree]
468+ } deriving (Generic)
469+
470+instance ToSchema MyRoseTree where
471+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
472+ { datatypeNameModifier = drop (length "My") }
473+
474+myRoseTreeSchemaJSON :: Value
475+myRoseTreeSchemaJSON = [aesonQQ|
476+{
477+ "type": "object",
478+ "properties":
479+ {
480+ "root": { "type": "string" },
481+ "trees":
482+ {
483+ "type": "array",
484+ "items":
485+ {
486+ "$ref": "#/definitions/RoseTree"
487+ }
488+ }
489+ },
490+ "required": ["root", "trees"]
491+}
492+|]
493+
494+data MyRoseTree' = MyRoseTree'
495+ { root' :: String
496+ , trees' :: [MyRoseTree']
497+ } deriving (Generic)
498+
499+instance ToSchema MyRoseTree' where
500+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
501+ { datatypeNameModifier = map toLower }
502+
503+myRoseTreeSchemaJSON' :: Value
504+myRoseTreeSchemaJSON' = [aesonQQ|
505+{
506+ "type": "object",
507+ "properties":
508+ {
509+ "root'": { "type": "string" },
510+ "trees'":
511+ {
512+ "type": "array",
513+ "items":
514+ {
515+ "$ref": "#/definitions/myrosetree'"
516+ }
517+ }
518+ },
519+ "required": ["root'", "trees'"]
520+}
521+|]
522+
523+-- ========================================================================
524+-- Inlined (newtype for inlining schemas)
525+-- ========================================================================
526+
527+newtype Inlined a = Inlined { getInlined :: a }
528+
529+instance ToSchema a => ToSchema (Inlined a) where
530+ declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
531+ where
532+ unname (NamedSchema _ s) = NamedSchema Nothing s
533+
534+-- ========================================================================
535+-- Light (sum type with unwrapUnaryRecords)
536+-- ========================================================================
537+
538+data Light
539+ = NoLight
540+ | LightFreq Double
541+ | LightColor Color
542+ | LightWaveLength { waveLength :: Double }
543+ deriving (Generic)
544+
545+instance ToSchema Light where
546+ declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
547+ { unwrapUnaryRecords = True }
548+
549+lightSchemaJSON :: Value
550+lightSchemaJSON = [aesonQQ|
551+{
552+ "type": "object",
553+ "properties":
554+ {
555+ "NoLight": { "type": "array", "items": [] },
556+ "LightFreq": { "type": "number", "format": "double" },
557+ "LightColor": { "$ref": "#/definitions/Color" },
558+ "LightWaveLength": { "type": "number", "format": "double" }
559+ },
560+ "maxProperties": 1,
561+ "minProperties": 1
562+}
563+|]
564+
565+lightInlinedSchemaJSON :: Value
566+lightInlinedSchemaJSON = [aesonQQ|
567+{
568+ "type": "object",
569+ "properties":
570+ {
571+ "NoLight": { "type": "array", "items": [] },
572+ "LightFreq": { "type": "number", "format": "double" },
573+ "LightColor":
574+ {
575+ "type": "string",
576+ "enum": ["Red", "Green", "Blue"]
577+ },
578+ "LightWaveLength": { "type": "number", "format": "double" }
579+ },
580+ "maxProperties": 1,
581+ "minProperties": 1
582+}
583+|]
584+
585+-- ========================================================================
586+-- ResourceId (series of newtypes)
587+-- ========================================================================
588+
589+newtype Id = Id String deriving (Generic)
590+instance ToSchema Id
591+
592+newtype ResourceId = ResourceId Id deriving (Generic)
593+instance ToSchema ResourceId
594+
595+-- ========================================================================
596+-- ButtonImages (bounded enum key mapping)
597+-- ========================================================================
598+
599+data ButtonState = Neutral | Focus | Active | Hover | Disabled
600+ deriving (Show, Bounded, Enum, Generic)
601+
602+instance ToJSON ButtonState
603+instance ToSchema ButtonState
604+instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (Text.pack . show)
605+
606+type ImageUrl = Text.Text
607+
608+newtype ButtonImages = ButtonImages { getButtonImages :: Map ButtonState ImageUrl }
609+ deriving (Generic)
610+
611+instance ToJSON ButtonImages where
612+ toJSON = toJSON . getButtonImages
613+
614+instance ToSchema ButtonImages where
615+ declareNamedSchema = genericDeclareNamedSchemaNewtype defaultSchemaOptions
616+ declareSchemaBoundedEnumKeyMapping
617+
618+buttonImagesSchemaJSON :: Value
619+buttonImagesSchemaJSON = [aesonQQ|
620+{
621+ "type": "object",
622+ "properties":
623+ {
624+ "Neutral": { "type": "string" },
625+ "Focus": { "type": "string" },
626+ "Active": { "type": "string" },
627+ "Hover": { "type": "string" },
628+ "Disabled": { "type": "string" }
629+ }
630+}
631+|]
632+
633+-- ========================================================================
634+-- SingleMaybeField (single field data with optional field)
635+-- ========================================================================
636+
637+data SingleMaybeField = SingleMaybeField { singleMaybeField :: Maybe String }
638+ deriving (Show, Generic)
639+
640+instance ToJSON SingleMaybeField
641+instance ToSchema SingleMaybeField
642+
643+singleMaybeFieldSchemaJSON :: Value
644+singleMaybeFieldSchemaJSON = [aesonQQ|
645+{
646+ "type": "object",
647+ "properties":
648+ {
649+ "singleMaybeField": { "type": "string" }
650+ }
651+}
652+|]