From 25207e08cfb124b0d4475c1a293760b5aeb8d77e Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Fri, 7 Jun 2024 10:27:34 +0200
Subject: [PATCH] Added description to GPT FunctionCall

---
 ihp-openai/IHP/OpenAI.hs          |  7 +++++--
 ihp-openai/Test/IHP/OpenAISpec.hs | 13 ++++++++++++-
 ihp-openai/ihp-openai.cabal       |  1 +
 3 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/ihp-openai/IHP/OpenAI.hs b/ihp-openai/IHP/OpenAI.hs
index b917e6ae2..b8516996b 100644
--- a/ihp-openai/IHP/OpenAI.hs
+++ b/ihp-openai/IHP/OpenAI.hs
@@ -65,7 +65,7 @@ data JsonSchema
     deriving (Eq, Show)
 
 data Property
-    = Property { propertyName :: !Text, type_ :: !JsonSchema, required :: !Bool }
+    = Property { propertyName :: !Text, type_ :: !JsonSchema, required :: !Bool, description :: !(Maybe Text) }
     deriving (Eq, Show)
 
 instance ToJSON CompletionRequest where
@@ -117,8 +117,11 @@ instance ToJSON JsonSchema where
     toJSON (JsonSchemaObject properties) =
         object
             [ "type" .= ("object" :: Text)
-            , "properties" .= (object (concat (map (\property -> [ (Key.fromText property.propertyName) .= (toJSON property.type_) ]) properties)))
+            , "properties" .= (object (concat (map (\property -> [ (Key.fromText property.propertyName) .= ((toJSON property.type_) `mergeObj` (object [ "description" .= property.description ])) ]) properties)))
             ]
+        where
+            mergeObj (Object first) (Object second) = Object (first <> second)
+            mergeObj _ _ = error "JsonSchema.mergeObj failed with invalid type"
     toJSON JsonSchemaString =
         object [ "type" .= ("string" :: Text) ]
     
diff --git a/ihp-openai/Test/IHP/OpenAISpec.hs b/ihp-openai/Test/IHP/OpenAISpec.hs
index 77eb43f33..cddd588dd 100644
--- a/ihp-openai/Test/IHP/OpenAISpec.hs
+++ b/ihp-openai/Test/IHP/OpenAISpec.hs
@@ -5,6 +5,7 @@ import IHP.OpenAI
 import NeatInterpolation (trimming)
 import qualified Data.Text.Encoding as Text
 import qualified Data.Text as Text
+import Data.Aeson
 
 main :: IO ()
 main = hspec do
@@ -584,4 +585,14 @@ tests = do
 
                 let parseLines = foldl (\state line -> (parseResponseChunk state (Text.encodeUtf8 line)).state) emptyParserState (Text.lines input)
 
-                parseLines `shouldBe` result
\ No newline at end of file
+                parseLines `shouldBe` result
+
+        describe "ToJSON Tool" do
+            it "encode Function call with parameter descriptions" do
+                let function = Function
+                        { name = "fetchUrl"
+                        , description = Just "Fetches a url"
+                        , parameters = Just (JsonSchemaObject [ Property { propertyName = "url", type_ = JsonSchemaString, required = True, description = Just "The url to fetch" }])
+                        }
+
+                encode function `shouldBe` "{\"function\":{\"description\":\"Fetches a url\",\"name\":\"fetchUrl\",\"parameters\":{\"properties\":{\"url\":{\"description\":\"The url to fetch\",\"type\":\"string\"}},\"type\":\"object\"}},\"type\":\"function\"}"
\ No newline at end of file
diff --git a/ihp-openai/ihp-openai.cabal b/ihp-openai/ihp-openai.cabal
index 0d7162971..684701ef7 100644
--- a/ihp-openai/ihp-openai.cabal
+++ b/ihp-openai/ihp-openai.cabal
@@ -62,6 +62,7 @@ test-suite tests
         , neat-interpolation
         , ihp-openai
         , text
+        , aeson
     hs-source-dirs: Test
     default-language: Haskell2010
     default-extensions: