git.iko.soy/typeable/openapi3
on master help sign in
Merge pull request #19 from GetShopTV/definitions-#13

Annotate NamedSchema with used Definitions

commitbb33aeb34650fca3006f60a6db654e23b8a3a9c5 authorNickolay Kudasov <fizruk@users.noreply.github.com> dateSat 12 Dec 2015, 06:27 (11 years ago) parente89e06ff295fa8
6 files changed+398−165
compare with master
unifiedsplit
src/Data/Swagger/Declare.hs+105 src/Data/Swagger/Internal/Schema.hs+230−151 src/Data/Swagger/Lens.hs+27−4 src/Data/Swagger/Schema.hs+5−2 swagger2.cabal+2 test/Data/Swagger/SchemaSpec.hs+29−8
src/Data/Swagger/Declare.hsnew file+105
@@ -0,0 +1,105 @@
1+{-# LANGUAGE DeriveFunctor #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE FunctionalDependencies #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+module Data.Swagger.Declare where
6+
7+import Control.Monad
8+import Control.Monad.Trans
9+import Data.Functor.Identity
10+import Data.Monoid
11+
12+-- | A declare monad transformer parametrized by:
13+--
14+-- * @d@ — the output to accumulate (declarations);
15+--
16+-- * @m@ — the inner monad.
17+--
18+-- This monad transformer is similar to both state and writer monad transformers.
19+-- Thus it can be seen as
20+--
21+-- * a restricted append-only version of a state monad transformer or
22+--
23+-- * a writer monad transformer with the extra ability to read all previous output.
24+newtype DeclareT d m a = DeclareT { runDeclareT :: d -> m (d, a) }
25+ deriving (Functor)
26+
27+instance (Monad m, Monoid d) => Applicative (DeclareT d m) where
28+ pure x = DeclareT (\_ -> pure (mempty, x))
29+ DeclareT df <*> DeclareT dx = DeclareT $ \d -> do
30+ ~(d', f) <- df d
31+ ~(d'', x) <- dx (d <> d')
32+ return (d' <> d'', f x)
33+
34+instance (Monad m, Monoid d) => Monad (DeclareT d m) where
35+ return x = DeclareT (\_ -> pure (mempty, x))
36+ DeclareT dx >>= f = DeclareT $ \d -> do
37+ ~(d', x) <- dx d
38+ ~(d'', y) <- runDeclareT (f x) (d <> d')
39+ return (d' <> d'', y)
40+
41+instance Monoid d => MonadTrans (DeclareT d) where
42+ lift m = DeclareT (\_ -> (,) mempty <$> m)
43+
44+-- |
45+-- Definitions of @declare@ and @look@ must satisfy the following laws:
46+--
47+-- [/monoid homomorphism (mempty)/]
48+-- @'declare' mempty == return ()@
49+--
50+-- [/monoid homomorphism (mappend)/]
51+-- @'declare' x >> 'declare' y == 'declare' (x <> y)@
52+-- for every @x@, @y@
53+--
54+-- [/@declare@-@look@/]
55+-- @'declare' x >> 'look' == 'fmap' (<> x) 'look' <* 'declare' x@
56+-- for every @x@
57+--
58+-- [/@look@ as left identity/]
59+-- @'look' >> m == m@
60+-- for every @m@
61+class Monad m => MonadDeclare d m | m -> d where
62+ -- | @'declare' x@ is an action that produces the output @x@.
63+ declare :: d -> m ()
64+ -- | @'look'@ is an action that returns all the output so far.
65+ look :: m d
66+
67+instance (Monad m, Monoid d) => MonadDeclare d (DeclareT d m) where
68+ declare d = DeclareT (\_ -> return (d, ()))
69+ look = DeclareT (\d -> return (mempty, d))
70+
71+-- | Retrieve a function of all the output so far.
72+looks :: MonadDeclare d m => (d -> a) -> m a
73+looks f = f <$> look
74+
75+evalDeclareT :: Monad m => DeclareT d m a -> d -> m a
76+evalDeclareT (DeclareT f) d = snd `liftM` f d
77+
78+execDeclareT :: Monad m => DeclareT d m a -> d -> m d
79+execDeclareT (DeclareT f) d = fst `liftM` f d
80+
81+undeclareT :: (Monad m, Monoid d) => DeclareT d m a -> m a
82+undeclareT = flip evalDeclareT mempty
83+
84+-- | A declare monad parametrized by @d@ — the output to accumulate (declarations).
85+--
86+-- This monad is similar to both state and writer monads.
87+-- Thus it can be seen as
88+--
89+-- * a restricted append-only version of a state monad or
90+--
91+-- * a writer monad with the extra ability to read all previous output.
92+type Declare d = DeclareT d Identity
93+
94+runDeclare :: Declare d a -> d -> (d, a)
95+runDeclare m = runIdentity . runDeclareT m
96+
97+evalDeclare :: Declare d a -> d -> a
98+evalDeclare m = runIdentity . evalDeclareT m
99+
100+execDeclare :: Declare d a -> d -> d
101+execDeclare m = runIdentity . execDeclareT m
102+
103+undeclare :: Monoid d => Declare d a -> a
104+undeclare = runIdentity . undeclareT
105+
src/Data/Swagger/Internal/Schema.hs+230−151
@@ -2,6 +2,7 @@
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE FlexibleInstances #-}
44{-# LANGUAGE KindSignatures #-}
5+{-# LANGUAGE OverloadedLists #-}
56{-# LANGUAGE OverloadedStrings #-}
67{-# LANGUAGE PackageImports #-}
78{-# LANGUAGE PolyKinds #-}
@@ -13,9 +14,12 @@
1314module Data.Swagger.Internal.Schema where
1415
1516import Control.Lens
17+import Control.Monad
18+import Control.Monad.Writer
1619import Data.Aeson
1720import Data.Char
1821import Data.HashMap.Strict (HashMap)
22+import qualified Data.HashMap.Strict as HashMap
1923import "unordered-containers" Data.HashSet (HashSet)
2024import Data.Int
2125import Data.IntSet (IntSet)
@@ -31,6 +35,7 @@ import Data.Time
3135import Data.Word
3236import GHC.Generics
3337
38+import Data.Swagger.Declare
3439import Data.Swagger.Internal
3540import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
3641import Data.Swagger.Lens
@@ -38,42 +43,56 @@ import Data.Swagger.SchemaOptions
3843
3944-- | A @'Schema'@ with an optional name.
4045-- This name can be used in references.
41−type NamedSchema = (Maybe String, Schema)
46+type NamedSchema = (Maybe T.Text, Schema)
47+
48+-- | Schema definitions, a mapping from schema name to @'Schema'@.
49+type Definitions = HashMap T.Text Schema
4250
4351unnamed :: Schema -> NamedSchema
4452unnamed schema = (Nothing, schema)
4553
46−named :: String -> Schema -> NamedSchema
54+named :: T.Text -> Schema -> NamedSchema
4755named name schema = (Just name, schema)
4856
57+plain :: Schema -> Declare Definitions NamedSchema
58+plain = pure . unnamed
59+
60+unname :: NamedSchema -> NamedSchema
61+unname (_, schema) = (Nothing, schema)
62+
63+rename :: Maybe T.Text -> NamedSchema -> NamedSchema
64+rename name (_, schema) = (name, schema)
65+
4966-- | Convert a type into @'Schema'@.
5067--
5168-- An example type and instance:
5269--
5370-- @
5471-- {-\# LANGUAGE OverloadedStrings \#-} -- allows to write 'T.Text' literals
55−-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' as list
72+-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' and 'HashMap' as lists
5673--
5774-- import Control.Lens
5875--
5976-- data Coord = Coord { x :: Double, y :: Double }
6077--
6178-- instance ToSchema Coord where
62−-- toNamedSchema = (Just \"Coord\", mempty
63−-- & schemaType .~ SwaggerObject
64−-- & schemaProperties .~
65−-- [ ("x", toSchemaRef (Proxy :: Proxy Double))
66−-- , ("y", toSchemaRef (Proxy :: Proxy Double))
67−-- ]
68−-- & schemaRequired .~ [ "x", "y" ]
79+-- declareNamedSchema = pure (Just \"Coord\", schema)
80+-- where
81+-- schema = mempty
82+-- & schemaType .~ SwaggerObject
83+-- & schemaProperties .~
84+-- [ (\"x\", toSchemaRef (Proxy :: Proxy Double))
85+-- , (\"y\", toSchemaRef (Proxy :: Proxy Double))
86+-- ]
87+-- & schemaRequired .~ [ \"x\", \"y\" ]
6988-- @
7089--
7190-- Instead of manually writing your @'ToSchema'@ instance you can
72−-- use a default generic implementation of @'toNamedSchema'@.
91+-- use a default generic implementation of @'declareNamedSchema'@.
7392--
7493-- To do that, simply add @deriving 'Generic'@ clause to your datatype
7594-- and declare a @'ToSchema'@ instance for your datatype without
76−-- giving definition for @'toNamedSchema'@.
95+-- giving definition for @'declareNamedSchema'@.
7796--
7897-- For instance, the previous example can be simplified into this:
7998--
@@ -87,13 +106,24 @@ named name schema = (Just name, schema)
87106-- instance ToSchema Coord
88107-- @
89108class ToSchema a where
90− -- | Convert a type into an optionally named schema.
91− toNamedSchema :: proxy a -> NamedSchema
92− default toNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> NamedSchema
93− toNamedSchema = genericToNamedSchema defaultSchemaOptions
109+ -- | Convert a type into an optionally named schema
110+ -- together with all used definitions.
111+ -- Note that the schema itself is included in definitions
112+ -- only if it is recursive (and thus needs its definition in scope).
113+ declareNamedSchema :: proxy a -> Declare Definitions NamedSchema
114+ default declareNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> Declare Definitions NamedSchema
115+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
116+
117+-- | Convert a type into a schema and declare all used schema definitions.
118+declareSchema :: ToSchema a => proxy a -> Declare Definitions Schema
119+declareSchema = fmap snd . declareNamedSchema
120+
121+-- | Convert a type into an optionally named schema.
122+toNamedSchema :: ToSchema a => proxy a -> NamedSchema
123+toNamedSchema = undeclare . declareNamedSchema
94124
95125-- | Get type's schema name according to its @'ToSchema'@ instance.
96−schemaName :: ToSchema a => proxy a -> Maybe String
126+schemaName :: ToSchema a => proxy a -> Maybe T.Text
97127schemaName = fst . toNamedSchema
98128
99129-- | Convert a type into a schema.
@@ -101,44 +131,67 @@ toSchema :: ToSchema a => proxy a -> Schema
101131toSchema = snd . toNamedSchema
102132
103133-- | Convert a type into a referenced schema if possible.
104−-- Only named schemas can be references, nameless schemas are inlined.
134+-- Only named schemas can be referenced, nameless schemas are inlined.
105135toSchemaRef :: ToSchema a => proxy a -> Referenced Schema
106−toSchemaRef proxy = case toNamedSchema proxy of
107− (Just name, _) -> Ref (Reference ("#/definitions/" <> T.pack name))
108− (_, schema) -> Inline schema
136+toSchemaRef = undeclare . declareSchemaRef
109137
110−class GToSchema (f :: * -> *) where
111− gtoNamedSchema :: SchemaOptions -> proxy f -> Schema -> NamedSchema
138+-- | Convert a type into a referenced schema if possible
139+-- and declare all used schema definitions.
140+-- Only named schemas can be referenced, nameless schemas are inlined.
141+--
142+-- Schema definitions are typically declared for every referenced schema.
143+-- If @'declareSchemaRef'@ returns a reference, a corresponding schema
144+-- will be declared (regardless of whether it is recusive or not).
145+declareSchemaRef :: ToSchema a => proxy a -> Declare Definitions (Referenced Schema)
146+declareSchemaRef proxy = do
147+ case toNamedSchema proxy of
148+ (Just name, schema) -> do
149+ -- This check is very important as it allows generically
150+ -- derive used definitions for recursive schemas.
151+ -- Lazy Declare monad allows toNamedSchema to ignore
152+ -- any declarations (which would otherwise loop) and
153+ -- retrieve the schema and its name to check if we
154+ -- have already declared it.
155+ -- If we have, we don't need to declare anything for
156+ -- this schema this time and thus simply return the reference.
157+ known <- looks (HashMap.member name)
158+ when (not known) $ do
159+ declare [(name, schema)]
160+ void $ declareNamedSchema proxy
161+ return $ Ref (Reference ("#/definitions/" <> name))
162+ _ -> Inline <$> declareSchema proxy
112163
113−gtoSchema :: GToSchema f => SchemaOptions -> proxy f -> Schema -> Schema
114−gtoSchema opts proxy = snd . gtoNamedSchema opts proxy
164+class GToSchema (f :: * -> *) where
165+ gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare Definitions NamedSchema
115166
116167instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
117− toNamedSchema _ = unnamed $ mempty
118− & schemaType .~ SwaggerArray
119− & schemaItems ?~ SchemaItemsObject (toSchemaRef (Proxy :: Proxy a))
120−
121−instance {-# OVERLAPPING #-} ToSchema String where toNamedSchema = unnamed . paramSchemaToSchema
122−instance ToSchema Bool where toNamedSchema = unnamed . paramSchemaToSchema
123−instance ToSchema Integer where toNamedSchema = unnamed . paramSchemaToSchema
124−instance ToSchema Int where toNamedSchema = unnamed . paramSchemaToSchema
125−instance ToSchema Int8 where toNamedSchema = unnamed . paramSchemaToSchema
126−instance ToSchema Int16 where toNamedSchema = unnamed . paramSchemaToSchema
127−instance ToSchema Int32 where toNamedSchema = unnamed . paramSchemaToSchema
128−instance ToSchema Int64 where toNamedSchema = unnamed . paramSchemaToSchema
129−instance ToSchema Word where toNamedSchema = unnamed . paramSchemaToSchema
130−instance ToSchema Word8 where toNamedSchema = unnamed . paramSchemaToSchema
131−instance ToSchema Word16 where toNamedSchema = unnamed . paramSchemaToSchema
132−instance ToSchema Word32 where toNamedSchema = unnamed . paramSchemaToSchema
133−instance ToSchema Word64 where toNamedSchema = unnamed . paramSchemaToSchema
134−
135−instance ToSchema Char where toNamedSchema = unnamed . paramSchemaToSchema
136−instance ToSchema Scientific where toNamedSchema = unnamed . paramSchemaToSchema
137−instance ToSchema Double where toNamedSchema = unnamed . paramSchemaToSchema
138−instance ToSchema Float where toNamedSchema = unnamed . paramSchemaToSchema
168+ declareNamedSchema _ = do
169+ ref <- declareSchemaRef (Proxy :: Proxy a)
170+ return $ unnamed $ mempty
171+ & schemaType .~ SwaggerArray
172+ & schemaItems ?~ SchemaItemsObject ref
173+
174+instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
175+instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
176+instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
177+instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
178+instance ToSchema Int8 where declareNamedSchema = plain . paramSchemaToSchema
179+instance ToSchema Int16 where declareNamedSchema = plain . paramSchemaToSchema
180+instance ToSchema Int32 where declareNamedSchema = plain . paramSchemaToSchema
181+instance ToSchema Int64 where declareNamedSchema = plain . paramSchemaToSchema
182+instance ToSchema Word where declareNamedSchema = plain . paramSchemaToSchema
183+instance ToSchema Word8 where declareNamedSchema = plain . paramSchemaToSchema
184+instance ToSchema Word16 where declareNamedSchema = plain . paramSchemaToSchema
185+instance ToSchema Word32 where declareNamedSchema = plain . paramSchemaToSchema
186+instance ToSchema Word64 where declareNamedSchema = plain . paramSchemaToSchema
187+
188+instance ToSchema Char where declareNamedSchema = plain . paramSchemaToSchema
189+instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSchema
190+instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
191+instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
139192
140193instance ToSchema a => ToSchema (Maybe a) where
141− toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
194+ declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
142195
143196instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
144197
@@ -150,77 +203,79 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchem
150203instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
151204instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
152205
153−timeNamedSchema :: String -> String -> NamedSchema
154−timeNamedSchema name format = (Just name, mempty
206+timeSchema :: T.Text -> Schema
207+timeSchema format = mempty
155208 & schemaType .~ SwaggerString
156− & schemaFormat ?~ T.pack format
157− & schemaMinLength ?~ toInteger (length format))
209+ & schemaFormat ?~ format
210+ & schemaMinLength ?~ toInteger (T.length format)
158211
159212-- |
160213-- >>> toSchema (Proxy :: Proxy Day) ^. schemaFormat
161214-- Just "yyyy-mm-dd"
162215instance ToSchema Day where
163− toNamedSchema _ = timeNamedSchema "Day" "yyyy-mm-dd"
216+ declareNamedSchema _ = pure $ named "Day" (timeSchema "yyyy-mm-dd")
164217
165218-- |
166219-- >>> toSchema (Proxy :: Proxy LocalTime) ^. schemaFormat
167220-- Just "yyyy-mm-ddThh:MM:ss"
168221instance ToSchema LocalTime where
169− toNamedSchema _ = timeNamedSchema "LocalTime" "yyyy-mm-ddThh:MM:ss"
222+ declareNamedSchema _ = pure $ named "LocalTime" (timeSchema "yyyy-mm-ddThh:MM:ss")
170223
171224-- |
172225-- >>> toSchema (Proxy :: Proxy ZonedTime) ^. schemaFormat
173226-- Just "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
174227instance ToSchema ZonedTime where
175− toNamedSchema _ = (Just "ZonedTime", mempty
176− & schemaType .~ SwaggerString
177− & schemaFormat ?~ "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
178− & schemaMinLength ?~ toInteger (length ("yyyy-mm-ddThh:MM:ssZ" :: String)))
228+ declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
229+ & schemaMinLength ?~ toInteger (T.length "yyyy-mm-ddThh:MM:ssZ")
179230
180231instance ToSchema NominalDiffTime where
181− toNamedSchema _ = toNamedSchema (Proxy :: Proxy Integer)
232+ declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Integer)
182233
183234-- |
184235-- >>> toSchema (Proxy :: Proxy UTCTime) ^. schemaFormat
185236-- Just "yyyy-mm-ddThh:MM:ssZ"
186237instance ToSchema UTCTime where
187− toNamedSchema _ = timeNamedSchema "UTCTime" "yyyy-mm-ddThh:MM:ssZ"
238+ declareNamedSchema _ = pure $ named "UTCTime" (timeSchema "yyyy-mm-ddThh:MM:ssZ")
188239
189−instance ToSchema T.Text where toNamedSchema = unnamed . paramSchemaToSchema
190−instance ToSchema TL.Text where toNamedSchema = unnamed . paramSchemaToSchema
240+instance ToSchema T.Text where declareNamedSchema = plain . paramSchemaToSchema
241+instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema
191242
192−instance ToSchema IntSet where toNamedSchema _ = toNamedSchema (Proxy :: Proxy (Set Int))
243+instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
193244
194245-- | NOTE: This schema does not account for the uniqueness of keys.
195246instance ToSchema a => ToSchema (IntMap a) where
196− toNamedSchema _ = toNamedSchema (Proxy :: Proxy [(Int, a)])
247+ declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
197248
198249instance ToSchema a => ToSchema (Map String a) where
199− toNamedSchema _ = unnamed $ mempty
200− & schemaType .~ SwaggerObject
201− & schemaAdditionalProperties ?~ toSchema (Proxy :: Proxy a)
250+ declareNamedSchema _ = do
251+ schema <- declareSchema (Proxy :: Proxy a)
252+ return $ unnamed $ mempty
253+ & schemaType .~ SwaggerObject
254+ & schemaAdditionalProperties ?~ schema
202255
203−instance ToSchema a => ToSchema (Map T.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
204−instance ToSchema a => ToSchema (Map TL.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
256+instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
257+instance ToSchema a => ToSchema (Map TL.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
205258
206−instance ToSchema a => ToSchema (HashMap String a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
207−instance ToSchema a => ToSchema (HashMap T.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
208−instance ToSchema a => ToSchema (HashMap TL.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
259+instance ToSchema a => ToSchema (HashMap String a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
260+instance ToSchema a => ToSchema (HashMap T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
261+instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
209262
210263instance ToSchema a => ToSchema (Set a) where
211− toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy [a])
212− & schemaUniqueItems ?~ True
264+ declareNamedSchema _ = do
265+ schema <- declareSchema (Proxy :: Proxy [a])
266+ return $ unnamed $ schema
267+ & schemaUniqueItems ?~ True
213268
214−instance ToSchema a => ToSchema (HashSet a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Set a))
269+instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
215270
216−instance ToSchema All where toNamedSchema = unnamed . paramSchemaToSchema
217−instance ToSchema Any where toNamedSchema = unnamed . paramSchemaToSchema
271+instance ToSchema All where declareNamedSchema = plain . paramSchemaToSchema
272+instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema
218273
219−instance ToSchema a => ToSchema (Sum a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
220−instance ToSchema a => ToSchema (Product a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
221−instance ToSchema a => ToSchema (First a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
222−instance ToSchema a => ToSchema (Last a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
223−instance ToSchema a => ToSchema (Dual a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
274+instance ToSchema a => ToSchema (Sum a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
275+instance ToSchema a => ToSchema (Product a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
276+instance ToSchema a => ToSchema (First a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
277+instance ToSchema a => ToSchema (Last a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
278+instance ToSchema a => ToSchema (Dual a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
224279
225280-- | Default schema for @'Bounded'@, @'Integral'@ types.
226281toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
@@ -238,19 +293,19 @@ genericToNamedSchemaBoundedIntegral opts proxy
238293 = (gdatatypeSchemaName opts (Proxy :: Proxy d), toSchemaBoundedIntegral proxy)
239294
240295-- | A configurable generic @'Schema'@ creator.
241−genericToSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Schema
242−genericToSchema opts = snd . genericToNamedSchema opts
296+genericDeclareSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare Definitions Schema
297+genericDeclareSchema opts proxy = snd <$> genericDeclareNamedSchema opts proxy
243298
244299-- | A configurable generic @'NamedSchema'@ creator.
245300-- This function applied to @'defaultSchemaOptions'@
246−-- is used as the default for @'toNamedSchema'@
301+-- is used as the default for @'declareNamedSchema'@
247302-- when the type is an instance of @'Generic'@.
248−genericToNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> NamedSchema
249−genericToNamedSchema opts _ = gtoNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
303+genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare Definitions NamedSchema
304+genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
250305
251−gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe String
306+gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text
252307gdatatypeSchemaName opts _ = case name of
253− (c:_) | isAlpha c && isUpper c -> Just name
308+ (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
254309 _ -> Nothing
255310 where
256311 name = datatypeNameModifier opts (datatypeName (Proxy3 :: Proxy3 d f a))
@@ -270,75 +325,104 @@ nullarySchema = mempty
270325 & schemaType .~ SwaggerArray
271326 & schemaEnum ?~ [ toJSON () ]
272327
328+gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema
329+gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
330+
331+gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare Definitions Schema
332+gdeclareSchema opts proxy = snd <$> gdeclareNamedSchema opts proxy mempty
333+
273334instance GToSchema U1 where
274− gtoNamedSchema _ _ _ = unnamed nullarySchema
335+ gdeclareNamedSchema _ _ _ = plain nullarySchema
275336
276337instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
277− gtoNamedSchema opts _ = unnamed . gtoSchema opts (Proxy :: Proxy f) . gtoSchema opts (Proxy :: Proxy g)
338+ gdeclareNamedSchema opts _ schema = do
339+ (_, gschema) <- gdeclareNamedSchema opts (Proxy :: Proxy g) schema
340+ gdeclareNamedSchema opts (Proxy :: Proxy f) gschema
278341
279342instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
280− gtoNamedSchema opts _ s = (name, gtoSchema opts (Proxy :: Proxy f) s)
343+ gdeclareNamedSchema opts _ s = rename name <$> gdeclareNamedSchema opts (Proxy :: Proxy f) s
281344 where
282345 name = gdatatypeSchemaName opts (Proxy :: Proxy d)
283346
284347instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
285− gtoNamedSchema opts _ = unnamed . gtoSchema opts (Proxy :: Proxy f)
348+ gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)
286349
287350-- | Single field constructor.
288351instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where
289− gtoNamedSchema opts _ s
352+ gdeclareNamedSchema opts _ s
290353 | unwrapUnaryRecords opts = fieldSchema
291− | otherwise =
354+ | otherwise = do
355+ (_, schema) <- recordSchema
292356 case schema ^. schemaItems of
293357 Just (SchemaItemsArray [_]) -> fieldSchema
294− _ -> unnamed schema
358+ _ -> pure (unnamed schema)
295359 where
296− schema = gtoSchema opts (Proxy :: Proxy (S1 s f)) s
297− fieldSchema = gtoNamedSchema opts (Proxy :: Proxy f) s
298−
299−gtoSchemaRef :: GToSchema f => SchemaOptions -> proxy f -> Referenced Schema
300−gtoSchemaRef opts proxy = case gtoNamedSchema opts proxy mempty of
301− (Just name, _)
302− | useReferences opts -> Ref (Reference ("#/definitions/" <> T.pack name))
303− (_, schema) -> Inline schema
360+ recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
361+ fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
362+
363+gdeclareSchemaRef :: GToSchema a => SchemaOptions -> proxy a -> Declare Definitions (Referenced Schema)
364+gdeclareSchemaRef opts proxy = do
365+ case gtoNamedSchema opts proxy of
366+ (Just name, schema) -> do
367+ -- This check is very important as it allows generically
368+ -- derive used definitions for recursive schemas.
369+ -- Lazy Declare monad allows toNamedSchema to ignore
370+ -- any declarations (which would otherwise loop) and
371+ -- retrieve the schema and its name to check if we
372+ -- have already declared it.
373+ -- If we have, we don't need to declare anything for
374+ -- this schema this time and thus simply return the reference.
375+ known <- looks (HashMap.member name)
376+ when (not known) $ do
377+ declare [(name, schema)]
378+ void $ gdeclareNamedSchema opts proxy mempty
379+ return $ Ref (Reference ("#/definitions/" <> name))
380+ _ -> Inline <$> gdeclareSchema opts proxy
304381
305382appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems
306383appendItem x Nothing = Just (SchemaItemsArray [x])
307384appendItem x (Just (SchemaItemsArray xs)) = Just (SchemaItemsArray (x:xs))
308385appendItem _ _ = error "GToSchema.appendItem: cannot append to SchemaItemsObject"
309386
310−withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) => SchemaOptions -> proxy s f -> Bool -> Schema -> Schema
311−withFieldSchema opts _ isRequiredField schema
312− | T.null fieldName = schema
313− & schemaType .~ SwaggerArray
314− & schemaItems %~ appendItem fieldSchemaRef
315− | otherwise = schema
316− & schemaType .~ SwaggerObject
317− & schemaProperties . at fieldName ?~ fieldSchemaRef
318− & if isRequiredField
319− then schemaRequired %~ (fieldName :)
320− else id
387+withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
388+ SchemaOptions -> proxy s f -> Bool -> Schema -> Declare Definitions Schema
389+withFieldSchema opts _ isRequiredField schema = do
390+ ref <- gdeclareSchemaRef opts (Proxy :: Proxy f)
391+ return $
392+ if T.null fname
393+ then schema
394+ & schemaType .~ SwaggerArray
395+ & schemaItems %~ appendItem ref
396+ else schema
397+ & schemaType .~ SwaggerObject
398+ & schemaProperties . at fname ?~ ref
399+ & if isRequiredField
400+ then schemaRequired %~ (fname :)
401+ else id
321402 where
322− fieldName = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
323− fieldSchemaRef = gtoSchemaRef opts (Proxy :: Proxy f)
403+ fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
324404
325405-- | Optional record fields.
326406instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
327− gtoNamedSchema opts _ = unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
407+ gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
328408
329409-- | Record fields.
330410instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
331− gtoNamedSchema opts _ = unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
411+ gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
332412
333−instance ToSchema c => GToSchema (K1 i c) where
334− gtoNamedSchema _ _ _ = toNamedSchema (Proxy :: Proxy c)
413+instance {-# OVERLAPPING #-} ToSchema c => GToSchema (K1 i (Maybe c)) where
414+ gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
415+
416+instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where
417+ gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
335418
336419instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
337− gtoNamedSchema opts _ s
338− | allNullaryToStringTag opts && allNullary = unnamed (toStringTag sumSchema)
339− | otherwise = unnamed sumSchema
420+ gdeclareNamedSchema opts _ s
421+ | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
422+ | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
340423 where
341− (All allNullary, sumSchema) = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s
424+ declareSumSchema = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s
425+ (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
342426
343427 toStringTag schema = mempty
344428 & schemaType .~ SwaggerString
@@ -347,40 +431,35 @@ instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
347431type AllNullary = All
348432
349433class GSumToSchema f where
350− gsumToSchema :: SchemaOptions -> proxy f -> Schema -> (AllNullary, Schema)
434+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare Definitions) Schema
351435
352436instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
353− gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) `after` gsumToSchema opts (Proxy :: Proxy g)
354− where
355− (f `after` g) s = (a <> b, s'')
356− where
357− (a, s') = f s
358− (b, s'') = g s'
359−
360−gsumConToSchema :: forall c f proxy. Constructor c =>
361− Bool -> Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> (AllNullary, Schema)
362−gsumConToSchema isNullary tagSchemaRef opts _ schema = (All isNullary, schema
363− & schemaType .~ SwaggerObject
364− & schemaProperties . at tag ?~ tagSchemaRef
365− & schemaMaxProperties ?~ 1
366− & schemaMinProperties ?~ 1)
437+ gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) <=< gsumToSchema opts (Proxy :: Proxy g)
438+
439+gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
440+ SchemaOptions -> proxy (C1 c f) -> Schema -> Declare Definitions Schema
441+gsumConToSchema opts _ schema = do
442+ ref <- gdeclareSchemaRef opts (Proxy :: Proxy (C1 c f))
443+ return $ schema
444+ & schemaType .~ SwaggerObject
445+ & schemaProperties . at tag ?~ ref
446+ & schemaMaxProperties ?~ 1
447+ & schemaMinProperties ?~ 1
367448 where
368449 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
369450
370451instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
371− gsumToSchema opts = gsumConToSchema False tagSchemaRef opts
372− where
373− tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c f))
374−
375−instance Constructor c => GSumToSchema (C1 c U1) where
376− gsumToSchema opts = gsumConToSchema True tagSchemaRef opts
377− where
378− tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c U1))
452+ gsumToSchema opts proxy schema = do
453+ tell (All False)
454+ lift $ gsumConToSchema opts proxy schema
379455
380456instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
381− gsumToSchema opts = gsumConToSchema False tagSchemaRef opts
382− where
383− tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c (S1 s f)))
457+ gsumToSchema opts proxy schema = do
458+ tell (All False)
459+ lift $ gsumConToSchema opts proxy schema
460+
461+instance Constructor c => GSumToSchema (C1 c U1) where
462+ gsumToSchema opts proxy = lift . gsumConToSchema opts proxy
384463
385464data Proxy2 a b = Proxy2
386465
src/Data/Swagger/Lens.hs+27−4
@@ -11,38 +11,61 @@ import Data.Swagger.Internal
1111import Data.Text (Text)
1212
1313-- =======================================================================
14−-- TH derived lenses
15−-- =======================================================================
14+-- * TH derived lenses
1615
16+-- ** 'Swagger' lenses
1717makeLenses ''Swagger
18+-- ** 'Host' lenses
1819makeLenses ''Host
20+-- ** 'Info' lenses
1921makeLenses ''Info
22+-- ** 'Contact' lenses
2023makeLenses ''Contact
24+-- ** 'License' lenses
2125makeLenses ''License
26+-- ** 'Paths' lenses
2227makeLenses ''Paths
28+-- ** 'PathItem' lenses
2329makeLenses ''PathItem
30+-- ** 'Tag' lenses
2431makeLenses ''Tag
32+-- ** 'Operation' lenses
2533makeLenses ''Operation
34+-- ** 'Param' lenses
2635makeLenses ''Param
36+-- ** 'ParamAnySchema' prisms
2737makePrisms ''ParamAnySchema
38+-- ** 'ParamOtherSchema' lenses
2839makeLenses ''ParamOtherSchema
40+-- ** 'Items' lenses
2941makeLenses ''Items
42+-- ** 'Header' lenses
3043makeLenses ''Header
44+-- ** 'Schema' lenses
3145makeLenses ''Schema
46+-- ** 'SchemaItems' prisms
3247makePrisms ''SchemaItems
48+-- ** 'ParamSchema' lenses
3349makeLenses ''ParamSchema
50+-- ** 'Xml' lenses
3451makeLenses ''Xml
52+-- ** 'Responses' lenses
3553makeLenses ''Responses
54+-- ** 'Response' lenses
3655makeLenses ''Response
56+-- ** 'SecurityScheme' lenses
3757makeLenses ''SecurityScheme
58+-- ** 'SecuritySchemeType' prisms
3859makePrisms ''SecuritySchemeType
60+-- ** 'ApiKeyParams' lenses
3961makeLenses ''ApiKeyParams
62+-- ** 'OAuth2Params' lenses
4063makeLenses ''OAuth2Params
64+-- ** 'ExternalDocs' lenses
4165makeLenses ''ExternalDocs
4266
4367-- =======================================================================
44−-- Helper classy lenses
45−-- =======================================================================
68+-- * Helper classy lenses
4669
4770class HasDescription s d | s -> d where
4871 description :: Lens' s d
src/Data/Swagger/Schema.hs+5−2
@@ -9,14 +9,17 @@
99module Data.Swagger.Schema (
1010 -- * Encoding
1111 ToSchema(..),
12+ Definitions,
1213 NamedSchema,
14+ declareSchema,
15+ declareSchemaRef,
1316 toSchema,
1417 toSchemaRef,
1518 schemaName,
1619
1720 -- * Generic schema encoding
18− genericToSchema,
19− genericToNamedSchema,
21+ genericDeclareNamedSchema,
22+ genericDeclareSchema,
2023 genericToNamedSchemaBoundedIntegral,
2124 toSchemaBoundedIntegral,
2225 paramSchemaToNamedSchema,
swagger2.cabal+2
@@ -20,6 +20,7 @@ library
2020 hs-source-dirs: src
2121 exposed-modules:
2222 Data.Swagger
23+ Data.Swagger.Declare
2324 Data.Swagger.Lens
2425 Data.Swagger.ParamSchema
2526 Data.Swagger.Schema
@@ -35,6 +36,7 @@ library
3536 , containers
3637 , hashable
3738 , http-media
39+ , mtl
3840 , network
3941 , template-haskell
4042 , text
test/Data/Swagger/SchemaSpec.hs+29−8
@@ -8,11 +8,16 @@ module Data.Swagger.SchemaSpec where
88import Data.Aeson
99import Data.Aeson.QQ
1010import Data.Char
11+import qualified Data.HashMap.Strict as HashMap
1112import Data.Proxy
1213import Data.Set (Set)
14+import qualified Data.Set as Set
15+import Data.Text (Text)
16+import qualified Data.Text as Text
1317import GHC.Generics
1418
1519import Data.Swagger
20+import Data.Swagger.Declare
1621
1722import SpecCommon
1823import Test.Hspec
@@ -23,7 +28,14 @@ checkToSchema proxy js = toSchema proxy <~> js
2328checkSchemaName :: ToSchema a => Maybe String -> Proxy a -> Spec
2429checkSchemaName sname proxy =
2530 it ("schema name is " ++ show sname) $
26− schemaName proxy `shouldBe` sname
31+ schemaName proxy `shouldBe` fmap Text.pack sname
32+
33+checkDefs :: ToSchema a => Proxy a -> [String] -> Spec
34+checkDefs proxy names =
35+ it ("uses these definitions " ++ show names) $
36+ Set.fromList (HashMap.keys defs) `shouldBe` Set.fromList (map Text.pack names)
37+ where
38+ defs = execDeclare (declareNamedSchema proxy) mempty
2739
2840spec :: Spec
2941spec = do
@@ -51,6 +63,13 @@ spec = do
5163 context "(Int, Float)" $ checkSchemaName Nothing (Proxy :: Proxy (Int, Float))
5264 context "Person" $ checkSchemaName (Just "Person") (Proxy :: Proxy Person)
5365 context "Shade" $ checkSchemaName (Just "Shade") (Proxy :: Proxy Shade)
66+ describe "Generic Definitions" $ do
67+ context "Unit" $ checkDefs (Proxy :: Proxy Unit) []
68+ context "Paint" $ checkDefs (Proxy :: Proxy Paint) ["Color"]
69+ context "Light" $ checkDefs (Proxy :: Proxy Light) ["Color"]
70+ context "Character" $ checkDefs (Proxy :: Proxy Character) ["Player", "Point"]
71+ context "MyRoseTree" $ checkDefs (Proxy :: Proxy MyRoseTree) ["RoseTree"]
72+ context "[Set (Unit, Maybe Color)]" $ checkDefs (Proxy :: Proxy [Set (Unit, Maybe Color)]) ["Unit", "Color"]
5473
5574main :: IO ()
5675main = hspec spec
@@ -105,7 +124,7 @@ data Point = Point
105124 } deriving (Generic)
106125
107126instance ToSchema Point where
108− toNamedSchema = genericToNamedSchema defaultSchemaOptions
127+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
109128 { fieldLabelModifier = map toLower . drop (length "point") }
110129
111130pointSchemaJSON :: Value
@@ -145,7 +164,7 @@ colorSchemaJSON = [aesonQQ|
145164
146165data Shade = Dim | Bright deriving (Generic, ToParamSchema)
147166
148−instance ToSchema Shade where toNamedSchema = paramSchemaToNamedSchema defaultSchemaOptions
167+instance ToSchema Shade where declareNamedSchema = pure . paramSchemaToNamedSchema defaultSchemaOptions
149168
150169shadeSchemaJSON :: Value
151170shadeSchemaJSON = [aesonQQ|
@@ -185,7 +204,7 @@ newtype Email = Email { getEmail :: String }
185204 deriving (Generic)
186205
187206instance ToSchema Email where
188− toNamedSchema = genericToNamedSchema defaultSchemaOptions
207+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
189208 { unwrapUnaryRecords = True }
190209
191210emailSchemaJSON :: Value
@@ -258,7 +277,7 @@ data MyRoseTree = MyRoseTree
258277 } deriving (Generic)
259278
260279instance ToSchema MyRoseTree where
261− toNamedSchema = genericToNamedSchema defaultSchemaOptions
280+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
262281 { datatypeNameModifier = drop (length "My") }
263282
264283myRoseTreeSchemaJSON :: Value
@@ -288,7 +307,9 @@ myRoseTreeSchemaJSON = [aesonQQ|
288307newtype Inlined a = Inlined { getInlined :: a }
289308
290309instance ToSchema a => ToSchema (Inlined a) where
291− toNamedSchema _ = (Nothing, toSchema (Proxy :: Proxy a))
310+ declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
311+ where
312+ unname (_, schema) = (Nothing, schema)
292313
293314newtype Players = Players [Inlined Player]
294315 deriving (Generic, ToSchema)
@@ -322,7 +343,7 @@ data Status
322343 deriving (Generic)
323344
324345instance ToSchema Status where
325− toNamedSchema = genericToNamedSchema defaultSchemaOptions
346+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
326347 { constructorTagModifier = map toLower . drop (length "Status") }
327348
328349statusSchemaJSON :: Value
@@ -397,7 +418,7 @@ data Light
397418 deriving (Generic)
398419
399420instance ToSchema Light where
400− toNamedSchema = genericToNamedSchema defaultSchemaOptions
421+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
401422 { unwrapUnaryRecords = True }
402423
403424lightSchemaJSON :: Value