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