Merge pull request #22 from iconnect/adinapoli/support-response-format

Add support for response_format
agrafix · Jul 13, 2024 · 85dea7b · 85dea7b
2 parents c44adfc + fb709ee
commit 85dea7b
Show file tree

Hide file tree

Showing 2 changed files with 25 additions and 0 deletions.
diff --git a/openai-hs/src/OpenAI/Client.hs b/openai-hs/src/OpenAI/Client.hs
@@ -35,6 +35,7 @@ module OpenAI.Client
  ChatCompletionRequest (..),
  ChatChoice (..),
  ChatResponse (..),
+ ResponseFormat(..),
  defaultChatCompletionRequest,
  completeChat,
 

diff --git a/openai-servant/src/OpenAI/Resources.hs b/openai-servant/src/OpenAI/Resources.hs
@@ -29,6 +29,7 @@ module OpenAI.Resources
  ChatCompletionRequest (..),
  ChatChoice (..),
  ChatResponse (..),
+ ResponseFormat(..),
  defaultChatCompletionRequest,
 
  -- * Edits
@@ -308,12 +309,34 @@ data ChatCompletionRequest = ChatCompletionRequest
  chcrStop :: Maybe (V.Vector T.Text),
  chcrMaxTokens :: Maybe Int,
  chcrPresencePenalty :: Maybe Double,
+ chcrResponseFormat :: Maybe ResponseFormat,
  chcrFrequencyPenalty :: Maybe Double,
  chcrLogitBias :: Maybe (V.Vector Double),
  chcrUser :: Maybe String
  }
  deriving (Show, Eq)
 
+data ResponseFormat
+ = RF_text
+ | RF_json_object
+ deriving (Show, Eq)
+
+instance ToJSON ResponseFormat where
+ toJSON = \case
+ RF_text -> A.object [ "type" A..= A.String "text" ]
+ RF_json_object -> A.object [ "type" A..= A.String "json_object" ]
+
+instance FromJSON ResponseFormat where
+ parseJSON = A.withObject "ResponseFormat" $ \o -> do
+ rt <- o A..: "type"
+ case rt of
+ "text"
+ -> pure RF_text
+ "json_object"
+ -> pure RF_json_object
+ xs
+ -> fail $ "ResponseFormat unexpected type: " <> T.unpack xs
+
 defaultChatCompletionRequest :: ModelId -> [ChatMessage] -> ChatCompletionRequest
 defaultChatCompletionRequest model messages =
  ChatCompletionRequest
@@ -328,6 +351,7 @@ defaultChatCompletionRequest model messages =
  chcrStop = Nothing,
  chcrMaxTokens = Nothing,
  chcrPresencePenalty = Nothing,
+ chcrResponseFormat = Nothing,
  chcrFrequencyPenalty = Nothing,
  chcrLogitBias = Nothing,
  chcrUser = Nothing