-- | The `ToolCall` type
module OpenAI.V1.ToolCall
    ( -- * Types
      ToolCall(..)
    , Function(..)
    ) where

import OpenAI.Prelude

-- | A called function
data Function = Function{ Function -> Text
name :: Text, Function -> Text
arguments :: Text }
    deriving stock ((forall x. Function -> Rep Function x)
-> (forall x. Rep Function x -> Function) -> Generic Function
forall x. Rep Function x -> Function
forall x. Function -> Rep Function x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Function -> Rep Function x
from :: forall x. Function -> Rep Function x
$cto :: forall x. Rep Function x -> Function
to :: forall x. Rep Function x -> Function
Generic, Int -> Function -> ShowS
[Function] -> ShowS
Function -> String
(Int -> Function -> ShowS)
-> (Function -> String) -> ([Function] -> ShowS) -> Show Function
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Function -> ShowS
showsPrec :: Int -> Function -> ShowS
$cshow :: Function -> String
show :: Function -> String
$cshowList :: [Function] -> ShowS
showList :: [Function] -> ShowS
Show)
    deriving anyclass (Maybe Function
Value -> Parser [Function]
Value -> Parser Function
(Value -> Parser Function)
-> (Value -> Parser [Function])
-> Maybe Function
-> FromJSON Function
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Function
parseJSON :: Value -> Parser Function
$cparseJSONList :: Value -> Parser [Function]
parseJSONList :: Value -> Parser [Function]
$comittedField :: Maybe Function
omittedField :: Maybe Function
FromJSON, [Function] -> Value
[Function] -> Encoding
Function -> Bool
Function -> Value
Function -> Encoding
(Function -> Value)
-> (Function -> Encoding)
-> ([Function] -> Value)
-> ([Function] -> Encoding)
-> (Function -> Bool)
-> ToJSON Function
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Function -> Value
toJSON :: Function -> Value
$ctoEncoding :: Function -> Encoding
toEncoding :: Function -> Encoding
$ctoJSONList :: [Function] -> Value
toJSONList :: [Function] -> Value
$ctoEncodingList :: [Function] -> Encoding
toEncodingList :: [Function] -> Encoding
$comitField :: Function -> Bool
omitField :: Function -> Bool
ToJSON)

-- | Tools called by the model
data ToolCall = ToolCall_Function
    { ToolCall -> Text
id :: Text
    , ToolCall -> Function
function :: Function
    } deriving stock ((forall x. ToolCall -> Rep ToolCall x)
-> (forall x. Rep ToolCall x -> ToolCall) -> Generic ToolCall
forall x. Rep ToolCall x -> ToolCall
forall x. ToolCall -> Rep ToolCall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ToolCall -> Rep ToolCall x
from :: forall x. ToolCall -> Rep ToolCall x
$cto :: forall x. Rep ToolCall x -> ToolCall
to :: forall x. Rep ToolCall x -> ToolCall
Generic, Int -> ToolCall -> ShowS
[ToolCall] -> ShowS
ToolCall -> String
(Int -> ToolCall -> ShowS)
-> (ToolCall -> String) -> ([ToolCall] -> ShowS) -> Show ToolCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolCall -> ShowS
showsPrec :: Int -> ToolCall -> ShowS
$cshow :: ToolCall -> String
show :: ToolCall -> String
$cshowList :: [ToolCall] -> ShowS
showList :: [ToolCall] -> ShowS
Show)

toolCallOptions :: Options
toolCallOptions :: Options
toolCallOptions = Options
aesonOptions
    { sumEncoding =
        TaggedObject{ tagFieldName = "type", contentsFieldName = "" }

    , tagSingleConstructors = True

    , constructorTagModifier = stripPrefix "ToolCall_"
    }

instance ToJSON ToolCall where
    toJSON :: ToolCall -> Value
toJSON = Options -> ToolCall -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
toolCallOptions

instance FromJSON ToolCall where
    parseJSON :: Value -> Parser ToolCall
parseJSON = Options -> Value -> Parser ToolCall
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
toolCallOptions