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