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