@@ -1,17 +1,15 @@
1−{-# LANGUAGE CPP #-}
21{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE DataKinds #-}
42{-# LANGUAGE DefaultSignatures #-}
53{-# LANGUAGE FlexibleContexts #-}
64{-# LANGUAGE FlexibleInstances #-}
75{-# LANGUAGE KindSignatures #-}
6+{-# LANGUAGE DataKinds #-}
87{-# LANGUAGE OverloadedLists #-}
98{-# LANGUAGE OverloadedStrings #-}
109{-# LANGUAGE PackageImports #-}
1110{-# LANGUAGE PolyKinds #-}
1211{-# LANGUAGE ScopedTypeVariables #-}
1312{-# LANGUAGE TupleSections #-}
14−{-# LANGUAGE TypeApplications #-}
1513{-# LANGUAGE TypeFamilies #-}
1614{-# LANGUAGE TypeOperators #-}
1715{-# LANGUAGE TypeSynonymInstances #-}
@@ -19,7 +17,7 @@
1917{-# OPTIONS_GHC -Wno-redundant-constraints #-}
2018-- For TypeErrors
2119{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
22−module Data.OpenApi.Internal.Schema where
20+module Data.Swagger.Internal.Schema where
2321
2422import Prelude ()
2523import Prelude.Compat
@@ -42,7 +40,6 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
4240import Data.Int
4341import Data.IntSet (IntSet)
4442import Data.IntMap (IntMap)
45−import Data.List (sort)
4643import Data.List.NonEmpty.Compat (NonEmpty)
4744import Data.Map (Map)
4845import Data.Maybe (fromMaybe)
@@ -62,16 +59,14 @@ import Numeric.Natural.Compat (Natural)
6259import Data.Word
6360import GHC.Generics
6461import qualified Data.UUID.Types as UUID
65−import Type.Reflection (Typeable, typeRep)
6662
67−import Data.OpenApi.Aeson.Compat (keyToText, objectKeys, toInsOrdHashMap)
68−import Data.OpenApi.Declare
69−import Data.OpenApi.Internal
70−import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))
71−import Data.OpenApi.Internal.TypeShape
72−import Data.OpenApi.Lens hiding (name, schema)
73−import qualified Data.OpenApi.Lens as Swagger
74−import Data.OpenApi.SchemaOptions
63+import Data.Swagger.Declare
64+import Data.Swagger.Internal
65+import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
66+import Data.Swagger.Lens hiding (name, schema)
67+import qualified Data.Swagger.Lens as Swagger
68+import Data.Swagger.SchemaOptions
69+import Data.Swagger.Internal.TypeShape
7570
7671import qualified Data.ByteString as BS
7772import qualified Data.ByteString.Lazy.Char8 as BSL
@@ -102,7 +97,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
10297--
10398-- import Control.Lens
10499-- import Data.Proxy
105−-- import Data.OpenApi
100+-- import Data.Swagger
106101--
107102-- data Coord = Coord { x :: Double, y :: Double }
108103--
@@ -110,7 +105,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
110105-- declareNamedSchema _ = do
111106-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
112107-- return $ NamedSchema (Just \"Coord\") $ mempty
113−-- & type_ ?~ OpenApiObject
108+-- & type_ ?~ SwaggerObject
114109-- & properties .~
115110-- [ (\"x\", doubleSchema)
116111-- , (\"y\", doubleSchema)
@@ -136,7 +131,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
136131--
137132-- instance ToSchema Coord
138133-- @
139−class Typeable a => ToSchema a where
134+class ToSchema a where
140135 -- | Convert a type into an optionally named schema
141136 -- together with all used definitions.
142137 -- Note that the schema itself is included in definitions
@@ -158,19 +153,13 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
158153--
159154-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
160155-- Nothing
161−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
162−-- {
163−-- "type": "string"
164−-- }
156+-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
157+-- {"type":"string"}
165158--
166159-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
167160-- Just "Day"
168−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy Day) ^. schema)
169−-- {
170−-- "example": "2016-07-22",
171−-- "format": "date",
172−-- "type": "string"
173−-- }
161+-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
162+-- {"example":"2016-07-22","format":"date","type":"string"}
174163toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
175164toNamedSchema = undeclare . declareNamedSchema
176165
@@ -186,35 +175,22 @@ schemaName = _namedSchemaName . toNamedSchema
186175
187176-- | Convert a type into a schema.
188177--
189−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Int8)
190−-- {
191−-- "maximum": 127,
192−-- "minimum": -128,
193−-- "type": "integer"
194−-- }
178+-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Int8)
179+-- {"maximum":127,"minimum":-128,"type":"integer"}
195180--
196−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])
197−-- {
198−-- "items": {
199−-- "$ref": "#/components/schemas/Day"
200−-- },
201−-- "type": "array"
202−-- }
181+-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy [Day])
182+-- {"items":{"$ref":"#/components/schemas/Day"},"type":"array"}
203183toSchema :: ToSchema a => Proxy a -> Schema
204184toSchema = _namedSchemaSchema . toNamedSchema
205185
206186-- | Convert a type into a referenced schema if possible.
207187-- Only named schemas can be referenced, nameless schemas are inlined.
208188--
209−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
210−-- {
211−-- "type": "integer"
212−-- }
189+-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Integer)
190+-- {"type":"integer"}
213191--
214−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
215−-- {
216−-- "$ref": "#/components/schemas/Day"
217−-- }
192+-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Day)
193+-- {"$ref":"#/components/schemas/Day"}
218194toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
219195toSchemaRef = undeclare . declareSchemaRef
220196
@@ -282,15 +258,8 @@ inlineAllSchemas = inlineSchemasWhen (const True)
282258
283259-- | Convert a type into a schema without references.
284260--
285−-- >>> BSL.putStrLn $ encodePretty $ toInlinedSchema (Proxy :: Proxy [Day])
286−-- {
287−-- "items": {
288−-- "example": "2016-07-22",
289−-- "format": "date",
290−-- "type": "string"
291−-- },
292−-- "type": "array"
293−-- }
261+-- >>> BSL.putStrLn $ encode $ toInlinedSchema (Proxy :: Proxy [Day])
262+-- {"items":{"example":"2016-07-22","format":"date","type":"string"},"type":"array"}
294263--
295264-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
296265-- when inlining recursive schemas.
@@ -320,67 +289,41 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
320289 traverse_ usedNames (InsOrdHashMap.lookup name defs)
321290 Inline subschema -> usedNames subschema
322291
292+-- | Default schema for binary data (any sequence of octets).
293+binarySchema :: Schema
294+binarySchema = mempty
295+ & type_ ?~ SwaggerString
296+ & format ?~ "binary"
297+
298+-- | Default schema for binary data (base64 encoded).
299+byteSchema :: Schema
300+byteSchema = mempty
301+ & type_ ?~ SwaggerString
302+ & format ?~ "byte"
303+
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"
310+
323311-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
324312-- Produced schema can be used for further refinement.
325313--
326−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
327−-- {
328−-- "example": "hello",
329−-- "type": "string"
330−-- }
314+-- >>> BSL.putStrLn $ encode $ sketchSchema "hello"
315+-- {"example":"hello","type":"string"}
331316--
332−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (1, 2, 3)
333−-- {
334−-- "example": [
335−-- 1,
336−-- 2,
337−-- 3
338−-- ],
339−-- "items": {
340−-- "type": "number"
341−-- },
342−-- "type": "array"
343−-- }
317+-- >>> BSL.putStrLn $ encode $ sketchSchema (1, 2, 3)
318+-- {"example":[1,2,3],"items":{"type":"number"},"type":"array"}
344319--
345−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema ("Jack", 25)
346−-- {
347−-- "example": [
348−-- "Jack",
349−-- 25
350−-- ],
351−-- "items": [
352−-- {
353−-- "type": "string"
354−-- },
355−-- {
356−-- "type": "number"
357−-- }
358−-- ],
359−-- "type": "array"
360−-- }
320+-- >>> BSL.putStrLn $ encode $ sketchSchema ("Jack", 25)
321+-- {"example":["Jack",25],"items":[{"type":"string"},{"type":"number"}],"type":"array"}
361322--
362323-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
363324-- >>> instance ToJSON Person
364−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (Person "Jack" 25)
365−-- {
366−-- "example": {
367−-- "age": 25,
368−-- "name": "Jack"
369−-- },
370−-- "properties": {
371−-- "age": {
372−-- "type": "number"
373−-- },
374−-- "name": {
375−-- "type": "string"
376−-- }
377−-- },
378−-- "required": [
379−-- "age",
380−-- "name"
381−-- ],
382−-- "type": "object"
383−-- }
325+-- >>> BSL.putStrLn $ encode $ sketchSchema (Person "Jack" 25)
326+-- {"required":["age","name"],"properties":{"age":{"type":"number"},"name":{"type":"string"}},"example":{"age":25,"name":"Jack"},"type":"object"}
384327sketchSchema :: ToJSON a => a -> Schema
385328sketchSchema = sketch . toJSON
386329 where
@@ -388,15 +331,15 @@ sketchSchema = sketch . toJSON
388331 sketch js@(Bool _) = go js
389332 sketch js = go js & example ?~ js
390333
391− go Null = mempty & type_ ?~ OpenApiNull
392− go (Bool _) = mempty & type_ ?~ OpenApiBoolean
393− go (String _) = mempty & type_ ?~ OpenApiString
394− go (Number _) = mempty & type_ ?~ OpenApiNumber
334+ go Null = mempty & type_ ?~ SwaggerNull
335+ go (Bool _) = mempty & type_ ?~ SwaggerBoolean
336+ go (String _) = mempty & type_ ?~ SwaggerString
337+ go (Number _) = mempty & type_ ?~ SwaggerNumber
395338 go (Array xs) = mempty
396− & type_ ?~ OpenApiArray
339+ & type_ ?~ SwaggerArray
397340 & items ?~ case ischema of
398− Just s -> OpenApiItemsObject (Inline s)
399− _ -> OpenApiItemsArray (map Inline ys)
341+ Just s -> SwaggerItemsObject (Inline s)
342+ _ -> SwaggerItemsArray (map Inline ys)
400343 where
401344 ys = map go (V.toList xs)
402345 allSame = and ((zipWith (==)) ys (tail ys))
@@ -405,178 +348,64 @@ sketchSchema = sketch . toJSON
405348 (z:_) | allSame -> Just z
406349 _ -> Nothing
407350 go (Object o) = mempty
408− & type_ ?~ OpenApiObject
409− & required .~ sort (objectKeys o)
410− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
351+ & type_ ?~ SwaggerObject
352+ & required .~ HashMap.keys o
353+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
411354
412355-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
413356-- Produced schema uses as much constraints as possible.
414357--
415−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema "hello"
416−-- {
417−-- "enum": [
418−-- "hello"
419−-- ],
420−-- "maxLength": 5,
421−-- "minLength": 5,
422−-- "pattern": "hello",
423−-- "type": "string"
424−-- }
358+-- >>> BSL.putStrLn $ encode $ sketchStrictSchema "hello"
359+-- {"maxLength":5,"pattern":"hello","minLength":5,"type":"string","enum":["hello"]}
425360--
426−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (1, 2, 3)
427−-- {
428−-- "enum": [
429−-- [
430−-- 1,
431−-- 2,
432−-- 3
433−-- ]
434−-- ],
435−-- "items": [
436−-- {
437−-- "enum": [
438−-- 1
439−-- ],
440−-- "maximum": 1,
441−-- "minimum": 1,
442−-- "multipleOf": 1,
443−-- "type": "number"
444−-- },
445−-- {
446−-- "enum": [
447−-- 2
448−-- ],
449−-- "maximum": 2,
450−-- "minimum": 2,
451−-- "multipleOf": 2,
452−-- "type": "number"
453−-- },
454−-- {
455−-- "enum": [
456−-- 3
457−-- ],
458−-- "maximum": 3,
459−-- "minimum": 3,
460−-- "multipleOf": 3,
461−-- "type": "number"
462−-- }
463−-- ],
464−-- "maxItems": 3,
465−-- "minItems": 3,
466−-- "type": "array",
467−-- "uniqueItems": true
468−-- }
361+-- >>> BSL.putStrLn $ encode $ 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]]}
469363--
470−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema ("Jack", 25)
471−-- {
472−-- "enum": [
473−-- [
474−-- "Jack",
475−-- 25
476−-- ]
477−-- ],
478−-- "items": [
479−-- {
480−-- "enum": [
481−-- "Jack"
482−-- ],
483−-- "maxLength": 4,
484−-- "minLength": 4,
485−-- "pattern": "Jack",
486−-- "type": "string"
487−-- },
488−-- {
489−-- "enum": [
490−-- 25
491−-- ],
492−-- "maximum": 25,
493−-- "minimum": 25,
494−-- "multipleOf": 25,
495−-- "type": "number"
496−-- }
497−-- ],
498−-- "maxItems": 2,
499−-- "minItems": 2,
500−-- "type": "array",
501−-- "uniqueItems": true
502−-- }
364+-- >>> BSL.putStrLn $ encode $ 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]]}
503366--
504367-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
505368-- >>> instance ToJSON Person
506−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (Person "Jack" 25)
507−-- {
508−-- "enum": [
509−-- {
510−-- "age": 25,
511−-- "name": "Jack"
512−-- }
513−-- ],
514−-- "maxProperties": 2,
515−-- "minProperties": 2,
516−-- "properties": {
517−-- "age": {
518−-- "enum": [
519−-- 25
520−-- ],
521−-- "maximum": 25,
522−-- "minimum": 25,
523−-- "multipleOf": 25,
524−-- "type": "number"
525−-- },
526−-- "name": {
527−-- "enum": [
528−-- "Jack"
529−-- ],
530−-- "maxLength": 4,
531−-- "minLength": 4,
532−-- "pattern": "Jack",
533−-- "type": "string"
534−-- }
535−-- },
536−-- "required": [
537−-- "age",
538−-- "name"
539−-- ],
540−-- "type": "object"
541−-- }
369+-- >>> BSL.putStrLn $ encode $ 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"}]}
542371sketchStrictSchema :: ToJSON a => a -> Schema
543372sketchStrictSchema = go . toJSON
544373 where
545− go Null = mempty & type_ ?~ OpenApiNull
374+ go Null = mempty & type_ ?~ SwaggerNull
546375 go js@(Bool _) = mempty
547− & type_ ?~ OpenApiBoolean
376+ & type_ ?~ SwaggerBoolean
548377 & enum_ ?~ [js]
549378 go js@(String s) = mempty
550− & type_ ?~ OpenApiString
379+ & type_ ?~ SwaggerString
551380 & maxLength ?~ fromIntegral (T.length s)
552381 & minLength ?~ fromIntegral (T.length s)
553382 & pattern ?~ s
554383 & enum_ ?~ [js]
555384 go js@(Number n) = mempty
556− & type_ ?~ OpenApiNumber
385+ & type_ ?~ SwaggerNumber
557386 & maximum_ ?~ n
558387 & minimum_ ?~ n
559388 & multipleOf ?~ n
560389 & enum_ ?~ [js]
561390 go js@(Array xs) = mempty
562− & type_ ?~ OpenApiArray
391+ & type_ ?~ SwaggerArray
563392 & maxItems ?~ fromIntegral sz
564393 & minItems ?~ fromIntegral sz
565− & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
394+ & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
566395 & uniqueItems ?~ allUnique
567396 & enum_ ?~ [js]
568397 where
569398 sz = length xs
570399 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
571400 go js@(Object o) = mempty
572− & type_ ?~ OpenApiObject
573− & required .~ sort names
574− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
401+ & type_ ?~ SwaggerObject
402+ & required .~ names
403+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
575404 & maxProperties ?~ fromIntegral (length names)
576405 & minProperties ?~ fromIntegral (length names)
577406 & enum_ ?~ [js]
578407 where
579− names = objectKeys o
408+ names = HashMap.keys o
580409
581410class GToSchema (f :: * -> *) where
582411 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
@@ -585,8 +414,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
585414 declareNamedSchema _ = do
586415 ref <- declareSchemaRef (Proxy :: Proxy a)
587416 return $ unnamed $ mempty
588− & type_ ?~ OpenApiArray
589− & items ?~ OpenApiItemsObject ref
417+ & type_ ?~ SwaggerArray
418+ & items ?~ SwaggerItemsObject ref
590419
591420instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
592421instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
@@ -611,7 +440,7 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
611440instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
612441instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
613442
614−instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
443+instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
615444
616445instance ToSchema a => ToSchema (Maybe a) where
617446 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -628,22 +457,16 @@ instance ToSchema UUID.UUID where
628457 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
629458 & example ?~ toJSON (UUID.toText UUID.nil)
630459
631−instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
632− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
633−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where
634− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
635−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where
636− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
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
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
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
460+instance (ToSchema a, ToSchema b) => ToSchema (a, b)
461+instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
462+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
463+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
464+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
465+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
643466
644467timeSchema :: T.Text -> Schema
645468timeSchema fmt = mempty
646− & type_ ?~ OpenApiString
469+ & type_ ?~ SwaggerString
647470 & format ?~ fmt
648471
649472-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -658,7 +481,7 @@ instance ToSchema LocalTime where
658481 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
659482 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
660483
661−-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
484+-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
662485instance ToSchema ZonedTime where
663486 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
664487 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
@@ -690,7 +513,7 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
690513instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
691514
692515-- | NOTE: This schema does not account for the uniqueness of keys.
693−instance (ToSchema a) => ToSchema (IntMap a) where
516+instance ToSchema a => ToSchema (IntMap a) where
694517 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
695518
696519instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
@@ -701,7 +524,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
701524 declareObjectMapSchema = do
702525 schema <- declareSchemaRef (Proxy :: Proxy v)
703526 return $ unnamed $ mempty
704− & type_ ?~ OpenApiObject
527+ & type_ ?~ SwaggerObject
705528 & additionalProperties ?~ AdditionalPropertiesSchema schema
706529
707530instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
@@ -709,7 +532,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
709532
710533instance {-# OVERLAPPING #-} ToSchema Object where
711534 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
712− & type_ ?~ OpenApiObject
535+ & type_ ?~ SwaggerObject
713536 & description ?~ "Arbitrary JSON object."
714537 & additionalProperties ?~ AdditionalPropertiesAllowed True
715538
@@ -746,15 +569,11 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
746569
747570-- | Default schema for @'Bounded'@, @'Integral'@ types.
748571--
749−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
750−-- {
751−-- "maximum": 32767,
752−-- "minimum": -32768,
753−-- "type": "integer"
754−-- }
572+-- >>> BSL.putStrLn $ encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
573+-- {"maximum":32767,"minimum":-32768,"type":"integer"}
755574toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
756575toSchemaBoundedIntegral _ = mempty
757− & type_ ?~ OpenApiInteger
576+ & type_ ?~ SwaggerInteger
758577 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
759578 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
760579
@@ -783,27 +602,8 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
783602-- >>> instance ToSchema ButtonState
784603-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
785604-- >>> type ImageUrl = T.Text
786−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
787−-- {
788−-- "properties": {
789−-- "Active": {
790−-- "type": "string"
791−-- },
792−-- "Disabled": {
793−-- "type": "string"
794−-- },
795−-- "Focus": {
796−-- "type": "string"
797−-- },
798−-- "Hover": {
799−-- "type": "string"
800−-- },
801−-- "Neutral": {
802−-- "type": "string"
803−-- }
804−-- },
805−-- "type": "object"
806−-- }
605+-- >>> BSL.putStrLn $ encode $ 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"}
807607--
808608-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
809609-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -811,15 +611,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
811611 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
812612 => Proxy (map key value) -> Declare (Definitions Schema) Schema
813613declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
814− ToJSONKeyText getKey _ -> objectSchema getKey
614+ ToJSONKeyText keyToText _ -> objectSchema keyToText
815615 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
816616 where
817− objectSchema getKey = do
617+ objectSchema keyToText = do
818618 valueRef <- declareSchemaRef (Proxy :: Proxy value)
819619 let allKeys = [minBound..maxBound :: key]
820− mkPair k = (keyToText $ getKey k, valueRef)
620+ mkPair k = (keyToText k, valueRef)
821621 return $ mempty
822− & type_ ?~ OpenApiObject
622+ & type_ ?~ SwaggerObject
823623 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
824624
825625-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -830,27 +630,8 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
830630-- >>> instance ToSchema ButtonState
831631-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
832632-- >>> type ImageUrl = T.Text
833−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
834−-- {
835−-- "properties": {
836−-- "Active": {
837−-- "type": "string"
838−-- },
839−-- "Disabled": {
840−-- "type": "string"
841−-- },
842−-- "Focus": {
843−-- "type": "string"
844−-- },
845−-- "Hover": {
846−-- "type": "string"
847−-- },
848−-- "Neutral": {
849−-- "type": "string"
850−-- }
851−-- },
852−-- "type": "object"
853−-- }
633+-- >>> BSL.putStrLn $ encode $ 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"}
854635--
855636-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
856637-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -860,7 +641,7 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
860641toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
861642
862643-- | A configurable generic @'Schema'@ creator.
863−genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
644+genericDeclareSchema :: (Generic a, GToSchema (Rep a)) =>
864645 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
865646genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
866647
@@ -868,24 +649,9 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
868649-- This function applied to @'defaultSchemaOptions'@
869650-- is used as the default for @'declareNamedSchema'@
870651-- when the type is an instance of @'Generic'@.
871−--
872−-- Default implementation will use the name from 'Typeable' instance, including concrete
873−-- instantioations of type variables.
874−--
875−-- For example:
876−--
877−-- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))
878−-- Just "Either_Int_Bool"
879−genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
652+genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a)) =>
880653 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
881−genericDeclareNamedSchema opts _ =
882− rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
883− where
884− unspace ' ' = '_'
885− unspace x = x
886− orig = fmap unspace $ show $ typeRep @a
887− name = datatypeNameModifier opts orig
888−
654+genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
889655
890656-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
891657genericNameSchema :: forall a d f.
@@ -901,19 +667,19 @@ gdatatypeSchemaName opts _ = case orig of
901667 orig = datatypeName (Proxy3 :: Proxy3 d f a)
902668 name = datatypeNameModifier opts orig
903669
904−-- | Construct 'NamedSchema' usinng 'ToParamSchema'.
670+-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
905671paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
906672 SchemaOptions -> Proxy a -> NamedSchema
907673paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
908674
909−-- | Construct 'Schema' usinng 'ToParamSchema'.
675+-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
910676paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
911−paramSchemaToSchema = toParamSchema
677+paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
912678
913679nullarySchema :: Schema
914680nullarySchema = mempty
915− & type_ ?~ OpenApiArray
916− & items ?~ OpenApiItemsArray []
681+ & type_ ?~ SwaggerArray
682+ & items ?~ SwaggerItemsArray []
917683
918684gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
919685gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -943,15 +709,12 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
943709 | unwrapUnaryRecords opts = fieldSchema
944710 | otherwise =
945711 case schema ^. items of
946− Just (OpenApiItemsArray [_]) -> fieldSchema
712+ Just (SwaggerItemsArray [_]) -> fieldSchema
947713 _ -> do
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
952− return (unnamed schema')
714+ declare defs
715+ return (unnamed schema)
953716 where
954− (_, NamedSchema _ schema) = runDeclare recordSchema mempty
717+ (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
955718 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
956719 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
957720
@@ -974,10 +737,10 @@ gdeclareSchemaRef opts proxy = do
974737 return $ Ref (Reference name)
975738 _ -> Inline <$> gdeclareSchema opts proxy
976739
977−appendItem :: Referenced Schema -> Maybe OpenApiItems -> Maybe OpenApiItems
978−appendItem x Nothing = Just (OpenApiItemsArray [x])
979−appendItem x (Just (OpenApiItemsArray xs)) = Just (OpenApiItemsArray (xs ++ [x]))
980−appendItem _ _ = error "GToSchema.appendItem: cannot append to OpenApiItemsObject"
740+appendItem :: Referenced Schema -> Maybe SwaggerItems -> Maybe SwaggerItems
741+appendItem x Nothing = Just (SwaggerItemsArray [x])
742+appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
743+appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
981744
982745withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
983746 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
@@ -986,12 +749,12 @@ withFieldSchema opts _ isRequiredField schema = do
986749 return $
987750 if T.null fname
988751 then schema
989− & type_ ?~ OpenApiArray
752+ & type_ ?~ SwaggerArray
990753 & items %~ appendItem ref
991754 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
992755 & minItems %~ Just . maybe 1 (+1) -- increment minItems
993756 else schema
994− & type_ ?~ OpenApiObject
757+ & type_ ?~ SwaggerObject
995758 & properties . at fname ?~ ref
996759 & if isRequiredField
997760 then required %~ (++ [fname])
@@ -1026,14 +789,14 @@ gdeclareNamedSumSchema opts proxy _
1026789 | otherwise = do
1027790 (schemas, _) <- runWriterT declareSumSchema
1028791 return $ unnamed $ mempty
1029− & type_ ?~ OpenApiObject
792+ & type_ ?~ SwaggerObject
1030793 & oneOf ?~ (snd <$> schemas)
1031794 where
1032795 declareSumSchema = gsumToSchema opts proxy
1033796 (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
1034797
1035798 toStringTag schemas = mempty
1036− & type_ ?~ OpenApiString
799+ & type_ ?~ SwaggerString
1037800 & enum_ ?~ map (String . fst) sumSchemas
1038801
1039802type AllNullary = All
@@ -1055,15 +818,15 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
1055818 case ref of
1056819 -- If subschema is an object and constructor is a record, we add tag directly
1057820 -- to the record, as Aeson does it.
1058− Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub
821+ Just (Inline sub) | sub ^. type_ == Just SwaggerObject && isRecord -> Inline $ sub
1059822 & required <>~ [T.pack tagField]
1060− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
823+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])
1061824
1062825 -- If it is not a record, we need to put subschema into "contents" field.
1063826 _ | not isRecord -> Inline $ mempty
1064− & type_ ?~ OpenApiObject
827+ & type_ ?~ SwaggerObject
1065828 & required .~ [T.pack tagField]
1066− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
829+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])
1067830 -- If constructor is nullary, there is no content.
1068831 & case ref of
1069832 Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
@@ -1071,17 +834,17 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
1071834
1072835 -- In the remaining cases we combine "tag" object and "contents" object using allOf.
1073836 _ -> Inline $ mempty
1074− & type_ ?~ OpenApiObject
837+ & type_ ?~ SwaggerObject
1075838 & allOf ?~ [Inline $ mempty
1076− & type_ ?~ OpenApiObject
839+ & type_ ?~ SwaggerObject
1077840 & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
1078− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])]
841+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])]
1079842 & if isRecord
1080843 then allOf . _Just <>~ [refOrNullary]
1081− else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary]
844+ else allOf . _Just <>~ [Inline $ mempty & type_ ?~ SwaggerObject & properties . at (T.pack contentsField) ?~ refOrNullary]
1082845 UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.
1083846 ObjectWithSingleField -> Inline $ mempty
1084− & type_ ?~ OpenApiObject
847+ & type_ ?~ SwaggerObject
1085848 & required .~ [tag]
1086849 & properties . at tag ?~ refOrNullary
1087850 TwoElemArray -> error "unrepresentable in OpenAPI 3"
@@ -1089,7 +852,7 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
1089852 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
1090853 isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)
1091854 refOrNullary = fromMaybe (Inline nullarySchema) ref
1092− refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref
855+ refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag]) ref
1093856
1094857gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
1095858 SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
@@ -1114,13 +877,7 @@ data Proxy2 a b = Proxy2
1114877
1115878data Proxy3 a b c = Proxy3
1116879
1117−{- $setup
1118−>>> import Data.OpenApi
1119−>>> import Data.Aeson (encode)
1120−>>> import Data.Aeson.Types (toJSONKeyText)
1121−>>> import Data.OpenApi.Internal.Utils
1122−>>> :set -XScopedTypeVariables
1123−>>> :set -XDeriveAnyClass
1124−>>> :set -XStandaloneDeriving
1125−>>> :set -XTypeApplications
1126−-}
880+-- $setup
881+-- >>> import Data.Swagger
882+-- >>> import Data.Aeson (encode)
883+-- >>> import Data.Aeson.Types (toJSONKeyText)