[haskell-servant][haskell-yesod] Use table-based conversion for field name conversion

modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellServantCodegen.java

@@ -658,6 +658,7 @@ public CodegenModel fromModel(String name, Schema mod) {
         String prefix = camelize(model.classname, LOWERCASE_FIRST_LETTER);
         for (CodegenProperty prop : model.vars) {
             prop.name = toVarName(prefix + camelize(prop.name));
+            prop.vendorExtensions.put("x-base-name-string-literal", "\"" + escapeText(prop.getBaseName()) + "\"");
         }
 
         // Create newtypes for things with non-object types
@@ -668,8 +669,6 @@ public CodegenModel fromModel(String name, Schema mod) {
             model.vendorExtensions.put("x-custom-newtype", newtype);
         }
 
-        // Provide the prefix as a vendor extension, so that it can be used in the ToJSON and FromJSON instances.
-        model.vendorExtensions.put("x-prefix", prefix);
         model.vendorExtensions.put("x-data", dataOrNewtype);
 
         return model;

modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellYesodServerCodegen.java

@@ -552,6 +552,7 @@ public CodegenModel fromModel(String name, Schema mod) {
         String prefix = camelize(model.classname, LOWERCASE_FIRST_LETTER);
         for (CodegenProperty prop : model.vars) {
             prop.name = toVarName(prefix + camelize(prop.name));
+            prop.vendorExtensions.put("x-base-name-string-literal", "\"" + escapeText(prop.getBaseName()) + "\"");
         }
 
         // Create newtypes for things with non-object types
@@ -562,8 +563,6 @@ public CodegenModel fromModel(String name, Schema mod) {
             model.vendorExtensions.put("x-custom-newtype", newtype);
         }
 
-        // Provide the prefix as a vendor extension, so that it can be used in the ToJSON and FromJSON instances.
-        model.vendorExtensions.put("x-prefix", prefix);
         model.vendorExtensions.put("x-data", dataOrNewtype);
 
         return model;

modules/openapi-generator/src/main/resources/haskell-servant/Types.mustache

@@ -13,7 +13,7 @@ module {{title}}.Types (
 
 import Data.Data (Data)
 import Data.UUID (UUID)
-import Data.List (stripPrefix)
+import Data.List (lookup)
 import Data.Maybe (fromMaybe)
 import Data.Aeson (Value, FromJSON(..), ToJSON(..), genericToJSON, genericParseJSON)
 import Data.Aeson.Types (Options(..), defaultOptions)
@@ -26,7 +26,6 @@ import qualified Data.Char as Char
 import qualified Data.Text as T
 import qualified Data.Map as Map
 import GHC.Generics (Generic)
-import Data.Function ((&))
 {{#imports}}import {{import}}
 {{/imports}}
 
@@ -42,16 +41,28 @@ import Data.Function ((&))
   } deriving (Show, Eq, Generic, Data)
 
 instance FromJSON {{classname}} where
-  parseJSON = genericParseJSON (removeFieldLabelPrefix "{{vendorExtensions.x-prefix}}")
+  parseJSON = genericParseJSON options{{classname}}
 instance ToJSON {{classname}} where
-  toJSON = genericToJSON (removeFieldLabelPrefix "{{vendorExtensions.x-prefix}}")
+  toJSON = genericToJSON options{{classname}}
 {{#generateToSchema}}
 instance ToSchema {{classname}} where
   declareNamedSchema = Swagger.genericDeclareNamedSchema
     $ Swagger.fromAesonOptions
-    $ removeFieldLabelPrefix "{{vendorExtensions.x-prefix}}"
+    $ options{{classname}}
 {{/generateToSchema}}
 
+options{{classname}} :: Options
+options{{classname}} =
+  defaultOptions
+    { omitNothingFields  = True
+    , fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ lookup s table
+    }
+  where
+    table =
+      [ {{#vars}}("{{& name}}", {{& vendorExtensions.x-base-name-string-literal}}){{^-last}}
+      , {{/-last}}{{/vars}}
+      ]
+
 {{/parent}}
 {{#parent}}
 newtype {{classname}} = {{classname}} { un{{classname}} :: {{parent}} }
@@ -63,23 +74,3 @@ newtype {{classname}} = {{classname}} {{vendorExtensions.x-custom-newtype}} deri
 {{/vendorExtensions.x-custom-newtype}}
 {{/model}}
 {{/models}}
-
-uncapitalize :: String -> String
-uncapitalize (first:rest) = Char.toLower first : rest
-uncapitalize [] = []
-
--- | Remove a field label prefix during JSON parsing.
---   Also perform any replacements for special characters.
-removeFieldLabelPrefix :: String -> Options
-removeFieldLabelPrefix prefix =
-  defaultOptions
-    { omitNothingFields  = True
-    , fieldLabelModifier = uncapitalize . replaceSpecialChars . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix
-    }
-  where
-    replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars)
-    specialChars =
-      [ {{#specialCharReplacements}}("{{&char}}", "{{&replacement}}"){{^-last}}
-      , {{/-last}}{{/specialCharReplacements}}
-      ]
-    mkCharReplacement (replaceStr, searchStr) = T.unpack . T.replace (T.pack searchStr) (T.pack replaceStr) . T.pack

modules/openapi-generator/src/main/resources/haskell-yesod/src/API/Types.mustache

@@ -13,14 +13,14 @@ module {{apiModuleName}}.Types (
 
 import ClassyPrelude.Yesod
 import Data.Foldable (foldl)
+import qualified Data.List as List
 import Data.Maybe (fromMaybe)
 import Data.Aeson (Value, FromJSON(..), ToJSON(..), genericToJSON, genericParseJSON)
 import Data.Aeson.Types (Options(..), defaultOptions)
 import qualified Data.Char as Char
 import qualified Data.Text as T
 import qualified Data.Map as Map
 import GHC.Generics (Generic)
-import Data.Function ((&))
 {{#imports}}import {{import}}
 {{/imports}}
 
@@ -36,9 +36,21 @@ import Data.Function ((&))
   } deriving (Show, Eq, Generic)
 
 instance FromJSON {{classname}} where
-  parseJSON = genericParseJSON (removeFieldLabelPrefix "{{vendorExtensions.x-prefix}}")
+  parseJSON = genericParseJSON options{{classname}}
 instance ToJSON {{classname}} where
-  toJSON = genericToJSON (removeFieldLabelPrefix "{{vendorExtensions.x-prefix}}")
+  toJSON = genericToJSON options{{classname}}
+
+options{{classname}} :: Options
+options{{classname}} =
+  defaultOptions
+    { omitNothingFields  = True
+    , fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ List.lookup s table
+    }
+  where
+    table =
+      [ {{#vars}}("{{& name}}", {{& vendorExtensions.x-base-name-string-literal}}){{^-last}}
+      , {{/-last}}{{/vars}}
+      ]
 
 {{/parent}}
 {{#parent}}
@@ -51,23 +63,3 @@ newtype {{classname}} = {{classname}} {{vendorExtensions.x-custom-newtype}} deri
 {{/vendorExtensions.x-custom-newtype}}
 {{/model}}
 {{/models}}
-
-uncapitalize :: String -> String
-uncapitalize (c : cs) = Char.toLower c : cs
-uncapitalize [] = []
-
--- | Remove a field label prefix during JSON parsing.
---   Also perform any replacements for special characters.
-removeFieldLabelPrefix :: String -> Options
-removeFieldLabelPrefix prefix =
-  defaultOptions
-    { omitNothingFields  = True
-    , fieldLabelModifier = uncapitalize . replaceSpecialChars . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix
-    }
-  where
-    replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars)
-    specialChars =
-      [ {{#specialCharReplacements}}("{{&char}}", "{{&replacement}}"){{^-last}}
-      , {{/-last}}{{/specialCharReplacements}}
-      ]
-    mkCharReplacement (replaceStr, searchStr) = T.unpack . T.replace (T.pack searchStr) (T.pack replaceStr) . T.pack