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