loafle/openapi-generator
3
0
Fork 0
forked from loafle/openapi-generator-original
Code Pull Requests Activity

Map ByteArray to Text for haskell codegen (#6402)

Browse Source 
* Support ByteArray in haskell codegen

* update petstore example
This commit is contained in:
Shimin Guo 2017-08-30 19:19:42 -07:00 committed by wing328
parent 8ec98a2ac4
commit 37f48239b0
2 changed files with 96 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellServantCodegen.java
View File

@ -148,6 +148,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
typeMapping.put("integer", "Int"); typeMapping.put("integer", "Int");
typeMapping.put("any", "Value"); typeMapping.put("any", "Value");
typeMapping.put("UUID", "Text"); typeMapping.put("UUID", "Text");
typeMapping.put("ByteArray", "Text");
importMapping.clear(); importMapping.clear();
importMapping.put("Map", "qualified Data.Map as Map"); importMapping.put("Map", "qualified Data.Map as Map");
@ -163,7 +164,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
* @return the escaped term * @return the escaped term
*/ */
@Override @Override
public String escapeReservedWord(String name) { public String escapeReservedWord(String name) {
if(this.reservedWordsMappings().containsKey(name)) { if(this.reservedWordsMappings().containsKey(name)) {
return this.reservedWordsMappings().get(name); return this.reservedWordsMappings().get(name);
} }
@ -515,7 +516,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
// Create newtypes for things with non-object types // Create newtypes for things with non-object types
String dataOrNewtype = "data"; String dataOrNewtype = "data";
// check if it's a ModelImpl before casting // check if it's a ModelImpl before casting
if (!(mod instanceof ModelImpl)) { if (!(mod instanceof ModelImpl)) {
return model; return model;
} }

151
samples/server/petstore/haskell-servant/lib/SwaggerPetstore/Types.hs
View File

@ -3,13 +3,13 @@
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
module SwaggerPetstore.Types ( module SwaggerPetstore.Types (
ApiResponse (..), ApiResponse (..),
Category (..), Category (..),
Order (..), Order (..),
Pet (..), Pet (..),
Tag (..), Tag (..),
User (..), User (..),
) where ) where
import Data.List (stripPrefix) import Data.List (stripPrefix)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
@ -24,96 +24,131 @@ import Data.Function ((&))
-- | Describes the result of uploading an image resource -- | Describes the result of uploading an image resource
data ApiResponse = ApiResponse data ApiResponse = ApiResponse
{ apiResponseCode :: Int -- ^ { apiResponseCode :: Int -- ^
, apiResponseType :: Text -- ^ , apiResponseType :: Text -- ^
, apiResponseMessage :: Text -- ^ , apiResponseMessage :: Text -- ^
} deriving (Show, Eq, Generic) } deriving (Show, Eq, Generic)
instance FromJSON ApiResponse where instance FromJSON ApiResponse where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "apiResponse") parseJSON = genericParseJSON (removeFieldLabelPrefix True "apiResponse")
instance ToJSON ApiResponse where instance ToJSON ApiResponse where
toJSON = genericToJSON (removeFieldLabelPrefix False "apiResponse") toJSON = genericToJSON (removeFieldLabelPrefix False "apiResponse")
-- | A category for a pet -- | A category for a pet
data Category = Category data Category = Category
{ categoryId :: Integer -- ^ { categoryId :: Integer -- ^
, categoryName :: Text -- ^ , categoryName :: Text -- ^
} deriving (Show, Eq, Generic) } deriving (Show, Eq, Generic)
instance FromJSON Category where instance FromJSON Category where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "category") parseJSON = genericParseJSON (removeFieldLabelPrefix True "category")
instance ToJSON Category where instance ToJSON Category where
toJSON = genericToJSON (removeFieldLabelPrefix False "category") toJSON = genericToJSON (removeFieldLabelPrefix False "category")
-- | An order for a pets from the pet store -- | An order for a pets from the pet store
data Order = Order data Order = Order
{ orderId :: Integer -- ^ { orderId :: Integer -- ^
, orderPetId :: Integer -- ^ , orderPetId :: Integer -- ^
, orderQuantity :: Int -- ^ , orderQuantity :: Int -- ^
, orderShipDate :: Integer -- ^ , orderShipDate :: Integer -- ^
, orderStatus :: Text -- ^ Order Status , orderStatus :: Text -- ^ Order Status
, orderComplete :: Bool -- ^ , orderComplete :: Bool -- ^
} deriving (Show, Eq, Generic) } deriving (Show, Eq, Generic)
instance FromJSON Order where instance FromJSON Order where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "order") parseJSON = genericParseJSON (removeFieldLabelPrefix True "order")
instance ToJSON Order where instance ToJSON Order where
toJSON = genericToJSON (removeFieldLabelPrefix False "order") toJSON = genericToJSON (removeFieldLabelPrefix False "order")
-- | A pet for sale in the pet store -- | A pet for sale in the pet store
data Pet = Pet data Pet = Pet
{ petId :: Integer -- ^ { petId :: Integer -- ^
, petCategory :: Category -- ^ , petCategory :: Category -- ^
, petName :: Text -- ^ , petName :: Text -- ^
, petPhotoUrls :: [Text] -- ^ , petPhotoUrls :: [Text] -- ^
, petTags :: [Tag] -- ^ , petTags :: [Tag] -- ^
, petStatus :: Text -- ^ pet status in the store , petStatus :: Text -- ^ pet status in the store
} deriving (Show, Eq, Generic) } deriving (Show, Eq, Generic)
instance FromJSON Pet where instance FromJSON Pet where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "pet") parseJSON = genericParseJSON (removeFieldLabelPrefix True "pet")
instance ToJSON Pet where instance ToJSON Pet where
toJSON = genericToJSON (removeFieldLabelPrefix False "pet") toJSON = genericToJSON (removeFieldLabelPrefix False "pet")
-- | A tag for a pet -- | A tag for a pet
data Tag = Tag data Tag = Tag
{ tagId :: Integer -- ^ { tagId :: Integer -- ^
, tagName :: Text -- ^ , tagName :: Text -- ^
} deriving (Show, Eq, Generic) } deriving (Show, Eq, Generic)
instance FromJSON Tag where instance FromJSON Tag where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "tag") parseJSON = genericParseJSON (removeFieldLabelPrefix True "tag")
instance ToJSON Tag where instance ToJSON Tag where
toJSON = genericToJSON (removeFieldLabelPrefix False "tag") toJSON = genericToJSON (removeFieldLabelPrefix False "tag")
-- | A User who is purchasing from the pet store -- | A User who is purchasing from the pet store
data User = User data User = User
{ userId :: Integer -- ^ { userId :: Integer -- ^
, userUsername :: Text -- ^ , userUsername :: Text -- ^
, userFirstName :: Text -- ^ , userFirstName :: Text -- ^
, userLastName :: Text -- ^ , userLastName :: Text -- ^
, userEmail :: Text -- ^ , userEmail :: Text -- ^
, userPassword :: Text -- ^ , userPassword :: Text -- ^
, userPhone :: Text -- ^ , userPhone :: Text -- ^
, userUserStatus :: Int -- ^ User Status , userUserStatus :: Int -- ^ User Status
} deriving (Show, Eq, Generic) } deriving (Show, Eq, Generic)
instance FromJSON User where instance FromJSON User where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "user") parseJSON = genericParseJSON (removeFieldLabelPrefix True "user")
instance ToJSON User where instance ToJSON User where
toJSON = genericToJSON (removeFieldLabelPrefix False "user") toJSON = genericToJSON (removeFieldLabelPrefix False "user")
-- Remove a field label prefix during JSON parsing. -- Remove a field label prefix during JSON parsing.
-- Also perform any replacements for special characters. -- Also perform any replacements for special characters.
removeFieldLabelPrefix :: Bool -> String -> Options removeFieldLabelPrefix :: Bool -> String -> Options
removeFieldLabelPrefix forParsing prefix = removeFieldLabelPrefix forParsing prefix =
defaultOptions defaultOptions
{ fieldLabelModifier = fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars {fieldLabelModifier = fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars}
}
where where
replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars) replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars)
specialChars = [("@", "'At"), ("<=", "'Less_Than_Or_Equal_To"), ("[", "'Left_Square_Bracket"), ("\", "'Back_Slash"), ("]", "'Right_Square_Bracket"), ("^", "'Caret"), ("_", "'Underscore"), ("`", "'Backtick"), ("!", "'Exclamation"), (""", "'Double_Quote"), ("#", "'Hash"), ("$", "'Dollar"), ("%", "'Percent"), ("&", "'Ampersand"), ("'", "'Quote"), ("(", "'Left_Parenthesis"), (")", "'Right_Parenthesis"), ("*", "'Star"), ("+", "'Plus"), (",", "'Comma"), ("-", "'Dash"), (".", "'Period"), ("/", "'Slash"), (":", "'Colon"), ("{", "'Left_Curly_Bracket"), ("|", "'Pipe"), ("<", "'LessThan"), ("!=", "'Not_Equal"), ("=", "'Equal"), ("}", "'Right_Curly_Bracket"), (">", "'GreaterThan"), ("~", "'Tilde"), ("?", "'Question_Mark"), (">=", "'Greater_Than_Or_Equal_To")] specialChars =
[ ("@", "'At")
, ("\\", "'Back_Slash")
, ("<=", "'Less_Than_Or_Equal_To")
, ("\"", "'Double_Quote")
, ("[", "'Left_Square_Bracket")
, ("]", "'Right_Square_Bracket")
, ("^", "'Caret")
, ("_", "'Underscore")
, ("`", "'Backtick")
, ("!", "'Exclamation")
, ("#", "'Hash")
, ("$", "'Dollar")
, ("%", "'Percent")
, ("&", "'Ampersand")
, ("'", "'Quote")
, ("(", "'Left_Parenthesis")
, (")", "'Right_Parenthesis")
, ("*", "'Star")
, ("+", "'Plus")
, (",", "'Comma")
, ("-", "'Dash")
, (".", "'Period")
, ("/", "'Slash")
, (":", "'Colon")
, ("{", "'Left_Curly_Bracket")
, ("|", "'Pipe")
, ("<", "'LessThan")
, ("!=", "'Not_Equal")
, ("=", "'Equal")
, ("}", "'Right_Curly_Bracket")
, (">", "'GreaterThan")
, ("~", "'Tilde")
, ("?", "'Question_Mark")
, (">=", "'Greater_Than_Or_Equal_To")
]
mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack
replacer = if forParsing then flip T.replace else T.replace replacer =
if forParsing
then flip T.replace
else T.replace