From f6a819686dd7a1a53d584dc7e37260c66f7b7164 Mon Sep 17 00:00:00 2001 From: Masahiro Sakai Date: Fri, 28 Jul 2023 10:35:46 +0900 Subject: [PATCH] [haskell][haskell-yesod] Fix special char replacements (#16197) * [haskell][haskell-yesod] remove fixOperatorChars() fixOperatorChars() does not change input strings since special characters have already been replaced in DefaultCodegen.fromModel(). * [haskell][haskell-yesod] do not prefix with quote ("'") when generating removeFieldLabelPrefix table We switched from the conversion done by fixOperatorChars() to the conversion done by DefaultCodegen.fromModel() and the latter does not insert quote characters. So We modify the removeFieldLabelPrefix table to conform the new mapping. * [haskell][haskell-yesod] remove forParsing parameter from removeFieldLabelPrefix function Aeson's fieldLabelModifier always convert Haskell field names to JSON field names, whether at parse time or not. (Note that stripPrefix and uncapitalize do not take such parameter) * [haskell][haskell-yesod] perform replaceSpecialChars after stripping prefix Because replaceSpecialChars can corrupt prefix if the prefix contains a replacement string of a specfial character as a substring. * [haskell][haskell-yesod] regenerate samples --- .../languages/HaskellServantCodegen.java | 27 +--- .../languages/HaskellYesodServerCodegen.java | 27 +--- .../resources/haskell-servant/Types.mustache | 22 +-- .../haskell-yesod/src/API/Types.mustache | 20 +-- .../lib/OpenAPIPetstore/Types.hs | 126 ++++++++---------- .../src/OpenAPIPetstore/Types.hs | 114 ++++++++-------- 6 files changed, 129 insertions(+), 207 deletions(-) diff --git a/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellServantCodegen.java b/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellServantCodegen.java index 581f1350f1b..dbc1b25ff18 100644 --- a/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellServantCodegen.java +++ b/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellServantCodegen.java @@ -326,7 +326,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf String c = (String) replacementChar; Map o = new HashMap<>(); o.put("char", c); - o.put("replacement", "'" + specialCharReplacements.get(c)); + o.put("replacement", specialCharReplacements.get(c)); replacements.add(o); } additionalProperties.put("specialCharReplacements", replacements); @@ -636,29 +636,6 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf } } - private String fixOperatorChars(String string) { - StringBuilder sb = new StringBuilder(); - String name = string; - //Check if it is a reserved word, in which case the underscore is added when property name is generated. - if (string.startsWith("_")) { - if (reservedWords.contains(string.substring(1))) { - name = string.substring(1); - } else if (reservedWordsMappings.containsValue(string)) { - name = LEADING_UNDERSCORE.matcher(string).replaceFirst(""); - } - } - for (char c : name.toCharArray()) { - String cString = String.valueOf(c); - if (specialCharReplacements.containsKey(cString)) { - sb.append("'"); - sb.append(specialCharReplacements.get(cString)); - } else { - sb.append(c); - } - } - return sb.toString(); - } - // Remove characters from a string that do not belong in a model classname private String fixModelChars(String string) { return string.replace(".", "").replace("-", ""); @@ -680,7 +657,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf // From the model name, compute the prefix for the fields. String prefix = camelize(model.classname, LOWERCASE_FIRST_LETTER); for (CodegenProperty prop : model.vars) { - prop.name = toVarName(prefix + camelize(fixOperatorChars(prop.name))); + prop.name = toVarName(prefix + camelize(prop.name)); } // Create newtypes for things with non-object types diff --git a/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellYesodServerCodegen.java b/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellYesodServerCodegen.java index 15df7fd778b..dd1bffb2a0e 100644 --- a/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellYesodServerCodegen.java +++ b/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellYesodServerCodegen.java @@ -286,7 +286,7 @@ public class HaskellYesodServerCodegen extends DefaultCodegen implements Codegen String c = (String) replacementChar; Map o = new HashMap<>(); o.put("char", c); - o.put("replacement", "'" + specialCharReplacements.get(c)); + o.put("replacement", specialCharReplacements.get(c)); replacements.add(o); } additionalProperties.put("specialCharReplacements", replacements); @@ -530,29 +530,6 @@ public class HaskellYesodServerCodegen extends DefaultCodegen implements Codegen } } - private String fixOperatorChars(String string) { - StringBuilder sb = new StringBuilder(); - String name = string; - //Check if it is a reserved word, in which case the underscore is added when property name is generated. - if (string.startsWith("_")) { - if (reservedWords.contains(string.substring(1))) { - name = string.substring(1); - } else if (reservedWordsMappings.containsValue(string)) { - name = LEADING_UNDERSCORE.matcher(string).replaceFirst(""); - } - } - for (char c : name.toCharArray()) { - String cString = String.valueOf(c); - if (specialCharReplacements.containsKey(cString)) { - sb.append("'"); - sb.append(specialCharReplacements.get(cString)); - } else { - sb.append(c); - } - } - return sb.toString(); - } - // Remove characters from a string that do not belong in a model classname private String fixModelChars(String string) { return string.replace(".", "").replace("-", ""); @@ -574,7 +551,7 @@ public class HaskellYesodServerCodegen extends DefaultCodegen implements Codegen // From the model name, compute the prefix for the fields. String prefix = camelize(model.classname, LOWERCASE_FIRST_LETTER); for (CodegenProperty prop : model.vars) { - prop.name = toVarName(prefix + camelize(fixOperatorChars(prop.name))); + prop.name = toVarName(prefix + camelize(prop.name)); } // Create newtypes for things with non-object types diff --git a/modules/openapi-generator/src/main/resources/haskell-servant/Types.mustache b/modules/openapi-generator/src/main/resources/haskell-servant/Types.mustache index bd3e103a296..15a1b9305bd 100644 --- a/modules/openapi-generator/src/main/resources/haskell-servant/Types.mustache +++ b/modules/openapi-generator/src/main/resources/haskell-servant/Types.mustache @@ -42,14 +42,14 @@ import Data.Function ((&)) } deriving (Show, Eq, Generic, Data) instance FromJSON {{classname}} where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "{{vendorExtensions.x-prefix}}") + parseJSON = genericParseJSON (removeFieldLabelPrefix "{{vendorExtensions.x-prefix}}") instance ToJSON {{classname}} where - toJSON = genericToJSON (removeFieldLabelPrefix False "{{vendorExtensions.x-prefix}}") + toJSON = genericToJSON (removeFieldLabelPrefix "{{vendorExtensions.x-prefix}}") {{#generateToSchema}} instance ToSchema {{classname}} where declareNamedSchema = Swagger.genericDeclareNamedSchema $ Swagger.fromAesonOptions - $ removeFieldLabelPrefix False "{{vendorExtensions.x-prefix}}" + $ removeFieldLabelPrefix "{{vendorExtensions.x-prefix}}" {{/generateToSchema}} {{/parent}} @@ -70,15 +70,11 @@ uncapitalize [] = [] -- | Remove a field label prefix during JSON parsing. -- Also perform any replacements for special characters. --- The @forParsing@ parameter is to distinguish between the cases in which we're using this --- to power a @FromJSON@ or a @ToJSON@ instance. In the first case we're parsing, and we want --- to replace special characters with their quoted equivalents (because we cannot have special --- chars in identifier names), while we want to do vice versa when sending data instead. -removeFieldLabelPrefix :: Bool -> String -> Options -removeFieldLabelPrefix forParsing prefix = +removeFieldLabelPrefix :: String -> Options +removeFieldLabelPrefix prefix = defaultOptions { omitNothingFields = True - , fieldLabelModifier = uncapitalize . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars + , fieldLabelModifier = uncapitalize . replaceSpecialChars . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix } where replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars) @@ -86,8 +82,4 @@ removeFieldLabelPrefix forParsing prefix = [ {{#specialCharReplacements}}("{{&char}}", "{{&replacement}}"){{^-last}} , {{/-last}}{{/specialCharReplacements}} ] - mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack - replacer = - if forParsing - then flip T.replace - else T.replace + mkCharReplacement (replaceStr, searchStr) = T.unpack . T.replace (T.pack searchStr) (T.pack replaceStr) . T.pack diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/src/API/Types.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/src/API/Types.mustache index 6c1a4e267ed..e60798054e8 100644 --- a/modules/openapi-generator/src/main/resources/haskell-yesod/src/API/Types.mustache +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/src/API/Types.mustache @@ -36,9 +36,9 @@ import Data.Function ((&)) } deriving (Show, Eq, Generic) instance FromJSON {{classname}} where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "{{vendorExtensions.x-prefix}}") + parseJSON = genericParseJSON (removeFieldLabelPrefix "{{vendorExtensions.x-prefix}}") instance ToJSON {{classname}} where - toJSON = genericToJSON (removeFieldLabelPrefix False "{{vendorExtensions.x-prefix}}") + toJSON = genericToJSON (removeFieldLabelPrefix "{{vendorExtensions.x-prefix}}") {{/parent}} {{#parent}} @@ -58,15 +58,11 @@ uncapitalize [] = [] -- | Remove a field label prefix during JSON parsing. -- Also perform any replacements for special characters. --- The @forParsing@ parameter is to distinguish between the cases in which we're using this --- to power a @FromJSON@ or a @ToJSON@ instance. In the first case we're parsing, and we want --- to replace special characters with their quoted equivalents (because we cannot have special --- chars in identifier names), while we want to do vice versa when sending data instead. -removeFieldLabelPrefix :: Bool -> String -> Options -removeFieldLabelPrefix forParsing prefix = +removeFieldLabelPrefix :: String -> Options +removeFieldLabelPrefix prefix = defaultOptions { omitNothingFields = True - , fieldLabelModifier = uncapitalize . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars + , fieldLabelModifier = uncapitalize . replaceSpecialChars . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix } where replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars) @@ -74,8 +70,4 @@ removeFieldLabelPrefix forParsing prefix = [ {{#specialCharReplacements}}("{{&char}}", "{{&replacement}}"){{^-last}} , {{/-last}}{{/specialCharReplacements}} ] - mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack - replacer = - if forParsing - then flip T.replace - else T.replace + mkCharReplacement (replaceStr, searchStr) = T.unpack . T.replace (T.pack searchStr) (T.pack replaceStr) . T.pack diff --git a/samples/server/petstore/haskell-servant/lib/OpenAPIPetstore/Types.hs b/samples/server/petstore/haskell-servant/lib/OpenAPIPetstore/Types.hs index 9a4bfb851ec..6f1dd6e54c8 100644 --- a/samples/server/petstore/haskell-servant/lib/OpenAPIPetstore/Types.hs +++ b/samples/server/petstore/haskell-servant/lib/OpenAPIPetstore/Types.hs @@ -38,13 +38,13 @@ data ApiResponse = ApiResponse } deriving (Show, Eq, Generic, Data) instance FromJSON ApiResponse where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "apiResponse") + parseJSON = genericParseJSON (removeFieldLabelPrefix "apiResponse") instance ToJSON ApiResponse where - toJSON = genericToJSON (removeFieldLabelPrefix False "apiResponse") + toJSON = genericToJSON (removeFieldLabelPrefix "apiResponse") instance ToSchema ApiResponse where declareNamedSchema = Swagger.genericDeclareNamedSchema $ Swagger.fromAesonOptions - $ removeFieldLabelPrefix False "apiResponse" + $ removeFieldLabelPrefix "apiResponse" -- | A category for a pet @@ -54,13 +54,13 @@ data Category = Category } deriving (Show, Eq, Generic, Data) instance FromJSON Category where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "category") + parseJSON = genericParseJSON (removeFieldLabelPrefix "category") instance ToJSON Category where - toJSON = genericToJSON (removeFieldLabelPrefix False "category") + toJSON = genericToJSON (removeFieldLabelPrefix "category") instance ToSchema Category where declareNamedSchema = Swagger.genericDeclareNamedSchema $ Swagger.fromAesonOptions - $ removeFieldLabelPrefix False "category" + $ removeFieldLabelPrefix "category" -- | An order for a pets from the pet store @@ -74,13 +74,13 @@ data Order = Order } deriving (Show, Eq, Generic, Data) instance FromJSON Order where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "order") + parseJSON = genericParseJSON (removeFieldLabelPrefix "order") instance ToJSON Order where - toJSON = genericToJSON (removeFieldLabelPrefix False "order") + toJSON = genericToJSON (removeFieldLabelPrefix "order") instance ToSchema Order where declareNamedSchema = Swagger.genericDeclareNamedSchema $ Swagger.fromAesonOptions - $ removeFieldLabelPrefix False "order" + $ removeFieldLabelPrefix "order" -- | A pet for sale in the pet store @@ -94,13 +94,13 @@ data Pet = Pet } deriving (Show, Eq, Generic, Data) instance FromJSON Pet where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "pet") + parseJSON = genericParseJSON (removeFieldLabelPrefix "pet") instance ToJSON Pet where - toJSON = genericToJSON (removeFieldLabelPrefix False "pet") + toJSON = genericToJSON (removeFieldLabelPrefix "pet") instance ToSchema Pet where declareNamedSchema = Swagger.genericDeclareNamedSchema $ Swagger.fromAesonOptions - $ removeFieldLabelPrefix False "pet" + $ removeFieldLabelPrefix "pet" -- | A tag for a pet @@ -110,13 +110,13 @@ data Tag = Tag } deriving (Show, Eq, Generic, Data) instance FromJSON Tag where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "tag") + parseJSON = genericParseJSON (removeFieldLabelPrefix "tag") instance ToJSON Tag where - toJSON = genericToJSON (removeFieldLabelPrefix False "tag") + toJSON = genericToJSON (removeFieldLabelPrefix "tag") instance ToSchema Tag where declareNamedSchema = Swagger.genericDeclareNamedSchema $ Swagger.fromAesonOptions - $ removeFieldLabelPrefix False "tag" + $ removeFieldLabelPrefix "tag" -- | A User who is purchasing from the pet store @@ -132,13 +132,13 @@ data User = User } deriving (Show, Eq, Generic, Data) instance FromJSON User where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "user") + parseJSON = genericParseJSON (removeFieldLabelPrefix "user") instance ToJSON User where - toJSON = genericToJSON (removeFieldLabelPrefix False "user") + toJSON = genericToJSON (removeFieldLabelPrefix "user") instance ToSchema User where declareNamedSchema = Swagger.genericDeclareNamedSchema $ Swagger.fromAesonOptions - $ removeFieldLabelPrefix False "user" + $ removeFieldLabelPrefix "user" uncapitalize :: String -> String @@ -147,59 +147,51 @@ uncapitalize [] = [] -- | Remove a field label prefix during JSON parsing. -- Also perform any replacements for special characters. --- The @forParsing@ parameter is to distinguish between the cases in which we're using this --- to power a @FromJSON@ or a @ToJSON@ instance. In the first case we're parsing, and we want --- to replace special characters with their quoted equivalents (because we cannot have special --- chars in identifier names), while we want to do vice versa when sending data instead. -removeFieldLabelPrefix :: Bool -> String -> Options -removeFieldLabelPrefix forParsing prefix = +removeFieldLabelPrefix :: String -> Options +removeFieldLabelPrefix prefix = defaultOptions { omitNothingFields = True - , fieldLabelModifier = uncapitalize . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars + , fieldLabelModifier = uncapitalize . replaceSpecialChars . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix } where replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars) specialChars = - [ ("$", "'Dollar") - , ("^", "'Caret") - , ("|", "'Pipe") - , ("=", "'Equal") - , ("*", "'Star") - , ("-", "'Dash") - , ("&", "'Ampersand") - , ("%", "'Percent") - , ("#", "'Hash") - , ("@", "'At") - , ("!", "'Exclamation") - , ("+", "'Plus") - , (":", "'Colon") - , (";", "'Semicolon") - , (">", "'GreaterThan") - , ("<", "'LessThan") - , (".", "'Period") - , ("_", "'Underscore") - , ("?", "'Question_Mark") - , (",", "'Comma") - , ("'", "'Quote") - , ("/", "'Slash") - , ("(", "'Left_Parenthesis") - , (")", "'Right_Parenthesis") - , ("{", "'Left_Curly_Bracket") - , ("}", "'Right_Curly_Bracket") - , ("[", "'Left_Square_Bracket") - , ("]", "'Right_Square_Bracket") - , ("~", "'Tilde") - , ("`", "'Backtick") - , ("<=", "'Less_Than_Or_Equal_To") - , (">=", "'Greater_Than_Or_Equal_To") - , ("!=", "'Not_Equal") - , ("<>", "'Not_Equal") - , ("~=", "'Tilde_Equal") - , ("\\", "'Back_Slash") - , ("\"", "'Double_Quote") + [ ("$", "Dollar") + , ("^", "Caret") + , ("|", "Pipe") + , ("=", "Equal") + , ("*", "Star") + , ("-", "Dash") + , ("&", "Ampersand") + , ("%", "Percent") + , ("#", "Hash") + , ("@", "At") + , ("!", "Exclamation") + , ("+", "Plus") + , (":", "Colon") + , (";", "Semicolon") + , (">", "GreaterThan") + , ("<", "LessThan") + , (".", "Period") + , ("_", "Underscore") + , ("?", "Question_Mark") + , (",", "Comma") + , ("'", "Quote") + , ("/", "Slash") + , ("(", "Left_Parenthesis") + , (")", "Right_Parenthesis") + , ("{", "Left_Curly_Bracket") + , ("}", "Right_Curly_Bracket") + , ("[", "Left_Square_Bracket") + , ("]", "Right_Square_Bracket") + , ("~", "Tilde") + , ("`", "Backtick") + , ("<=", "Less_Than_Or_Equal_To") + , (">=", "Greater_Than_Or_Equal_To") + , ("!=", "Not_Equal") + , ("<>", "Not_Equal") + , ("~=", "Tilde_Equal") + , ("\\", "Back_Slash") + , ("\"", "Double_Quote") ] - mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack - replacer = - if forParsing - then flip T.replace - else T.replace + mkCharReplacement (replaceStr, searchStr) = T.unpack . T.replace (T.pack searchStr) (T.pack replaceStr) . T.pack diff --git a/samples/server/petstore/haskell-yesod/src/OpenAPIPetstore/Types.hs b/samples/server/petstore/haskell-yesod/src/OpenAPIPetstore/Types.hs index 5e9b72c8fac..b8077fc0427 100644 --- a/samples/server/petstore/haskell-yesod/src/OpenAPIPetstore/Types.hs +++ b/samples/server/petstore/haskell-yesod/src/OpenAPIPetstore/Types.hs @@ -32,9 +32,9 @@ data ApiResponse = ApiResponse } deriving (Show, Eq, Generic) instance FromJSON ApiResponse where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "apiResponse") + parseJSON = genericParseJSON (removeFieldLabelPrefix "apiResponse") instance ToJSON ApiResponse where - toJSON = genericToJSON (removeFieldLabelPrefix False "apiResponse") + toJSON = genericToJSON (removeFieldLabelPrefix "apiResponse") -- | A category for a pet @@ -44,9 +44,9 @@ data Category = Category } deriving (Show, Eq, Generic) instance FromJSON Category where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "category") + parseJSON = genericParseJSON (removeFieldLabelPrefix "category") instance ToJSON Category where - toJSON = genericToJSON (removeFieldLabelPrefix False "category") + toJSON = genericToJSON (removeFieldLabelPrefix "category") -- | An order for a pets from the pet store @@ -60,9 +60,9 @@ data Order = Order } deriving (Show, Eq, Generic) instance FromJSON Order where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "order") + parseJSON = genericParseJSON (removeFieldLabelPrefix "order") instance ToJSON Order where - toJSON = genericToJSON (removeFieldLabelPrefix False "order") + toJSON = genericToJSON (removeFieldLabelPrefix "order") -- | A pet for sale in the pet store @@ -76,9 +76,9 @@ data Pet = Pet } deriving (Show, Eq, Generic) instance FromJSON Pet where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "pet") + parseJSON = genericParseJSON (removeFieldLabelPrefix "pet") instance ToJSON Pet where - toJSON = genericToJSON (removeFieldLabelPrefix False "pet") + toJSON = genericToJSON (removeFieldLabelPrefix "pet") -- | A tag for a pet @@ -88,9 +88,9 @@ data Tag = Tag } deriving (Show, Eq, Generic) instance FromJSON Tag where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "tag") + parseJSON = genericParseJSON (removeFieldLabelPrefix "tag") instance ToJSON Tag where - toJSON = genericToJSON (removeFieldLabelPrefix False "tag") + toJSON = genericToJSON (removeFieldLabelPrefix "tag") -- | A User who is purchasing from the pet store @@ -106,9 +106,9 @@ data User = User } deriving (Show, Eq, Generic) instance FromJSON User where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "user") + parseJSON = genericParseJSON (removeFieldLabelPrefix "user") instance ToJSON User where - toJSON = genericToJSON (removeFieldLabelPrefix False "user") + toJSON = genericToJSON (removeFieldLabelPrefix "user") uncapitalize :: String -> String @@ -117,59 +117,51 @@ uncapitalize [] = [] -- | Remove a field label prefix during JSON parsing. -- Also perform any replacements for special characters. --- The @forParsing@ parameter is to distinguish between the cases in which we're using this --- to power a @FromJSON@ or a @ToJSON@ instance. In the first case we're parsing, and we want --- to replace special characters with their quoted equivalents (because we cannot have special --- chars in identifier names), while we want to do vice versa when sending data instead. -removeFieldLabelPrefix :: Bool -> String -> Options -removeFieldLabelPrefix forParsing prefix = +removeFieldLabelPrefix :: String -> Options +removeFieldLabelPrefix prefix = defaultOptions { omitNothingFields = True - , fieldLabelModifier = uncapitalize . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars + , fieldLabelModifier = uncapitalize . replaceSpecialChars . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix } where replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars) specialChars = - [ ("$", "'Dollar") - , ("^", "'Caret") - , ("|", "'Pipe") - , ("=", "'Equal") - , ("*", "'Star") - , ("-", "'Dash") - , ("&", "'Ampersand") - , ("%", "'Percent") - , ("#", "'Hash") - , ("@", "'At") - , ("!", "'Exclamation") - , ("+", "'Plus") - , (":", "'Colon") - , (";", "'Semicolon") - , (">", "'GreaterThan") - , ("<", "'LessThan") - , (".", "'Period") - , ("_", "'Underscore") - , ("?", "'Question_Mark") - , (",", "'Comma") - , ("'", "'Quote") - , ("/", "'Slash") - , ("(", "'Left_Parenthesis") - , (")", "'Right_Parenthesis") - , ("{", "'Left_Curly_Bracket") - , ("}", "'Right_Curly_Bracket") - , ("[", "'Left_Square_Bracket") - , ("]", "'Right_Square_Bracket") - , ("~", "'Tilde") - , ("`", "'Backtick") - , ("<=", "'Less_Than_Or_Equal_To") - , (">=", "'Greater_Than_Or_Equal_To") - , ("!=", "'Not_Equal") - , ("<>", "'Not_Equal") - , ("~=", "'Tilde_Equal") - , ("\\", "'Back_Slash") - , ("\"", "'Double_Quote") + [ ("$", "Dollar") + , ("^", "Caret") + , ("|", "Pipe") + , ("=", "Equal") + , ("*", "Star") + , ("-", "Dash") + , ("&", "Ampersand") + , ("%", "Percent") + , ("#", "Hash") + , ("@", "At") + , ("!", "Exclamation") + , ("+", "Plus") + , (":", "Colon") + , (";", "Semicolon") + , (">", "GreaterThan") + , ("<", "LessThan") + , (".", "Period") + , ("_", "Underscore") + , ("?", "Question_Mark") + , (",", "Comma") + , ("'", "Quote") + , ("/", "Slash") + , ("(", "Left_Parenthesis") + , (")", "Right_Parenthesis") + , ("{", "Left_Curly_Bracket") + , ("}", "Right_Curly_Bracket") + , ("[", "Left_Square_Bracket") + , ("]", "Right_Square_Bracket") + , ("~", "Tilde") + , ("`", "Backtick") + , ("<=", "Less_Than_Or_Equal_To") + , (">=", "Greater_Than_Or_Equal_To") + , ("!=", "Not_Equal") + , ("<>", "Not_Equal") + , ("~=", "Tilde_Equal") + , ("\\", "Back_Slash") + , ("\"", "Double_Quote") ] - mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack - replacer = - if forParsing - then flip T.replace - else T.replace + mkCharReplacement (replaceStr, searchStr) = T.unpack . T.replace (T.pack searchStr) (T.pack replaceStr) . T.pack