git.iko.soy/typeable/swagger2
on master help sign in
Merge pull request #133 from amiddelk/#132-infinite-expansion-datatypenamemodifier

Fixes #132: Nontermination when using datatypeNameModifier with recursive data types

commitc669a64e80bbe8b4e2fdf4f94c2f7fc597ff9fb9 authorNickolay Kudasov <fizruk@users.noreply.github.com> dateSun 31 Dec 2017, 21:01 (9 years ago) parentf014fbc4376384
2 files changed+35−2
compare with master
unifiedsplit
src/Data/Swagger/Internal/Schema.hs+3−2 test/Data/Swagger/SchemaSpec.hs+32
src/Data/Swagger/Internal/Schema.hs+3−2
@@ -680,11 +680,12 @@ genericNameSchema :: forall a d f proxy.
680680genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d))
681681
682682gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text
683−gdatatypeSchemaName opts _ = case name of
683+gdatatypeSchemaName opts _ = case orig of
684684 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
685685 _ -> Nothing
686686 where
687− name = datatypeNameModifier opts (datatypeName (Proxy3 :: Proxy3 d f a))
687+ orig = datatypeName (Proxy3 :: Proxy3 d f a)
688+ name = datatypeNameModifier opts orig
688689
689690-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
690691paramSchemaToNamedSchema :: forall a d f proxy.
test/Data/Swagger/SchemaSpec.hs+32
@@ -80,6 +80,7 @@ spec = do
8080 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
8181 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
8282 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
83+ context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
8384 context "Sum types" $ do
8485 context "Status (sum of unary constructors)" $ checkToSchema (Proxy :: Proxy Status) statusSchemaJSON
8586 context "Character (ref and record sum)" $ checkToSchema (Proxy :: Proxy Character) characterSchemaJSON
@@ -95,6 +96,7 @@ spec = do
9596 context "Light" $ checkDefs (Proxy :: Proxy Light) ["Color"]
9697 context "Character" $ checkDefs (Proxy :: Proxy Character) ["Player", "Point"]
9798 context "MyRoseTree" $ checkDefs (Proxy :: Proxy MyRoseTree) ["RoseTree"]
99+ context "MyRoseTree'" $ checkDefs (Proxy :: Proxy MyRoseTree') ["myrosetree'"]
98100 context "[Set (Unit, Maybe Color)]" $ checkDefs (Proxy :: Proxy [Set (Unit, Maybe Color)]) ["Unit", "Color"]
99101 context "ResourceId" $ checkDefs (Proxy :: Proxy ResourceId) []
100102 describe "Inlining Schemas" $ do
@@ -103,6 +105,7 @@ spec = do
103105 context "Character (inlining only Player)" $ checkInlinedSchemas ["Player"] (Proxy :: Proxy Character) characterInlinedPlayerSchemaJSON
104106 context "Light" $ checkInlinedSchema (Proxy :: Proxy Light) lightInlinedSchemaJSON
105107 context "MyRoseTree (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
108+ context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
106109 describe "Bounded Enum key mapping" $ do
107110 context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON
108111
@@ -398,6 +401,35 @@ myRoseTreeSchemaJSON = [aesonQQ|
398401}
399402|]
400403
404+data MyRoseTree' = MyRoseTree'
405+ { root' :: String
406+ , trees' :: [MyRoseTree']
407+ } deriving (Generic)
408+
409+instance ToSchema MyRoseTree' where
410+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
411+ { datatypeNameModifier = map toLower }
412+
413+myRoseTreeSchemaJSON' :: Value
414+myRoseTreeSchemaJSON' = [aesonQQ|
415+{
416+ "type": "object",
417+ "properties":
418+ {
419+ "root'": { "type": "string" },
420+ "trees'":
421+ {
422+ "type": "array",
423+ "items":
424+ {
425+ "$ref": "#/definitions/myrosetree'"
426+ }
427+ }
428+ },
429+ "required": ["root'", "trees'"]
430+}
431+|]
432+
401433-- ========================================================================
402434-- Inlined (newtype for inlining schemas)
403435-- ========================================================================