forked from loafle/openapi-generator-original
[haskell-servant][haskell-yesod] Use table-based conversion for field name conversion (#16232)
* [haskell-servant][haskell-yesod] use table-based conversion for field name conversion Current fieldLabelModifier implementation always produces uncapitalize name, but it is inappropriate if the original JSON field name begins with a capital letter. * [haskell-servant][haskell-yesod] regenerate samples
This commit is contained in:
parent
81c398e530
commit
45d8027bb4
@ -658,6 +658,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
|
||||
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 class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
|
||||
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;
|
||||
|
@ -552,6 +552,7 @@ public class HaskellYesodServerCodegen extends DefaultCodegen implements Codegen
|
||||
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 class HaskellYesodServerCodegen extends DefaultCodegen implements Codegen
|
||||
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;
|
||||
|
@ -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
|
||||
|
@ -13,6 +13,7 @@ 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)
|
||||
@ -20,7 +21,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}}
|
||||
|
||||
@ -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
|
||||
|
@ -14,7 +14,7 @@ module OpenAPIPetstore.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)
|
||||
@ -27,7 +27,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 ((&))
|
||||
|
||||
|
||||
-- | Describes the result of uploading an image resource
|
||||
@ -38,13 +37,26 @@ data ApiResponse = ApiResponse
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
|
||||
instance FromJSON ApiResponse where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "apiResponse")
|
||||
parseJSON = genericParseJSON optionsApiResponse
|
||||
instance ToJSON ApiResponse where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "apiResponse")
|
||||
toJSON = genericToJSON optionsApiResponse
|
||||
instance ToSchema ApiResponse where
|
||||
declareNamedSchema = Swagger.genericDeclareNamedSchema
|
||||
$ Swagger.fromAesonOptions
|
||||
$ removeFieldLabelPrefix "apiResponse"
|
||||
$ optionsApiResponse
|
||||
|
||||
optionsApiResponse :: Options
|
||||
optionsApiResponse =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ lookup s table
|
||||
}
|
||||
where
|
||||
table =
|
||||
[ ("apiResponseCode", "code")
|
||||
, ("apiResponseType", "type")
|
||||
, ("apiResponseMessage", "message")
|
||||
]
|
||||
|
||||
|
||||
-- | A category for a pet
|
||||
@ -54,13 +66,25 @@ data Category = Category
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
|
||||
instance FromJSON Category where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "category")
|
||||
parseJSON = genericParseJSON optionsCategory
|
||||
instance ToJSON Category where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "category")
|
||||
toJSON = genericToJSON optionsCategory
|
||||
instance ToSchema Category where
|
||||
declareNamedSchema = Swagger.genericDeclareNamedSchema
|
||||
$ Swagger.fromAesonOptions
|
||||
$ removeFieldLabelPrefix "category"
|
||||
$ optionsCategory
|
||||
|
||||
optionsCategory :: Options
|
||||
optionsCategory =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ lookup s table
|
||||
}
|
||||
where
|
||||
table =
|
||||
[ ("categoryId", "id")
|
||||
, ("categoryName", "name")
|
||||
]
|
||||
|
||||
|
||||
-- | An order for a pets from the pet store
|
||||
@ -74,13 +98,29 @@ data Order = Order
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
|
||||
instance FromJSON Order where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "order")
|
||||
parseJSON = genericParseJSON optionsOrder
|
||||
instance ToJSON Order where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "order")
|
||||
toJSON = genericToJSON optionsOrder
|
||||
instance ToSchema Order where
|
||||
declareNamedSchema = Swagger.genericDeclareNamedSchema
|
||||
$ Swagger.fromAesonOptions
|
||||
$ removeFieldLabelPrefix "order"
|
||||
$ optionsOrder
|
||||
|
||||
optionsOrder :: Options
|
||||
optionsOrder =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ lookup s table
|
||||
}
|
||||
where
|
||||
table =
|
||||
[ ("orderId", "id")
|
||||
, ("orderPetId", "petId")
|
||||
, ("orderQuantity", "quantity")
|
||||
, ("orderShipDate", "shipDate")
|
||||
, ("orderStatus", "status")
|
||||
, ("orderComplete", "complete")
|
||||
]
|
||||
|
||||
|
||||
-- | A pet for sale in the pet store
|
||||
@ -94,13 +134,29 @@ data Pet = Pet
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
|
||||
instance FromJSON Pet where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "pet")
|
||||
parseJSON = genericParseJSON optionsPet
|
||||
instance ToJSON Pet where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "pet")
|
||||
toJSON = genericToJSON optionsPet
|
||||
instance ToSchema Pet where
|
||||
declareNamedSchema = Swagger.genericDeclareNamedSchema
|
||||
$ Swagger.fromAesonOptions
|
||||
$ removeFieldLabelPrefix "pet"
|
||||
$ optionsPet
|
||||
|
||||
optionsPet :: Options
|
||||
optionsPet =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ lookup s table
|
||||
}
|
||||
where
|
||||
table =
|
||||
[ ("petId", "id")
|
||||
, ("petCategory", "category")
|
||||
, ("petName", "name")
|
||||
, ("petPhotoUrls", "photoUrls")
|
||||
, ("petTags", "tags")
|
||||
, ("petStatus", "status")
|
||||
]
|
||||
|
||||
|
||||
-- | A tag for a pet
|
||||
@ -110,13 +166,25 @@ data Tag = Tag
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
|
||||
instance FromJSON Tag where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "tag")
|
||||
parseJSON = genericParseJSON optionsTag
|
||||
instance ToJSON Tag where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "tag")
|
||||
toJSON = genericToJSON optionsTag
|
||||
instance ToSchema Tag where
|
||||
declareNamedSchema = Swagger.genericDeclareNamedSchema
|
||||
$ Swagger.fromAesonOptions
|
||||
$ removeFieldLabelPrefix "tag"
|
||||
$ optionsTag
|
||||
|
||||
optionsTag :: Options
|
||||
optionsTag =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ lookup s table
|
||||
}
|
||||
where
|
||||
table =
|
||||
[ ("tagId", "id")
|
||||
, ("tagName", "name")
|
||||
]
|
||||
|
||||
|
||||
-- | A User who is purchasing from the pet store
|
||||
@ -132,66 +200,29 @@ data User = User
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "user")
|
||||
parseJSON = genericParseJSON optionsUser
|
||||
instance ToJSON User where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "user")
|
||||
toJSON = genericToJSON optionsUser
|
||||
instance ToSchema User where
|
||||
declareNamedSchema = Swagger.genericDeclareNamedSchema
|
||||
$ Swagger.fromAesonOptions
|
||||
$ removeFieldLabelPrefix "user"
|
||||
$ optionsUser
|
||||
|
||||
|
||||
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 =
|
||||
optionsUser :: Options
|
||||
optionsUser =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = uncapitalize . replaceSpecialChars . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ lookup s table
|
||||
}
|
||||
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")
|
||||
table =
|
||||
[ ("userId", "id")
|
||||
, ("userUsername", "username")
|
||||
, ("userFirstName", "firstName")
|
||||
, ("userLastName", "lastName")
|
||||
, ("userEmail", "email")
|
||||
, ("userPassword", "password")
|
||||
, ("userPhone", "phone")
|
||||
, ("userUserStatus", "userStatus")
|
||||
]
|
||||
mkCharReplacement (replaceStr, searchStr) = T.unpack . T.replace (T.pack searchStr) (T.pack replaceStr) . T.pack
|
||||
|
||||
|
@ -14,6 +14,7 @@ module OpenAPIPetstore.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)
|
||||
@ -21,7 +22,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 ((&))
|
||||
|
||||
|
||||
-- | Describes the result of uploading an image resource
|
||||
@ -32,9 +32,22 @@ data ApiResponse = ApiResponse
|
||||
} deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON ApiResponse where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "apiResponse")
|
||||
parseJSON = genericParseJSON optionsApiResponse
|
||||
instance ToJSON ApiResponse where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "apiResponse")
|
||||
toJSON = genericToJSON optionsApiResponse
|
||||
|
||||
optionsApiResponse :: Options
|
||||
optionsApiResponse =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ List.lookup s table
|
||||
}
|
||||
where
|
||||
table =
|
||||
[ ("apiResponseCode", "code")
|
||||
, ("apiResponseType", "type")
|
||||
, ("apiResponseMessage", "message")
|
||||
]
|
||||
|
||||
|
||||
-- | A category for a pet
|
||||
@ -44,9 +57,21 @@ data Category = Category
|
||||
} deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON Category where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "category")
|
||||
parseJSON = genericParseJSON optionsCategory
|
||||
instance ToJSON Category where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "category")
|
||||
toJSON = genericToJSON optionsCategory
|
||||
|
||||
optionsCategory :: Options
|
||||
optionsCategory =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ List.lookup s table
|
||||
}
|
||||
where
|
||||
table =
|
||||
[ ("categoryId", "id")
|
||||
, ("categoryName", "name")
|
||||
]
|
||||
|
||||
|
||||
-- | An order for a pets from the pet store
|
||||
@ -60,9 +85,25 @@ data Order = Order
|
||||
} deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON Order where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "order")
|
||||
parseJSON = genericParseJSON optionsOrder
|
||||
instance ToJSON Order where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "order")
|
||||
toJSON = genericToJSON optionsOrder
|
||||
|
||||
optionsOrder :: Options
|
||||
optionsOrder =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ List.lookup s table
|
||||
}
|
||||
where
|
||||
table =
|
||||
[ ("orderId", "id")
|
||||
, ("orderPetId", "petId")
|
||||
, ("orderQuantity", "quantity")
|
||||
, ("orderShipDate", "shipDate")
|
||||
, ("orderStatus", "status")
|
||||
, ("orderComplete", "complete")
|
||||
]
|
||||
|
||||
|
||||
-- | A pet for sale in the pet store
|
||||
@ -76,9 +117,25 @@ data Pet = Pet
|
||||
} deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON Pet where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "pet")
|
||||
parseJSON = genericParseJSON optionsPet
|
||||
instance ToJSON Pet where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "pet")
|
||||
toJSON = genericToJSON optionsPet
|
||||
|
||||
optionsPet :: Options
|
||||
optionsPet =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ List.lookup s table
|
||||
}
|
||||
where
|
||||
table =
|
||||
[ ("petId", "id")
|
||||
, ("petCategory", "category")
|
||||
, ("petName", "name")
|
||||
, ("petPhotoUrls", "photoUrls")
|
||||
, ("petTags", "tags")
|
||||
, ("petStatus", "status")
|
||||
]
|
||||
|
||||
|
||||
-- | A tag for a pet
|
||||
@ -88,9 +145,21 @@ data Tag = Tag
|
||||
} deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON Tag where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "tag")
|
||||
parseJSON = genericParseJSON optionsTag
|
||||
instance ToJSON Tag where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "tag")
|
||||
toJSON = genericToJSON optionsTag
|
||||
|
||||
optionsTag :: Options
|
||||
optionsTag =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ List.lookup s table
|
||||
}
|
||||
where
|
||||
table =
|
||||
[ ("tagId", "id")
|
||||
, ("tagName", "name")
|
||||
]
|
||||
|
||||
|
||||
-- | A User who is purchasing from the pet store
|
||||
@ -106,62 +175,25 @@ data User = User
|
||||
} deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = genericParseJSON (removeFieldLabelPrefix "user")
|
||||
parseJSON = genericParseJSON optionsUser
|
||||
instance ToJSON User where
|
||||
toJSON = genericToJSON (removeFieldLabelPrefix "user")
|
||||
toJSON = genericToJSON optionsUser
|
||||
|
||||
|
||||
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 =
|
||||
optionsUser :: Options
|
||||
optionsUser =
|
||||
defaultOptions
|
||||
{ omitNothingFields = True
|
||||
, fieldLabelModifier = uncapitalize . replaceSpecialChars . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix
|
||||
, fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ List.lookup s table
|
||||
}
|
||||
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")
|
||||
table =
|
||||
[ ("userId", "id")
|
||||
, ("userUsername", "username")
|
||||
, ("userFirstName", "firstName")
|
||||
, ("userLastName", "lastName")
|
||||
, ("userEmail", "email")
|
||||
, ("userPassword", "password")
|
||||
, ("userPhone", "phone")
|
||||
, ("userUserStatus", "userStatus")
|
||||
]
|
||||
mkCharReplacement (replaceStr, searchStr) = T.unpack . T.replace (T.pack searchStr) (T.pack replaceStr) . T.pack
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user