module IHP.OpenAI where

import Data.Text (Text)
import Data.ByteString (ByteString)
import Control.Exception (SomeException)
import Data.IORef

import qualified System.IO.Streams as Streams
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as ByteString
import Network.Http.Client
import Data.Aeson
import OpenSSL
import qualified OpenSSL.Session as SSL
import qualified Data.Text as Text
import qualified Control.Retry as Retry
import qualified Control.Exception as Exception
import Control.Applicative ((<|>))
import qualified Data.Aeson.Key as Key
import qualified Data.Maybe as Maybe

data CompletionRequest = CompletionRequest
    { CompletionRequest -> [Message]
messages :: ![Message]
    , CompletionRequest -> Text
model :: !Text
    , CompletionRequest -> Maybe StatusCode
maxTokens :: !(Maybe Int)
    , CompletionRequest -> Maybe Double
temperature :: !(Maybe Double)
    , CompletionRequest -> Maybe Double
presencePenalty :: !(Maybe Double)
    , CompletionRequest -> Maybe Double
frequencePenalty :: !(Maybe Double)
    , CompletionRequest -> Bool
stream :: !Bool
    , CompletionRequest -> Maybe ResponseFormat
responseFormat :: !(Maybe ResponseFormat)
    , CompletionRequest -> [Tool]
tools :: ![Tool]
    } deriving (CompletionRequest -> CompletionRequest -> Bool
(CompletionRequest -> CompletionRequest -> Bool)
-> (CompletionRequest -> CompletionRequest -> Bool)
-> Eq CompletionRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionRequest -> CompletionRequest -> Bool
== :: CompletionRequest -> CompletionRequest -> Bool
$c/= :: CompletionRequest -> CompletionRequest -> Bool
/= :: CompletionRequest -> CompletionRequest -> Bool
Eq, StatusCode -> CompletionRequest -> ShowS
[CompletionRequest] -> ShowS
CompletionRequest -> [Char]
(StatusCode -> CompletionRequest -> ShowS)
-> (CompletionRequest -> [Char])
-> ([CompletionRequest] -> ShowS)
-> Show CompletionRequest
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> CompletionRequest -> ShowS
showsPrec :: StatusCode -> CompletionRequest -> ShowS
$cshow :: CompletionRequest -> [Char]
show :: CompletionRequest -> [Char]
$cshowList :: [CompletionRequest] -> ShowS
showList :: [CompletionRequest] -> ShowS
Show)

data Message = Message
    { Message -> Role
role :: !Role
    , Message -> Text
content :: !Text
    , Message -> Maybe Text
name :: !(Maybe Text)
    , Message -> Maybe Text
toolCallId :: !(Maybe Text)
    , Message -> [ToolCall]
toolCalls :: ![ToolCall]
    } deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
/= :: Message -> Message -> Bool
Eq, StatusCode -> Message -> ShowS
[Message] -> ShowS
Message -> [Char]
(StatusCode -> Message -> ShowS)
-> (Message -> [Char]) -> ([Message] -> ShowS) -> Show Message
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> Message -> ShowS
showsPrec :: StatusCode -> Message -> ShowS
$cshow :: Message -> [Char]
show :: Message -> [Char]
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show)

data Role
    = UserRole
    | SystemRole
    | AssistantRole
    | ToolRole
    deriving (Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq, StatusCode -> Role -> ShowS
[Role] -> ShowS
Role -> [Char]
(StatusCode -> Role -> ShowS)
-> (Role -> [Char]) -> ([Role] -> ShowS) -> Show Role
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> Role -> ShowS
showsPrec :: StatusCode -> Role -> ShowS
$cshow :: Role -> [Char]
show :: Role -> [Char]
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show)

data ResponseFormat
    = Text
    | JsonObject
    deriving (ResponseFormat -> ResponseFormat -> Bool
(ResponseFormat -> ResponseFormat -> Bool)
-> (ResponseFormat -> ResponseFormat -> Bool) -> Eq ResponseFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseFormat -> ResponseFormat -> Bool
== :: ResponseFormat -> ResponseFormat -> Bool
$c/= :: ResponseFormat -> ResponseFormat -> Bool
/= :: ResponseFormat -> ResponseFormat -> Bool
Eq, StatusCode -> ResponseFormat -> ShowS
[ResponseFormat] -> ShowS
ResponseFormat -> [Char]
(StatusCode -> ResponseFormat -> ShowS)
-> (ResponseFormat -> [Char])
-> ([ResponseFormat] -> ShowS)
-> Show ResponseFormat
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> ResponseFormat -> ShowS
showsPrec :: StatusCode -> ResponseFormat -> ShowS
$cshow :: ResponseFormat -> [Char]
show :: ResponseFormat -> [Char]
$cshowList :: [ResponseFormat] -> ShowS
showList :: [ResponseFormat] -> ShowS
Show)

data Tool
    = Function { Tool -> Maybe Text
description :: !(Maybe Text), Tool -> Text
name :: !Text, Tool -> Maybe JsonSchema
parameters :: !(Maybe JsonSchema) }
    deriving (Tool -> Tool -> Bool
(Tool -> Tool -> Bool) -> (Tool -> Tool -> Bool) -> Eq Tool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tool -> Tool -> Bool
== :: Tool -> Tool -> Bool
$c/= :: Tool -> Tool -> Bool
/= :: Tool -> Tool -> Bool
Eq, StatusCode -> Tool -> ShowS
[Tool] -> ShowS
Tool -> [Char]
(StatusCode -> Tool -> ShowS)
-> (Tool -> [Char]) -> ([Tool] -> ShowS) -> Show Tool
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> Tool -> ShowS
showsPrec :: StatusCode -> Tool -> ShowS
$cshow :: Tool -> [Char]
show :: Tool -> [Char]
$cshowList :: [Tool] -> ShowS
showList :: [Tool] -> ShowS
Show)

data JsonSchema
    = JsonSchemaObject ![Property]
    | JsonSchemaString
    | JsonSchemaInteger
    | JsonSchemaNumber
    | JsonSchemaArray !JsonSchema
    | JsonSchemaEnum ![Text]
    deriving (JsonSchema -> JsonSchema -> Bool
(JsonSchema -> JsonSchema -> Bool)
-> (JsonSchema -> JsonSchema -> Bool) -> Eq JsonSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonSchema -> JsonSchema -> Bool
== :: JsonSchema -> JsonSchema -> Bool
$c/= :: JsonSchema -> JsonSchema -> Bool
/= :: JsonSchema -> JsonSchema -> Bool
Eq, StatusCode -> JsonSchema -> ShowS
[JsonSchema] -> ShowS
JsonSchema -> [Char]
(StatusCode -> JsonSchema -> ShowS)
-> (JsonSchema -> [Char])
-> ([JsonSchema] -> ShowS)
-> Show JsonSchema
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> JsonSchema -> ShowS
showsPrec :: StatusCode -> JsonSchema -> ShowS
$cshow :: JsonSchema -> [Char]
show :: JsonSchema -> [Char]
$cshowList :: [JsonSchema] -> ShowS
showList :: [JsonSchema] -> ShowS
Show)

data Property
    = Property { Property -> Text
propertyName :: !Text, Property -> JsonSchema
type_ :: !JsonSchema, Property -> Bool
required :: !Bool, Property -> Maybe Text
description :: !(Maybe Text) }
    deriving (Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
/= :: Property -> Property -> Bool
Eq, StatusCode -> Property -> ShowS
[Property] -> ShowS
Property -> [Char]
(StatusCode -> Property -> ShowS)
-> (Property -> [Char]) -> ([Property] -> ShowS) -> Show Property
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> Property -> ShowS
showsPrec :: StatusCode -> Property -> ShowS
$cshow :: Property -> [Char]
show :: Property -> [Char]
$cshowList :: [Property] -> ShowS
showList :: [Property] -> ShowS
Show)

instance ToJSON CompletionRequest where
    toJSON :: CompletionRequest -> Value
toJSON CompletionRequest { Text
$sel:model:CompletionRequest :: CompletionRequest -> Text
model :: Text
model, [Message]
$sel:messages:CompletionRequest :: CompletionRequest -> [Message]
messages :: [Message]
messages, Maybe StatusCode
$sel:maxTokens:CompletionRequest :: CompletionRequest -> Maybe StatusCode
maxTokens :: Maybe StatusCode
maxTokens, Maybe Double
$sel:temperature:CompletionRequest :: CompletionRequest -> Maybe Double
temperature :: Maybe Double
temperature, Maybe Double
$sel:presencePenalty:CompletionRequest :: CompletionRequest -> Maybe Double
presencePenalty :: Maybe Double
presencePenalty, Maybe Double
$sel:frequencePenalty:CompletionRequest :: CompletionRequest -> Maybe Double
frequencePenalty :: Maybe Double
frequencePenalty, Bool
$sel:stream:CompletionRequest :: CompletionRequest -> Bool
stream :: Bool
stream, Maybe ResponseFormat
$sel:responseFormat:CompletionRequest :: CompletionRequest -> Maybe ResponseFormat
responseFormat :: Maybe ResponseFormat
responseFormat, [Tool]
$sel:tools:CompletionRequest :: CompletionRequest -> [Tool]
tools :: [Tool]
tools } =
        [Pair] -> Value
object
            [ Key
"model" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
model
            , Key
"messages" Key -> [Message] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Message]
messages
            , Key
"max_tokens" Key -> Maybe StatusCode -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe StatusCode
maxTokens
            , Key
"stream" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
stream
            , Key
"temperature" Key -> Maybe Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
temperature
            , Key
"presence_penalty" Key -> Maybe Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
presencePenalty
            , Key
"frequency_penalty" Key -> Maybe Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
frequencePenalty
            , Key
"response_format" Key -> Maybe ResponseFormat -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe ResponseFormat
responseFormat
            , Key
"tools" Key -> Maybe [Tool] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Tool] -> Maybe [Tool]
forall value. [value] -> Maybe [value]
emptyListToNothing [Tool]
tools
            ]

instance ToJSON Role where
    toJSON :: Role -> Value
toJSON Role
UserRole = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"user" :: Text)
    toJSON Role
SystemRole = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"system" :: Text)
    toJSON Role
AssistantRole = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"assistant" :: Text)
    toJSON Role
ToolRole = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"tool" :: Text)

instance ToJSON Message where
    toJSON :: Message -> Value
toJSON Message { Role
$sel:role:Message :: Message -> Role
role :: Role
role, Text
$sel:content:Message :: Message -> Text
content :: Text
content, Maybe Text
$sel:name:Message :: Message -> Maybe Text
name :: Maybe Text
name, Maybe Text
$sel:toolCallId:Message :: Message -> Maybe Text
toolCallId :: Maybe Text
toolCallId, [ToolCall]
$sel:toolCalls:Message :: Message -> [ToolCall]
toolCalls :: [ToolCall]
toolCalls } = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
        [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"role" Key -> Role -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Role
role)
        , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"content" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
content)
        , (Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
name
        , (Key
"tool_call_id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
toolCallId
        , if [ToolCall] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ToolCall]
toolCalls then Maybe Pair
forall a. Maybe a
Nothing else Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"tool_calls" Key -> [ToolCall] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [ToolCall]
toolCalls)
        ]

instance ToJSON ResponseFormat where
    toJSON :: ResponseFormat -> Value
toJSON ResponseFormat
Text = [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"text" :: Text) ]
    toJSON ResponseFormat
JsonObject = [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"json_object" :: Text) ]

instance ToJSON Tool where
    toJSON :: Tool -> Value
toJSON Function { Maybe Text
$sel:description:Function :: Tool -> Maybe Text
description :: Maybe Text
description, Text
$sel:name:Function :: Tool -> Text
name :: Text
name, Maybe JsonSchema
$sel:parameters:Function :: Tool -> Maybe JsonSchema
parameters :: Maybe JsonSchema
parameters } =
        [Pair] -> Value
object
            [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"function" :: Text)
            , Key
"function" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ([Pair] -> Value
object
                [ Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name
                , Key
"description" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
description
                , Key
"parameters" Key -> Maybe JsonSchema -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe JsonSchema
parameters
                ])
            ]

instance ToJSON JsonSchema where
    toJSON :: JsonSchema -> Value
toJSON (JsonSchemaObject [Property]
properties) =
        [Pair] -> Value
object
            [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"object" :: Text)
            , Key
"properties" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ([Pair] -> Value
object ([[Pair]] -> [Pair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Property -> [Pair]) -> [Property] -> [[Pair]]
forall a b. (a -> b) -> [a] -> [b]
map (\Property
property -> [ (Text -> Key
Key.fromText Property
property.propertyName) Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ((JsonSchema -> Value
forall a. ToJSON a => a -> Value
toJSON Property
property.type_) Value -> Value -> Value
`mergeObj` ([Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Maybe.catMaybes [ (Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Property
property.description ])) ]) [Property]
properties)))
            ]
        where
            mergeObj :: Value -> Value -> Value
mergeObj (Object Object
first) (Object Object
second) = Object -> Value
Object (Object
first Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
second)
            mergeObj Value
_ Value
_ = [Char] -> Value
forall a. HasCallStack => [Char] -> a
error [Char]
"JsonSchema.mergeObj failed with invalid type"
    toJSON JsonSchema
JsonSchemaString =
        [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"string" :: Text) ]
    
    toJSON JsonSchema
JsonSchemaInteger =
        [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"integer" :: Text) ]
    
    toJSON JsonSchema
JsonSchemaNumber =
        [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"number" :: Text) ]
    
    toJSON (JsonSchemaArray JsonSchema
items) =
        [Pair] -> Value
object
            [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"array" :: Text)
            , Key
"items" Key -> JsonSchema -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonSchema
items
            ]
    
    toJSON (JsonSchemaEnum [Text]
values) =
        [Pair] -> Value
object
            [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"string" :: Text)
            , Key
"enum" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Text]
values
            ]        

userMessage :: Text -> Message
userMessage :: Text -> Message
userMessage Text
content = Message { $sel:role:Message :: Role
role = Role
UserRole, Text
$sel:content:Message :: Text
content :: Text
content, $sel:name:Message :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing, $sel:toolCallId:Message :: Maybe Text
toolCallId = Maybe Text
forall a. Maybe a
Nothing, $sel:toolCalls:Message :: [ToolCall]
toolCalls = [] }

systemMessage :: Text -> Message
systemMessage :: Text -> Message
systemMessage Text
content = Message { $sel:role:Message :: Role
role = Role
SystemRole, Text
$sel:content:Message :: Text
content :: Text
content, $sel:name:Message :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing, $sel:toolCallId:Message :: Maybe Text
toolCallId = Maybe Text
forall a. Maybe a
Nothing, $sel:toolCalls:Message :: [ToolCall]
toolCalls = [] }

assistantMessage :: Text -> Message
assistantMessage :: Text -> Message
assistantMessage Text
content = Message { $sel:role:Message :: Role
role = Role
AssistantRole, Text
$sel:content:Message :: Text
content :: Text
content, $sel:name:Message :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing, $sel:toolCallId:Message :: Maybe Text
toolCallId = Maybe Text
forall a. Maybe a
Nothing, $sel:toolCalls:Message :: [ToolCall]
toolCalls = [] }

toolMessage :: Text -> Message
toolMessage :: Text -> Message
toolMessage Text
content = Message { $sel:role:Message :: Role
role = Role
ToolRole, Text
$sel:content:Message :: Text
content :: Text
content, $sel:name:Message :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing, $sel:toolCallId:Message :: Maybe Text
toolCallId = Maybe Text
forall a. Maybe a
Nothing, $sel:toolCalls:Message :: [ToolCall]
toolCalls = [] }

newCompletionRequest :: CompletionRequest
newCompletionRequest :: CompletionRequest
newCompletionRequest = CompletionRequest
    { $sel:messages:CompletionRequest :: [Message]
messages = []
    , $sel:maxTokens:CompletionRequest :: Maybe StatusCode
maxTokens = Maybe StatusCode
forall a. Maybe a
Nothing
    , $sel:temperature:CompletionRequest :: Maybe Double
temperature = Maybe Double
forall a. Maybe a
Nothing
    , $sel:presencePenalty:CompletionRequest :: Maybe Double
presencePenalty = Maybe Double
forall a. Maybe a
Nothing
    , $sel:frequencePenalty:CompletionRequest :: Maybe Double
frequencePenalty = Maybe Double
forall a. Maybe a
Nothing
    , $sel:model:CompletionRequest :: Text
model = Text
"gpt-3.5-turbo"
    , $sel:stream:CompletionRequest :: Bool
stream = Bool
False
    , $sel:responseFormat:CompletionRequest :: Maybe ResponseFormat
responseFormat = Maybe ResponseFormat
forall a. Maybe a
Nothing
    , $sel:tools:CompletionRequest :: [Tool]
tools = []
    }

data CompletionResult
    = CompletionResult
    { CompletionResult -> [Choice]
choices :: [Choice]
    }
    | CompletionError
    { CompletionResult -> Text
message :: !Text
    }
    deriving (CompletionResult -> CompletionResult -> Bool
(CompletionResult -> CompletionResult -> Bool)
-> (CompletionResult -> CompletionResult -> Bool)
-> Eq CompletionResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionResult -> CompletionResult -> Bool
== :: CompletionResult -> CompletionResult -> Bool
$c/= :: CompletionResult -> CompletionResult -> Bool
/= :: CompletionResult -> CompletionResult -> Bool
Eq, StatusCode -> CompletionResult -> ShowS
[CompletionResult] -> ShowS
CompletionResult -> [Char]
(StatusCode -> CompletionResult -> ShowS)
-> (CompletionResult -> [Char])
-> ([CompletionResult] -> ShowS)
-> Show CompletionResult
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> CompletionResult -> ShowS
showsPrec :: StatusCode -> CompletionResult -> ShowS
$cshow :: CompletionResult -> [Char]
show :: CompletionResult -> [Char]
$cshowList :: [CompletionResult] -> ShowS
showList :: [CompletionResult] -> ShowS
Show)

instance FromJSON CompletionResult where
    parseJSON :: Value -> Parser CompletionResult
parseJSON = [Char]
-> (Object -> Parser CompletionResult)
-> Value
-> Parser CompletionResult
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"CompletionResult" \Object
v -> do
        let result :: Parser CompletionResult
result = [Choice] -> CompletionResult
CompletionResult ([Choice] -> CompletionResult)
-> Parser [Choice] -> Parser CompletionResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser [Choice]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"choices"
        let error :: Parser CompletionResult
error = do
                Object
errorObj <- Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
                Text
message <- Object
errorObj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
                CompletionResult -> Parser CompletionResult
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionError { Text
$sel:message:CompletionResult :: Text
message :: Text
message }

        Parser CompletionResult
result Parser CompletionResult
-> Parser CompletionResult -> Parser CompletionResult
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser CompletionResult
error

-- [{"text": "Introdu", "index": 0, "logprobs": null, "finish_reason": null}]
data Choice = Choice
    { Choice -> Text
text :: !Text
    }
    deriving (Choice -> Choice -> Bool
(Choice -> Choice -> Bool)
-> (Choice -> Choice -> Bool) -> Eq Choice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Choice -> Choice -> Bool
== :: Choice -> Choice -> Bool
$c/= :: Choice -> Choice -> Bool
/= :: Choice -> Choice -> Bool
Eq, StatusCode -> Choice -> ShowS
[Choice] -> ShowS
Choice -> [Char]
(StatusCode -> Choice -> ShowS)
-> (Choice -> [Char]) -> ([Choice] -> ShowS) -> Show Choice
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> Choice -> ShowS
showsPrec :: StatusCode -> Choice -> ShowS
$cshow :: Choice -> [Char]
show :: Choice -> [Char]
$cshowList :: [Choice] -> ShowS
showList :: [Choice] -> ShowS
Show)

instance FromJSON Choice where
    parseJSON :: Value -> Parser Choice
parseJSON = [Char] -> (Object -> Parser Choice) -> Value -> Parser Choice
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Choice" ((Object -> Parser Choice) -> Value -> Parser Choice)
-> (Object -> Parser Choice) -> Value -> Parser Choice
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
        Object
deltaOrMessage <- (Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message") Parser Object -> Parser Object -> Parser Object
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delta")
        Text
content <- Object
deltaOrMessage Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"content"
        Choice -> Parser Choice
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Choice { $sel:text:Choice :: Text
text = Text
content }


streamCompletion :: ByteString -> CompletionRequest -> IO () -> (CompletionChunk -> IO ()) -> IO [CompletionChunk]
streamCompletion :: URL
-> CompletionRequest
-> IO ()
-> (CompletionChunk -> IO ())
-> IO [CompletionChunk]
streamCompletion URL
secretKey CompletionRequest
completionRequest' IO ()
onStart CompletionChunk -> IO ()
callback = do
        let completionRequest :: CompletionRequest
completionRequest = CompletionRequest -> CompletionRequest
enableStream CompletionRequest
completionRequest'
        IORef CompletionRequest
completionRequestRef <- CompletionRequest -> IO (IORef CompletionRequest)
forall a. a -> IO (IORef a)
newIORef CompletionRequest
completionRequest
        Either SomeException (Either Text [CompletionChunk])
result <- RetryPolicyM IO
-> (RetryStatus
    -> Either SomeException (Either Text [CompletionChunk]) -> IO Bool)
-> (RetryStatus
    -> IO (Either SomeException (Either Text [CompletionChunk])))
-> IO (Either SomeException (Either Text [CompletionChunk]))
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
Retry.retrying RetryPolicyM IO
retryPolicyDefault RetryStatus
-> Either SomeException (Either Text [CompletionChunk]) -> IO Bool
forall {f :: * -> *} {p} {a} {a} {b}.
Applicative f =>
p -> Either a (Either a b) -> f Bool
shouldRetry (IORef CompletionRequest
-> RetryStatus
-> IO (Either SomeException (Either Text [CompletionChunk]))
forall {e} {a} {p}.
(Exception e, Eq a, HasField "rsIterNumber" p a, Num a) =>
IORef CompletionRequest
-> p -> IO (Either e (Either Text [CompletionChunk]))
action IORef CompletionRequest
completionRequestRef)
        case Either SomeException (Either Text [CompletionChunk])
result of
            Left (SomeException
e :: SomeException) -> SomeException -> IO [CompletionChunk]
forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
e
            Right (Left Text
e) -> [Char] -> IO [CompletionChunk]
forall a. HasCallStack => [Char] -> a
error (Text -> [Char]
Text.unpack Text
e)
            Right (Right [CompletionChunk]
r) -> [CompletionChunk] -> IO [CompletionChunk]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [CompletionChunk]
r
    where
        shouldRetry :: p -> Either a (Either a b) -> f Bool
shouldRetry p
retryStatus (Left a
e) = Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        shouldRetry p
retryStatus (Right (Left a
_)) = Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        shouldRetry p
retryStatus (Right (Right b
r)) = Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        action :: IORef CompletionRequest
-> p -> IO (Either e (Either Text [CompletionChunk]))
action IORef CompletionRequest
completionRequestRef p
retryStatus = do
            CompletionRequest
completionRequest <- IORef CompletionRequest -> IO CompletionRequest
forall a. IORef a -> IO a
readIORef IORef CompletionRequest
completionRequestRef
            let onStart' :: IO ()
onStart' = if p
retryStatus.rsIterNumber a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then IO ()
onStart else () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            IO (Either Text [CompletionChunk])
-> IO (Either e (Either Text [CompletionChunk]))
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (URL
-> CompletionRequest
-> IO ()
-> (CompletionChunk -> IO ())
-> IO (Either Text [CompletionChunk])
streamCompletionWithoutRetry URL
secretKey CompletionRequest
completionRequest IO ()
onStart' (IORef CompletionRequest -> CompletionChunk -> IO ()
wrappedCallback IORef CompletionRequest
completionRequestRef))

        wrappedCallback :: IORef CompletionRequest -> CompletionChunk -> IO ()
wrappedCallback IORef CompletionRequest
completionRequestRef CompletionChunk
completionChunk = do
            let text :: Text
text = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (CompletionChunkChoice -> Maybe Text)
-> [CompletionChunkChoice] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (\CompletionChunkChoice
choiceDelta -> CompletionChunkChoice
choiceDelta.delta.content) CompletionChunk
completionChunk.choices
            IORef CompletionRequest
-> (CompletionRequest -> CompletionRequest) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef CompletionRequest
completionRequestRef (\CompletionRequest
completionRequest -> CompletionRequest
completionRequest
                    { messages = completionRequest.messages <> [assistantMessage text]
                    , maxTokens = case completionRequest.maxTokens of
                        Just StatusCode
maxTokens -> StatusCode -> Maybe StatusCode
forall a. a -> Maybe a
Just (StatusCode -> Maybe StatusCode) -> StatusCode -> Maybe StatusCode
forall a b. (a -> b) -> a -> b
$ StatusCode
maxTokens StatusCode -> StatusCode -> StatusCode
forall a. Num a => a -> a -> a
- ([Text] -> StatusCode
forall a. [a] -> StatusCode
forall (t :: * -> *) a. Foldable t => t a -> StatusCode
length (Text -> [Text]
Text.words Text
text))
                        Maybe StatusCode
Nothing -> Maybe StatusCode
forall a. Maybe a
Nothing
                    }
                )
            CompletionChunk -> IO ()
callback CompletionChunk
completionChunk

        retryPolicyDefault :: RetryPolicyM IO
retryPolicyDefault = StatusCode -> RetryPolicyM IO
forall (m :: * -> *). Monad m => StatusCode -> RetryPolicyM m
Retry.constantDelay StatusCode
50000 RetryPolicyM IO -> RetryPolicyM IO -> RetryPolicyM IO
forall a. Semigroup a => a -> a -> a
<> StatusCode -> RetryPolicy
Retry.limitRetries StatusCode
10

streamCompletionWithoutRetry :: ByteString -> CompletionRequest -> IO () -> (CompletionChunk -> IO ()) -> IO (Either Text [CompletionChunk])
streamCompletionWithoutRetry :: URL
-> CompletionRequest
-> IO ()
-> (CompletionChunk -> IO ())
-> IO (Either Text [CompletionChunk])
streamCompletionWithoutRetry URL
secretKey CompletionRequest
completionRequest' IO ()
onStart CompletionChunk -> IO ()
callback = do
    let completionRequest :: CompletionRequest
completionRequest = CompletionRequest -> CompletionRequest
enableStream CompletionRequest
completionRequest'
    (SSLContext -> IO SSLContext) -> IO ()
modifyContextSSL (\SSLContext
context -> do
            SSLContext -> VerificationMode -> IO ()
SSL.contextSetVerificationMode SSLContext
context VerificationMode
SSL.VerifyNone
            SSLContext -> IO SSLContext
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLContext
context
        )
    IO (Either Text [CompletionChunk])
-> IO (Either Text [CompletionChunk])
forall a. IO a -> IO a
withOpenSSL do
        IO Connection
-> (Connection -> IO (Either Text [CompletionChunk]))
-> IO (Either Text [CompletionChunk])
forall γ. IO Connection -> (Connection -> IO γ) -> IO γ
withConnection (URL -> IO Connection
establishConnection URL
"https://api.openai.com/v1/chat/completions") \Connection
connection -> do
            let q :: Request
q = RequestBuilder () -> Request
forall α. RequestBuilder α -> Request
buildRequest1 do
                    Method -> URL -> RequestBuilder ()
http Method
POST URL
"/v1/chat/completions"
                    URL -> RequestBuilder ()
setContentType URL
"application/json"
                    URL -> URL -> RequestBuilder ()
Network.Http.Client.setHeader URL
"Authorization" (URL
"Bearer " URL -> URL -> URL
forall a. Semigroup a => a -> a -> a
<> URL
secretKey)
            Connection -> Request -> (OutputStream Builder -> IO ()) -> IO ()
forall α.
Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
sendRequest Connection
connection Request
q (CompletionRequest -> OutputStream Builder -> IO ()
forall a. ToJSON a => a -> OutputStream Builder -> IO ()
jsonBody CompletionRequest
completionRequest)
            IO ()
onStart
            Connection
-> (Response
    -> InputStream URL -> IO (Either Text [CompletionChunk]))
-> IO (Either Text [CompletionChunk])
forall β.
Connection -> (Response -> InputStream URL -> IO β) -> IO β
receiveResponse Connection
connection Response -> InputStream URL -> IO (Either Text [CompletionChunk])
handler

    where
        handler :: Response -> Streams.InputStream ByteString -> IO (Either Text [CompletionChunk])
        handler :: Response -> InputStream URL -> IO (Either Text [CompletionChunk])
handler Response
response InputStream URL
stream = do
            let status :: StatusCode
status = Response -> StatusCode
getStatusCode Response
response
            if StatusCode
status StatusCode -> StatusCode -> Bool
forall a. Eq a => a -> a -> Bool
== StatusCode
200
                then do
                    {-
                    parse stream line by line as event stream format according to API spec:
                    https://platform.openai.com/docs/api-reference/chat/create#chat/create-stream
                    https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events/Using_server-sent_events#event_stream_format
                    -}
                    ParserState
state <- InputStream URL -> IO (InputStream URL)
Streams.lines InputStream URL
stream IO (InputStream URL)
-> (InputStream URL -> IO ParserState) -> IO ParserState
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParserState -> URL -> IO ParserState)
-> ParserState -> InputStream URL -> IO ParserState
forall s a. (s -> a -> IO s) -> s -> InputStream a -> IO s
Streams.foldM ((CompletionChunk -> IO ()) -> ParserState -> URL -> IO ParserState
parseResponseChunk' CompletionChunk -> IO ()
callback) ParserState
emptyParserState
                    Either Text [CompletionChunk] -> IO (Either Text [CompletionChunk])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompletionChunk] -> Either Text [CompletionChunk]
forall a b. b -> Either a b
Right ParserState
state.chunks)
                else do
                    URL
x :: ByteString <- (URL -> URL -> URL) -> URL -> InputStream URL -> IO URL
forall s a. (s -> a -> s) -> s -> InputStream a -> IO s
Streams.fold URL -> URL -> URL
forall a. Monoid a => a -> a -> a
mappend URL
forall a. Monoid a => a
mempty InputStream URL
stream
                    Either Text [CompletionChunk] -> IO (Either Text [CompletionChunk])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text [CompletionChunk]
forall a b. a -> Either a b
Left (Text -> Either Text [CompletionChunk])
-> Text -> Either Text [CompletionChunk]
forall a b. (a -> b) -> a -> b
$ Text
"an error happend: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (URL -> [Char]
forall a. Show a => a -> [Char]
show URL
x))


        parseResponseChunk' :: (CompletionChunk -> IO ()) -> ParserState -> ByteString -> IO ParserState
        parseResponseChunk' :: (CompletionChunk -> IO ()) -> ParserState -> URL -> IO ParserState
parseResponseChunk' CompletionChunk -> IO ()
callback ParserState
state URL
input =
            case ParserState -> URL -> ParserResult
parseResponseChunk ParserState
state URL
input of
                ParserResult { $sel:chunk:ParserResult :: ParserResult -> Maybe CompletionChunk
chunk = Just CompletionChunk
chunk, ParserState
state :: ParserState
$sel:state:ParserResult :: ParserResult -> ParserState
state } -> do
                    CompletionChunk -> IO ()
callback CompletionChunk
chunk
                    ParserState -> IO ParserState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParserState
state
                ParserResult { ParserState
$sel:state:ParserResult :: ParserResult -> ParserState
state :: ParserState
state } -> ParserState -> IO ParserState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParserState
state

data ParserState = ParserState
    { ParserState -> URL
curBuffer :: !ByteString
    , ParserState -> Bool
emptyLineFound :: !Bool
    , ParserState -> [CompletionChunk]
chunks :: ![CompletionChunk]
    } deriving (ParserState -> ParserState -> Bool
(ParserState -> ParserState -> Bool)
-> (ParserState -> ParserState -> Bool) -> Eq ParserState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParserState -> ParserState -> Bool
== :: ParserState -> ParserState -> Bool
$c/= :: ParserState -> ParserState -> Bool
/= :: ParserState -> ParserState -> Bool
Eq, StatusCode -> ParserState -> ShowS
[ParserState] -> ShowS
ParserState -> [Char]
(StatusCode -> ParserState -> ShowS)
-> (ParserState -> [Char])
-> ([ParserState] -> ShowS)
-> Show ParserState
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> ParserState -> ShowS
showsPrec :: StatusCode -> ParserState -> ShowS
$cshow :: ParserState -> [Char]
show :: ParserState -> [Char]
$cshowList :: [ParserState] -> ShowS
showList :: [ParserState] -> ShowS
Show)
data ParserResult = ParserResult
    { ParserResult -> Maybe CompletionChunk
chunk :: !(Maybe CompletionChunk)
    , ParserResult -> ParserState
state :: ParserState
    } deriving (ParserResult -> ParserResult -> Bool
(ParserResult -> ParserResult -> Bool)
-> (ParserResult -> ParserResult -> Bool) -> Eq ParserResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParserResult -> ParserResult -> Bool
== :: ParserResult -> ParserResult -> Bool
$c/= :: ParserResult -> ParserResult -> Bool
/= :: ParserResult -> ParserResult -> Bool
Eq, StatusCode -> ParserResult -> ShowS
[ParserResult] -> ShowS
ParserResult -> [Char]
(StatusCode -> ParserResult -> ShowS)
-> (ParserResult -> [Char])
-> ([ParserResult] -> ShowS)
-> Show ParserResult
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> ParserResult -> ShowS
showsPrec :: StatusCode -> ParserResult -> ShowS
$cshow :: ParserResult -> [Char]
show :: ParserResult -> [Char]
$cshowList :: [ParserResult] -> ShowS
showList :: [ParserResult] -> ShowS
Show)
emptyParserState :: ParserState
emptyParserState :: ParserState
emptyParserState = ParserState { $sel:curBuffer:ParserState :: URL
curBuffer = URL
"", $sel:emptyLineFound:ParserState :: Bool
emptyLineFound = Bool
False, $sel:chunks:ParserState :: [CompletionChunk]
chunks = [] }

parseResponseChunk :: ParserState -> ByteString -> ParserResult
parseResponseChunk :: ParserState -> URL -> ParserResult
parseResponseChunk ParserState { URL
$sel:curBuffer:ParserState :: ParserState -> URL
curBuffer :: URL
curBuffer, Bool
$sel:emptyLineFound:ParserState :: ParserState -> Bool
emptyLineFound :: Bool
emptyLineFound, [CompletionChunk]
$sel:chunks:ParserState :: ParserState -> [CompletionChunk]
chunks :: [CompletionChunk]
chunks } URL
input
    -- input line is empty, but previous was not, append newline to buffer
    | URL -> Bool
ByteString.null URL
input Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
emptyLineFound = ParserResult { $sel:chunk:ParserResult :: Maybe CompletionChunk
chunk = Maybe CompletionChunk
forall a. Maybe a
Nothing, $sel:state:ParserResult :: ParserState
state = ParserState { $sel:curBuffer:ParserState :: URL
curBuffer = URL
curBuffer URL -> URL -> URL
forall a. Semigroup a => a -> a -> a
<> URL
"\n", $sel:emptyLineFound:ParserState :: Bool
emptyLineFound = Bool
True, [CompletionChunk]
$sel:chunks:ParserState :: [CompletionChunk]
chunks :: [CompletionChunk]
chunks } }
    -- input line is empty, previous line was already empty: message ended, clear buffer
    | URL -> Bool
ByteString.null URL
input Bool -> Bool -> Bool
&& Bool
emptyLineFound = ParserResult { $sel:chunk:ParserResult :: Maybe CompletionChunk
chunk = Maybe CompletionChunk
forall a. Maybe a
Nothing, $sel:state:ParserResult :: ParserState
state = ParserState { $sel:curBuffer:ParserState :: URL
curBuffer = URL
"", $sel:emptyLineFound:ParserState :: Bool
emptyLineFound = Bool
True, [CompletionChunk]
$sel:chunks:ParserState :: [CompletionChunk]
chunks :: [CompletionChunk]
chunks } }
    -- lines starting with : are comments, ignore
    | URL
":" URL -> URL -> Bool
`ByteString.isPrefixOf` URL
input = ParserResult { $sel:chunk:ParserResult :: Maybe CompletionChunk
chunk = Maybe CompletionChunk
forall a. Maybe a
Nothing, $sel:state:ParserResult :: ParserState
state = ParserState { $sel:curBuffer:ParserState :: URL
curBuffer = URL
curBuffer, $sel:emptyLineFound:ParserState :: Bool
emptyLineFound = Bool
False, [CompletionChunk]
$sel:chunks:ParserState :: [CompletionChunk]
chunks :: [CompletionChunk]
chunks } }
    -- try to parse line together with buffer otherwise
    | Bool
otherwise = case URL -> URL -> Maybe URL
ByteString.stripPrefix URL
"data: " (URL -> URL
ByteString.strip (URL
curBuffer URL -> URL -> URL
forall a. Semigroup a => a -> a -> a
<> URL
input)) of
            -- the stream terminated by a data: [DONE] message
            Just URL
"[DONE]" ->
                ParserResult { $sel:chunk:ParserResult :: Maybe CompletionChunk
chunk = Maybe CompletionChunk
forall a. Maybe a
Nothing, $sel:state:ParserResult :: ParserState
state = ParserState { URL
$sel:curBuffer:ParserState :: URL
curBuffer :: URL
curBuffer, Bool
$sel:emptyLineFound:ParserState :: Bool
emptyLineFound :: Bool
emptyLineFound, [CompletionChunk]
$sel:chunks:ParserState :: [CompletionChunk]
chunks :: [CompletionChunk]
chunks } }
            Just URL
json ->
                case URL -> Either [Char] CompletionChunk
forall a. FromJSON a => URL -> Either [Char] a
eitherDecodeStrict URL
json of
                    Right (CompletionChunk
completionChunk :: CompletionChunk) ->
                        ParserResult
                            { $sel:chunk:ParserResult :: Maybe CompletionChunk
chunk = CompletionChunk -> Maybe CompletionChunk
forall a. a -> Maybe a
Just CompletionChunk
completionChunk
                            , $sel:state:ParserResult :: ParserState
state = ParserState { $sel:curBuffer:ParserState :: URL
curBuffer = URL
"", $sel:emptyLineFound:ParserState :: Bool
emptyLineFound = Bool
False, $sel:chunks:ParserState :: [CompletionChunk]
chunks = [CompletionChunk]
chunks [CompletionChunk] -> [CompletionChunk] -> [CompletionChunk]
forall a. Semigroup a => a -> a -> a
<> [CompletionChunk
completionChunk] }
                            }
                    Left [Char]
err -> [Char] -> ParserResult
forall a. HasCallStack => [Char] -> a
error (ShowS
forall a. Show a => a -> [Char]
show [Char]
err [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" while parsing " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> URL -> [Char]
forall a. Show a => a -> [Char]
show URL
input)
                        --ParserResult
                        --    { chunk = Nothing
                        --    , state = ParserState { curBuffer = curBuffer <> json, emptyLineFound = False, chunks = chunks } }
            Maybe URL
Nothing ->
                ParserResult
                    { $sel:chunk:ParserResult :: Maybe CompletionChunk
chunk = Maybe CompletionChunk
forall a. Maybe a
Nothing
                    , $sel:state:ParserResult :: ParserState
state = ParserState { $sel:curBuffer:ParserState :: URL
curBuffer = URL
curBuffer URL -> URL -> URL
forall a. Semigroup a => a -> a -> a
<> URL
input, $sel:emptyLineFound:ParserState :: Bool
emptyLineFound = Bool
False, $sel:chunks:ParserState :: [CompletionChunk]
chunks = [CompletionChunk]
chunks } }


fetchCompletion :: ByteString -> CompletionRequest -> IO Text
fetchCompletion :: URL -> CompletionRequest -> IO Text
fetchCompletion URL
secretKey CompletionRequest
completionRequest = do
        Either SomeException CompletionResult
result <- RetryPolicyM IO
-> (RetryStatus
    -> Either SomeException CompletionResult -> IO Bool)
-> (RetryStatus -> IO (Either SomeException CompletionResult))
-> IO (Either SomeException CompletionResult)
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
Retry.retrying RetryPolicyM IO
retryPolicyDefault RetryStatus -> Either SomeException CompletionResult -> IO Bool
forall {f :: * -> *} {p} {a} {b}.
Applicative f =>
p -> Either a b -> f Bool
shouldRetry RetryStatus -> IO (Either SomeException CompletionResult)
forall {e} {p}. Exception e => p -> IO (Either e CompletionResult)
action
        case Either SomeException CompletionResult
result of
            Left (SomeException
e :: SomeException) -> SomeException -> IO Text
forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
e
            Right CompletionResult
result ->
                case CompletionResult
result of
                    CompletionResult { [Choice]
$sel:choices:CompletionResult :: CompletionResult -> [Choice]
choices :: [Choice]
choices } -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Choice -> Text) -> [Choice] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (.text) [Choice]
choices)
                    CompletionError { Text
$sel:message:CompletionResult :: CompletionResult -> Text
message :: Text
message } -> [Char] -> IO Text
forall a. HasCallStack => [Char] -> a
error (Text -> [Char]
Text.unpack Text
message)
    where
        shouldRetry :: p -> Either a b -> f Bool
shouldRetry p
retryStatus (Left a
_) = Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        shouldRetry p
retryStatus (Right b
_) = Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        action :: p -> IO (Either e CompletionResult)
action p
retryStatus = IO CompletionResult -> IO (Either e CompletionResult)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (URL -> CompletionRequest -> IO CompletionResult
fetchCompletionWithoutRetry URL
secretKey CompletionRequest
completionRequest)

        retryPolicyDefault :: RetryPolicyM IO
retryPolicyDefault = StatusCode -> RetryPolicyM IO
forall (m :: * -> *). Monad m => StatusCode -> RetryPolicyM m
Retry.constantDelay StatusCode
50000 RetryPolicyM IO -> RetryPolicyM IO -> RetryPolicyM IO
forall a. Semigroup a => a -> a -> a
<> StatusCode -> RetryPolicy
Retry.limitRetries StatusCode
10

fetchCompletionWithoutRetry :: ByteString -> CompletionRequest -> IO CompletionResult
fetchCompletionWithoutRetry :: URL -> CompletionRequest -> IO CompletionResult
fetchCompletionWithoutRetry URL
secretKey CompletionRequest
completionRequest = do
        (SSLContext -> IO SSLContext) -> IO ()
modifyContextSSL (\SSLContext
context -> do
                SSLContext -> VerificationMode -> IO ()
SSL.contextSetVerificationMode SSLContext
context VerificationMode
SSL.VerifyNone
                SSLContext -> IO SSLContext
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSLContext
context
            )
        IO CompletionResult -> IO CompletionResult
forall a. IO a -> IO a
withOpenSSL do
            IO Connection
-> (Connection -> IO CompletionResult) -> IO CompletionResult
forall γ. IO Connection -> (Connection -> IO γ) -> IO γ
withConnection (URL -> IO Connection
establishConnection URL
"https://api.openai.com/v1/chat/completions") \Connection
connection -> do
                    let q :: Request
q = RequestBuilder () -> Request
forall α. RequestBuilder α -> Request
buildRequest1 do
                                Method -> URL -> RequestBuilder ()
http Method
POST URL
"/v1/chat/completions"
                                URL -> RequestBuilder ()
setContentType URL
"application/json"
                                URL -> URL -> RequestBuilder ()
Network.Http.Client.setHeader URL
"Authorization" (URL
"Bearer " URL -> URL -> URL
forall a. Semigroup a => a -> a -> a
<> URL
secretKey)

                    Connection -> Request -> (OutputStream Builder -> IO ()) -> IO ()
forall α.
Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
sendRequest Connection
connection Request
q (CompletionRequest -> OutputStream Builder -> IO ()
forall a. ToJSON a => a -> OutputStream Builder -> IO ()
jsonBody CompletionRequest
completionRequest)
                    Connection
-> (Response -> InputStream URL -> IO CompletionResult)
-> IO CompletionResult
forall β.
Connection -> (Response -> InputStream URL -> IO β) -> IO β
receiveResponse Connection
connection Response -> InputStream URL -> IO CompletionResult
forall α. FromJSON α => Response -> InputStream URL -> IO α
jsonHandler

enableStream :: CompletionRequest -> CompletionRequest
enableStream :: CompletionRequest -> CompletionRequest
enableStream CompletionRequest
completionRequest = CompletionRequest
completionRequest { stream = True }

data CompletionChunk = CompletionChunk
    { CompletionChunk -> Text
id :: !Text
    , CompletionChunk -> [CompletionChunkChoice]
choices :: [CompletionChunkChoice]
    , CompletionChunk -> StatusCode
created :: Int
    , CompletionChunk -> Text
model :: !Text
    , CompletionChunk -> Maybe Text
systemFingerprint :: !(Maybe Text)
    } deriving (CompletionChunk -> CompletionChunk -> Bool
(CompletionChunk -> CompletionChunk -> Bool)
-> (CompletionChunk -> CompletionChunk -> Bool)
-> Eq CompletionChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionChunk -> CompletionChunk -> Bool
== :: CompletionChunk -> CompletionChunk -> Bool
$c/= :: CompletionChunk -> CompletionChunk -> Bool
/= :: CompletionChunk -> CompletionChunk -> Bool
Eq, StatusCode -> CompletionChunk -> ShowS
[CompletionChunk] -> ShowS
CompletionChunk -> [Char]
(StatusCode -> CompletionChunk -> ShowS)
-> (CompletionChunk -> [Char])
-> ([CompletionChunk] -> ShowS)
-> Show CompletionChunk
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> CompletionChunk -> ShowS
showsPrec :: StatusCode -> CompletionChunk -> ShowS
$cshow :: CompletionChunk -> [Char]
show :: CompletionChunk -> [Char]
$cshowList :: [CompletionChunk] -> ShowS
showList :: [CompletionChunk] -> ShowS
Show)

instance FromJSON CompletionChunk where
    parseJSON :: Value -> Parser CompletionChunk
parseJSON = [Char]
-> (Object -> Parser CompletionChunk)
-> Value
-> Parser CompletionChunk
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"CompletionChunk" ((Object -> Parser CompletionChunk)
 -> Value -> Parser CompletionChunk)
-> (Object -> Parser CompletionChunk)
-> Value
-> Parser CompletionChunk
forall a b. (a -> b) -> a -> b
$ \Object
v -> Text
-> [CompletionChunkChoice]
-> StatusCode
-> Text
-> Maybe Text
-> CompletionChunk
CompletionChunk
        (Text
 -> [CompletionChunkChoice]
 -> StatusCode
 -> Text
 -> Maybe Text
 -> CompletionChunk)
-> Parser Text
-> Parser
     ([CompletionChunkChoice]
      -> StatusCode -> Text -> Maybe Text -> CompletionChunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        Parser
  ([CompletionChunkChoice]
   -> StatusCode -> Text -> Maybe Text -> CompletionChunk)
-> Parser [CompletionChunkChoice]
-> Parser (StatusCode -> Text -> Maybe Text -> CompletionChunk)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [CompletionChunkChoice]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"choices"
        Parser (StatusCode -> Text -> Maybe Text -> CompletionChunk)
-> Parser StatusCode
-> Parser (Text -> Maybe Text -> CompletionChunk)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser StatusCode
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
        Parser (Text -> Maybe Text -> CompletionChunk)
-> Parser Text -> Parser (Maybe Text -> CompletionChunk)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"model"
        Parser (Maybe Text -> CompletionChunk)
-> Parser (Maybe Text) -> Parser CompletionChunk
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"system_fingerprint"

data CompletionChunkChoice
     = CompletionChunkChoice { CompletionChunkChoice -> Delta
delta :: !Delta }
     deriving (CompletionChunkChoice -> CompletionChunkChoice -> Bool
(CompletionChunkChoice -> CompletionChunkChoice -> Bool)
-> (CompletionChunkChoice -> CompletionChunkChoice -> Bool)
-> Eq CompletionChunkChoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionChunkChoice -> CompletionChunkChoice -> Bool
== :: CompletionChunkChoice -> CompletionChunkChoice -> Bool
$c/= :: CompletionChunkChoice -> CompletionChunkChoice -> Bool
/= :: CompletionChunkChoice -> CompletionChunkChoice -> Bool
Eq, StatusCode -> CompletionChunkChoice -> ShowS
[CompletionChunkChoice] -> ShowS
CompletionChunkChoice -> [Char]
(StatusCode -> CompletionChunkChoice -> ShowS)
-> (CompletionChunkChoice -> [Char])
-> ([CompletionChunkChoice] -> ShowS)
-> Show CompletionChunkChoice
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> CompletionChunkChoice -> ShowS
showsPrec :: StatusCode -> CompletionChunkChoice -> ShowS
$cshow :: CompletionChunkChoice -> [Char]
show :: CompletionChunkChoice -> [Char]
$cshowList :: [CompletionChunkChoice] -> ShowS
showList :: [CompletionChunkChoice] -> ShowS
Show)

instance FromJSON CompletionChunkChoice where
    parseJSON :: Value -> Parser CompletionChunkChoice
parseJSON = [Char]
-> (Object -> Parser CompletionChunkChoice)
-> Value
-> Parser CompletionChunkChoice
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"CompletionChunkChoice" ((Object -> Parser CompletionChunkChoice)
 -> Value -> Parser CompletionChunkChoice)
-> (Object -> Parser CompletionChunkChoice)
-> Value
-> Parser CompletionChunkChoice
forall a b. (a -> b) -> a -> b
$ \Object
v -> Delta -> CompletionChunkChoice
CompletionChunkChoice
        (Delta -> CompletionChunkChoice)
-> Parser Delta -> Parser CompletionChunkChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Delta
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delta"

data Delta
     = Delta
     { Delta -> Maybe Text
content :: !(Maybe Text)
     , Delta -> Maybe [ToolCall]
toolCalls :: !(Maybe [ToolCall])
     , Delta -> Maybe Role
role :: !(Maybe Role)
     } deriving (Delta -> Delta -> Bool
(Delta -> Delta -> Bool) -> (Delta -> Delta -> Bool) -> Eq Delta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Delta -> Delta -> Bool
== :: Delta -> Delta -> Bool
$c/= :: Delta -> Delta -> Bool
/= :: Delta -> Delta -> Bool
Eq, StatusCode -> Delta -> ShowS
[Delta] -> ShowS
Delta -> [Char]
(StatusCode -> Delta -> ShowS)
-> (Delta -> [Char]) -> ([Delta] -> ShowS) -> Show Delta
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> Delta -> ShowS
showsPrec :: StatusCode -> Delta -> ShowS
$cshow :: Delta -> [Char]
show :: Delta -> [Char]
$cshowList :: [Delta] -> ShowS
showList :: [Delta] -> ShowS
Show)

instance FromJSON Delta where
    parseJSON :: Value -> Parser Delta
parseJSON = [Char] -> (Object -> Parser Delta) -> Value -> Parser Delta
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Delta" ((Object -> Parser Delta) -> Value -> Parser Delta)
-> (Object -> Parser Delta) -> Value -> Parser Delta
forall a b. (a -> b) -> a -> b
$ \Object
v -> Maybe Text -> Maybe [ToolCall] -> Maybe Role -> Delta
Delta
        (Maybe Text -> Maybe [ToolCall] -> Maybe Role -> Delta)
-> Parser (Maybe Text)
-> Parser (Maybe [ToolCall] -> Maybe Role -> Delta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content"
        Parser (Maybe [ToolCall] -> Maybe Role -> Delta)
-> Parser (Maybe [ToolCall]) -> Parser (Maybe Role -> Delta)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [ToolCall])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tool_calls"
        Parser (Maybe Role -> Delta) -> Parser (Maybe Role) -> Parser Delta
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Role)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"role"

instance FromJSON Role where
    parseJSON :: Value -> Parser Role
parseJSON (String Text
"user") = Role -> Parser Role
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
UserRole
    parseJSON (String Text
"system") = Role -> Parser Role
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
SystemRole
    parseJSON (String Text
"assistant") = Role -> Parser Role
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
AssistantRole
    parseJSON (String Text
"ToolRole") = Role -> Parser Role
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
ToolRole
    parseJSON Value
otherwise = [Char] -> Parser Role
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Failed to parse role" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> [Char]
forall a. Show a => a -> [Char]
show Value
otherwise)

data ToolCall
    = FunctionCall
    { ToolCall -> StatusCode
index :: !Int
    , ToolCall -> Maybe Text
id :: !(Maybe Text)
    , ToolCall -> Maybe Text
name :: !(Maybe Text)
    , ToolCall -> Text
arguments :: !Text
    } deriving (ToolCall -> ToolCall -> Bool
(ToolCall -> ToolCall -> Bool)
-> (ToolCall -> ToolCall -> Bool) -> Eq ToolCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToolCall -> ToolCall -> Bool
== :: ToolCall -> ToolCall -> Bool
$c/= :: ToolCall -> ToolCall -> Bool
/= :: ToolCall -> ToolCall -> Bool
Eq, StatusCode -> ToolCall -> ShowS
[ToolCall] -> ShowS
ToolCall -> [Char]
(StatusCode -> ToolCall -> ShowS)
-> (ToolCall -> [Char]) -> ([ToolCall] -> ShowS) -> Show ToolCall
forall a.
(StatusCode -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StatusCode -> ToolCall -> ShowS
showsPrec :: StatusCode -> ToolCall -> ShowS
$cshow :: ToolCall -> [Char]
show :: ToolCall -> [Char]
$cshowList :: [ToolCall] -> ShowS
showList :: [ToolCall] -> ShowS
Show)

instance FromJSON ToolCall where
    parseJSON :: Value -> Parser ToolCall
parseJSON = [Char] -> (Object -> Parser ToolCall) -> Value -> Parser ToolCall
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"ToolCall" ((Object -> Parser ToolCall) -> Value -> Parser ToolCall)
-> (Object -> Parser ToolCall) -> Value -> Parser ToolCall
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
        StatusCode
index <- Object
v Object -> Key -> Parser StatusCode
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
        Maybe Text
id <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"

        Object
function <- Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"function"
        Maybe Text
name <- Object
function Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
        Text
arguments <- Object
function Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"arguments"

        ToolCall -> Parser ToolCall
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunctionCall { StatusCode
$sel:index:FunctionCall :: StatusCode
index :: StatusCode
index, Maybe Text
$sel:id:FunctionCall :: Maybe Text
id :: Maybe Text
id, Maybe Text
$sel:name:FunctionCall :: Maybe Text
name :: Maybe Text
name, Text
$sel:arguments:FunctionCall :: Text
arguments :: Text
arguments }

instance ToJSON ToolCall where
    toJSON :: ToolCall -> Value
toJSON FunctionCall { StatusCode
$sel:index:FunctionCall :: ToolCall -> StatusCode
index :: StatusCode
index, Maybe Text
$sel:id:FunctionCall :: ToolCall -> Maybe Text
id :: Maybe Text
id, Maybe Text
$sel:name:FunctionCall :: ToolCall -> Maybe Text
name :: Maybe Text
name, Text
$sel:arguments:FunctionCall :: ToolCall -> Text
arguments :: Text
arguments } =
        [Pair] -> Value
object
            [ Key
"index" Key -> StatusCode -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StatusCode
index
            , Key
"id" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
id
            , Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"function" :: Text)
            , Key
"function" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ Key
"name" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
name, Key
"arguments" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
arguments ]
            ]

-- [{"text": "Introdu", "index": 0, "logprobs": null, "finish_reason": null}]


emptyListToNothing :: [value] -> Maybe [value]
emptyListToNothing :: forall value. [value] -> Maybe [value]
emptyListToNothing [] = Maybe [value]
forall a. Maybe a
Nothing
emptyListToNothing [value]
values = [value] -> Maybe [value]
forall a. a -> Maybe a
Just [value]
values