packages feed

swagger2 1.1.1 → 1.2

raw patch · 7 files changed

+65/−25 lines, 7 files

Files

CHANGELOG.md view
@@ -1,3 +1,15 @@+1.2+---+* Minor changes (see [#36](https://github.com/GetShopTV/swagger2/pull/36)):+  * Change default `ToSchema` instance for unit data types (i.e. types with one nullable constructor like `data Unit = Unit`):+    now these types are treated like sum types with only one alternative;+  * Add generic `ToParamSchema` instance for unit data types;+  * Add `items: []` to schema for `()` (making it a valid schema).++* Fixes:+    * Do not omit `items: []` from `Schema` JSON;+    * Do not generate unused definitions for nested `newtype`s (see [#38](https://github.com/GetShopTV/swagger2/pull/38)).+ 1.1.1 --- * Fixes:
src/Data/Swagger/Internal.hs view
@@ -906,7 +906,10 @@   toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")  instance ToJSON Schema where-  toJSON = omitEmpties . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")+  toJSON = omitEmptiesExcept f . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")+    where+      f "items" (Array _) = True+      f _ _ = False  instance ToJSON Header where   toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")@@ -985,7 +988,10 @@   toJSON CollectionMulti = "multi"  instance ToJSON (ParamSchema t) where-  toJSON = omitEmpties . genericToJSONWithSub "items" (jsonPrefix "paramSchema")+  toJSON = omitEmptiesExcept f . genericToJSONWithSub "items" (jsonPrefix "paramSchema")+    where+      f "items" (Array _) = True+      f _ _ = False  -- ======================================================================= -- Manual FromJSON instances
src/Data/Swagger/Internal/ParamSchema.hs view
@@ -206,6 +206,9 @@ instance GToParamSchema f => GToParamSchema (D1 d f) where   gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f) +instance Constructor c => GToParamSchema (C1 c U1) where+  gtoParamSchema = genumParamSchema+ instance GToParamSchema f => GToParamSchema (C1 c (S1 s f)) where   gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
src/Data/Swagger/Internal/Schema.hs view
@@ -292,7 +292,9 @@  instance (ToSchema a, ToSchema b) => ToSchema (Either a b) -instance ToSchema ()+instance ToSchema () where+  declareNamedSchema _ = pure (Nothing, nullarySchema)+ instance (ToSchema a, ToSchema b) => ToSchema (a, b) instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)@@ -418,6 +420,7 @@ nullarySchema = mempty   & schemaType .~ SwaggerArray   & schemaEnum ?~ [ toJSON () ]+  & schemaItems ?~ SwaggerItemsArray []  gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty@@ -425,9 +428,6 @@ gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare Definitions Schema gdeclareSchema opts proxy = snd <$> gdeclareNamedSchema opts proxy mempty -instance GToSchema U1 where-  gdeclareNamedSchema _ _ _ = plain nullarySchema- instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where   gdeclareNamedSchema opts _ schema = do     (_, gschema) <- gdeclareNamedSchema opts (Proxy :: Proxy g) schema@@ -441,16 +441,21 @@ instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where   gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f) +instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where+  gdeclareNamedSchema = gdeclareNamedSumSchema+ -- | Single field constructor. instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where   gdeclareNamedSchema opts _ s     | unwrapUnaryRecords opts = fieldSchema-    | otherwise = do-        (_, schema) <- recordSchema+    | otherwise =         case schema ^. schemaItems of           Just (SwaggerItemsArray [_]) -> fieldSchema-          _ -> pure (unnamed schema)+          _ -> do+            declare defs+            return (unnamed schema)     where+      (defs, (_, schema)) = runDeclare recordSchema mempty       recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s       fieldSchema  = gdeclareNamedSchema opts (Proxy :: Proxy f) s @@ -511,16 +516,19 @@   gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)  instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where-  gdeclareNamedSchema opts _ s-    | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)-    | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema-    where-      declareSumSchema = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s-      (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)+  gdeclareNamedSchema = gdeclareNamedSumSchema -      toStringTag schema = mempty-        & schemaType .~ SwaggerString-        & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)+gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare Definitions NamedSchema+gdeclareNamedSumSchema opts proxy s+  | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)+  | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema+  where+    declareSumSchema = gsumToSchema opts proxy s+    (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)++    toStringTag schema = mempty+      & schemaType .~ SwaggerString+      & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)  type AllNullary = All
src/Data/Swagger/Internal/Utils.hs view
@@ -58,11 +58,14 @@   where     ys = zip (map toJSON xs) xs -omitEmpties :: Value -> Value-omitEmpties (Object o) = Object (HashMap.filter nonEmpty o)+omitEmptiesExcept :: (Text -> Value -> Bool) -> Value -> Value+omitEmptiesExcept f (Object o) = Object (HashMap.filterWithKey nonEmpty o)   where-    nonEmpty js = (js /= Object mempty) && (js /= Array mempty) && (js /= Null)-omitEmpties js = js+    nonEmpty k js = f k js || (js /= Object mempty) && (js /= Array mempty) && (js /= Null)+omitEmptiesExcept _ js = js++omitEmpties :: Value -> Value+omitEmpties = omitEmptiesExcept (\_ _ -> False)  genericToJSONWithSub :: (Generic a, GToJSON (Rep a)) => Text -> Options -> a -> Value genericToJSONWithSub sub opts x =
swagger2.cabal view
@@ -1,5 +1,5 @@ name:                swagger2-version:             1.1.1+version:             1.2 synopsis:            Swagger 2.0 data model description:         Please see README.md homepage:            https://github.com/GetShopTV/swagger2
test/Data/Swagger/SchemaSpec.hs view
@@ -83,6 +83,7 @@     context "Character" $ checkDefs (Proxy :: Proxy Character) ["Player", "Point"]     context "MyRoseTree" $ checkDefs (Proxy :: Proxy MyRoseTree) ["RoseTree"]     context "[Set (Unit, Maybe Color)]" $ checkDefs (Proxy :: Proxy [Set (Unit, Maybe Color)]) ["Unit", "Color"]+    context "ResourceId" $ checkDefs (Proxy :: Proxy ResourceId) []   describe "Inlining Schemas" $ do     context "Paint" $ checkInlinedSchema (Proxy :: Proxy Paint) paintInlinedSchemaJSON     context "Character" $ checkInlinedSchema (Proxy :: Proxy Character) characterInlinedSchemaJSON@@ -404,8 +405,8 @@ unitSchemaJSON :: Value unitSchemaJSON = [aesonQQ| {-  "type": "array",-  "enum": [[]]+  "type": "string",+  "enum": ["Unit"] } |] @@ -573,3 +574,10 @@ } |] +-- ========================================================================+-- ResourceId (series of newtypes)+-- ========================================================================++newtype Id = Id String deriving (Generic, ToSchema)++newtype ResourceId = ResourceId Id deriving (Generic, ToSchema)