Normalize params and responses

src/Tie.hs

@@ -49,6 +49,7 @@ import Tie.Name
 import Tie.Operation
   ( Operation (..),
     errors,
+    normalizeOperation,
     operationResponseDependencies,
     operationSchemaDependencies,
     pathItemsToOperation,
@@ -185,19 +186,24 @@ generate write packageName apiName inputFile = do
   for_ operations $ \operation@Operation {name} -> do
     let path = toResponseHaskellFileName apiName name
         header = codegenModuleHeader (toResponseHaskellModuleName apiName name)
-
-        dependencyCode =
+        importsCode =
           codegenSchemaDependencies apiName $
             nubOrd (operationSchemaDependencies shallow operation)
+    (operation, inlineDefinitions) <-
+      normalizeOperation operation
+    codeForInlineDefinitions <-
+      traverse (uncurry codegenSchema) inlineDefinitions
     responsesCode <- codegenResponses resolver operation
     write path $
       vsep
         [ header,
           mempty,
-          dependencyCode,
+          importsCode,
           mempty,
           codegenExtraResponseModuleDependencies apiName,
           mempty,
+          vsep codeForInlineDefinitions,
+          mempty,
           responsesCode
         ]
 

src/Tie/Name.hs

@@ -35,6 +35,9 @@ module Tie.Name
     inlineObjectTypeName,
     inlineVariantTypeName,
     inlineArrayElementTypeName,
+    operationParamTypeName,
+    apiResponseConstructorName,
+    apiDefaultResponseConstructorName,
   )
 where
 
@@ -85,7 +88,7 @@ toSchemaHaskellFileName apiName (Name name) =
   haskellModuleToFilePath apiName <> "/Schemas/" <> capitalizeFirstLetter (Text.unpack name) <> ".hs"
 
 haskellModuleToFilePath :: ApiName -> FilePath
-haskellModuleToFilePath = 
+haskellModuleToFilePath =
   Text.unpack . Text.replace "." "/"
 
 toOperationHaskellModuleName :: ApiName -> Name -> Text
@@ -146,6 +149,15 @@ toParamBinder :: Name -> PP.Doc ann
 toParamBinder =
   PP.pretty . Text.pack . escapeKeyword . lowerFirstLetter . Text.unpack . unName
 
+operationParamTypeName :: Name -> Name -> Name
+operationParamTypeName (Name operationName) (Name paramName) =
+  Name $
+    Text.pack $
+      escapeKeyword $
+        capitalizeFirstLetter (Text.unpack operationName)
+          <> capitalizeFirstLetter (Text.unpack paramName)
+          <> "Param"
+
 toApiMemberName :: Name -> PP.Doc ann
 toApiMemberName =
   PP.pretty . Text.pack . escapeKeyword . lowerFirstLetter . Text.unpack . unName
@@ -158,10 +170,18 @@ toApiResponseConstructorName :: Name -> Int -> PP.Doc ann
 toApiResponseConstructorName name statusCode =
   PP.pretty . Text.pack . escapeKeyword . (<> show statusCode) . (<> "Response") . capitalizeFirstLetter . Text.unpack . unName $ name
 
+apiResponseConstructorName :: Name -> Int -> Name
+apiResponseConstructorName name statusCode =
+  Name . Text.pack . escapeKeyword . (<> show statusCode) . (<> "Response") . capitalizeFirstLetter . Text.unpack . unName $ name
+
 toApiDefaultResponseConstructorName :: Name -> PP.Doc ann
 toApiDefaultResponseConstructorName name =
   PP.pretty . Text.pack . escapeKeyword . (<> "DefaultResponse") . capitalizeFirstLetter . Text.unpack . unName $ name
 
+apiDefaultResponseConstructorName :: Name -> Name
+apiDefaultResponseConstructorName name =
+  Name . Text.pack . escapeKeyword . (<> "DefaultResponse") . capitalizeFirstLetter . Text.unpack . unName $ name
+
 toEnumConstructorName :: Name -> Text -> PP.Doc ann
 toEnumConstructorName (Name typName) variant =
   PP.pretty $

src/Tie/Operation.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
 
 module Tie.Operation
   ( StatusCode,
@@ -28,13 +29,23 @@ module Tie.Operation
     -- * Dependencies
     operationSchemaDependencies,
     operationResponseDependencies,
+
+    -- * Normalization
+    normalizeOperation,
   )
 where
 
+import Control.Monad.Writer (WriterT (..), runWriterT)
 import qualified Data.HashMap.Strict.InsOrd as InsOrd
 import qualified Data.OpenApi as OpenApi
 import qualified Data.Text as Text
-import Tie.Name (Name, fromText)
+import Tie.Name
+  ( Name,
+    apiDefaultResponseConstructorName,
+    apiResponseConstructorName,
+    fromText,
+    operationParamTypeName,
+  )
 import Tie.Resolve (Resolver, resolve)
 import Tie.Type
   ( Named,
@@ -42,6 +53,7 @@ import Tie.Type
     isBasicType,
     namedType,
     namedTypeDependencies,
+    normalizeNamedType,
     schemaRefToType,
   )
 import Prelude hiding (Type)
@@ -366,3 +378,41 @@ pathToPath resolver errors@Errors {..} textualPath params = do
           (isBasicType (namedType (schema param)))
           paramNotBasicType
       pure param
+
+normalizeParam :: Monad m => Name -> Param -> m (Param, [(Name, Type)])
+normalizeParam operationName param@Param {..} = do
+  (normedType, inlineDefinitions) <-
+    normalizeNamedType
+      (pure (operationParamTypeName operationName name))
+      schema
+  pure (param {schema = normedType}, inlineDefinitions)
+
+normalizeResponse :: Monad m => Name -> Response -> m (Response, [(Name, Type)])
+normalizeResponse name response@Response {..} = do
+  (normedType, inlineDefinitions) <- normalizeNamedType (pure name) jsonResponseContent
+  pure (response {jsonResponseContent = normedType}, inlineDefinitions)
+
+normalizeOperation :: Monad m => Operation -> m (Operation, [(Name, Type)])
+normalizeOperation operation@Operation {..} = runWriterT $ do
+  queryParams <-
+    traverse
+      (WriterT . normalizeParam name)
+      queryParams
+  headerParams <-
+    traverse
+      (WriterT . normalizeParam name)
+      headerParams
+  defaultResponse <-
+    traverse
+      (WriterT . normalizeResponse (apiDefaultResponseConstructorName name))
+      defaultResponse
+  responses <-
+    traverse
+      ( \(status, response) ->
+          ( (status,)
+              <$> WriterT
+                (normalizeResponse (apiResponseConstructorName name status) response)
+          )
+      )
+      responses
+  pure Operation {..}

src/Tie/Type.hs

@@ -28,10 +28,8 @@ module Tie.Type
     isOneOfType,
 
     -- * Normalize types
-
-    --    normalizeObjectType,
-    --    normalizeVariants,
     normalizeType,
+    normalizeNamedType,
 
     -- * Dependencies
     namedTypeDependencies,

test/golden/datetime.yaml.out

@@ -115,6 +115,8 @@ import Test.Schemas.Test
 
 import Test.Response
 
+
+
 data TestResponse
     = TestResponse200 Test
 

test/golden/enum.yaml.out

@@ -129,8 +129,28 @@ import qualified Web.HttpApiData
 
 import Test.Response
 
+data ListPackagesResponse200
+    = ListPackagesResponse200A
+    | ListPackagesResponse200B
+    | ListPackagesResponse200C
+    deriving (Eq, Show)
+
+instance Data.Aeson.ToJSON ListPackagesResponse200 where
+    toJSON x = case x of
+        ListPackagesResponse200A -> "A"
+        ListPackagesResponse200B -> "B"
+        ListPackagesResponse200C -> "C"
+
+instance Data.Aeson.FromJSON ListPackagesResponse200 where
+    parseJSON = Data.Aeson.withText "ListPackagesResponse200" $ \s ->
+        case s of
+            "A" -> pure ListPackagesResponse200A
+            "B" -> pure ListPackagesResponse200B
+            "C" -> pure ListPackagesResponse200C
+            _ -> fail "invalid enum value"
+
 data ListPackagesResponse
-    = ListPackagesResponse200 error: Enum
+    = ListPackagesResponse200 ListPackagesResponse200
 
 instance ToResponse ListPackagesResponse where
     toResponse (ListPackagesResponse200 x) =
@@ -166,6 +186,8 @@ import Test.Schemas.Package
 
 import Test.Response
 
+
+
 data ListPackagesResponse
     = ListPackagesResponse200 Package
 

test/golden/lists.yaml.out

@@ -143,6 +143,8 @@ import Test.Schemas.Packages
 
 import Test.Response
 
+
+
 data ListPackagesResponse
     = ListPackagesResponse200 Packages
 
@@ -180,6 +182,8 @@ import Test.Schemas.Package
 
 import Test.Response
 
+
+
 data ListPackages2Response
     = ListPackages2Response200 [ Package ]
 
@@ -217,6 +221,8 @@ import Test.Schemas.Inline
 
 import Test.Response
 
+
+
 data ListPackages3Response
     = ListPackages3Response200 [ Inline ]
 

test/golden/oneof.yaml.out

@@ -143,6 +143,8 @@ import Test.Schemas.Packages
 
 import Test.Response
 
+
+
 data ListPackagesResponse
     = ListPackagesResponse200 Packages
 
@@ -180,6 +182,8 @@ import Test.Schemas.Inline
 
 import Test.Response
 
+
+
 data ListPackages2Response
     = ListPackages2Response200 Inline
 
@@ -217,6 +221,8 @@ import Test.Schemas.Inline2
 
 import Test.Response
 
+
+
 data ListPackages2Response
     = ListPackages2Response200 Inline2
 

test/golden/test1.yaml.out

@@ -178,6 +178,8 @@ import Test.Schemas.Vehicle
 
 import Test.Response
 
+
+
 data CreateUserResponse
     = CreateUserResponse200 Vehicle
 
@@ -215,6 +217,8 @@ import Test.Schemas.Vehicle
 
 import Test.Response
 
+
+
 data GetUserResponse
     = GetUserResponse200 Vehicle