@@ -1,4 +1,5 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
@@ -13,6 +14,13 @@
13{-# LANGUAGE TypeFamilies #-}
14{-# LANGUAGE TypeFamilies #-}
14{-# LANGUAGE TypeOperators #-}
15{-# LANGUAGE TypeOperators #-}
15{-# LANGUAGE TypeSynonymInstances #-}
16{-# LANGUAGE TypeSynonymInstances #-}
17+{-# LANGUAGE UndecidableInstances #-}
18+#if __GLASGOW_HASKELL__ >= 800
19+-- Few generics related redundant constraints
20+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
22+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
16#include "overlapping-compat.h"
24#include "overlapping-compat.h"
17module Data.Swagger.Internal.Schema where
25module Data.Swagger.Internal.Schema where
@@ -22,27 +30,25 @@ import Prelude.Compat
22import Control.Lens
30import Control.Lens
23import Data.Data.Lens (template)
31import Data.Data.Lens (template)
25−import Control.Applicative
26import Control.Monad
33import Control.Monad
27import Control.Monad.Writer
34import Control.Monad.Writer
28−import Data.Aeson
35+import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..), Object(..))
29−import qualified Data.Aeson.Types as Aeson
30import Data.Char
36import Data.Char
31import Data.Data (Data)
37import Data.Data (Data)
32import Data.Foldable (traverse_)
38import Data.Foldable (traverse_)
33−import Data.Function (on)
34import Data.HashMap.Strict (HashMap)
39import Data.HashMap.Strict (HashMap)
35import qualified Data.HashMap.Strict as HashMap
40import qualified Data.HashMap.Strict as HashMap
36import "unordered-containers" Data.HashSet (HashSet)
41import "unordered-containers" Data.HashSet (HashSet)
37import qualified "unordered-containers" Data.HashSet as HashSet
42import qualified "unordered-containers" Data.HashSet as HashSet
38−import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
39import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
43import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
40import Data.Int
44import Data.Int
41import Data.IntSet (IntSet)
45import Data.IntSet (IntSet)
42import Data.IntMap (IntMap)
46import Data.IntMap (IntMap)
47+import Data.List.NonEmpty.Compat (NonEmpty)
43import Data.Map (Map)
48import Data.Map (Map)
44import Data.Proxy
49import Data.Proxy
45import Data.Scientific (Scientific)
50import Data.Scientific (Scientific)
51+import Data.Fixed (Fixed, HasResolution, Pico)
46import Data.Set (Set)
52import Data.Set (Set)
47import qualified Data.Text as T
53import qualified Data.Text as T
48import qualified Data.Text.Lazy as TL
54import qualified Data.Text.Lazy as TL
@@ -51,8 +57,11 @@ import qualified Data.Vector as V
51import qualified Data.Vector.Primitive as VP
57import qualified Data.Vector.Primitive as VP
52import qualified Data.Vector.Storable as VS
58import qualified Data.Vector.Storable as VS
53import qualified Data.Vector.Unboxed as VU
59import qualified Data.Vector.Unboxed as VU
60+import Data.Version (Version)
61+import Numeric.Natural.Compat (Natural)
54import Data.Word
62import Data.Word
55import GHC.Generics
63import GHC.Generics
64+import qualified Data.UUID.Types as UUID
57import Data.Swagger.Declare
66import Data.Swagger.Declare
58import Data.Swagger.Internal
67import Data.Swagger.Internal
@@ -60,9 +69,13 @@ import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
60import Data.Swagger.Lens hiding (name, schema)
69import Data.Swagger.Lens hiding (name, schema)
61import qualified Data.Swagger.Lens as Swagger
70import qualified Data.Swagger.Lens as Swagger
62import Data.Swagger.SchemaOptions
71import Data.Swagger.SchemaOptions
72+import Data.Swagger.Internal.TypeShape
64−#ifdef __DOCTEST__
74+#if __GLASGOW_HASKELL__ < 800
65−import Data.Swagger.Lens (name, schema)
75+#else
76+import qualified Data.ByteString as BS
77+import qualified Data.ByteString.Lazy as BSL
78+import GHC.TypeLits (TypeError, ErrorMessage(..))
68unnamed :: Schema -> NamedSchema
81unnamed :: Schema -> NamedSchema
@@ -89,14 +102,16 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
89-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' and 'HashMap' as lists
102-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' and 'HashMap' as lists
91-- import Control.Lens
104-- import Control.Lens
106+-- import Data.Swagger
93-- data Coord = Coord { x :: Double, y :: Double }
108-- data Coord = Coord { x :: Double, y :: Double }
95-- instance ToSchema Coord where
110-- instance ToSchema Coord where
96−-- declareNamedSchema = do
111+-- declareNamedSchema _ = do
97-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
112-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
98−-- return $ NamedSchema (Just \"Coord\")) $ mempty
113+-- return $ NamedSchema (Just \"Coord\") $ mempty
99−-- & type_ .~ SwaggerObject
114+-- & type_ ?~ SwaggerObject
100-- & properties .~
115-- & properties .~
101-- [ (\"x\", doubleSchema)
116-- [ (\"x\", doubleSchema)
102-- , (\"y\", doubleSchema)
117-- , (\"y\", doubleSchema)
@@ -127,12 +142,17 @@ class ToSchema a where
127 -- together with all used definitions.
142 -- together with all used definitions.
128 -- Note that the schema itself is included in definitions
143 -- Note that the schema itself is included in definitions
129 -- only if it is recursive (and thus needs its definition in scope).
144 -- only if it is recursive (and thus needs its definition in scope).
130− declareNamedSchema :: proxy a -> Declare (Definitions Schema) NamedSchema
145+ declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
146+ default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
131− default declareNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> Declare (Definitions Schema) NamedSchema
147+ Proxy a -> Declare (Definitions Schema) NamedSchema
132 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
150+instance ToSchema TimeOfDay where
151+ declareNamedSchema _ = pure $ named "TimeOfDay" $ timeSchema "hh:MM:ss"
152+ & example ?~ toJSON (TimeOfDay 12 33 15)
134-- | Convert a type into a schema and declare all used schema definitions.
154-- | Convert a type into a schema and declare all used schema definitions.
135−declareSchema :: ToSchema a => proxy a -> Declare (Definitions Schema) Schema
155+declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema
136declareSchema = fmap _namedSchemaSchema . declareNamedSchema
156declareSchema = fmap _namedSchemaSchema . declareNamedSchema
138-- | Convert a type into an optionally named schema.
158-- | Convert a type into an optionally named schema.
@@ -146,7 +166,7 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
146-- Just "Day"
166-- Just "Day"
147-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
167-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
148-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"
168-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"
149−toNamedSchema :: ToSchema a => proxy a -> NamedSchema
169+toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
150toNamedSchema = undeclare . declareNamedSchema
170toNamedSchema = undeclare . declareNamedSchema
152-- | Get type's schema name according to its @'ToSchema'@ instance.
172-- | Get type's schema name according to its @'ToSchema'@ instance.
@@ -156,7 +176,7 @@ toNamedSchema = undeclare . declareNamedSchema
157-- >>> schemaName (Proxy :: Proxy UTCTime)
177-- >>> schemaName (Proxy :: Proxy UTCTime)
158-- Just "UTCTime"
178-- Just "UTCTime"
159−schemaName :: ToSchema a => proxy a -> Maybe T.Text
179+schemaName :: ToSchema a => Proxy a -> Maybe T.Text
160schemaName = _namedSchemaName . toNamedSchema
180schemaName = _namedSchemaName . toNamedSchema
162-- | Convert a type into a schema.
182-- | Convert a type into a schema.
@@ -166,7 +186,7 @@ schemaName = _namedSchemaName . toNamedSchema
167-- >>> encode $ toSchema (Proxy :: Proxy [Day])
187-- >>> encode $ toSchema (Proxy :: Proxy [Day])
168-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
188-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
169−toSchema :: ToSchema a => proxy a -> Schema
189+toSchema :: ToSchema a => Proxy a -> Schema
170toSchema = _namedSchemaSchema . toNamedSchema
190toSchema = _namedSchemaSchema . toNamedSchema
172-- | Convert a type into a referenced schema if possible.
192-- | Convert a type into a referenced schema if possible.
@@ -177,7 +197,7 @@ toSchema = _namedSchemaSchema . toNamedSchema
178-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
198-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
179-- "{\"$ref\":\"#/definitions/Day\"}"
199-- "{\"$ref\":\"#/definitions/Day\"}"
180−toSchemaRef :: ToSchema a => proxy a -> Referenced Schema
200+toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
181toSchemaRef = undeclare . declareSchemaRef
201toSchemaRef = undeclare . declareSchemaRef
183-- | Convert a type into a referenced schema if possible
203-- | Convert a type into a referenced schema if possible
@@ -187,7 +207,7 @@ toSchemaRef = undeclare . declareSchemaRef
187-- Schema definitions are typically declared for every referenced schema.
207-- Schema definitions are typically declared for every referenced schema.
188-- If @'declareSchemaRef'@ returns a reference, a corresponding schema
208-- If @'declareSchemaRef'@ returns a reference, a corresponding schema
189-- will be declared (regardless of whether it is recusive or not).
209-- will be declared (regardless of whether it is recusive or not).
190−declareSchemaRef :: ToSchema a => proxy a -> Declare (Definitions Schema) (Referenced Schema)
210+declareSchemaRef :: ToSchema a => Proxy a -> Declare (Definitions Schema) (Referenced Schema)
191declareSchemaRef proxy = do
211declareSchemaRef proxy = do
192 case toNamedSchema proxy of
212 case toNamedSchema proxy of
193 NamedSchema (Just name) schema -> do
213 NamedSchema (Just name) schema -> do
@@ -249,7 +269,7 @@ inlineAllSchemas = inlineSchemasWhen (const True)
250-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
270-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
251-- when inlining recursive schemas.
271-- when inlining recursive schemas.
252−toInlinedSchema :: ToSchema a => proxy a -> Schema
272+toInlinedSchema :: ToSchema a => Proxy a -> Schema
253toInlinedSchema proxy = inlineAllSchemas defs schema
273toInlinedSchema proxy = inlineAllSchemas defs schema
255 (defs, schema) = runDeclare (declareSchema proxy) mempty
275 (defs, schema) = runDeclare (declareSchema proxy) mempty
@@ -278,20 +298,20 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
278-- | Default schema for binary data (any sequence of octets).
298-- | Default schema for binary data (any sequence of octets).
279binarySchema :: Schema
299binarySchema :: Schema
280binarySchema = mempty
300binarySchema = mempty
281− & type_ .~ SwaggerString
301+ & type_ ?~ SwaggerString
282 & format ?~ "binary"
302 & format ?~ "binary"
284-- | Default schema for binary data (base64 encoded).
304-- | Default schema for binary data (base64 encoded).
285byteSchema :: Schema
305byteSchema :: Schema
286byteSchema = mempty
306byteSchema = mempty
287− & type_ .~ SwaggerString
307+ & type_ ?~ SwaggerString
288 & format ?~ "byte"
308 & format ?~ "byte"
290-- | Default schema for password string.
310-- | Default schema for password string.
291-- @"password"@ format is used to hint UIs the input needs to be obscured.
311-- @"password"@ format is used to hint UIs the input needs to be obscured.
292passwordSchema :: Schema
312passwordSchema :: Schema
293passwordSchema = mempty
313passwordSchema = mempty
294− & type_ .~ SwaggerString
314+ & type_ ?~ SwaggerString
295 & format ?~ "password"
315 & format ?~ "password"
297-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
317-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
@@ -317,12 +337,12 @@ sketchSchema = sketch . toJSON
317 sketch js@(Bool _) = go js
337 sketch js@(Bool _) = go js
318 sketch js = go js & example ?~ js
338 sketch js = go js & example ?~ js
320− go Null = mempty & type_ .~ SwaggerNull
340+ go Null = mempty & type_ ?~ SwaggerNull
321− go js@(Bool _) = mempty & type_ .~ SwaggerBoolean
341+ go (Bool _) = mempty & type_ ?~ SwaggerBoolean
322− go js@(String s) = mempty & type_ .~ SwaggerString
342+ go (String _) = mempty & type_ ?~ SwaggerString
323− go js@(Number n) = mempty & type_ .~ SwaggerNumber
343+ go (Number _) = mempty & type_ ?~ SwaggerNumber
324− go js@(Array xs) = mempty
344+ go (Array xs) = mempty
325− & type_ .~ SwaggerArray
345+ & type_ ?~ SwaggerArray
326 & items ?~ case ischema of
346 & items ?~ case ischema of
327 Just s -> SwaggerItemsObject (Inline s)
347 Just s -> SwaggerItemsObject (Inline s)
328 _ -> SwaggerItemsArray (map Inline ys)
348 _ -> SwaggerItemsArray (map Inline ys)
@@ -331,10 +351,10 @@ sketchSchema = sketch . toJSON
331 allSame = and ((zipWith (==)) ys (tail ys))
351 allSame = and ((zipWith (==)) ys (tail ys))
333 ischema = case ys of
353 ischema = case ys of
334− (z:zs) | allSame -> Just z
354+ (z:_) | allSame -> Just z
335− _ -> Nothing
355+ _ -> Nothing
336− go js@(Object o) = mempty
356+ go (Object o) = mempty
337− & type_ .~ SwaggerObject
357+ & type_ ?~ SwaggerObject
338 & required .~ HashMap.keys o
358 & required .~ HashMap.keys o
339 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
359 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
@@ -357,24 +377,24 @@ sketchSchema = sketch . toJSON
357sketchStrictSchema :: ToJSON a => a -> Schema
377sketchStrictSchema :: ToJSON a => a -> Schema
358sketchStrictSchema = go . toJSON
378sketchStrictSchema = go . toJSON
360− go Null = mempty & type_ .~ SwaggerNull
380+ go Null = mempty & type_ ?~ SwaggerNull
361 go js@(Bool _) = mempty
381 go js@(Bool _) = mempty
362− & type_ .~ SwaggerBoolean
382+ & type_ ?~ SwaggerBoolean
363 & enum_ ?~ [js]
383 & enum_ ?~ [js]
364 go js@(String s) = mempty
384 go js@(String s) = mempty
365− & type_ .~ SwaggerString
385+ & type_ ?~ SwaggerString
366 & maxLength ?~ fromIntegral (T.length s)
386 & maxLength ?~ fromIntegral (T.length s)
367 & minLength ?~ fromIntegral (T.length s)
387 & minLength ?~ fromIntegral (T.length s)
368 & pattern ?~ s
388 & pattern ?~ s
369 & enum_ ?~ [js]
389 & enum_ ?~ [js]
370 go js@(Number n) = mempty
390 go js@(Number n) = mempty
371− & type_ .~ SwaggerNumber
391+ & type_ ?~ SwaggerNumber
372 & maximum_ ?~ n
392 & maximum_ ?~ n
373 & minimum_ ?~ n
393 & minimum_ ?~ n
374 & multipleOf ?~ n
394 & multipleOf ?~ n
375 & enum_ ?~ [js]
395 & enum_ ?~ [js]
376 go js@(Array xs) = mempty
396 go js@(Array xs) = mempty
377− & type_ .~ SwaggerArray
397+ & type_ ?~ SwaggerArray
378 & maxItems ?~ fromIntegral sz
398 & maxItems ?~ fromIntegral sz
379 & minItems ?~ fromIntegral sz
399 & minItems ?~ fromIntegral sz
380 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
400 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
@@ -384,7 +404,7 @@ sketchStrictSchema = go . toJSON
384 sz = length xs
404 sz = length xs
385 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
405 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
386 go js@(Object o) = mempty
406 go js@(Object o) = mempty
387− & type_ .~ SwaggerObject
407+ & type_ ?~ SwaggerObject
388 & required .~ names
408 & required .~ names
389 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
409 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
390 & maxProperties ?~ fromIntegral (length names)
410 & maxProperties ?~ fromIntegral (length names)
@@ -394,18 +414,19 @@ sketchStrictSchema = go . toJSON
394 names = HashMap.keys o
414 names = HashMap.keys o
396class GToSchema (f :: * -> *) where
416class GToSchema (f :: * -> *) where
397− gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
417+ gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
399instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
419instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
400 declareNamedSchema _ = do
420 declareNamedSchema _ = do
401 ref <- declareSchemaRef (Proxy :: Proxy a)
421 ref <- declareSchemaRef (Proxy :: Proxy a)
402 return $ unnamed $ mempty
422 return $ unnamed $ mempty
403− & type_ .~ SwaggerArray
423+ & type_ ?~ SwaggerArray
404 & items ?~ SwaggerItemsObject ref
424 & items ?~ SwaggerItemsObject ref
406instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
426instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
407instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
427instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
408instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
428instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
429+instance ToSchema Natural where declareNamedSchema = plain . paramSchemaToSchema
409instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
430instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
410instance ToSchema Int8 where declareNamedSchema = plain . paramSchemaToSchema
431instance ToSchema Int8 where declareNamedSchema = plain . paramSchemaToSchema
411instance ToSchema Int16 where declareNamedSchema = plain . paramSchemaToSchema
432instance ToSchema Int16 where declareNamedSchema = plain . paramSchemaToSchema
@@ -425,6 +446,8 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
425instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
446instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
426instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
447instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
449+instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
428instance ToSchema a => ToSchema (Maybe a) where
451instance ToSchema a => ToSchema (Maybe a) where
429 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
452 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -433,6 +456,11 @@ instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
433instance ToSchema () where
456instance ToSchema () where
434 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
457 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
459+-- | For 'ToJSON' instance, see <http://hackage.haskell.org/package/uuid-aeson uuid-aeson> package.
460+instance ToSchema UUID.UUID where
461+ declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
462+ & example ?~ toJSON (UUID.toText UUID.nil)
436instance (ToSchema a, ToSchema b) => ToSchema (a, b)
464instance (ToSchema a, ToSchema b) => ToSchema (a, b)
437instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
465instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
438instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
466instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
@@ -442,7 +470,7 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f
443timeSchema :: T.Text -> Schema
471timeSchema :: T.Text -> Schema
444timeSchema fmt = mempty
472timeSchema fmt = mempty
445− & type_ .~ SwaggerString
473+ & type_ ?~ SwaggerString
446 & format ?~ fmt
474 & format ?~ fmt
448-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
476-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -463,7 +491,7 @@ instance ToSchema ZonedTime where
463 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
491 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
465instance ToSchema NominalDiffTime where
493instance ToSchema NominalDiffTime where
466− declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Integer)
494+ declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Pico)
469-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format
497-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format
@@ -475,6 +503,20 @@ instance ToSchema UTCTime where
475instance ToSchema T.Text where declareNamedSchema = plain . paramSchemaToSchema
503instance ToSchema T.Text where declareNamedSchema = plain . paramSchemaToSchema
476instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema
504instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema
506+instance ToSchema Version where declareNamedSchema = plain . paramSchemaToSchema
508+#if __GLASGOW_HASKELL__ < 800
510+type family ToSchemaByteStringError bs where
511+ ToSchemaByteStringError bs = TypeError
512+ ( Text "Impossible to have an instance " :<>: ShowType (ToSchema bs) :<>: Text "."
513+ :$$: Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
514+ :$$: Text "Consider using byteSchema or binarySchema templates." )
516+instance ToSchemaByteStringError BS.ByteString => ToSchema BS.ByteString where declareNamedSchema = error "impossible"
517+instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where declareNamedSchema = error "impossible"
478instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
520instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
480-- | NOTE: This schema does not account for the uniqueness of keys.
522-- | NOTE: This schema does not account for the uniqueness of keys.
@@ -482,12 +524,27 @@ instance ToSchema a => ToSchema (IntMap a) where
482 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
524 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
484#if MIN_VERSION_aeson(1,0,0)
526#if MIN_VERSION_aeson(1,0,0)
527+instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
528+ declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of
529+ ToJSONKeyText _ _ -> declareObjectMapSchema
530+ ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])
532+ declareObjectMapSchema = do
533+ schema <- declareSchemaRef (Proxy :: Proxy v)
534+ return $ unnamed $ mempty
535+ & type_ ?~ SwaggerObject
536+ & additionalProperties ?~ AdditionalPropertiesSchema schema
538+instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
539+ declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
486instance ToSchema a => ToSchema (Map String a) where
543instance ToSchema a => ToSchema (Map String a) where
487 declareNamedSchema _ = do
544 declareNamedSchema _ = do
488 schema <- declareSchemaRef (Proxy :: Proxy a)
545 schema <- declareSchemaRef (Proxy :: Proxy a)
489 return $ unnamed $ mempty
546 return $ unnamed $ mempty
490− & type_ .~ SwaggerObject
547+ & type_ ?~ SwaggerObject
491 & additionalProperties ?~ schema
548 & additionalProperties ?~ schema
493instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
550instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
@@ -497,24 +554,14 @@ instance ToSchema a => ToSchema (HashMap String a) where declareNamedSchema _ =
497instance ToSchema a => ToSchema (HashMap T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
554instance ToSchema a => ToSchema (HashMap T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
498instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
555instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
502−instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
503− declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction v of
504− ToJSONKeyText _ _ -> declareObjectMapSchema
505− ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])
507− declareObjectMapSchema = do
508− schema <- declareSchemaRef (Proxy :: Proxy v)
509− return $ unnamed $ mempty
510− & type_ .~ SwaggerObject
511− & additionalProperties ?~ schema
513−instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
514− declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
559+instance OVERLAPPING_ ToSchema Object where
560+ declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
561+ & type_ ?~ SwaggerObject
562+ & description ?~ "Arbitrary JSON object."
563+ & additionalProperties ?~ AdditionalPropertiesAllowed True
518instance ToSchema a => ToSchema (V.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
565instance ToSchema a => ToSchema (V.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
519instance ToSchema a => ToSchema (VU.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
566instance ToSchema a => ToSchema (VU.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
520instance ToSchema a => ToSchema (VS.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
567instance ToSchema a => ToSchema (VS.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
@@ -528,6 +575,13 @@ instance ToSchema a => ToSchema (Set a) where
529instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
576instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
579+instance ToSchema a => ToSchema (NonEmpty a) where
580+ declareNamedSchema _ = do
581+ schema <- declareSchema (Proxy :: Proxy [a])
582+ return $ unnamed $ schema
583+ & minItems .~ Just 1
531instance ToSchema All where declareNamedSchema = plain . paramSchemaToSchema
585instance ToSchema All where declareNamedSchema = plain . paramSchemaToSchema
532instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema
586instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema
@@ -537,61 +591,141 @@ instance ToSchema a => ToSchema (First a) where declareNamedSchema _ = unname
537instance ToSchema a => ToSchema (Last a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
591instance ToSchema a => ToSchema (Last a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
538instance ToSchema a => ToSchema (Dual a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
592instance ToSchema a => ToSchema (Dual a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
594+instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
540-- | Default schema for @'Bounded'@, @'Integral'@ types.
596-- | Default schema for @'Bounded'@, @'Integral'@ types.
542-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
598-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
543-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
599-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
544−toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
600+toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
545toSchemaBoundedIntegral _ = mempty
601toSchemaBoundedIntegral _ = mempty
546− & type_ .~ SwaggerInteger
602+ & type_ ?~ SwaggerInteger
547 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
603 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
548 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
604 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
550-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
606-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
551−genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
607+genericToNamedSchemaBoundedIntegral :: forall a d f.
552 ( Bounded a, Integral a
608 ( Bounded a, Integral a
553 , Generic a, Rep a ~ D1 d f, Datatype d)
609 , Generic a, Rep a ~ D1 d f, Datatype d)
554− => SchemaOptions -> proxy a -> NamedSchema
610+ => SchemaOptions -> Proxy a -> NamedSchema
555genericToNamedSchemaBoundedIntegral opts proxy
611genericToNamedSchemaBoundedIntegral opts proxy
556− = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d)) (toSchemaBoundedIntegral proxy)
612+ = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)
614+-- | Declare a named schema for a @newtype@ wrapper.
615+genericDeclareNamedSchemaNewtype :: forall a d c s i inner.
616+ (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))
617+ => SchemaOptions -- ^ How to derive the name.
618+ -> (Proxy inner -> Declare (Definitions Schema) Schema) -- ^ How to create a schema for the wrapped type.
620+ -> Declare (Definitions Schema) NamedSchema
621+genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$> f (Proxy :: Proxy inner)
623+-- | Declare 'Schema' for a mapping with 'Bounded' 'Enum' keys.
624+-- This makes a much more useful schema when there aren't many options for key values.
626+-- >>> data ButtonState = Neutral | Focus | Active | Hover | Disabled deriving (Show, Bounded, Enum, Generic)
627+-- >>> instance ToJSON ButtonState
628+-- >>> instance ToSchema ButtonState
629+-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
630+-- >>> type ImageUrl = T.Text
631+-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
632+-- "{\"properties\":{\"Neutral\":{\"type\":\"string\"},\"Focus\":{\"type\":\"string\"},\"Active\":{\"type\":\"string\"},\"Hover\":{\"type\":\"string\"},\"Disabled\":{\"type\":\"string\"}},\"type\":\"object\"}"
634+-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
635+-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
636+declareSchemaBoundedEnumKeyMapping :: forall map key value.
637+ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
638+ => Proxy (map key value) -> Declare (Definitions Schema) Schema
639+declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
640+ ToJSONKeyText keyToText _ -> objectSchema keyToText
641+ ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
643+ objectSchema keyToText = do
644+ valueRef <- declareSchemaRef (Proxy :: Proxy value)
645+ let allKeys = [minBound..maxBound :: key]
646+ mkPair k = (keyToText k, valueRef)
648+ & type_ ?~ SwaggerObject
649+ & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
651+-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
652+-- This makes a much more useful schema when there aren't many options for key values.
654+-- >>> data ButtonState = Neutral | Focus | Active | Hover | Disabled deriving (Show, Bounded, Enum, Generic)
655+-- >>> instance ToJSON ButtonState
656+-- >>> instance ToSchema ButtonState
657+-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
658+-- >>> type ImageUrl = T.Text
659+-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
660+-- "{\"properties\":{\"Neutral\":{\"type\":\"string\"},\"Focus\":{\"type\":\"string\"},\"Active\":{\"type\":\"string\"},\"Hover\":{\"type\":\"string\"},\"Disabled\":{\"type\":\"string\"}},\"type\":\"object\"}"
662+-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
663+-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
664+toSchemaBoundedEnumKeyMapping :: forall map key value.
665+ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
666+ => Proxy (map key value) -> Schema
667+toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
558-- | A configurable generic @'Schema'@ creator.
669-- | A configurable generic @'Schema'@ creator.
670+genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
559−genericDeclareSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema
671+ SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
560−genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
672+genericDeclareSchema = genericDeclareSchemaUnrestricted
562-- | A configurable generic @'NamedSchema'@ creator.
674-- | A configurable generic @'NamedSchema'@ creator.
563-- This function applied to @'defaultSchemaOptions'@
675-- This function applied to @'defaultSchemaOptions'@
564-- is used as the default for @'declareNamedSchema'@
676-- is used as the default for @'declareNamedSchema'@
565-- when the type is an instance of @'Generic'@.
677-- when the type is an instance of @'Generic'@.
678+genericDeclareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
679+ SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
680+genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted
682+-- | A configurable generic @'Schema'@ creator.
684+-- Unlike 'genericDeclareSchema' also works for mixed sum types.
685+-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
566−genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema
686+genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
687+genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy
689+-- | A configurable generic @'NamedSchema'@ creator.
691+-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.
692+-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
693+genericDeclareNamedSchemaUnrestricted :: forall a. (Generic a, GToSchema (Rep a)) =>
694+ SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
567−genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
695+genericDeclareNamedSchemaUnrestricted opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
697+-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
698+genericNameSchema :: forall a d f.
699+ (Generic a, Rep a ~ D1 d f, Datatype d)
700+ => SchemaOptions -> Proxy a -> Schema -> NamedSchema
701+genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d))
569−gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text
703+gdatatypeSchemaName :: forall d. Datatype d => SchemaOptions -> Proxy d -> Maybe T.Text
570−gdatatypeSchemaName opts _ = case name of
704+gdatatypeSchemaName opts _ = case orig of
571 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
705 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
572 _ -> Nothing
706 _ -> Nothing
574− name = datatypeNameModifier opts (datatypeName (Proxy3 :: Proxy3 d f a))
708+ orig = datatypeName (Proxy3 :: Proxy3 d f a)
709+ name = datatypeNameModifier opts orig
576-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
711-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
577−paramSchemaToNamedSchema :: forall a d f proxy.
578− (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d)
712+paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
579− => SchemaOptions -> proxy a -> NamedSchema
713+ SchemaOptions -> Proxy a -> NamedSchema
580−paramSchemaToNamedSchema opts proxy = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d)) (paramSchemaToSchema proxy)
714+paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
582-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
716-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
583−paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> Schema
717+paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
584−paramSchemaToSchema _ = mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a)
718+paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
586nullarySchema :: Schema
720nullarySchema :: Schema
587nullarySchema = mempty
721nullarySchema = mempty
588− & type_ .~ SwaggerArray
722+ & type_ ?~ SwaggerArray
589 & items ?~ SwaggerItemsArray []
723 & items ?~ SwaggerItemsArray []
591−gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema
725+gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
592gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
726gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
594−gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare (Definitions Schema) Schema
728+gdeclareSchema :: GToSchema f => SchemaOptions -> Proxy f -> Declare (Definitions Schema) Schema
595gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty
729gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty
597instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
731instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
@@ -611,7 +745,7 @@ instance OVERLAPPING_ Constructor c => GToSchema (C1 c U1) where
611 gdeclareNamedSchema = gdeclareNamedSumSchema
745 gdeclareNamedSchema = gdeclareNamedSumSchema
613-- | Single field constructor.
747-- | Single field constructor.
614−instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where
748+instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s f)) where
615 gdeclareNamedSchema opts _ s
749 gdeclareNamedSchema opts _ s
616 | unwrapUnaryRecords opts = fieldSchema
750 | unwrapUnaryRecords opts = fieldSchema
617 | otherwise =
751 | otherwise =
@@ -625,7 +759,7 @@ instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where
625 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
759 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
626 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
760 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
628−gdeclareSchemaRef :: GToSchema a => SchemaOptions -> proxy a -> Declare (Definitions Schema) (Referenced Schema)
762+gdeclareSchemaRef :: GToSchema a => SchemaOptions -> Proxy a -> Declare (Definitions Schema) (Referenced Schema)
629gdeclareSchemaRef opts proxy = do
763gdeclareSchemaRef opts proxy = do
630 case gtoNamedSchema opts proxy of
764 case gtoNamedSchema opts proxy of
631 NamedSchema (Just name) schema -> do
765 NamedSchema (Just name) schema -> do
@@ -644,7 +778,7 @@ gdeclareSchemaRef opts proxy = do
644 return $ Ref (Reference name)
778 return $ Ref (Reference name)
645 _ -> Inline <$> gdeclareSchema opts proxy
779 _ -> Inline <$> gdeclareSchema opts proxy
647−appendItem :: Referenced Schema -> Maybe (SwaggerItems SwaggerKindSchema) -> Maybe (SwaggerItems SwaggerKindSchema)
781+appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema)
648appendItem x Nothing = Just (SwaggerItemsArray [x])
782appendItem x Nothing = Just (SwaggerItemsArray [x])
649appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
783appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
650appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
784appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
@@ -656,10 +790,12 @@ withFieldSchema opts _ isRequiredField schema = do
657 if T.null fname
791 if T.null fname
658 then schema
792 then schema
659− & type_ .~ SwaggerArray
793+ & type_ ?~ SwaggerArray
660 & items %~ appendItem ref
794 & items %~ appendItem ref
795+ & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
796+ & minItems %~ Just . maybe 1 (+1) -- increment minItems
661 else schema
797 else schema
662− & type_ .~ SwaggerObject
798+ & type_ ?~ SwaggerObject
663 & properties . at fname ?~ ref
799 & properties . at fname ?~ ref
664 & if isRequiredField
800 & if isRequiredField
665 then required %~ (++ [fname])
801 then required %~ (++ [fname])
@@ -681,10 +817,13 @@ instance OVERLAPPING_ ToSchema c => GToSchema (K1 i (Maybe c)) where
681instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where
817instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where
682 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
818 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
684−instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
820+instance ( GSumToSchema f
822+ ) => GToSchema (f :+: g)
685 gdeclareNamedSchema = gdeclareNamedSumSchema
824 gdeclareNamedSchema = gdeclareNamedSumSchema
687−gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
826+gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
688gdeclareNamedSumSchema opts proxy s
827gdeclareNamedSumSchema opts proxy s
689 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
828 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
690 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
829 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
@@ -693,29 +832,29 @@ gdeclareNamedSumSchema opts proxy s
693 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
832 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
695 toStringTag schema = mempty
834 toStringTag schema = mempty
696− & type_ .~ SwaggerString
835+ & type_ ?~ SwaggerString
697 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
836 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
699type AllNullary = All
838type AllNullary = All
701−class GSumToSchema f where
840+class GSumToSchema (f :: * -> *) where
702− gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
841+ gsumToSchema :: SchemaOptions -> Proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
704instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
843instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
705 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
844 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
707−gsumConToSchemaWith :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
846+gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
708− Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema
847+ Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
709gsumConToSchemaWith ref opts _ schema = schema
848gsumConToSchemaWith ref opts _ schema = schema
710− & type_ .~ SwaggerObject
849+ & type_ ?~ SwaggerObject
711 & properties . at tag ?~ ref
850 & properties . at tag ?~ ref
712 & maxProperties ?~ 1
851 & maxProperties ?~ 1
713 & minProperties ?~ 1
852 & minProperties ?~ 1
715 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
854 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
717−gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
856+gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
718− SchemaOptions -> proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
857+ SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
719gsumConToSchema opts proxy schema = do
858gsumConToSchema opts proxy schema = do
720 ref <- gdeclareSchemaRef opts proxy
859 ref <- gdeclareSchemaRef opts proxy
721 return $ gsumConToSchemaWith ref opts proxy schema
860 return $ gsumConToSchemaWith ref opts proxy schema
@@ -737,3 +876,7 @@ data Proxy2 a b = Proxy2
738data Proxy3 a b c = Proxy3
877data Proxy3 a b c = Proxy3
880+-- >>> import Data.Swagger
881+-- >>> import Data.Aeson (encode)
882+-- >>> import Data.Aeson.Types (toJSONKeyText)