fix: use ToJSON instance instead of Show to serialize path parameters

openapi3-code-generator/src/OpenAPI/Common.hs

@@ -22,7 +22,6 @@ module OpenAPI.Common
     Configuration (..),
     SecurityScheme,
     MonadHTTP (..),
-    StringifyModel,
     JsonByteString (..),
     JsonDateTime (..),
     RequestBodyEncoding (..),
@@ -38,6 +37,7 @@ import qualified Control.Monad.Reader as MR
 import qualified Control.Monad.Trans.Class as MT
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encoding as Encoding
+import Data.Aeson.Text (encodeToTextBuilder)
 import qualified Data.Bifunctor as BF
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
@@ -47,6 +47,8 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import Data.Text.Encoding.Error (lenientDecode)
+import Data.Text.Lazy (toStrict)
+import Data.Text.Lazy.Builder (toLazyText)
 import qualified Data.Time.LocalTime as Time
 import qualified Data.Vector as Vector
 import qualified Network.HTTP.Client as HC
@@ -338,30 +340,13 @@ jsonToFormDataPrefixed prefix (Aeson.Object object) =
 jsonToFormDataPrefixed prefix (Aeson.Array vector) =
   Vector.toList vector >>= jsonToFormDataPrefixed (prefix <> "[]")
 
--- | This type class makes the code generation for URL parameters easier as it allows to stringify a value
+-- | This function makes the code generation for URL parameters easier as it allows to stringify a value
 --
 -- The 'Show' class is not sufficient as strings should not be stringified with quotes.
-class Show a => StringifyModel a where
-  -- | Stringifies a showable value
-  --
-  -- >>> stringifyModel "Test"
-  -- "Test"
-  --
-  -- >>> stringifyModel 123
-  -- "123"
-  stringifyModel :: a -> Text
-
-instance StringifyModel String where
-  -- stringifyModel :: String -> String
-  stringifyModel = T.pack
-
-instance StringifyModel Text where
-  -- stringifyModel :: Text -> String
-  stringifyModel = id
-
-instance {-# OVERLAPS #-} Show a => StringifyModel a where
-  -- stringifyModel :: Show a => a -> String
-  stringifyModel = T.pack . show
+stringifyModel :: Aeson.ToJSON a => a -> Text
+stringifyModel x = case Aeson.toJSON x of
+  Aeson.String s -> s
+  v -> toStrict $ toLazyText $ encodeToTextBuilder v
 
 -- | Wraps a 'BS.ByteString' to implement 'Aeson.ToJSON' and 'Aeson.FromJSON'
 newtype JsonByteString = JsonByteString BS.ByteString

openapi3-code-generator/src/OpenAPI/Generate/Internal/Util.hs

@@ -84,7 +84,6 @@ haskellifyText convertToCamelCase startWithUppercase name =
       replaceReservedWord "where" = "where'"
       replaceReservedWord "Configuration" = "Configuration'"
       replaceReservedWord "MonadHTTP" = "MonadHTTP'"
-      replaceReservedWord "StringifyModel" = "StringifyModel'"
       replaceReservedWord "SecurityScheme" = "SecurityScheme'"
       replaceReservedWord "AnonymousSecurityScheme" = "AnonymousSecurityScheme'"
       replaceReservedWord "JsonByteString" = "JsonByteString'"

specifications/petstore-running-example.yaml

@@ -563,6 +563,27 @@ paths:
                 type: string
         '400':
           description: No User-Agent header is present
+  "/echo/{path}":
+    get:
+      summary: Echo the path
+      operationId: echoPath
+      parameters:
+      - name: path
+        in: path
+        required: true
+        schema:
+          type: string
+          enum:
+            - test
+            - foo
+            - bar
+      responses:
+        '200':
+          description: The path parameter
+          content:
+            application/json:
+              schema:
+                type: string
   "/nullable-optional/{mode}":
     post:
       summary: Test nullable and optional values

testing/golden-output/src/OpenAPI/Common.hs

@@ -22,7 +22,6 @@ module OpenAPI.Common
     Configuration (..),
     SecurityScheme,
     MonadHTTP (..),
-    StringifyModel,
     JsonByteString (..),
     JsonDateTime (..),
     RequestBodyEncoding (..),
@@ -38,6 +37,7 @@ import qualified Control.Monad.Reader as MR
 import qualified Control.Monad.Trans.Class as MT
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encoding as Encoding
+import Data.Aeson.Text (encodeToTextBuilder)
 import qualified Data.Bifunctor as BF
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
@@ -47,6 +47,8 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import Data.Text.Encoding.Error (lenientDecode)
+import Data.Text.Lazy (toStrict)
+import Data.Text.Lazy.Builder (toLazyText)
 import qualified Data.Time.LocalTime as Time
 import qualified Data.Vector as Vector
 import qualified Network.HTTP.Client as HC
@@ -338,30 +340,13 @@ jsonToFormDataPrefixed prefix (Aeson.Object object) =
 jsonToFormDataPrefixed prefix (Aeson.Array vector) =
   Vector.toList vector >>= jsonToFormDataPrefixed (prefix <> "[]")
 
--- | This type class makes the code generation for URL parameters easier as it allows to stringify a value
+-- | This function makes the code generation for URL parameters easier as it allows to stringify a value
 --
 -- The 'Show' class is not sufficient as strings should not be stringified with quotes.
-class Show a => StringifyModel a where
-  -- | Stringifies a showable value
-  --
-  -- >>> stringifyModel "Test"
-  -- "Test"
-  --
-  -- >>> stringifyModel 123
-  -- "123"
-  stringifyModel :: a -> Text
-
-instance StringifyModel String where
-  -- stringifyModel :: String -> String
-  stringifyModel = T.pack
-
-instance StringifyModel Text where
-  -- stringifyModel :: Text -> String
-  stringifyModel = id
-
-instance {-# OVERLAPS #-} Show a => StringifyModel a where
-  -- stringifyModel :: Show a => a -> String
-  stringifyModel = T.pack . show
+stringifyModel :: Aeson.ToJSON a => a -> Text
+stringifyModel x = case Aeson.toJSON x of
+  Aeson.String s -> s
+  v -> toStrict $ toLazyText $ encodeToTextBuilder v
 
 -- | Wraps a 'BS.ByteString' to implement 'Aeson.ToJSON' and 'Aeson.FromJSON'
 newtype JsonByteString = JsonByteString BS.ByteString

testing/level3/mock-server/src/Lib.hs

@@ -34,6 +34,7 @@ type API =
     :<|> "pet" :> "findByStatus" :> QueryParam "status" String :> Get '[JSON] [Pet]
     :<|> "pet" :> ReqBody '[JSON] Pet :> Post '[JSON] NoContent
     :<|> "echo" :> Header "User-Agent" String :> Get '[JSON] String
+    :<|> "echo" :> Capture "path" String :> Get '[JSON] String
     :<|> "nullable-optional" :> Capture "mode" String :> ReqBody '[JSON] Value :> Post '[JSON] Value
 
 startApp :: IO ()
@@ -46,7 +47,7 @@ api :: Proxy API
 api = Proxy
 
 server :: Server API
-server = pure getInventory :<|> findByStatus :<|> addPet :<|> userAgentEcho :<|> checkNullableAndOptional
+server = pure getInventory :<|> findByStatus :<|> addPet :<|> userAgentEcho :<|> pathEcho :<|> checkNullableAndOptional
 
 getInventory :: Value
 getInventory = object ["pet1" .= Number 23, "pet2" .= Number 2]
@@ -71,6 +72,9 @@ userAgentEcho :: Maybe String -> Handler String
 userAgentEcho (Just userAgent) = pure userAgent
 userAgentEcho Nothing = throwError err400
 
+pathEcho :: String -> Handler String
+pathEcho = pure
+
 checkNullableAndOptional :: String -> Value -> Handler Value
 checkNullableAndOptional "filled" (Object map) = do
   when (KeyMap.lookup (Key.fromText "requiredNonNullable") map /= Just "x") $ throwError err400

testing/level3/petstore-running-example/src/Lib.hs

@@ -38,5 +38,8 @@ runEchoUserAgentWithoutUserAgent =
       { configIncludeUserAgent = False
       }
 
+runEchoPath :: MonadHTTP m => EchoPathParametersPath -> m (Response EchoPathResponse)
+runEchoPath = echoPathWithConfiguration defaultConfiguration
+
 runSendAndReceiveNullableAndOptional :: MonadHTTP m => Text -> NullableAndOptionalTest -> m (Response SendAndReceiveNullableAndOptionalResponse)
 runSendAndReceiveNullableAndOptional mode body = sendAndReceiveNullableAndOptionalWithConfiguration defaultConfiguration mode body

testing/level3/petstore-running-example/test/Spec.hs

@@ -69,6 +69,23 @@ main =
           getResponseBody response
             `shouldBe` EchoUserAgentResponse400
 
+    describe "runEchoPath" $ do
+      it "returns enum value 'test'" $
+        do
+          response <- runEchoPath EchoPathParametersPathEnumTest
+          getResponseBody response
+            `shouldBe` EchoPathResponse200 "test"
+      it "returns enum value 'foo'" $
+        do
+          response <- runEchoPath EchoPathParametersPathEnumFoo
+          getResponseBody response
+            `shouldBe` EchoPathResponse200 "foo"
+      it "works with custom value" $
+        do
+          response <- runEchoPath $ EchoPathParametersPathTyped "xyz"
+          getResponseBody response
+            `shouldBe` EchoPathResponse200 "xyz"
+
     describe "runSendAndReceiveNullableAndOptional" $ do
       it "should work with filled objects" $ do
         response <-