git.iko.soy/typeable/swagger2
on master help sign in
Merge pull request #22 from GetShopTV/reduce-noise-#11

Reduce noise in ToJSON output

commitd776474e3e7730f34b2fdbcef4f47c4d09218fba authorNickolay Kudasov <fizruk@users.noreply.github.com> dateSun 13 Dec 2015, 03:30 (11 years ago) parent49d1fade07b402
5 files changed+31−25
compare with master
unifiedsplit
src/Data/Swagger/Internal.hs+14−7 src/Data/Swagger/Internal/Utils.hs+6 test/Data/Swagger/SchemaSpec.hs+1−1 test/Data/SwaggerSpec.hs+10−10 test/SpecCommon.hs−7
src/Data/Swagger/Internal.hs+14−7
@@ -722,9 +722,6 @@ deriveJSONDefault ''Scheme
722722deriveJSON' ''Tag
723723deriveJSON' ''ExternalDocs
724724
725−deriveToJSON' ''Operation
726−deriveToJSON' ''Response
727−deriveToJSON' ''PathItem
728725deriveToJSON' ''Xml
729726
730727-- =======================================================================
@@ -747,7 +744,7 @@ instance ToJSON OAuth2Flow where
747744 , "tokenUrl" .= tokenUrl ]
748745
749746instance ToJSON OAuth2Params where
750− toJSON = genericToJSONWithSub "flow" (jsonPrefix "oauth2")
747+ toJSON = omitEmpties . genericToJSONWithSub "flow" (jsonPrefix "oauth2")
751748
752749instance ToJSON SecuritySchemeType where
753750 toJSON SecuritySchemeBasic
@@ -760,7 +757,7 @@ instance ToJSON SecuritySchemeType where
760757 <+> object [ "type" .= ("oauth2" :: Text) ]
761758
762759instance ToJSON Swagger where
763− toJSON = addVersion . genericToJSON (jsonPrefix "")
760+ toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "")
764761 where
765762 addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
766763 addVersion _ = error "impossible"
@@ -769,7 +766,7 @@ instance ToJSON SecurityScheme where
769766 toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
770767
771768instance ToJSON Schema where
772− toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "schema")
769+ toJSON = omitEmpties . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")
773770
774771instance ToJSON Header where
775772 toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")
@@ -804,7 +801,17 @@ instance ToJSON SchemaItems where
804801 toJSON (SchemaItemsArray xs) = toJSON xs
805802
806803instance ToJSON Responses where
807− toJSON (Responses def rs) = toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
804+ toJSON (Responses def rs) = omitEmpties $
805+ toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
806+
807+instance ToJSON Response where
808+ toJSON = omitEmpties . genericToJSON (jsonPrefix "response")
809+
810+instance ToJSON Operation where
811+ toJSON = omitEmpties . genericToJSON (jsonPrefix "operation")
812+
813+instance ToJSON PathItem where
814+ toJSON = omitEmpties . genericToJSON (jsonPrefix "pathItem")
808815
809816instance ToJSON Example where
810817 toJSON = toJSON . Map.mapKeys show . getExample
src/Data/Swagger/Internal/Utils.hs+6
@@ -60,6 +60,12 @@ parseOneOf xs js =
6060 where
6161 ys = zip (map toJSON xs) xs
6262
63+omitEmpties :: Value -> Value
64+omitEmpties (Object o) = Object (HashMap.filter nonEmpty o)
65+ where
66+ nonEmpty js = (js /= Object mempty) && (js /= Array mempty) && (js /= Null)
67+omitEmpties js = js
68+
6369genericToJSONWithSub :: (Generic a, GToJSON (Rep a)) => Text -> Options -> a -> Value
6470genericToJSONWithSub sub opts x =
6571 case genericToJSON opts x of
test/Data/Swagger/SchemaSpec.hs+1−1
@@ -23,7 +23,7 @@ import SpecCommon
2323import Test.Hspec
2424
2525checkToSchema :: ToSchema a => Proxy a -> Value -> Spec
26−checkToSchema proxy js = toSchema proxy <~> js
26+checkToSchema proxy js = toSchema proxy <=> js
2727
2828checkSchemaName :: ToSchema a => Maybe String -> Proxy a -> Spec
2929checkSchemaName sname proxy =
test/Data/SwaggerSpec.hs+10−10
@@ -21,18 +21,18 @@ spec = do
2121 describe "License Object" $ licenseExample <=> licenseExampleJSON
2222 describe "Contact Object" $ contactExample <=> contactExampleJSON
2323 describe "Info Object" $ infoExample <=> infoExampleJSON
24− describe "Operation Object" $ operationExample <~> operationExampleJSON
24+ describe "Operation Object" $ operationExample <=> operationExampleJSON
2525 describe "Schema Object" $ do
26− context "Primitive Sample" $ schemaPrimitiveExample <~> schemaPrimitiveExampleJSON
27− context "Simple Model" $ schemaSimpleModelExample <~> schemaSimpleModelExampleJSON
28− context "Model with Map/Dictionary Properties" $ schemaModelDictExample <~> schemaModelDictExampleJSON
29− context "Model with Example" $ schemaWithExampleExample <~> schemaWithExampleExampleJSON
30− describe "Definitions Object" $ definitionsExample <~> definitionsExampleJSON
31− describe "Parameters Definition Object" $ paramsDefinitionExample <~> paramsDefinitionExampleJSON
32− describe "Responses Definition Object" $ responsesDefinitionExample <~> responsesDefinitionExampleJSON
33− describe "Security Definitions Object" $ securityDefinitionsExample <~> securityDefinitionsExampleJSON
26+ context "Primitive Sample" $ schemaPrimitiveExample <=> schemaPrimitiveExampleJSON
27+ context "Simple Model" $ schemaSimpleModelExample <=> schemaSimpleModelExampleJSON
28+ context "Model with Map/Dictionary Properties" $ schemaModelDictExample <=> schemaModelDictExampleJSON
29+ context "Model with Example" $ schemaWithExampleExample <=> schemaWithExampleExampleJSON
30+ describe "Definitions Object" $ definitionsExample <=> definitionsExampleJSON
31+ describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON
32+ describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON
33+ describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON
3434 describe "Swagger Object" $ do
35− context "Todo Example" $ swaggerExample <~> swaggerExampleJSON
35+ context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
3636 context "PetStore Example" $
3737 it "decodes successfully" $ do
3838 fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: Swagger) -> True; _ -> False)
test/SpecCommon.hs−7
@@ -15,13 +15,6 @@ isSubJSON (Object x) (Object y) = HashMap.keys x == HashMap.keys i && F.and i
1515isSubJSON (Array xs) (Array ys) = Vector.length xs == Vector.length ys && F.and (Vector.zipWith isSubJSON xs ys)
1616isSubJSON x y = x == y
1717
18−(<~>) :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Value -> Spec
19−x <~> js = do
20− it "encodes correctly (probably with extra properties)" $ do
21− toJSON x `shouldSatisfy` (js `isSubJSON`)
22− it "decodes correctly" $ do
23− fromJSON js `shouldBe` Success x
24−
2518(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Value -> Spec
2619x <=> js = do
2720 it "encodes correctly" $ do