@@ -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,25 +51,17 @@ 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
68import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
59import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
69import Data.Swagger.Lens hiding (name, schema)
60import Data.Swagger.Lens hiding (name, schema)
70−import qualified Data.Swagger.Lens as Swagger
71import Data.Swagger.SchemaOptions
61import Data.Swagger.SchemaOptions
72−import Data.Swagger.Internal.TypeShape
74−#if __GLASGOW_HASKELL__ < 800
63+#ifdef __DOCTEST__
75−#else
64+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
67unnamed :: Schema -> NamedSchema
@@ -102,16 +88,14 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
102-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' and 'HashMap' as lists
88-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' and 'HashMap' as lists
104-- import Control.Lens
90-- import Control.Lens
106−-- import Data.Swagger
108-- data Coord = Coord { x :: Double, y :: Double }
92-- data Coord = Coord { x :: Double, y :: Double }
110-- instance ToSchema Coord where
94-- instance ToSchema Coord where
111−-- declareNamedSchema _ = do
95+-- declareNamedSchema = do
112-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
96-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
113−-- return $ NamedSchema (Just \"Coord\") $ mempty
97+-- return $ NamedSchema (Just \"Coord\")) $ mempty
114−-- & type_ ?~ SwaggerObject
98+-- & type_ .~ SwaggerObject
115-- & properties .~
99-- & properties .~
116-- [ (\"x\", doubleSchema)
100-- [ (\"x\", doubleSchema)
117-- , (\"y\", doubleSchema)
101-- , (\"y\", doubleSchema)
@@ -142,17 +126,12 @@ class ToSchema a where
142 -- together with all used definitions.
126 -- together with all used definitions.
143 -- Note that the schema itself is included in definitions
127 -- Note that the schema itself is included in definitions
144 -- only if it is recursive (and thus needs its definition in scope).
128 -- only if it is recursive (and thus needs its definition in scope).
145− declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
129+ 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
130+ default declareNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> Declare (Definitions Schema) NamedSchema
148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
131 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.
133-- | Convert a type into a schema and declare all used schema definitions.
155−declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema
134+declareSchema :: ToSchema a => proxy a -> Declare (Definitions Schema) Schema
156declareSchema = fmap _namedSchemaSchema . declareNamedSchema
135declareSchema = fmap _namedSchemaSchema . declareNamedSchema
158-- | Convert a type into an optionally named schema.
137-- | Convert a type into an optionally named schema.
@@ -165,8 +144,8 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
165-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
144-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
166-- Just "Day"
145-- Just "Day"
167-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
146-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
168−-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"
147+-- "{\"format\":\"date\",\"type\":\"string\"}"
169−toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
148+toNamedSchema :: ToSchema a => proxy a -> NamedSchema
170toNamedSchema = undeclare . declareNamedSchema
149toNamedSchema = undeclare . declareNamedSchema
172-- | Get type's schema name according to its @'ToSchema'@ instance.
151-- | Get type's schema name according to its @'ToSchema'@ instance.
@@ -176,7 +155,7 @@ toNamedSchema = undeclare . declareNamedSchema
177-- >>> schemaName (Proxy :: Proxy UTCTime)
156-- >>> schemaName (Proxy :: Proxy UTCTime)
178-- Just "UTCTime"
157-- Just "UTCTime"
179−schemaName :: ToSchema a => Proxy a -> Maybe T.Text
158+schemaName :: ToSchema a => proxy a -> Maybe T.Text
180schemaName = _namedSchemaName . toNamedSchema
159schemaName = _namedSchemaName . toNamedSchema
182-- | Convert a type into a schema.
161-- | Convert a type into a schema.
@@ -186,7 +165,7 @@ schemaName = _namedSchemaName . toNamedSchema
187-- >>> encode $ toSchema (Proxy :: Proxy [Day])
166-- >>> encode $ toSchema (Proxy :: Proxy [Day])
188-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
167-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
189−toSchema :: ToSchema a => Proxy a -> Schema
168+toSchema :: ToSchema a => proxy a -> Schema
190toSchema = _namedSchemaSchema . toNamedSchema
169toSchema = _namedSchemaSchema . toNamedSchema
192-- | Convert a type into a referenced schema if possible.
171-- | Convert a type into a referenced schema if possible.
@@ -197,7 +176,7 @@ toSchema = _namedSchemaSchema . toNamedSchema
198-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
177-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
199-- "{\"$ref\":\"#/definitions/Day\"}"
178-- "{\"$ref\":\"#/definitions/Day\"}"
200−toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
179+toSchemaRef :: ToSchema a => proxy a -> Referenced Schema
201toSchemaRef = undeclare . declareSchemaRef
180toSchemaRef = undeclare . declareSchemaRef
203-- | Convert a type into a referenced schema if possible
182-- | Convert a type into a referenced schema if possible
@@ -207,7 +186,7 @@ toSchemaRef = undeclare . declareSchemaRef
207-- Schema definitions are typically declared for every referenced schema.
186-- Schema definitions are typically declared for every referenced schema.
208-- If @'declareSchemaRef'@ returns a reference, a corresponding schema
187-- If @'declareSchemaRef'@ returns a reference, a corresponding schema
209-- will be declared (regardless of whether it is recusive or not).
188-- will be declared (regardless of whether it is recusive or not).
210−declareSchemaRef :: ToSchema a => Proxy a -> Declare (Definitions Schema) (Referenced Schema)
189+declareSchemaRef :: ToSchema a => proxy a -> Declare (Definitions Schema) (Referenced Schema)
211declareSchemaRef proxy = do
190declareSchemaRef proxy = do
212 case toNamedSchema proxy of
191 case toNamedSchema proxy of
213 NamedSchema (Just name) schema -> do
192 NamedSchema (Just name) schema -> do
@@ -265,11 +244,11 @@ inlineAllSchemas = inlineSchemasWhen (const True)
265-- | Convert a type into a schema without references.
244-- | Convert a type into a schema without references.
267-- >>> encode $ toInlinedSchema (Proxy :: Proxy [Day])
246-- >>> encode $ toInlinedSchema (Proxy :: Proxy [Day])
268−-- "{\"items\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"},\"type\":\"array\"}"
247+-- "{\"items\":{\"format\":\"date\",\"type\":\"string\"},\"type\":\"array\"}"
270-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
249-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
271-- when inlining recursive schemas.
250-- when inlining recursive schemas.
272−toInlinedSchema :: ToSchema a => Proxy a -> Schema
251+toInlinedSchema :: ToSchema a => proxy a -> Schema
273toInlinedSchema proxy = inlineAllSchemas defs schema
252toInlinedSchema proxy = inlineAllSchemas defs schema
275 (defs, schema) = runDeclare (declareSchema proxy) mempty
254 (defs, schema) = runDeclare (declareSchema proxy) mempty
@@ -298,20 +277,20 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
298-- | Default schema for binary data (any sequence of octets).
277-- | Default schema for binary data (any sequence of octets).
299binarySchema :: Schema
278binarySchema :: Schema
300binarySchema = mempty
279binarySchema = mempty
301− & type_ ?~ SwaggerString
280+ & type_ .~ SwaggerString
302 & format ?~ "binary"
281 & format ?~ "binary"
304-- | Default schema for binary data (base64 encoded).
283-- | Default schema for binary data (base64 encoded).
305byteSchema :: Schema
284byteSchema :: Schema
306byteSchema = mempty
285byteSchema = mempty
307− & type_ ?~ SwaggerString
286+ & type_ .~ SwaggerString
308 & format ?~ "byte"
287 & format ?~ "byte"
310-- | Default schema for password string.
289-- | Default schema for password string.
311-- @"password"@ format is used to hint UIs the input needs to be obscured.
290-- @"password"@ format is used to hint UIs the input needs to be obscured.
312passwordSchema :: Schema
291passwordSchema :: Schema
313passwordSchema = mempty
292passwordSchema = mempty
314− & type_ ?~ SwaggerString
293+ & type_ .~ SwaggerString
315 & format ?~ "password"
294 & format ?~ "password"
317-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
296-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
@@ -337,12 +316,12 @@ sketchSchema = sketch . toJSON
337 sketch js@(Bool _) = go js
316 sketch js@(Bool _) = go js
338 sketch js = go js & example ?~ js
317 sketch js = go js & example ?~ js
340− go Null = mempty & type_ ?~ SwaggerNull
319+ go Null = mempty & type_ .~ SwaggerNull
341− go (Bool _) = mempty & type_ ?~ SwaggerBoolean
320+ go js@(Bool _) = mempty & type_ .~ SwaggerBoolean
342− go (String _) = mempty & type_ ?~ SwaggerString
321+ go js@(String s) = mempty & type_ .~ SwaggerString
343− go (Number _) = mempty & type_ ?~ SwaggerNumber
322+ go js@(Number n) = mempty & type_ .~ SwaggerNumber
344− go (Array xs) = mempty
323+ go js@(Array xs) = mempty
345− & type_ ?~ SwaggerArray
324+ & type_ .~ SwaggerArray
346 & items ?~ case ischema of
325 & items ?~ case ischema of
347 Just s -> SwaggerItemsObject (Inline s)
326 Just s -> SwaggerItemsObject (Inline s)
348 _ -> SwaggerItemsArray (map Inline ys)
327 _ -> SwaggerItemsArray (map Inline ys)
@@ -351,10 +330,10 @@ sketchSchema = sketch . toJSON
351 allSame = and ((zipWith (==)) ys (tail ys))
330 allSame = and ((zipWith (==)) ys (tail ys))
353 ischema = case ys of
332 ischema = case ys of
354− (z:_) | allSame -> Just z
333+ (z:zs) | allSame -> Just z
355− _ -> Nothing
334+ _ -> Nothing
356− go (Object o) = mempty
335+ go js@(Object o) = mempty
357− & type_ ?~ SwaggerObject
336+ & type_ .~ SwaggerObject
358 & required .~ HashMap.keys o
337 & required .~ HashMap.keys o
359 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
338 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
@@ -377,24 +356,24 @@ sketchSchema = sketch . toJSON
377sketchStrictSchema :: ToJSON a => a -> Schema
356sketchStrictSchema :: ToJSON a => a -> Schema
378sketchStrictSchema = go . toJSON
357sketchStrictSchema = go . toJSON
380− go Null = mempty & type_ ?~ SwaggerNull
359+ go Null = mempty & type_ .~ SwaggerNull
381 go js@(Bool _) = mempty
360 go js@(Bool _) = mempty
382− & type_ ?~ SwaggerBoolean
361+ & type_ .~ SwaggerBoolean
383 & enum_ ?~ [js]
362 & enum_ ?~ [js]
384 go js@(String s) = mempty
363 go js@(String s) = mempty
385− & type_ ?~ SwaggerString
364+ & type_ .~ SwaggerString
386 & maxLength ?~ fromIntegral (T.length s)
365 & maxLength ?~ fromIntegral (T.length s)
387 & minLength ?~ fromIntegral (T.length s)
366 & minLength ?~ fromIntegral (T.length s)
388 & pattern ?~ s
367 & pattern ?~ s
389 & enum_ ?~ [js]
368 & enum_ ?~ [js]
390 go js@(Number n) = mempty
369 go js@(Number n) = mempty
391− & type_ ?~ SwaggerNumber
370+ & type_ .~ SwaggerNumber
392 & maximum_ ?~ n
371 & maximum_ ?~ n
393 & minimum_ ?~ n
372 & minimum_ ?~ n
394 & multipleOf ?~ n
373 & multipleOf ?~ n
395 & enum_ ?~ [js]
374 & enum_ ?~ [js]
396 go js@(Array xs) = mempty
375 go js@(Array xs) = mempty
397− & type_ ?~ SwaggerArray
376+ & type_ .~ SwaggerArray
398 & maxItems ?~ fromIntegral sz
377 & maxItems ?~ fromIntegral sz
399 & minItems ?~ fromIntegral sz
378 & minItems ?~ fromIntegral sz
400 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
379 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
@@ -404,7 +383,7 @@ sketchStrictSchema = go . toJSON
404 sz = length xs
383 sz = length xs
405 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
384 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
406 go js@(Object o) = mempty
385 go js@(Object o) = mempty
407− & type_ ?~ SwaggerObject
386+ & type_ .~ SwaggerObject
408 & required .~ names
387 & required .~ names
409 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
388 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
410 & maxProperties ?~ fromIntegral (length names)
389 & maxProperties ?~ fromIntegral (length names)
@@ -414,19 +393,18 @@ sketchStrictSchema = go . toJSON
414 names = HashMap.keys o
393 names = HashMap.keys o
416class GToSchema (f :: * -> *) where
395class GToSchema (f :: * -> *) where
417− gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
396+ gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
419instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
398instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
420 declareNamedSchema _ = do
399 declareNamedSchema _ = do
421 ref <- declareSchemaRef (Proxy :: Proxy a)
400 ref <- declareSchemaRef (Proxy :: Proxy a)
422 return $ unnamed $ mempty
401 return $ unnamed $ mempty
423− & type_ ?~ SwaggerArray
402+ & type_ .~ SwaggerArray
424 & items ?~ SwaggerItemsObject ref
403 & items ?~ SwaggerItemsObject ref
426instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
405instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
427instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
406instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
428instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
407instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
429−instance ToSchema Natural where declareNamedSchema = plain . paramSchemaToSchema
430instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
408instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
431instance ToSchema Int8 where declareNamedSchema = plain . paramSchemaToSchema
409instance ToSchema Int8 where declareNamedSchema = plain . paramSchemaToSchema
432instance ToSchema Int16 where declareNamedSchema = plain . paramSchemaToSchema
410instance ToSchema Int16 where declareNamedSchema = plain . paramSchemaToSchema
@@ -438,16 +416,11 @@ instance ToSchema Word16 where declareNamedSchema = plain . paramSchemaToSchema
438instance ToSchema Word32 where declareNamedSchema = plain . paramSchemaToSchema
416instance ToSchema Word32 where declareNamedSchema = plain . paramSchemaToSchema
439instance ToSchema Word64 where declareNamedSchema = plain . paramSchemaToSchema
417instance ToSchema Word64 where declareNamedSchema = plain . paramSchemaToSchema
441−instance ToSchema Char where
442− declareNamedSchema proxy = plain (paramSchemaToSchema proxy)
419+instance ToSchema Char where declareNamedSchema = plain . paramSchemaToSchema
443− & mapped.Swagger.schema.example ?~ toJSON '?'
445instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSchema
420instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSchema
446instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
421instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
447instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
422instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
449−instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
451instance ToSchema a => ToSchema (Maybe a) where
424instance ToSchema a => ToSchema (Maybe a) where
452 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
425 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -456,11 +429,6 @@ instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
456instance ToSchema () where
429instance ToSchema () where
457 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
430 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)
432instance (ToSchema a, ToSchema b) => ToSchema (a, b)
465instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
433instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
466instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
434instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
@@ -470,81 +438,46 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f
471timeSchema :: T.Text -> Schema
439timeSchema :: T.Text -> Schema
472timeSchema fmt = mempty
440timeSchema fmt = mempty
473− & type_ ?~ SwaggerString
441+ & type_ .~ SwaggerString
474 & format ?~ fmt
442 & format ?~ fmt
476-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
444-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
477instance ToSchema Day where
445instance ToSchema Day where
478− declareNamedSchema _ = pure $ named "Day" $ timeSchema "date"
446+ declareNamedSchema _ = pure $ named "Day" (timeSchema "date")
479− & example ?~ toJSON (fromGregorian 2016 7 22)
482-- >>> toSchema (Proxy :: Proxy LocalTime) ^. format
449-- >>> toSchema (Proxy :: Proxy LocalTime) ^. format
483-- Just "yyyy-mm-ddThh:MM:ss"
450-- Just "yyyy-mm-ddThh:MM:ss"
484instance ToSchema LocalTime where
451instance ToSchema LocalTime where
485− declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
452+ declareNamedSchema _ = pure $ named "LocalTime" (timeSchema "yyyy-mm-ddThh:MM:ss")
486− & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
488-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
454-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
489instance ToSchema ZonedTime where
455instance ToSchema ZonedTime where
490 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
456 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
491− & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
493instance ToSchema NominalDiffTime where
458instance ToSchema NominalDiffTime where
494− declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Pico)
459+ declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Integer)
497-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format
462-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format
498-- Just "yyyy-mm-ddThh:MM:ssZ"
463-- Just "yyyy-mm-ddThh:MM:ssZ"
499instance ToSchema UTCTime where
464instance ToSchema UTCTime where
500− declareNamedSchema _ = pure $ named "UTCTime" $ timeSchema "yyyy-mm-ddThh:MM:ssZ"
465+ declareNamedSchema _ = pure $ named "UTCTime" (timeSchema "yyyy-mm-ddThh:MM:ssZ")
501− & example ?~ toJSON (UTCTime (fromGregorian 2016 7 22) 0)
503instance ToSchema T.Text where declareNamedSchema = plain . paramSchemaToSchema
467instance ToSchema T.Text where declareNamedSchema = plain . paramSchemaToSchema
504instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema
468instance 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))
470instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
522-- | NOTE: This schema does not account for the uniqueness of keys.
472-- | NOTE: This schema does not account for the uniqueness of keys.
523instance ToSchema a => ToSchema (IntMap a) where
473instance ToSchema a => ToSchema (IntMap a) where
524 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
474 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
476instance ToSchema a => ToSchema (Map String a) where
544 declareNamedSchema _ = do
477 declareNamedSchema _ = do
545 schema <- declareSchemaRef (Proxy :: Proxy a)
478 schema <- declareSchemaRef (Proxy :: Proxy a)
546 return $ unnamed $ mempty
479 return $ unnamed $ mempty
547− & type_ ?~ SwaggerObject
480+ & type_ .~ SwaggerObject
548 & additionalProperties ?~ schema
481 & additionalProperties ?~ schema
550instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
483instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
@@ -554,14 +487,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))
487instance 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))
488instance 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])
490instance 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])
491instance 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])
492instance ToSchema a => ToSchema (VS.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
@@ -575,13 +500,6 @@ instance ToSchema a => ToSchema (Set a) where
576instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
501instance 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
503instance ToSchema All where declareNamedSchema = plain . paramSchemaToSchema
586instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema
504instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema
@@ -591,141 +509,61 @@ instance ToSchema a => ToSchema (First a) where declareNamedSchema _ = unname
591instance ToSchema a => ToSchema (Last a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
509instance 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)
510instance 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.
512-- | Default schema for @'Bounded'@, @'Integral'@ types.
598-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
514-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
599-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
515-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
600−toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
516+toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
601toSchemaBoundedIntegral _ = mempty
517toSchemaBoundedIntegral _ = mempty
602− & type_ ?~ SwaggerInteger
518+ & type_ .~ SwaggerInteger
603 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
519 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
604 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
520 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
606-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
522-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
607−genericToNamedSchemaBoundedIntegral :: forall a d f.
523+genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
608 ( Bounded a, Integral a
524 ( Bounded a, Integral a
609 , Generic a, Rep a ~ D1 d f, Datatype d)
525 , Generic a, Rep a ~ D1 d f, Datatype d)
610− => SchemaOptions -> Proxy a -> NamedSchema
526+ => SchemaOptions -> proxy a -> NamedSchema
611genericToNamedSchemaBoundedIntegral opts proxy
527genericToNamedSchemaBoundedIntegral opts proxy
612− = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)
528+ = 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.
530-- | A configurable generic @'Schema'@ creator.
670−genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
671− SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
531+genericDeclareSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema
672−genericDeclareSchema = genericDeclareSchemaUnrestricted
532+genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
674-- | A configurable generic @'NamedSchema'@ creator.
534-- | A configurable generic @'NamedSchema'@ creator.
675-- This function applied to @'defaultSchemaOptions'@
535-- This function applied to @'defaultSchemaOptions'@
676-- is used as the default for @'declareNamedSchema'@
536-- is used as the default for @'declareNamedSchema'@
677-- when the type is an instance of @'Generic'@.
537-- 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
538+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
539+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
541+gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text
704−gdatatypeSchemaName opts _ = case orig of
542+gdatatypeSchemaName opts _ = case name of
705 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
543 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
706 _ -> Nothing
544 _ -> Nothing
708− orig = datatypeName (Proxy3 :: Proxy3 d f a)
546+ name = datatypeNameModifier opts (datatypeName (Proxy3 :: Proxy3 d f a))
709− name = datatypeNameModifier opts orig
711-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
548-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
549+paramSchemaToNamedSchema :: forall a d f proxy.
712−paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
550+ (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d)
713− SchemaOptions -> Proxy a -> NamedSchema
551+ => SchemaOptions -> proxy a -> NamedSchema
714−paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
552+paramSchemaToNamedSchema opts proxy = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d)) (paramSchemaToSchema proxy)
716-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
554-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
717−paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
555+paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> Schema
718−paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
556+paramSchemaToSchema _ = mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a)
720nullarySchema :: Schema
558nullarySchema :: Schema
721nullarySchema = mempty
559nullarySchema = mempty
722− & type_ ?~ SwaggerArray
560+ & type_ .~ SwaggerArray
723 & items ?~ SwaggerItemsArray []
561 & items ?~ SwaggerItemsArray []
725−gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
563+gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema
726gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
564gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
728−gdeclareSchema :: GToSchema f => SchemaOptions -> Proxy f -> Declare (Definitions Schema) Schema
566+gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare (Definitions Schema) Schema
729gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty
567gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty
731instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
569instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
@@ -745,7 +583,7 @@ instance OVERLAPPING_ Constructor c => GToSchema (C1 c U1) where
745 gdeclareNamedSchema = gdeclareNamedSumSchema
583 gdeclareNamedSchema = gdeclareNamedSumSchema
747-- | Single field constructor.
585-- | Single field constructor.
748−instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s f)) where
586+instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where
749 gdeclareNamedSchema opts _ s
587 gdeclareNamedSchema opts _ s
750 | unwrapUnaryRecords opts = fieldSchema
588 | unwrapUnaryRecords opts = fieldSchema
751 | otherwise =
589 | otherwise =
@@ -759,7 +597,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
597 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
760 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
598 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
762−gdeclareSchemaRef :: GToSchema a => SchemaOptions -> Proxy a -> Declare (Definitions Schema) (Referenced Schema)
600+gdeclareSchemaRef :: GToSchema a => SchemaOptions -> proxy a -> Declare (Definitions Schema) (Referenced Schema)
763gdeclareSchemaRef opts proxy = do
601gdeclareSchemaRef opts proxy = do
764 case gtoNamedSchema opts proxy of
602 case gtoNamedSchema opts proxy of
765 NamedSchema (Just name) schema -> do
603 NamedSchema (Just name) schema -> do
@@ -778,7 +616,7 @@ gdeclareSchemaRef opts proxy = do
778 return $ Ref (Reference name)
616 return $ Ref (Reference name)
779 _ -> Inline <$> gdeclareSchema opts proxy
617 _ -> Inline <$> gdeclareSchema opts proxy
781−appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema)
619+appendItem :: Referenced Schema -> Maybe (SwaggerItems SwaggerKindSchema) -> Maybe (SwaggerItems SwaggerKindSchema)
782appendItem x Nothing = Just (SwaggerItemsArray [x])
620appendItem x Nothing = Just (SwaggerItemsArray [x])
783appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
621appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
784appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
622appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
@@ -790,12 +628,10 @@ withFieldSchema opts _ isRequiredField schema = do
791 if T.null fname
629 if T.null fname
792 then schema
630 then schema
793− & type_ ?~ SwaggerArray
631+ & type_ .~ SwaggerArray
794 & items %~ appendItem ref
632 & items %~ appendItem ref
795− & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
796− & minItems %~ Just . maybe 1 (+1) -- increment minItems
797 else schema
633 else schema
798− & type_ ?~ SwaggerObject
634+ & type_ .~ SwaggerObject
799 & properties . at fname ?~ ref
635 & properties . at fname ?~ ref
800 & if isRequiredField
636 & if isRequiredField
801 then required %~ (++ [fname])
637 then required %~ (++ [fname])
@@ -817,13 +653,10 @@ instance OVERLAPPING_ ToSchema c => GToSchema (K1 i (Maybe c)) where
817instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where
653instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where
818 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
654 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
820−instance ( GSumToSchema f
656+instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
822− ) => GToSchema (f :+: g)
824 gdeclareNamedSchema = gdeclareNamedSumSchema
657 gdeclareNamedSchema = gdeclareNamedSumSchema
826−gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
659+gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
827gdeclareNamedSumSchema opts proxy s
660gdeclareNamedSumSchema opts proxy s
828 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
661 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
829 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
662 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
@@ -832,29 +665,29 @@ gdeclareNamedSumSchema opts proxy s
832 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
665 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
834 toStringTag schema = mempty
667 toStringTag schema = mempty
835− & type_ ?~ SwaggerString
668+ & type_ .~ SwaggerString
836 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
669 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
838type AllNullary = All
671type AllNullary = All
840−class GSumToSchema (f :: * -> *) where
673+class GSumToSchema f where
841− gsumToSchema :: SchemaOptions -> Proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
674+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
843instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
676instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
844 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
677 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
846−gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
679+gsumConToSchemaWith :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
847− Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
680+ Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema
848gsumConToSchemaWith ref opts _ schema = schema
681gsumConToSchemaWith ref opts _ schema = schema
849− & type_ ?~ SwaggerObject
682+ & type_ .~ SwaggerObject
850 & properties . at tag ?~ ref
683 & properties . at tag ?~ ref
851 & maxProperties ?~ 1
684 & maxProperties ?~ 1
852 & minProperties ?~ 1
685 & minProperties ?~ 1
854 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
687 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
856−gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
689+gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
857− SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
690+ SchemaOptions -> proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
858gsumConToSchema opts proxy schema = do
691gsumConToSchema opts proxy schema = do
859 ref <- gdeclareSchemaRef opts proxy
692 ref <- gdeclareSchemaRef opts proxy
860 return $ gsumConToSchemaWith ref opts proxy schema
693 return $ gsumConToSchemaWith ref opts proxy schema
@@ -876,7 +709,3 @@ data Proxy2 a b = Proxy2
877data Proxy3 a b c = Proxy3
710data Proxy3 a b c = Proxy3
880−-- >>> import Data.Swagger
881−-- >>> import Data.Aeson (encode)
882−-- >>> import Data.Aeson.Types (toJSONKeyText)