git.iko.soy/typeable/openapi3
on fbf7723 help sign in
typeable/openapi3/test/Data/Swagger/CommonTestTypes.hs
652 lines 16 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE QuasiQuotes #-}
3{-# LANGUAGE ScopedTypeVariables #-}
5module Data.Swagger.CommonTestTypes where
7import Prelude ()
8import Prelude.Compat
10import Data.Aeson (ToJSON (..), ToJSONKey (..), Value)
11import Data.Aeson.QQ.Simple
12import Data.Aeson.Types (toJSONKeyText)
13import Data.Char
14import Data.Map (Map)
15import Data.Proxy
16import Data.Set (Set)
17import qualified Data.Text as Text
18import GHC.Generics
20import Data.Swagger
21import Data.Swagger.Declare
22import Data.Swagger.Internal (SwaggerKind (..))
24-- ========================================================================
25-- Unit type
26-- ========================================================================
28data Unit = Unit deriving (Generic)
29instance ToParamSchema Unit
30instance ToSchema Unit
32unitSchemaJSON :: Value
33unitSchemaJSON = [aesonQQ|
35 "type": "string",
36 "enum": ["Unit"]
38|]
40-- ========================================================================
41-- Color (enum)
42-- ========================================================================
43data Color
44 = Red
45 | Green
46 | Blue
47 deriving (Generic)
48instance ToParamSchema Color
49instance ToSchema Color
51colorSchemaJSON :: Value
52colorSchemaJSON = [aesonQQ|
54 "type": "string",
55 "enum": ["Red", "Green", "Blue"]
57|]
59-- ========================================================================
60-- Shade (paramSchemaToNamedSchema)
61-- ========================================================================
63data Shade = Dim | Bright deriving (Generic)
64instance ToParamSchema Shade
66instance ToSchema Shade where declareNamedSchema = pure . paramSchemaToNamedSchema defaultSchemaOptions
68shadeSchemaJSON :: Value
69shadeSchemaJSON = [aesonQQ|
71 "type": "string",
72 "enum": ["Dim", "Bright"]
74|]
76-- ========================================================================
77-- Paint (record with bounded enum property)
78-- ========================================================================
80newtype Paint = Paint { color :: Color }
81 deriving (Generic)
82instance ToSchema Paint
84paintSchemaJSON :: Value
85paintSchemaJSON = [aesonQQ|
87 "type": "object",
88 "properties":
89 {
90 "color":
91 {
92 "$ref": "#/definitions/Color"
93 }
94 },
95 "required": ["color"]
97|]
99paintInlinedSchemaJSON :: Value
100paintInlinedSchemaJSON = [aesonQQ|
102 "type": "object",
103 "properties":
104 {
105 "color":
106 {
107 "type": "string",
108 "enum": ["Red", "Green", "Blue"]
109 }
110 },
111 "required": ["color"]
113|]
115-- ========================================================================
116-- Status (constructorTagModifier)
117-- ========================================================================
119data Status
120 = StatusOk
121 | StatusError
122 deriving (Generic)
124instance ToParamSchema Status where
125 toParamSchema = genericToParamSchema defaultSchemaOptions
126 { constructorTagModifier = map toLower . drop (length "Status") }
127instance ToSchema Status where
128 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
129 { constructorTagModifier = map toLower . drop (length "Status") }
131statusSchemaJSON :: Value
132statusSchemaJSON = [aesonQQ|
134 "type": "string",
135 "enum": ["ok", "error"]
137|]
139-- ========================================================================
140-- Email (newtype with unwrapUnaryRecords set to True)
141-- ========================================================================
143newtype Email = Email { getEmail :: String }
144 deriving (Generic)
145instance ToParamSchema Email
146instance ToSchema Email where
147 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
148 { unwrapUnaryRecords = True }
150emailSchemaJSON :: Value
151emailSchemaJSON = [aesonQQ|
153 "type": "string"
155|]
157-- ========================================================================
158-- UserId (non-record newtype)
159-- ========================================================================
161newtype UserId = UserId Integer
162 deriving (Eq, Ord, Generic)
163instance ToParamSchema UserId
164instance ToSchema UserId
166userIdSchemaJSON :: Value
167userIdSchemaJSON = [aesonQQ|
169 "type": "integer"
171|]
173-- ========================================================================
174-- UserGroup (set newtype)
175-- ========================================================================
177newtype UserGroup = UserGroup (Set UserId)
178 deriving (Generic)
179instance ToSchema UserGroup
181userGroupSchemaJSON :: Value
182userGroupSchemaJSON = [aesonQQ|
184 "type": "array",
185 "items": { "$ref": "#/definitions/UserId" },
186 "uniqueItems": true
188|]
190-- ========================================================================
191-- Person (simple record with optional fields)
192-- ========================================================================
193data Person = Person
194 { name :: String
195 , phone :: Integer
196 , email :: Maybe String
197 } deriving (Generic)
199instance ToSchema Person
201personSchemaJSON :: Value
202personSchemaJSON = [aesonQQ|
204 "type": "object",
205 "properties":
206 {
207 "name": { "type": "string" },
208 "phone": { "type": "integer" },
209 "email": { "type": "string" }
210 },
211 "required": ["name", "phone"]
213|]
215-- ========================================================================
216-- Player (record newtype)
217-- ========================================================================
219newtype Player = Player
220 { position :: Point
221 } deriving (Generic)
222instance ToSchema Player
224playerSchemaJSON :: Value
225playerSchemaJSON = [aesonQQ|
227 "type": "object",
228 "properties":
229 {
230 "position":
231 {
232 "$ref": "#/definitions/Point"
233 }
234 },
235 "required": ["position"]
237|]
239newtype Players = Players [Inlined Player]
240 deriving (Generic)
241instance ToSchema Players
243playersSchemaJSON :: Value
244playersSchemaJSON = [aesonQQ|
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 }
260|]
262-- ========================================================================
263-- Character (sum type with ref and record in alternative)
264-- ========================================================================
266data Character
267 = PC Player
268 | NPC { npcName :: String, npcPosition :: Point }
269 deriving (Generic)
270instance ToSchema Character
272characterSchemaJSON :: Value
273characterSchemaJSON = [aesonQQ|
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
293|]
295characterInlinedSchemaJSON :: Value
296characterInlinedSchemaJSON = [aesonQQ|
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
342|]
344characterInlinedPlayerSchemaJSON :: Value
345characterInlinedPlayerSchemaJSON = [aesonQQ|
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
376|]
378-- ========================================================================
379-- ISPair (non-record product data type)
380-- ========================================================================
381data ISPair = ISPair Integer String
382 deriving (Generic)
384instance ToSchema ISPair
386ispairSchemaJSON :: Value
387ispairSchemaJSON = [aesonQQ|
389 "type": "array",
390 "items":
391 [
392 { "type": "integer" },
393 { "type": "string" }
394 ],
395 "minItems": 2,
396 "maxItems": 2
398|]
400-- ========================================================================
401-- Point (record data type with custom fieldLabelModifier)
402-- ========================================================================
404data Point = Point
405 { pointX :: Double
406 , pointY :: Double
407 } deriving (Generic)
409instance ToSchema Point where
410 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
411 { fieldLabelModifier = map toLower . drop (length "point") }
413pointSchemaJSON :: Value
414pointSchemaJSON = [aesonQQ|
416 "type": "object",
417 "properties":
418 {
419 "x": { "type": "number", "format": "double" },
420 "y": { "type": "number", "format": "double" }
421 },
422 "required": ["x", "y"]
424|]
426-- ========================================================================
427-- Point (record data type with multiple fields)
428-- ========================================================================
430data Point5 = Point5
431 { point5X :: Double
432 , point5Y :: Double
433 , point5Z :: Double
434 , point5U :: Double
435 , point5V :: Double -- 5 dimensional!
436 } deriving (Generic)
438instance ToSchema Point5 where
439 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
440 { fieldLabelModifier = map toLower . drop (length "point5") }
442point5SchemaJSON :: Value
443point5SchemaJSON = [aesonQQ|
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"]
456|]
458point5Properties :: [String]
459point5Properties = ["x", "y", "z", "u", "v"]
461-- ========================================================================
462-- MyRoseTree (custom datatypeNameModifier)
463-- ========================================================================
465data MyRoseTree = MyRoseTree
466 { root :: String
467 , trees :: [MyRoseTree]
468 } deriving (Generic)
470instance ToSchema MyRoseTree where
471 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
472 { datatypeNameModifier = drop (length "My") }
474myRoseTreeSchemaJSON :: Value
475myRoseTreeSchemaJSON = [aesonQQ|
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"]
492|]
494data MyRoseTree' = MyRoseTree'
495 { root' :: String
496 , trees' :: [MyRoseTree']
497 } deriving (Generic)
499instance ToSchema MyRoseTree' where
500 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
501 { datatypeNameModifier = map toLower }
503myRoseTreeSchemaJSON' :: Value
504myRoseTreeSchemaJSON' = [aesonQQ|
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'"]
521|]
523-- ========================================================================
524-- Inlined (newtype for inlining schemas)
525-- ========================================================================
527newtype Inlined a = Inlined { getInlined :: a }
529instance ToSchema a => ToSchema (Inlined a) where
530 declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
531 where
532 unname (NamedSchema _ s) = NamedSchema Nothing s
534-- ========================================================================
535-- Light (sum type with unwrapUnaryRecords)
536-- ========================================================================
538data Light
539 = NoLight
540 | LightFreq Double
541 | LightColor Color
542 | LightWaveLength { waveLength :: Double }
543 deriving (Generic)
545instance ToSchema Light where
546 declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
547 { unwrapUnaryRecords = True }
549lightSchemaJSON :: Value
550lightSchemaJSON = [aesonQQ|
552 "type": "object",
553 "properties":
554 {
555 "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
556 "LightFreq": { "type": "number", "format": "double" },
557 "LightColor": { "$ref": "#/definitions/Color" },
558 "LightWaveLength": { "type": "number", "format": "double" }
559 },
560 "maxProperties": 1,
561 "minProperties": 1
563|]
565lightInlinedSchemaJSON :: Value
566lightInlinedSchemaJSON = [aesonQQ|
568 "type": "object",
569 "properties":
570 {
571 "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
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
583|]
585-- ========================================================================
586-- ResourceId (series of newtypes)
587-- ========================================================================
589newtype Id = Id String deriving (Generic)
590instance ToSchema Id
592newtype ResourceId = ResourceId Id deriving (Generic)
593instance ToSchema ResourceId
595-- ========================================================================
596-- ButtonImages (bounded enum key mapping)
597-- ========================================================================
599data ButtonState = Neutral | Focus | Active | Hover | Disabled
600 deriving (Show, Bounded, Enum, Generic)
602instance ToJSON ButtonState
603instance ToSchema ButtonState
604instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (Text.pack . show)
606type ImageUrl = Text.Text
608newtype ButtonImages = ButtonImages { getButtonImages :: Map ButtonState ImageUrl }
609 deriving (Generic)
611instance ToJSON ButtonImages where
612 toJSON = toJSON . getButtonImages
614instance ToSchema ButtonImages where
615 declareNamedSchema = genericDeclareNamedSchemaNewtype defaultSchemaOptions
616 declareSchemaBoundedEnumKeyMapping
618buttonImagesSchemaJSON :: Value
619buttonImagesSchemaJSON = [aesonQQ|
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 }
631|]
633-- ========================================================================
634-- SingleMaybeField (single field data with optional field)
635-- ========================================================================
637data SingleMaybeField = SingleMaybeField { singleMaybeField :: Maybe String }
638 deriving (Show, Generic)
640instance ToJSON SingleMaybeField
641instance ToSchema SingleMaybeField
643singleMaybeFieldSchemaJSON :: Value
644singleMaybeFieldSchemaJSON = [aesonQQ|
646 "type": "object",
647 "properties":
648 {
649 "singleMaybeField": { "type": "string" }
650 }
652|]