From 6d386aaa901b0f18925d80e7027f48d8a975f343 Mon Sep 17 00:00:00 2001
From: Andrew Gibiansky <andrew.gibiansky@gmail.com>
Date: Tue, 5 Apr 2016 17:47:23 -0700
Subject: [PATCH] Fix a bunch of minor bugs in the Haskell generator

---
 .../codegen/languages/HaskellServantCodegen.java     | 12 +++++++++++-
 .../src/main/resources/haskell-servant/API.mustache  | 10 +++++-----
 .../haskell-servant/haskell-servant-codegen.mustache |  1 +
 3 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellServantCodegen.java b/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellServantCodegen.java
index 4916effd8b9..a78bb441c48 100644
--- a/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellServantCodegen.java
+++ b/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellServantCodegen.java
@@ -156,6 +156,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
         typeMapping.put("file", "FilePath");
         typeMapping.put("number", "Double");
         typeMapping.put("integer", "Int");
+        typeMapping.put("any", "Value");
 
         importMapping.clear();
         importMapping.put("Map", "qualified Data.Map as Map");
@@ -216,6 +217,9 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
         additionalProperties.put("titleLower", apiName.substring(0, 1).toLowerCase() + apiName.substring(1));
         additionalProperties.put("package", cabalName);
 
+        // Due to the way servant resolves types, we need a high context stack limit
+        additionalProperties.put("contextStackLimit", swagger.getPaths().size() * 2 + 300);
+
         List<Map<String, Object>> replacements = new ArrayList<>();
         Object[] replacementChars = specialCharReplacements.keySet().toArray();
         for(int i = 0; i < replacementChars.length; i++) {
@@ -269,6 +273,8 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
                 return toModelName(type);
         } else if(swaggerType == "object") {
             type = "Value";
+        } else if(typeMapping.containsValue(swaggerType)) {
+            type = swaggerType + "_";
         } else {
             type = swaggerType;
         }
@@ -423,7 +429,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
         if (returnType.indexOf(" ") >= 0) {
             returnType = "(" + returnType + ")";
         }
-        path.add(camelize(op.httpMethod.toLowerCase()) + " '[JSON] " + returnType);
+        path.add("Verb '" + op.httpMethod.toUpperCase() + " 200 '[JSON] " + returnType);
         type.add("m " + returnType);
 
         op.vendorExtensions.put("x-routeType", joinStrings(" :> ", path));
@@ -473,6 +479,9 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
 
         // Clean up the class name to remove invalid characters
         model.classname = fixModelChars(model.classname);
+        if(typeMapping.containsValue(model.classname)) {
+            model.classname += "_";
+        }
 
         // From the model name, compute the prefix for the fields.
         String prefix = camelize(model.classname, true);
@@ -499,6 +508,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
     public CodegenParameter fromParameter(Parameter param, Set<String> imports) {
         CodegenParameter p = super.fromParameter(param, imports);
         p.vendorExtensions.put("x-formParamName", camelize(p.baseName));
+        p.dataType = fixModelChars(p.dataType);
         return p;
     }
 }
diff --git a/modules/swagger-codegen/src/main/resources/haskell-servant/API.mustache b/modules/swagger-codegen/src/main/resources/haskell-servant/API.mustache
index 65c017bafb4..82cc63c8055 100644
--- a/modules/swagger-codegen/src/main/resources/haskell-servant/API.mustache
+++ b/modules/swagger-codegen/src/main/resources/haskell-servant/API.mustache
@@ -1,6 +1,6 @@
 {-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, FlexibleInstances, OverloadedStrings, ViewPatterns #-}
 {-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, DeriveTraversable, FlexibleContexts, DeriveGeneric #-}
-{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports -fcontext-stack={{contextStackLimit}} #-}
 module {{title}}.API (
   -- * Client and Server
   ServerConfig(..),
@@ -33,13 +33,13 @@ import GHC.Exts (IsString(..))
 import qualified Data.Map as Map
 import GHC.Generics (Generic)
 import Data.Monoid ((<>))
-import Servant.API.Verbs (Verb, StdMethod(HEAD))
+import Servant.API.Verbs (Verb, StdMethod(..))
 import Control.Monad.Except (ExceptT)
 import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
+import Network.HTTP.Types.Method (methodOptions)
 
-
--- | HEAD with 200 status code.
-type Head = Verb 'HEAD 200
+instance ReflectMethod 'OPTIONS where
+  reflectMethod _ = methodOptions
 
 
 {{#apiInfo}}{{#apis}}{{#operations}}{{#operation}}{{#hasFormParams}}
diff --git a/modules/swagger-codegen/src/main/resources/haskell-servant/haskell-servant-codegen.mustache b/modules/swagger-codegen/src/main/resources/haskell-servant/haskell-servant-codegen.mustache
index dd868d64b84..18a29c87db1 100644
--- a/modules/swagger-codegen/src/main/resources/haskell-servant/haskell-servant-codegen.mustache
+++ b/modules/swagger-codegen/src/main/resources/haskell-servant/haskell-servant-codegen.mustache
@@ -29,4 +29,5 @@ library
                      , transformers
                      , mtl
                      , http-client
+                     , http-types
   default-language:    Haskell2010