@@ -1,15 +1,17 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE ConstraintKinds #-}
3+{-# LANGUAGE DataKinds #-}
24{-# LANGUAGE DefaultSignatures #-}
35{-# LANGUAGE FlexibleContexts #-}
46{-# LANGUAGE FlexibleInstances #-}
57{-# LANGUAGE KindSignatures #-}
6−{-# LANGUAGE DataKinds #-}
78{-# LANGUAGE OverloadedLists #-}
89{-# LANGUAGE OverloadedStrings #-}
910{-# LANGUAGE PackageImports #-}
1011{-# LANGUAGE PolyKinds #-}
1112{-# LANGUAGE ScopedTypeVariables #-}
1213{-# LANGUAGE TupleSections #-}
14+{-# LANGUAGE TypeApplications #-}
1315{-# LANGUAGE TypeFamilies #-}
1416{-# LANGUAGE TypeOperators #-}
1517{-# LANGUAGE TypeSynonymInstances #-}
@@ -17,7 +19,7 @@
1719{-# OPTIONS_GHC -Wno-redundant-constraints #-}
1820-- For TypeErrors
1921{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
20−module Data.Swagger.Internal.Schema where
22+module Data.OpenApi.Internal.Schema where
2123
2224import Prelude ()
2325import Prelude.Compat
@@ -40,6 +42,7 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
4042import Data.Int
4143import Data.IntSet (IntSet)
4244import Data.IntMap (IntMap)
45+import Data.List (sort)
4346import Data.List.NonEmpty.Compat (NonEmpty)
4447import Data.Map (Map)
4548import Data.Maybe (fromMaybe)
@@ -59,14 +62,16 @@ import Numeric.Natural.Compat (Natural)
5962import Data.Word
6063import GHC.Generics
6164import qualified Data.UUID.Types as UUID
65+import Type.Reflection (Typeable, typeRep)
6266
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
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
7075
7176import qualified Data.ByteString as BS
7277import qualified Data.ByteString.Lazy.Char8 as BSL
@@ -97,7 +102,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
97102--
98103-- import Control.Lens
99104-- import Data.Proxy
100−-- import Data.Swagger
105+-- import Data.OpenApi
101106--
102107-- data Coord = Coord { x :: Double, y :: Double }
103108--
@@ -105,7 +110,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
105110-- declareNamedSchema _ = do
106111-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
107112-- return $ NamedSchema (Just \"Coord\") $ mempty
108−-- & type_ ?~ SwaggerObject
113+-- & type_ ?~ OpenApiObject
109114-- & properties .~
110115-- [ (\"x\", doubleSchema)
111116-- , (\"y\", doubleSchema)
@@ -131,7 +136,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
131136--
132137-- instance ToSchema Coord
133138-- @
134−class ToSchema a where
139+class Typeable a => ToSchema a where
135140 -- | Convert a type into an optionally named schema
136141 -- together with all used definitions.
137142 -- Note that the schema itself is included in definitions
@@ -153,13 +158,19 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
153158--
154159-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
155160-- Nothing
156−-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
157−-- {"type":"string"}
161+-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
162+-- {
163+-- "type": "string"
164+-- }
158165--
159166-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
160167-- Just "Day"
161−-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
162−-- {"example":"2016-07-22","format":"date","type":"string"}
168+-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy Day) ^. schema)
169+-- {
170+-- "example": "2016-07-22",
171+-- "format": "date",
172+-- "type": "string"
173+-- }
163174toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
164175toNamedSchema = undeclare . declareNamedSchema
165176
@@ -175,22 +186,35 @@ schemaName = _namedSchemaName . toNamedSchema
175186
176187-- | Convert a type into a schema.
177188--
178−-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Int8)
179−-- {"maximum":127,"minimum":-128,"type":"integer"}
189+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Int8)
190+-- {
191+-- "maximum": 127,
192+-- "minimum": -128,
193+-- "type": "integer"
194+-- }
180195--
181−-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy [Day])
182−-- {"items":{"$ref":"#/components/schemas/Day"},"type":"array"}
196+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])
197+-- {
198+-- "items": {
199+-- "$ref": "#/components/schemas/Day"
200+-- },
201+-- "type": "array"
202+-- }
183203toSchema :: ToSchema a => Proxy a -> Schema
184204toSchema = _namedSchemaSchema . toNamedSchema
185205
186206-- | Convert a type into a referenced schema if possible.
187207-- Only named schemas can be referenced, nameless schemas are inlined.
188208--
189−-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Integer)
190−-- {"type":"integer"}
209+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
210+-- {
211+-- "type": "integer"
212+-- }
191213--
192−-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Day)
193−-- {"$ref":"#/components/schemas/Day"}
214+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
215+-- {
216+-- "$ref": "#/components/schemas/Day"
217+-- }
194218toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
195219toSchemaRef = undeclare . declareSchemaRef
196220
@@ -258,8 +282,15 @@ inlineAllSchemas = inlineSchemasWhen (const True)
258282
259283-- | Convert a type into a schema without references.
260284--
261−-- >>> BSL.putStrLn $ encode $ toInlinedSchema (Proxy :: Proxy [Day])
262−-- {"items":{"example":"2016-07-22","format":"date","type":"string"},"type":"array"}
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+-- }
263294--
264295-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
265296-- when inlining recursive schemas.
@@ -292,19 +323,64 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
292323-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
293324-- Produced schema can be used for further refinement.
294325--
295−-- >>> BSL.putStrLn $ encode $ sketchSchema "hello"
296−-- {"example":"hello","type":"string"}
326+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
327+-- {
328+-- "example": "hello",
329+-- "type": "string"
330+-- }
297331--
298−-- >>> BSL.putStrLn $ encode $ sketchSchema (1, 2, 3)
299−-- {"example":[1,2,3],"items":{"type":"number"},"type":"array"}
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+-- }
300344--
301−-- >>> BSL.putStrLn $ encode $ sketchSchema ("Jack", 25)
302−-- {"example":["Jack",25],"items":[{"type":"string"},{"type":"number"}],"type":"array"}
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+-- }
303361--
304362-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
305363-- >>> instance ToJSON Person
306−-- >>> BSL.putStrLn $ encode $ sketchSchema (Person "Jack" 25)
307−-- {"example":{"age":25,"name":"Jack"},"required":["age","name"],"type":"object","properties":{"age":{"type":"number"},"name":{"type":"string"}}}
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+-- }
308384sketchSchema :: ToJSON a => a -> Schema
309385sketchSchema = sketch . toJSON
310386 where
@@ -312,15 +388,15 @@ sketchSchema = sketch . toJSON
312388 sketch js@(Bool _) = go js
313389 sketch js = go js & example ?~ js
314390
315− go Null = mempty & type_ ?~ SwaggerNull
316− go (Bool _) = mempty & type_ ?~ SwaggerBoolean
317− go (String _) = mempty & type_ ?~ SwaggerString
318− go (Number _) = mempty & type_ ?~ SwaggerNumber
391+ go Null = mempty & type_ ?~ OpenApiNull
392+ go (Bool _) = mempty & type_ ?~ OpenApiBoolean
393+ go (String _) = mempty & type_ ?~ OpenApiString
394+ go (Number _) = mempty & type_ ?~ OpenApiNumber
319395 go (Array xs) = mempty
320− & type_ ?~ SwaggerArray
396+ & type_ ?~ OpenApiArray
321397 & items ?~ case ischema of
322− Just s -> SwaggerItemsObject (Inline s)
323− _ -> SwaggerItemsArray (map Inline ys)
398+ Just s -> OpenApiItemsObject (Inline s)
399+ _ -> OpenApiItemsArray (map Inline ys)
324400 where
325401 ys = map go (V.toList xs)
326402 allSame = and ((zipWith (==)) ys (tail ys))
@@ -329,64 +405,178 @@ sketchSchema = sketch . toJSON
329405 (z:_) | allSame -> Just z
330406 _ -> Nothing
331407 go (Object o) = mempty
332− & type_ ?~ SwaggerObject
333− & required .~ HashMap.keys o
334− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
408+ & type_ ?~ OpenApiObject
409+ & required .~ sort (objectKeys o)
410+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
335411
336412-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
337413-- Produced schema uses as much constraints as possible.
338414--
339−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema "hello"
340−-- {"maxLength":5,"pattern":"hello","minLength":5,"type":"string","enum":["hello"]}
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+-- }
341425--
342−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (1, 2, 3)
343−-- {"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]]}
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+-- }
344469--
345−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema ("Jack", 25)
346−-- {"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]]}
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+-- }
347503--
348504-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
349505-- >>> instance ToJSON Person
350−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (Person "Jack" 25)
351−-- {"minProperties":2,"required":["age","name"],"maxProperties":2,"type":"object","enum":[{"age":25,"name":"Jack"}],"properties":{"age":{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]},"name":{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]}}}
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+-- }
352542sketchStrictSchema :: ToJSON a => a -> Schema
353543sketchStrictSchema = go . toJSON
354544 where
355− go Null = mempty & type_ ?~ SwaggerNull
545+ go Null = mempty & type_ ?~ OpenApiNull
356546 go js@(Bool _) = mempty
357− & type_ ?~ SwaggerBoolean
547+ & type_ ?~ OpenApiBoolean
358548 & enum_ ?~ [js]
359549 go js@(String s) = mempty
360− & type_ ?~ SwaggerString
550+ & type_ ?~ OpenApiString
361551 & maxLength ?~ fromIntegral (T.length s)
362552 & minLength ?~ fromIntegral (T.length s)
363553 & pattern ?~ s
364554 & enum_ ?~ [js]
365555 go js@(Number n) = mempty
366− & type_ ?~ SwaggerNumber
556+ & type_ ?~ OpenApiNumber
367557 & maximum_ ?~ n
368558 & minimum_ ?~ n
369559 & multipleOf ?~ n
370560 & enum_ ?~ [js]
371561 go js@(Array xs) = mempty
372− & type_ ?~ SwaggerArray
562+ & type_ ?~ OpenApiArray
373563 & maxItems ?~ fromIntegral sz
374564 & minItems ?~ fromIntegral sz
375− & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
565+ & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
376566 & uniqueItems ?~ allUnique
377567 & enum_ ?~ [js]
378568 where
379569 sz = length xs
380570 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
381571 go js@(Object o) = mempty
382− & type_ ?~ SwaggerObject
383− & required .~ names
384− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
572+ & type_ ?~ OpenApiObject
573+ & required .~ sort names
574+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
385575 & maxProperties ?~ fromIntegral (length names)
386576 & minProperties ?~ fromIntegral (length names)
387577 & enum_ ?~ [js]
388578 where
389− names = HashMap.keys o
579+ names = objectKeys o
390580
391581class GToSchema (f :: * -> *) where
392582 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
@@ -395,8 +585,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
395585 declareNamedSchema _ = do
396586 ref <- declareSchemaRef (Proxy :: Proxy a)
397587 return $ unnamed $ mempty
398− & type_ ?~ SwaggerArray
399− & items ?~ SwaggerItemsObject ref
588+ & type_ ?~ OpenApiArray
589+ & items ?~ OpenApiItemsObject ref
400590
401591instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
402592instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
@@ -421,7 +611,7 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
421611instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
422612instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
423613
424−instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
614+instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
425615
426616instance ToSchema a => ToSchema (Maybe a) where
427617 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -438,16 +628,22 @@ instance ToSchema UUID.UUID where
438628 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
439629 & example ?~ toJSON (UUID.toText UUID.nil)
440630
441−instance (ToSchema a, ToSchema b) => ToSchema (a, b)
442−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
443−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
444−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
445−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
446−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
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
447643
448644timeSchema :: T.Text -> Schema
449645timeSchema fmt = mempty
450− & type_ ?~ SwaggerString
646+ & type_ ?~ OpenApiString
451647 & format ?~ fmt
452648
453649-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -462,7 +658,7 @@ instance ToSchema LocalTime where
462658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
463659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
464660
465−-- | 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.
466662instance ToSchema ZonedTime where
467663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
468664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
@@ -494,7 +690,7 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
494690instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
495691
496692-- | NOTE: This schema does not account for the uniqueness of keys.
497−instance ToSchema a => ToSchema (IntMap a) where
693+instance (ToSchema a) => ToSchema (IntMap a) where
498694 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
499695
500696instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
@@ -505,7 +701,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
505701 declareObjectMapSchema = do
506702 schema <- declareSchemaRef (Proxy :: Proxy v)
507703 return $ unnamed $ mempty
508− & type_ ?~ SwaggerObject
704+ & type_ ?~ OpenApiObject
509705 & additionalProperties ?~ AdditionalPropertiesSchema schema
510706
511707instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
@@ -513,7 +709,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
513709
514710instance {-# OVERLAPPING #-} ToSchema Object where
515711 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
516− & type_ ?~ SwaggerObject
712+ & type_ ?~ OpenApiObject
517713 & description ?~ "Arbitrary JSON object."
518714 & additionalProperties ?~ AdditionalPropertiesAllowed True
519715
@@ -550,11 +746,15 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
550746
551747-- | Default schema for @'Bounded'@, @'Integral'@ types.
552748--
553−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
554−-- {"maximum":32767,"minimum":-32768,"type":"integer"}
749+-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
750+-- {
751+-- "maximum": 32767,
752+-- "minimum": -32768,
753+-- "type": "integer"
754+-- }
555755toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
556756toSchemaBoundedIntegral _ = mempty
557− & type_ ?~ SwaggerInteger
757+ & type_ ?~ OpenApiInteger
558758 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
559759 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
560760
@@ -583,8 +783,27 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
583783-- >>> instance ToSchema ButtonState
584784-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
585785-- >>> type ImageUrl = T.Text
586−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
587−-- {"type":"object","properties":{"Focus":{"type":"string"},"Disabled":{"type":"string"},"Active":{"type":"string"},"Neutral":{"type":"string"},"Hover":{"type":"string"}}}
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+-- }
588807--
589808-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
590809-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -592,15 +811,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
592811 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
593812 => Proxy (map key value) -> Declare (Definitions Schema) Schema
594813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
595− ToJSONKeyText keyToText _ -> objectSchema keyToText
814+ ToJSONKeyText getKey _ -> objectSchema getKey
596815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
597816 where
598− objectSchema keyToText = do
817+ objectSchema getKey = do
599818 valueRef <- declareSchemaRef (Proxy :: Proxy value)
600819 let allKeys = [minBound..maxBound :: key]
601− mkPair k = (keyToText k, valueRef)
820+ mkPair k = (keyToText $ getKey k, valueRef)
602821 return $ mempty
603− & type_ ?~ SwaggerObject
822+ & type_ ?~ OpenApiObject
604823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
605824
606825-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -611,8 +830,27 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
611830-- >>> instance ToSchema ButtonState
612831-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
613832-- >>> type ImageUrl = T.Text
614−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
615−-- {"type":"object","properties":{"Focus":{"type":"string"},"Disabled":{"type":"string"},"Active":{"type":"string"},"Neutral":{"type":"string"},"Hover":{"type":"string"}}}
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+-- }
616854--
617855-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
618856-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -622,7 +860,7 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
622860toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
623861
624862-- | A configurable generic @'Schema'@ creator.
625−genericDeclareSchema :: (Generic a, GToSchema (Rep a)) =>
863+genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
626864 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
627865genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
628866
@@ -630,9 +868,24 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
630868-- This function applied to @'defaultSchemaOptions'@
631869-- is used as the default for @'declareNamedSchema'@
632870-- when the type is an instance of @'Generic'@.
633−genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a)) =>
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) =>
634880 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
635−genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
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+
636889
637890-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
638891genericNameSchema :: forall a d f.
@@ -659,8 +912,8 @@ paramSchemaToSchema = toParamSchema
659912
660913nullarySchema :: Schema
661914nullarySchema = mempty
662− & type_ ?~ SwaggerArray
663− & items ?~ SwaggerItemsArray []
915+ & type_ ?~ OpenApiArray
916+ & items ?~ OpenApiItemsArray []
664917
665918gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
666919gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -690,12 +943,15 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
690943 | unwrapUnaryRecords opts = fieldSchema
691944 | otherwise =
692945 case schema ^. items of
693− Just (SwaggerItemsArray [_]) -> fieldSchema
946+ Just (OpenApiItemsArray [_]) -> fieldSchema
694947 _ -> do
695− declare defs
696− return (unnamed schema)
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')
697953 where
698− (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
954+ (_, NamedSchema _ schema) = runDeclare recordSchema mempty
699955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
700956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
701957
@@ -718,10 +974,10 @@ gdeclareSchemaRef opts proxy = do
718974 return $ Ref (Reference name)
719975 _ -> Inline <$> gdeclareSchema opts proxy
720976
721−appendItem :: Referenced Schema -> Maybe SwaggerItems -> Maybe SwaggerItems
722−appendItem x Nothing = Just (SwaggerItemsArray [x])
723−appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
724−appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
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"
725981
726982withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
727983 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
@@ -730,12 +986,12 @@ withFieldSchema opts _ isRequiredField schema = do
730986 return $
731987 if T.null fname
732988 then schema
733− & type_ ?~ SwaggerArray
989+ & type_ ?~ OpenApiArray
734990 & items %~ appendItem ref
735991 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
736992 & minItems %~ Just . maybe 1 (+1) -- increment minItems
737993 else schema
738− & type_ ?~ SwaggerObject
994+ & type_ ?~ OpenApiObject
739995 & properties . at fname ?~ ref
740996 & if isRequiredField
741997 then required %~ (++ [fname])
@@ -770,14 +1026,14 @@ gdeclareNamedSumSchema opts proxy _
7701026 | otherwise = do
7711027 (schemas, _) <- runWriterT declareSumSchema
7721028 return $ unnamed $ mempty
773− & type_ ?~ SwaggerObject
1029+ & type_ ?~ OpenApiObject
7741030 & oneOf ?~ (snd <$> schemas)
7751031 where
7761032 declareSumSchema = gsumToSchema opts proxy
7771033 (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
7781034
7791035 toStringTag schemas = mempty
780− & type_ ?~ SwaggerString
1036+ & type_ ?~ OpenApiString
7811037 & enum_ ?~ map (String . fst) sumSchemas
7821038
7831039type AllNullary = All
@@ -799,15 +1055,15 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
7991055 case ref of
8001056 -- If subschema is an object and constructor is a record, we add tag directly
8011057 -- to the record, as Aeson does it.
802− Just (Inline sub) | sub ^. type_ == Just SwaggerObject && isRecord -> Inline $ sub
1058+ Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub
8031059 & required <>~ [T.pack tagField]
804− & 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])
8051061
8061062 -- If it is not a record, we need to put subschema into "contents" field.
8071063 _ | not isRecord -> Inline $ mempty
808− & type_ ?~ SwaggerObject
1064+ & type_ ?~ OpenApiObject
8091065 & required .~ [T.pack tagField]
810− & 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])
8111067 -- If constructor is nullary, there is no content.
8121068 & case ref of
8131069 Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
@@ -815,17 +1071,17 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
8151071
8161072 -- In the remaining cases we combine "tag" object and "contents" object using allOf.
8171073 _ -> Inline $ mempty
818− & type_ ?~ SwaggerObject
1074+ & type_ ?~ OpenApiObject
8191075 & allOf ?~ [Inline $ mempty
820− & type_ ?~ SwaggerObject
1076+ & type_ ?~ OpenApiObject
8211077 & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
822− & 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])]
8231079 & if isRecord
8241080 then allOf . _Just <>~ [refOrNullary]
825− 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]
8261082 UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.
8271083 ObjectWithSingleField -> Inline $ mempty
828− & type_ ?~ SwaggerObject
1084+ & type_ ?~ OpenApiObject
8291085 & required .~ [tag]
8301086 & properties . at tag ?~ refOrNullary
8311087 TwoElemArray -> error "unrepresentable in OpenAPI 3"
@@ -833,7 +1089,7 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
8331089 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
8341090 isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)
8351091 refOrNullary = fromMaybe (Inline nullarySchema) ref
836− refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag]) ref
1092+ refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref
8371093
8381094gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
8391095 SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
@@ -858,7 +1114,13 @@ data Proxy2 a b = Proxy2
8581114
8591115data Proxy3 a b c = Proxy3
8601116
861−-- $setup
862−-- >>> import Data.Swagger
863−-- >>> import Data.Aeson (encode)
864−-- >>> import Data.Aeson.Types (toJSONKeyText)
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+-}