Tests' changes

- make checkDefs stricter (tests)
- add multiple-fields tests

src/Data/Swagger/Internal/Schema.hs

@@ -567,8 +567,8 @@ gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts prox
 
 instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
   gdeclareNamedSchema opts _ schema = do
-    NamedSchema _ gschema <- gdeclareNamedSchema opts (Proxy :: Proxy g) schema
-    gdeclareNamedSchema opts (Proxy :: Proxy f) gschema
+    NamedSchema _ gschema <- gdeclareNamedSchema opts (Proxy :: Proxy f) schema
+    gdeclareNamedSchema opts (Proxy :: Proxy g) gschema
 
 instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
   gdeclareNamedSchema opts _ s = rename name <$> gdeclareNamedSchema opts (Proxy :: Proxy f) s
@@ -617,7 +617,7 @@ gdeclareSchemaRef opts proxy = do
 
 appendItem :: Referenced Schema -> Maybe (SwaggerItems Schema) -> Maybe (SwaggerItems Schema)
 appendItem x Nothing = Just (SwaggerItemsArray [x])
-appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (x:xs))
+appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
 appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
 
 withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
@@ -633,7 +633,7 @@ withFieldSchema opts _ isRequiredField schema = do
         & type_ .~ SwaggerObject
         & properties . at fname ?~ ref
         & if isRequiredField
-            then required %~ (fname :)
+            then required %~ (++ [fname])
             else id
   where
     fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
@@ -673,7 +673,7 @@ class GSumToSchema f where
   gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
 
 instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
-  gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) <=< gsumToSchema opts (Proxy :: Proxy g)
+  gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
 
 gsumConToSchemaWith :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
   Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema

test/Data/Swagger/SchemaSpec.hs

@@ -7,6 +7,7 @@ module Data.Swagger.SchemaSpec where
 import Prelude ()
 import Prelude.Compat
 
+import Control.Lens ((^.))
 import Data.Aeson
 import Data.Aeson.QQ
 import Data.Char
@@ -35,10 +36,17 @@ checkSchemaName sname proxy =
 checkDefs :: ToSchema a => Proxy a -> [String] -> Spec
 checkDefs proxy names =
   it ("uses these definitions " ++ show names) $
-    Set.fromList (OrdHashMap.keys defs) `shouldBe` Set.fromList (map Text.pack names)
+    OrdHashMap.keys defs `shouldBe` map Text.pack names
   where
     defs = execDeclare (declareNamedSchema proxy) mempty
 
+checkProperties :: ToSchema a => Proxy a -> [String] -> Spec
+checkProperties proxy names =
+  it ("has these fields in order " ++ show names) $
+    OrdHashMap.keys fields `shouldBe` map Text.pack names
+  where
+    fields = toSchema proxy ^. properties
+
 checkInlinedSchema :: ToSchema a => Proxy a -> Value -> Spec
 checkInlinedSchema proxy js = toInlinedSchema proxy <=> js
 
@@ -59,6 +67,9 @@ spec = do
     context "Person" $ checkToSchema (Proxy :: Proxy Person) personSchemaJSON
     context "ISPair" $ checkToSchema (Proxy :: Proxy ISPair) ispairSchemaJSON
     context "Point (fieldLabelModifier)" $ checkToSchema (Proxy :: Proxy Point) pointSchemaJSON
+    context "Point5 (many field record)" $ do
+      checkToSchema (Proxy :: Proxy Point5) point5SchemaJSON
+      checkProperties (Proxy :: Proxy Point5) point5Properties
     context "Color (bounded enum)" $ checkToSchema (Proxy :: Proxy Color) colorSchemaJSON
     context "Shade (paramSchemaToNamedSchema)" $ checkToSchema (Proxy :: Proxy Shade) shadeSchemaJSON
     context "Paint (record with bounded enum field)" $ checkToSchema (Proxy :: Proxy Paint) paintSchemaJSON
@@ -144,6 +155,7 @@ ispairSchemaJSON = [aesonQQ|
 -- ========================================================================
 -- Point (record data type with custom fieldLabelModifier)
 -- ========================================================================
+
 data Point = Point
   { pointX :: Double
   , pointY :: Double
@@ -166,6 +178,40 @@ pointSchemaJSON = [aesonQQ|
 }
 |]
 
+-- ========================================================================
+-- Point (record data type with multiple fields)
+-- ========================================================================
+
+data Point5 = Point5
+  { point5X :: Double
+  , point5Y :: Double
+  , point5Z :: Double
+  , point5U :: Double
+  , point5V :: Double -- 5 dimensional!
+  } deriving (Generic)
+
+instance ToSchema Point5 where
+  declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
+    { fieldLabelModifier = map toLower . drop (length "point5") }
+
+point5SchemaJSON :: Value
+point5SchemaJSON = [aesonQQ|
+{
+  "type": "object",
+  "properties":
+    {
+      "x": { "type": "number", "format": "double" },
+      "y": { "type": "number", "format": "double" },
+      "z": { "type": "number", "format": "double" },
+      "u": { "type": "number", "format": "double" },
+      "v": { "type": "number", "format": "double" }
+    },
+  "required": ["x", "y", "z", "u", "v"]
+}
+|]
+
+point5Properties :: [String]
+point5Properties = ["x", "y", "z", "u", "v"]
 
 -- ========================================================================
 -- Color (enum)