@@ -1,652 +1,679 @@
1−{-# LANGUAGE DeriveGeneric #-}
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE QuasiQuotes #-}
23{-# LANGUAGE ScopedTypeVariables #-}
3−{-# LANGUAGE QuasiQuotes #-}
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 (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+|]