Fixed recursing into normalized operations

src/Tie.hs

@@ -120,6 +120,22 @@ normalize =
         pure (inlineArrayElementTypeName enclosingType)
     )
 
+-- | Expands a list of inline definitions until it reaches a fixed point.
+-- The invariant of the returned list is that there are no non-primitive
+-- unnamed types left: 
+--   forall x. normalize x == [] 
+--  where x is an element of the result of normalizedTypes
+normalizeTypes :: Monad m => [(Name, Type)] -> m [(Name, Type)]
+normalizeTypes types =
+  concat
+    <$> traverse
+      ( \(name, type_) -> do
+          (normalizedType, inlineDefinitions) <- normalize name type_
+          normalizedTypes <- normalizeTypes inlineDefinitions
+          pure ((name, normalizedType) : normalizedTypes)
+      )
+      types
+
 generate ::
   MonadIO m =>
   Writer m ->
@@ -214,8 +230,13 @@ generate write packageName apiName extraPackages inputFile = do
             nubOrd (operationSchemaDependencies shallow operation)
     (operation, inlineDefinitions) <-
       normalizeOperation operation
+    -- normalizeOperation doesn't recurse into transitive inline definitions,
+    -- we apply normalizeTypes explicitly to normalize transitive inline definitions
+    -- explicitly
+    normalizedInlineDefinitions <-
+      normalizeTypes inlineDefinitions
     codeForInlineDefinitions <-
-      traverse (uncurry codegenSchema) inlineDefinitions
+      traverse (uncurry codegenSchema) normalizedInlineDefinitions
     responsesCode <- codegenResponses resolver operation
     write path $
       vsep $

test/golden/additional-properties.yaml

@@ -18,6 +18,27 @@ paths:
             application/json:    
               schema:
                 $ref: "#/components/schemas/Pets"
+  /pets2:
+    get:
+      summary: List all pets
+      operationId: listPets2
+      responses:
+        '200':
+          description: A paged array of pets
+          content:
+            application/json:    
+              schema:
+                type: object
+                additionalProperties:
+                  type: object
+                  required: 
+                    - name
+                    - count
+                  properties:
+                    name: 
+                      type: string
+                    count: 
+                      type: integer
 components:
   schemas:
     Pet:

test/golden/additional-properties.yaml.out

@@ -38,11 +38,15 @@ import Test.Response
 import Test.Schemas.Pets
 
 import Test.Response.ListPets
+import Test.Response.ListPets2
 
 data Api m = Api {
     -- | List all pets
     listPets ::
-        m ListPetsResponse
+        m ListPetsResponse,
+    -- | List all pets
+    listPets2 ::
+        m ListPets2Response
 }
 
 application :: (Control.Monad.IO.Class.MonadIO m) => (forall a . Network.Wai.Request -> m a -> IO a) -> Api m -> Network.Wai.Application -> Network.Wai.Application
@@ -58,6 +62,16 @@ application run api notFound request respond =
                 x ->
                     unsupportedMethod x
 
+        ["pets2"] ->
+            case Network.Wai.requestMethod request of
+                "GET" ->
+                    run request (do
+                        response <- listPets2 api
+                        Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
+                    )
+                x ->
+                    unsupportedMethod x
+
         _ ->
             notFound request respond
     where
@@ -317,6 +331,90 @@ instance ToResponse ListPetsResponse where
     toResponse (ListPetsResponse200 x) =
         Network.Wai.responseBuilder Network.HTTP.Types.status200 ([(Network.HTTP.Types.hContentType, "application/json")]) (Data.Aeson.fromEncoding (Data.Aeson.toEncoding x))
 ---------------------
+Test/Response/ListPets2.hs
+
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+module Test.Response.ListPets2 where
+
+import qualified Control.Applicative
+import qualified Control.Exception
+import qualified Control.Monad
+import qualified Control.Monad.IO.Class
+import qualified Data.Aeson
+import qualified Data.Aeson.Encoding
+import qualified Data.Aeson.Parser
+import qualified Data.Aeson.Types
+import qualified Data.Attoparsec.ByteString
+import qualified Data.List
+import qualified Data.Map
+import qualified Data.Maybe
+import qualified Data.Text
+import qualified Data.Time
+import qualified Data.Text.Encoding
+import qualified GHC.Float
+import qualified GHC.Int
+import qualified GHC.Types
+import qualified Network.HTTP.Types
+import qualified Network.Wai
+import qualified Web.HttpApiData
+
+
+
+import Test.Response
+
+newtype ListPets2ResponseBody200 = ListPets2ResponseBody200
+    (Data.Map.Map Data.Text.Text (ListPets2ResponseBody200AdditionalProperties))
+    deriving (Show)
+
+instance Data.Aeson.ToJSON ListPets2ResponseBody200 where
+    toJSON (ListPets2ResponseBody200 x) =
+        Data.Aeson.toJSON x
+
+    toEncoding (ListPets2ResponseBody200 x) =
+        Data.Aeson.toEncoding x
+
+instance Data.Aeson.FromJSON ListPets2ResponseBody200 where
+    parseJSON x =
+        ListPets2ResponseBody200 <$> Data.Aeson.parseJSON x
+
+data ListPets2ResponseBody200AdditionalProperties = ListPets2ResponseBody200AdditionalProperties
+    {
+        count :: GHC.Int.Int,
+        name :: Data.Text.Text
+    }
+    deriving (Show)
+
+instance Data.Aeson.ToJSON ListPets2ResponseBody200AdditionalProperties where
+    toJSON ListPets2ResponseBody200AdditionalProperties {..} = Data.Aeson.object
+        [
+            "count" Data.Aeson..= count,
+            "name" Data.Aeson..= name
+        ]
+
+    toEncoding ListPets2ResponseBody200AdditionalProperties {..} = Data.Aeson.Encoding.pairs
+        ( Data.Aeson.Encoding.pair "count" (Data.Aeson.toEncoding count) <>
+          Data.Aeson.Encoding.pair "name" (Data.Aeson.toEncoding name)
+        )
+
+instance Data.Aeson.FromJSON ListPets2ResponseBody200AdditionalProperties where
+    parseJSON = Data.Aeson.withObject "ListPets2ResponseBody200AdditionalProperties" $ \o ->
+        ListPets2ResponseBody200AdditionalProperties
+            <$> o Data.Aeson..: "count"
+            <*> o Data.Aeson..: "name"
+
+data ListPets2Response
+    = ListPets2Response200 ListPets2ResponseBody200
+    deriving (Show)
+
+instance ToResponse ListPets2Response where
+    toResponse (ListPets2Response200 x) =
+        Network.Wai.responseBuilder Network.HTTP.Types.status200 ([(Network.HTTP.Types.hContentType, "application/json")]) (Data.Aeson.fromEncoding (Data.Aeson.toEncoding x))
+---------------------
 Test/Schemas/Pet.hs
 
 {-# LANGUAGE BangPatterns #-}
@@ -456,5 +554,6 @@ library
     Test.Request
     Test.Response
     Test.Response.ListPets
+    Test.Response.ListPets2
     Test.Schemas.Pet
     Test.Schemas.Pets