Map ByteArray to Text for haskell codegen (#6402)

* Support ByteArray in haskell codegen * update petstore example
2017-08-30 19:19:42 -07:00 · 2017-08-30 19:19:42 -07:00 · 37f48239b0
commit 37f48239b0
parent 8ec98a2ac4
2 changed files with 96 additions and 60 deletions
--- 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
@ -148,6 +148,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
        typeMapping.put("integer", "Int");
        typeMapping.put("any", "Value");
        typeMapping.put("UUID", "Text");
+        typeMapping.put("ByteArray", "Text");

        importMapping.clear();
        importMapping.put("Map", "qualified Data.Map as Map");
@ -163,7 +164,7 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
     * @return the escaped term
     */
    @Override
-    public String escapeReservedWord(String name) {           
+    public String escapeReservedWord(String name) {
        if(this.reservedWordsMappings().containsKey(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
        String dataOrNewtype = "data";
-        // check if it's a ModelImpl before casting 
+        // check if it's a ModelImpl before casting
        if (!(mod instanceof ModelImpl)) {
            return model;
        }
--- a/samples/server/petstore/haskell-servant/lib/SwaggerPetstore/Types.hs
+++ b/samples/server/petstore/haskell-servant/lib/SwaggerPetstore/Types.hs
@ -3,13 +3,13 @@
 {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}

 module SwaggerPetstore.Types (
-    ApiResponse (..),
-    Category (..),
-    Order (..),
-    Pet (..),
-    Tag (..),
-    User (..),
-    ) where
+  ApiResponse (..),
+  Category (..),
+  Order (..),
+  Pet (..),
+  Tag (..),
+  User (..),
+  ) where

 import Data.List (stripPrefix)
 import Data.Maybe (fromMaybe)
@ -24,96 +24,131 @@ import Data.Function ((&))

 -- | Describes the result of uploading an image resource
 data ApiResponse = ApiResponse
-    { apiResponseCode :: Int -- ^ 
-    , apiResponseType :: Text -- ^ 
-    , apiResponseMessage :: Text -- ^ 
-    } deriving (Show, Eq, Generic)
+  { apiResponseCode :: Int -- ^ 
+  , apiResponseType :: Text -- ^ 
+  , apiResponseMessage :: Text -- ^ 
+  } deriving (Show, Eq, Generic)

 instance FromJSON ApiResponse where
-  parseJSON  = genericParseJSON  (removeFieldLabelPrefix True "apiResponse")
+  parseJSON = genericParseJSON (removeFieldLabelPrefix True "apiResponse")
 instance ToJSON ApiResponse where
-  toJSON     = genericToJSON     (removeFieldLabelPrefix False "apiResponse")
+  toJSON = genericToJSON (removeFieldLabelPrefix False "apiResponse")

 -- | A category for a pet
 data Category = Category
-    { categoryId :: Integer -- ^ 
-    , categoryName :: Text -- ^ 
-    } deriving (Show, Eq, Generic)
+  { categoryId :: Integer -- ^ 
+  , categoryName :: Text -- ^ 
+  } deriving (Show, Eq, Generic)

 instance FromJSON Category where
-  parseJSON  = genericParseJSON  (removeFieldLabelPrefix True "category")
+  parseJSON = genericParseJSON (removeFieldLabelPrefix True "category")
 instance ToJSON Category where
-  toJSON     = genericToJSON     (removeFieldLabelPrefix False "category")
+  toJSON = genericToJSON (removeFieldLabelPrefix False "category")

 -- | An order for a pets from the pet store
 data Order = Order
-    { orderId :: Integer -- ^ 
-    , orderPetId :: Integer -- ^ 
-    , orderQuantity :: Int -- ^ 
-    , orderShipDate :: Integer -- ^ 
-    , orderStatus :: Text -- ^ Order Status
-    , orderComplete :: Bool -- ^ 
-    } deriving (Show, Eq, Generic)
+  { orderId :: Integer -- ^ 
+  , orderPetId :: Integer -- ^ 
+  , orderQuantity :: Int -- ^ 
+  , orderShipDate :: Integer -- ^ 
+  , orderStatus :: Text -- ^ Order Status
+  , orderComplete :: Bool -- ^ 
+  } deriving (Show, Eq, Generic)

 instance FromJSON Order where
-  parseJSON  = genericParseJSON  (removeFieldLabelPrefix True "order")
+  parseJSON = genericParseJSON (removeFieldLabelPrefix True "order")
 instance ToJSON Order where
-  toJSON     = genericToJSON     (removeFieldLabelPrefix False "order")
+  toJSON = genericToJSON (removeFieldLabelPrefix False "order")

 -- | A pet for sale in the pet store
 data Pet = Pet
-    { petId :: Integer -- ^ 
-    , petCategory :: Category -- ^ 
-    , petName :: Text -- ^ 
-    , petPhotoUrls :: [Text] -- ^ 
-    , petTags :: [Tag] -- ^ 
-    , petStatus :: Text -- ^ pet status in the store
-    } deriving (Show, Eq, Generic)
+  { petId :: Integer -- ^ 
+  , petCategory :: Category -- ^ 
+  , petName :: Text -- ^ 
+  , petPhotoUrls :: [Text] -- ^ 
+  , petTags :: [Tag] -- ^ 
+  , petStatus :: Text -- ^ pet status in the store
+  } deriving (Show, Eq, Generic)

 instance FromJSON Pet where
-  parseJSON  = genericParseJSON  (removeFieldLabelPrefix True "pet")
+  parseJSON = genericParseJSON (removeFieldLabelPrefix True "pet")
 instance ToJSON Pet where
-  toJSON     = genericToJSON     (removeFieldLabelPrefix False "pet")
+  toJSON = genericToJSON (removeFieldLabelPrefix False "pet")

 -- | A tag for a pet
 data Tag = Tag
-    { tagId :: Integer -- ^ 
-    , tagName :: Text -- ^ 
-    } deriving (Show, Eq, Generic)
+  { tagId :: Integer -- ^ 
+  , tagName :: Text -- ^ 
+  } deriving (Show, Eq, Generic)

 instance FromJSON Tag where
-  parseJSON  = genericParseJSON  (removeFieldLabelPrefix True "tag")
+  parseJSON = genericParseJSON (removeFieldLabelPrefix True "tag")
 instance ToJSON Tag where
-  toJSON     = genericToJSON     (removeFieldLabelPrefix False "tag")
+  toJSON = genericToJSON (removeFieldLabelPrefix False "tag")

 -- | A User who is purchasing from the pet store
 data User = User
-    { userId :: Integer -- ^ 
-    , userUsername :: Text -- ^ 
-    , userFirstName :: Text -- ^ 
-    , userLastName :: Text -- ^ 
-    , userEmail :: Text -- ^ 
-    , userPassword :: Text -- ^ 
-    , userPhone :: Text -- ^ 
-    , userUserStatus :: Int -- ^ User Status
-    } deriving (Show, Eq, Generic)
+  { userId :: Integer -- ^ 
+  , userUsername :: Text -- ^ 
+  , userFirstName :: Text -- ^ 
+  , userLastName :: Text -- ^ 
+  , userEmail :: Text -- ^ 
+  , userPassword :: Text -- ^ 
+  , userPhone :: Text -- ^ 
+  , userUserStatus :: Int -- ^ User Status
+  } deriving (Show, Eq, Generic)

 instance FromJSON User where
-  parseJSON  = genericParseJSON  (removeFieldLabelPrefix True "user")
+  parseJSON = genericParseJSON (removeFieldLabelPrefix True "user")
 instance ToJSON User where
-  toJSON     = genericToJSON     (removeFieldLabelPrefix False "user")
+  toJSON = genericToJSON (removeFieldLabelPrefix False "user")

 -- Remove a field label prefix during JSON parsing.
 -- Also perform any replacements for special characters.
 removeFieldLabelPrefix :: Bool -> String -> Options
 removeFieldLabelPrefix forParsing prefix =
  defaultOptions
-    { fieldLabelModifier = fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars
-    }
+  {fieldLabelModifier = fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars}
  where
    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
-    replacer = if forParsing then flip T.replace else T.replace
-
-
+    replacer =
+      if forParsing
+        then flip T.replace
+        else T.replace