git.iko.soy/typeable/openapi3
on master help sign in
Tests' changes
2a46257Oleg Grenrus
src/Data/Swagger/Internal/Schema.hs+5−5
compare with master
unifiedsplit
@@ -567,8 +567,8 @@ gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts prox
567
567
568instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
568instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
569 gdeclareNamedSchema opts _ schema = do
569 gdeclareNamedSchema opts _ schema = do
570− NamedSchema _ gschema <- gdeclareNamedSchema opts (Proxy :: Proxy g) schema
570+ NamedSchema _ gschema <- gdeclareNamedSchema opts (Proxy :: Proxy f) schema
571− gdeclareNamedSchema opts (Proxy :: Proxy f) gschema
571+ gdeclareNamedSchema opts (Proxy :: Proxy g) gschema
572
572
573instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
573instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
574 gdeclareNamedSchema opts _ s = rename name <$> gdeclareNamedSchema opts (Proxy :: Proxy f) s
574 gdeclareNamedSchema opts _ s = rename name <$> gdeclareNamedSchema opts (Proxy :: Proxy f) s
@@ -617,7 +617,7 @@ gdeclareSchemaRef opts proxy = do
617
617
618appendItem :: Referenced Schema -> Maybe (SwaggerItems Schema) -> Maybe (SwaggerItems Schema)
618appendItem :: Referenced Schema -> Maybe (SwaggerItems Schema) -> Maybe (SwaggerItems Schema)
619appendItem x Nothing = Just (SwaggerItemsArray [x])
619appendItem x Nothing = Just (SwaggerItemsArray [x])
620−appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (x:xs))
620+appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
621appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
621appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
622
622
623withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
623withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
@@ -633,7 +633,7 @@ withFieldSchema opts _ isRequiredField schema = do
633 & type_ .~ SwaggerObject
633 & type_ .~ SwaggerObject
634 & properties . at fname ?~ ref
634 & properties . at fname ?~ ref
635 & if isRequiredField
635 & if isRequiredField
636− then required %~ (fname :)
636+ then required %~ (++ [fname])
637 else id
637 else id
638 where
638 where
639 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
639 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
@@ -673,7 +673,7 @@ class GSumToSchema f where
673 gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
673 gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
674
674
675instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
675instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
676− gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) <=< gsumToSchema opts (Proxy :: Proxy g)
676+ gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
677
677
678gsumConToSchemaWith :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
678gsumConToSchemaWith :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
679 Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema
679 Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema
swagger2.cabal+1
@@ -68,6 +68,7 @@ test-suite spec
68 , containers
68 , containers
69 , hashable
69 , hashable
70 , hspec
70 , hspec
71+ , insert-ordered-containers
71 , HUnit
72 , HUnit
72 , mtl
73 , mtl
73 , QuickCheck
74 , QuickCheck
test/Data/Swagger/SchemaSpec.hs+48−2
@@ -7,17 +7,18 @@ module Data.Swagger.SchemaSpec where
7import Prelude ()
7import Prelude ()
8import Prelude.Compat
8import Prelude.Compat
9
9
10+import Control.Lens ((^.))
10import Data.Aeson
11import Data.Aeson
11import Data.Aeson.QQ
12import Data.Aeson.QQ
12import Data.Char
13import Data.Char
13import qualified Data.HashMap.Strict as HashMap
14import qualified Data.HashMap.Strict as HashMap
15+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
14import Data.Proxy
16import Data.Proxy
15import Data.Set (Set)
17import Data.Set (Set)
16import qualified Data.Set as Set
18import qualified Data.Set as Set
17import qualified Data.Text as Text
19import qualified Data.Text as Text
18import GHC.Generics
20import GHC.Generics
19
21
20−import qualified Data.Swagger.OrdHashMap as OrdHashMap
21import Data.Swagger
22import Data.Swagger
22import Data.Swagger.Declare
23import Data.Swagger.Declare
23
24
@@ -35,10 +36,17 @@ checkSchemaName sname proxy =
35checkDefs :: ToSchema a => Proxy a -> [String] -> Spec
36checkDefs :: ToSchema a => Proxy a -> [String] -> Spec
36checkDefs proxy names =
37checkDefs proxy names =
37 it ("uses these definitions " ++ show names) $
38 it ("uses these definitions " ++ show names) $
38− Set.fromList (OrdHashMap.keys defs) `shouldBe` Set.fromList (map Text.pack names)
39+ InsOrdHashMap.keys defs `shouldBe` map Text.pack names
39 where
40 where
40 defs = execDeclare (declareNamedSchema proxy) mempty
41 defs = execDeclare (declareNamedSchema proxy) mempty
41
42
43+checkProperties :: ToSchema a => Proxy a -> [String] -> Spec
44+checkProperties proxy names =
45+ it ("has these fields in order " ++ show names) $
46+ InsOrdHashMap.keys fields `shouldBe` map Text.pack names
47+ where
48+ fields = toSchema proxy ^. properties
49+
42checkInlinedSchema :: ToSchema a => Proxy a -> Value -> Spec
50checkInlinedSchema :: ToSchema a => Proxy a -> Value -> Spec
43checkInlinedSchema proxy js = toInlinedSchema proxy <=> js
51checkInlinedSchema proxy js = toInlinedSchema proxy <=> js
44
52
@@ -59,6 +67,9 @@ spec = do
59 context "Person" $ checkToSchema (Proxy :: Proxy Person) personSchemaJSON
67 context "Person" $ checkToSchema (Proxy :: Proxy Person) personSchemaJSON
60 context "ISPair" $ checkToSchema (Proxy :: Proxy ISPair) ispairSchemaJSON
68 context "ISPair" $ checkToSchema (Proxy :: Proxy ISPair) ispairSchemaJSON
61 context "Point (fieldLabelModifier)" $ checkToSchema (Proxy :: Proxy Point) pointSchemaJSON
69 context "Point (fieldLabelModifier)" $ checkToSchema (Proxy :: Proxy Point) pointSchemaJSON
70+ context "Point5 (many field record)" $ do
71+ checkToSchema (Proxy :: Proxy Point5) point5SchemaJSON
72+ checkProperties (Proxy :: Proxy Point5) point5Properties
62 context "Color (bounded enum)" $ checkToSchema (Proxy :: Proxy Color) colorSchemaJSON
73 context "Color (bounded enum)" $ checkToSchema (Proxy :: Proxy Color) colorSchemaJSON
63 context "Shade (paramSchemaToNamedSchema)" $ checkToSchema (Proxy :: Proxy Shade) shadeSchemaJSON
74 context "Shade (paramSchemaToNamedSchema)" $ checkToSchema (Proxy :: Proxy Shade) shadeSchemaJSON
64 context "Paint (record with bounded enum field)" $ checkToSchema (Proxy :: Proxy Paint) paintSchemaJSON
75 context "Paint (record with bounded enum field)" $ checkToSchema (Proxy :: Proxy Paint) paintSchemaJSON
@@ -144,6 +155,7 @@ ispairSchemaJSON = [aesonQQ|
144-- ========================================================================
155-- ========================================================================
145-- Point (record data type with custom fieldLabelModifier)
156-- Point (record data type with custom fieldLabelModifier)
146-- ========================================================================
157-- ========================================================================
158+
147data Point = Point
159data Point = Point
148 { pointX :: Double
160 { pointX :: Double
149 , pointY :: Double
161 , pointY :: Double
@@ -166,6 +178,40 @@ pointSchemaJSON = [aesonQQ|
166}
178}
167|]
179|]
168
180
181+-- ========================================================================
182+-- Point (record data type with multiple fields)
183+-- ========================================================================
184+
185+data Point5 = Point5
186+ { point5X :: Double
187+ , point5Y :: Double
188+ , point5Z :: Double
189+ , point5U :: Double
190+ , point5V :: Double -- 5 dimensional!
191+ } deriving (Generic)
192+
193+instance ToSchema Point5 where
194+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
195+ { fieldLabelModifier = map toLower . drop (length "point5") }
196+
197+point5SchemaJSON :: Value
198+point5SchemaJSON = [aesonQQ|
199+{
200+ "type": "object",
201+ "properties":
202+ {
203+ "x": { "type": "number", "format": "double" },
204+ "y": { "type": "number", "format": "double" },
205+ "z": { "type": "number", "format": "double" },
206+ "u": { "type": "number", "format": "double" },
207+ "v": { "type": "number", "format": "double" }
208+ },
209+ "required": ["x", "y", "z", "u", "v"]
210+}
211+|]
212+
213+point5Properties :: [String]
214+point5Properties = ["x", "y", "z", "u", "v"]
169
215
170-- ========================================================================
216-- ========================================================================
171-- Color (enum)
217-- Color (enum)