Reduce noise in ToJSON output

src/Data/Swagger/Internal.hs

@@ -722,9 +722,6 @@ deriveJSONDefault ''Scheme
 deriveJSON' ''Tag
 deriveJSON' ''ExternalDocs
 
-deriveToJSON' ''Operation
-deriveToJSON' ''Response
-deriveToJSON' ''PathItem
 deriveToJSON' ''Xml
 
 -- =======================================================================
@@ -747,7 +744,7 @@ instance ToJSON OAuth2Flow where
     , "tokenUrl"         .= tokenUrl ]
 
 instance ToJSON OAuth2Params where
-  toJSON = genericToJSONWithSub "flow" (jsonPrefix "oauth2")
+  toJSON = omitEmpties . genericToJSONWithSub "flow" (jsonPrefix "oauth2")
 
 instance ToJSON SecuritySchemeType where
   toJSON SecuritySchemeBasic
@@ -760,7 +757,7 @@ instance ToJSON SecuritySchemeType where
     <+> object [ "type" .= ("oauth2" :: Text) ]
 
 instance ToJSON Swagger where
-  toJSON = addVersion . genericToJSON (jsonPrefix "")
+  toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "")
     where
       addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
       addVersion _ = error "impossible"
@@ -769,7 +766,7 @@ instance ToJSON SecurityScheme where
   toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
 
 instance ToJSON Schema where
-  toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "schema")
+  toJSON = omitEmpties . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")
 
 instance ToJSON Header where
   toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")
@@ -804,7 +801,17 @@ instance ToJSON SchemaItems where
   toJSON (SchemaItemsArray xs) = toJSON xs
 
 instance ToJSON Responses where
-  toJSON (Responses def rs) = toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
+  toJSON (Responses def rs) = omitEmpties $
+    toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
+
+instance ToJSON Response where
+  toJSON = omitEmpties . genericToJSON (jsonPrefix "response")
+
+instance ToJSON Operation where
+  toJSON = omitEmpties . genericToJSON (jsonPrefix "operation")
+
+instance ToJSON PathItem where
+  toJSON = omitEmpties . genericToJSON (jsonPrefix "pathItem")
 
 instance ToJSON Example where
   toJSON = toJSON . Map.mapKeys show . getExample

src/Data/Swagger/Internal/Utils.hs

@@ -60,6 +60,12 @@ parseOneOf xs js =
   where
     ys = zip (map toJSON xs) xs
 
+omitEmpties :: Value -> Value
+omitEmpties (Object o) = Object (HashMap.filter nonEmpty o)
+  where
+    nonEmpty js = (js /= Object mempty) && (js /= Array mempty) && (js /= Null)
+omitEmpties js = js
+
 genericToJSONWithSub :: (Generic a, GToJSON (Rep a)) => Text -> Options -> a -> Value
 genericToJSONWithSub sub opts x =
   case genericToJSON opts x of

test/Data/Swagger/SchemaSpec.hs

@@ -23,7 +23,7 @@ import SpecCommon
 import Test.Hspec
 
 checkToSchema :: ToSchema a => Proxy a -> Value -> Spec
-checkToSchema proxy js = toSchema proxy <~> js
+checkToSchema proxy js = toSchema proxy <=> js
 
 checkSchemaName :: ToSchema a => Maybe String -> Proxy a -> Spec
 checkSchemaName sname proxy =

test/Data/SwaggerSpec.hs

@@ -21,18 +21,18 @@ spec = do
   describe "License Object" $ licenseExample <=> licenseExampleJSON
   describe "Contact Object" $ contactExample <=> contactExampleJSON
   describe "Info Object" $ infoExample <=> infoExampleJSON
-  describe "Operation Object" $ operationExample <~> operationExampleJSON
+  describe "Operation Object" $ operationExample <=> operationExampleJSON
   describe "Schema Object" $ do
-    context "Primitive Sample" $ schemaPrimitiveExample <~> schemaPrimitiveExampleJSON
-    context "Simple Model" $ schemaSimpleModelExample <~> schemaSimpleModelExampleJSON
-    context "Model with Map/Dictionary Properties" $ schemaModelDictExample <~> schemaModelDictExampleJSON
-    context "Model with Example" $ schemaWithExampleExample <~> schemaWithExampleExampleJSON
-  describe "Definitions Object" $ definitionsExample <~> definitionsExampleJSON
-  describe "Parameters Definition Object" $ paramsDefinitionExample <~> paramsDefinitionExampleJSON
-  describe "Responses Definition Object" $ responsesDefinitionExample <~> responsesDefinitionExampleJSON
-  describe "Security Definitions Object" $ securityDefinitionsExample <~> securityDefinitionsExampleJSON
+    context "Primitive Sample" $ schemaPrimitiveExample <=> schemaPrimitiveExampleJSON
+    context "Simple Model" $ schemaSimpleModelExample <=> schemaSimpleModelExampleJSON
+    context "Model with Map/Dictionary Properties" $ schemaModelDictExample <=> schemaModelDictExampleJSON
+    context "Model with Example" $ schemaWithExampleExample <=> schemaWithExampleExampleJSON
+  describe "Definitions Object" $ definitionsExample <=> definitionsExampleJSON
+  describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON
+  describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON
+  describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON
   describe "Swagger Object" $ do
-    context "Todo Example" $ swaggerExample <~> swaggerExampleJSON
+    context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
     context "PetStore Example" $
       it "decodes successfully" $ do
         fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: Swagger) -> True; _ -> False)

test/SpecCommon.hs

@@ -15,13 +15,6 @@ isSubJSON (Object x) (Object y) = HashMap.keys x == HashMap.keys i && F.and i
 isSubJSON (Array xs) (Array ys) = Vector.length xs == Vector.length ys && F.and (Vector.zipWith isSubJSON xs ys)
 isSubJSON x y = x == y
 
-(<~>) :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Value -> Spec
-x <~> js = do
-  it "encodes correctly (probably with extra properties)" $ do
-    toJSON x `shouldSatisfy` (js `isSubJSON`)
-  it "decodes correctly" $ do
-    fromJSON js `shouldBe` Success x
-
 (<=>) :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Value -> Spec
 x <=> js = do
   it "encodes correctly" $ do