Added ContentTypes handling from swaggerJson to generated contract

byteally · Nov 26, 2018 · 87f4f7e · 87f4f7e
1 parent f735d88
commit 87f4f7e
Showing 1 changed file with 18 additions and 4 deletions.
diff --git a/webapi-swagger/src/ContractGen.hs b/webapi-swagger/src/ContractGen.hs
@@ -213,18 +213,19 @@ readSwaggerJSON petstoreJSONContents= do
         (mApiOutType, apiErrType) <- getApiType (currentRouteName ++ show stdMethod) apiResponses
         -- TODO: Case match on ApiOut and if `Nothing` then check for default responses in `_responsesDefault $ _operationResponses operationData`
         let apiOutType = fromMaybe "()" mApiOutType
-        let mContentTypes = 
+        let addPlainText = 
               case apiOutType of
-                "()" -> Just "'[PlainText]"
-                "Text" -> Just "'[PlainText]"
-                _ -> Nothing
+                "()" -> True
+                "Text" -> True
+                _ -> False
         -- Group the Referenced Params by ParamLocation and then go through each group separately.
         let (formParamList, queryParamList, fileParamList, headerInList, bodyParamList) = DL.foldl' (groupParamTypes) ([], [], [], [], []) (_operationParameters operationData)
         mFormParamType <- getParamTypes (currentRouteName ++ show stdMethod) formParamList FormParam
         mQueryParamType <- getParamTypes (currentRouteName ++ show stdMethod) queryParamList QueryParam
         mFileParamType <- getParamTypes (currentRouteName ++ show stdMethod) fileParamList FileParam
         mHeaderInType <- getParamTypes (currentRouteName ++ show stdMethod) headerInList HeaderParam
         mReqBodyType <- getParamTypes (currentRouteName ++ show stdMethod) bodyParamList BodyParam
+        let mContentTypes = getContentTypes (_operationProduces operationData) addPlainText
         let finalReqBodyType = flip fmap mReqBodyType (\reqBodyType -> 
               case (DL.isPrefixOf "[" reqBodyType) of
                 True -> "'" ++ reqBodyType
@@ -252,6 +253,19 @@ readSwaggerJSON petstoreJSONContents= do
                       SwaggerFile -> (formParamList, queryParamList, param:fileParamList, headerInList, bodyParamList) 
                       _ -> (param:formParamList, queryParamList, fileParamList, headerInList, bodyParamList) 
 
+  getContentTypes :: Maybe MimeList -> Bool -> Maybe String
+  getContentTypes mContentList addPlainText = do
+    let plainTextList = if addPlainText then ["PlainText"] else []
+    case mContentList of 
+      Just contentList -> 
+        case getMimeList contentList of
+          [] -> Nothing
+          mimeList -> Just $ '\'':DL.filter (/= '"') (show $ plainTextList ++ flip fmap mimeList (\mimeType -> case mimeType of
+            "application/xml" -> "XML"
+            "application/json" -> "JSON" ) )
+      Nothing -> Nothing
+
+  -- constructContentTypesList :: [String]
 
   getApiType :: String -> InsOrdHashMap HttpStatusCode (Referenced Response)  -> StateT [CreateNewType] IO (Maybe String, Maybe String)
   getApiType newTypeName responsesHM = foldlWithKey' (\stateConfigWrappedTypes currentCode currentResponse -> do