Added description to GPT FunctionCall

digitallyinduced · Jun 7, 2024 · 25207e0 · 25207e0
1 parent 207c5c2
commit 25207e0
Show file tree

Hide file tree

Showing 3 changed files with 18 additions and 3 deletions.
diff --git 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
@@ -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
+                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\"}"
diff --git 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: