@@ -1,15 +1,17 @@
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
3+{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DefaultSignatures #-}
4{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE KindSignatures #-}
7{-# LANGUAGE KindSignatures #-}
6−{-# LANGUAGE DataKinds #-}
7{-# LANGUAGE OverloadedLists #-}
8{-# LANGUAGE OverloadedLists #-}
8{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE PackageImports #-}
10{-# LANGUAGE PackageImports #-}
10{-# LANGUAGE PolyKinds #-}
11{-# LANGUAGE PolyKinds #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE TupleSections #-}
13{-# LANGUAGE TupleSections #-}
14+{-# LANGUAGE TypeApplications #-}
13{-# LANGUAGE TypeFamilies #-}
15{-# LANGUAGE TypeFamilies #-}
14{-# LANGUAGE TypeOperators #-}
16{-# LANGUAGE TypeOperators #-}
15{-# LANGUAGE TypeSynonymInstances #-}
17{-# LANGUAGE TypeSynonymInstances #-}
@@ -17,7 +19,7 @@
17{-# OPTIONS_GHC -Wno-redundant-constraints #-}
19{-# OPTIONS_GHC -Wno-redundant-constraints #-}
18-- For TypeErrors
20-- For TypeErrors
19{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
21{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
20−module Data.Swagger.Internal.Schema where
22+module Data.OpenApi.Internal.Schema where
22import Prelude ()
24import Prelude ()
23import Prelude.Compat
25import Prelude.Compat
@@ -40,6 +42,7 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
40import Data.Int
42import Data.Int
41import Data.IntSet (IntSet)
43import Data.IntSet (IntSet)
42import Data.IntMap (IntMap)
44import Data.IntMap (IntMap)
45+import Data.List (sort)
43import Data.List.NonEmpty.Compat (NonEmpty)
46import Data.List.NonEmpty.Compat (NonEmpty)
44import Data.Map (Map)
47import Data.Map (Map)
45import Data.Maybe (fromMaybe)
48import Data.Maybe (fromMaybe)
@@ -59,14 +62,16 @@ import Numeric.Natural.Compat (Natural)
59import Data.Word
62import Data.Word
60import GHC.Generics
63import GHC.Generics
61import qualified Data.UUID.Types as UUID
64import qualified Data.UUID.Types as UUID
65+import Type.Reflection (Typeable, typeRep)
67+import Data.OpenApi.Aeson.Compat (keyToText, objectKeys, toInsOrdHashMap)
63−import Data.Swagger.Declare
68+import Data.OpenApi.Declare
64−import Data.Swagger.Internal
69+import Data.OpenApi.Internal
65−import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
70+import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))
71+import Data.OpenApi.Internal.TypeShape
66−import Data.Swagger.Lens hiding (name, schema)
72+import Data.OpenApi.Lens hiding (name, schema)
67−import qualified Data.Swagger.Lens as Swagger
73+import qualified Data.OpenApi.Lens as Swagger
68−import Data.Swagger.SchemaOptions
74+import Data.OpenApi.SchemaOptions
69−import Data.Swagger.Internal.TypeShape
71import qualified Data.ByteString as BS
76import qualified Data.ByteString as BS
72import qualified Data.ByteString.Lazy.Char8 as BSL
77import qualified Data.ByteString.Lazy.Char8 as BSL
@@ -97,7 +102,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
98-- import Control.Lens
103-- import Control.Lens
99-- import Data.Proxy
104-- import Data.Proxy
100−-- import Data.Swagger
105+-- import Data.OpenApi
102-- data Coord = Coord { x :: Double, y :: Double }
107-- data Coord = Coord { x :: Double, y :: Double }
@@ -105,7 +110,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
105-- declareNamedSchema _ = do
110-- declareNamedSchema _ = do
106-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
111-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
107-- return $ NamedSchema (Just \"Coord\") $ mempty
112-- return $ NamedSchema (Just \"Coord\") $ mempty
108−-- & type_ ?~ SwaggerObject
113+-- & type_ ?~ OpenApiObject
109-- & properties .~
114-- & properties .~
110-- [ (\"x\", doubleSchema)
115-- [ (\"x\", doubleSchema)
111-- , (\"y\", doubleSchema)
116-- , (\"y\", doubleSchema)
@@ -131,7 +136,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
132-- instance ToSchema Coord
137-- instance ToSchema Coord
134−class ToSchema a where
139+class Typeable a => ToSchema a where
135 -- | Convert a type into an optionally named schema
140 -- | Convert a type into an optionally named schema
136 -- together with all used definitions.
141 -- together with all used definitions.
137 -- Note that the schema itself is included in definitions
142 -- Note that the schema itself is included in definitions
@@ -153,13 +158,19 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
154-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
159-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
155-- Nothing
160-- Nothing
156−-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
161+-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
157−-- {"type":"string"}
163+-- "type": "string"
159-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
166-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
160-- Just "Day"
167-- Just "Day"
161−-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
168+-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy Day) ^. schema)
162−-- {"example":"2016-07-22","format":"date","type":"string"}
170+-- "example": "2016-07-22",
163toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
174toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
164toNamedSchema = undeclare . declareNamedSchema
175toNamedSchema = undeclare . declareNamedSchema
@@ -175,22 +186,35 @@ schemaName = _namedSchemaName . toNamedSchema
176-- | Convert a type into a schema.
187-- | Convert a type into a schema.
178−-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Int8)
189+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Int8)
179−-- {"maximum":127,"minimum":-128,"type":"integer"}
193+-- "type": "integer"
181−-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy [Day])
196+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])
182−-- {"items":{"$ref":"#/components/schemas/Day"},"type":"array"}
199+-- "$ref": "#/components/schemas/Day"
183toSchema :: ToSchema a => Proxy a -> Schema
203toSchema :: ToSchema a => Proxy a -> Schema
184toSchema = _namedSchemaSchema . toNamedSchema
204toSchema = _namedSchemaSchema . toNamedSchema
186-- | Convert a type into a referenced schema if possible.
206-- | Convert a type into a referenced schema if possible.
187-- Only named schemas can be referenced, nameless schemas are inlined.
207-- Only named schemas can be referenced, nameless schemas are inlined.
189−-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Integer)
209+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
190−-- {"type":"integer"}
211+-- "type": "integer"
192−-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Day)
214+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
193−-- {"$ref":"#/components/schemas/Day"}
216+-- "$ref": "#/components/schemas/Day"
194toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
218toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
195toSchemaRef = undeclare . declareSchemaRef
219toSchemaRef = undeclare . declareSchemaRef
@@ -258,8 +282,15 @@ inlineAllSchemas = inlineSchemasWhen (const True)
259-- | Convert a type into a schema without references.
283-- | Convert a type into a schema without references.
261−-- >>> BSL.putStrLn $ encode $ toInlinedSchema (Proxy :: Proxy [Day])
285+-- >>> BSL.putStrLn $ encodePretty $ toInlinedSchema (Proxy :: Proxy [Day])
262−-- {"items":{"example":"2016-07-22","format":"date","type":"string"},"type":"array"}
288+-- "example": "2016-07-22",
264-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
295-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
265-- when inlining recursive schemas.
296-- when inlining recursive schemas.
@@ -289,41 +320,67 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
289 traverse_ usedNames (InsOrdHashMap.lookup name defs)
320 traverse_ usedNames (InsOrdHashMap.lookup name defs)
290 Inline subschema -> usedNames subschema
321 Inline subschema -> usedNames subschema
292−-- | Default schema for binary data (any sequence of octets).
293−binarySchema :: Schema
294−binarySchema = mempty
295− & type_ ?~ SwaggerString
296− & format ?~ "binary"
298−-- | Default schema for binary data (base64 encoded).
301− & type_ ?~ SwaggerString
304−-- | Default schema for password string.
305−-- @"password"@ format is used to hint UIs the input needs to be obscured.
306−passwordSchema :: Schema
307−passwordSchema = mempty
308− & type_ ?~ SwaggerString
309− & format ?~ "password"
311-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
323-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
312-- Produced schema can be used for further refinement.
324-- Produced schema can be used for further refinement.
314−-- >>> BSL.putStrLn $ encode $ sketchSchema "hello"
326+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
315−-- {"example":"hello","type":"string"}
328+-- "example": "hello",
317−-- >>> BSL.putStrLn $ encode $ sketchSchema (1, 2, 3)
332+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (1, 2, 3)
318−-- {"example":[1,2,3],"items":{"type":"number"},"type":"array"}
340+-- "type": "number"
320−-- >>> BSL.putStrLn $ encode $ sketchSchema ("Jack", 25)
345+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema ("Jack", 25)
321−-- {"example":["Jack",25],"items":[{"type":"string"},{"type":"number"}],"type":"array"}
346+-- {
323-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
362-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
324-- >>> instance ToJSON Person
363-- >>> instance ToJSON Person
325−-- >>> BSL.putStrLn $ encode $ sketchSchema (Person "Jack" 25)
364+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (Person "Jack" 25)
326−-- {"required":["age","name"],"properties":{"age":{"type":"number"},"name":{"type":"string"}},"example":{"age":25,"name":"Jack"},"type":"object"}
365+-- {
327sketchSchema :: ToJSON a => a -> Schema
384sketchSchema :: ToJSON a => a -> Schema
328sketchSchema = sketch . toJSON
385sketchSchema = sketch . toJSON
@@ -331,15 +388,15 @@ sketchSchema = sketch . toJSON
331 sketch js@(Bool _) = go js
388 sketch js@(Bool _) = go js
332 sketch js = go js & example ?~ js
389 sketch js = go js & example ?~ js
334− go Null = mempty & type_ ?~ SwaggerNull
391+ go Null = mempty & type_ ?~ OpenApiNull
335− go (Bool _) = mempty & type_ ?~ SwaggerBoolean
392+ go (Bool _) = mempty & type_ ?~ OpenApiBoolean
336− go (String _) = mempty & type_ ?~ SwaggerString
393+ go (String _) = mempty & type_ ?~ OpenApiString
337− go (Number _) = mempty & type_ ?~ SwaggerNumber
394+ go (Number _) = mempty & type_ ?~ OpenApiNumber
338 go (Array xs) = mempty
395 go (Array xs) = mempty
339− & type_ ?~ SwaggerArray
396+ & type_ ?~ OpenApiArray
340 & items ?~ case ischema of
397 & items ?~ case ischema of
341− Just s -> SwaggerItemsObject (Inline s)
398+ Just s -> OpenApiItemsObject (Inline s)
342− _ -> SwaggerItemsArray (map Inline ys)
399+ _ -> OpenApiItemsArray (map Inline ys)
344 ys = map go (V.toList xs)
401 ys = map go (V.toList xs)
345 allSame = and ((zipWith (==)) ys (tail ys))
402 allSame = and ((zipWith (==)) ys (tail ys))
@@ -348,64 +405,178 @@ sketchSchema = sketch . toJSON
348 (z:_) | allSame -> Just z
405 (z:_) | allSame -> Just z
349 _ -> Nothing
406 _ -> Nothing
350 go (Object o) = mempty
407 go (Object o) = mempty
351− & type_ ?~ SwaggerObject
408+ & type_ ?~ OpenApiObject
352− & required .~ HashMap.keys o
409+ & required .~ sort (objectKeys o)
353− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
410+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
355-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
412-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
356-- Produced schema uses as much constraints as possible.
413-- Produced schema uses as much constraints as possible.
358−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema "hello"
415+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema "hello"
359−-- {"maxLength":5,"pattern":"hello","minLength":5,"type":"string","enum":["hello"]}
416+-- {
422+-- "pattern": "hello",
361−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (1, 2, 3)
426+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (1, 2, 3)
362−-- {"minItems":3,"uniqueItems":true,"items":[{"maximum":1,"minimum":1,"multipleOf":1,"type":"number","enum":[1]},{"maximum":2,"minimum":2,"multipleOf":2,"type":"number","enum":[2]},{"maximum":3,"minimum":3,"multipleOf":3,"type":"number","enum":[3]}],"maxItems":3,"type":"array","enum":[[1,2,3]]}
427+-- {
467+-- "uniqueItems": true
364−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema ("Jack", 25)
470+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema ("Jack", 25)
365−-- {"minItems":2,"uniqueItems":true,"items":[{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]},{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]}],"maxItems":2,"type":"array","enum":[["Jack",25]]}
471+-- {
485+-- "pattern": "Jack",
501+-- "uniqueItems": true
367-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
504-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
368-- >>> instance ToJSON Person
505-- >>> instance ToJSON Person
369−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (Person "Jack" 25)
506+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (Person "Jack" 25)
370−-- {"required":["age","name"],"properties":{"age":{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]},"name":{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]}},"maxProperties":2,"minProperties":2,"type":"object","enum":[{"age":25,"name":"Jack"}]}
507+-- {
514+-- "maxProperties": 2,
515+-- "minProperties": 2,
532+-- "pattern": "Jack",
371sketchStrictSchema :: ToJSON a => a -> Schema
542sketchStrictSchema :: ToJSON a => a -> Schema
372sketchStrictSchema = go . toJSON
543sketchStrictSchema = go . toJSON
374− go Null = mempty & type_ ?~ SwaggerNull
545+ go Null = mempty & type_ ?~ OpenApiNull
375 go js@(Bool _) = mempty
546 go js@(Bool _) = mempty
376− & type_ ?~ SwaggerBoolean
547+ & type_ ?~ OpenApiBoolean
377 & enum_ ?~ [js]
548 & enum_ ?~ [js]
378 go js@(String s) = mempty
549 go js@(String s) = mempty
379− & type_ ?~ SwaggerString
550+ & type_ ?~ OpenApiString
380 & maxLength ?~ fromIntegral (T.length s)
551 & maxLength ?~ fromIntegral (T.length s)
381 & minLength ?~ fromIntegral (T.length s)
552 & minLength ?~ fromIntegral (T.length s)
382 & pattern ?~ s
553 & pattern ?~ s
383 & enum_ ?~ [js]
554 & enum_ ?~ [js]
384 go js@(Number n) = mempty
555 go js@(Number n) = mempty
385− & type_ ?~ SwaggerNumber
556+ & type_ ?~ OpenApiNumber
386 & maximum_ ?~ n
557 & maximum_ ?~ n
387 & minimum_ ?~ n
558 & minimum_ ?~ n
388 & multipleOf ?~ n
559 & multipleOf ?~ n
389 & enum_ ?~ [js]
560 & enum_ ?~ [js]
390 go js@(Array xs) = mempty
561 go js@(Array xs) = mempty
391− & type_ ?~ SwaggerArray
562+ & type_ ?~ OpenApiArray
392 & maxItems ?~ fromIntegral sz
563 & maxItems ?~ fromIntegral sz
393 & minItems ?~ fromIntegral sz
564 & minItems ?~ fromIntegral sz
394− & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
565+ & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
395 & uniqueItems ?~ allUnique
566 & uniqueItems ?~ allUnique
396 & enum_ ?~ [js]
567 & enum_ ?~ [js]
398 sz = length xs
569 sz = length xs
399 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
570 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
400 go js@(Object o) = mempty
571 go js@(Object o) = mempty
401− & type_ ?~ SwaggerObject
572+ & type_ ?~ OpenApiObject
402− & required .~ names
573+ & required .~ sort names
403− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
574+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
404 & maxProperties ?~ fromIntegral (length names)
575 & maxProperties ?~ fromIntegral (length names)
405 & minProperties ?~ fromIntegral (length names)
576 & minProperties ?~ fromIntegral (length names)
406 & enum_ ?~ [js]
577 & enum_ ?~ [js]
408− names = HashMap.keys o
579+ names = objectKeys o
410class GToSchema (f :: * -> *) where
581class GToSchema (f :: * -> *) where
411 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
582 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
@@ -414,8 +585,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
414 declareNamedSchema _ = do
585 declareNamedSchema _ = do
415 ref <- declareSchemaRef (Proxy :: Proxy a)
586 ref <- declareSchemaRef (Proxy :: Proxy a)
416 return $ unnamed $ mempty
587 return $ unnamed $ mempty
417− & type_ ?~ SwaggerArray
588+ & type_ ?~ OpenApiArray
418− & items ?~ SwaggerItemsObject ref
589+ & items ?~ OpenApiItemsObject ref
420instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
591instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
421instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
592instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
@@ -440,7 +611,7 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
440instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
611instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
441instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
612instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
443−instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
614+instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
445instance ToSchema a => ToSchema (Maybe a) where
616instance ToSchema a => ToSchema (Maybe a) where
446 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
617 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -457,16 +628,22 @@ instance ToSchema UUID.UUID where
457 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
628 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
458 & example ?~ toJSON (UUID.toText UUID.nil)
629 & example ?~ toJSON (UUID.toText UUID.nil)
460−instance (ToSchema a, ToSchema b) => ToSchema (a, b)
631+instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
632+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
461−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
633+instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where
634+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
462−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
635+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where
636+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
463−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
637+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e) where
638+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
464−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
639+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f) where
640+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
465−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
641+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g) where
642+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
467timeSchema :: T.Text -> Schema
644timeSchema :: T.Text -> Schema
468timeSchema fmt = mempty
645timeSchema fmt = mempty
469− & type_ ?~ SwaggerString
646+ & type_ ?~ OpenApiString
470 & format ?~ fmt
647 & format ?~ fmt
472-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
649-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -481,7 +658,7 @@ instance ToSchema LocalTime where
481 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
482 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
484−-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
661+-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
485instance ToSchema ZonedTime where
662instance ToSchema ZonedTime where
486 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
487 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
@@ -513,7 +690,7 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
513instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
690instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
515-- | NOTE: This schema does not account for the uniqueness of keys.
692-- | NOTE: This schema does not account for the uniqueness of keys.
516−instance ToSchema a => ToSchema (IntMap a) where
693+instance (ToSchema a) => ToSchema (IntMap a) where
517 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
694 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
519instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
696instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
@@ -524,7 +701,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
524 declareObjectMapSchema = do
701 declareObjectMapSchema = do
525 schema <- declareSchemaRef (Proxy :: Proxy v)
702 schema <- declareSchemaRef (Proxy :: Proxy v)
526 return $ unnamed $ mempty
703 return $ unnamed $ mempty
527− & type_ ?~ SwaggerObject
704+ & type_ ?~ OpenApiObject
528 & additionalProperties ?~ AdditionalPropertiesSchema schema
705 & additionalProperties ?~ AdditionalPropertiesSchema schema
530instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
707instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
@@ -532,7 +709,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
533instance {-# OVERLAPPING #-} ToSchema Object where
710instance {-# OVERLAPPING #-} ToSchema Object where
534 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
711 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
535− & type_ ?~ SwaggerObject
712+ & type_ ?~ OpenApiObject
536 & description ?~ "Arbitrary JSON object."
713 & description ?~ "Arbitrary JSON object."
537 & additionalProperties ?~ AdditionalPropertiesAllowed True
714 & additionalProperties ?~ AdditionalPropertiesAllowed True
@@ -569,11 +746,15 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
570-- | Default schema for @'Bounded'@, @'Integral'@ types.
747-- | Default schema for @'Bounded'@, @'Integral'@ types.
572−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
749+-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
573−-- {"maximum":32767,"minimum":-32768,"type":"integer"}
751+-- "maximum": 32767,
752+-- "minimum": -32768,
574toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
755toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
575toSchemaBoundedIntegral _ = mempty
756toSchemaBoundedIntegral _ = mempty
576− & type_ ?~ SwaggerInteger
757+ & type_ ?~ OpenApiInteger
577 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
758 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
578 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
759 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
@@ -602,8 +783,27 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
602-- >>> instance ToSchema ButtonState
783-- >>> instance ToSchema ButtonState
603-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
784-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
604-- >>> type ImageUrl = T.Text
785-- >>> type ImageUrl = T.Text
605−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
786+-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
606−-- {"properties":{"Neutral":{"type":"string"},"Focus":{"type":"string"},"Active":{"type":"string"},"Hover":{"type":"string"},"Disabled":{"type":"string"}},"type":"object"}
787+-- {
608-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
808-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
609-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
809-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -611,15 +811,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
611 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
811 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
612 => Proxy (map key value) -> Declare (Definitions Schema) Schema
812 => Proxy (map key value) -> Declare (Definitions Schema) Schema
613declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
614− ToJSONKeyText keyToText _ -> objectSchema keyToText
814+ ToJSONKeyText getKey _ -> objectSchema getKey
615 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
617− objectSchema keyToText = do
817+ objectSchema getKey = do
618 valueRef <- declareSchemaRef (Proxy :: Proxy value)
818 valueRef <- declareSchemaRef (Proxy :: Proxy value)
619 let allKeys = [minBound..maxBound :: key]
819 let allKeys = [minBound..maxBound :: key]
620− mkPair k = (keyToText k, valueRef)
820+ mkPair k = (keyToText $ getKey k, valueRef)
621 return $ mempty
821 return $ mempty
622− & type_ ?~ SwaggerObject
822+ & type_ ?~ OpenApiObject
623 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
625-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
825-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -630,8 +830,27 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
630-- >>> instance ToSchema ButtonState
830-- >>> instance ToSchema ButtonState
631-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
831-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
632-- >>> type ImageUrl = T.Text
832-- >>> type ImageUrl = T.Text
633−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
833+-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
634−-- {"properties":{"Neutral":{"type":"string"},"Focus":{"type":"string"},"Active":{"type":"string"},"Hover":{"type":"string"},"Disabled":{"type":"string"}},"type":"object"}
834+-- {
636-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
855-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
637-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
856-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -641,7 +860,7 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
641toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
860toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
643-- | A configurable generic @'Schema'@ creator.
862-- | A configurable generic @'Schema'@ creator.
644−genericDeclareSchema :: (Generic a, GToSchema (Rep a)) =>
863+genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
645 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
864 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
646genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
865genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
@@ -649,9 +868,24 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
649-- This function applied to @'defaultSchemaOptions'@
868-- This function applied to @'defaultSchemaOptions'@
650-- is used as the default for @'declareNamedSchema'@
869-- is used as the default for @'declareNamedSchema'@
651-- when the type is an instance of @'Generic'@.
870-- when the type is an instance of @'Generic'@.
872+-- Default implementation will use the name from 'Typeable' instance, including concrete
873+-- instantioations of type variables.
877+-- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))
878+-- Just "Either_Int_Bool"
652−genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a)) =>
879+genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
653 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
880 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
881+genericDeclareNamedSchema opts _ =
654−genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
882+ rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
886+ orig = fmap unspace $ show $ typeRep @a
887+ name = datatypeNameModifier opts orig
656-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
890-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
657genericNameSchema :: forall a d f.
891genericNameSchema :: forall a d f.
@@ -667,19 +901,19 @@ gdatatypeSchemaName opts _ = case orig of
667 orig = datatypeName (Proxy3 :: Proxy3 d f a)
901 orig = datatypeName (Proxy3 :: Proxy3 d f a)
668 name = datatypeNameModifier opts orig
902 name = datatypeNameModifier opts orig
670−-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
904+-- | Construct 'NamedSchema' usinng 'ToParamSchema'.
671paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
905paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
672 SchemaOptions -> Proxy a -> NamedSchema
906 SchemaOptions -> Proxy a -> NamedSchema
673paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
907paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
675−-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
909+-- | Construct 'Schema' usinng 'ToParamSchema'.
676paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
910paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
677−paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
911+paramSchemaToSchema = toParamSchema
679nullarySchema :: Schema
913nullarySchema :: Schema
680nullarySchema = mempty
914nullarySchema = mempty
681− & type_ ?~ SwaggerArray
915+ & type_ ?~ OpenApiArray
682− & items ?~ SwaggerItemsArray []
916+ & items ?~ OpenApiItemsArray []
684gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
918gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
685gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
919gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -709,12 +943,15 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
709 | unwrapUnaryRecords opts = fieldSchema
943 | unwrapUnaryRecords opts = fieldSchema
710 | otherwise =
944 | otherwise =
711 case schema ^. items of
945 case schema ^. items of
712− Just (SwaggerItemsArray [_]) -> fieldSchema
946+ Just (OpenApiItemsArray [_]) -> fieldSchema
714− declare defs
948+ -- We have to run recordSchema instead of just using its defs,
949+ -- since those can be recursive and will lead to infinite loop,
950+ -- see https://github.com/biocad/openapi3/pull/37
951+ NamedSchema _ schema' <- recordSchema
715− return (unnamed schema)
952+ return (unnamed schema')
717− (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
954+ (_, NamedSchema _ schema) = runDeclare recordSchema mempty
718 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
719 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
@@ -737,10 +974,10 @@ gdeclareSchemaRef opts proxy = do
737 return $ Ref (Reference name)
974 return $ Ref (Reference name)
738 _ -> Inline <$> gdeclareSchema opts proxy
975 _ -> Inline <$> gdeclareSchema opts proxy
740−appendItem :: Referenced Schema -> Maybe SwaggerItems -> Maybe SwaggerItems
977+appendItem :: Referenced Schema -> Maybe OpenApiItems -> Maybe OpenApiItems
741−appendItem x Nothing = Just (SwaggerItemsArray [x])
978+appendItem x Nothing = Just (OpenApiItemsArray [x])
742−appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
979+appendItem x (Just (OpenApiItemsArray xs)) = Just (OpenApiItemsArray (xs ++ [x]))
743−appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
980+appendItem _ _ = error "GToSchema.appendItem: cannot append to OpenApiItemsObject"
745withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
982withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
746 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
983 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
@@ -749,12 +986,12 @@ withFieldSchema opts _ isRequiredField schema = do
750 if T.null fname
987 if T.null fname
751 then schema
988 then schema
752− & type_ ?~ SwaggerArray
989+ & type_ ?~ OpenApiArray
753 & items %~ appendItem ref
990 & items %~ appendItem ref
754 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
991 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
755 & minItems %~ Just . maybe 1 (+1) -- increment minItems
992 & minItems %~ Just . maybe 1 (+1) -- increment minItems
756 else schema
993 else schema
757− & type_ ?~ SwaggerObject
994+ & type_ ?~ OpenApiObject
758 & properties . at fname ?~ ref
995 & properties . at fname ?~ ref
759 & if isRequiredField
996 & if isRequiredField
760 then required %~ (++ [fname])
997 then required %~ (++ [fname])
@@ -789,14 +1026,14 @@ gdeclareNamedSumSchema opts proxy _
789 | otherwise = do
1026 | otherwise = do
790 (schemas, _) <- runWriterT declareSumSchema
1027 (schemas, _) <- runWriterT declareSumSchema
791 return $ unnamed $ mempty
1028 return $ unnamed $ mempty
792− & type_ ?~ SwaggerObject
1029+ & type_ ?~ OpenApiObject
793 & oneOf ?~ (snd <$> schemas)
1030 & oneOf ?~ (snd <$> schemas)
795 declareSumSchema = gsumToSchema opts proxy
1032 declareSumSchema = gsumToSchema opts proxy
796 (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
1033 (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
798 toStringTag schemas = mempty
1035 toStringTag schemas = mempty
799− & type_ ?~ SwaggerString
1036+ & type_ ?~ OpenApiString
800 & enum_ ?~ map (String . fst) sumSchemas
1037 & enum_ ?~ map (String . fst) sumSchemas
802type AllNullary = All
1039type AllNullary = All
@@ -818,15 +1055,15 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
818 case ref of
1055 case ref of
819 -- If subschema is an object and constructor is a record, we add tag directly
1056 -- If subschema is an object and constructor is a record, we add tag directly
820 -- to the record, as Aeson does it.
1057 -- to the record, as Aeson does it.
821− Just (Inline sub) | sub ^. type_ == Just SwaggerObject && isRecord -> Inline $ sub
1058+ Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub
822 & required <>~ [T.pack tagField]
1059 & required <>~ [T.pack tagField]
823− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])
1060+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
825 -- If it is not a record, we need to put subschema into "contents" field.
1062 -- If it is not a record, we need to put subschema into "contents" field.
826 _ | not isRecord -> Inline $ mempty
1063 _ | not isRecord -> Inline $ mempty
827− & type_ ?~ SwaggerObject
1064+ & type_ ?~ OpenApiObject
828 & required .~ [T.pack tagField]
1065 & required .~ [T.pack tagField]
829− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])
1066+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
830 -- If constructor is nullary, there is no content.
1067 -- If constructor is nullary, there is no content.
831 & case ref of
1068 & case ref of
832 Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
1069 Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
@@ -834,17 +1071,17 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
835 -- In the remaining cases we combine "tag" object and "contents" object using allOf.
1072 -- In the remaining cases we combine "tag" object and "contents" object using allOf.
836 _ -> Inline $ mempty
1073 _ -> Inline $ mempty
837− & type_ ?~ SwaggerObject
1074+ & type_ ?~ OpenApiObject
838 & allOf ?~ [Inline $ mempty
1075 & allOf ?~ [Inline $ mempty
839− & type_ ?~ SwaggerObject
1076+ & type_ ?~ OpenApiObject
840 & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
1077 & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
841− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])]
1078+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])]
842 & if isRecord
1079 & if isRecord
843 then allOf . _Just <>~ [refOrNullary]
1080 then allOf . _Just <>~ [refOrNullary]
844− else allOf . _Just <>~ [Inline $ mempty & type_ ?~ SwaggerObject & properties . at (T.pack contentsField) ?~ refOrNullary]
1081+ else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary]
845 UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.
1082 UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.
846 ObjectWithSingleField -> Inline $ mempty
1083 ObjectWithSingleField -> Inline $ mempty
847− & type_ ?~ SwaggerObject
1084+ & type_ ?~ OpenApiObject
848 & required .~ [tag]
1085 & required .~ [tag]
849 & properties . at tag ?~ refOrNullary
1086 & properties . at tag ?~ refOrNullary
850 TwoElemArray -> error "unrepresentable in OpenAPI 3"
1087 TwoElemArray -> error "unrepresentable in OpenAPI 3"
@@ -852,7 +1089,7 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
852 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
1089 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
853 isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)
1090 isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)
854 refOrNullary = fromMaybe (Inline nullarySchema) ref
1091 refOrNullary = fromMaybe (Inline nullarySchema) ref
855− refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag]) ref
1092+ refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref
857gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
1094gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
858 SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
1095 SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
@@ -877,7 +1114,13 @@ data Proxy2 a b = Proxy2
878data Proxy3 a b c = Proxy3
1115data Proxy3 a b c = Proxy3
880−-- $setup
1117+{- $setup
881−-- >>> import Data.Swagger
1118+>>> import Data.OpenApi
882−-- >>> import Data.Aeson (encode)
1119+>>> import Data.Aeson (encode)
883−-- >>> import Data.Aeson.Types (toJSONKeyText)
1120+>>> import Data.Aeson.Types (toJSONKeyText)
1121+>>> import Data.OpenApi.Internal.Utils
1122+>>> :set -XScopedTypeVariables
1123+>>> :set -XDeriveAnyClass
1124+>>> :set -XStandaloneDeriving
1125+>>> :set -XTypeApplications