@@ -0,0 +1,597 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE OverloadedLabels #-}
5+{-# LANGUAGE TemplateHaskell #-}
6+{-# LANGUAGE TypeFamilies #-}
7+{-# LANGUAGE UndecidableInstances #-}
8+{-# OPTIONS_GHC -fno-warn-orphans #-}
10+-- Module: Data.Swagger.Optics
11+-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>
12+-- Stability: experimental
14+-- Lenses and prisms for the <https://hackage.haskell.org/package/optics optics>
17+-- >>> import Data.Aeson
18+-- >>> import Optics.Core
19+-- >>> :set -XOverloadedLabels
21+-- Example from the "Data.Swagger" module using @optics@:
24+-- encode $ (mempty :: Swagger)
25+-- & #definitions .~ [ ("User", mempty & #type ?~ SwaggerString) ]
27+-- [ ("/user", mempty & #get ?~ (mempty
28+-- & #produces ?~ MimeList ["application/json"]
29+-- & at 200 ?~ ("OK" & #_Inline % #schema ?~ Ref (Reference "User"))
30+-- & at 404 ?~ "User info not found")) ]
32+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"produces\":[\"application/json\"],\"responses\":{\"404\":{\"description\":\"User info not found\"},\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"OK\"}}}}},\"definitions\":{\"User\":{\"type\":\"string\"}}}"
34+-- For convenience optics are defined as /labels/. It means that field accessor
35+-- names can be overloaded for different types. One such common field is
36+-- @#description@. Many components of a Swagger specification can have
37+-- descriptions, and you can use the same name for them:
39+-- >>> encode $ (mempty :: Response) & #description .~ "No content"
40+-- "{\"description\":\"No content\"}"
42+-- encode $ (mempty :: Schema)
43+-- & #type ?~ SwaggerBoolean
44+-- & #description ?~ "To be or not to be"
46+-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
48+-- @'ParamSchema'@ is basically the /base schema specification/ and many types
49+-- contain it. So for convenience, all @'ParamSchema'@ fields are transitively
50+-- made fields of the type that has it. For example, you can use @#type@ to
51+-- access @'SwaggerType'@ of @'Header'@ schema without having to use
54+-- >>> encode $ (mempty :: Header) & #type ?~ SwaggerNumber
55+-- "{\"type\":\"number\"}"
57+-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
58+-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
61+-- encode $ (mempty :: Operation)
62+-- & at 404 ?~ "Not found"
64+-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
66+module Data.Swagger.Optics () where
68+import Data.Aeson (Value)
69+import Data.Scientific (Scientific)
70+import Data.Swagger.Internal
71+import Data.Text (Text)
77+makeFieldLabels ''Swagger
78+makeFieldLabels ''Host
79+makeFieldLabels ''Info
80+makeFieldLabels ''Contact
81+makeFieldLabels ''License
82+makeFieldLabels ''PathItem
84+makeFieldLabels ''Operation
85+makeFieldLabels ''Param
86+makeFieldLabels ''ParamOtherSchema
87+makeFieldLabels ''Header
88+makeFieldLabels ''Schema
89+makeFieldLabels ''NamedSchema
90+makeFieldLabels ''ParamSchema
92+makeFieldLabels ''Responses
93+makeFieldLabels ''Response
94+makeFieldLabels ''SecurityScheme
95+makeFieldLabels ''ApiKeyParams
96+makeFieldLabels ''OAuth2Params
97+makeFieldLabels ''ExternalDocs
101+makePrismLabels ''ParamAnySchema
102+makePrismLabels ''SecuritySchemeType
103+makePrismLabels ''Referenced
105+-- SwaggerItems prisms
108+ ( a ~ [Referenced Schema]
109+ , b ~ [Referenced Schema]
110+ ) => LabelOptic "_SwaggerItemsArray"
112+ (SwaggerItems 'SwaggerKindSchema)
113+ (SwaggerItems 'SwaggerKindSchema)
116+ labelOptic = unto (\x -> SwaggerItemsArray x)
117+ {-# INLINE labelOptic #-}
120+ ( a ~ Referenced Schema
121+ , b ~ Referenced Schema
122+ ) => LabelOptic "_SwaggerItemsObject"
124+ (SwaggerItems 'SwaggerKindSchema)
125+ (SwaggerItems 'SwaggerKindSchema)
128+ labelOptic = unto (\x -> SwaggerItemsObject x)
129+ {-# INLINE labelOptic #-}
132+ ( a ~ (Maybe (CollectionFormat t), ParamSchema t)
133+ , b ~ (Maybe (CollectionFormat t), ParamSchema t)
134+ ) => LabelOptic "_SwaggerItemsPrimitive"
140+ labelOptic = unto (\(c, p) -> SwaggerItemsPrimitive c p)
141+ {-# INLINE labelOptic #-}
143+-- =============================================================
144+-- More helpful instances for easier access to schema properties
146+type instance Index Responses = HttpStatusCode
147+type instance Index Operation = HttpStatusCode
149+type instance IxValue Responses = Referenced Response
150+type instance IxValue Operation = Referenced Response
152+instance Ixed Responses where
153+ ix n = #responses % ix n
155+instance At Responses where
156+ at n = #responses % at n
159+instance Ixed Operation where
160+ ix n = #responses % ix n
162+instance At Operation where
163+ at n = #responses % at n
169+ ( a ~ ParamSchema 'SwaggerKindSchema
170+ , b ~ ParamSchema 'SwaggerKindSchema
171+ ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where
172+ labelOptic = #schema % #paramSchema
173+ {-# INLINE labelOptic #-}
178+ ( a ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
179+ , b ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
180+ ) => LabelOptic "type" A_Lens Header Header a b where
181+ labelOptic = #paramSchema % #type
182+ {-# INLINE labelOptic #-}
185+ ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
186+ , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
187+ ) => LabelOptic "type" A_Lens Schema Schema a b where
188+ labelOptic = #paramSchema % #type
189+ {-# INLINE labelOptic #-}
192+ ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
193+ , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
194+ ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
195+ labelOptic = #paramSchema % #type
196+ {-# INLINE labelOptic #-}
199+ ( a ~ Maybe (SwaggerType 'SwaggerKindParamOtherSchema)
200+ , b ~ Maybe (SwaggerType 'SwaggerKindParamOtherSchema)
201+ ) => LabelOptic "type" A_Lens ParamOtherSchema ParamOtherSchema a b where
202+ labelOptic = #paramSchema % #type
203+ {-# INLINE labelOptic #-}
208+ ( a ~ Maybe Value, b ~ Maybe Value
209+ ) => LabelOptic "default" A_Lens Header Header a b where
210+ labelOptic = #paramSchema % #default
211+ {-# INLINE labelOptic #-}
214+ ( a ~ Maybe Value, b ~ Maybe Value
215+ ) => LabelOptic "default" A_Lens Schema Schema a b where
216+ labelOptic = #paramSchema % #default
217+ {-# INLINE labelOptic #-}
220+ ( a ~ Maybe Value, b ~ Maybe Value
221+ ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where
222+ labelOptic = #paramSchema % #default
223+ {-# INLINE labelOptic #-}
226+ ( a ~ Maybe Value, b ~ Maybe Value
227+ ) => LabelOptic "default" A_Lens ParamOtherSchema ParamOtherSchema a b where
228+ labelOptic = #paramSchema % #default
229+ {-# INLINE labelOptic #-}
234+ ( a ~ Maybe Format, b ~ Maybe Format
235+ ) => LabelOptic "format" A_Lens Header Header a b where
236+ labelOptic = #paramSchema % #format
237+ {-# INLINE labelOptic #-}
240+ ( a ~ Maybe Format, b ~ Maybe Format
241+ ) => LabelOptic "format" A_Lens Schema Schema a b where
242+ labelOptic = #paramSchema % #format
243+ {-# INLINE labelOptic #-}
246+ ( a ~ Maybe Format, b ~ Maybe Format
247+ ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where
248+ labelOptic = #paramSchema % #format
249+ {-# INLINE labelOptic #-}
252+ ( a ~ Maybe Format, b ~ Maybe Format
253+ ) => LabelOptic "format" A_Lens ParamOtherSchema ParamOtherSchema a b where
254+ labelOptic = #paramSchema % #format
255+ {-# INLINE labelOptic #-}
260+ ( a ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
261+ , b ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
262+ ) => LabelOptic "items" A_Lens Header Header a b where
263+ labelOptic = #paramSchema % #items
264+ {-# INLINE labelOptic #-}
267+ ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
268+ , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
269+ ) => LabelOptic "items" A_Lens Schema Schema a b where
270+ labelOptic = #paramSchema % #items
271+ {-# INLINE labelOptic #-}
274+ ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
275+ , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
276+ ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
277+ labelOptic = #paramSchema % #items
278+ {-# INLINE labelOptic #-}
281+ ( a ~ Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)
282+ , b ~ Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)
283+ ) => LabelOptic "items" A_Lens ParamOtherSchema ParamOtherSchema a b where
284+ labelOptic = #paramSchema % #items
285+ {-# INLINE labelOptic #-}
290+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
291+ ) => LabelOptic "maximum" A_Lens Header Header a b where
292+ labelOptic = #paramSchema % #maximum
293+ {-# INLINE labelOptic #-}
296+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
297+ ) => LabelOptic "maximum" A_Lens Schema Schema a b where
298+ labelOptic = #paramSchema % #maximum
299+ {-# INLINE labelOptic #-}
302+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
303+ ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where
304+ labelOptic = #paramSchema % #maximum
305+ {-# INLINE labelOptic #-}
308+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
309+ ) => LabelOptic "maximum" A_Lens ParamOtherSchema ParamOtherSchema a b where
310+ labelOptic = #paramSchema % #maximum
311+ {-# INLINE labelOptic #-}
316+ ( a ~ Maybe Bool, b ~ Maybe Bool
317+ ) => LabelOptic "exclusiveMaximum" A_Lens Header Header a b where
318+ labelOptic = #paramSchema % #exclusiveMaximum
319+ {-# INLINE labelOptic #-}
322+ ( a ~ Maybe Bool, b ~ Maybe Bool
323+ ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where
324+ labelOptic = #paramSchema % #exclusiveMaximum
325+ {-# INLINE labelOptic #-}
328+ ( a ~ Maybe Bool, b ~ Maybe Bool
329+ ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where
330+ labelOptic = #paramSchema % #exclusiveMaximum
331+ {-# INLINE labelOptic #-}
334+ ( a ~ Maybe Bool, b ~ Maybe Bool
335+ ) => LabelOptic "exclusiveMaximum" A_Lens ParamOtherSchema ParamOtherSchema a b where
336+ labelOptic = #paramSchema % #exclusiveMaximum
337+ {-# INLINE labelOptic #-}
342+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
343+ ) => LabelOptic "minimum" A_Lens Header Header a b where
344+ labelOptic = #paramSchema % #minimum
345+ {-# INLINE labelOptic #-}
348+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
349+ ) => LabelOptic "minimum" A_Lens Schema Schema a b where
350+ labelOptic = #paramSchema % #minimum
351+ {-# INLINE labelOptic #-}
354+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
355+ ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where
356+ labelOptic = #paramSchema % #minimum
357+ {-# INLINE labelOptic #-}
360+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
361+ ) => LabelOptic "minimum" A_Lens ParamOtherSchema ParamOtherSchema a b where
362+ labelOptic = #paramSchema % #minimum
363+ {-# INLINE labelOptic #-}
368+ ( a ~ Maybe Bool, b ~ Maybe Bool
369+ ) => LabelOptic "exclusiveMinimum" A_Lens Header Header a b where
370+ labelOptic = #paramSchema % #exclusiveMinimum
371+ {-# INLINE labelOptic #-}
374+ ( a ~ Maybe Bool, b ~ Maybe Bool
375+ ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where
376+ labelOptic = #paramSchema % #exclusiveMinimum
377+ {-# INLINE labelOptic #-}
380+ ( a ~ Maybe Bool, b ~ Maybe Bool
381+ ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where
382+ labelOptic = #paramSchema % #exclusiveMinimum
383+ {-# INLINE labelOptic #-}
386+ ( a ~ Maybe Bool, b ~ Maybe Bool
387+ ) => LabelOptic "exclusiveMinimum" A_Lens ParamOtherSchema ParamOtherSchema a b where
388+ labelOptic = #paramSchema % #exclusiveMinimum
389+ {-# INLINE labelOptic #-}
394+ ( a ~ Maybe Integer, b ~ Maybe Integer
395+ ) => LabelOptic "maxLength" A_Lens Header Header a b where
396+ labelOptic = #paramSchema % #maxLength
397+ {-# INLINE labelOptic #-}
400+ ( a ~ Maybe Integer, b ~ Maybe Integer
401+ ) => LabelOptic "maxLength" A_Lens Schema Schema a b where
402+ labelOptic = #paramSchema % #maxLength
403+ {-# INLINE labelOptic #-}
406+ ( a ~ Maybe Integer, b ~ Maybe Integer
407+ ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where
408+ labelOptic = #paramSchema % #maxLength
409+ {-# INLINE labelOptic #-}
412+ ( a ~ Maybe Integer, b ~ Maybe Integer
413+ ) => LabelOptic "maxLength" A_Lens ParamOtherSchema ParamOtherSchema a b where
414+ labelOptic = #paramSchema % #maxLength
415+ {-# INLINE labelOptic #-}
420+ ( a ~ Maybe Integer, b ~ Maybe Integer
421+ ) => LabelOptic "minLength" A_Lens Header Header a b where
422+ labelOptic = #paramSchema % #minLength
423+ {-# INLINE labelOptic #-}
426+ ( a ~ Maybe Integer, b ~ Maybe Integer
427+ ) => LabelOptic "minLength" A_Lens Schema Schema a b where
428+ labelOptic = #paramSchema % #minLength
429+ {-# INLINE labelOptic #-}
432+ ( a ~ Maybe Integer, b ~ Maybe Integer
433+ ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where
434+ labelOptic = #paramSchema % #minLength
435+ {-# INLINE labelOptic #-}
438+ ( a ~ Maybe Integer, b ~ Maybe Integer
439+ ) => LabelOptic "minLength" A_Lens ParamOtherSchema ParamOtherSchema a b where
440+ labelOptic = #paramSchema % #minLength
441+ {-# INLINE labelOptic #-}
446+ ( a ~ Maybe Text, b ~ Maybe Text
447+ ) => LabelOptic "pattern" A_Lens Header Header a b where
448+ labelOptic = #paramSchema % #pattern
449+ {-# INLINE labelOptic #-}
452+ ( a ~ Maybe Text, b ~ Maybe Text
453+ ) => LabelOptic "pattern" A_Lens Schema Schema a b where
454+ labelOptic = #paramSchema % #pattern
455+ {-# INLINE labelOptic #-}
458+ ( a ~ Maybe Text, b ~ Maybe Text
459+ ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where
460+ labelOptic = #paramSchema % #pattern
461+ {-# INLINE labelOptic #-}
464+ ( a ~ Maybe Text, b ~ Maybe Text
465+ ) => LabelOptic "pattern" A_Lens ParamOtherSchema ParamOtherSchema a b where
466+ labelOptic = #paramSchema % #pattern
467+ {-# INLINE labelOptic #-}
472+ ( a ~ Maybe Integer, b ~ Maybe Integer
473+ ) => LabelOptic "maxItems" A_Lens Header Header a b where
474+ labelOptic = #paramSchema % #maxItems
475+ {-# INLINE labelOptic #-}
478+ ( a ~ Maybe Integer, b ~ Maybe Integer
479+ ) => LabelOptic "maxItems" A_Lens Schema Schema a b where
480+ labelOptic = #paramSchema % #maxItems
481+ {-# INLINE labelOptic #-}
484+ ( a ~ Maybe Integer, b ~ Maybe Integer
485+ ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where
486+ labelOptic = #paramSchema % #maxItems
487+ {-# INLINE labelOptic #-}
490+ ( a ~ Maybe Integer, b ~ Maybe Integer
491+ ) => LabelOptic "maxItems" A_Lens ParamOtherSchema ParamOtherSchema a b where
492+ labelOptic = #paramSchema % #maxItems
493+ {-# INLINE labelOptic #-}
498+ ( a ~ Maybe Integer, b ~ Maybe Integer
499+ ) => LabelOptic "minItems" A_Lens Header Header a b where
500+ labelOptic = #paramSchema % #minItems
501+ {-# INLINE labelOptic #-}
504+ ( a ~ Maybe Integer, b ~ Maybe Integer
505+ ) => LabelOptic "minItems" A_Lens Schema Schema a b where
506+ labelOptic = #paramSchema % #minItems
507+ {-# INLINE labelOptic #-}
510+ ( a ~ Maybe Integer, b ~ Maybe Integer
511+ ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where
512+ labelOptic = #paramSchema % #minItems
513+ {-# INLINE labelOptic #-}
516+ ( a ~ Maybe Integer, b ~ Maybe Integer
517+ ) => LabelOptic "minItems" A_Lens ParamOtherSchema ParamOtherSchema a b where
518+ labelOptic = #paramSchema % #minItems
519+ {-# INLINE labelOptic #-}
524+ ( a ~ Maybe Bool, b ~ Maybe Bool
525+ ) => LabelOptic "uniqueItems" A_Lens Header Header a b where
526+ labelOptic = #paramSchema % #uniqueItems
527+ {-# INLINE labelOptic #-}
530+ ( a ~ Maybe Bool, b ~ Maybe Bool
531+ ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where
532+ labelOptic = #paramSchema % #uniqueItems
533+ {-# INLINE labelOptic #-}
536+ ( a ~ Maybe Bool, b ~ Maybe Bool
537+ ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where
538+ labelOptic = #paramSchema % #uniqueItems
539+ {-# INLINE labelOptic #-}
542+ ( a ~ Maybe Bool, b ~ Maybe Bool
543+ ) => LabelOptic "uniqueItems" A_Lens ParamOtherSchema ParamOtherSchema a b where
544+ labelOptic = #paramSchema % #uniqueItems
545+ {-# INLINE labelOptic #-}
550+ ( a ~ Maybe [Value], b ~ Maybe [Value]
551+ ) => LabelOptic "enum" A_Lens Header Header a b where
552+ labelOptic = #paramSchema % #enum
553+ {-# INLINE labelOptic #-}
556+ ( a ~ Maybe [Value], b ~ Maybe [Value]
557+ ) => LabelOptic "enum" A_Lens Schema Schema a b where
558+ labelOptic = #paramSchema % #enum
559+ {-# INLINE labelOptic #-}
562+ ( a ~ Maybe [Value], b ~ Maybe [Value]
563+ ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where
564+ labelOptic = #paramSchema % #enum
565+ {-# INLINE labelOptic #-}
568+ ( a ~ Maybe [Value], b ~ Maybe [Value]
569+ ) => LabelOptic "enum" A_Lens ParamOtherSchema ParamOtherSchema a b where
570+ labelOptic = #paramSchema % #enum
571+ {-# INLINE labelOptic #-}
576+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
577+ ) => LabelOptic "multipleOf" A_Lens Header Header a b where
578+ labelOptic = #paramSchema % #multipleOf
579+ {-# INLINE labelOptic #-}
582+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
583+ ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where
584+ labelOptic = #paramSchema % #multipleOf
585+ {-# INLINE labelOptic #-}
588+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
589+ ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where
590+ labelOptic = #paramSchema % #multipleOf
591+ {-# INLINE labelOptic #-}
594+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
595+ ) => LabelOptic "multipleOf" A_Lens ParamOtherSchema ParamOtherSchema a b where
596+ labelOptic = #paramSchema % #multipleOf
597+ {-# INLINE labelOptic #-}