diff --git a/src/Data/Swagger/Internal.hs b/src/Data/Swagger/Internal.hs index 2022c12..430fc56 100644 --- a/src/Data/Swagger/Internal.hs +++ b/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 diff --git a/src/Data/Swagger/Internal/Utils.hs b/src/Data/Swagger/Internal/Utils.hs index 6f7e1a0..2795b4a 100644 --- a/src/Data/Swagger/Internal/Utils.hs +++ b/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 diff --git a/test/Data/Swagger/SchemaSpec.hs b/test/Data/Swagger/SchemaSpec.hs index d4d3110..e74b2df 100644 --- a/test/Data/Swagger/SchemaSpec.hs +++ b/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 = diff --git a/test/Data/SwaggerSpec.hs b/test/Data/SwaggerSpec.hs index 8053cf1..ef3517e 100644 --- a/test/Data/SwaggerSpec.hs +++ b/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) diff --git a/test/SpecCommon.hs b/test/SpecCommon.hs index 3aa6494..368285c 100644 --- a/test/SpecCommon.hs +++ b/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