{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}

module OpenAI.Types (
  AssistantFileObject (..),
  AssistantObject (..),
  AssistantObjectToolsInner (..),
  AssistantToolsCode (..),
  AssistantToolsFunction (..),
  AssistantToolsRetrieval (..),
  ChatCompletionFunctionCallOption (..),
  ChatCompletionFunctions (..),
  ChatCompletionMessageToolCall (..),
  ChatCompletionMessageToolCallChunk (..),
  ChatCompletionMessageToolCallChunkFunction (..),
  ChatCompletionMessageToolCallFunction (..),
  ChatCompletionNamedToolChoice (..),
  ChatCompletionNamedToolChoiceFunction (..),
  ChatCompletionRequestAssistantMessage (..),
  ChatCompletionRequestAssistantMessageFunctionCall (..),
  ChatCompletionRequestFunctionMessage (..),
  ChatCompletionRequestMessage (..),
  ChatCompletionRequestMessageContent (..),
  ChatCompletionRequestMessageContentPart (..),
  ChatCompletionRequestMessageContentPartImage (..),
  ChatCompletionRequestMessageContentPartImageImageUrl (..),
  ChatCompletionRequestMessageContentPartText (..),
  ChatCompletionRequestSystemMessage (..),
  ChatCompletionRequestToolMessage (..),
  ChatCompletionRequestUserMessage (..),
  ChatCompletionRequestUserMessageContent (..),
  ChatCompletionResponseMessage (..),
  ChatCompletionRole (..),
  ChatCompletionStreamResponseDelta (..),
  ChatCompletionStreamResponseDeltaFunctionCall (..),
  ChatCompletionTokenLogprob (..),
  ChatCompletionTokenLogprobTopLogprobsInner (..),
  ChatCompletionTool (..),
  ChatCompletionToolChoiceOption (..),
  CompletionUsage (..),
  CreateAssistantFileRequest (..),
  CreateAssistantRequest (..),
  CreateAssistantRequestModel (..),
  CreateChatCompletionFunctionResponse (..),
  CreateChatCompletionFunctionResponseChoicesInner (..),
  CreateChatCompletionRequest (..),
  CreateChatCompletionRequestFunctionCall (..),
  CreateChatCompletionRequestModel (..),
  CreateChatCompletionRequestResponseFormat (..),
  CreateChatCompletionRequestStop (..),
  CreateChatCompletionResponse (..),
  CreateChatCompletionResponseChoicesInner (..),
  CreateChatCompletionResponseChoicesInnerLogprobs (..),
  CreateChatCompletionStreamResponse (..),
  CreateChatCompletionStreamResponseChoicesInner (..),
  CreateCompletionRequest (..),
  CreateCompletionRequestModel (..),
  CreateCompletionRequestPrompt (..),
  CreateCompletionRequestStop (..),
  CreateCompletionResponse (..),
  CreateCompletionResponseChoicesInner (..),
  CreateCompletionResponseChoicesInnerLogprobs (..),
  CreateEmbeddingRequest (..),
  CreateEmbeddingRequestInput (..),
  CreateEmbeddingRequestModel (..),
  CreateEmbeddingResponse (..),
  CreateEmbeddingResponseUsage (..),
  CreateFineTuningJobRequest (..),
  CreateFineTuningJobRequestHyperparameters (..),
  CreateFineTuningJobRequestHyperparametersBatchSize (..),
  CreateFineTuningJobRequestHyperparametersLearningRateMultiplier (..),
  CreateFineTuningJobRequestHyperparametersNEpochs (..),
  CreateFineTuningJobRequestModel (..),
  CreateImageRequest (..),
  CreateImageRequestModel (..),
  CreateMessageRequest (..),
  CreateModerationRequest (..),
  CreateModerationRequestInput (..),
  CreateModerationRequestModel (..),
  CreateModerationResponse (..),
  CreateModerationResponseResultsInner (..),
  CreateModerationResponseResultsInnerCategories (..),
  CreateModerationResponseResultsInnerCategoryScores (..),
  CreateRunRequest (..),
  CreateSpeechRequest (..),
  CreateSpeechRequestModel (..),
  CreateThreadAndRunRequest (..),
  CreateThreadAndRunRequestToolsInner (..),
  CreateThreadRequest (..),
  CreateTranscription200Response (..),
  CreateTranscriptionResponseJson (..),
  CreateTranscriptionResponseVerboseJson (..),
  CreateTranslation200Response (..),
  CreateTranslationResponseJson (..),
  CreateTranslationResponseVerboseJson (..),
  DeleteAssistantFileResponse (..),
  DeleteAssistantResponse (..),
  DeleteFileResponse (..),
  DeleteMessageResponse (..),
  DeleteModelResponse (..),
  DeleteThreadResponse (..),
  Embedding (..),
  Error (..),
  ErrorResponse (..),
  FineTuningJob (..),
  FineTuningJobError (..),
  FineTuningJobEvent (..),
  FineTuningJobHyperparameters (..),
  FineTuningJobHyperparametersNEpochs (..),
  FunctionObject (..),
  Image (..),
  ImagesResponse (..),
  ListAssistantFilesResponse (..),
  ListAssistantsResponse (..),
  ListFilesResponse (..),
  ListFineTuningJobEventsResponse (..),
  ListMessageFilesResponse (..),
  ListMessagesResponse (..),
  ListModelsResponse (..),
  ListPaginatedFineTuningJobsResponse (..),
  ListRunStepsResponse (..),
  ListRunsResponse (..),
  ListThreadsResponse (..),
  MessageContentImageFileObject (..),
  MessageContentImageFileObjectImageFile (..),
  MessageContentTextAnnotationsFileCitationObject (..),
  MessageContentTextAnnotationsFileCitationObjectFileCitation (..),
  MessageContentTextAnnotationsFilePathObject (..),
  MessageContentTextAnnotationsFilePathObjectFilePath (..),
  MessageContentTextObject (..),
  MessageContentTextObjectText (..),
  MessageContentTextObjectTextAnnotationsInner (..),
  MessageFileObject (..),
  MessageObject (..),
  MessageObjectContentInner (..),
  Model (..),
  ModifyAssistantRequest (..),
  ModifyMessageRequest (..),
  ModifyRunRequest (..),
  ModifyThreadRequest (..),
  OpenAIFile (..),
  RunCompletionUsage (..),
  RunObject (..),
  RunObjectLastError (..),
  RunObjectRequiredAction (..),
  RunObjectRequiredActionSubmitToolOutputs (..),
  RunStepCompletionUsage (..),
  RunStepDetailsMessageCreationObject (..),
  RunStepDetailsMessageCreationObjectMessageCreation (..),
  RunStepDetailsToolCallsCodeObject (..),
  RunStepDetailsToolCallsCodeObjectCodeInterpreter (..),
  RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner (..),
  RunStepDetailsToolCallsCodeOutputImageObject (..),
  RunStepDetailsToolCallsCodeOutputImageObjectImage (..),
  RunStepDetailsToolCallsCodeOutputLogsObject (..),
  RunStepDetailsToolCallsFunctionObject (..),
  RunStepDetailsToolCallsFunctionObjectFunction (..),
  RunStepDetailsToolCallsObject (..),
  RunStepDetailsToolCallsObjectToolCallsInner (..),
  RunStepDetailsToolCallsRetrievalObject (..),
  RunStepObject (..),
  RunStepObjectLastError (..),
  RunStepObjectStepDetails (..),
  RunToolCallObject (..),
  RunToolCallObjectFunction (..),
  SubmitToolOutputsRunRequest (..),
  SubmitToolOutputsRunRequestToolOutputsInner (..),
  ThreadObject (..),
  TranscriptionSegment (..),
  TranscriptionWord (..),
  ) where

import Data.Data (Data)
import Data.UUID (UUID)
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import Data.Aeson (Value, FromJSON(..), ToJSON(..), genericToJSON, genericParseJSON)
import Data.Aeson.Types (Options(..), defaultOptions)
import qualified Data.Aeson as Aeson
import Data.Set (Set)
import Data.Text (Text)
import qualified Data.Vector as V
import Data.Time
import Data.Swagger (ToSchema, declareNamedSchema)
import qualified Data.Swagger as Swagger
import qualified Data.Char as Char
import qualified Data.Text as T
import qualified Data.Map as Map
import GHC.Generics (Generic)
import Data.Function ((&))


-- | A list of [Files](/docs/api-reference/files) attached to an `assistant`.
data AssistantFileObject = AssistantFileObject
  { AssistantFileObject -> Text
assistantFileObjectId :: Text -- ^ The identifier, which can be referenced in API endpoints.
  , AssistantFileObject -> Text
assistantFileObjectObject :: Text -- ^ The object type, which is always `assistant.file`.
  , AssistantFileObject -> Int
assistantFileObjectCreatedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the assistant file was created.
  , AssistantFileObject -> Text
assistantFileObjectAssistantUnderscoreid :: Text -- ^ The assistant ID that the file is attached to.
  } deriving (Int -> AssistantFileObject -> ShowS
[AssistantFileObject] -> ShowS
AssistantFileObject -> String
(Int -> AssistantFileObject -> ShowS)
-> (AssistantFileObject -> String)
-> ([AssistantFileObject] -> ShowS)
-> Show AssistantFileObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssistantFileObject -> ShowS
showsPrec :: Int -> AssistantFileObject -> ShowS
$cshow :: AssistantFileObject -> String
show :: AssistantFileObject -> String
$cshowList :: [AssistantFileObject] -> ShowS
showList :: [AssistantFileObject] -> ShowS
Show, AssistantFileObject -> AssistantFileObject -> Bool
(AssistantFileObject -> AssistantFileObject -> Bool)
-> (AssistantFileObject -> AssistantFileObject -> Bool)
-> Eq AssistantFileObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssistantFileObject -> AssistantFileObject -> Bool
== :: AssistantFileObject -> AssistantFileObject -> Bool
$c/= :: AssistantFileObject -> AssistantFileObject -> Bool
/= :: AssistantFileObject -> AssistantFileObject -> Bool
Eq, Eq AssistantFileObject
Eq AssistantFileObject =>
(AssistantFileObject -> AssistantFileObject -> Ordering)
-> (AssistantFileObject -> AssistantFileObject -> Bool)
-> (AssistantFileObject -> AssistantFileObject -> Bool)
-> (AssistantFileObject -> AssistantFileObject -> Bool)
-> (AssistantFileObject -> AssistantFileObject -> Bool)
-> (AssistantFileObject
    -> AssistantFileObject -> AssistantFileObject)
-> (AssistantFileObject
    -> AssistantFileObject -> AssistantFileObject)
-> Ord AssistantFileObject
AssistantFileObject -> AssistantFileObject -> Bool
AssistantFileObject -> AssistantFileObject -> Ordering
AssistantFileObject -> AssistantFileObject -> AssistantFileObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AssistantFileObject -> AssistantFileObject -> Ordering
compare :: AssistantFileObject -> AssistantFileObject -> Ordering
$c< :: AssistantFileObject -> AssistantFileObject -> Bool
< :: AssistantFileObject -> AssistantFileObject -> Bool
$c<= :: AssistantFileObject -> AssistantFileObject -> Bool
<= :: AssistantFileObject -> AssistantFileObject -> Bool
$c> :: AssistantFileObject -> AssistantFileObject -> Bool
> :: AssistantFileObject -> AssistantFileObject -> Bool
$c>= :: AssistantFileObject -> AssistantFileObject -> Bool
>= :: AssistantFileObject -> AssistantFileObject -> Bool
$cmax :: AssistantFileObject -> AssistantFileObject -> AssistantFileObject
max :: AssistantFileObject -> AssistantFileObject -> AssistantFileObject
$cmin :: AssistantFileObject -> AssistantFileObject -> AssistantFileObject
min :: AssistantFileObject -> AssistantFileObject -> AssistantFileObject
Ord, (forall x. AssistantFileObject -> Rep AssistantFileObject x)
-> (forall x. Rep AssistantFileObject x -> AssistantFileObject)
-> Generic AssistantFileObject
forall x. Rep AssistantFileObject x -> AssistantFileObject
forall x. AssistantFileObject -> Rep AssistantFileObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssistantFileObject -> Rep AssistantFileObject x
from :: forall x. AssistantFileObject -> Rep AssistantFileObject x
$cto :: forall x. Rep AssistantFileObject x -> AssistantFileObject
to :: forall x. Rep AssistantFileObject x -> AssistantFileObject
Generic, Typeable AssistantFileObject
Typeable AssistantFileObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> AssistantFileObject
 -> c AssistantFileObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AssistantFileObject)
-> (AssistantFileObject -> Constr)
-> (AssistantFileObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AssistantFileObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AssistantFileObject))
-> ((forall b. Data b => b -> b)
    -> AssistantFileObject -> AssistantFileObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AssistantFileObject -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AssistantFileObject -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AssistantFileObject -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AssistantFileObject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AssistantFileObject -> m AssistantFileObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantFileObject -> m AssistantFileObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantFileObject -> m AssistantFileObject)
-> Data AssistantFileObject
AssistantFileObject -> Constr
AssistantFileObject -> DataType
(forall b. Data b => b -> b)
-> AssistantFileObject -> AssistantFileObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AssistantFileObject -> u
forall u.
(forall d. Data d => d -> u) -> AssistantFileObject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantFileObject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantFileObject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantFileObject -> m AssistantFileObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantFileObject -> m AssistantFileObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantFileObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantFileObject
-> c AssistantFileObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantFileObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantFileObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantFileObject
-> c AssistantFileObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantFileObject
-> c AssistantFileObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantFileObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantFileObject
$ctoConstr :: AssistantFileObject -> Constr
toConstr :: AssistantFileObject -> Constr
$cdataTypeOf :: AssistantFileObject -> DataType
dataTypeOf :: AssistantFileObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantFileObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantFileObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantFileObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantFileObject)
$cgmapT :: (forall b. Data b => b -> b)
-> AssistantFileObject -> AssistantFileObject
gmapT :: (forall b. Data b => b -> b)
-> AssistantFileObject -> AssistantFileObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantFileObject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantFileObject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantFileObject -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantFileObject -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AssistantFileObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> AssistantFileObject -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssistantFileObject -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssistantFileObject -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantFileObject -> m AssistantFileObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantFileObject -> m AssistantFileObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantFileObject -> m AssistantFileObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantFileObject -> m AssistantFileObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantFileObject -> m AssistantFileObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantFileObject -> m AssistantFileObject
Data)

instance FromJSON AssistantFileObject where
  parseJSON :: Value -> Parser AssistantFileObject
parseJSON = Options -> Value -> Parser AssistantFileObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"assistantFileObject")
instance ToJSON AssistantFileObject where
  toJSON :: AssistantFileObject -> Value
toJSON = Options -> AssistantFileObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"assistantFileObject")


-- | Represents an &#x60;assistant&#x60; that can call the model and use tools.
data AssistantObject = AssistantObject
  { AssistantObject -> Text
assistantObjectId :: Text -- ^ The identifier, which can be referenced in API endpoints.
  , AssistantObject -> Text
assistantObjectObject :: Text -- ^ The object type, which is always `assistant`.
  , AssistantObject -> Int
assistantObjectCreatedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the assistant was created.
  , AssistantObject -> Text
assistantObjectName :: Text -- ^ The name of the assistant. The maximum length is 256 characters. 
  , AssistantObject -> Text
assistantObjectDescription :: Text -- ^ The description of the assistant. The maximum length is 512 characters. 
  , AssistantObject -> Text
assistantObjectModel :: Text -- ^ ID of the model to use. You can use the [List models](/docs/api-reference/models/list) API to see all of your available models, or see our [Model overview](/docs/models/overview) for descriptions of them. 
  , AssistantObject -> Text
assistantObjectInstructions :: Text -- ^ The system instructions that the assistant uses. The maximum length is 32768 characters. 
  , AssistantObject -> [AssistantObjectToolsInner]
assistantObjectTools :: [AssistantObjectToolsInner] -- ^ A list of tool enabled on the assistant. There can be a maximum of 128 tools per assistant. Tools can be of types `code_interpreter`, `retrieval`, or `function`. 
  , AssistantObject -> [Text]
assistantObjectFileUnderscoreids :: [Text] -- ^ A list of [file](/docs/api-reference/files) IDs attached to this assistant. There can be a maximum of 20 files attached to the assistant. Files are ordered by their creation date in ascending order. 
  , AssistantObject -> Value
assistantObjectMetadata :: Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> AssistantObject -> ShowS
[AssistantObject] -> ShowS
AssistantObject -> String
(Int -> AssistantObject -> ShowS)
-> (AssistantObject -> String)
-> ([AssistantObject] -> ShowS)
-> Show AssistantObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssistantObject -> ShowS
showsPrec :: Int -> AssistantObject -> ShowS
$cshow :: AssistantObject -> String
show :: AssistantObject -> String
$cshowList :: [AssistantObject] -> ShowS
showList :: [AssistantObject] -> ShowS
Show, AssistantObject -> AssistantObject -> Bool
(AssistantObject -> AssistantObject -> Bool)
-> (AssistantObject -> AssistantObject -> Bool)
-> Eq AssistantObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssistantObject -> AssistantObject -> Bool
== :: AssistantObject -> AssistantObject -> Bool
$c/= :: AssistantObject -> AssistantObject -> Bool
/= :: AssistantObject -> AssistantObject -> Bool
Eq, Eq AssistantObject
Eq AssistantObject =>
(AssistantObject -> AssistantObject -> Ordering)
-> (AssistantObject -> AssistantObject -> Bool)
-> (AssistantObject -> AssistantObject -> Bool)
-> (AssistantObject -> AssistantObject -> Bool)
-> (AssistantObject -> AssistantObject -> Bool)
-> (AssistantObject -> AssistantObject -> AssistantObject)
-> (AssistantObject -> AssistantObject -> AssistantObject)
-> Ord AssistantObject
AssistantObject -> AssistantObject -> Bool
AssistantObject -> AssistantObject -> Ordering
AssistantObject -> AssistantObject -> AssistantObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AssistantObject -> AssistantObject -> Ordering
compare :: AssistantObject -> AssistantObject -> Ordering
$c< :: AssistantObject -> AssistantObject -> Bool
< :: AssistantObject -> AssistantObject -> Bool
$c<= :: AssistantObject -> AssistantObject -> Bool
<= :: AssistantObject -> AssistantObject -> Bool
$c> :: AssistantObject -> AssistantObject -> Bool
> :: AssistantObject -> AssistantObject -> Bool
$c>= :: AssistantObject -> AssistantObject -> Bool
>= :: AssistantObject -> AssistantObject -> Bool
$cmax :: AssistantObject -> AssistantObject -> AssistantObject
max :: AssistantObject -> AssistantObject -> AssistantObject
$cmin :: AssistantObject -> AssistantObject -> AssistantObject
min :: AssistantObject -> AssistantObject -> AssistantObject
Ord, (forall x. AssistantObject -> Rep AssistantObject x)
-> (forall x. Rep AssistantObject x -> AssistantObject)
-> Generic AssistantObject
forall x. Rep AssistantObject x -> AssistantObject
forall x. AssistantObject -> Rep AssistantObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssistantObject -> Rep AssistantObject x
from :: forall x. AssistantObject -> Rep AssistantObject x
$cto :: forall x. Rep AssistantObject x -> AssistantObject
to :: forall x. Rep AssistantObject x -> AssistantObject
Generic, Typeable AssistantObject
Typeable AssistantObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AssistantObject -> c AssistantObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AssistantObject)
-> (AssistantObject -> Constr)
-> (AssistantObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AssistantObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AssistantObject))
-> ((forall b. Data b => b -> b)
    -> AssistantObject -> AssistantObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AssistantObject -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AssistantObject -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AssistantObject -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AssistantObject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AssistantObject -> m AssistantObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantObject -> m AssistantObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantObject -> m AssistantObject)
-> Data AssistantObject
AssistantObject -> Constr
AssistantObject -> DataType
(forall b. Data b => b -> b) -> AssistantObject -> AssistantObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AssistantObject -> u
forall u. (forall d. Data d => d -> u) -> AssistantObject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantObject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantObject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantObject -> m AssistantObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantObject -> m AssistantObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssistantObject -> c AssistantObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssistantObject -> c AssistantObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssistantObject -> c AssistantObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantObject
$ctoConstr :: AssistantObject -> Constr
toConstr :: AssistantObject -> Constr
$cdataTypeOf :: AssistantObject -> DataType
dataTypeOf :: AssistantObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantObject)
$cgmapT :: (forall b. Data b => b -> b) -> AssistantObject -> AssistantObject
gmapT :: (forall b. Data b => b -> b) -> AssistantObject -> AssistantObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantObject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantObject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantObject -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantObject -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AssistantObject -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AssistantObject -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssistantObject -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssistantObject -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantObject -> m AssistantObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantObject -> m AssistantObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantObject -> m AssistantObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantObject -> m AssistantObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantObject -> m AssistantObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantObject -> m AssistantObject
Data)

instance FromJSON AssistantObject where
  parseJSON :: Value -> Parser AssistantObject
parseJSON = Options -> Value -> Parser AssistantObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"assistantObject")
instance ToJSON AssistantObject where
  toJSON :: AssistantObject -> Value
toJSON = Options -> AssistantObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"assistantObject")


-- | 
data AssistantObjectToolsInner = AssistantObjectToolsInner
  { AssistantObjectToolsInner -> Text
assistantObjectToolsInnerType :: Text -- ^ The type of tool being defined: `function`
  , AssistantObjectToolsInner -> FunctionObject
assistantObjectToolsInnerFunction :: FunctionObject -- ^ 
  } deriving (Int -> AssistantObjectToolsInner -> ShowS
[AssistantObjectToolsInner] -> ShowS
AssistantObjectToolsInner -> String
(Int -> AssistantObjectToolsInner -> ShowS)
-> (AssistantObjectToolsInner -> String)
-> ([AssistantObjectToolsInner] -> ShowS)
-> Show AssistantObjectToolsInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssistantObjectToolsInner -> ShowS
showsPrec :: Int -> AssistantObjectToolsInner -> ShowS
$cshow :: AssistantObjectToolsInner -> String
show :: AssistantObjectToolsInner -> String
$cshowList :: [AssistantObjectToolsInner] -> ShowS
showList :: [AssistantObjectToolsInner] -> ShowS
Show, AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
(AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool)
-> (AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool)
-> Eq AssistantObjectToolsInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
== :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
$c/= :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
/= :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
Eq, Eq AssistantObjectToolsInner
Eq AssistantObjectToolsInner =>
(AssistantObjectToolsInner
 -> AssistantObjectToolsInner -> Ordering)
-> (AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool)
-> (AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool)
-> (AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool)
-> (AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool)
-> (AssistantObjectToolsInner
    -> AssistantObjectToolsInner -> AssistantObjectToolsInner)
-> (AssistantObjectToolsInner
    -> AssistantObjectToolsInner -> AssistantObjectToolsInner)
-> Ord AssistantObjectToolsInner
AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
AssistantObjectToolsInner -> AssistantObjectToolsInner -> Ordering
AssistantObjectToolsInner
-> AssistantObjectToolsInner -> AssistantObjectToolsInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Ordering
compare :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Ordering
$c< :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
< :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
$c<= :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
<= :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
$c> :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
> :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
$c>= :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
>= :: AssistantObjectToolsInner -> AssistantObjectToolsInner -> Bool
$cmax :: AssistantObjectToolsInner
-> AssistantObjectToolsInner -> AssistantObjectToolsInner
max :: AssistantObjectToolsInner
-> AssistantObjectToolsInner -> AssistantObjectToolsInner
$cmin :: AssistantObjectToolsInner
-> AssistantObjectToolsInner -> AssistantObjectToolsInner
min :: AssistantObjectToolsInner
-> AssistantObjectToolsInner -> AssistantObjectToolsInner
Ord, (forall x.
 AssistantObjectToolsInner -> Rep AssistantObjectToolsInner x)
-> (forall x.
    Rep AssistantObjectToolsInner x -> AssistantObjectToolsInner)
-> Generic AssistantObjectToolsInner
forall x.
Rep AssistantObjectToolsInner x -> AssistantObjectToolsInner
forall x.
AssistantObjectToolsInner -> Rep AssistantObjectToolsInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
AssistantObjectToolsInner -> Rep AssistantObjectToolsInner x
from :: forall x.
AssistantObjectToolsInner -> Rep AssistantObjectToolsInner x
$cto :: forall x.
Rep AssistantObjectToolsInner x -> AssistantObjectToolsInner
to :: forall x.
Rep AssistantObjectToolsInner x -> AssistantObjectToolsInner
Generic, Typeable AssistantObjectToolsInner
Typeable AssistantObjectToolsInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> AssistantObjectToolsInner
 -> c AssistantObjectToolsInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AssistantObjectToolsInner)
-> (AssistantObjectToolsInner -> Constr)
-> (AssistantObjectToolsInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c AssistantObjectToolsInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AssistantObjectToolsInner))
-> ((forall b. Data b => b -> b)
    -> AssistantObjectToolsInner -> AssistantObjectToolsInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AssistantObjectToolsInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AssistantObjectToolsInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AssistantObjectToolsInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> AssistantObjectToolsInner -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AssistantObjectToolsInner -> m AssistantObjectToolsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantObjectToolsInner -> m AssistantObjectToolsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantObjectToolsInner -> m AssistantObjectToolsInner)
-> Data AssistantObjectToolsInner
AssistantObjectToolsInner -> Constr
AssistantObjectToolsInner -> DataType
(forall b. Data b => b -> b)
-> AssistantObjectToolsInner -> AssistantObjectToolsInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> AssistantObjectToolsInner -> u
forall u.
(forall d. Data d => d -> u) -> AssistantObjectToolsInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantObjectToolsInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantObjectToolsInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantObjectToolsInner -> m AssistantObjectToolsInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantObjectToolsInner -> m AssistantObjectToolsInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantObjectToolsInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantObjectToolsInner
-> c AssistantObjectToolsInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AssistantObjectToolsInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantObjectToolsInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantObjectToolsInner
-> c AssistantObjectToolsInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantObjectToolsInner
-> c AssistantObjectToolsInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantObjectToolsInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantObjectToolsInner
$ctoConstr :: AssistantObjectToolsInner -> Constr
toConstr :: AssistantObjectToolsInner -> Constr
$cdataTypeOf :: AssistantObjectToolsInner -> DataType
dataTypeOf :: AssistantObjectToolsInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AssistantObjectToolsInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AssistantObjectToolsInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantObjectToolsInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantObjectToolsInner)
$cgmapT :: (forall b. Data b => b -> b)
-> AssistantObjectToolsInner -> AssistantObjectToolsInner
gmapT :: (forall b. Data b => b -> b)
-> AssistantObjectToolsInner -> AssistantObjectToolsInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantObjectToolsInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantObjectToolsInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantObjectToolsInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantObjectToolsInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AssistantObjectToolsInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> AssistantObjectToolsInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> AssistantObjectToolsInner -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> AssistantObjectToolsInner -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantObjectToolsInner -> m AssistantObjectToolsInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantObjectToolsInner -> m AssistantObjectToolsInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantObjectToolsInner -> m AssistantObjectToolsInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantObjectToolsInner -> m AssistantObjectToolsInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantObjectToolsInner -> m AssistantObjectToolsInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantObjectToolsInner -> m AssistantObjectToolsInner
Data)

instance FromJSON AssistantObjectToolsInner where
  parseJSON :: Value -> Parser AssistantObjectToolsInner
parseJSON = Options -> Value -> Parser AssistantObjectToolsInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"assistantObjectToolsInner")
instance ToJSON AssistantObjectToolsInner where
  toJSON :: AssistantObjectToolsInner -> Value
toJSON = Options -> AssistantObjectToolsInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"assistantObjectToolsInner")


-- | 
data AssistantToolsCode = AssistantToolsCode
  { AssistantToolsCode -> Text
assistantToolsCodeType :: Text -- ^ The type of tool being defined: `code_interpreter`
  } deriving (Int -> AssistantToolsCode -> ShowS
[AssistantToolsCode] -> ShowS
AssistantToolsCode -> String
(Int -> AssistantToolsCode -> ShowS)
-> (AssistantToolsCode -> String)
-> ([AssistantToolsCode] -> ShowS)
-> Show AssistantToolsCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssistantToolsCode -> ShowS
showsPrec :: Int -> AssistantToolsCode -> ShowS
$cshow :: AssistantToolsCode -> String
show :: AssistantToolsCode -> String
$cshowList :: [AssistantToolsCode] -> ShowS
showList :: [AssistantToolsCode] -> ShowS
Show, AssistantToolsCode -> AssistantToolsCode -> Bool
(AssistantToolsCode -> AssistantToolsCode -> Bool)
-> (AssistantToolsCode -> AssistantToolsCode -> Bool)
-> Eq AssistantToolsCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssistantToolsCode -> AssistantToolsCode -> Bool
== :: AssistantToolsCode -> AssistantToolsCode -> Bool
$c/= :: AssistantToolsCode -> AssistantToolsCode -> Bool
/= :: AssistantToolsCode -> AssistantToolsCode -> Bool
Eq, Eq AssistantToolsCode
Eq AssistantToolsCode =>
(AssistantToolsCode -> AssistantToolsCode -> Ordering)
-> (AssistantToolsCode -> AssistantToolsCode -> Bool)
-> (AssistantToolsCode -> AssistantToolsCode -> Bool)
-> (AssistantToolsCode -> AssistantToolsCode -> Bool)
-> (AssistantToolsCode -> AssistantToolsCode -> Bool)
-> (AssistantToolsCode -> AssistantToolsCode -> AssistantToolsCode)
-> (AssistantToolsCode -> AssistantToolsCode -> AssistantToolsCode)
-> Ord AssistantToolsCode
AssistantToolsCode -> AssistantToolsCode -> Bool
AssistantToolsCode -> AssistantToolsCode -> Ordering
AssistantToolsCode -> AssistantToolsCode -> AssistantToolsCode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AssistantToolsCode -> AssistantToolsCode -> Ordering
compare :: AssistantToolsCode -> AssistantToolsCode -> Ordering
$c< :: AssistantToolsCode -> AssistantToolsCode -> Bool
< :: AssistantToolsCode -> AssistantToolsCode -> Bool
$c<= :: AssistantToolsCode -> AssistantToolsCode -> Bool
<= :: AssistantToolsCode -> AssistantToolsCode -> Bool
$c> :: AssistantToolsCode -> AssistantToolsCode -> Bool
> :: AssistantToolsCode -> AssistantToolsCode -> Bool
$c>= :: AssistantToolsCode -> AssistantToolsCode -> Bool
>= :: AssistantToolsCode -> AssistantToolsCode -> Bool
$cmax :: AssistantToolsCode -> AssistantToolsCode -> AssistantToolsCode
max :: AssistantToolsCode -> AssistantToolsCode -> AssistantToolsCode
$cmin :: AssistantToolsCode -> AssistantToolsCode -> AssistantToolsCode
min :: AssistantToolsCode -> AssistantToolsCode -> AssistantToolsCode
Ord, (forall x. AssistantToolsCode -> Rep AssistantToolsCode x)
-> (forall x. Rep AssistantToolsCode x -> AssistantToolsCode)
-> Generic AssistantToolsCode
forall x. Rep AssistantToolsCode x -> AssistantToolsCode
forall x. AssistantToolsCode -> Rep AssistantToolsCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssistantToolsCode -> Rep AssistantToolsCode x
from :: forall x. AssistantToolsCode -> Rep AssistantToolsCode x
$cto :: forall x. Rep AssistantToolsCode x -> AssistantToolsCode
to :: forall x. Rep AssistantToolsCode x -> AssistantToolsCode
Generic, Typeable AssistantToolsCode
Typeable AssistantToolsCode =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> AssistantToolsCode
 -> c AssistantToolsCode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AssistantToolsCode)
-> (AssistantToolsCode -> Constr)
-> (AssistantToolsCode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AssistantToolsCode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AssistantToolsCode))
-> ((forall b. Data b => b -> b)
    -> AssistantToolsCode -> AssistantToolsCode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AssistantToolsCode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AssistantToolsCode -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AssistantToolsCode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AssistantToolsCode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AssistantToolsCode -> m AssistantToolsCode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantToolsCode -> m AssistantToolsCode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantToolsCode -> m AssistantToolsCode)
-> Data AssistantToolsCode
AssistantToolsCode -> Constr
AssistantToolsCode -> DataType
(forall b. Data b => b -> b)
-> AssistantToolsCode -> AssistantToolsCode
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AssistantToolsCode -> u
forall u. (forall d. Data d => d -> u) -> AssistantToolsCode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantToolsCode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantToolsCode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantToolsCode -> m AssistantToolsCode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsCode -> m AssistantToolsCode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantToolsCode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantToolsCode
-> c AssistantToolsCode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantToolsCode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantToolsCode)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantToolsCode
-> c AssistantToolsCode
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantToolsCode
-> c AssistantToolsCode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantToolsCode
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantToolsCode
$ctoConstr :: AssistantToolsCode -> Constr
toConstr :: AssistantToolsCode -> Constr
$cdataTypeOf :: AssistantToolsCode -> DataType
dataTypeOf :: AssistantToolsCode -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantToolsCode)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantToolsCode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantToolsCode)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantToolsCode)
$cgmapT :: (forall b. Data b => b -> b)
-> AssistantToolsCode -> AssistantToolsCode
gmapT :: (forall b. Data b => b -> b)
-> AssistantToolsCode -> AssistantToolsCode
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantToolsCode -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantToolsCode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantToolsCode -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssistantToolsCode -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AssistantToolsCode -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AssistantToolsCode -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssistantToolsCode -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssistantToolsCode -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantToolsCode -> m AssistantToolsCode
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantToolsCode -> m AssistantToolsCode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsCode -> m AssistantToolsCode
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsCode -> m AssistantToolsCode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsCode -> m AssistantToolsCode
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsCode -> m AssistantToolsCode
Data)

instance FromJSON AssistantToolsCode where
  parseJSON :: Value -> Parser AssistantToolsCode
parseJSON = Options -> Value -> Parser AssistantToolsCode
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"assistantToolsCode")
instance ToJSON AssistantToolsCode where
  toJSON :: AssistantToolsCode -> Value
toJSON = Options -> AssistantToolsCode -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"assistantToolsCode")


-- | 
data AssistantToolsFunction = AssistantToolsFunction
  { AssistantToolsFunction -> Text
assistantToolsFunctionType :: Text -- ^ The type of tool being defined: `function`
  , AssistantToolsFunction -> FunctionObject
assistantToolsFunctionFunction :: FunctionObject -- ^ 
  } deriving (Int -> AssistantToolsFunction -> ShowS
[AssistantToolsFunction] -> ShowS
AssistantToolsFunction -> String
(Int -> AssistantToolsFunction -> ShowS)
-> (AssistantToolsFunction -> String)
-> ([AssistantToolsFunction] -> ShowS)
-> Show AssistantToolsFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssistantToolsFunction -> ShowS
showsPrec :: Int -> AssistantToolsFunction -> ShowS
$cshow :: AssistantToolsFunction -> String
show :: AssistantToolsFunction -> String
$cshowList :: [AssistantToolsFunction] -> ShowS
showList :: [AssistantToolsFunction] -> ShowS
Show, AssistantToolsFunction -> AssistantToolsFunction -> Bool
(AssistantToolsFunction -> AssistantToolsFunction -> Bool)
-> (AssistantToolsFunction -> AssistantToolsFunction -> Bool)
-> Eq AssistantToolsFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
== :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
$c/= :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
/= :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
Eq, Eq AssistantToolsFunction
Eq AssistantToolsFunction =>
(AssistantToolsFunction -> AssistantToolsFunction -> Ordering)
-> (AssistantToolsFunction -> AssistantToolsFunction -> Bool)
-> (AssistantToolsFunction -> AssistantToolsFunction -> Bool)
-> (AssistantToolsFunction -> AssistantToolsFunction -> Bool)
-> (AssistantToolsFunction -> AssistantToolsFunction -> Bool)
-> (AssistantToolsFunction
    -> AssistantToolsFunction -> AssistantToolsFunction)
-> (AssistantToolsFunction
    -> AssistantToolsFunction -> AssistantToolsFunction)
-> Ord AssistantToolsFunction
AssistantToolsFunction -> AssistantToolsFunction -> Bool
AssistantToolsFunction -> AssistantToolsFunction -> Ordering
AssistantToolsFunction
-> AssistantToolsFunction -> AssistantToolsFunction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AssistantToolsFunction -> AssistantToolsFunction -> Ordering
compare :: AssistantToolsFunction -> AssistantToolsFunction -> Ordering
$c< :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
< :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
$c<= :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
<= :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
$c> :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
> :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
$c>= :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
>= :: AssistantToolsFunction -> AssistantToolsFunction -> Bool
$cmax :: AssistantToolsFunction
-> AssistantToolsFunction -> AssistantToolsFunction
max :: AssistantToolsFunction
-> AssistantToolsFunction -> AssistantToolsFunction
$cmin :: AssistantToolsFunction
-> AssistantToolsFunction -> AssistantToolsFunction
min :: AssistantToolsFunction
-> AssistantToolsFunction -> AssistantToolsFunction
Ord, (forall x. AssistantToolsFunction -> Rep AssistantToolsFunction x)
-> (forall x.
    Rep AssistantToolsFunction x -> AssistantToolsFunction)
-> Generic AssistantToolsFunction
forall x. Rep AssistantToolsFunction x -> AssistantToolsFunction
forall x. AssistantToolsFunction -> Rep AssistantToolsFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssistantToolsFunction -> Rep AssistantToolsFunction x
from :: forall x. AssistantToolsFunction -> Rep AssistantToolsFunction x
$cto :: forall x. Rep AssistantToolsFunction x -> AssistantToolsFunction
to :: forall x. Rep AssistantToolsFunction x -> AssistantToolsFunction
Generic, Typeable AssistantToolsFunction
Typeable AssistantToolsFunction =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> AssistantToolsFunction
 -> c AssistantToolsFunction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AssistantToolsFunction)
-> (AssistantToolsFunction -> Constr)
-> (AssistantToolsFunction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AssistantToolsFunction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AssistantToolsFunction))
-> ((forall b. Data b => b -> b)
    -> AssistantToolsFunction -> AssistantToolsFunction)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AssistantToolsFunction
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AssistantToolsFunction
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AssistantToolsFunction -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AssistantToolsFunction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AssistantToolsFunction -> m AssistantToolsFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantToolsFunction -> m AssistantToolsFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantToolsFunction -> m AssistantToolsFunction)
-> Data AssistantToolsFunction
AssistantToolsFunction -> Constr
AssistantToolsFunction -> DataType
(forall b. Data b => b -> b)
-> AssistantToolsFunction -> AssistantToolsFunction
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AssistantToolsFunction -> u
forall u.
(forall d. Data d => d -> u) -> AssistantToolsFunction -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsFunction
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsFunction
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantToolsFunction -> m AssistantToolsFunction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsFunction -> m AssistantToolsFunction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantToolsFunction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantToolsFunction
-> c AssistantToolsFunction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantToolsFunction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantToolsFunction)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantToolsFunction
-> c AssistantToolsFunction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantToolsFunction
-> c AssistantToolsFunction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantToolsFunction
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantToolsFunction
$ctoConstr :: AssistantToolsFunction -> Constr
toConstr :: AssistantToolsFunction -> Constr
$cdataTypeOf :: AssistantToolsFunction -> DataType
dataTypeOf :: AssistantToolsFunction -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantToolsFunction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantToolsFunction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantToolsFunction)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantToolsFunction)
$cgmapT :: (forall b. Data b => b -> b)
-> AssistantToolsFunction -> AssistantToolsFunction
gmapT :: (forall b. Data b => b -> b)
-> AssistantToolsFunction -> AssistantToolsFunction
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsFunction
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsFunction
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsFunction
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsFunction
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AssistantToolsFunction -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> AssistantToolsFunction -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssistantToolsFunction -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssistantToolsFunction -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantToolsFunction -> m AssistantToolsFunction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantToolsFunction -> m AssistantToolsFunction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsFunction -> m AssistantToolsFunction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsFunction -> m AssistantToolsFunction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsFunction -> m AssistantToolsFunction
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsFunction -> m AssistantToolsFunction
Data)

instance FromJSON AssistantToolsFunction where
  parseJSON :: Value -> Parser AssistantToolsFunction
parseJSON = Options -> Value -> Parser AssistantToolsFunction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"assistantToolsFunction")
instance ToJSON AssistantToolsFunction where
  toJSON :: AssistantToolsFunction -> Value
toJSON = Options -> AssistantToolsFunction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"assistantToolsFunction")


-- | 
data AssistantToolsRetrieval = AssistantToolsRetrieval
  { AssistantToolsRetrieval -> Text
assistantToolsRetrievalType :: Text -- ^ The type of tool being defined: `retrieval`
  } deriving (Int -> AssistantToolsRetrieval -> ShowS
[AssistantToolsRetrieval] -> ShowS
AssistantToolsRetrieval -> String
(Int -> AssistantToolsRetrieval -> ShowS)
-> (AssistantToolsRetrieval -> String)
-> ([AssistantToolsRetrieval] -> ShowS)
-> Show AssistantToolsRetrieval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssistantToolsRetrieval -> ShowS
showsPrec :: Int -> AssistantToolsRetrieval -> ShowS
$cshow :: AssistantToolsRetrieval -> String
show :: AssistantToolsRetrieval -> String
$cshowList :: [AssistantToolsRetrieval] -> ShowS
showList :: [AssistantToolsRetrieval] -> ShowS
Show, AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
(AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool)
-> (AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool)
-> Eq AssistantToolsRetrieval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
== :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
$c/= :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
/= :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
Eq, Eq AssistantToolsRetrieval
Eq AssistantToolsRetrieval =>
(AssistantToolsRetrieval -> AssistantToolsRetrieval -> Ordering)
-> (AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool)
-> (AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool)
-> (AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool)
-> (AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool)
-> (AssistantToolsRetrieval
    -> AssistantToolsRetrieval -> AssistantToolsRetrieval)
-> (AssistantToolsRetrieval
    -> AssistantToolsRetrieval -> AssistantToolsRetrieval)
-> Ord AssistantToolsRetrieval
AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
AssistantToolsRetrieval -> AssistantToolsRetrieval -> Ordering
AssistantToolsRetrieval
-> AssistantToolsRetrieval -> AssistantToolsRetrieval
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Ordering
compare :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Ordering
$c< :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
< :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
$c<= :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
<= :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
$c> :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
> :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
$c>= :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
>= :: AssistantToolsRetrieval -> AssistantToolsRetrieval -> Bool
$cmax :: AssistantToolsRetrieval
-> AssistantToolsRetrieval -> AssistantToolsRetrieval
max :: AssistantToolsRetrieval
-> AssistantToolsRetrieval -> AssistantToolsRetrieval
$cmin :: AssistantToolsRetrieval
-> AssistantToolsRetrieval -> AssistantToolsRetrieval
min :: AssistantToolsRetrieval
-> AssistantToolsRetrieval -> AssistantToolsRetrieval
Ord, (forall x.
 AssistantToolsRetrieval -> Rep AssistantToolsRetrieval x)
-> (forall x.
    Rep AssistantToolsRetrieval x -> AssistantToolsRetrieval)
-> Generic AssistantToolsRetrieval
forall x. Rep AssistantToolsRetrieval x -> AssistantToolsRetrieval
forall x. AssistantToolsRetrieval -> Rep AssistantToolsRetrieval x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssistantToolsRetrieval -> Rep AssistantToolsRetrieval x
from :: forall x. AssistantToolsRetrieval -> Rep AssistantToolsRetrieval x
$cto :: forall x. Rep AssistantToolsRetrieval x -> AssistantToolsRetrieval
to :: forall x. Rep AssistantToolsRetrieval x -> AssistantToolsRetrieval
Generic, Typeable AssistantToolsRetrieval
Typeable AssistantToolsRetrieval =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> AssistantToolsRetrieval
 -> c AssistantToolsRetrieval)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AssistantToolsRetrieval)
-> (AssistantToolsRetrieval -> Constr)
-> (AssistantToolsRetrieval -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AssistantToolsRetrieval))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AssistantToolsRetrieval))
-> ((forall b. Data b => b -> b)
    -> AssistantToolsRetrieval -> AssistantToolsRetrieval)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AssistantToolsRetrieval
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AssistantToolsRetrieval
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AssistantToolsRetrieval -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> AssistantToolsRetrieval -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AssistantToolsRetrieval -> m AssistantToolsRetrieval)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantToolsRetrieval -> m AssistantToolsRetrieval)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssistantToolsRetrieval -> m AssistantToolsRetrieval)
-> Data AssistantToolsRetrieval
AssistantToolsRetrieval -> Constr
AssistantToolsRetrieval -> DataType
(forall b. Data b => b -> b)
-> AssistantToolsRetrieval -> AssistantToolsRetrieval
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AssistantToolsRetrieval -> u
forall u.
(forall d. Data d => d -> u) -> AssistantToolsRetrieval -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsRetrieval
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsRetrieval
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantToolsRetrieval -> m AssistantToolsRetrieval
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsRetrieval -> m AssistantToolsRetrieval
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantToolsRetrieval
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantToolsRetrieval
-> c AssistantToolsRetrieval
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantToolsRetrieval)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantToolsRetrieval)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantToolsRetrieval
-> c AssistantToolsRetrieval
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AssistantToolsRetrieval
-> c AssistantToolsRetrieval
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantToolsRetrieval
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssistantToolsRetrieval
$ctoConstr :: AssistantToolsRetrieval -> Constr
toConstr :: AssistantToolsRetrieval -> Constr
$cdataTypeOf :: AssistantToolsRetrieval -> DataType
dataTypeOf :: AssistantToolsRetrieval -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantToolsRetrieval)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssistantToolsRetrieval)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantToolsRetrieval)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssistantToolsRetrieval)
$cgmapT :: (forall b. Data b => b -> b)
-> AssistantToolsRetrieval -> AssistantToolsRetrieval
gmapT :: (forall b. Data b => b -> b)
-> AssistantToolsRetrieval -> AssistantToolsRetrieval
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsRetrieval
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsRetrieval
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsRetrieval
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AssistantToolsRetrieval
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AssistantToolsRetrieval -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> AssistantToolsRetrieval -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssistantToolsRetrieval -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssistantToolsRetrieval -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantToolsRetrieval -> m AssistantToolsRetrieval
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssistantToolsRetrieval -> m AssistantToolsRetrieval
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsRetrieval -> m AssistantToolsRetrieval
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsRetrieval -> m AssistantToolsRetrieval
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsRetrieval -> m AssistantToolsRetrieval
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssistantToolsRetrieval -> m AssistantToolsRetrieval
Data)

instance FromJSON AssistantToolsRetrieval where
  parseJSON :: Value -> Parser AssistantToolsRetrieval
parseJSON = Options -> Value -> Parser AssistantToolsRetrieval
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"assistantToolsRetrieval")
instance ToJSON AssistantToolsRetrieval where
  toJSON :: AssistantToolsRetrieval -> Value
toJSON = Options -> AssistantToolsRetrieval -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"assistantToolsRetrieval")


-- | Specifying a particular function via &#x60;{\&quot;name\&quot;: \&quot;my_function\&quot;}&#x60; forces the model to call that function. 
data ChatCompletionFunctionCallOption = ChatCompletionFunctionCallOption
  { ChatCompletionFunctionCallOption -> Text
chatCompletionFunctionCallOptionName :: Text -- ^ The name of the function to call.
  } deriving (Int -> ChatCompletionFunctionCallOption -> ShowS
[ChatCompletionFunctionCallOption] -> ShowS
ChatCompletionFunctionCallOption -> String
(Int -> ChatCompletionFunctionCallOption -> ShowS)
-> (ChatCompletionFunctionCallOption -> String)
-> ([ChatCompletionFunctionCallOption] -> ShowS)
-> Show ChatCompletionFunctionCallOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionFunctionCallOption -> ShowS
showsPrec :: Int -> ChatCompletionFunctionCallOption -> ShowS
$cshow :: ChatCompletionFunctionCallOption -> String
show :: ChatCompletionFunctionCallOption -> String
$cshowList :: [ChatCompletionFunctionCallOption] -> ShowS
showList :: [ChatCompletionFunctionCallOption] -> ShowS
Show, ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
(ChatCompletionFunctionCallOption
 -> ChatCompletionFunctionCallOption -> Bool)
-> (ChatCompletionFunctionCallOption
    -> ChatCompletionFunctionCallOption -> Bool)
-> Eq ChatCompletionFunctionCallOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
== :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
$c/= :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
/= :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
Eq, Eq ChatCompletionFunctionCallOption
Eq ChatCompletionFunctionCallOption =>
(ChatCompletionFunctionCallOption
 -> ChatCompletionFunctionCallOption -> Ordering)
-> (ChatCompletionFunctionCallOption
    -> ChatCompletionFunctionCallOption -> Bool)
-> (ChatCompletionFunctionCallOption
    -> ChatCompletionFunctionCallOption -> Bool)
-> (ChatCompletionFunctionCallOption
    -> ChatCompletionFunctionCallOption -> Bool)
-> (ChatCompletionFunctionCallOption
    -> ChatCompletionFunctionCallOption -> Bool)
-> (ChatCompletionFunctionCallOption
    -> ChatCompletionFunctionCallOption
    -> ChatCompletionFunctionCallOption)
-> (ChatCompletionFunctionCallOption
    -> ChatCompletionFunctionCallOption
    -> ChatCompletionFunctionCallOption)
-> Ord ChatCompletionFunctionCallOption
ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Ordering
ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Ordering
compare :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Ordering
$c< :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
< :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
$c<= :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
<= :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
$c> :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
> :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
$c>= :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
>= :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption -> Bool
$cmax :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
max :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
$cmin :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
min :: ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
Ord, (forall x.
 ChatCompletionFunctionCallOption
 -> Rep ChatCompletionFunctionCallOption x)
-> (forall x.
    Rep ChatCompletionFunctionCallOption x
    -> ChatCompletionFunctionCallOption)
-> Generic ChatCompletionFunctionCallOption
forall x.
Rep ChatCompletionFunctionCallOption x
-> ChatCompletionFunctionCallOption
forall x.
ChatCompletionFunctionCallOption
-> Rep ChatCompletionFunctionCallOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionFunctionCallOption
-> Rep ChatCompletionFunctionCallOption x
from :: forall x.
ChatCompletionFunctionCallOption
-> Rep ChatCompletionFunctionCallOption x
$cto :: forall x.
Rep ChatCompletionFunctionCallOption x
-> ChatCompletionFunctionCallOption
to :: forall x.
Rep ChatCompletionFunctionCallOption x
-> ChatCompletionFunctionCallOption
Generic, Typeable ChatCompletionFunctionCallOption
Typeable ChatCompletionFunctionCallOption =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionFunctionCallOption
 -> c ChatCompletionFunctionCallOption)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionFunctionCallOption)
-> (ChatCompletionFunctionCallOption -> Constr)
-> (ChatCompletionFunctionCallOption -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionFunctionCallOption))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionFunctionCallOption))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionFunctionCallOption
    -> ChatCompletionFunctionCallOption)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionFunctionCallOption
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionFunctionCallOption
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionFunctionCallOption -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionFunctionCallOption
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionFunctionCallOption
    -> m ChatCompletionFunctionCallOption)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionFunctionCallOption
    -> m ChatCompletionFunctionCallOption)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionFunctionCallOption
    -> m ChatCompletionFunctionCallOption)
-> Data ChatCompletionFunctionCallOption
ChatCompletionFunctionCallOption -> Constr
ChatCompletionFunctionCallOption -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionFunctionCallOption
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionFunctionCallOption -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctionCallOption
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctionCallOption
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctionCallOption
-> m ChatCompletionFunctionCallOption
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctionCallOption
-> m ChatCompletionFunctionCallOption
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionFunctionCallOption
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionFunctionCallOption
-> c ChatCompletionFunctionCallOption
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionFunctionCallOption)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionFunctionCallOption)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionFunctionCallOption
-> c ChatCompletionFunctionCallOption
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionFunctionCallOption
-> c ChatCompletionFunctionCallOption
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionFunctionCallOption
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionFunctionCallOption
$ctoConstr :: ChatCompletionFunctionCallOption -> Constr
toConstr :: ChatCompletionFunctionCallOption -> Constr
$cdataTypeOf :: ChatCompletionFunctionCallOption -> DataType
dataTypeOf :: ChatCompletionFunctionCallOption -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionFunctionCallOption)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionFunctionCallOption)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionFunctionCallOption)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionFunctionCallOption)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionFunctionCallOption
-> ChatCompletionFunctionCallOption
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctionCallOption
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctionCallOption
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctionCallOption
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctionCallOption
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionFunctionCallOption -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionFunctionCallOption -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionFunctionCallOption
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionFunctionCallOption
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctionCallOption
-> m ChatCompletionFunctionCallOption
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctionCallOption
-> m ChatCompletionFunctionCallOption
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctionCallOption
-> m ChatCompletionFunctionCallOption
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctionCallOption
-> m ChatCompletionFunctionCallOption
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctionCallOption
-> m ChatCompletionFunctionCallOption
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctionCallOption
-> m ChatCompletionFunctionCallOption
Data)

instance FromJSON ChatCompletionFunctionCallOption where
  parseJSON :: Value -> Parser ChatCompletionFunctionCallOption
parseJSON = Options -> Value -> Parser ChatCompletionFunctionCallOption
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionFunctionCallOption")
instance ToJSON ChatCompletionFunctionCallOption where
  toJSON :: ChatCompletionFunctionCallOption -> Value
toJSON = Options -> ChatCompletionFunctionCallOption -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionFunctionCallOption")


-- | 
data ChatCompletionFunctions = ChatCompletionFunctions
  { ChatCompletionFunctions -> Maybe Text
chatCompletionFunctionsDescription :: Maybe Text -- ^ A description of what the function does, used by the model to choose when and how to call the function.
  , ChatCompletionFunctions -> Text
chatCompletionFunctionsName :: Text -- ^ The name of the function to be called. Must be a-z, A-Z, 0-9, or contain underscores and dashes, with a maximum length of 64.
  , ChatCompletionFunctions -> Maybe (Map String Value)
chatCompletionFunctionsParameters :: Maybe (Map.Map String Value) -- ^ The parameters the functions accepts, described as a JSON Schema object. See the [guide](/docs/guides/text-generation/function-calling) for examples, and the [JSON Schema reference](https://json-schema.org/understanding-json-schema/) for documentation about the format.   Omitting `parameters` defines a function with an empty parameter list.
  } deriving (Int -> ChatCompletionFunctions -> ShowS
[ChatCompletionFunctions] -> ShowS
ChatCompletionFunctions -> String
(Int -> ChatCompletionFunctions -> ShowS)
-> (ChatCompletionFunctions -> String)
-> ([ChatCompletionFunctions] -> ShowS)
-> Show ChatCompletionFunctions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionFunctions -> ShowS
showsPrec :: Int -> ChatCompletionFunctions -> ShowS
$cshow :: ChatCompletionFunctions -> String
show :: ChatCompletionFunctions -> String
$cshowList :: [ChatCompletionFunctions] -> ShowS
showList :: [ChatCompletionFunctions] -> ShowS
Show, ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
(ChatCompletionFunctions -> ChatCompletionFunctions -> Bool)
-> (ChatCompletionFunctions -> ChatCompletionFunctions -> Bool)
-> Eq ChatCompletionFunctions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
== :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
$c/= :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
/= :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
Eq, Eq ChatCompletionFunctions
Eq ChatCompletionFunctions =>
(ChatCompletionFunctions -> ChatCompletionFunctions -> Ordering)
-> (ChatCompletionFunctions -> ChatCompletionFunctions -> Bool)
-> (ChatCompletionFunctions -> ChatCompletionFunctions -> Bool)
-> (ChatCompletionFunctions -> ChatCompletionFunctions -> Bool)
-> (ChatCompletionFunctions -> ChatCompletionFunctions -> Bool)
-> (ChatCompletionFunctions
    -> ChatCompletionFunctions -> ChatCompletionFunctions)
-> (ChatCompletionFunctions
    -> ChatCompletionFunctions -> ChatCompletionFunctions)
-> Ord ChatCompletionFunctions
ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
ChatCompletionFunctions -> ChatCompletionFunctions -> Ordering
ChatCompletionFunctions
-> ChatCompletionFunctions -> ChatCompletionFunctions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionFunctions -> ChatCompletionFunctions -> Ordering
compare :: ChatCompletionFunctions -> ChatCompletionFunctions -> Ordering
$c< :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
< :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
$c<= :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
<= :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
$c> :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
> :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
$c>= :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
>= :: ChatCompletionFunctions -> ChatCompletionFunctions -> Bool
$cmax :: ChatCompletionFunctions
-> ChatCompletionFunctions -> ChatCompletionFunctions
max :: ChatCompletionFunctions
-> ChatCompletionFunctions -> ChatCompletionFunctions
$cmin :: ChatCompletionFunctions
-> ChatCompletionFunctions -> ChatCompletionFunctions
min :: ChatCompletionFunctions
-> ChatCompletionFunctions -> ChatCompletionFunctions
Ord, (forall x.
 ChatCompletionFunctions -> Rep ChatCompletionFunctions x)
-> (forall x.
    Rep ChatCompletionFunctions x -> ChatCompletionFunctions)
-> Generic ChatCompletionFunctions
forall x. Rep ChatCompletionFunctions x -> ChatCompletionFunctions
forall x. ChatCompletionFunctions -> Rep ChatCompletionFunctions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChatCompletionFunctions -> Rep ChatCompletionFunctions x
from :: forall x. ChatCompletionFunctions -> Rep ChatCompletionFunctions x
$cto :: forall x. Rep ChatCompletionFunctions x -> ChatCompletionFunctions
to :: forall x. Rep ChatCompletionFunctions x -> ChatCompletionFunctions
Generic, Typeable ChatCompletionFunctions
Typeable ChatCompletionFunctions =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionFunctions
 -> c ChatCompletionFunctions)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ChatCompletionFunctions)
-> (ChatCompletionFunctions -> Constr)
-> (ChatCompletionFunctions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ChatCompletionFunctions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionFunctions))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionFunctions -> ChatCompletionFunctions)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionFunctions
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionFunctions
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ChatCompletionFunctions -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> ChatCompletionFunctions -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionFunctions -> m ChatCompletionFunctions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionFunctions -> m ChatCompletionFunctions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionFunctions -> m ChatCompletionFunctions)
-> Data ChatCompletionFunctions
ChatCompletionFunctions -> Constr
ChatCompletionFunctions -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionFunctions -> ChatCompletionFunctions
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ChatCompletionFunctions -> u
forall u.
(forall d. Data d => d -> u) -> ChatCompletionFunctions -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctions
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctions
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctions -> m ChatCompletionFunctions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctions -> m ChatCompletionFunctions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionFunctions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionFunctions
-> c ChatCompletionFunctions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChatCompletionFunctions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionFunctions)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionFunctions
-> c ChatCompletionFunctions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionFunctions
-> c ChatCompletionFunctions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionFunctions
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionFunctions
$ctoConstr :: ChatCompletionFunctions -> Constr
toConstr :: ChatCompletionFunctions -> Constr
$cdataTypeOf :: ChatCompletionFunctions -> DataType
dataTypeOf :: ChatCompletionFunctions -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChatCompletionFunctions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChatCompletionFunctions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionFunctions)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionFunctions)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionFunctions -> ChatCompletionFunctions
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionFunctions -> ChatCompletionFunctions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctions
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctions
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctions
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionFunctions
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ChatCompletionFunctions -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ChatCompletionFunctions -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ChatCompletionFunctions -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ChatCompletionFunctions -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctions -> m ChatCompletionFunctions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctions -> m ChatCompletionFunctions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctions -> m ChatCompletionFunctions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctions -> m ChatCompletionFunctions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctions -> m ChatCompletionFunctions
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionFunctions -> m ChatCompletionFunctions
Data)

instance FromJSON ChatCompletionFunctions where
  parseJSON :: Value -> Parser ChatCompletionFunctions
parseJSON = Options -> Value -> Parser ChatCompletionFunctions
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionFunctions")
instance ToJSON ChatCompletionFunctions where
  toJSON :: ChatCompletionFunctions -> Value
toJSON = Options -> ChatCompletionFunctions -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionFunctions")


-- | 
data ChatCompletionMessageToolCall = ChatCompletionMessageToolCall
  { ChatCompletionMessageToolCall -> Text
chatCompletionMessageToolCallId :: Text -- ^ The ID of the tool call.
  , ChatCompletionMessageToolCall -> Text
chatCompletionMessageToolCallType :: Text -- ^ The type of the tool. Currently, only `function` is supported.
  , ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCallFunction
chatCompletionMessageToolCallFunction :: ChatCompletionMessageToolCallFunction -- ^ 
  } deriving (Int -> ChatCompletionMessageToolCall -> ShowS
[ChatCompletionMessageToolCall] -> ShowS
ChatCompletionMessageToolCall -> String
(Int -> ChatCompletionMessageToolCall -> ShowS)
-> (ChatCompletionMessageToolCall -> String)
-> ([ChatCompletionMessageToolCall] -> ShowS)
-> Show ChatCompletionMessageToolCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionMessageToolCall -> ShowS
showsPrec :: Int -> ChatCompletionMessageToolCall -> ShowS
$cshow :: ChatCompletionMessageToolCall -> String
show :: ChatCompletionMessageToolCall -> String
$cshowList :: [ChatCompletionMessageToolCall] -> ShowS
showList :: [ChatCompletionMessageToolCall] -> ShowS
Show, ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
(ChatCompletionMessageToolCall
 -> ChatCompletionMessageToolCall -> Bool)
-> (ChatCompletionMessageToolCall
    -> ChatCompletionMessageToolCall -> Bool)
-> Eq ChatCompletionMessageToolCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
== :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
$c/= :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
/= :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
Eq, Eq ChatCompletionMessageToolCall
Eq ChatCompletionMessageToolCall =>
(ChatCompletionMessageToolCall
 -> ChatCompletionMessageToolCall -> Ordering)
-> (ChatCompletionMessageToolCall
    -> ChatCompletionMessageToolCall -> Bool)
-> (ChatCompletionMessageToolCall
    -> ChatCompletionMessageToolCall -> Bool)
-> (ChatCompletionMessageToolCall
    -> ChatCompletionMessageToolCall -> Bool)
-> (ChatCompletionMessageToolCall
    -> ChatCompletionMessageToolCall -> Bool)
-> (ChatCompletionMessageToolCall
    -> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall)
-> (ChatCompletionMessageToolCall
    -> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall)
-> Ord ChatCompletionMessageToolCall
ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Ordering
ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Ordering
compare :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Ordering
$c< :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
< :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
$c<= :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
<= :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
$c> :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
> :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
$c>= :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
>= :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> Bool
$cmax :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall
max :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall
$cmin :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall
min :: ChatCompletionMessageToolCall
-> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall
Ord, (forall x.
 ChatCompletionMessageToolCall
 -> Rep ChatCompletionMessageToolCall x)
-> (forall x.
    Rep ChatCompletionMessageToolCall x
    -> ChatCompletionMessageToolCall)
-> Generic ChatCompletionMessageToolCall
forall x.
Rep ChatCompletionMessageToolCall x
-> ChatCompletionMessageToolCall
forall x.
ChatCompletionMessageToolCall
-> Rep ChatCompletionMessageToolCall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionMessageToolCall
-> Rep ChatCompletionMessageToolCall x
from :: forall x.
ChatCompletionMessageToolCall
-> Rep ChatCompletionMessageToolCall x
$cto :: forall x.
Rep ChatCompletionMessageToolCall x
-> ChatCompletionMessageToolCall
to :: forall x.
Rep ChatCompletionMessageToolCall x
-> ChatCompletionMessageToolCall
Generic, Typeable ChatCompletionMessageToolCall
Typeable ChatCompletionMessageToolCall =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionMessageToolCall
 -> c ChatCompletionMessageToolCall)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionMessageToolCall)
-> (ChatCompletionMessageToolCall -> Constr)
-> (ChatCompletionMessageToolCall -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionMessageToolCall))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionMessageToolCall))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionMessageToolCall
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionMessageToolCall
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionMessageToolCall -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionMessageToolCall
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCall
    -> m ChatCompletionMessageToolCall)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCall
    -> m ChatCompletionMessageToolCall)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCall
    -> m ChatCompletionMessageToolCall)
-> Data ChatCompletionMessageToolCall
ChatCompletionMessageToolCall -> Constr
ChatCompletionMessageToolCall -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCall
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCall -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCall
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCall
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCall -> m ChatCompletionMessageToolCall
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCall -> m ChatCompletionMessageToolCall
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCall
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCall
-> c ChatCompletionMessageToolCall
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCall)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCall)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCall
-> c ChatCompletionMessageToolCall
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCall
-> c ChatCompletionMessageToolCall
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCall
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCall
$ctoConstr :: ChatCompletionMessageToolCall -> Constr
toConstr :: ChatCompletionMessageToolCall -> Constr
$cdataTypeOf :: ChatCompletionMessageToolCall -> DataType
dataTypeOf :: ChatCompletionMessageToolCall -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCall)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCall)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCall)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCall)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionMessageToolCall -> ChatCompletionMessageToolCall
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCall
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCall
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCall
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCall
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCall -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCall -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCall
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCall
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCall -> m ChatCompletionMessageToolCall
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCall -> m ChatCompletionMessageToolCall
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCall -> m ChatCompletionMessageToolCall
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCall -> m ChatCompletionMessageToolCall
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCall -> m ChatCompletionMessageToolCall
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCall -> m ChatCompletionMessageToolCall
Data)

instance FromJSON ChatCompletionMessageToolCall where
  parseJSON :: Value -> Parser ChatCompletionMessageToolCall
parseJSON = Options -> Value -> Parser ChatCompletionMessageToolCall
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionMessageToolCall")
instance ToJSON ChatCompletionMessageToolCall where
  toJSON :: ChatCompletionMessageToolCall -> Value
toJSON = Options -> ChatCompletionMessageToolCall -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionMessageToolCall")


-- | 
data ChatCompletionMessageToolCallChunk = ChatCompletionMessageToolCallChunk
  { ChatCompletionMessageToolCallChunk -> Int
chatCompletionMessageToolCallChunkIndex :: Int -- ^ 
  , ChatCompletionMessageToolCallChunk -> Maybe Text
chatCompletionMessageToolCallChunkId :: Maybe Text -- ^ The ID of the tool call.
  , ChatCompletionMessageToolCallChunk -> Maybe Text
chatCompletionMessageToolCallChunkType :: Maybe Text -- ^ The type of the tool. Currently, only `function` is supported.
  , ChatCompletionMessageToolCallChunk
-> Maybe ChatCompletionMessageToolCallChunkFunction
chatCompletionMessageToolCallChunkFunction :: Maybe ChatCompletionMessageToolCallChunkFunction -- ^ 
  } deriving (Int -> ChatCompletionMessageToolCallChunk -> ShowS
[ChatCompletionMessageToolCallChunk] -> ShowS
ChatCompletionMessageToolCallChunk -> String
(Int -> ChatCompletionMessageToolCallChunk -> ShowS)
-> (ChatCompletionMessageToolCallChunk -> String)
-> ([ChatCompletionMessageToolCallChunk] -> ShowS)
-> Show ChatCompletionMessageToolCallChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionMessageToolCallChunk -> ShowS
showsPrec :: Int -> ChatCompletionMessageToolCallChunk -> ShowS
$cshow :: ChatCompletionMessageToolCallChunk -> String
show :: ChatCompletionMessageToolCallChunk -> String
$cshowList :: [ChatCompletionMessageToolCallChunk] -> ShowS
showList :: [ChatCompletionMessageToolCallChunk] -> ShowS
Show, ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
(ChatCompletionMessageToolCallChunk
 -> ChatCompletionMessageToolCallChunk -> Bool)
-> (ChatCompletionMessageToolCallChunk
    -> ChatCompletionMessageToolCallChunk -> Bool)
-> Eq ChatCompletionMessageToolCallChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
== :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
$c/= :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
/= :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
Eq, Eq ChatCompletionMessageToolCallChunk
Eq ChatCompletionMessageToolCallChunk =>
(ChatCompletionMessageToolCallChunk
 -> ChatCompletionMessageToolCallChunk -> Ordering)
-> (ChatCompletionMessageToolCallChunk
    -> ChatCompletionMessageToolCallChunk -> Bool)
-> (ChatCompletionMessageToolCallChunk
    -> ChatCompletionMessageToolCallChunk -> Bool)
-> (ChatCompletionMessageToolCallChunk
    -> ChatCompletionMessageToolCallChunk -> Bool)
-> (ChatCompletionMessageToolCallChunk
    -> ChatCompletionMessageToolCallChunk -> Bool)
-> (ChatCompletionMessageToolCallChunk
    -> ChatCompletionMessageToolCallChunk
    -> ChatCompletionMessageToolCallChunk)
-> (ChatCompletionMessageToolCallChunk
    -> ChatCompletionMessageToolCallChunk
    -> ChatCompletionMessageToolCallChunk)
-> Ord ChatCompletionMessageToolCallChunk
ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Ordering
ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Ordering
compare :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Ordering
$c< :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
< :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
$c<= :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
<= :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
$c> :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
> :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
$c>= :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
>= :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk -> Bool
$cmax :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
max :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
$cmin :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
min :: ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
Ord, (forall x.
 ChatCompletionMessageToolCallChunk
 -> Rep ChatCompletionMessageToolCallChunk x)
-> (forall x.
    Rep ChatCompletionMessageToolCallChunk x
    -> ChatCompletionMessageToolCallChunk)
-> Generic ChatCompletionMessageToolCallChunk
forall x.
Rep ChatCompletionMessageToolCallChunk x
-> ChatCompletionMessageToolCallChunk
forall x.
ChatCompletionMessageToolCallChunk
-> Rep ChatCompletionMessageToolCallChunk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionMessageToolCallChunk
-> Rep ChatCompletionMessageToolCallChunk x
from :: forall x.
ChatCompletionMessageToolCallChunk
-> Rep ChatCompletionMessageToolCallChunk x
$cto :: forall x.
Rep ChatCompletionMessageToolCallChunk x
-> ChatCompletionMessageToolCallChunk
to :: forall x.
Rep ChatCompletionMessageToolCallChunk x
-> ChatCompletionMessageToolCallChunk
Generic, Typeable ChatCompletionMessageToolCallChunk
Typeable ChatCompletionMessageToolCallChunk =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionMessageToolCallChunk
 -> c ChatCompletionMessageToolCallChunk)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionMessageToolCallChunk)
-> (ChatCompletionMessageToolCallChunk -> Constr)
-> (ChatCompletionMessageToolCallChunk -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionMessageToolCallChunk))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionMessageToolCallChunk))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionMessageToolCallChunk
    -> ChatCompletionMessageToolCallChunk)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionMessageToolCallChunk
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionMessageToolCallChunk
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionMessageToolCallChunk -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionMessageToolCallChunk
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCallChunk
    -> m ChatCompletionMessageToolCallChunk)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCallChunk
    -> m ChatCompletionMessageToolCallChunk)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCallChunk
    -> m ChatCompletionMessageToolCallChunk)
-> Data ChatCompletionMessageToolCallChunk
ChatCompletionMessageToolCallChunk -> Constr
ChatCompletionMessageToolCallChunk -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunk
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunk -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunk
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunk
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunk
-> m ChatCompletionMessageToolCallChunk
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunk
-> m ChatCompletionMessageToolCallChunk
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCallChunk
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCallChunk
-> c ChatCompletionMessageToolCallChunk
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCallChunk)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCallChunk)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCallChunk
-> c ChatCompletionMessageToolCallChunk
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCallChunk
-> c ChatCompletionMessageToolCallChunk
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCallChunk
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCallChunk
$ctoConstr :: ChatCompletionMessageToolCallChunk -> Constr
toConstr :: ChatCompletionMessageToolCallChunk -> Constr
$cdataTypeOf :: ChatCompletionMessageToolCallChunk -> DataType
dataTypeOf :: ChatCompletionMessageToolCallChunk -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCallChunk)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCallChunk)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCallChunk)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCallChunk)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionMessageToolCallChunk
-> ChatCompletionMessageToolCallChunk
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunk
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunk
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunk
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunk
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunk -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunk -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunk
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunk
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunk
-> m ChatCompletionMessageToolCallChunk
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunk
-> m ChatCompletionMessageToolCallChunk
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunk
-> m ChatCompletionMessageToolCallChunk
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunk
-> m ChatCompletionMessageToolCallChunk
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunk
-> m ChatCompletionMessageToolCallChunk
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunk
-> m ChatCompletionMessageToolCallChunk
Data)

instance FromJSON ChatCompletionMessageToolCallChunk where
  parseJSON :: Value -> Parser ChatCompletionMessageToolCallChunk
parseJSON = Options -> Value -> Parser ChatCompletionMessageToolCallChunk
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionMessageToolCallChunk")
instance ToJSON ChatCompletionMessageToolCallChunk where
  toJSON :: ChatCompletionMessageToolCallChunk -> Value
toJSON = Options -> ChatCompletionMessageToolCallChunk -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionMessageToolCallChunk")


-- | 
data ChatCompletionMessageToolCallChunkFunction = ChatCompletionMessageToolCallChunkFunction
  { ChatCompletionMessageToolCallChunkFunction -> Maybe Text
chatCompletionMessageToolCallChunkFunctionName :: Maybe Text -- ^ The name of the function to call.
  , ChatCompletionMessageToolCallChunkFunction -> Maybe Text
chatCompletionMessageToolCallChunkFunctionArguments :: Maybe Text -- ^ The arguments to call the function with, as generated by the model in JSON format. Note that the model does not always generate valid JSON, and may hallucinate parameters not defined by your function schema. Validate the arguments in your code before calling your function.
  } deriving (Int -> ChatCompletionMessageToolCallChunkFunction -> ShowS
[ChatCompletionMessageToolCallChunkFunction] -> ShowS
ChatCompletionMessageToolCallChunkFunction -> String
(Int -> ChatCompletionMessageToolCallChunkFunction -> ShowS)
-> (ChatCompletionMessageToolCallChunkFunction -> String)
-> ([ChatCompletionMessageToolCallChunkFunction] -> ShowS)
-> Show ChatCompletionMessageToolCallChunkFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionMessageToolCallChunkFunction -> ShowS
showsPrec :: Int -> ChatCompletionMessageToolCallChunkFunction -> ShowS
$cshow :: ChatCompletionMessageToolCallChunkFunction -> String
show :: ChatCompletionMessageToolCallChunkFunction -> String
$cshowList :: [ChatCompletionMessageToolCallChunkFunction] -> ShowS
showList :: [ChatCompletionMessageToolCallChunkFunction] -> ShowS
Show, ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
(ChatCompletionMessageToolCallChunkFunction
 -> ChatCompletionMessageToolCallChunkFunction -> Bool)
-> (ChatCompletionMessageToolCallChunkFunction
    -> ChatCompletionMessageToolCallChunkFunction -> Bool)
-> Eq ChatCompletionMessageToolCallChunkFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
== :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
$c/= :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
/= :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
Eq, Eq ChatCompletionMessageToolCallChunkFunction
Eq ChatCompletionMessageToolCallChunkFunction =>
(ChatCompletionMessageToolCallChunkFunction
 -> ChatCompletionMessageToolCallChunkFunction -> Ordering)
-> (ChatCompletionMessageToolCallChunkFunction
    -> ChatCompletionMessageToolCallChunkFunction -> Bool)
-> (ChatCompletionMessageToolCallChunkFunction
    -> ChatCompletionMessageToolCallChunkFunction -> Bool)
-> (ChatCompletionMessageToolCallChunkFunction
    -> ChatCompletionMessageToolCallChunkFunction -> Bool)
-> (ChatCompletionMessageToolCallChunkFunction
    -> ChatCompletionMessageToolCallChunkFunction -> Bool)
-> (ChatCompletionMessageToolCallChunkFunction
    -> ChatCompletionMessageToolCallChunkFunction
    -> ChatCompletionMessageToolCallChunkFunction)
-> (ChatCompletionMessageToolCallChunkFunction
    -> ChatCompletionMessageToolCallChunkFunction
    -> ChatCompletionMessageToolCallChunkFunction)
-> Ord ChatCompletionMessageToolCallChunkFunction
ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Ordering
ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Ordering
compare :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Ordering
$c< :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
< :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
$c<= :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
<= :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
$c> :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
> :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
$c>= :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
>= :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction -> Bool
$cmax :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
max :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
$cmin :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
min :: ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
Ord, (forall x.
 ChatCompletionMessageToolCallChunkFunction
 -> Rep ChatCompletionMessageToolCallChunkFunction x)
-> (forall x.
    Rep ChatCompletionMessageToolCallChunkFunction x
    -> ChatCompletionMessageToolCallChunkFunction)
-> Generic ChatCompletionMessageToolCallChunkFunction
forall x.
Rep ChatCompletionMessageToolCallChunkFunction x
-> ChatCompletionMessageToolCallChunkFunction
forall x.
ChatCompletionMessageToolCallChunkFunction
-> Rep ChatCompletionMessageToolCallChunkFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionMessageToolCallChunkFunction
-> Rep ChatCompletionMessageToolCallChunkFunction x
from :: forall x.
ChatCompletionMessageToolCallChunkFunction
-> Rep ChatCompletionMessageToolCallChunkFunction x
$cto :: forall x.
Rep ChatCompletionMessageToolCallChunkFunction x
-> ChatCompletionMessageToolCallChunkFunction
to :: forall x.
Rep ChatCompletionMessageToolCallChunkFunction x
-> ChatCompletionMessageToolCallChunkFunction
Generic, Typeable ChatCompletionMessageToolCallChunkFunction
Typeable ChatCompletionMessageToolCallChunkFunction =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionMessageToolCallChunkFunction
 -> c ChatCompletionMessageToolCallChunkFunction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionMessageToolCallChunkFunction)
-> (ChatCompletionMessageToolCallChunkFunction -> Constr)
-> (ChatCompletionMessageToolCallChunkFunction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionMessageToolCallChunkFunction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionMessageToolCallChunkFunction))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionMessageToolCallChunkFunction
    -> ChatCompletionMessageToolCallChunkFunction)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionMessageToolCallChunkFunction
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionMessageToolCallChunkFunction
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionMessageToolCallChunkFunction -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionMessageToolCallChunkFunction
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCallChunkFunction
    -> m ChatCompletionMessageToolCallChunkFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCallChunkFunction
    -> m ChatCompletionMessageToolCallChunkFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCallChunkFunction
    -> m ChatCompletionMessageToolCallChunkFunction)
-> Data ChatCompletionMessageToolCallChunkFunction
ChatCompletionMessageToolCallChunkFunction -> Constr
ChatCompletionMessageToolCallChunkFunction -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunkFunction
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunkFunction -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunkFunction
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunkFunction
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunkFunction
-> m ChatCompletionMessageToolCallChunkFunction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunkFunction
-> m ChatCompletionMessageToolCallChunkFunction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCallChunkFunction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCallChunkFunction
-> c ChatCompletionMessageToolCallChunkFunction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCallChunkFunction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCallChunkFunction)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCallChunkFunction
-> c ChatCompletionMessageToolCallChunkFunction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCallChunkFunction
-> c ChatCompletionMessageToolCallChunkFunction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCallChunkFunction
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCallChunkFunction
$ctoConstr :: ChatCompletionMessageToolCallChunkFunction -> Constr
toConstr :: ChatCompletionMessageToolCallChunkFunction -> Constr
$cdataTypeOf :: ChatCompletionMessageToolCallChunkFunction -> DataType
dataTypeOf :: ChatCompletionMessageToolCallChunkFunction -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCallChunkFunction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCallChunkFunction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCallChunkFunction)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCallChunkFunction)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionMessageToolCallChunkFunction
-> ChatCompletionMessageToolCallChunkFunction
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunkFunction
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunkFunction
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunkFunction
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallChunkFunction
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunkFunction -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunkFunction -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunkFunction
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallChunkFunction
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunkFunction
-> m ChatCompletionMessageToolCallChunkFunction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunkFunction
-> m ChatCompletionMessageToolCallChunkFunction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunkFunction
-> m ChatCompletionMessageToolCallChunkFunction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunkFunction
-> m ChatCompletionMessageToolCallChunkFunction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunkFunction
-> m ChatCompletionMessageToolCallChunkFunction
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallChunkFunction
-> m ChatCompletionMessageToolCallChunkFunction
Data)

instance FromJSON ChatCompletionMessageToolCallChunkFunction where
  parseJSON :: Value -> Parser ChatCompletionMessageToolCallChunkFunction
parseJSON = Options
-> Value -> Parser ChatCompletionMessageToolCallChunkFunction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionMessageToolCallChunkFunction")
instance ToJSON ChatCompletionMessageToolCallChunkFunction where
  toJSON :: ChatCompletionMessageToolCallChunkFunction -> Value
toJSON = Options -> ChatCompletionMessageToolCallChunkFunction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionMessageToolCallChunkFunction")


-- | The function that the model called.
data ChatCompletionMessageToolCallFunction = ChatCompletionMessageToolCallFunction
  { ChatCompletionMessageToolCallFunction -> Text
chatCompletionMessageToolCallFunctionName :: Text -- ^ The name of the function to call.
  , ChatCompletionMessageToolCallFunction -> Text
chatCompletionMessageToolCallFunctionArguments :: Text -- ^ The arguments to call the function with, as generated by the model in JSON format. Note that the model does not always generate valid JSON, and may hallucinate parameters not defined by your function schema. Validate the arguments in your code before calling your function.
  } deriving (Int -> ChatCompletionMessageToolCallFunction -> ShowS
[ChatCompletionMessageToolCallFunction] -> ShowS
ChatCompletionMessageToolCallFunction -> String
(Int -> ChatCompletionMessageToolCallFunction -> ShowS)
-> (ChatCompletionMessageToolCallFunction -> String)
-> ([ChatCompletionMessageToolCallFunction] -> ShowS)
-> Show ChatCompletionMessageToolCallFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionMessageToolCallFunction -> ShowS
showsPrec :: Int -> ChatCompletionMessageToolCallFunction -> ShowS
$cshow :: ChatCompletionMessageToolCallFunction -> String
show :: ChatCompletionMessageToolCallFunction -> String
$cshowList :: [ChatCompletionMessageToolCallFunction] -> ShowS
showList :: [ChatCompletionMessageToolCallFunction] -> ShowS
Show, ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
(ChatCompletionMessageToolCallFunction
 -> ChatCompletionMessageToolCallFunction -> Bool)
-> (ChatCompletionMessageToolCallFunction
    -> ChatCompletionMessageToolCallFunction -> Bool)
-> Eq ChatCompletionMessageToolCallFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
== :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
$c/= :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
/= :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
Eq, Eq ChatCompletionMessageToolCallFunction
Eq ChatCompletionMessageToolCallFunction =>
(ChatCompletionMessageToolCallFunction
 -> ChatCompletionMessageToolCallFunction -> Ordering)
-> (ChatCompletionMessageToolCallFunction
    -> ChatCompletionMessageToolCallFunction -> Bool)
-> (ChatCompletionMessageToolCallFunction
    -> ChatCompletionMessageToolCallFunction -> Bool)
-> (ChatCompletionMessageToolCallFunction
    -> ChatCompletionMessageToolCallFunction -> Bool)
-> (ChatCompletionMessageToolCallFunction
    -> ChatCompletionMessageToolCallFunction -> Bool)
-> (ChatCompletionMessageToolCallFunction
    -> ChatCompletionMessageToolCallFunction
    -> ChatCompletionMessageToolCallFunction)
-> (ChatCompletionMessageToolCallFunction
    -> ChatCompletionMessageToolCallFunction
    -> ChatCompletionMessageToolCallFunction)
-> Ord ChatCompletionMessageToolCallFunction
ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Ordering
ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Ordering
compare :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Ordering
$c< :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
< :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
$c<= :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
<= :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
$c> :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
> :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
$c>= :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
>= :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction -> Bool
$cmax :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
max :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
$cmin :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
min :: ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
Ord, (forall x.
 ChatCompletionMessageToolCallFunction
 -> Rep ChatCompletionMessageToolCallFunction x)
-> (forall x.
    Rep ChatCompletionMessageToolCallFunction x
    -> ChatCompletionMessageToolCallFunction)
-> Generic ChatCompletionMessageToolCallFunction
forall x.
Rep ChatCompletionMessageToolCallFunction x
-> ChatCompletionMessageToolCallFunction
forall x.
ChatCompletionMessageToolCallFunction
-> Rep ChatCompletionMessageToolCallFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionMessageToolCallFunction
-> Rep ChatCompletionMessageToolCallFunction x
from :: forall x.
ChatCompletionMessageToolCallFunction
-> Rep ChatCompletionMessageToolCallFunction x
$cto :: forall x.
Rep ChatCompletionMessageToolCallFunction x
-> ChatCompletionMessageToolCallFunction
to :: forall x.
Rep ChatCompletionMessageToolCallFunction x
-> ChatCompletionMessageToolCallFunction
Generic, Typeable ChatCompletionMessageToolCallFunction
Typeable ChatCompletionMessageToolCallFunction =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionMessageToolCallFunction
 -> c ChatCompletionMessageToolCallFunction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionMessageToolCallFunction)
-> (ChatCompletionMessageToolCallFunction -> Constr)
-> (ChatCompletionMessageToolCallFunction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionMessageToolCallFunction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionMessageToolCallFunction))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionMessageToolCallFunction
    -> ChatCompletionMessageToolCallFunction)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionMessageToolCallFunction
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionMessageToolCallFunction
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionMessageToolCallFunction -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionMessageToolCallFunction
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCallFunction
    -> m ChatCompletionMessageToolCallFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCallFunction
    -> m ChatCompletionMessageToolCallFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionMessageToolCallFunction
    -> m ChatCompletionMessageToolCallFunction)
-> Data ChatCompletionMessageToolCallFunction
ChatCompletionMessageToolCallFunction -> Constr
ChatCompletionMessageToolCallFunction -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallFunction
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallFunction -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallFunction
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallFunction
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallFunction
-> m ChatCompletionMessageToolCallFunction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallFunction
-> m ChatCompletionMessageToolCallFunction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCallFunction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCallFunction
-> c ChatCompletionMessageToolCallFunction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCallFunction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCallFunction)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCallFunction
-> c ChatCompletionMessageToolCallFunction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionMessageToolCallFunction
-> c ChatCompletionMessageToolCallFunction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCallFunction
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionMessageToolCallFunction
$ctoConstr :: ChatCompletionMessageToolCallFunction -> Constr
toConstr :: ChatCompletionMessageToolCallFunction -> Constr
$cdataTypeOf :: ChatCompletionMessageToolCallFunction -> DataType
dataTypeOf :: ChatCompletionMessageToolCallFunction -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCallFunction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionMessageToolCallFunction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCallFunction)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionMessageToolCallFunction)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionMessageToolCallFunction
-> ChatCompletionMessageToolCallFunction
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallFunction
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallFunction
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallFunction
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionMessageToolCallFunction
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallFunction -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallFunction -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallFunction
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionMessageToolCallFunction
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallFunction
-> m ChatCompletionMessageToolCallFunction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallFunction
-> m ChatCompletionMessageToolCallFunction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallFunction
-> m ChatCompletionMessageToolCallFunction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallFunction
-> m ChatCompletionMessageToolCallFunction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallFunction
-> m ChatCompletionMessageToolCallFunction
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionMessageToolCallFunction
-> m ChatCompletionMessageToolCallFunction
Data)

instance FromJSON ChatCompletionMessageToolCallFunction where
  parseJSON :: Value -> Parser ChatCompletionMessageToolCallFunction
parseJSON = Options -> Value -> Parser ChatCompletionMessageToolCallFunction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionMessageToolCallFunction")
instance ToJSON ChatCompletionMessageToolCallFunction where
  toJSON :: ChatCompletionMessageToolCallFunction -> Value
toJSON = Options -> ChatCompletionMessageToolCallFunction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionMessageToolCallFunction")


-- | Specifies a tool the model should use. Use to force the model to call a specific function.
data ChatCompletionNamedToolChoice = ChatCompletionNamedToolChoice
  { ChatCompletionNamedToolChoice -> Text
chatCompletionNamedToolChoiceType :: Text -- ^ The type of the tool. Currently, only `function` is supported.
  , ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoiceFunction
chatCompletionNamedToolChoiceFunction :: ChatCompletionNamedToolChoiceFunction -- ^ 
  } deriving (Int -> ChatCompletionNamedToolChoice -> ShowS
[ChatCompletionNamedToolChoice] -> ShowS
ChatCompletionNamedToolChoice -> String
(Int -> ChatCompletionNamedToolChoice -> ShowS)
-> (ChatCompletionNamedToolChoice -> String)
-> ([ChatCompletionNamedToolChoice] -> ShowS)
-> Show ChatCompletionNamedToolChoice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionNamedToolChoice -> ShowS
showsPrec :: Int -> ChatCompletionNamedToolChoice -> ShowS
$cshow :: ChatCompletionNamedToolChoice -> String
show :: ChatCompletionNamedToolChoice -> String
$cshowList :: [ChatCompletionNamedToolChoice] -> ShowS
showList :: [ChatCompletionNamedToolChoice] -> ShowS
Show, ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
(ChatCompletionNamedToolChoice
 -> ChatCompletionNamedToolChoice -> Bool)
-> (ChatCompletionNamedToolChoice
    -> ChatCompletionNamedToolChoice -> Bool)
-> Eq ChatCompletionNamedToolChoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
== :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
$c/= :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
/= :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
Eq, Eq ChatCompletionNamedToolChoice
Eq ChatCompletionNamedToolChoice =>
(ChatCompletionNamedToolChoice
 -> ChatCompletionNamedToolChoice -> Ordering)
-> (ChatCompletionNamedToolChoice
    -> ChatCompletionNamedToolChoice -> Bool)
-> (ChatCompletionNamedToolChoice
    -> ChatCompletionNamedToolChoice -> Bool)
-> (ChatCompletionNamedToolChoice
    -> ChatCompletionNamedToolChoice -> Bool)
-> (ChatCompletionNamedToolChoice
    -> ChatCompletionNamedToolChoice -> Bool)
-> (ChatCompletionNamedToolChoice
    -> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice)
-> (ChatCompletionNamedToolChoice
    -> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice)
-> Ord ChatCompletionNamedToolChoice
ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Ordering
ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Ordering
compare :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Ordering
$c< :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
< :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
$c<= :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
<= :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
$c> :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
> :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
$c>= :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
>= :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> Bool
$cmax :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice
max :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice
$cmin :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice
min :: ChatCompletionNamedToolChoice
-> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice
Ord, (forall x.
 ChatCompletionNamedToolChoice
 -> Rep ChatCompletionNamedToolChoice x)
-> (forall x.
    Rep ChatCompletionNamedToolChoice x
    -> ChatCompletionNamedToolChoice)
-> Generic ChatCompletionNamedToolChoice
forall x.
Rep ChatCompletionNamedToolChoice x
-> ChatCompletionNamedToolChoice
forall x.
ChatCompletionNamedToolChoice
-> Rep ChatCompletionNamedToolChoice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionNamedToolChoice
-> Rep ChatCompletionNamedToolChoice x
from :: forall x.
ChatCompletionNamedToolChoice
-> Rep ChatCompletionNamedToolChoice x
$cto :: forall x.
Rep ChatCompletionNamedToolChoice x
-> ChatCompletionNamedToolChoice
to :: forall x.
Rep ChatCompletionNamedToolChoice x
-> ChatCompletionNamedToolChoice
Generic, Typeable ChatCompletionNamedToolChoice
Typeable ChatCompletionNamedToolChoice =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionNamedToolChoice
 -> c ChatCompletionNamedToolChoice)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionNamedToolChoice)
-> (ChatCompletionNamedToolChoice -> Constr)
-> (ChatCompletionNamedToolChoice -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionNamedToolChoice))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionNamedToolChoice))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionNamedToolChoice
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionNamedToolChoice
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionNamedToolChoice -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionNamedToolChoice
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionNamedToolChoice
    -> m ChatCompletionNamedToolChoice)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionNamedToolChoice
    -> m ChatCompletionNamedToolChoice)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionNamedToolChoice
    -> m ChatCompletionNamedToolChoice)
-> Data ChatCompletionNamedToolChoice
ChatCompletionNamedToolChoice -> Constr
ChatCompletionNamedToolChoice -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoice
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoice -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoice
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoice
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoice -> m ChatCompletionNamedToolChoice
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoice -> m ChatCompletionNamedToolChoice
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionNamedToolChoice
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionNamedToolChoice
-> c ChatCompletionNamedToolChoice
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionNamedToolChoice)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionNamedToolChoice)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionNamedToolChoice
-> c ChatCompletionNamedToolChoice
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionNamedToolChoice
-> c ChatCompletionNamedToolChoice
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionNamedToolChoice
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionNamedToolChoice
$ctoConstr :: ChatCompletionNamedToolChoice -> Constr
toConstr :: ChatCompletionNamedToolChoice -> Constr
$cdataTypeOf :: ChatCompletionNamedToolChoice -> DataType
dataTypeOf :: ChatCompletionNamedToolChoice -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionNamedToolChoice)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionNamedToolChoice)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionNamedToolChoice)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionNamedToolChoice)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionNamedToolChoice -> ChatCompletionNamedToolChoice
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoice
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoice
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoice
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoice
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoice -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoice -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoice
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoice
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoice -> m ChatCompletionNamedToolChoice
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoice -> m ChatCompletionNamedToolChoice
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoice -> m ChatCompletionNamedToolChoice
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoice -> m ChatCompletionNamedToolChoice
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoice -> m ChatCompletionNamedToolChoice
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoice -> m ChatCompletionNamedToolChoice
Data)

instance FromJSON ChatCompletionNamedToolChoice where
  parseJSON :: Value -> Parser ChatCompletionNamedToolChoice
parseJSON = Options -> Value -> Parser ChatCompletionNamedToolChoice
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionNamedToolChoice")
instance ToJSON ChatCompletionNamedToolChoice where
  toJSON :: ChatCompletionNamedToolChoice -> Value
toJSON = Options -> ChatCompletionNamedToolChoice -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionNamedToolChoice")


-- | 
data ChatCompletionNamedToolChoiceFunction = ChatCompletionNamedToolChoiceFunction
  { ChatCompletionNamedToolChoiceFunction -> Text
chatCompletionNamedToolChoiceFunctionName :: Text -- ^ The name of the function to call.
  } deriving (Int -> ChatCompletionNamedToolChoiceFunction -> ShowS
[ChatCompletionNamedToolChoiceFunction] -> ShowS
ChatCompletionNamedToolChoiceFunction -> String
(Int -> ChatCompletionNamedToolChoiceFunction -> ShowS)
-> (ChatCompletionNamedToolChoiceFunction -> String)
-> ([ChatCompletionNamedToolChoiceFunction] -> ShowS)
-> Show ChatCompletionNamedToolChoiceFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionNamedToolChoiceFunction -> ShowS
showsPrec :: Int -> ChatCompletionNamedToolChoiceFunction -> ShowS
$cshow :: ChatCompletionNamedToolChoiceFunction -> String
show :: ChatCompletionNamedToolChoiceFunction -> String
$cshowList :: [ChatCompletionNamedToolChoiceFunction] -> ShowS
showList :: [ChatCompletionNamedToolChoiceFunction] -> ShowS
Show, ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
(ChatCompletionNamedToolChoiceFunction
 -> ChatCompletionNamedToolChoiceFunction -> Bool)
-> (ChatCompletionNamedToolChoiceFunction
    -> ChatCompletionNamedToolChoiceFunction -> Bool)
-> Eq ChatCompletionNamedToolChoiceFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
== :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
$c/= :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
/= :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
Eq, Eq ChatCompletionNamedToolChoiceFunction
Eq ChatCompletionNamedToolChoiceFunction =>
(ChatCompletionNamedToolChoiceFunction
 -> ChatCompletionNamedToolChoiceFunction -> Ordering)
-> (ChatCompletionNamedToolChoiceFunction
    -> ChatCompletionNamedToolChoiceFunction -> Bool)
-> (ChatCompletionNamedToolChoiceFunction
    -> ChatCompletionNamedToolChoiceFunction -> Bool)
-> (ChatCompletionNamedToolChoiceFunction
    -> ChatCompletionNamedToolChoiceFunction -> Bool)
-> (ChatCompletionNamedToolChoiceFunction
    -> ChatCompletionNamedToolChoiceFunction -> Bool)
-> (ChatCompletionNamedToolChoiceFunction
    -> ChatCompletionNamedToolChoiceFunction
    -> ChatCompletionNamedToolChoiceFunction)
-> (ChatCompletionNamedToolChoiceFunction
    -> ChatCompletionNamedToolChoiceFunction
    -> ChatCompletionNamedToolChoiceFunction)
-> Ord ChatCompletionNamedToolChoiceFunction
ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Ordering
ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Ordering
compare :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Ordering
$c< :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
< :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
$c<= :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
<= :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
$c> :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
> :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
$c>= :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
>= :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction -> Bool
$cmax :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
max :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
$cmin :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
min :: ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
Ord, (forall x.
 ChatCompletionNamedToolChoiceFunction
 -> Rep ChatCompletionNamedToolChoiceFunction x)
-> (forall x.
    Rep ChatCompletionNamedToolChoiceFunction x
    -> ChatCompletionNamedToolChoiceFunction)
-> Generic ChatCompletionNamedToolChoiceFunction
forall x.
Rep ChatCompletionNamedToolChoiceFunction x
-> ChatCompletionNamedToolChoiceFunction
forall x.
ChatCompletionNamedToolChoiceFunction
-> Rep ChatCompletionNamedToolChoiceFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionNamedToolChoiceFunction
-> Rep ChatCompletionNamedToolChoiceFunction x
from :: forall x.
ChatCompletionNamedToolChoiceFunction
-> Rep ChatCompletionNamedToolChoiceFunction x
$cto :: forall x.
Rep ChatCompletionNamedToolChoiceFunction x
-> ChatCompletionNamedToolChoiceFunction
to :: forall x.
Rep ChatCompletionNamedToolChoiceFunction x
-> ChatCompletionNamedToolChoiceFunction
Generic, Typeable ChatCompletionNamedToolChoiceFunction
Typeable ChatCompletionNamedToolChoiceFunction =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionNamedToolChoiceFunction
 -> c ChatCompletionNamedToolChoiceFunction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionNamedToolChoiceFunction)
-> (ChatCompletionNamedToolChoiceFunction -> Constr)
-> (ChatCompletionNamedToolChoiceFunction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionNamedToolChoiceFunction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionNamedToolChoiceFunction))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionNamedToolChoiceFunction
    -> ChatCompletionNamedToolChoiceFunction)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionNamedToolChoiceFunction
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionNamedToolChoiceFunction
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionNamedToolChoiceFunction -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionNamedToolChoiceFunction
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionNamedToolChoiceFunction
    -> m ChatCompletionNamedToolChoiceFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionNamedToolChoiceFunction
    -> m ChatCompletionNamedToolChoiceFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionNamedToolChoiceFunction
    -> m ChatCompletionNamedToolChoiceFunction)
-> Data ChatCompletionNamedToolChoiceFunction
ChatCompletionNamedToolChoiceFunction -> Constr
ChatCompletionNamedToolChoiceFunction -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoiceFunction
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoiceFunction -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoiceFunction
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoiceFunction
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoiceFunction
-> m ChatCompletionNamedToolChoiceFunction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoiceFunction
-> m ChatCompletionNamedToolChoiceFunction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionNamedToolChoiceFunction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionNamedToolChoiceFunction
-> c ChatCompletionNamedToolChoiceFunction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionNamedToolChoiceFunction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionNamedToolChoiceFunction)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionNamedToolChoiceFunction
-> c ChatCompletionNamedToolChoiceFunction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionNamedToolChoiceFunction
-> c ChatCompletionNamedToolChoiceFunction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionNamedToolChoiceFunction
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionNamedToolChoiceFunction
$ctoConstr :: ChatCompletionNamedToolChoiceFunction -> Constr
toConstr :: ChatCompletionNamedToolChoiceFunction -> Constr
$cdataTypeOf :: ChatCompletionNamedToolChoiceFunction -> DataType
dataTypeOf :: ChatCompletionNamedToolChoiceFunction -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionNamedToolChoiceFunction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionNamedToolChoiceFunction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionNamedToolChoiceFunction)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionNamedToolChoiceFunction)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionNamedToolChoiceFunction
-> ChatCompletionNamedToolChoiceFunction
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoiceFunction
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoiceFunction
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoiceFunction
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionNamedToolChoiceFunction
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoiceFunction -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoiceFunction -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoiceFunction
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionNamedToolChoiceFunction
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoiceFunction
-> m ChatCompletionNamedToolChoiceFunction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoiceFunction
-> m ChatCompletionNamedToolChoiceFunction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoiceFunction
-> m ChatCompletionNamedToolChoiceFunction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoiceFunction
-> m ChatCompletionNamedToolChoiceFunction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoiceFunction
-> m ChatCompletionNamedToolChoiceFunction
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionNamedToolChoiceFunction
-> m ChatCompletionNamedToolChoiceFunction
Data)

instance FromJSON ChatCompletionNamedToolChoiceFunction where
  parseJSON :: Value -> Parser ChatCompletionNamedToolChoiceFunction
parseJSON = Options -> Value -> Parser ChatCompletionNamedToolChoiceFunction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionNamedToolChoiceFunction")
instance ToJSON ChatCompletionNamedToolChoiceFunction where
  toJSON :: ChatCompletionNamedToolChoiceFunction -> Value
toJSON = Options -> ChatCompletionNamedToolChoiceFunction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionNamedToolChoiceFunction")


-- | 
data ChatCompletionRequestAssistantMessage = ChatCompletionRequestAssistantMessage
  { ChatCompletionRequestAssistantMessage -> Maybe Text
chatCompletionRequestAssistantMessageContent :: Maybe Text -- ^ The contents of the assistant message. Required unless `tool_calls` or `function_call` is specified. 
  , ChatCompletionRequestAssistantMessage -> Text
chatCompletionRequestAssistantMessageRole :: Text -- ^ The role of the messages author, in this case `assistant`.
  , ChatCompletionRequestAssistantMessage -> Maybe Text
chatCompletionRequestAssistantMessageName :: Maybe Text -- ^ An optional name for the participant. Provides the model information to differentiate between participants of the same role.
  , ChatCompletionRequestAssistantMessage
-> Maybe [ChatCompletionMessageToolCall]
chatCompletionRequestAssistantMessageToolUnderscorecalls :: Maybe [ChatCompletionMessageToolCall] -- ^ The tool calls generated by the model, such as function calls.
  , ChatCompletionRequestAssistantMessage
-> Maybe ChatCompletionRequestAssistantMessageFunctionCall
chatCompletionRequestAssistantMessageFunctionUnderscorecall :: Maybe ChatCompletionRequestAssistantMessageFunctionCall -- ^ 
  } deriving (Int -> ChatCompletionRequestAssistantMessage -> ShowS
[ChatCompletionRequestAssistantMessage] -> ShowS
ChatCompletionRequestAssistantMessage -> String
(Int -> ChatCompletionRequestAssistantMessage -> ShowS)
-> (ChatCompletionRequestAssistantMessage -> String)
-> ([ChatCompletionRequestAssistantMessage] -> ShowS)
-> Show ChatCompletionRequestAssistantMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestAssistantMessage -> ShowS
showsPrec :: Int -> ChatCompletionRequestAssistantMessage -> ShowS
$cshow :: ChatCompletionRequestAssistantMessage -> String
show :: ChatCompletionRequestAssistantMessage -> String
$cshowList :: [ChatCompletionRequestAssistantMessage] -> ShowS
showList :: [ChatCompletionRequestAssistantMessage] -> ShowS
Show, ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
(ChatCompletionRequestAssistantMessage
 -> ChatCompletionRequestAssistantMessage -> Bool)
-> (ChatCompletionRequestAssistantMessage
    -> ChatCompletionRequestAssistantMessage -> Bool)
-> Eq ChatCompletionRequestAssistantMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
== :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
$c/= :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
/= :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
Eq, Eq ChatCompletionRequestAssistantMessage
Eq ChatCompletionRequestAssistantMessage =>
(ChatCompletionRequestAssistantMessage
 -> ChatCompletionRequestAssistantMessage -> Ordering)
-> (ChatCompletionRequestAssistantMessage
    -> ChatCompletionRequestAssistantMessage -> Bool)
-> (ChatCompletionRequestAssistantMessage
    -> ChatCompletionRequestAssistantMessage -> Bool)
-> (ChatCompletionRequestAssistantMessage
    -> ChatCompletionRequestAssistantMessage -> Bool)
-> (ChatCompletionRequestAssistantMessage
    -> ChatCompletionRequestAssistantMessage -> Bool)
-> (ChatCompletionRequestAssistantMessage
    -> ChatCompletionRequestAssistantMessage
    -> ChatCompletionRequestAssistantMessage)
-> (ChatCompletionRequestAssistantMessage
    -> ChatCompletionRequestAssistantMessage
    -> ChatCompletionRequestAssistantMessage)
-> Ord ChatCompletionRequestAssistantMessage
ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Ordering
ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Ordering
compare :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Ordering
$c< :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
< :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
$c<= :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
<= :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
$c> :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
> :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
$c>= :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
>= :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage -> Bool
$cmax :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
max :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
$cmin :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
min :: ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
Ord, (forall x.
 ChatCompletionRequestAssistantMessage
 -> Rep ChatCompletionRequestAssistantMessage x)
-> (forall x.
    Rep ChatCompletionRequestAssistantMessage x
    -> ChatCompletionRequestAssistantMessage)
-> Generic ChatCompletionRequestAssistantMessage
forall x.
Rep ChatCompletionRequestAssistantMessage x
-> ChatCompletionRequestAssistantMessage
forall x.
ChatCompletionRequestAssistantMessage
-> Rep ChatCompletionRequestAssistantMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestAssistantMessage
-> Rep ChatCompletionRequestAssistantMessage x
from :: forall x.
ChatCompletionRequestAssistantMessage
-> Rep ChatCompletionRequestAssistantMessage x
$cto :: forall x.
Rep ChatCompletionRequestAssistantMessage x
-> ChatCompletionRequestAssistantMessage
to :: forall x.
Rep ChatCompletionRequestAssistantMessage x
-> ChatCompletionRequestAssistantMessage
Generic, Typeable ChatCompletionRequestAssistantMessage
Typeable ChatCompletionRequestAssistantMessage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestAssistantMessage
 -> c ChatCompletionRequestAssistantMessage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestAssistantMessage)
-> (ChatCompletionRequestAssistantMessage -> Constr)
-> (ChatCompletionRequestAssistantMessage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestAssistantMessage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestAssistantMessage))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestAssistantMessage
    -> ChatCompletionRequestAssistantMessage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestAssistantMessage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestAssistantMessage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestAssistantMessage -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestAssistantMessage
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestAssistantMessage
    -> m ChatCompletionRequestAssistantMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestAssistantMessage
    -> m ChatCompletionRequestAssistantMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestAssistantMessage
    -> m ChatCompletionRequestAssistantMessage)
-> Data ChatCompletionRequestAssistantMessage
ChatCompletionRequestAssistantMessage -> Constr
ChatCompletionRequestAssistantMessage -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessage
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessage
-> m ChatCompletionRequestAssistantMessage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessage
-> m ChatCompletionRequestAssistantMessage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestAssistantMessage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestAssistantMessage
-> c ChatCompletionRequestAssistantMessage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestAssistantMessage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestAssistantMessage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestAssistantMessage
-> c ChatCompletionRequestAssistantMessage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestAssistantMessage
-> c ChatCompletionRequestAssistantMessage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestAssistantMessage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestAssistantMessage
$ctoConstr :: ChatCompletionRequestAssistantMessage -> Constr
toConstr :: ChatCompletionRequestAssistantMessage -> Constr
$cdataTypeOf :: ChatCompletionRequestAssistantMessage -> DataType
dataTypeOf :: ChatCompletionRequestAssistantMessage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestAssistantMessage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestAssistantMessage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestAssistantMessage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestAssistantMessage)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestAssistantMessage
-> ChatCompletionRequestAssistantMessage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessage -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessage
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessage
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessage
-> m ChatCompletionRequestAssistantMessage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessage
-> m ChatCompletionRequestAssistantMessage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessage
-> m ChatCompletionRequestAssistantMessage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessage
-> m ChatCompletionRequestAssistantMessage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessage
-> m ChatCompletionRequestAssistantMessage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessage
-> m ChatCompletionRequestAssistantMessage
Data)

instance FromJSON ChatCompletionRequestAssistantMessage where
  parseJSON :: Value -> Parser ChatCompletionRequestAssistantMessage
parseJSON = Options -> Value -> Parser ChatCompletionRequestAssistantMessage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestAssistantMessage")
instance ToJSON ChatCompletionRequestAssistantMessage where
  toJSON :: ChatCompletionRequestAssistantMessage -> Value
toJSON = Options -> ChatCompletionRequestAssistantMessage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestAssistantMessage")


-- | Deprecated and replaced by &#x60;tool_calls&#x60;. The name and arguments of a function that should be called, as generated by the model.
data ChatCompletionRequestAssistantMessageFunctionCall = ChatCompletionRequestAssistantMessageFunctionCall
  { ChatCompletionRequestAssistantMessageFunctionCall -> Text
chatCompletionRequestAssistantMessageFunctionCallArguments :: Text -- ^ The arguments to call the function with, as generated by the model in JSON format. Note that the model does not always generate valid JSON, and may hallucinate parameters not defined by your function schema. Validate the arguments in your code before calling your function.
  , ChatCompletionRequestAssistantMessageFunctionCall -> Text
chatCompletionRequestAssistantMessageFunctionCallName :: Text -- ^ The name of the function to call.
  } deriving (Int -> ChatCompletionRequestAssistantMessageFunctionCall -> ShowS
[ChatCompletionRequestAssistantMessageFunctionCall] -> ShowS
ChatCompletionRequestAssistantMessageFunctionCall -> String
(Int -> ChatCompletionRequestAssistantMessageFunctionCall -> ShowS)
-> (ChatCompletionRequestAssistantMessageFunctionCall -> String)
-> ([ChatCompletionRequestAssistantMessageFunctionCall] -> ShowS)
-> Show ChatCompletionRequestAssistantMessageFunctionCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestAssistantMessageFunctionCall -> ShowS
showsPrec :: Int -> ChatCompletionRequestAssistantMessageFunctionCall -> ShowS
$cshow :: ChatCompletionRequestAssistantMessageFunctionCall -> String
show :: ChatCompletionRequestAssistantMessageFunctionCall -> String
$cshowList :: [ChatCompletionRequestAssistantMessageFunctionCall] -> ShowS
showList :: [ChatCompletionRequestAssistantMessageFunctionCall] -> ShowS
Show, ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
(ChatCompletionRequestAssistantMessageFunctionCall
 -> ChatCompletionRequestAssistantMessageFunctionCall -> Bool)
-> (ChatCompletionRequestAssistantMessageFunctionCall
    -> ChatCompletionRequestAssistantMessageFunctionCall -> Bool)
-> Eq ChatCompletionRequestAssistantMessageFunctionCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
== :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
$c/= :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
/= :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
Eq, Eq ChatCompletionRequestAssistantMessageFunctionCall
Eq ChatCompletionRequestAssistantMessageFunctionCall =>
(ChatCompletionRequestAssistantMessageFunctionCall
 -> ChatCompletionRequestAssistantMessageFunctionCall -> Ordering)
-> (ChatCompletionRequestAssistantMessageFunctionCall
    -> ChatCompletionRequestAssistantMessageFunctionCall -> Bool)
-> (ChatCompletionRequestAssistantMessageFunctionCall
    -> ChatCompletionRequestAssistantMessageFunctionCall -> Bool)
-> (ChatCompletionRequestAssistantMessageFunctionCall
    -> ChatCompletionRequestAssistantMessageFunctionCall -> Bool)
-> (ChatCompletionRequestAssistantMessageFunctionCall
    -> ChatCompletionRequestAssistantMessageFunctionCall -> Bool)
-> (ChatCompletionRequestAssistantMessageFunctionCall
    -> ChatCompletionRequestAssistantMessageFunctionCall
    -> ChatCompletionRequestAssistantMessageFunctionCall)
-> (ChatCompletionRequestAssistantMessageFunctionCall
    -> ChatCompletionRequestAssistantMessageFunctionCall
    -> ChatCompletionRequestAssistantMessageFunctionCall)
-> Ord ChatCompletionRequestAssistantMessageFunctionCall
ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Ordering
ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Ordering
compare :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Ordering
$c< :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
< :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
$c<= :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
<= :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
$c> :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
> :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
$c>= :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
>= :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall -> Bool
$cmax :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
max :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
$cmin :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
min :: ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
Ord, (forall x.
 ChatCompletionRequestAssistantMessageFunctionCall
 -> Rep ChatCompletionRequestAssistantMessageFunctionCall x)
-> (forall x.
    Rep ChatCompletionRequestAssistantMessageFunctionCall x
    -> ChatCompletionRequestAssistantMessageFunctionCall)
-> Generic ChatCompletionRequestAssistantMessageFunctionCall
forall x.
Rep ChatCompletionRequestAssistantMessageFunctionCall x
-> ChatCompletionRequestAssistantMessageFunctionCall
forall x.
ChatCompletionRequestAssistantMessageFunctionCall
-> Rep ChatCompletionRequestAssistantMessageFunctionCall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestAssistantMessageFunctionCall
-> Rep ChatCompletionRequestAssistantMessageFunctionCall x
from :: forall x.
ChatCompletionRequestAssistantMessageFunctionCall
-> Rep ChatCompletionRequestAssistantMessageFunctionCall x
$cto :: forall x.
Rep ChatCompletionRequestAssistantMessageFunctionCall x
-> ChatCompletionRequestAssistantMessageFunctionCall
to :: forall x.
Rep ChatCompletionRequestAssistantMessageFunctionCall x
-> ChatCompletionRequestAssistantMessageFunctionCall
Generic, Typeable ChatCompletionRequestAssistantMessageFunctionCall
Typeable ChatCompletionRequestAssistantMessageFunctionCall =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestAssistantMessageFunctionCall
 -> c ChatCompletionRequestAssistantMessageFunctionCall)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestAssistantMessageFunctionCall)
-> (ChatCompletionRequestAssistantMessageFunctionCall -> Constr)
-> (ChatCompletionRequestAssistantMessageFunctionCall -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestAssistantMessageFunctionCall))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestAssistantMessageFunctionCall))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestAssistantMessageFunctionCall
    -> ChatCompletionRequestAssistantMessageFunctionCall)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestAssistantMessageFunctionCall
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestAssistantMessageFunctionCall
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestAssistantMessageFunctionCall -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestAssistantMessageFunctionCall
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestAssistantMessageFunctionCall
    -> m ChatCompletionRequestAssistantMessageFunctionCall)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestAssistantMessageFunctionCall
    -> m ChatCompletionRequestAssistantMessageFunctionCall)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestAssistantMessageFunctionCall
    -> m ChatCompletionRequestAssistantMessageFunctionCall)
-> Data ChatCompletionRequestAssistantMessageFunctionCall
ChatCompletionRequestAssistantMessageFunctionCall -> Constr
ChatCompletionRequestAssistantMessageFunctionCall -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessageFunctionCall -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessageFunctionCall
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessageFunctionCall
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> m ChatCompletionRequestAssistantMessageFunctionCall
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> m ChatCompletionRequestAssistantMessageFunctionCall
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestAssistantMessageFunctionCall
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> c ChatCompletionRequestAssistantMessageFunctionCall
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestAssistantMessageFunctionCall)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestAssistantMessageFunctionCall)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> c ChatCompletionRequestAssistantMessageFunctionCall
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> c ChatCompletionRequestAssistantMessageFunctionCall
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestAssistantMessageFunctionCall
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestAssistantMessageFunctionCall
$ctoConstr :: ChatCompletionRequestAssistantMessageFunctionCall -> Constr
toConstr :: ChatCompletionRequestAssistantMessageFunctionCall -> Constr
$cdataTypeOf :: ChatCompletionRequestAssistantMessageFunctionCall -> DataType
dataTypeOf :: ChatCompletionRequestAssistantMessageFunctionCall -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestAssistantMessageFunctionCall)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestAssistantMessageFunctionCall)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestAssistantMessageFunctionCall)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestAssistantMessageFunctionCall)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> ChatCompletionRequestAssistantMessageFunctionCall
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessageFunctionCall
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessageFunctionCall
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessageFunctionCall
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestAssistantMessageFunctionCall
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessageFunctionCall -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessageFunctionCall -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> m ChatCompletionRequestAssistantMessageFunctionCall
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> m ChatCompletionRequestAssistantMessageFunctionCall
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> m ChatCompletionRequestAssistantMessageFunctionCall
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> m ChatCompletionRequestAssistantMessageFunctionCall
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> m ChatCompletionRequestAssistantMessageFunctionCall
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestAssistantMessageFunctionCall
-> m ChatCompletionRequestAssistantMessageFunctionCall
Data)

instance FromJSON ChatCompletionRequestAssistantMessageFunctionCall where
  parseJSON :: Value -> Parser ChatCompletionRequestAssistantMessageFunctionCall
parseJSON = Options
-> Value
-> Parser ChatCompletionRequestAssistantMessageFunctionCall
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestAssistantMessageFunctionCall")
instance ToJSON ChatCompletionRequestAssistantMessageFunctionCall where
  toJSON :: ChatCompletionRequestAssistantMessageFunctionCall -> Value
toJSON = Options
-> ChatCompletionRequestAssistantMessageFunctionCall -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestAssistantMessageFunctionCall")


-- | 
data ChatCompletionRequestFunctionMessage = ChatCompletionRequestFunctionMessage
  { ChatCompletionRequestFunctionMessage -> Text
chatCompletionRequestFunctionMessageRole :: Text -- ^ The role of the messages author, in this case `function`.
  , ChatCompletionRequestFunctionMessage -> Text
chatCompletionRequestFunctionMessageContent :: Text -- ^ The contents of the function message.
  , ChatCompletionRequestFunctionMessage -> Text
chatCompletionRequestFunctionMessageName :: Text -- ^ The name of the function to call.
  } deriving (Int -> ChatCompletionRequestFunctionMessage -> ShowS
[ChatCompletionRequestFunctionMessage] -> ShowS
ChatCompletionRequestFunctionMessage -> String
(Int -> ChatCompletionRequestFunctionMessage -> ShowS)
-> (ChatCompletionRequestFunctionMessage -> String)
-> ([ChatCompletionRequestFunctionMessage] -> ShowS)
-> Show ChatCompletionRequestFunctionMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestFunctionMessage -> ShowS
showsPrec :: Int -> ChatCompletionRequestFunctionMessage -> ShowS
$cshow :: ChatCompletionRequestFunctionMessage -> String
show :: ChatCompletionRequestFunctionMessage -> String
$cshowList :: [ChatCompletionRequestFunctionMessage] -> ShowS
showList :: [ChatCompletionRequestFunctionMessage] -> ShowS
Show, ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
(ChatCompletionRequestFunctionMessage
 -> ChatCompletionRequestFunctionMessage -> Bool)
-> (ChatCompletionRequestFunctionMessage
    -> ChatCompletionRequestFunctionMessage -> Bool)
-> Eq ChatCompletionRequestFunctionMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
== :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
$c/= :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
/= :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
Eq, Eq ChatCompletionRequestFunctionMessage
Eq ChatCompletionRequestFunctionMessage =>
(ChatCompletionRequestFunctionMessage
 -> ChatCompletionRequestFunctionMessage -> Ordering)
-> (ChatCompletionRequestFunctionMessage
    -> ChatCompletionRequestFunctionMessage -> Bool)
-> (ChatCompletionRequestFunctionMessage
    -> ChatCompletionRequestFunctionMessage -> Bool)
-> (ChatCompletionRequestFunctionMessage
    -> ChatCompletionRequestFunctionMessage -> Bool)
-> (ChatCompletionRequestFunctionMessage
    -> ChatCompletionRequestFunctionMessage -> Bool)
-> (ChatCompletionRequestFunctionMessage
    -> ChatCompletionRequestFunctionMessage
    -> ChatCompletionRequestFunctionMessage)
-> (ChatCompletionRequestFunctionMessage
    -> ChatCompletionRequestFunctionMessage
    -> ChatCompletionRequestFunctionMessage)
-> Ord ChatCompletionRequestFunctionMessage
ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Ordering
ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Ordering
compare :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Ordering
$c< :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
< :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
$c<= :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
<= :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
$c> :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
> :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
$c>= :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
>= :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage -> Bool
$cmax :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
max :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
$cmin :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
min :: ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
Ord, (forall x.
 ChatCompletionRequestFunctionMessage
 -> Rep ChatCompletionRequestFunctionMessage x)
-> (forall x.
    Rep ChatCompletionRequestFunctionMessage x
    -> ChatCompletionRequestFunctionMessage)
-> Generic ChatCompletionRequestFunctionMessage
forall x.
Rep ChatCompletionRequestFunctionMessage x
-> ChatCompletionRequestFunctionMessage
forall x.
ChatCompletionRequestFunctionMessage
-> Rep ChatCompletionRequestFunctionMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestFunctionMessage
-> Rep ChatCompletionRequestFunctionMessage x
from :: forall x.
ChatCompletionRequestFunctionMessage
-> Rep ChatCompletionRequestFunctionMessage x
$cto :: forall x.
Rep ChatCompletionRequestFunctionMessage x
-> ChatCompletionRequestFunctionMessage
to :: forall x.
Rep ChatCompletionRequestFunctionMessage x
-> ChatCompletionRequestFunctionMessage
Generic, Typeable ChatCompletionRequestFunctionMessage
Typeable ChatCompletionRequestFunctionMessage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestFunctionMessage
 -> c ChatCompletionRequestFunctionMessage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestFunctionMessage)
-> (ChatCompletionRequestFunctionMessage -> Constr)
-> (ChatCompletionRequestFunctionMessage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestFunctionMessage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestFunctionMessage))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestFunctionMessage
    -> ChatCompletionRequestFunctionMessage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestFunctionMessage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestFunctionMessage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestFunctionMessage -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestFunctionMessage
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestFunctionMessage
    -> m ChatCompletionRequestFunctionMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestFunctionMessage
    -> m ChatCompletionRequestFunctionMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestFunctionMessage
    -> m ChatCompletionRequestFunctionMessage)
-> Data ChatCompletionRequestFunctionMessage
ChatCompletionRequestFunctionMessage -> Constr
ChatCompletionRequestFunctionMessage -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestFunctionMessage
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestFunctionMessage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestFunctionMessage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestFunctionMessage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestFunctionMessage
-> m ChatCompletionRequestFunctionMessage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestFunctionMessage
-> m ChatCompletionRequestFunctionMessage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestFunctionMessage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestFunctionMessage
-> c ChatCompletionRequestFunctionMessage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestFunctionMessage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestFunctionMessage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestFunctionMessage
-> c ChatCompletionRequestFunctionMessage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestFunctionMessage
-> c ChatCompletionRequestFunctionMessage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestFunctionMessage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestFunctionMessage
$ctoConstr :: ChatCompletionRequestFunctionMessage -> Constr
toConstr :: ChatCompletionRequestFunctionMessage -> Constr
$cdataTypeOf :: ChatCompletionRequestFunctionMessage -> DataType
dataTypeOf :: ChatCompletionRequestFunctionMessage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestFunctionMessage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestFunctionMessage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestFunctionMessage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestFunctionMessage)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestFunctionMessage
-> ChatCompletionRequestFunctionMessage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestFunctionMessage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestFunctionMessage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestFunctionMessage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestFunctionMessage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestFunctionMessage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestFunctionMessage -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestFunctionMessage
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestFunctionMessage
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestFunctionMessage
-> m ChatCompletionRequestFunctionMessage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestFunctionMessage
-> m ChatCompletionRequestFunctionMessage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestFunctionMessage
-> m ChatCompletionRequestFunctionMessage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestFunctionMessage
-> m ChatCompletionRequestFunctionMessage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestFunctionMessage
-> m ChatCompletionRequestFunctionMessage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestFunctionMessage
-> m ChatCompletionRequestFunctionMessage
Data)

instance FromJSON ChatCompletionRequestFunctionMessage where
  parseJSON :: Value -> Parser ChatCompletionRequestFunctionMessage
parseJSON = Options -> Value -> Parser ChatCompletionRequestFunctionMessage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestFunctionMessage")
instance ToJSON ChatCompletionRequestFunctionMessage where
  toJSON :: ChatCompletionRequestFunctionMessage -> Value
toJSON = Options -> ChatCompletionRequestFunctionMessage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestFunctionMessage")


-- | 
data ChatCompletionRequestMessage = ChatCompletionRequestMessage
  { ChatCompletionRequestMessage
-> Maybe ChatCompletionRequestMessageContent
chatCompletionRequestMessageContent :: Maybe ChatCompletionRequestMessageContent -- ^ The contents of the function message.
  , ChatCompletionRequestMessage -> Text
chatCompletionRequestMessageRole :: Text -- ^ The role of the messages author, in this case `function`.
  , ChatCompletionRequestMessage -> Maybe Text
chatCompletionRequestMessageName :: Maybe Text -- ^ The name of the function to call.
  , ChatCompletionRequestMessage
-> Maybe [ChatCompletionMessageToolCall]
chatCompletionRequestMessageToolUnderscorecalls :: Maybe [ChatCompletionMessageToolCall] -- ^ The tool calls generated by the model, such as function calls.
  , ChatCompletionRequestMessage
-> Maybe ChatCompletionRequestAssistantMessageFunctionCall
chatCompletionRequestMessageFunctionUnderscorecall :: Maybe ChatCompletionRequestAssistantMessageFunctionCall -- ^ 
  , ChatCompletionRequestMessage -> Maybe Text
chatCompletionRequestMessageToolUnderscorecallUnderscoreid :: Maybe Text -- ^ Tool call that this message is responding to.
  } deriving (Int -> ChatCompletionRequestMessage -> ShowS
[ChatCompletionRequestMessage] -> ShowS
ChatCompletionRequestMessage -> String
(Int -> ChatCompletionRequestMessage -> ShowS)
-> (ChatCompletionRequestMessage -> String)
-> ([ChatCompletionRequestMessage] -> ShowS)
-> Show ChatCompletionRequestMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestMessage -> ShowS
showsPrec :: Int -> ChatCompletionRequestMessage -> ShowS
$cshow :: ChatCompletionRequestMessage -> String
show :: ChatCompletionRequestMessage -> String
$cshowList :: [ChatCompletionRequestMessage] -> ShowS
showList :: [ChatCompletionRequestMessage] -> ShowS
Show, ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
(ChatCompletionRequestMessage
 -> ChatCompletionRequestMessage -> Bool)
-> (ChatCompletionRequestMessage
    -> ChatCompletionRequestMessage -> Bool)
-> Eq ChatCompletionRequestMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
== :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
$c/= :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
/= :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
Eq, Eq ChatCompletionRequestMessage
Eq ChatCompletionRequestMessage =>
(ChatCompletionRequestMessage
 -> ChatCompletionRequestMessage -> Ordering)
-> (ChatCompletionRequestMessage
    -> ChatCompletionRequestMessage -> Bool)
-> (ChatCompletionRequestMessage
    -> ChatCompletionRequestMessage -> Bool)
-> (ChatCompletionRequestMessage
    -> ChatCompletionRequestMessage -> Bool)
-> (ChatCompletionRequestMessage
    -> ChatCompletionRequestMessage -> Bool)
-> (ChatCompletionRequestMessage
    -> ChatCompletionRequestMessage -> ChatCompletionRequestMessage)
-> (ChatCompletionRequestMessage
    -> ChatCompletionRequestMessage -> ChatCompletionRequestMessage)
-> Ord ChatCompletionRequestMessage
ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Ordering
ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> ChatCompletionRequestMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Ordering
compare :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Ordering
$c< :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
< :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
$c<= :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
<= :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
$c> :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
> :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
$c>= :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
>= :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> Bool
$cmax :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> ChatCompletionRequestMessage
max :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> ChatCompletionRequestMessage
$cmin :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> ChatCompletionRequestMessage
min :: ChatCompletionRequestMessage
-> ChatCompletionRequestMessage -> ChatCompletionRequestMessage
Ord, (forall x.
 ChatCompletionRequestMessage -> Rep ChatCompletionRequestMessage x)
-> (forall x.
    Rep ChatCompletionRequestMessage x -> ChatCompletionRequestMessage)
-> Generic ChatCompletionRequestMessage
forall x.
Rep ChatCompletionRequestMessage x -> ChatCompletionRequestMessage
forall x.
ChatCompletionRequestMessage -> Rep ChatCompletionRequestMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestMessage -> Rep ChatCompletionRequestMessage x
from :: forall x.
ChatCompletionRequestMessage -> Rep ChatCompletionRequestMessage x
$cto :: forall x.
Rep ChatCompletionRequestMessage x -> ChatCompletionRequestMessage
to :: forall x.
Rep ChatCompletionRequestMessage x -> ChatCompletionRequestMessage
Generic, Typeable ChatCompletionRequestMessage
Typeable ChatCompletionRequestMessage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestMessage
 -> c ChatCompletionRequestMessage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestMessage)
-> (ChatCompletionRequestMessage -> Constr)
-> (ChatCompletionRequestMessage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestMessage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestMessage))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestMessage -> ChatCompletionRequestMessage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessage -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessage
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage)
-> Data ChatCompletionRequestMessage
ChatCompletionRequestMessage -> Constr
ChatCompletionRequestMessage -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestMessage -> ChatCompletionRequestMessage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessage
-> u
forall u.
(forall d. Data d => d -> u) -> ChatCompletionRequestMessage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionRequestMessage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessage
-> c ChatCompletionRequestMessage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessage
-> c ChatCompletionRequestMessage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessage
-> c ChatCompletionRequestMessage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionRequestMessage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionRequestMessage
$ctoConstr :: ChatCompletionRequestMessage -> Constr
toConstr :: ChatCompletionRequestMessage -> Constr
$cdataTypeOf :: ChatCompletionRequestMessage -> DataType
dataTypeOf :: ChatCompletionRequestMessage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessage)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessage -> ChatCompletionRequestMessage
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessage -> ChatCompletionRequestMessage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ChatCompletionRequestMessage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ChatCompletionRequestMessage -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessage
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessage
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessage -> m ChatCompletionRequestMessage
Data)

instance FromJSON ChatCompletionRequestMessage where
  parseJSON :: Value -> Parser ChatCompletionRequestMessage
parseJSON = Options -> Value -> Parser ChatCompletionRequestMessage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestMessage")
instance ToJSON ChatCompletionRequestMessage where
  toJSON :: ChatCompletionRequestMessage -> Value
toJSON = Options -> ChatCompletionRequestMessage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestMessage")

data ChatCompletionRequestMessageContent
  = ChatCompletionRequestMessageContentText Text
  | ChatCompletionRequestMessageContentParts [ChatCompletionRequestMessageContentPart]
 deriving (Int -> ChatCompletionRequestMessageContent -> ShowS
[ChatCompletionRequestMessageContent] -> ShowS
ChatCompletionRequestMessageContent -> String
(Int -> ChatCompletionRequestMessageContent -> ShowS)
-> (ChatCompletionRequestMessageContent -> String)
-> ([ChatCompletionRequestMessageContent] -> ShowS)
-> Show ChatCompletionRequestMessageContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestMessageContent -> ShowS
showsPrec :: Int -> ChatCompletionRequestMessageContent -> ShowS
$cshow :: ChatCompletionRequestMessageContent -> String
show :: ChatCompletionRequestMessageContent -> String
$cshowList :: [ChatCompletionRequestMessageContent] -> ShowS
showList :: [ChatCompletionRequestMessageContent] -> ShowS
Show, ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
(ChatCompletionRequestMessageContent
 -> ChatCompletionRequestMessageContent -> Bool)
-> (ChatCompletionRequestMessageContent
    -> ChatCompletionRequestMessageContent -> Bool)
-> Eq ChatCompletionRequestMessageContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
== :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
$c/= :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
/= :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
Eq, Eq ChatCompletionRequestMessageContent
Eq ChatCompletionRequestMessageContent =>
(ChatCompletionRequestMessageContent
 -> ChatCompletionRequestMessageContent -> Ordering)
-> (ChatCompletionRequestMessageContent
    -> ChatCompletionRequestMessageContent -> Bool)
-> (ChatCompletionRequestMessageContent
    -> ChatCompletionRequestMessageContent -> Bool)
-> (ChatCompletionRequestMessageContent
    -> ChatCompletionRequestMessageContent -> Bool)
-> (ChatCompletionRequestMessageContent
    -> ChatCompletionRequestMessageContent -> Bool)
-> (ChatCompletionRequestMessageContent
    -> ChatCompletionRequestMessageContent
    -> ChatCompletionRequestMessageContent)
-> (ChatCompletionRequestMessageContent
    -> ChatCompletionRequestMessageContent
    -> ChatCompletionRequestMessageContent)
-> Ord ChatCompletionRequestMessageContent
ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Ordering
ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Ordering
compare :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Ordering
$c< :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
< :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
$c<= :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
<= :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
$c> :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
> :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
$c>= :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
>= :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent -> Bool
$cmax :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
max :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
$cmin :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
min :: ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
Ord, (forall x.
 ChatCompletionRequestMessageContent
 -> Rep ChatCompletionRequestMessageContent x)
-> (forall x.
    Rep ChatCompletionRequestMessageContent x
    -> ChatCompletionRequestMessageContent)
-> Generic ChatCompletionRequestMessageContent
forall x.
Rep ChatCompletionRequestMessageContent x
-> ChatCompletionRequestMessageContent
forall x.
ChatCompletionRequestMessageContent
-> Rep ChatCompletionRequestMessageContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestMessageContent
-> Rep ChatCompletionRequestMessageContent x
from :: forall x.
ChatCompletionRequestMessageContent
-> Rep ChatCompletionRequestMessageContent x
$cto :: forall x.
Rep ChatCompletionRequestMessageContent x
-> ChatCompletionRequestMessageContent
to :: forall x.
Rep ChatCompletionRequestMessageContent x
-> ChatCompletionRequestMessageContent
Generic, Typeable ChatCompletionRequestMessageContent
Typeable ChatCompletionRequestMessageContent =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestMessageContent
 -> c ChatCompletionRequestMessageContent)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestMessageContent)
-> (ChatCompletionRequestMessageContent -> Constr)
-> (ChatCompletionRequestMessageContent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestMessageContent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestMessageContent))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestMessageContent
    -> ChatCompletionRequestMessageContent)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessageContent
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessageContent
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessageContent -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessageContent
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContent
    -> m ChatCompletionRequestMessageContent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContent
    -> m ChatCompletionRequestMessageContent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContent
    -> m ChatCompletionRequestMessageContent)
-> Data ChatCompletionRequestMessageContent
ChatCompletionRequestMessageContent -> Constr
ChatCompletionRequestMessageContent -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContent
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContent -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContent
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContent
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContent
-> m ChatCompletionRequestMessageContent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContent
-> m ChatCompletionRequestMessageContent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContent
-> c ChatCompletionRequestMessageContent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContent)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContent
-> c ChatCompletionRequestMessageContent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContent
-> c ChatCompletionRequestMessageContent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContent
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContent
$ctoConstr :: ChatCompletionRequestMessageContent -> Constr
toConstr :: ChatCompletionRequestMessageContent -> Constr
$cdataTypeOf :: ChatCompletionRequestMessageContent -> DataType
dataTypeOf :: ChatCompletionRequestMessageContent -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContent)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContent)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContent
-> ChatCompletionRequestMessageContent
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContent
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContent
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContent
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContent
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContent -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContent -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContent
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContent
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContent
-> m ChatCompletionRequestMessageContent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContent
-> m ChatCompletionRequestMessageContent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContent
-> m ChatCompletionRequestMessageContent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContent
-> m ChatCompletionRequestMessageContent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContent
-> m ChatCompletionRequestMessageContent
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContent
-> m ChatCompletionRequestMessageContent
Data)

instance FromJSON ChatCompletionRequestMessageContent where
  -- When it is a string, parse it as a text
  -- When it is a list, parse it as a list of parts
  parseJSON :: Value -> Parser ChatCompletionRequestMessageContent
parseJSON = \case
    Aeson.String Text
text -> ChatCompletionRequestMessageContent
-> Parser ChatCompletionRequestMessageContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatCompletionRequestMessageContent
 -> Parser ChatCompletionRequestMessageContent)
-> ChatCompletionRequestMessageContent
-> Parser ChatCompletionRequestMessageContent
forall a b. (a -> b) -> a -> b
$ Text -> ChatCompletionRequestMessageContent
ChatCompletionRequestMessageContentText Text
text
    Aeson.Array Array
parts -> do
      [ChatCompletionRequestMessageContentPart]
parsedParts <- (Value -> Parser ChatCompletionRequestMessageContentPart)
-> [Value] -> Parser [ChatCompletionRequestMessageContentPart]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser ChatCompletionRequestMessageContentPart
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON ([Value] -> Parser [ChatCompletionRequestMessageContentPart])
-> [Value] -> Parser [ChatCompletionRequestMessageContentPart]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
parts
      ChatCompletionRequestMessageContent
-> Parser ChatCompletionRequestMessageContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatCompletionRequestMessageContent
 -> Parser ChatCompletionRequestMessageContent)
-> ChatCompletionRequestMessageContent
-> Parser ChatCompletionRequestMessageContent
forall a b. (a -> b) -> a -> b
$ [ChatCompletionRequestMessageContentPart]
-> ChatCompletionRequestMessageContent
ChatCompletionRequestMessageContentParts [ChatCompletionRequestMessageContentPart]
parsedParts
    Value
_ -> String -> Parser ChatCompletionRequestMessageContent
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ChatCompletionRequestMessageContent"
instance ToJSON ChatCompletionRequestMessageContent where
  toJSON :: ChatCompletionRequestMessageContent -> Value
toJSON = \case
    ChatCompletionRequestMessageContentText Text
text -> Text -> Value
Aeson.String Text
text
    ChatCompletionRequestMessageContentParts [ChatCompletionRequestMessageContentPart]
parts -> Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ (ChatCompletionRequestMessageContentPart -> Value)
-> [ChatCompletionRequestMessageContentPart] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ChatCompletionRequestMessageContentPart -> Value
forall a. ToJSON a => a -> Value
toJSON [ChatCompletionRequestMessageContentPart]
parts

-- | 
data ChatCompletionRequestMessageContentPart = ChatCompletionRequestMessageContentPart
  { ChatCompletionRequestMessageContentPart -> Text
chatCompletionRequestMessageContentPartType :: Text -- ^ The type of the content part.
  , ChatCompletionRequestMessageContentPart -> Maybe Text
chatCompletionRequestMessageContentPartText :: Maybe Text -- ^ The text content.
  , ChatCompletionRequestMessageContentPart
-> Maybe ChatCompletionRequestMessageContentPartImageImageUrl
chatCompletionRequestMessageContentPartImageUnderscoreurl :: Maybe ChatCompletionRequestMessageContentPartImageImageUrl -- ^ 
  } deriving (Int -> ChatCompletionRequestMessageContentPart -> ShowS
[ChatCompletionRequestMessageContentPart] -> ShowS
ChatCompletionRequestMessageContentPart -> String
(Int -> ChatCompletionRequestMessageContentPart -> ShowS)
-> (ChatCompletionRequestMessageContentPart -> String)
-> ([ChatCompletionRequestMessageContentPart] -> ShowS)
-> Show ChatCompletionRequestMessageContentPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestMessageContentPart -> ShowS
showsPrec :: Int -> ChatCompletionRequestMessageContentPart -> ShowS
$cshow :: ChatCompletionRequestMessageContentPart -> String
show :: ChatCompletionRequestMessageContentPart -> String
$cshowList :: [ChatCompletionRequestMessageContentPart] -> ShowS
showList :: [ChatCompletionRequestMessageContentPart] -> ShowS
Show, ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
(ChatCompletionRequestMessageContentPart
 -> ChatCompletionRequestMessageContentPart -> Bool)
-> (ChatCompletionRequestMessageContentPart
    -> ChatCompletionRequestMessageContentPart -> Bool)
-> Eq ChatCompletionRequestMessageContentPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
== :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
$c/= :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
/= :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
Eq, Eq ChatCompletionRequestMessageContentPart
Eq ChatCompletionRequestMessageContentPart =>
(ChatCompletionRequestMessageContentPart
 -> ChatCompletionRequestMessageContentPart -> Ordering)
-> (ChatCompletionRequestMessageContentPart
    -> ChatCompletionRequestMessageContentPart -> Bool)
-> (ChatCompletionRequestMessageContentPart
    -> ChatCompletionRequestMessageContentPart -> Bool)
-> (ChatCompletionRequestMessageContentPart
    -> ChatCompletionRequestMessageContentPart -> Bool)
-> (ChatCompletionRequestMessageContentPart
    -> ChatCompletionRequestMessageContentPart -> Bool)
-> (ChatCompletionRequestMessageContentPart
    -> ChatCompletionRequestMessageContentPart
    -> ChatCompletionRequestMessageContentPart)
-> (ChatCompletionRequestMessageContentPart
    -> ChatCompletionRequestMessageContentPart
    -> ChatCompletionRequestMessageContentPart)
-> Ord ChatCompletionRequestMessageContentPart
ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Ordering
ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Ordering
compare :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Ordering
$c< :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
< :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
$c<= :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
<= :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
$c> :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
> :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
$c>= :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
>= :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart -> Bool
$cmax :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
max :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
$cmin :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
min :: ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
Ord, (forall x.
 ChatCompletionRequestMessageContentPart
 -> Rep ChatCompletionRequestMessageContentPart x)
-> (forall x.
    Rep ChatCompletionRequestMessageContentPart x
    -> ChatCompletionRequestMessageContentPart)
-> Generic ChatCompletionRequestMessageContentPart
forall x.
Rep ChatCompletionRequestMessageContentPart x
-> ChatCompletionRequestMessageContentPart
forall x.
ChatCompletionRequestMessageContentPart
-> Rep ChatCompletionRequestMessageContentPart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestMessageContentPart
-> Rep ChatCompletionRequestMessageContentPart x
from :: forall x.
ChatCompletionRequestMessageContentPart
-> Rep ChatCompletionRequestMessageContentPart x
$cto :: forall x.
Rep ChatCompletionRequestMessageContentPart x
-> ChatCompletionRequestMessageContentPart
to :: forall x.
Rep ChatCompletionRequestMessageContentPart x
-> ChatCompletionRequestMessageContentPart
Generic, Typeable ChatCompletionRequestMessageContentPart
Typeable ChatCompletionRequestMessageContentPart =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestMessageContentPart
 -> c ChatCompletionRequestMessageContentPart)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestMessageContentPart)
-> (ChatCompletionRequestMessageContentPart -> Constr)
-> (ChatCompletionRequestMessageContentPart -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestMessageContentPart))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestMessageContentPart))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestMessageContentPart
    -> ChatCompletionRequestMessageContentPart)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessageContentPart
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessageContentPart
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessageContentPart -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessageContentPart
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPart
    -> m ChatCompletionRequestMessageContentPart)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPart
    -> m ChatCompletionRequestMessageContentPart)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPart
    -> m ChatCompletionRequestMessageContentPart)
-> Data ChatCompletionRequestMessageContentPart
ChatCompletionRequestMessageContentPart -> Constr
ChatCompletionRequestMessageContentPart -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPart
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPart -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPart
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPart
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPart
-> m ChatCompletionRequestMessageContentPart
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPart
-> m ChatCompletionRequestMessageContentPart
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPart
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPart
-> c ChatCompletionRequestMessageContentPart
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPart)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPart)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPart
-> c ChatCompletionRequestMessageContentPart
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPart
-> c ChatCompletionRequestMessageContentPart
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPart
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPart
$ctoConstr :: ChatCompletionRequestMessageContentPart -> Constr
toConstr :: ChatCompletionRequestMessageContentPart -> Constr
$cdataTypeOf :: ChatCompletionRequestMessageContentPart -> DataType
dataTypeOf :: ChatCompletionRequestMessageContentPart -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPart)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPart)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPart)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPart)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPart
-> ChatCompletionRequestMessageContentPart
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPart
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPart
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPart
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPart
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPart -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPart -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPart
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPart
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPart
-> m ChatCompletionRequestMessageContentPart
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPart
-> m ChatCompletionRequestMessageContentPart
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPart
-> m ChatCompletionRequestMessageContentPart
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPart
-> m ChatCompletionRequestMessageContentPart
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPart
-> m ChatCompletionRequestMessageContentPart
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPart
-> m ChatCompletionRequestMessageContentPart
Data)

instance FromJSON ChatCompletionRequestMessageContentPart where
  parseJSON :: Value -> Parser ChatCompletionRequestMessageContentPart
parseJSON = Options -> Value -> Parser ChatCompletionRequestMessageContentPart
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestMessageContentPart")
instance ToJSON ChatCompletionRequestMessageContentPart where
  toJSON :: ChatCompletionRequestMessageContentPart -> Value
toJSON = Options -> ChatCompletionRequestMessageContentPart -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestMessageContentPart")


-- | 
data ChatCompletionRequestMessageContentPartImage = ChatCompletionRequestMessageContentPartImage
  { ChatCompletionRequestMessageContentPartImage -> Text
chatCompletionRequestMessageContentPartImageType :: Text -- ^ The type of the content part.
  , ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImageImageUrl
chatCompletionRequestMessageContentPartImageImageUnderscoreurl :: ChatCompletionRequestMessageContentPartImageImageUrl -- ^ 
  } deriving (Int -> ChatCompletionRequestMessageContentPartImage -> ShowS
[ChatCompletionRequestMessageContentPartImage] -> ShowS
ChatCompletionRequestMessageContentPartImage -> String
(Int -> ChatCompletionRequestMessageContentPartImage -> ShowS)
-> (ChatCompletionRequestMessageContentPartImage -> String)
-> ([ChatCompletionRequestMessageContentPartImage] -> ShowS)
-> Show ChatCompletionRequestMessageContentPartImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestMessageContentPartImage -> ShowS
showsPrec :: Int -> ChatCompletionRequestMessageContentPartImage -> ShowS
$cshow :: ChatCompletionRequestMessageContentPartImage -> String
show :: ChatCompletionRequestMessageContentPartImage -> String
$cshowList :: [ChatCompletionRequestMessageContentPartImage] -> ShowS
showList :: [ChatCompletionRequestMessageContentPartImage] -> ShowS
Show, ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
(ChatCompletionRequestMessageContentPartImage
 -> ChatCompletionRequestMessageContentPartImage -> Bool)
-> (ChatCompletionRequestMessageContentPartImage
    -> ChatCompletionRequestMessageContentPartImage -> Bool)
-> Eq ChatCompletionRequestMessageContentPartImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
== :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
$c/= :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
/= :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
Eq, Eq ChatCompletionRequestMessageContentPartImage
Eq ChatCompletionRequestMessageContentPartImage =>
(ChatCompletionRequestMessageContentPartImage
 -> ChatCompletionRequestMessageContentPartImage -> Ordering)
-> (ChatCompletionRequestMessageContentPartImage
    -> ChatCompletionRequestMessageContentPartImage -> Bool)
-> (ChatCompletionRequestMessageContentPartImage
    -> ChatCompletionRequestMessageContentPartImage -> Bool)
-> (ChatCompletionRequestMessageContentPartImage
    -> ChatCompletionRequestMessageContentPartImage -> Bool)
-> (ChatCompletionRequestMessageContentPartImage
    -> ChatCompletionRequestMessageContentPartImage -> Bool)
-> (ChatCompletionRequestMessageContentPartImage
    -> ChatCompletionRequestMessageContentPartImage
    -> ChatCompletionRequestMessageContentPartImage)
-> (ChatCompletionRequestMessageContentPartImage
    -> ChatCompletionRequestMessageContentPartImage
    -> ChatCompletionRequestMessageContentPartImage)
-> Ord ChatCompletionRequestMessageContentPartImage
ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Ordering
ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Ordering
compare :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Ordering
$c< :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
< :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
$c<= :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
<= :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
$c> :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
> :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
$c>= :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
>= :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage -> Bool
$cmax :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
max :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
$cmin :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
min :: ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
Ord, (forall x.
 ChatCompletionRequestMessageContentPartImage
 -> Rep ChatCompletionRequestMessageContentPartImage x)
-> (forall x.
    Rep ChatCompletionRequestMessageContentPartImage x
    -> ChatCompletionRequestMessageContentPartImage)
-> Generic ChatCompletionRequestMessageContentPartImage
forall x.
Rep ChatCompletionRequestMessageContentPartImage x
-> ChatCompletionRequestMessageContentPartImage
forall x.
ChatCompletionRequestMessageContentPartImage
-> Rep ChatCompletionRequestMessageContentPartImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestMessageContentPartImage
-> Rep ChatCompletionRequestMessageContentPartImage x
from :: forall x.
ChatCompletionRequestMessageContentPartImage
-> Rep ChatCompletionRequestMessageContentPartImage x
$cto :: forall x.
Rep ChatCompletionRequestMessageContentPartImage x
-> ChatCompletionRequestMessageContentPartImage
to :: forall x.
Rep ChatCompletionRequestMessageContentPartImage x
-> ChatCompletionRequestMessageContentPartImage
Generic, Typeable ChatCompletionRequestMessageContentPartImage
Typeable ChatCompletionRequestMessageContentPartImage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestMessageContentPartImage
 -> c ChatCompletionRequestMessageContentPartImage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestMessageContentPartImage)
-> (ChatCompletionRequestMessageContentPartImage -> Constr)
-> (ChatCompletionRequestMessageContentPartImage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestMessageContentPartImage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestMessageContentPartImage))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestMessageContentPartImage
    -> ChatCompletionRequestMessageContentPartImage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessageContentPartImage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessageContentPartImage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessageContentPartImage -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessageContentPartImage
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPartImage
    -> m ChatCompletionRequestMessageContentPartImage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPartImage
    -> m ChatCompletionRequestMessageContentPartImage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPartImage
    -> m ChatCompletionRequestMessageContentPartImage)
-> Data ChatCompletionRequestMessageContentPartImage
ChatCompletionRequestMessageContentPartImage -> Constr
ChatCompletionRequestMessageContentPartImage -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImage
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImage
-> m ChatCompletionRequestMessageContentPartImage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImage
-> m ChatCompletionRequestMessageContentPartImage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPartImage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPartImage
-> c ChatCompletionRequestMessageContentPartImage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPartImage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPartImage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPartImage
-> c ChatCompletionRequestMessageContentPartImage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPartImage
-> c ChatCompletionRequestMessageContentPartImage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPartImage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPartImage
$ctoConstr :: ChatCompletionRequestMessageContentPartImage -> Constr
toConstr :: ChatCompletionRequestMessageContentPartImage -> Constr
$cdataTypeOf :: ChatCompletionRequestMessageContentPartImage -> DataType
dataTypeOf :: ChatCompletionRequestMessageContentPartImage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPartImage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPartImage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPartImage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPartImage)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPartImage
-> ChatCompletionRequestMessageContentPartImage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImage -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImage
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImage
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImage
-> m ChatCompletionRequestMessageContentPartImage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImage
-> m ChatCompletionRequestMessageContentPartImage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImage
-> m ChatCompletionRequestMessageContentPartImage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImage
-> m ChatCompletionRequestMessageContentPartImage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImage
-> m ChatCompletionRequestMessageContentPartImage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImage
-> m ChatCompletionRequestMessageContentPartImage
Data)

instance FromJSON ChatCompletionRequestMessageContentPartImage where
  parseJSON :: Value -> Parser ChatCompletionRequestMessageContentPartImage
parseJSON = Options
-> Value -> Parser ChatCompletionRequestMessageContentPartImage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestMessageContentPartImage")
instance ToJSON ChatCompletionRequestMessageContentPartImage where
  toJSON :: ChatCompletionRequestMessageContentPartImage -> Value
toJSON = Options -> ChatCompletionRequestMessageContentPartImage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestMessageContentPartImage")


-- | 
data ChatCompletionRequestMessageContentPartImageImageUrl = ChatCompletionRequestMessageContentPartImageImageUrl
  { ChatCompletionRequestMessageContentPartImageImageUrl -> Text
chatCompletionRequestMessageContentPartImageImageUrlUrl :: Text -- ^ Either a URL of the image or the base64 encoded image data.
  , ChatCompletionRequestMessageContentPartImageImageUrl -> Maybe Text
chatCompletionRequestMessageContentPartImageImageUrlDetail :: Maybe Text -- ^ Specifies the detail level of the image. Learn more in the [Vision guide](/docs/guides/vision/low-or-high-fidelity-image-understanding).
  } deriving (Int
-> ChatCompletionRequestMessageContentPartImageImageUrl -> ShowS
[ChatCompletionRequestMessageContentPartImageImageUrl] -> ShowS
ChatCompletionRequestMessageContentPartImageImageUrl -> String
(Int
 -> ChatCompletionRequestMessageContentPartImageImageUrl -> ShowS)
-> (ChatCompletionRequestMessageContentPartImageImageUrl -> String)
-> ([ChatCompletionRequestMessageContentPartImageImageUrl]
    -> ShowS)
-> Show ChatCompletionRequestMessageContentPartImageImageUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int
-> ChatCompletionRequestMessageContentPartImageImageUrl -> ShowS
showsPrec :: Int
-> ChatCompletionRequestMessageContentPartImageImageUrl -> ShowS
$cshow :: ChatCompletionRequestMessageContentPartImageImageUrl -> String
show :: ChatCompletionRequestMessageContentPartImageImageUrl -> String
$cshowList :: [ChatCompletionRequestMessageContentPartImageImageUrl] -> ShowS
showList :: [ChatCompletionRequestMessageContentPartImageImageUrl] -> ShowS
Show, ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
(ChatCompletionRequestMessageContentPartImageImageUrl
 -> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool)
-> (ChatCompletionRequestMessageContentPartImageImageUrl
    -> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool)
-> Eq ChatCompletionRequestMessageContentPartImageImageUrl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
== :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
$c/= :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
/= :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
Eq, Eq ChatCompletionRequestMessageContentPartImageImageUrl
Eq ChatCompletionRequestMessageContentPartImageImageUrl =>
(ChatCompletionRequestMessageContentPartImageImageUrl
 -> ChatCompletionRequestMessageContentPartImageImageUrl
 -> Ordering)
-> (ChatCompletionRequestMessageContentPartImageImageUrl
    -> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool)
-> (ChatCompletionRequestMessageContentPartImageImageUrl
    -> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool)
-> (ChatCompletionRequestMessageContentPartImageImageUrl
    -> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool)
-> (ChatCompletionRequestMessageContentPartImageImageUrl
    -> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool)
-> (ChatCompletionRequestMessageContentPartImageImageUrl
    -> ChatCompletionRequestMessageContentPartImageImageUrl
    -> ChatCompletionRequestMessageContentPartImageImageUrl)
-> (ChatCompletionRequestMessageContentPartImageImageUrl
    -> ChatCompletionRequestMessageContentPartImageImageUrl
    -> ChatCompletionRequestMessageContentPartImageImageUrl)
-> Ord ChatCompletionRequestMessageContentPartImageImageUrl
ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Ordering
ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Ordering
compare :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Ordering
$c< :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
< :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
$c<= :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
<= :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
$c> :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
> :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
$c>= :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
>= :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Bool
$cmax :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
max :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
$cmin :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
min :: ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
Ord, (forall x.
 ChatCompletionRequestMessageContentPartImageImageUrl
 -> Rep ChatCompletionRequestMessageContentPartImageImageUrl x)
-> (forall x.
    Rep ChatCompletionRequestMessageContentPartImageImageUrl x
    -> ChatCompletionRequestMessageContentPartImageImageUrl)
-> Generic ChatCompletionRequestMessageContentPartImageImageUrl
forall x.
Rep ChatCompletionRequestMessageContentPartImageImageUrl x
-> ChatCompletionRequestMessageContentPartImageImageUrl
forall x.
ChatCompletionRequestMessageContentPartImageImageUrl
-> Rep ChatCompletionRequestMessageContentPartImageImageUrl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestMessageContentPartImageImageUrl
-> Rep ChatCompletionRequestMessageContentPartImageImageUrl x
from :: forall x.
ChatCompletionRequestMessageContentPartImageImageUrl
-> Rep ChatCompletionRequestMessageContentPartImageImageUrl x
$cto :: forall x.
Rep ChatCompletionRequestMessageContentPartImageImageUrl x
-> ChatCompletionRequestMessageContentPartImageImageUrl
to :: forall x.
Rep ChatCompletionRequestMessageContentPartImageImageUrl x
-> ChatCompletionRequestMessageContentPartImageImageUrl
Generic, Typeable ChatCompletionRequestMessageContentPartImageImageUrl
Typeable ChatCompletionRequestMessageContentPartImageImageUrl =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestMessageContentPartImageImageUrl
 -> c ChatCompletionRequestMessageContentPartImageImageUrl)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestMessageContentPartImageImageUrl)
-> (ChatCompletionRequestMessageContentPartImageImageUrl -> Constr)
-> (ChatCompletionRequestMessageContentPartImageImageUrl
    -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestMessageContentPartImageImageUrl))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestMessageContentPartImageImageUrl))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestMessageContentPartImageImageUrl
    -> ChatCompletionRequestMessageContentPartImageImageUrl)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessageContentPartImageImageUrl
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessageContentPartImageImageUrl
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessageContentPartImageImageUrl -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessageContentPartImageImageUrl
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPartImageImageUrl
    -> m ChatCompletionRequestMessageContentPartImageImageUrl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPartImageImageUrl
    -> m ChatCompletionRequestMessageContentPartImageImageUrl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPartImageImageUrl
    -> m ChatCompletionRequestMessageContentPartImageImageUrl)
-> Data ChatCompletionRequestMessageContentPartImageImageUrl
ChatCompletionRequestMessageContentPartImageImageUrl -> Constr
ChatCompletionRequestMessageContentPartImageImageUrl -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImageImageUrl -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> m ChatCompletionRequestMessageContentPartImageImageUrl
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> m ChatCompletionRequestMessageContentPartImageImageUrl
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPartImageImageUrl
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> c ChatCompletionRequestMessageContentPartImageImageUrl
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPartImageImageUrl)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPartImageImageUrl)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> c ChatCompletionRequestMessageContentPartImageImageUrl
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> c ChatCompletionRequestMessageContentPartImageImageUrl
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPartImageImageUrl
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPartImageImageUrl
$ctoConstr :: ChatCompletionRequestMessageContentPartImageImageUrl -> Constr
toConstr :: ChatCompletionRequestMessageContentPartImageImageUrl -> Constr
$cdataTypeOf :: ChatCompletionRequestMessageContentPartImageImageUrl -> DataType
dataTypeOf :: ChatCompletionRequestMessageContentPartImageImageUrl -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPartImageImageUrl)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPartImageImageUrl)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPartImageImageUrl)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPartImageImageUrl)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> ChatCompletionRequestMessageContentPartImageImageUrl
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImageImageUrl -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImageImageUrl -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> m ChatCompletionRequestMessageContentPartImageImageUrl
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> m ChatCompletionRequestMessageContentPartImageImageUrl
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> m ChatCompletionRequestMessageContentPartImageImageUrl
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> m ChatCompletionRequestMessageContentPartImageImageUrl
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> m ChatCompletionRequestMessageContentPartImageImageUrl
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartImageImageUrl
-> m ChatCompletionRequestMessageContentPartImageImageUrl
Data)

instance FromJSON ChatCompletionRequestMessageContentPartImageImageUrl where
  parseJSON :: Value
-> Parser ChatCompletionRequestMessageContentPartImageImageUrl
parseJSON = Options
-> Value
-> Parser ChatCompletionRequestMessageContentPartImageImageUrl
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestMessageContentPartImageImageUrl")
instance ToJSON ChatCompletionRequestMessageContentPartImageImageUrl where
  toJSON :: ChatCompletionRequestMessageContentPartImageImageUrl -> Value
toJSON = Options
-> ChatCompletionRequestMessageContentPartImageImageUrl -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestMessageContentPartImageImageUrl")


-- | 
data ChatCompletionRequestMessageContentPartText = ChatCompletionRequestMessageContentPartText
  { ChatCompletionRequestMessageContentPartText -> Text
chatCompletionRequestMessageContentPartTextType :: Text -- ^ The type of the content part.
  , ChatCompletionRequestMessageContentPartText -> Text
chatCompletionRequestMessageContentPartTextText :: Text -- ^ The text content.
  } deriving (Int -> ChatCompletionRequestMessageContentPartText -> ShowS
[ChatCompletionRequestMessageContentPartText] -> ShowS
ChatCompletionRequestMessageContentPartText -> String
(Int -> ChatCompletionRequestMessageContentPartText -> ShowS)
-> (ChatCompletionRequestMessageContentPartText -> String)
-> ([ChatCompletionRequestMessageContentPartText] -> ShowS)
-> Show ChatCompletionRequestMessageContentPartText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestMessageContentPartText -> ShowS
showsPrec :: Int -> ChatCompletionRequestMessageContentPartText -> ShowS
$cshow :: ChatCompletionRequestMessageContentPartText -> String
show :: ChatCompletionRequestMessageContentPartText -> String
$cshowList :: [ChatCompletionRequestMessageContentPartText] -> ShowS
showList :: [ChatCompletionRequestMessageContentPartText] -> ShowS
Show, ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
(ChatCompletionRequestMessageContentPartText
 -> ChatCompletionRequestMessageContentPartText -> Bool)
-> (ChatCompletionRequestMessageContentPartText
    -> ChatCompletionRequestMessageContentPartText -> Bool)
-> Eq ChatCompletionRequestMessageContentPartText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
== :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
$c/= :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
/= :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
Eq, Eq ChatCompletionRequestMessageContentPartText
Eq ChatCompletionRequestMessageContentPartText =>
(ChatCompletionRequestMessageContentPartText
 -> ChatCompletionRequestMessageContentPartText -> Ordering)
-> (ChatCompletionRequestMessageContentPartText
    -> ChatCompletionRequestMessageContentPartText -> Bool)
-> (ChatCompletionRequestMessageContentPartText
    -> ChatCompletionRequestMessageContentPartText -> Bool)
-> (ChatCompletionRequestMessageContentPartText
    -> ChatCompletionRequestMessageContentPartText -> Bool)
-> (ChatCompletionRequestMessageContentPartText
    -> ChatCompletionRequestMessageContentPartText -> Bool)
-> (ChatCompletionRequestMessageContentPartText
    -> ChatCompletionRequestMessageContentPartText
    -> ChatCompletionRequestMessageContentPartText)
-> (ChatCompletionRequestMessageContentPartText
    -> ChatCompletionRequestMessageContentPartText
    -> ChatCompletionRequestMessageContentPartText)
-> Ord ChatCompletionRequestMessageContentPartText
ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Ordering
ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Ordering
compare :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Ordering
$c< :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
< :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
$c<= :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
<= :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
$c> :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
> :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
$c>= :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
>= :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText -> Bool
$cmax :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
max :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
$cmin :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
min :: ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
Ord, (forall x.
 ChatCompletionRequestMessageContentPartText
 -> Rep ChatCompletionRequestMessageContentPartText x)
-> (forall x.
    Rep ChatCompletionRequestMessageContentPartText x
    -> ChatCompletionRequestMessageContentPartText)
-> Generic ChatCompletionRequestMessageContentPartText
forall x.
Rep ChatCompletionRequestMessageContentPartText x
-> ChatCompletionRequestMessageContentPartText
forall x.
ChatCompletionRequestMessageContentPartText
-> Rep ChatCompletionRequestMessageContentPartText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestMessageContentPartText
-> Rep ChatCompletionRequestMessageContentPartText x
from :: forall x.
ChatCompletionRequestMessageContentPartText
-> Rep ChatCompletionRequestMessageContentPartText x
$cto :: forall x.
Rep ChatCompletionRequestMessageContentPartText x
-> ChatCompletionRequestMessageContentPartText
to :: forall x.
Rep ChatCompletionRequestMessageContentPartText x
-> ChatCompletionRequestMessageContentPartText
Generic, Typeable ChatCompletionRequestMessageContentPartText
Typeable ChatCompletionRequestMessageContentPartText =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestMessageContentPartText
 -> c ChatCompletionRequestMessageContentPartText)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestMessageContentPartText)
-> (ChatCompletionRequestMessageContentPartText -> Constr)
-> (ChatCompletionRequestMessageContentPartText -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestMessageContentPartText))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestMessageContentPartText))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestMessageContentPartText
    -> ChatCompletionRequestMessageContentPartText)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessageContentPartText
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestMessageContentPartText
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessageContentPartText -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestMessageContentPartText
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPartText
    -> m ChatCompletionRequestMessageContentPartText)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPartText
    -> m ChatCompletionRequestMessageContentPartText)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestMessageContentPartText
    -> m ChatCompletionRequestMessageContentPartText)
-> Data ChatCompletionRequestMessageContentPartText
ChatCompletionRequestMessageContentPartText -> Constr
ChatCompletionRequestMessageContentPartText -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartText
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartText -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartText
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartText
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartText
-> m ChatCompletionRequestMessageContentPartText
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartText
-> m ChatCompletionRequestMessageContentPartText
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPartText
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPartText
-> c ChatCompletionRequestMessageContentPartText
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPartText)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPartText)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPartText
-> c ChatCompletionRequestMessageContentPartText
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestMessageContentPartText
-> c ChatCompletionRequestMessageContentPartText
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPartText
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestMessageContentPartText
$ctoConstr :: ChatCompletionRequestMessageContentPartText -> Constr
toConstr :: ChatCompletionRequestMessageContentPartText -> Constr
$cdataTypeOf :: ChatCompletionRequestMessageContentPartText -> DataType
dataTypeOf :: ChatCompletionRequestMessageContentPartText -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPartText)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestMessageContentPartText)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPartText)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestMessageContentPartText)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestMessageContentPartText
-> ChatCompletionRequestMessageContentPartText
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartText
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartText
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartText
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestMessageContentPartText
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartText -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartText -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartText
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestMessageContentPartText
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartText
-> m ChatCompletionRequestMessageContentPartText
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartText
-> m ChatCompletionRequestMessageContentPartText
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartText
-> m ChatCompletionRequestMessageContentPartText
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartText
-> m ChatCompletionRequestMessageContentPartText
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartText
-> m ChatCompletionRequestMessageContentPartText
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestMessageContentPartText
-> m ChatCompletionRequestMessageContentPartText
Data)

instance FromJSON ChatCompletionRequestMessageContentPartText where
  parseJSON :: Value -> Parser ChatCompletionRequestMessageContentPartText
parseJSON = Options
-> Value -> Parser ChatCompletionRequestMessageContentPartText
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestMessageContentPartText")
instance ToJSON ChatCompletionRequestMessageContentPartText where
  toJSON :: ChatCompletionRequestMessageContentPartText -> Value
toJSON = Options -> ChatCompletionRequestMessageContentPartText -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestMessageContentPartText")


-- | 
data ChatCompletionRequestSystemMessage = ChatCompletionRequestSystemMessage
  { ChatCompletionRequestSystemMessage -> Text
chatCompletionRequestSystemMessageContent :: Text -- ^ The contents of the system message.
  , ChatCompletionRequestSystemMessage -> Text
chatCompletionRequestSystemMessageRole :: Text -- ^ The role of the messages author, in this case `system`.
  , ChatCompletionRequestSystemMessage -> Maybe Text
chatCompletionRequestSystemMessageName :: Maybe Text -- ^ An optional name for the participant. Provides the model information to differentiate between participants of the same role.
  } deriving (Int -> ChatCompletionRequestSystemMessage -> ShowS
[ChatCompletionRequestSystemMessage] -> ShowS
ChatCompletionRequestSystemMessage -> String
(Int -> ChatCompletionRequestSystemMessage -> ShowS)
-> (ChatCompletionRequestSystemMessage -> String)
-> ([ChatCompletionRequestSystemMessage] -> ShowS)
-> Show ChatCompletionRequestSystemMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestSystemMessage -> ShowS
showsPrec :: Int -> ChatCompletionRequestSystemMessage -> ShowS
$cshow :: ChatCompletionRequestSystemMessage -> String
show :: ChatCompletionRequestSystemMessage -> String
$cshowList :: [ChatCompletionRequestSystemMessage] -> ShowS
showList :: [ChatCompletionRequestSystemMessage] -> ShowS
Show, ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
(ChatCompletionRequestSystemMessage
 -> ChatCompletionRequestSystemMessage -> Bool)
-> (ChatCompletionRequestSystemMessage
    -> ChatCompletionRequestSystemMessage -> Bool)
-> Eq ChatCompletionRequestSystemMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
== :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
$c/= :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
/= :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
Eq, Eq ChatCompletionRequestSystemMessage
Eq ChatCompletionRequestSystemMessage =>
(ChatCompletionRequestSystemMessage
 -> ChatCompletionRequestSystemMessage -> Ordering)
-> (ChatCompletionRequestSystemMessage
    -> ChatCompletionRequestSystemMessage -> Bool)
-> (ChatCompletionRequestSystemMessage
    -> ChatCompletionRequestSystemMessage -> Bool)
-> (ChatCompletionRequestSystemMessage
    -> ChatCompletionRequestSystemMessage -> Bool)
-> (ChatCompletionRequestSystemMessage
    -> ChatCompletionRequestSystemMessage -> Bool)
-> (ChatCompletionRequestSystemMessage
    -> ChatCompletionRequestSystemMessage
    -> ChatCompletionRequestSystemMessage)
-> (ChatCompletionRequestSystemMessage
    -> ChatCompletionRequestSystemMessage
    -> ChatCompletionRequestSystemMessage)
-> Ord ChatCompletionRequestSystemMessage
ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Ordering
ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Ordering
compare :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Ordering
$c< :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
< :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
$c<= :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
<= :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
$c> :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
> :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
$c>= :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
>= :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage -> Bool
$cmax :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
max :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
$cmin :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
min :: ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
Ord, (forall x.
 ChatCompletionRequestSystemMessage
 -> Rep ChatCompletionRequestSystemMessage x)
-> (forall x.
    Rep ChatCompletionRequestSystemMessage x
    -> ChatCompletionRequestSystemMessage)
-> Generic ChatCompletionRequestSystemMessage
forall x.
Rep ChatCompletionRequestSystemMessage x
-> ChatCompletionRequestSystemMessage
forall x.
ChatCompletionRequestSystemMessage
-> Rep ChatCompletionRequestSystemMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestSystemMessage
-> Rep ChatCompletionRequestSystemMessage x
from :: forall x.
ChatCompletionRequestSystemMessage
-> Rep ChatCompletionRequestSystemMessage x
$cto :: forall x.
Rep ChatCompletionRequestSystemMessage x
-> ChatCompletionRequestSystemMessage
to :: forall x.
Rep ChatCompletionRequestSystemMessage x
-> ChatCompletionRequestSystemMessage
Generic, Typeable ChatCompletionRequestSystemMessage
Typeable ChatCompletionRequestSystemMessage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestSystemMessage
 -> c ChatCompletionRequestSystemMessage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestSystemMessage)
-> (ChatCompletionRequestSystemMessage -> Constr)
-> (ChatCompletionRequestSystemMessage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestSystemMessage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestSystemMessage))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestSystemMessage
    -> ChatCompletionRequestSystemMessage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestSystemMessage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestSystemMessage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestSystemMessage -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestSystemMessage
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestSystemMessage
    -> m ChatCompletionRequestSystemMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestSystemMessage
    -> m ChatCompletionRequestSystemMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestSystemMessage
    -> m ChatCompletionRequestSystemMessage)
-> Data ChatCompletionRequestSystemMessage
ChatCompletionRequestSystemMessage -> Constr
ChatCompletionRequestSystemMessage -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestSystemMessage
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestSystemMessage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestSystemMessage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestSystemMessage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestSystemMessage
-> m ChatCompletionRequestSystemMessage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestSystemMessage
-> m ChatCompletionRequestSystemMessage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestSystemMessage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestSystemMessage
-> c ChatCompletionRequestSystemMessage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestSystemMessage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestSystemMessage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestSystemMessage
-> c ChatCompletionRequestSystemMessage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestSystemMessage
-> c ChatCompletionRequestSystemMessage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestSystemMessage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestSystemMessage
$ctoConstr :: ChatCompletionRequestSystemMessage -> Constr
toConstr :: ChatCompletionRequestSystemMessage -> Constr
$cdataTypeOf :: ChatCompletionRequestSystemMessage -> DataType
dataTypeOf :: ChatCompletionRequestSystemMessage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestSystemMessage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestSystemMessage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestSystemMessage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestSystemMessage)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestSystemMessage
-> ChatCompletionRequestSystemMessage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestSystemMessage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestSystemMessage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestSystemMessage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestSystemMessage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestSystemMessage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestSystemMessage -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestSystemMessage
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestSystemMessage
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestSystemMessage
-> m ChatCompletionRequestSystemMessage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestSystemMessage
-> m ChatCompletionRequestSystemMessage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestSystemMessage
-> m ChatCompletionRequestSystemMessage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestSystemMessage
-> m ChatCompletionRequestSystemMessage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestSystemMessage
-> m ChatCompletionRequestSystemMessage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestSystemMessage
-> m ChatCompletionRequestSystemMessage
Data)

instance FromJSON ChatCompletionRequestSystemMessage where
  parseJSON :: Value -> Parser ChatCompletionRequestSystemMessage
parseJSON = Options -> Value -> Parser ChatCompletionRequestSystemMessage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestSystemMessage")
instance ToJSON ChatCompletionRequestSystemMessage where
  toJSON :: ChatCompletionRequestSystemMessage -> Value
toJSON = Options -> ChatCompletionRequestSystemMessage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestSystemMessage")


-- | 
data ChatCompletionRequestToolMessage = ChatCompletionRequestToolMessage
  { ChatCompletionRequestToolMessage -> Text
chatCompletionRequestToolMessageRole :: Text -- ^ The role of the messages author, in this case `tool`.
  , ChatCompletionRequestToolMessage -> Text
chatCompletionRequestToolMessageContent :: Text -- ^ The contents of the tool message.
  , ChatCompletionRequestToolMessage -> Text
chatCompletionRequestToolMessageToolUnderscorecallUnderscoreid :: Text -- ^ Tool call that this message is responding to.
  } deriving (Int -> ChatCompletionRequestToolMessage -> ShowS
[ChatCompletionRequestToolMessage] -> ShowS
ChatCompletionRequestToolMessage -> String
(Int -> ChatCompletionRequestToolMessage -> ShowS)
-> (ChatCompletionRequestToolMessage -> String)
-> ([ChatCompletionRequestToolMessage] -> ShowS)
-> Show ChatCompletionRequestToolMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestToolMessage -> ShowS
showsPrec :: Int -> ChatCompletionRequestToolMessage -> ShowS
$cshow :: ChatCompletionRequestToolMessage -> String
show :: ChatCompletionRequestToolMessage -> String
$cshowList :: [ChatCompletionRequestToolMessage] -> ShowS
showList :: [ChatCompletionRequestToolMessage] -> ShowS
Show, ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
(ChatCompletionRequestToolMessage
 -> ChatCompletionRequestToolMessage -> Bool)
-> (ChatCompletionRequestToolMessage
    -> ChatCompletionRequestToolMessage -> Bool)
-> Eq ChatCompletionRequestToolMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
== :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
$c/= :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
/= :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
Eq, Eq ChatCompletionRequestToolMessage
Eq ChatCompletionRequestToolMessage =>
(ChatCompletionRequestToolMessage
 -> ChatCompletionRequestToolMessage -> Ordering)
-> (ChatCompletionRequestToolMessage
    -> ChatCompletionRequestToolMessage -> Bool)
-> (ChatCompletionRequestToolMessage
    -> ChatCompletionRequestToolMessage -> Bool)
-> (ChatCompletionRequestToolMessage
    -> ChatCompletionRequestToolMessage -> Bool)
-> (ChatCompletionRequestToolMessage
    -> ChatCompletionRequestToolMessage -> Bool)
-> (ChatCompletionRequestToolMessage
    -> ChatCompletionRequestToolMessage
    -> ChatCompletionRequestToolMessage)
-> (ChatCompletionRequestToolMessage
    -> ChatCompletionRequestToolMessage
    -> ChatCompletionRequestToolMessage)
-> Ord ChatCompletionRequestToolMessage
ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Ordering
ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Ordering
compare :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Ordering
$c< :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
< :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
$c<= :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
<= :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
$c> :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
> :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
$c>= :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
>= :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage -> Bool
$cmax :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
max :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
$cmin :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
min :: ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
Ord, (forall x.
 ChatCompletionRequestToolMessage
 -> Rep ChatCompletionRequestToolMessage x)
-> (forall x.
    Rep ChatCompletionRequestToolMessage x
    -> ChatCompletionRequestToolMessage)
-> Generic ChatCompletionRequestToolMessage
forall x.
Rep ChatCompletionRequestToolMessage x
-> ChatCompletionRequestToolMessage
forall x.
ChatCompletionRequestToolMessage
-> Rep ChatCompletionRequestToolMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestToolMessage
-> Rep ChatCompletionRequestToolMessage x
from :: forall x.
ChatCompletionRequestToolMessage
-> Rep ChatCompletionRequestToolMessage x
$cto :: forall x.
Rep ChatCompletionRequestToolMessage x
-> ChatCompletionRequestToolMessage
to :: forall x.
Rep ChatCompletionRequestToolMessage x
-> ChatCompletionRequestToolMessage
Generic, Typeable ChatCompletionRequestToolMessage
Typeable ChatCompletionRequestToolMessage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestToolMessage
 -> c ChatCompletionRequestToolMessage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestToolMessage)
-> (ChatCompletionRequestToolMessage -> Constr)
-> (ChatCompletionRequestToolMessage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestToolMessage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestToolMessage))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestToolMessage
    -> ChatCompletionRequestToolMessage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestToolMessage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestToolMessage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestToolMessage -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestToolMessage
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestToolMessage
    -> m ChatCompletionRequestToolMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestToolMessage
    -> m ChatCompletionRequestToolMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestToolMessage
    -> m ChatCompletionRequestToolMessage)
-> Data ChatCompletionRequestToolMessage
ChatCompletionRequestToolMessage -> Constr
ChatCompletionRequestToolMessage -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestToolMessage
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestToolMessage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestToolMessage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestToolMessage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestToolMessage
-> m ChatCompletionRequestToolMessage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestToolMessage
-> m ChatCompletionRequestToolMessage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestToolMessage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestToolMessage
-> c ChatCompletionRequestToolMessage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestToolMessage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestToolMessage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestToolMessage
-> c ChatCompletionRequestToolMessage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestToolMessage
-> c ChatCompletionRequestToolMessage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestToolMessage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestToolMessage
$ctoConstr :: ChatCompletionRequestToolMessage -> Constr
toConstr :: ChatCompletionRequestToolMessage -> Constr
$cdataTypeOf :: ChatCompletionRequestToolMessage -> DataType
dataTypeOf :: ChatCompletionRequestToolMessage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestToolMessage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestToolMessage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestToolMessage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestToolMessage)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestToolMessage
-> ChatCompletionRequestToolMessage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestToolMessage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestToolMessage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestToolMessage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestToolMessage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestToolMessage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestToolMessage -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestToolMessage
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestToolMessage
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestToolMessage
-> m ChatCompletionRequestToolMessage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestToolMessage
-> m ChatCompletionRequestToolMessage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestToolMessage
-> m ChatCompletionRequestToolMessage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestToolMessage
-> m ChatCompletionRequestToolMessage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestToolMessage
-> m ChatCompletionRequestToolMessage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestToolMessage
-> m ChatCompletionRequestToolMessage
Data)

instance FromJSON ChatCompletionRequestToolMessage where
  parseJSON :: Value -> Parser ChatCompletionRequestToolMessage
parseJSON = Options -> Value -> Parser ChatCompletionRequestToolMessage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestToolMessage")
instance ToJSON ChatCompletionRequestToolMessage where
  toJSON :: ChatCompletionRequestToolMessage -> Value
toJSON = Options -> ChatCompletionRequestToolMessage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestToolMessage")


-- | 
data ChatCompletionRequestUserMessage = ChatCompletionRequestUserMessage
  { ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessageContent
chatCompletionRequestUserMessageContent :: ChatCompletionRequestUserMessageContent -- ^ 
  , ChatCompletionRequestUserMessage -> Text
chatCompletionRequestUserMessageRole :: Text -- ^ The role of the messages author, in this case `user`.
  , ChatCompletionRequestUserMessage -> Maybe Text
chatCompletionRequestUserMessageName :: Maybe Text -- ^ An optional name for the participant. Provides the model information to differentiate between participants of the same role.
  } deriving (Int -> ChatCompletionRequestUserMessage -> ShowS
[ChatCompletionRequestUserMessage] -> ShowS
ChatCompletionRequestUserMessage -> String
(Int -> ChatCompletionRequestUserMessage -> ShowS)
-> (ChatCompletionRequestUserMessage -> String)
-> ([ChatCompletionRequestUserMessage] -> ShowS)
-> Show ChatCompletionRequestUserMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestUserMessage -> ShowS
showsPrec :: Int -> ChatCompletionRequestUserMessage -> ShowS
$cshow :: ChatCompletionRequestUserMessage -> String
show :: ChatCompletionRequestUserMessage -> String
$cshowList :: [ChatCompletionRequestUserMessage] -> ShowS
showList :: [ChatCompletionRequestUserMessage] -> ShowS
Show, ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
(ChatCompletionRequestUserMessage
 -> ChatCompletionRequestUserMessage -> Bool)
-> (ChatCompletionRequestUserMessage
    -> ChatCompletionRequestUserMessage -> Bool)
-> Eq ChatCompletionRequestUserMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
== :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
$c/= :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
/= :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
Eq, Eq ChatCompletionRequestUserMessage
Eq ChatCompletionRequestUserMessage =>
(ChatCompletionRequestUserMessage
 -> ChatCompletionRequestUserMessage -> Ordering)
-> (ChatCompletionRequestUserMessage
    -> ChatCompletionRequestUserMessage -> Bool)
-> (ChatCompletionRequestUserMessage
    -> ChatCompletionRequestUserMessage -> Bool)
-> (ChatCompletionRequestUserMessage
    -> ChatCompletionRequestUserMessage -> Bool)
-> (ChatCompletionRequestUserMessage
    -> ChatCompletionRequestUserMessage -> Bool)
-> (ChatCompletionRequestUserMessage
    -> ChatCompletionRequestUserMessage
    -> ChatCompletionRequestUserMessage)
-> (ChatCompletionRequestUserMessage
    -> ChatCompletionRequestUserMessage
    -> ChatCompletionRequestUserMessage)
-> Ord ChatCompletionRequestUserMessage
ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Ordering
ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Ordering
compare :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Ordering
$c< :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
< :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
$c<= :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
<= :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
$c> :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
> :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
$c>= :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
>= :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage -> Bool
$cmax :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
max :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
$cmin :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
min :: ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
Ord, (forall x.
 ChatCompletionRequestUserMessage
 -> Rep ChatCompletionRequestUserMessage x)
-> (forall x.
    Rep ChatCompletionRequestUserMessage x
    -> ChatCompletionRequestUserMessage)
-> Generic ChatCompletionRequestUserMessage
forall x.
Rep ChatCompletionRequestUserMessage x
-> ChatCompletionRequestUserMessage
forall x.
ChatCompletionRequestUserMessage
-> Rep ChatCompletionRequestUserMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestUserMessage
-> Rep ChatCompletionRequestUserMessage x
from :: forall x.
ChatCompletionRequestUserMessage
-> Rep ChatCompletionRequestUserMessage x
$cto :: forall x.
Rep ChatCompletionRequestUserMessage x
-> ChatCompletionRequestUserMessage
to :: forall x.
Rep ChatCompletionRequestUserMessage x
-> ChatCompletionRequestUserMessage
Generic, Typeable ChatCompletionRequestUserMessage
Typeable ChatCompletionRequestUserMessage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestUserMessage
 -> c ChatCompletionRequestUserMessage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestUserMessage)
-> (ChatCompletionRequestUserMessage -> Constr)
-> (ChatCompletionRequestUserMessage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestUserMessage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestUserMessage))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestUserMessage
    -> ChatCompletionRequestUserMessage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestUserMessage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestUserMessage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestUserMessage -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestUserMessage
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestUserMessage
    -> m ChatCompletionRequestUserMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestUserMessage
    -> m ChatCompletionRequestUserMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestUserMessage
    -> m ChatCompletionRequestUserMessage)
-> Data ChatCompletionRequestUserMessage
ChatCompletionRequestUserMessage -> Constr
ChatCompletionRequestUserMessage -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessage
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessage
-> m ChatCompletionRequestUserMessage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessage
-> m ChatCompletionRequestUserMessage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestUserMessage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestUserMessage
-> c ChatCompletionRequestUserMessage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestUserMessage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestUserMessage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestUserMessage
-> c ChatCompletionRequestUserMessage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestUserMessage
-> c ChatCompletionRequestUserMessage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestUserMessage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestUserMessage
$ctoConstr :: ChatCompletionRequestUserMessage -> Constr
toConstr :: ChatCompletionRequestUserMessage -> Constr
$cdataTypeOf :: ChatCompletionRequestUserMessage -> DataType
dataTypeOf :: ChatCompletionRequestUserMessage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestUserMessage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestUserMessage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestUserMessage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestUserMessage)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestUserMessage
-> ChatCompletionRequestUserMessage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessage -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessage
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessage
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessage
-> m ChatCompletionRequestUserMessage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessage
-> m ChatCompletionRequestUserMessage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessage
-> m ChatCompletionRequestUserMessage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessage
-> m ChatCompletionRequestUserMessage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessage
-> m ChatCompletionRequestUserMessage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessage
-> m ChatCompletionRequestUserMessage
Data)

instance FromJSON ChatCompletionRequestUserMessage where
  parseJSON :: Value -> Parser ChatCompletionRequestUserMessage
parseJSON = Options -> Value -> Parser ChatCompletionRequestUserMessage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestUserMessage")
instance ToJSON ChatCompletionRequestUserMessage where
  toJSON :: ChatCompletionRequestUserMessage -> Value
toJSON = Options -> ChatCompletionRequestUserMessage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestUserMessage")


-- | The contents of the user message. 
data ChatCompletionRequestUserMessageContent = ChatCompletionRequestUserMessageContent
  { 
  } deriving (Int -> ChatCompletionRequestUserMessageContent -> ShowS
[ChatCompletionRequestUserMessageContent] -> ShowS
ChatCompletionRequestUserMessageContent -> String
(Int -> ChatCompletionRequestUserMessageContent -> ShowS)
-> (ChatCompletionRequestUserMessageContent -> String)
-> ([ChatCompletionRequestUserMessageContent] -> ShowS)
-> Show ChatCompletionRequestUserMessageContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRequestUserMessageContent -> ShowS
showsPrec :: Int -> ChatCompletionRequestUserMessageContent -> ShowS
$cshow :: ChatCompletionRequestUserMessageContent -> String
show :: ChatCompletionRequestUserMessageContent -> String
$cshowList :: [ChatCompletionRequestUserMessageContent] -> ShowS
showList :: [ChatCompletionRequestUserMessageContent] -> ShowS
Show, ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
(ChatCompletionRequestUserMessageContent
 -> ChatCompletionRequestUserMessageContent -> Bool)
-> (ChatCompletionRequestUserMessageContent
    -> ChatCompletionRequestUserMessageContent -> Bool)
-> Eq ChatCompletionRequestUserMessageContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
== :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
$c/= :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
/= :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
Eq, Eq ChatCompletionRequestUserMessageContent
Eq ChatCompletionRequestUserMessageContent =>
(ChatCompletionRequestUserMessageContent
 -> ChatCompletionRequestUserMessageContent -> Ordering)
-> (ChatCompletionRequestUserMessageContent
    -> ChatCompletionRequestUserMessageContent -> Bool)
-> (ChatCompletionRequestUserMessageContent
    -> ChatCompletionRequestUserMessageContent -> Bool)
-> (ChatCompletionRequestUserMessageContent
    -> ChatCompletionRequestUserMessageContent -> Bool)
-> (ChatCompletionRequestUserMessageContent
    -> ChatCompletionRequestUserMessageContent -> Bool)
-> (ChatCompletionRequestUserMessageContent
    -> ChatCompletionRequestUserMessageContent
    -> ChatCompletionRequestUserMessageContent)
-> (ChatCompletionRequestUserMessageContent
    -> ChatCompletionRequestUserMessageContent
    -> ChatCompletionRequestUserMessageContent)
-> Ord ChatCompletionRequestUserMessageContent
ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Ordering
ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Ordering
compare :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Ordering
$c< :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
< :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
$c<= :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
<= :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
$c> :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
> :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
$c>= :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
>= :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent -> Bool
$cmax :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
max :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
$cmin :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
min :: ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
Ord, (forall x.
 ChatCompletionRequestUserMessageContent
 -> Rep ChatCompletionRequestUserMessageContent x)
-> (forall x.
    Rep ChatCompletionRequestUserMessageContent x
    -> ChatCompletionRequestUserMessageContent)
-> Generic ChatCompletionRequestUserMessageContent
forall x.
Rep ChatCompletionRequestUserMessageContent x
-> ChatCompletionRequestUserMessageContent
forall x.
ChatCompletionRequestUserMessageContent
-> Rep ChatCompletionRequestUserMessageContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionRequestUserMessageContent
-> Rep ChatCompletionRequestUserMessageContent x
from :: forall x.
ChatCompletionRequestUserMessageContent
-> Rep ChatCompletionRequestUserMessageContent x
$cto :: forall x.
Rep ChatCompletionRequestUserMessageContent x
-> ChatCompletionRequestUserMessageContent
to :: forall x.
Rep ChatCompletionRequestUserMessageContent x
-> ChatCompletionRequestUserMessageContent
Generic, Typeable ChatCompletionRequestUserMessageContent
Typeable ChatCompletionRequestUserMessageContent =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRequestUserMessageContent
 -> c ChatCompletionRequestUserMessageContent)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionRequestUserMessageContent)
-> (ChatCompletionRequestUserMessageContent -> Constr)
-> (ChatCompletionRequestUserMessageContent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionRequestUserMessageContent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRequestUserMessageContent))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRequestUserMessageContent
    -> ChatCompletionRequestUserMessageContent)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestUserMessageContent
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionRequestUserMessageContent
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionRequestUserMessageContent -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionRequestUserMessageContent
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestUserMessageContent
    -> m ChatCompletionRequestUserMessageContent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestUserMessageContent
    -> m ChatCompletionRequestUserMessageContent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRequestUserMessageContent
    -> m ChatCompletionRequestUserMessageContent)
-> Data ChatCompletionRequestUserMessageContent
ChatCompletionRequestUserMessageContent -> Constr
ChatCompletionRequestUserMessageContent -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessageContent
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessageContent -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessageContent
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessageContent
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessageContent
-> m ChatCompletionRequestUserMessageContent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessageContent
-> m ChatCompletionRequestUserMessageContent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestUserMessageContent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestUserMessageContent
-> c ChatCompletionRequestUserMessageContent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestUserMessageContent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestUserMessageContent)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestUserMessageContent
-> c ChatCompletionRequestUserMessageContent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRequestUserMessageContent
-> c ChatCompletionRequestUserMessageContent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestUserMessageContent
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionRequestUserMessageContent
$ctoConstr :: ChatCompletionRequestUserMessageContent -> Constr
toConstr :: ChatCompletionRequestUserMessageContent -> Constr
$cdataTypeOf :: ChatCompletionRequestUserMessageContent -> DataType
dataTypeOf :: ChatCompletionRequestUserMessageContent -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestUserMessageContent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionRequestUserMessageContent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestUserMessageContent)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRequestUserMessageContent)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRequestUserMessageContent
-> ChatCompletionRequestUserMessageContent
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessageContent
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessageContent
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessageContent
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionRequestUserMessageContent
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessageContent -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessageContent -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessageContent
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionRequestUserMessageContent
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessageContent
-> m ChatCompletionRequestUserMessageContent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessageContent
-> m ChatCompletionRequestUserMessageContent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessageContent
-> m ChatCompletionRequestUserMessageContent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessageContent
-> m ChatCompletionRequestUserMessageContent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessageContent
-> m ChatCompletionRequestUserMessageContent
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRequestUserMessageContent
-> m ChatCompletionRequestUserMessageContent
Data)

instance FromJSON ChatCompletionRequestUserMessageContent where
  parseJSON :: Value -> Parser ChatCompletionRequestUserMessageContent
parseJSON = Options -> Value -> Parser ChatCompletionRequestUserMessageContent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestUserMessageContent")
instance ToJSON ChatCompletionRequestUserMessageContent where
  toJSON :: ChatCompletionRequestUserMessageContent -> Value
  toJSON :: ChatCompletionRequestUserMessageContent -> Value
toJSON = Options -> ChatCompletionRequestUserMessageContent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRequestUserMessageContent")


-- | A chat completion message generated by the model.
data ChatCompletionResponseMessage = ChatCompletionResponseMessage
  { ChatCompletionResponseMessage -> Maybe Text
chatCompletionResponseMessageContent :: Maybe Text -- ^ The contents of the message.
  , ChatCompletionResponseMessage
-> Maybe [ChatCompletionMessageToolCall]
chatCompletionResponseMessageToolUnderscorecalls :: Maybe [ChatCompletionMessageToolCall] -- ^ The tool calls generated by the model, such as function calls.
  , ChatCompletionResponseMessage -> Text
chatCompletionResponseMessageRole :: Text -- ^ The role of the author of this message.
  , ChatCompletionResponseMessage
-> Maybe ChatCompletionRequestAssistantMessageFunctionCall
chatCompletionResponseMessageFunctionUnderscorecall :: Maybe ChatCompletionRequestAssistantMessageFunctionCall -- ^ 
  } deriving (Int -> ChatCompletionResponseMessage -> ShowS
[ChatCompletionResponseMessage] -> ShowS
ChatCompletionResponseMessage -> String
(Int -> ChatCompletionResponseMessage -> ShowS)
-> (ChatCompletionResponseMessage -> String)
-> ([ChatCompletionResponseMessage] -> ShowS)
-> Show ChatCompletionResponseMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionResponseMessage -> ShowS
showsPrec :: Int -> ChatCompletionResponseMessage -> ShowS
$cshow :: ChatCompletionResponseMessage -> String
show :: ChatCompletionResponseMessage -> String
$cshowList :: [ChatCompletionResponseMessage] -> ShowS
showList :: [ChatCompletionResponseMessage] -> ShowS
Show, ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
(ChatCompletionResponseMessage
 -> ChatCompletionResponseMessage -> Bool)
-> (ChatCompletionResponseMessage
    -> ChatCompletionResponseMessage -> Bool)
-> Eq ChatCompletionResponseMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
== :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
$c/= :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
/= :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
Eq, Eq ChatCompletionResponseMessage
Eq ChatCompletionResponseMessage =>
(ChatCompletionResponseMessage
 -> ChatCompletionResponseMessage -> Ordering)
-> (ChatCompletionResponseMessage
    -> ChatCompletionResponseMessage -> Bool)
-> (ChatCompletionResponseMessage
    -> ChatCompletionResponseMessage -> Bool)
-> (ChatCompletionResponseMessage
    -> ChatCompletionResponseMessage -> Bool)
-> (ChatCompletionResponseMessage
    -> ChatCompletionResponseMessage -> Bool)
-> (ChatCompletionResponseMessage
    -> ChatCompletionResponseMessage -> ChatCompletionResponseMessage)
-> (ChatCompletionResponseMessage
    -> ChatCompletionResponseMessage -> ChatCompletionResponseMessage)
-> Ord ChatCompletionResponseMessage
ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Ordering
ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> ChatCompletionResponseMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Ordering
compare :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Ordering
$c< :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
< :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
$c<= :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
<= :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
$c> :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
> :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
$c>= :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
>= :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> Bool
$cmax :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> ChatCompletionResponseMessage
max :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> ChatCompletionResponseMessage
$cmin :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> ChatCompletionResponseMessage
min :: ChatCompletionResponseMessage
-> ChatCompletionResponseMessage -> ChatCompletionResponseMessage
Ord, (forall x.
 ChatCompletionResponseMessage
 -> Rep ChatCompletionResponseMessage x)
-> (forall x.
    Rep ChatCompletionResponseMessage x
    -> ChatCompletionResponseMessage)
-> Generic ChatCompletionResponseMessage
forall x.
Rep ChatCompletionResponseMessage x
-> ChatCompletionResponseMessage
forall x.
ChatCompletionResponseMessage
-> Rep ChatCompletionResponseMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionResponseMessage
-> Rep ChatCompletionResponseMessage x
from :: forall x.
ChatCompletionResponseMessage
-> Rep ChatCompletionResponseMessage x
$cto :: forall x.
Rep ChatCompletionResponseMessage x
-> ChatCompletionResponseMessage
to :: forall x.
Rep ChatCompletionResponseMessage x
-> ChatCompletionResponseMessage
Generic, Typeable ChatCompletionResponseMessage
Typeable ChatCompletionResponseMessage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionResponseMessage
 -> c ChatCompletionResponseMessage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionResponseMessage)
-> (ChatCompletionResponseMessage -> Constr)
-> (ChatCompletionResponseMessage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionResponseMessage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionResponseMessage))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionResponseMessage -> ChatCompletionResponseMessage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionResponseMessage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionResponseMessage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionResponseMessage -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionResponseMessage
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionResponseMessage
    -> m ChatCompletionResponseMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionResponseMessage
    -> m ChatCompletionResponseMessage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionResponseMessage
    -> m ChatCompletionResponseMessage)
-> Data ChatCompletionResponseMessage
ChatCompletionResponseMessage -> Constr
ChatCompletionResponseMessage -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionResponseMessage -> ChatCompletionResponseMessage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionResponseMessage
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionResponseMessage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionResponseMessage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionResponseMessage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionResponseMessage -> m ChatCompletionResponseMessage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionResponseMessage -> m ChatCompletionResponseMessage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionResponseMessage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionResponseMessage
-> c ChatCompletionResponseMessage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionResponseMessage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionResponseMessage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionResponseMessage
-> c ChatCompletionResponseMessage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionResponseMessage
-> c ChatCompletionResponseMessage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionResponseMessage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionResponseMessage
$ctoConstr :: ChatCompletionResponseMessage -> Constr
toConstr :: ChatCompletionResponseMessage -> Constr
$cdataTypeOf :: ChatCompletionResponseMessage -> DataType
dataTypeOf :: ChatCompletionResponseMessage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionResponseMessage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionResponseMessage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionResponseMessage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionResponseMessage)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionResponseMessage -> ChatCompletionResponseMessage
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionResponseMessage -> ChatCompletionResponseMessage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionResponseMessage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionResponseMessage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionResponseMessage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionResponseMessage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionResponseMessage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionResponseMessage -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionResponseMessage
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionResponseMessage
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionResponseMessage -> m ChatCompletionResponseMessage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionResponseMessage -> m ChatCompletionResponseMessage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionResponseMessage -> m ChatCompletionResponseMessage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionResponseMessage -> m ChatCompletionResponseMessage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionResponseMessage -> m ChatCompletionResponseMessage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionResponseMessage -> m ChatCompletionResponseMessage
Data)

instance FromJSON ChatCompletionResponseMessage where
  parseJSON :: Value -> Parser ChatCompletionResponseMessage
parseJSON = Options -> Value -> Parser ChatCompletionResponseMessage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionResponseMessage")
instance ToJSON ChatCompletionResponseMessage where
  toJSON :: ChatCompletionResponseMessage -> Value
toJSON = Options -> ChatCompletionResponseMessage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionResponseMessage")


-- | The role of the author of a message
data ChatCompletionRole = ChatCompletionRole
  { 
  } deriving (Int -> ChatCompletionRole -> ShowS
[ChatCompletionRole] -> ShowS
ChatCompletionRole -> String
(Int -> ChatCompletionRole -> ShowS)
-> (ChatCompletionRole -> String)
-> ([ChatCompletionRole] -> ShowS)
-> Show ChatCompletionRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionRole -> ShowS
showsPrec :: Int -> ChatCompletionRole -> ShowS
$cshow :: ChatCompletionRole -> String
show :: ChatCompletionRole -> String
$cshowList :: [ChatCompletionRole] -> ShowS
showList :: [ChatCompletionRole] -> ShowS
Show, ChatCompletionRole -> ChatCompletionRole -> Bool
(ChatCompletionRole -> ChatCompletionRole -> Bool)
-> (ChatCompletionRole -> ChatCompletionRole -> Bool)
-> Eq ChatCompletionRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionRole -> ChatCompletionRole -> Bool
== :: ChatCompletionRole -> ChatCompletionRole -> Bool
$c/= :: ChatCompletionRole -> ChatCompletionRole -> Bool
/= :: ChatCompletionRole -> ChatCompletionRole -> Bool
Eq, Eq ChatCompletionRole
Eq ChatCompletionRole =>
(ChatCompletionRole -> ChatCompletionRole -> Ordering)
-> (ChatCompletionRole -> ChatCompletionRole -> Bool)
-> (ChatCompletionRole -> ChatCompletionRole -> Bool)
-> (ChatCompletionRole -> ChatCompletionRole -> Bool)
-> (ChatCompletionRole -> ChatCompletionRole -> Bool)
-> (ChatCompletionRole -> ChatCompletionRole -> ChatCompletionRole)
-> (ChatCompletionRole -> ChatCompletionRole -> ChatCompletionRole)
-> Ord ChatCompletionRole
ChatCompletionRole -> ChatCompletionRole -> Bool
ChatCompletionRole -> ChatCompletionRole -> Ordering
ChatCompletionRole -> ChatCompletionRole -> ChatCompletionRole
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionRole -> ChatCompletionRole -> Ordering
compare :: ChatCompletionRole -> ChatCompletionRole -> Ordering
$c< :: ChatCompletionRole -> ChatCompletionRole -> Bool
< :: ChatCompletionRole -> ChatCompletionRole -> Bool
$c<= :: ChatCompletionRole -> ChatCompletionRole -> Bool
<= :: ChatCompletionRole -> ChatCompletionRole -> Bool
$c> :: ChatCompletionRole -> ChatCompletionRole -> Bool
> :: ChatCompletionRole -> ChatCompletionRole -> Bool
$c>= :: ChatCompletionRole -> ChatCompletionRole -> Bool
>= :: ChatCompletionRole -> ChatCompletionRole -> Bool
$cmax :: ChatCompletionRole -> ChatCompletionRole -> ChatCompletionRole
max :: ChatCompletionRole -> ChatCompletionRole -> ChatCompletionRole
$cmin :: ChatCompletionRole -> ChatCompletionRole -> ChatCompletionRole
min :: ChatCompletionRole -> ChatCompletionRole -> ChatCompletionRole
Ord, (forall x. ChatCompletionRole -> Rep ChatCompletionRole x)
-> (forall x. Rep ChatCompletionRole x -> ChatCompletionRole)
-> Generic ChatCompletionRole
forall x. Rep ChatCompletionRole x -> ChatCompletionRole
forall x. ChatCompletionRole -> Rep ChatCompletionRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChatCompletionRole -> Rep ChatCompletionRole x
from :: forall x. ChatCompletionRole -> Rep ChatCompletionRole x
$cto :: forall x. Rep ChatCompletionRole x -> ChatCompletionRole
to :: forall x. Rep ChatCompletionRole x -> ChatCompletionRole
Generic, Typeable ChatCompletionRole
Typeable ChatCompletionRole =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionRole
 -> c ChatCompletionRole)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ChatCompletionRole)
-> (ChatCompletionRole -> Constr)
-> (ChatCompletionRole -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ChatCompletionRole))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionRole))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionRole -> ChatCompletionRole)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ChatCompletionRole -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ChatCompletionRole -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ChatCompletionRole -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ChatCompletionRole -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRole -> m ChatCompletionRole)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRole -> m ChatCompletionRole)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionRole -> m ChatCompletionRole)
-> Data ChatCompletionRole
ChatCompletionRole -> Constr
ChatCompletionRole -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionRole -> ChatCompletionRole
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ChatCompletionRole -> u
forall u. (forall d. Data d => d -> u) -> ChatCompletionRole -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionRole -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionRole -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRole -> m ChatCompletionRole
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRole -> m ChatCompletionRole
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionRole
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRole
-> c ChatCompletionRole
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChatCompletionRole)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRole)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRole
-> c ChatCompletionRole
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionRole
-> c ChatCompletionRole
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionRole
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionRole
$ctoConstr :: ChatCompletionRole -> Constr
toConstr :: ChatCompletionRole -> Constr
$cdataTypeOf :: ChatCompletionRole -> DataType
dataTypeOf :: ChatCompletionRole -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChatCompletionRole)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChatCompletionRole)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRole)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionRole)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRole -> ChatCompletionRole
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionRole -> ChatCompletionRole
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionRole -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionRole -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionRole -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionRole -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ChatCompletionRole -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ChatCompletionRole -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ChatCompletionRole -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ChatCompletionRole -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRole -> m ChatCompletionRole
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRole -> m ChatCompletionRole
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRole -> m ChatCompletionRole
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRole -> m ChatCompletionRole
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRole -> m ChatCompletionRole
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionRole -> m ChatCompletionRole
Data)

instance FromJSON ChatCompletionRole where
  parseJSON :: Value -> Parser ChatCompletionRole
parseJSON = Options -> Value -> Parser ChatCompletionRole
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRole")
instance ToJSON ChatCompletionRole where
  toJSON :: ChatCompletionRole -> Value
toJSON = Options -> ChatCompletionRole -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionRole")


-- | A chat completion delta generated by streamed model responses.
data ChatCompletionStreamResponseDelta = ChatCompletionStreamResponseDelta
  { ChatCompletionStreamResponseDelta -> Maybe Text
chatCompletionStreamResponseDeltaContent :: Maybe Text -- ^ The contents of the chunk message.
  , ChatCompletionStreamResponseDelta
-> Maybe ChatCompletionStreamResponseDeltaFunctionCall
chatCompletionStreamResponseDeltaFunctionUnderscorecall :: Maybe ChatCompletionStreamResponseDeltaFunctionCall -- ^ 
  , ChatCompletionStreamResponseDelta
-> Maybe [ChatCompletionMessageToolCallChunk]
chatCompletionStreamResponseDeltaToolUnderscorecalls :: Maybe [ChatCompletionMessageToolCallChunk] -- ^ 
  , ChatCompletionStreamResponseDelta -> Maybe Text
chatCompletionStreamResponseDeltaRole :: Maybe Text -- ^ The role of the author of this message.
  } deriving (Int -> ChatCompletionStreamResponseDelta -> ShowS
[ChatCompletionStreamResponseDelta] -> ShowS
ChatCompletionStreamResponseDelta -> String
(Int -> ChatCompletionStreamResponseDelta -> ShowS)
-> (ChatCompletionStreamResponseDelta -> String)
-> ([ChatCompletionStreamResponseDelta] -> ShowS)
-> Show ChatCompletionStreamResponseDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionStreamResponseDelta -> ShowS
showsPrec :: Int -> ChatCompletionStreamResponseDelta -> ShowS
$cshow :: ChatCompletionStreamResponseDelta -> String
show :: ChatCompletionStreamResponseDelta -> String
$cshowList :: [ChatCompletionStreamResponseDelta] -> ShowS
showList :: [ChatCompletionStreamResponseDelta] -> ShowS
Show, ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
(ChatCompletionStreamResponseDelta
 -> ChatCompletionStreamResponseDelta -> Bool)
-> (ChatCompletionStreamResponseDelta
    -> ChatCompletionStreamResponseDelta -> Bool)
-> Eq ChatCompletionStreamResponseDelta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
== :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
$c/= :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
/= :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
Eq, Eq ChatCompletionStreamResponseDelta
Eq ChatCompletionStreamResponseDelta =>
(ChatCompletionStreamResponseDelta
 -> ChatCompletionStreamResponseDelta -> Ordering)
-> (ChatCompletionStreamResponseDelta
    -> ChatCompletionStreamResponseDelta -> Bool)
-> (ChatCompletionStreamResponseDelta
    -> ChatCompletionStreamResponseDelta -> Bool)
-> (ChatCompletionStreamResponseDelta
    -> ChatCompletionStreamResponseDelta -> Bool)
-> (ChatCompletionStreamResponseDelta
    -> ChatCompletionStreamResponseDelta -> Bool)
-> (ChatCompletionStreamResponseDelta
    -> ChatCompletionStreamResponseDelta
    -> ChatCompletionStreamResponseDelta)
-> (ChatCompletionStreamResponseDelta
    -> ChatCompletionStreamResponseDelta
    -> ChatCompletionStreamResponseDelta)
-> Ord ChatCompletionStreamResponseDelta
ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Ordering
ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Ordering
compare :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Ordering
$c< :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
< :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
$c<= :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
<= :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
$c> :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
> :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
$c>= :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
>= :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta -> Bool
$cmax :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
max :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
$cmin :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
min :: ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
Ord, (forall x.
 ChatCompletionStreamResponseDelta
 -> Rep ChatCompletionStreamResponseDelta x)
-> (forall x.
    Rep ChatCompletionStreamResponseDelta x
    -> ChatCompletionStreamResponseDelta)
-> Generic ChatCompletionStreamResponseDelta
forall x.
Rep ChatCompletionStreamResponseDelta x
-> ChatCompletionStreamResponseDelta
forall x.
ChatCompletionStreamResponseDelta
-> Rep ChatCompletionStreamResponseDelta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionStreamResponseDelta
-> Rep ChatCompletionStreamResponseDelta x
from :: forall x.
ChatCompletionStreamResponseDelta
-> Rep ChatCompletionStreamResponseDelta x
$cto :: forall x.
Rep ChatCompletionStreamResponseDelta x
-> ChatCompletionStreamResponseDelta
to :: forall x.
Rep ChatCompletionStreamResponseDelta x
-> ChatCompletionStreamResponseDelta
Generic, Typeable ChatCompletionStreamResponseDelta
Typeable ChatCompletionStreamResponseDelta =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionStreamResponseDelta
 -> c ChatCompletionStreamResponseDelta)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionStreamResponseDelta)
-> (ChatCompletionStreamResponseDelta -> Constr)
-> (ChatCompletionStreamResponseDelta -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionStreamResponseDelta))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionStreamResponseDelta))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionStreamResponseDelta
    -> ChatCompletionStreamResponseDelta)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionStreamResponseDelta
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionStreamResponseDelta
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionStreamResponseDelta -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionStreamResponseDelta
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionStreamResponseDelta
    -> m ChatCompletionStreamResponseDelta)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionStreamResponseDelta
    -> m ChatCompletionStreamResponseDelta)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionStreamResponseDelta
    -> m ChatCompletionStreamResponseDelta)
-> Data ChatCompletionStreamResponseDelta
ChatCompletionStreamResponseDelta -> Constr
ChatCompletionStreamResponseDelta -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDelta
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDelta -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDelta
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDelta
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDelta
-> m ChatCompletionStreamResponseDelta
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDelta
-> m ChatCompletionStreamResponseDelta
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionStreamResponseDelta
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionStreamResponseDelta
-> c ChatCompletionStreamResponseDelta
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionStreamResponseDelta)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionStreamResponseDelta)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionStreamResponseDelta
-> c ChatCompletionStreamResponseDelta
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionStreamResponseDelta
-> c ChatCompletionStreamResponseDelta
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionStreamResponseDelta
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionStreamResponseDelta
$ctoConstr :: ChatCompletionStreamResponseDelta -> Constr
toConstr :: ChatCompletionStreamResponseDelta -> Constr
$cdataTypeOf :: ChatCompletionStreamResponseDelta -> DataType
dataTypeOf :: ChatCompletionStreamResponseDelta -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionStreamResponseDelta)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionStreamResponseDelta)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionStreamResponseDelta)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionStreamResponseDelta)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionStreamResponseDelta
-> ChatCompletionStreamResponseDelta
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDelta
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDelta
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDelta
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDelta
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDelta -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDelta -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDelta
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDelta
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDelta
-> m ChatCompletionStreamResponseDelta
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDelta
-> m ChatCompletionStreamResponseDelta
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDelta
-> m ChatCompletionStreamResponseDelta
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDelta
-> m ChatCompletionStreamResponseDelta
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDelta
-> m ChatCompletionStreamResponseDelta
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDelta
-> m ChatCompletionStreamResponseDelta
Data)

instance FromJSON ChatCompletionStreamResponseDelta where
  parseJSON :: Value -> Parser ChatCompletionStreamResponseDelta
parseJSON = Options -> Value -> Parser ChatCompletionStreamResponseDelta
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionStreamResponseDelta")
instance ToJSON ChatCompletionStreamResponseDelta where
  toJSON :: ChatCompletionStreamResponseDelta -> Value
toJSON = Options -> ChatCompletionStreamResponseDelta -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionStreamResponseDelta")


-- | Deprecated and replaced by &#x60;tool_calls&#x60;. The name and arguments of a function that should be called, as generated by the model.
data ChatCompletionStreamResponseDeltaFunctionCall = ChatCompletionStreamResponseDeltaFunctionCall
  { ChatCompletionStreamResponseDeltaFunctionCall -> Maybe Text
chatCompletionStreamResponseDeltaFunctionCallArguments :: Maybe Text -- ^ The arguments to call the function with, as generated by the model in JSON format. Note that the model does not always generate valid JSON, and may hallucinate parameters not defined by your function schema. Validate the arguments in your code before calling your function.
  , ChatCompletionStreamResponseDeltaFunctionCall -> Maybe Text
chatCompletionStreamResponseDeltaFunctionCallName :: Maybe Text -- ^ The name of the function to call.
  } deriving (Int -> ChatCompletionStreamResponseDeltaFunctionCall -> ShowS
[ChatCompletionStreamResponseDeltaFunctionCall] -> ShowS
ChatCompletionStreamResponseDeltaFunctionCall -> String
(Int -> ChatCompletionStreamResponseDeltaFunctionCall -> ShowS)
-> (ChatCompletionStreamResponseDeltaFunctionCall -> String)
-> ([ChatCompletionStreamResponseDeltaFunctionCall] -> ShowS)
-> Show ChatCompletionStreamResponseDeltaFunctionCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionStreamResponseDeltaFunctionCall -> ShowS
showsPrec :: Int -> ChatCompletionStreamResponseDeltaFunctionCall -> ShowS
$cshow :: ChatCompletionStreamResponseDeltaFunctionCall -> String
show :: ChatCompletionStreamResponseDeltaFunctionCall -> String
$cshowList :: [ChatCompletionStreamResponseDeltaFunctionCall] -> ShowS
showList :: [ChatCompletionStreamResponseDeltaFunctionCall] -> ShowS
Show, ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
(ChatCompletionStreamResponseDeltaFunctionCall
 -> ChatCompletionStreamResponseDeltaFunctionCall -> Bool)
-> (ChatCompletionStreamResponseDeltaFunctionCall
    -> ChatCompletionStreamResponseDeltaFunctionCall -> Bool)
-> Eq ChatCompletionStreamResponseDeltaFunctionCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
== :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
$c/= :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
/= :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
Eq, Eq ChatCompletionStreamResponseDeltaFunctionCall
Eq ChatCompletionStreamResponseDeltaFunctionCall =>
(ChatCompletionStreamResponseDeltaFunctionCall
 -> ChatCompletionStreamResponseDeltaFunctionCall -> Ordering)
-> (ChatCompletionStreamResponseDeltaFunctionCall
    -> ChatCompletionStreamResponseDeltaFunctionCall -> Bool)
-> (ChatCompletionStreamResponseDeltaFunctionCall
    -> ChatCompletionStreamResponseDeltaFunctionCall -> Bool)
-> (ChatCompletionStreamResponseDeltaFunctionCall
    -> ChatCompletionStreamResponseDeltaFunctionCall -> Bool)
-> (ChatCompletionStreamResponseDeltaFunctionCall
    -> ChatCompletionStreamResponseDeltaFunctionCall -> Bool)
-> (ChatCompletionStreamResponseDeltaFunctionCall
    -> ChatCompletionStreamResponseDeltaFunctionCall
    -> ChatCompletionStreamResponseDeltaFunctionCall)
-> (ChatCompletionStreamResponseDeltaFunctionCall
    -> ChatCompletionStreamResponseDeltaFunctionCall
    -> ChatCompletionStreamResponseDeltaFunctionCall)
-> Ord ChatCompletionStreamResponseDeltaFunctionCall
ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Ordering
ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Ordering
compare :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Ordering
$c< :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
< :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
$c<= :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
<= :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
$c> :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
> :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
$c>= :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
>= :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall -> Bool
$cmax :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
max :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
$cmin :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
min :: ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
Ord, (forall x.
 ChatCompletionStreamResponseDeltaFunctionCall
 -> Rep ChatCompletionStreamResponseDeltaFunctionCall x)
-> (forall x.
    Rep ChatCompletionStreamResponseDeltaFunctionCall x
    -> ChatCompletionStreamResponseDeltaFunctionCall)
-> Generic ChatCompletionStreamResponseDeltaFunctionCall
forall x.
Rep ChatCompletionStreamResponseDeltaFunctionCall x
-> ChatCompletionStreamResponseDeltaFunctionCall
forall x.
ChatCompletionStreamResponseDeltaFunctionCall
-> Rep ChatCompletionStreamResponseDeltaFunctionCall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionStreamResponseDeltaFunctionCall
-> Rep ChatCompletionStreamResponseDeltaFunctionCall x
from :: forall x.
ChatCompletionStreamResponseDeltaFunctionCall
-> Rep ChatCompletionStreamResponseDeltaFunctionCall x
$cto :: forall x.
Rep ChatCompletionStreamResponseDeltaFunctionCall x
-> ChatCompletionStreamResponseDeltaFunctionCall
to :: forall x.
Rep ChatCompletionStreamResponseDeltaFunctionCall x
-> ChatCompletionStreamResponseDeltaFunctionCall
Generic, Typeable ChatCompletionStreamResponseDeltaFunctionCall
Typeable ChatCompletionStreamResponseDeltaFunctionCall =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionStreamResponseDeltaFunctionCall
 -> c ChatCompletionStreamResponseDeltaFunctionCall)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionStreamResponseDeltaFunctionCall)
-> (ChatCompletionStreamResponseDeltaFunctionCall -> Constr)
-> (ChatCompletionStreamResponseDeltaFunctionCall -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionStreamResponseDeltaFunctionCall))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionStreamResponseDeltaFunctionCall))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionStreamResponseDeltaFunctionCall
    -> ChatCompletionStreamResponseDeltaFunctionCall)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionStreamResponseDeltaFunctionCall
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionStreamResponseDeltaFunctionCall
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionStreamResponseDeltaFunctionCall -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionStreamResponseDeltaFunctionCall
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionStreamResponseDeltaFunctionCall
    -> m ChatCompletionStreamResponseDeltaFunctionCall)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionStreamResponseDeltaFunctionCall
    -> m ChatCompletionStreamResponseDeltaFunctionCall)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionStreamResponseDeltaFunctionCall
    -> m ChatCompletionStreamResponseDeltaFunctionCall)
-> Data ChatCompletionStreamResponseDeltaFunctionCall
ChatCompletionStreamResponseDeltaFunctionCall -> Constr
ChatCompletionStreamResponseDeltaFunctionCall -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDeltaFunctionCall -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDeltaFunctionCall
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDeltaFunctionCall
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> m ChatCompletionStreamResponseDeltaFunctionCall
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> m ChatCompletionStreamResponseDeltaFunctionCall
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionStreamResponseDeltaFunctionCall
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> c ChatCompletionStreamResponseDeltaFunctionCall
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionStreamResponseDeltaFunctionCall)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionStreamResponseDeltaFunctionCall)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> c ChatCompletionStreamResponseDeltaFunctionCall
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> c ChatCompletionStreamResponseDeltaFunctionCall
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionStreamResponseDeltaFunctionCall
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionStreamResponseDeltaFunctionCall
$ctoConstr :: ChatCompletionStreamResponseDeltaFunctionCall -> Constr
toConstr :: ChatCompletionStreamResponseDeltaFunctionCall -> Constr
$cdataTypeOf :: ChatCompletionStreamResponseDeltaFunctionCall -> DataType
dataTypeOf :: ChatCompletionStreamResponseDeltaFunctionCall -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionStreamResponseDeltaFunctionCall)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionStreamResponseDeltaFunctionCall)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionStreamResponseDeltaFunctionCall)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionStreamResponseDeltaFunctionCall)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> ChatCompletionStreamResponseDeltaFunctionCall
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDeltaFunctionCall
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDeltaFunctionCall
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDeltaFunctionCall
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionStreamResponseDeltaFunctionCall
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDeltaFunctionCall -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDeltaFunctionCall -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> m ChatCompletionStreamResponseDeltaFunctionCall
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> m ChatCompletionStreamResponseDeltaFunctionCall
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> m ChatCompletionStreamResponseDeltaFunctionCall
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> m ChatCompletionStreamResponseDeltaFunctionCall
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> m ChatCompletionStreamResponseDeltaFunctionCall
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionStreamResponseDeltaFunctionCall
-> m ChatCompletionStreamResponseDeltaFunctionCall
Data)

instance FromJSON ChatCompletionStreamResponseDeltaFunctionCall where
  parseJSON :: Value -> Parser ChatCompletionStreamResponseDeltaFunctionCall
parseJSON = Options
-> Value -> Parser ChatCompletionStreamResponseDeltaFunctionCall
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionStreamResponseDeltaFunctionCall")
instance ToJSON ChatCompletionStreamResponseDeltaFunctionCall where
  toJSON :: ChatCompletionStreamResponseDeltaFunctionCall -> Value
toJSON = Options -> ChatCompletionStreamResponseDeltaFunctionCall -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionStreamResponseDeltaFunctionCall")


-- | 
data ChatCompletionTokenLogprob = ChatCompletionTokenLogprob
  { ChatCompletionTokenLogprob -> Text
chatCompletionTokenLogprobToken :: Text -- ^ The token.
  , ChatCompletionTokenLogprob -> Double
chatCompletionTokenLogprobLogprob :: Double -- ^ The log probability of this token, if it is within the top 20 most likely tokens. Otherwise, the value `-9999.0` is used to signify that the token is very unlikely.
  , ChatCompletionTokenLogprob -> [Int]
chatCompletionTokenLogprobBytes :: [Int] -- ^ A list of integers representing the UTF-8 bytes representation of the token. Useful in instances where characters are represented by multiple tokens and their byte representations must be combined to generate the correct text representation. Can be `null` if there is no bytes representation for the token.
  , ChatCompletionTokenLogprob
-> [ChatCompletionTokenLogprobTopLogprobsInner]
chatCompletionTokenLogprobTopUnderscorelogprobs :: [ChatCompletionTokenLogprobTopLogprobsInner] -- ^ List of the most likely tokens and their log probability, at this token position. In rare cases, there may be fewer than the number of requested `top_logprobs` returned.
  } deriving (Int -> ChatCompletionTokenLogprob -> ShowS
[ChatCompletionTokenLogprob] -> ShowS
ChatCompletionTokenLogprob -> String
(Int -> ChatCompletionTokenLogprob -> ShowS)
-> (ChatCompletionTokenLogprob -> String)
-> ([ChatCompletionTokenLogprob] -> ShowS)
-> Show ChatCompletionTokenLogprob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionTokenLogprob -> ShowS
showsPrec :: Int -> ChatCompletionTokenLogprob -> ShowS
$cshow :: ChatCompletionTokenLogprob -> String
show :: ChatCompletionTokenLogprob -> String
$cshowList :: [ChatCompletionTokenLogprob] -> ShowS
showList :: [ChatCompletionTokenLogprob] -> ShowS
Show, ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
(ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool)
-> (ChatCompletionTokenLogprob
    -> ChatCompletionTokenLogprob -> Bool)
-> Eq ChatCompletionTokenLogprob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
== :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
$c/= :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
/= :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
Eq, Eq ChatCompletionTokenLogprob
Eq ChatCompletionTokenLogprob =>
(ChatCompletionTokenLogprob
 -> ChatCompletionTokenLogprob -> Ordering)
-> (ChatCompletionTokenLogprob
    -> ChatCompletionTokenLogprob -> Bool)
-> (ChatCompletionTokenLogprob
    -> ChatCompletionTokenLogprob -> Bool)
-> (ChatCompletionTokenLogprob
    -> ChatCompletionTokenLogprob -> Bool)
-> (ChatCompletionTokenLogprob
    -> ChatCompletionTokenLogprob -> Bool)
-> (ChatCompletionTokenLogprob
    -> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob)
-> (ChatCompletionTokenLogprob
    -> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob)
-> Ord ChatCompletionTokenLogprob
ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
ChatCompletionTokenLogprob
-> ChatCompletionTokenLogprob -> Ordering
ChatCompletionTokenLogprob
-> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionTokenLogprob
-> ChatCompletionTokenLogprob -> Ordering
compare :: ChatCompletionTokenLogprob
-> ChatCompletionTokenLogprob -> Ordering
$c< :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
< :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
$c<= :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
<= :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
$c> :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
> :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
$c>= :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
>= :: ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob -> Bool
$cmax :: ChatCompletionTokenLogprob
-> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob
max :: ChatCompletionTokenLogprob
-> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob
$cmin :: ChatCompletionTokenLogprob
-> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob
min :: ChatCompletionTokenLogprob
-> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob
Ord, (forall x.
 ChatCompletionTokenLogprob -> Rep ChatCompletionTokenLogprob x)
-> (forall x.
    Rep ChatCompletionTokenLogprob x -> ChatCompletionTokenLogprob)
-> Generic ChatCompletionTokenLogprob
forall x.
Rep ChatCompletionTokenLogprob x -> ChatCompletionTokenLogprob
forall x.
ChatCompletionTokenLogprob -> Rep ChatCompletionTokenLogprob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionTokenLogprob -> Rep ChatCompletionTokenLogprob x
from :: forall x.
ChatCompletionTokenLogprob -> Rep ChatCompletionTokenLogprob x
$cto :: forall x.
Rep ChatCompletionTokenLogprob x -> ChatCompletionTokenLogprob
to :: forall x.
Rep ChatCompletionTokenLogprob x -> ChatCompletionTokenLogprob
Generic, Typeable ChatCompletionTokenLogprob
Typeable ChatCompletionTokenLogprob =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionTokenLogprob
 -> c ChatCompletionTokenLogprob)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ChatCompletionTokenLogprob)
-> (ChatCompletionTokenLogprob -> Constr)
-> (ChatCompletionTokenLogprob -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionTokenLogprob))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionTokenLogprob))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionTokenLogprob
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionTokenLogprob
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ChatCompletionTokenLogprob -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> ChatCompletionTokenLogprob -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob)
-> Data ChatCompletionTokenLogprob
ChatCompletionTokenLogprob -> Constr
ChatCompletionTokenLogprob -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> ChatCompletionTokenLogprob -> u
forall u.
(forall d. Data d => d -> u) -> ChatCompletionTokenLogprob -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprob
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprob
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionTokenLogprob
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionTokenLogprob
-> c ChatCompletionTokenLogprob
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionTokenLogprob)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionTokenLogprob)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionTokenLogprob
-> c ChatCompletionTokenLogprob
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionTokenLogprob
-> c ChatCompletionTokenLogprob
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionTokenLogprob
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionTokenLogprob
$ctoConstr :: ChatCompletionTokenLogprob -> Constr
toConstr :: ChatCompletionTokenLogprob -> Constr
$cdataTypeOf :: ChatCompletionTokenLogprob -> DataType
dataTypeOf :: ChatCompletionTokenLogprob -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionTokenLogprob)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionTokenLogprob)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionTokenLogprob)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionTokenLogprob)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionTokenLogprob -> ChatCompletionTokenLogprob
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprob
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprob
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprob
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprob
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ChatCompletionTokenLogprob -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ChatCompletionTokenLogprob -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ChatCompletionTokenLogprob -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ChatCompletionTokenLogprob -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprob -> m ChatCompletionTokenLogprob
Data)

instance FromJSON ChatCompletionTokenLogprob where
  parseJSON :: Value -> Parser ChatCompletionTokenLogprob
parseJSON = Options -> Value -> Parser ChatCompletionTokenLogprob
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionTokenLogprob")
instance ToJSON ChatCompletionTokenLogprob where
  toJSON :: ChatCompletionTokenLogprob -> Value
toJSON = Options -> ChatCompletionTokenLogprob -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionTokenLogprob")


-- | 
data ChatCompletionTokenLogprobTopLogprobsInner = ChatCompletionTokenLogprobTopLogprobsInner
  { ChatCompletionTokenLogprobTopLogprobsInner -> Text
chatCompletionTokenLogprobTopLogprobsInnerToken :: Text -- ^ The token.
  , ChatCompletionTokenLogprobTopLogprobsInner -> Double
chatCompletionTokenLogprobTopLogprobsInnerLogprob :: Double -- ^ The log probability of this token, if it is within the top 20 most likely tokens. Otherwise, the value `-9999.0` is used to signify that the token is very unlikely.
  , ChatCompletionTokenLogprobTopLogprobsInner -> [Int]
chatCompletionTokenLogprobTopLogprobsInnerBytes :: [Int] -- ^ A list of integers representing the UTF-8 bytes representation of the token. Useful in instances where characters are represented by multiple tokens and their byte representations must be combined to generate the correct text representation. Can be `null` if there is no bytes representation for the token.
  } deriving (Int -> ChatCompletionTokenLogprobTopLogprobsInner -> ShowS
[ChatCompletionTokenLogprobTopLogprobsInner] -> ShowS
ChatCompletionTokenLogprobTopLogprobsInner -> String
(Int -> ChatCompletionTokenLogprobTopLogprobsInner -> ShowS)
-> (ChatCompletionTokenLogprobTopLogprobsInner -> String)
-> ([ChatCompletionTokenLogprobTopLogprobsInner] -> ShowS)
-> Show ChatCompletionTokenLogprobTopLogprobsInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionTokenLogprobTopLogprobsInner -> ShowS
showsPrec :: Int -> ChatCompletionTokenLogprobTopLogprobsInner -> ShowS
$cshow :: ChatCompletionTokenLogprobTopLogprobsInner -> String
show :: ChatCompletionTokenLogprobTopLogprobsInner -> String
$cshowList :: [ChatCompletionTokenLogprobTopLogprobsInner] -> ShowS
showList :: [ChatCompletionTokenLogprobTopLogprobsInner] -> ShowS
Show, ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
(ChatCompletionTokenLogprobTopLogprobsInner
 -> ChatCompletionTokenLogprobTopLogprobsInner -> Bool)
-> (ChatCompletionTokenLogprobTopLogprobsInner
    -> ChatCompletionTokenLogprobTopLogprobsInner -> Bool)
-> Eq ChatCompletionTokenLogprobTopLogprobsInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
== :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
$c/= :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
/= :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
Eq, Eq ChatCompletionTokenLogprobTopLogprobsInner
Eq ChatCompletionTokenLogprobTopLogprobsInner =>
(ChatCompletionTokenLogprobTopLogprobsInner
 -> ChatCompletionTokenLogprobTopLogprobsInner -> Ordering)
-> (ChatCompletionTokenLogprobTopLogprobsInner
    -> ChatCompletionTokenLogprobTopLogprobsInner -> Bool)
-> (ChatCompletionTokenLogprobTopLogprobsInner
    -> ChatCompletionTokenLogprobTopLogprobsInner -> Bool)
-> (ChatCompletionTokenLogprobTopLogprobsInner
    -> ChatCompletionTokenLogprobTopLogprobsInner -> Bool)
-> (ChatCompletionTokenLogprobTopLogprobsInner
    -> ChatCompletionTokenLogprobTopLogprobsInner -> Bool)
-> (ChatCompletionTokenLogprobTopLogprobsInner
    -> ChatCompletionTokenLogprobTopLogprobsInner
    -> ChatCompletionTokenLogprobTopLogprobsInner)
-> (ChatCompletionTokenLogprobTopLogprobsInner
    -> ChatCompletionTokenLogprobTopLogprobsInner
    -> ChatCompletionTokenLogprobTopLogprobsInner)
-> Ord ChatCompletionTokenLogprobTopLogprobsInner
ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Ordering
ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Ordering
compare :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Ordering
$c< :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
< :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
$c<= :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
<= :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
$c> :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
> :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
$c>= :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
>= :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner -> Bool
$cmax :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
max :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
$cmin :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
min :: ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
Ord, (forall x.
 ChatCompletionTokenLogprobTopLogprobsInner
 -> Rep ChatCompletionTokenLogprobTopLogprobsInner x)
-> (forall x.
    Rep ChatCompletionTokenLogprobTopLogprobsInner x
    -> ChatCompletionTokenLogprobTopLogprobsInner)
-> Generic ChatCompletionTokenLogprobTopLogprobsInner
forall x.
Rep ChatCompletionTokenLogprobTopLogprobsInner x
-> ChatCompletionTokenLogprobTopLogprobsInner
forall x.
ChatCompletionTokenLogprobTopLogprobsInner
-> Rep ChatCompletionTokenLogprobTopLogprobsInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionTokenLogprobTopLogprobsInner
-> Rep ChatCompletionTokenLogprobTopLogprobsInner x
from :: forall x.
ChatCompletionTokenLogprobTopLogprobsInner
-> Rep ChatCompletionTokenLogprobTopLogprobsInner x
$cto :: forall x.
Rep ChatCompletionTokenLogprobTopLogprobsInner x
-> ChatCompletionTokenLogprobTopLogprobsInner
to :: forall x.
Rep ChatCompletionTokenLogprobTopLogprobsInner x
-> ChatCompletionTokenLogprobTopLogprobsInner
Generic, Typeable ChatCompletionTokenLogprobTopLogprobsInner
Typeable ChatCompletionTokenLogprobTopLogprobsInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionTokenLogprobTopLogprobsInner
 -> c ChatCompletionTokenLogprobTopLogprobsInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionTokenLogprobTopLogprobsInner)
-> (ChatCompletionTokenLogprobTopLogprobsInner -> Constr)
-> (ChatCompletionTokenLogprobTopLogprobsInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionTokenLogprobTopLogprobsInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionTokenLogprobTopLogprobsInner))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionTokenLogprobTopLogprobsInner
    -> ChatCompletionTokenLogprobTopLogprobsInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionTokenLogprobTopLogprobsInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionTokenLogprobTopLogprobsInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionTokenLogprobTopLogprobsInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionTokenLogprobTopLogprobsInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionTokenLogprobTopLogprobsInner
    -> m ChatCompletionTokenLogprobTopLogprobsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionTokenLogprobTopLogprobsInner
    -> m ChatCompletionTokenLogprobTopLogprobsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionTokenLogprobTopLogprobsInner
    -> m ChatCompletionTokenLogprobTopLogprobsInner)
-> Data ChatCompletionTokenLogprobTopLogprobsInner
ChatCompletionTokenLogprobTopLogprobsInner -> Constr
ChatCompletionTokenLogprobTopLogprobsInner -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionTokenLogprobTopLogprobsInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprobTopLogprobsInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprobTopLogprobsInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> m ChatCompletionTokenLogprobTopLogprobsInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> m ChatCompletionTokenLogprobTopLogprobsInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionTokenLogprobTopLogprobsInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> c ChatCompletionTokenLogprobTopLogprobsInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionTokenLogprobTopLogprobsInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionTokenLogprobTopLogprobsInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> c ChatCompletionTokenLogprobTopLogprobsInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> c ChatCompletionTokenLogprobTopLogprobsInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionTokenLogprobTopLogprobsInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionTokenLogprobTopLogprobsInner
$ctoConstr :: ChatCompletionTokenLogprobTopLogprobsInner -> Constr
toConstr :: ChatCompletionTokenLogprobTopLogprobsInner -> Constr
$cdataTypeOf :: ChatCompletionTokenLogprobTopLogprobsInner -> DataType
dataTypeOf :: ChatCompletionTokenLogprobTopLogprobsInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionTokenLogprobTopLogprobsInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionTokenLogprobTopLogprobsInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionTokenLogprobTopLogprobsInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionTokenLogprobTopLogprobsInner)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> ChatCompletionTokenLogprobTopLogprobsInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprobTopLogprobsInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprobTopLogprobsInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprobTopLogprobsInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionTokenLogprobTopLogprobsInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionTokenLogprobTopLogprobsInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionTokenLogprobTopLogprobsInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> m ChatCompletionTokenLogprobTopLogprobsInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> m ChatCompletionTokenLogprobTopLogprobsInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> m ChatCompletionTokenLogprobTopLogprobsInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> m ChatCompletionTokenLogprobTopLogprobsInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> m ChatCompletionTokenLogprobTopLogprobsInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTokenLogprobTopLogprobsInner
-> m ChatCompletionTokenLogprobTopLogprobsInner
Data)

instance FromJSON ChatCompletionTokenLogprobTopLogprobsInner where
  parseJSON :: Value -> Parser ChatCompletionTokenLogprobTopLogprobsInner
parseJSON = Options
-> Value -> Parser ChatCompletionTokenLogprobTopLogprobsInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionTokenLogprobTopLogprobsInner")
instance ToJSON ChatCompletionTokenLogprobTopLogprobsInner where
  toJSON :: ChatCompletionTokenLogprobTopLogprobsInner -> Value
toJSON = Options -> ChatCompletionTokenLogprobTopLogprobsInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionTokenLogprobTopLogprobsInner")


-- | 
data ChatCompletionTool = ChatCompletionTool
  { ChatCompletionTool -> Text
chatCompletionToolType :: Text -- ^ The type of the tool. Currently, only `function` is supported.
  , ChatCompletionTool -> FunctionObject
chatCompletionToolFunction :: FunctionObject -- ^ 
  } deriving (Int -> ChatCompletionTool -> ShowS
[ChatCompletionTool] -> ShowS
ChatCompletionTool -> String
(Int -> ChatCompletionTool -> ShowS)
-> (ChatCompletionTool -> String)
-> ([ChatCompletionTool] -> ShowS)
-> Show ChatCompletionTool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionTool -> ShowS
showsPrec :: Int -> ChatCompletionTool -> ShowS
$cshow :: ChatCompletionTool -> String
show :: ChatCompletionTool -> String
$cshowList :: [ChatCompletionTool] -> ShowS
showList :: [ChatCompletionTool] -> ShowS
Show, ChatCompletionTool -> ChatCompletionTool -> Bool
(ChatCompletionTool -> ChatCompletionTool -> Bool)
-> (ChatCompletionTool -> ChatCompletionTool -> Bool)
-> Eq ChatCompletionTool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionTool -> ChatCompletionTool -> Bool
== :: ChatCompletionTool -> ChatCompletionTool -> Bool
$c/= :: ChatCompletionTool -> ChatCompletionTool -> Bool
/= :: ChatCompletionTool -> ChatCompletionTool -> Bool
Eq, Eq ChatCompletionTool
Eq ChatCompletionTool =>
(ChatCompletionTool -> ChatCompletionTool -> Ordering)
-> (ChatCompletionTool -> ChatCompletionTool -> Bool)
-> (ChatCompletionTool -> ChatCompletionTool -> Bool)
-> (ChatCompletionTool -> ChatCompletionTool -> Bool)
-> (ChatCompletionTool -> ChatCompletionTool -> Bool)
-> (ChatCompletionTool -> ChatCompletionTool -> ChatCompletionTool)
-> (ChatCompletionTool -> ChatCompletionTool -> ChatCompletionTool)
-> Ord ChatCompletionTool
ChatCompletionTool -> ChatCompletionTool -> Bool
ChatCompletionTool -> ChatCompletionTool -> Ordering
ChatCompletionTool -> ChatCompletionTool -> ChatCompletionTool
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionTool -> ChatCompletionTool -> Ordering
compare :: ChatCompletionTool -> ChatCompletionTool -> Ordering
$c< :: ChatCompletionTool -> ChatCompletionTool -> Bool
< :: ChatCompletionTool -> ChatCompletionTool -> Bool
$c<= :: ChatCompletionTool -> ChatCompletionTool -> Bool
<= :: ChatCompletionTool -> ChatCompletionTool -> Bool
$c> :: ChatCompletionTool -> ChatCompletionTool -> Bool
> :: ChatCompletionTool -> ChatCompletionTool -> Bool
$c>= :: ChatCompletionTool -> ChatCompletionTool -> Bool
>= :: ChatCompletionTool -> ChatCompletionTool -> Bool
$cmax :: ChatCompletionTool -> ChatCompletionTool -> ChatCompletionTool
max :: ChatCompletionTool -> ChatCompletionTool -> ChatCompletionTool
$cmin :: ChatCompletionTool -> ChatCompletionTool -> ChatCompletionTool
min :: ChatCompletionTool -> ChatCompletionTool -> ChatCompletionTool
Ord, (forall x. ChatCompletionTool -> Rep ChatCompletionTool x)
-> (forall x. Rep ChatCompletionTool x -> ChatCompletionTool)
-> Generic ChatCompletionTool
forall x. Rep ChatCompletionTool x -> ChatCompletionTool
forall x. ChatCompletionTool -> Rep ChatCompletionTool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChatCompletionTool -> Rep ChatCompletionTool x
from :: forall x. ChatCompletionTool -> Rep ChatCompletionTool x
$cto :: forall x. Rep ChatCompletionTool x -> ChatCompletionTool
to :: forall x. Rep ChatCompletionTool x -> ChatCompletionTool
Generic, Typeable ChatCompletionTool
Typeable ChatCompletionTool =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionTool
 -> c ChatCompletionTool)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ChatCompletionTool)
-> (ChatCompletionTool -> Constr)
-> (ChatCompletionTool -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ChatCompletionTool))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionTool))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionTool -> ChatCompletionTool)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ChatCompletionTool -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ChatCompletionTool -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ChatCompletionTool -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ChatCompletionTool -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionTool -> m ChatCompletionTool)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionTool -> m ChatCompletionTool)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionTool -> m ChatCompletionTool)
-> Data ChatCompletionTool
ChatCompletionTool -> Constr
ChatCompletionTool -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionTool -> ChatCompletionTool
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ChatCompletionTool -> u
forall u. (forall d. Data d => d -> u) -> ChatCompletionTool -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionTool -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionTool -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTool -> m ChatCompletionTool
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTool -> m ChatCompletionTool
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionTool
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionTool
-> c ChatCompletionTool
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChatCompletionTool)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionTool)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionTool
-> c ChatCompletionTool
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionTool
-> c ChatCompletionTool
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionTool
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChatCompletionTool
$ctoConstr :: ChatCompletionTool -> Constr
toConstr :: ChatCompletionTool -> Constr
$cdataTypeOf :: ChatCompletionTool -> DataType
dataTypeOf :: ChatCompletionTool -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChatCompletionTool)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChatCompletionTool)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionTool)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionTool)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionTool -> ChatCompletionTool
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionTool -> ChatCompletionTool
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionTool -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionTool -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionTool -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChatCompletionTool -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ChatCompletionTool -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ChatCompletionTool -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ChatCompletionTool -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ChatCompletionTool -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTool -> m ChatCompletionTool
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTool -> m ChatCompletionTool
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTool -> m ChatCompletionTool
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTool -> m ChatCompletionTool
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTool -> m ChatCompletionTool
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionTool -> m ChatCompletionTool
Data)

instance FromJSON ChatCompletionTool where
  parseJSON :: Value -> Parser ChatCompletionTool
parseJSON = Options -> Value -> Parser ChatCompletionTool
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionTool")
instance ToJSON ChatCompletionTool where
  toJSON :: ChatCompletionTool -> Value
toJSON = Options -> ChatCompletionTool -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionTool")


-- | Controls which (if any) function is called by the model. &#x60;none&#x60; means the model will not call a function and instead generates a message. &#x60;auto&#x60; means the model can pick between generating a message or calling a function. Specifying a particular function via &#x60;{\&quot;type\&quot;: \&quot;function\&quot;, \&quot;function\&quot;: {\&quot;name\&quot;: \&quot;my_function\&quot;}}&#x60; forces the model to call that function.  &#x60;none&#x60; is the default when no functions are present. &#x60;auto&#x60; is the default if functions are present. 
data ChatCompletionToolChoiceOption = ChatCompletionToolChoiceOption
  { ChatCompletionToolChoiceOption -> Text
chatCompletionToolChoiceOptionType :: Text -- ^ The type of the tool. Currently, only `function` is supported.
  , ChatCompletionToolChoiceOption
-> ChatCompletionNamedToolChoiceFunction
chatCompletionToolChoiceOptionFunction :: ChatCompletionNamedToolChoiceFunction -- ^ 
  } deriving (Int -> ChatCompletionToolChoiceOption -> ShowS
[ChatCompletionToolChoiceOption] -> ShowS
ChatCompletionToolChoiceOption -> String
(Int -> ChatCompletionToolChoiceOption -> ShowS)
-> (ChatCompletionToolChoiceOption -> String)
-> ([ChatCompletionToolChoiceOption] -> ShowS)
-> Show ChatCompletionToolChoiceOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatCompletionToolChoiceOption -> ShowS
showsPrec :: Int -> ChatCompletionToolChoiceOption -> ShowS
$cshow :: ChatCompletionToolChoiceOption -> String
show :: ChatCompletionToolChoiceOption -> String
$cshowList :: [ChatCompletionToolChoiceOption] -> ShowS
showList :: [ChatCompletionToolChoiceOption] -> ShowS
Show, ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
(ChatCompletionToolChoiceOption
 -> ChatCompletionToolChoiceOption -> Bool)
-> (ChatCompletionToolChoiceOption
    -> ChatCompletionToolChoiceOption -> Bool)
-> Eq ChatCompletionToolChoiceOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
== :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
$c/= :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
/= :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
Eq, Eq ChatCompletionToolChoiceOption
Eq ChatCompletionToolChoiceOption =>
(ChatCompletionToolChoiceOption
 -> ChatCompletionToolChoiceOption -> Ordering)
-> (ChatCompletionToolChoiceOption
    -> ChatCompletionToolChoiceOption -> Bool)
-> (ChatCompletionToolChoiceOption
    -> ChatCompletionToolChoiceOption -> Bool)
-> (ChatCompletionToolChoiceOption
    -> ChatCompletionToolChoiceOption -> Bool)
-> (ChatCompletionToolChoiceOption
    -> ChatCompletionToolChoiceOption -> Bool)
-> (ChatCompletionToolChoiceOption
    -> ChatCompletionToolChoiceOption
    -> ChatCompletionToolChoiceOption)
-> (ChatCompletionToolChoiceOption
    -> ChatCompletionToolChoiceOption
    -> ChatCompletionToolChoiceOption)
-> Ord ChatCompletionToolChoiceOption
ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Ordering
ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> ChatCompletionToolChoiceOption
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Ordering
compare :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Ordering
$c< :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
< :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
$c<= :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
<= :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
$c> :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
> :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
$c>= :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
>= :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> Bool
$cmax :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> ChatCompletionToolChoiceOption
max :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> ChatCompletionToolChoiceOption
$cmin :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> ChatCompletionToolChoiceOption
min :: ChatCompletionToolChoiceOption
-> ChatCompletionToolChoiceOption -> ChatCompletionToolChoiceOption
Ord, (forall x.
 ChatCompletionToolChoiceOption
 -> Rep ChatCompletionToolChoiceOption x)
-> (forall x.
    Rep ChatCompletionToolChoiceOption x
    -> ChatCompletionToolChoiceOption)
-> Generic ChatCompletionToolChoiceOption
forall x.
Rep ChatCompletionToolChoiceOption x
-> ChatCompletionToolChoiceOption
forall x.
ChatCompletionToolChoiceOption
-> Rep ChatCompletionToolChoiceOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ChatCompletionToolChoiceOption
-> Rep ChatCompletionToolChoiceOption x
from :: forall x.
ChatCompletionToolChoiceOption
-> Rep ChatCompletionToolChoiceOption x
$cto :: forall x.
Rep ChatCompletionToolChoiceOption x
-> ChatCompletionToolChoiceOption
to :: forall x.
Rep ChatCompletionToolChoiceOption x
-> ChatCompletionToolChoiceOption
Generic, Typeable ChatCompletionToolChoiceOption
Typeable ChatCompletionToolChoiceOption =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChatCompletionToolChoiceOption
 -> c ChatCompletionToolChoiceOption)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ChatCompletionToolChoiceOption)
-> (ChatCompletionToolChoiceOption -> Constr)
-> (ChatCompletionToolChoiceOption -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ChatCompletionToolChoiceOption))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChatCompletionToolChoiceOption))
-> ((forall b. Data b => b -> b)
    -> ChatCompletionToolChoiceOption
    -> ChatCompletionToolChoiceOption)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionToolChoiceOption
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ChatCompletionToolChoiceOption
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ChatCompletionToolChoiceOption -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ChatCompletionToolChoiceOption
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionToolChoiceOption
    -> m ChatCompletionToolChoiceOption)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionToolChoiceOption
    -> m ChatCompletionToolChoiceOption)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChatCompletionToolChoiceOption
    -> m ChatCompletionToolChoiceOption)
-> Data ChatCompletionToolChoiceOption
ChatCompletionToolChoiceOption -> Constr
ChatCompletionToolChoiceOption -> DataType
(forall b. Data b => b -> b)
-> ChatCompletionToolChoiceOption -> ChatCompletionToolChoiceOption
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionToolChoiceOption
-> u
forall u.
(forall d. Data d => d -> u)
-> ChatCompletionToolChoiceOption -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionToolChoiceOption
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionToolChoiceOption
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionToolChoiceOption
-> m ChatCompletionToolChoiceOption
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionToolChoiceOption
-> m ChatCompletionToolChoiceOption
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionToolChoiceOption
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionToolChoiceOption
-> c ChatCompletionToolChoiceOption
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionToolChoiceOption)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionToolChoiceOption)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionToolChoiceOption
-> c ChatCompletionToolChoiceOption
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChatCompletionToolChoiceOption
-> c ChatCompletionToolChoiceOption
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionToolChoiceOption
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ChatCompletionToolChoiceOption
$ctoConstr :: ChatCompletionToolChoiceOption -> Constr
toConstr :: ChatCompletionToolChoiceOption -> Constr
$cdataTypeOf :: ChatCompletionToolChoiceOption -> DataType
dataTypeOf :: ChatCompletionToolChoiceOption -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionToolChoiceOption)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ChatCompletionToolChoiceOption)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionToolChoiceOption)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChatCompletionToolChoiceOption)
$cgmapT :: (forall b. Data b => b -> b)
-> ChatCompletionToolChoiceOption -> ChatCompletionToolChoiceOption
gmapT :: (forall b. Data b => b -> b)
-> ChatCompletionToolChoiceOption -> ChatCompletionToolChoiceOption
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionToolChoiceOption
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionToolChoiceOption
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionToolChoiceOption
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ChatCompletionToolChoiceOption
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionToolChoiceOption -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ChatCompletionToolChoiceOption -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionToolChoiceOption
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ChatCompletionToolChoiceOption
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionToolChoiceOption
-> m ChatCompletionToolChoiceOption
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChatCompletionToolChoiceOption
-> m ChatCompletionToolChoiceOption
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionToolChoiceOption
-> m ChatCompletionToolChoiceOption
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionToolChoiceOption
-> m ChatCompletionToolChoiceOption
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionToolChoiceOption
-> m ChatCompletionToolChoiceOption
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChatCompletionToolChoiceOption
-> m ChatCompletionToolChoiceOption
Data)

instance FromJSON ChatCompletionToolChoiceOption where
  parseJSON :: Value -> Parser ChatCompletionToolChoiceOption
parseJSON = Options -> Value -> Parser ChatCompletionToolChoiceOption
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionToolChoiceOption")
instance ToJSON ChatCompletionToolChoiceOption where
  toJSON :: ChatCompletionToolChoiceOption -> Value
toJSON = Options -> ChatCompletionToolChoiceOption -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"chatCompletionToolChoiceOption")


-- | Usage statistics for the completion request.
data CompletionUsage = CompletionUsage
  { CompletionUsage -> Int
completionUsageCompletionUnderscoretokens :: Int -- ^ Number of tokens in the generated completion.
  , CompletionUsage -> Int
completionUsagePromptUnderscoretokens :: Int -- ^ Number of tokens in the prompt.
  , CompletionUsage -> Int
completionUsageTotalUnderscoretokens :: Int -- ^ Total number of tokens used in the request (prompt + completion).
  } deriving (Int -> CompletionUsage -> ShowS
[CompletionUsage] -> ShowS
CompletionUsage -> String
(Int -> CompletionUsage -> ShowS)
-> (CompletionUsage -> String)
-> ([CompletionUsage] -> ShowS)
-> Show CompletionUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompletionUsage -> ShowS
showsPrec :: Int -> CompletionUsage -> ShowS
$cshow :: CompletionUsage -> String
show :: CompletionUsage -> String
$cshowList :: [CompletionUsage] -> ShowS
showList :: [CompletionUsage] -> ShowS
Show, CompletionUsage -> CompletionUsage -> Bool
(CompletionUsage -> CompletionUsage -> Bool)
-> (CompletionUsage -> CompletionUsage -> Bool)
-> Eq CompletionUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionUsage -> CompletionUsage -> Bool
== :: CompletionUsage -> CompletionUsage -> Bool
$c/= :: CompletionUsage -> CompletionUsage -> Bool
/= :: CompletionUsage -> CompletionUsage -> Bool
Eq, Eq CompletionUsage
Eq CompletionUsage =>
(CompletionUsage -> CompletionUsage -> Ordering)
-> (CompletionUsage -> CompletionUsage -> Bool)
-> (CompletionUsage -> CompletionUsage -> Bool)
-> (CompletionUsage -> CompletionUsage -> Bool)
-> (CompletionUsage -> CompletionUsage -> Bool)
-> (CompletionUsage -> CompletionUsage -> CompletionUsage)
-> (CompletionUsage -> CompletionUsage -> CompletionUsage)
-> Ord CompletionUsage
CompletionUsage -> CompletionUsage -> Bool
CompletionUsage -> CompletionUsage -> Ordering
CompletionUsage -> CompletionUsage -> CompletionUsage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CompletionUsage -> CompletionUsage -> Ordering
compare :: CompletionUsage -> CompletionUsage -> Ordering
$c< :: CompletionUsage -> CompletionUsage -> Bool
< :: CompletionUsage -> CompletionUsage -> Bool
$c<= :: CompletionUsage -> CompletionUsage -> Bool
<= :: CompletionUsage -> CompletionUsage -> Bool
$c> :: CompletionUsage -> CompletionUsage -> Bool
> :: CompletionUsage -> CompletionUsage -> Bool
$c>= :: CompletionUsage -> CompletionUsage -> Bool
>= :: CompletionUsage -> CompletionUsage -> Bool
$cmax :: CompletionUsage -> CompletionUsage -> CompletionUsage
max :: CompletionUsage -> CompletionUsage -> CompletionUsage
$cmin :: CompletionUsage -> CompletionUsage -> CompletionUsage
min :: CompletionUsage -> CompletionUsage -> CompletionUsage
Ord, (forall x. CompletionUsage -> Rep CompletionUsage x)
-> (forall x. Rep CompletionUsage x -> CompletionUsage)
-> Generic CompletionUsage
forall x. Rep CompletionUsage x -> CompletionUsage
forall x. CompletionUsage -> Rep CompletionUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompletionUsage -> Rep CompletionUsage x
from :: forall x. CompletionUsage -> Rep CompletionUsage x
$cto :: forall x. Rep CompletionUsage x -> CompletionUsage
to :: forall x. Rep CompletionUsage x -> CompletionUsage
Generic, Typeable CompletionUsage
Typeable CompletionUsage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CompletionUsage -> c CompletionUsage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CompletionUsage)
-> (CompletionUsage -> Constr)
-> (CompletionUsage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CompletionUsage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CompletionUsage))
-> ((forall b. Data b => b -> b)
    -> CompletionUsage -> CompletionUsage)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CompletionUsage -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CompletionUsage -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CompletionUsage -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CompletionUsage -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CompletionUsage -> m CompletionUsage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompletionUsage -> m CompletionUsage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompletionUsage -> m CompletionUsage)
-> Data CompletionUsage
CompletionUsage -> Constr
CompletionUsage -> DataType
(forall b. Data b => b -> b) -> CompletionUsage -> CompletionUsage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CompletionUsage -> u
forall u. (forall d. Data d => d -> u) -> CompletionUsage -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompletionUsage -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompletionUsage -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompletionUsage -> m CompletionUsage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompletionUsage -> m CompletionUsage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompletionUsage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompletionUsage -> c CompletionUsage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompletionUsage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompletionUsage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompletionUsage -> c CompletionUsage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompletionUsage -> c CompletionUsage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompletionUsage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompletionUsage
$ctoConstr :: CompletionUsage -> Constr
toConstr :: CompletionUsage -> Constr
$cdataTypeOf :: CompletionUsage -> DataType
dataTypeOf :: CompletionUsage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompletionUsage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompletionUsage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompletionUsage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompletionUsage)
$cgmapT :: (forall b. Data b => b -> b) -> CompletionUsage -> CompletionUsage
gmapT :: (forall b. Data b => b -> b) -> CompletionUsage -> CompletionUsage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompletionUsage -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompletionUsage -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompletionUsage -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompletionUsage -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CompletionUsage -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CompletionUsage -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompletionUsage -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompletionUsage -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompletionUsage -> m CompletionUsage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompletionUsage -> m CompletionUsage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompletionUsage -> m CompletionUsage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompletionUsage -> m CompletionUsage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompletionUsage -> m CompletionUsage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompletionUsage -> m CompletionUsage
Data)

instance FromJSON CompletionUsage where
  parseJSON :: Value -> Parser CompletionUsage
parseJSON = Options -> Value -> Parser CompletionUsage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"completionUsage")
instance ToJSON CompletionUsage where
  toJSON :: CompletionUsage -> Value
toJSON = Options -> CompletionUsage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"completionUsage")


-- | 
data CreateAssistantFileRequest = CreateAssistantFileRequest
  { CreateAssistantFileRequest -> Text
createAssistantFileRequestFileUnderscoreid :: Text -- ^ A [File](/docs/api-reference/files) ID (with `purpose=\"assistants\"`) that the assistant should use. Useful for tools like `retrieval` and `code_interpreter` that can access files.
  } deriving (Int -> CreateAssistantFileRequest -> ShowS
[CreateAssistantFileRequest] -> ShowS
CreateAssistantFileRequest -> String
(Int -> CreateAssistantFileRequest -> ShowS)
-> (CreateAssistantFileRequest -> String)
-> ([CreateAssistantFileRequest] -> ShowS)
-> Show CreateAssistantFileRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateAssistantFileRequest -> ShowS
showsPrec :: Int -> CreateAssistantFileRequest -> ShowS
$cshow :: CreateAssistantFileRequest -> String
show :: CreateAssistantFileRequest -> String
$cshowList :: [CreateAssistantFileRequest] -> ShowS
showList :: [CreateAssistantFileRequest] -> ShowS
Show, CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
(CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool)
-> (CreateAssistantFileRequest
    -> CreateAssistantFileRequest -> Bool)
-> Eq CreateAssistantFileRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
== :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
$c/= :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
/= :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
Eq, Eq CreateAssistantFileRequest
Eq CreateAssistantFileRequest =>
(CreateAssistantFileRequest
 -> CreateAssistantFileRequest -> Ordering)
-> (CreateAssistantFileRequest
    -> CreateAssistantFileRequest -> Bool)
-> (CreateAssistantFileRequest
    -> CreateAssistantFileRequest -> Bool)
-> (CreateAssistantFileRequest
    -> CreateAssistantFileRequest -> Bool)
-> (CreateAssistantFileRequest
    -> CreateAssistantFileRequest -> Bool)
-> (CreateAssistantFileRequest
    -> CreateAssistantFileRequest -> CreateAssistantFileRequest)
-> (CreateAssistantFileRequest
    -> CreateAssistantFileRequest -> CreateAssistantFileRequest)
-> Ord CreateAssistantFileRequest
CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
CreateAssistantFileRequest
-> CreateAssistantFileRequest -> Ordering
CreateAssistantFileRequest
-> CreateAssistantFileRequest -> CreateAssistantFileRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateAssistantFileRequest
-> CreateAssistantFileRequest -> Ordering
compare :: CreateAssistantFileRequest
-> CreateAssistantFileRequest -> Ordering
$c< :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
< :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
$c<= :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
<= :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
$c> :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
> :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
$c>= :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
>= :: CreateAssistantFileRequest -> CreateAssistantFileRequest -> Bool
$cmax :: CreateAssistantFileRequest
-> CreateAssistantFileRequest -> CreateAssistantFileRequest
max :: CreateAssistantFileRequest
-> CreateAssistantFileRequest -> CreateAssistantFileRequest
$cmin :: CreateAssistantFileRequest
-> CreateAssistantFileRequest -> CreateAssistantFileRequest
min :: CreateAssistantFileRequest
-> CreateAssistantFileRequest -> CreateAssistantFileRequest
Ord, (forall x.
 CreateAssistantFileRequest -> Rep CreateAssistantFileRequest x)
-> (forall x.
    Rep CreateAssistantFileRequest x -> CreateAssistantFileRequest)
-> Generic CreateAssistantFileRequest
forall x.
Rep CreateAssistantFileRequest x -> CreateAssistantFileRequest
forall x.
CreateAssistantFileRequest -> Rep CreateAssistantFileRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateAssistantFileRequest -> Rep CreateAssistantFileRequest x
from :: forall x.
CreateAssistantFileRequest -> Rep CreateAssistantFileRequest x
$cto :: forall x.
Rep CreateAssistantFileRequest x -> CreateAssistantFileRequest
to :: forall x.
Rep CreateAssistantFileRequest x -> CreateAssistantFileRequest
Generic, Typeable CreateAssistantFileRequest
Typeable CreateAssistantFileRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateAssistantFileRequest
 -> c CreateAssistantFileRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateAssistantFileRequest)
-> (CreateAssistantFileRequest -> Constr)
-> (CreateAssistantFileRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateAssistantFileRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateAssistantFileRequest))
-> ((forall b. Data b => b -> b)
    -> CreateAssistantFileRequest -> CreateAssistantFileRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateAssistantFileRequest
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateAssistantFileRequest
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateAssistantFileRequest -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> CreateAssistantFileRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateAssistantFileRequest -> m CreateAssistantFileRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateAssistantFileRequest -> m CreateAssistantFileRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateAssistantFileRequest -> m CreateAssistantFileRequest)
-> Data CreateAssistantFileRequest
CreateAssistantFileRequest -> Constr
CreateAssistantFileRequest -> DataType
(forall b. Data b => b -> b)
-> CreateAssistantFileRequest -> CreateAssistantFileRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateAssistantFileRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateAssistantFileRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantFileRequest
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantFileRequest
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateAssistantFileRequest -> m CreateAssistantFileRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantFileRequest -> m CreateAssistantFileRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateAssistantFileRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateAssistantFileRequest
-> c CreateAssistantFileRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateAssistantFileRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateAssistantFileRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateAssistantFileRequest
-> c CreateAssistantFileRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateAssistantFileRequest
-> c CreateAssistantFileRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateAssistantFileRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateAssistantFileRequest
$ctoConstr :: CreateAssistantFileRequest -> Constr
toConstr :: CreateAssistantFileRequest -> Constr
$cdataTypeOf :: CreateAssistantFileRequest -> DataType
dataTypeOf :: CreateAssistantFileRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateAssistantFileRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateAssistantFileRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateAssistantFileRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateAssistantFileRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateAssistantFileRequest -> CreateAssistantFileRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateAssistantFileRequest -> CreateAssistantFileRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantFileRequest
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantFileRequest
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantFileRequest
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantFileRequest
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateAssistantFileRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateAssistantFileRequest -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateAssistantFileRequest -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateAssistantFileRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateAssistantFileRequest -> m CreateAssistantFileRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateAssistantFileRequest -> m CreateAssistantFileRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantFileRequest -> m CreateAssistantFileRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantFileRequest -> m CreateAssistantFileRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantFileRequest -> m CreateAssistantFileRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantFileRequest -> m CreateAssistantFileRequest
Data)

instance FromJSON CreateAssistantFileRequest where
  parseJSON :: Value -> Parser CreateAssistantFileRequest
parseJSON = Options -> Value -> Parser CreateAssistantFileRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createAssistantFileRequest")
instance ToJSON CreateAssistantFileRequest where
  toJSON :: CreateAssistantFileRequest -> Value
toJSON = Options -> CreateAssistantFileRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createAssistantFileRequest")


-- | 
data CreateAssistantRequest = CreateAssistantRequest
  { CreateAssistantRequest -> CreateAssistantRequestModel
createAssistantRequestModel :: CreateAssistantRequestModel -- ^ 
  , CreateAssistantRequest -> Maybe Text
createAssistantRequestName :: Maybe Text -- ^ The name of the assistant. The maximum length is 256 characters. 
  , CreateAssistantRequest -> Maybe Text
createAssistantRequestDescription :: Maybe Text -- ^ The description of the assistant. The maximum length is 512 characters. 
  , CreateAssistantRequest -> Maybe Text
createAssistantRequestInstructions :: Maybe Text -- ^ The system instructions that the assistant uses. The maximum length is 32768 characters. 
  , CreateAssistantRequest -> Maybe [AssistantObjectToolsInner]
createAssistantRequestTools :: Maybe [AssistantObjectToolsInner] -- ^ A list of tool enabled on the assistant. There can be a maximum of 128 tools per assistant. Tools can be of types `code_interpreter`, `retrieval`, or `function`. 
  , CreateAssistantRequest -> Maybe [Text]
createAssistantRequestFileUnderscoreids :: Maybe [Text] -- ^ A list of [file](/docs/api-reference/files) IDs attached to this assistant. There can be a maximum of 20 files attached to the assistant. Files are ordered by their creation date in ascending order. 
  , CreateAssistantRequest -> Maybe Value
createAssistantRequestMetadata :: Maybe Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> CreateAssistantRequest -> ShowS
[CreateAssistantRequest] -> ShowS
CreateAssistantRequest -> String
(Int -> CreateAssistantRequest -> ShowS)
-> (CreateAssistantRequest -> String)
-> ([CreateAssistantRequest] -> ShowS)
-> Show CreateAssistantRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateAssistantRequest -> ShowS
showsPrec :: Int -> CreateAssistantRequest -> ShowS
$cshow :: CreateAssistantRequest -> String
show :: CreateAssistantRequest -> String
$cshowList :: [CreateAssistantRequest] -> ShowS
showList :: [CreateAssistantRequest] -> ShowS
Show, CreateAssistantRequest -> CreateAssistantRequest -> Bool
(CreateAssistantRequest -> CreateAssistantRequest -> Bool)
-> (CreateAssistantRequest -> CreateAssistantRequest -> Bool)
-> Eq CreateAssistantRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
== :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
$c/= :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
/= :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
Eq, Eq CreateAssistantRequest
Eq CreateAssistantRequest =>
(CreateAssistantRequest -> CreateAssistantRequest -> Ordering)
-> (CreateAssistantRequest -> CreateAssistantRequest -> Bool)
-> (CreateAssistantRequest -> CreateAssistantRequest -> Bool)
-> (CreateAssistantRequest -> CreateAssistantRequest -> Bool)
-> (CreateAssistantRequest -> CreateAssistantRequest -> Bool)
-> (CreateAssistantRequest
    -> CreateAssistantRequest -> CreateAssistantRequest)
-> (CreateAssistantRequest
    -> CreateAssistantRequest -> CreateAssistantRequest)
-> Ord CreateAssistantRequest
CreateAssistantRequest -> CreateAssistantRequest -> Bool
CreateAssistantRequest -> CreateAssistantRequest -> Ordering
CreateAssistantRequest
-> CreateAssistantRequest -> CreateAssistantRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateAssistantRequest -> CreateAssistantRequest -> Ordering
compare :: CreateAssistantRequest -> CreateAssistantRequest -> Ordering
$c< :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
< :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
$c<= :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
<= :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
$c> :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
> :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
$c>= :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
>= :: CreateAssistantRequest -> CreateAssistantRequest -> Bool
$cmax :: CreateAssistantRequest
-> CreateAssistantRequest -> CreateAssistantRequest
max :: CreateAssistantRequest
-> CreateAssistantRequest -> CreateAssistantRequest
$cmin :: CreateAssistantRequest
-> CreateAssistantRequest -> CreateAssistantRequest
min :: CreateAssistantRequest
-> CreateAssistantRequest -> CreateAssistantRequest
Ord, (forall x. CreateAssistantRequest -> Rep CreateAssistantRequest x)
-> (forall x.
    Rep CreateAssistantRequest x -> CreateAssistantRequest)
-> Generic CreateAssistantRequest
forall x. Rep CreateAssistantRequest x -> CreateAssistantRequest
forall x. CreateAssistantRequest -> Rep CreateAssistantRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateAssistantRequest -> Rep CreateAssistantRequest x
from :: forall x. CreateAssistantRequest -> Rep CreateAssistantRequest x
$cto :: forall x. Rep CreateAssistantRequest x -> CreateAssistantRequest
to :: forall x. Rep CreateAssistantRequest x -> CreateAssistantRequest
Generic, Typeable CreateAssistantRequest
Typeable CreateAssistantRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateAssistantRequest
 -> c CreateAssistantRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateAssistantRequest)
-> (CreateAssistantRequest -> Constr)
-> (CreateAssistantRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateAssistantRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateAssistantRequest))
-> ((forall b. Data b => b -> b)
    -> CreateAssistantRequest -> CreateAssistantRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateAssistantRequest
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateAssistantRequest
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateAssistantRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CreateAssistantRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateAssistantRequest -> m CreateAssistantRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateAssistantRequest -> m CreateAssistantRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateAssistantRequest -> m CreateAssistantRequest)
-> Data CreateAssistantRequest
CreateAssistantRequest -> Constr
CreateAssistantRequest -> DataType
(forall b. Data b => b -> b)
-> CreateAssistantRequest -> CreateAssistantRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateAssistantRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateAssistantRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequest
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequest
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequest -> m CreateAssistantRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequest -> m CreateAssistantRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateAssistantRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateAssistantRequest
-> c CreateAssistantRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateAssistantRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateAssistantRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateAssistantRequest
-> c CreateAssistantRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateAssistantRequest
-> c CreateAssistantRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateAssistantRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateAssistantRequest
$ctoConstr :: CreateAssistantRequest -> Constr
toConstr :: CreateAssistantRequest -> Constr
$cdataTypeOf :: CreateAssistantRequest -> DataType
dataTypeOf :: CreateAssistantRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateAssistantRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateAssistantRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateAssistantRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateAssistantRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateAssistantRequest -> CreateAssistantRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateAssistantRequest -> CreateAssistantRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequest
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequest
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequest
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequest
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateAssistantRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateAssistantRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateAssistantRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateAssistantRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequest -> m CreateAssistantRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequest -> m CreateAssistantRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequest -> m CreateAssistantRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequest -> m CreateAssistantRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequest -> m CreateAssistantRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequest -> m CreateAssistantRequest
Data)

instance FromJSON CreateAssistantRequest where
  parseJSON :: Value -> Parser CreateAssistantRequest
parseJSON = Options -> Value -> Parser CreateAssistantRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createAssistantRequest")
instance ToJSON CreateAssistantRequest where
  toJSON :: CreateAssistantRequest -> Value
toJSON = Options -> CreateAssistantRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createAssistantRequest")


-- | ID of the model to use. You can use the [List models](/docs/api-reference/models/list) API to see all of your available models, or see our [Model overview](/docs/models/overview) for descriptions of them. 
data CreateAssistantRequestModel = CreateAssistantRequestModel Text  deriving (Int -> CreateAssistantRequestModel -> ShowS
[CreateAssistantRequestModel] -> ShowS
CreateAssistantRequestModel -> String
(Int -> CreateAssistantRequestModel -> ShowS)
-> (CreateAssistantRequestModel -> String)
-> ([CreateAssistantRequestModel] -> ShowS)
-> Show CreateAssistantRequestModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateAssistantRequestModel -> ShowS
showsPrec :: Int -> CreateAssistantRequestModel -> ShowS
$cshow :: CreateAssistantRequestModel -> String
show :: CreateAssistantRequestModel -> String
$cshowList :: [CreateAssistantRequestModel] -> ShowS
showList :: [CreateAssistantRequestModel] -> ShowS
Show, CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
(CreateAssistantRequestModel
 -> CreateAssistantRequestModel -> Bool)
-> (CreateAssistantRequestModel
    -> CreateAssistantRequestModel -> Bool)
-> Eq CreateAssistantRequestModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
== :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
$c/= :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
/= :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
Eq, Eq CreateAssistantRequestModel
Eq CreateAssistantRequestModel =>
(CreateAssistantRequestModel
 -> CreateAssistantRequestModel -> Ordering)
-> (CreateAssistantRequestModel
    -> CreateAssistantRequestModel -> Bool)
-> (CreateAssistantRequestModel
    -> CreateAssistantRequestModel -> Bool)
-> (CreateAssistantRequestModel
    -> CreateAssistantRequestModel -> Bool)
-> (CreateAssistantRequestModel
    -> CreateAssistantRequestModel -> Bool)
-> (CreateAssistantRequestModel
    -> CreateAssistantRequestModel -> CreateAssistantRequestModel)
-> (CreateAssistantRequestModel
    -> CreateAssistantRequestModel -> CreateAssistantRequestModel)
-> Ord CreateAssistantRequestModel
CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
CreateAssistantRequestModel
-> CreateAssistantRequestModel -> Ordering
CreateAssistantRequestModel
-> CreateAssistantRequestModel -> CreateAssistantRequestModel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateAssistantRequestModel
-> CreateAssistantRequestModel -> Ordering
compare :: CreateAssistantRequestModel
-> CreateAssistantRequestModel -> Ordering
$c< :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
< :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
$c<= :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
<= :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
$c> :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
> :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
$c>= :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
>= :: CreateAssistantRequestModel -> CreateAssistantRequestModel -> Bool
$cmax :: CreateAssistantRequestModel
-> CreateAssistantRequestModel -> CreateAssistantRequestModel
max :: CreateAssistantRequestModel
-> CreateAssistantRequestModel -> CreateAssistantRequestModel
$cmin :: CreateAssistantRequestModel
-> CreateAssistantRequestModel -> CreateAssistantRequestModel
min :: CreateAssistantRequestModel
-> CreateAssistantRequestModel -> CreateAssistantRequestModel
Ord, (forall x.
 CreateAssistantRequestModel -> Rep CreateAssistantRequestModel x)
-> (forall x.
    Rep CreateAssistantRequestModel x -> CreateAssistantRequestModel)
-> Generic CreateAssistantRequestModel
forall x.
Rep CreateAssistantRequestModel x -> CreateAssistantRequestModel
forall x.
CreateAssistantRequestModel -> Rep CreateAssistantRequestModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateAssistantRequestModel -> Rep CreateAssistantRequestModel x
from :: forall x.
CreateAssistantRequestModel -> Rep CreateAssistantRequestModel x
$cto :: forall x.
Rep CreateAssistantRequestModel x -> CreateAssistantRequestModel
to :: forall x.
Rep CreateAssistantRequestModel x -> CreateAssistantRequestModel
Generic, Typeable CreateAssistantRequestModel
Typeable CreateAssistantRequestModel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateAssistantRequestModel
 -> c CreateAssistantRequestModel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateAssistantRequestModel)
-> (CreateAssistantRequestModel -> Constr)
-> (CreateAssistantRequestModel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateAssistantRequestModel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateAssistantRequestModel))
-> ((forall b. Data b => b -> b)
    -> CreateAssistantRequestModel -> CreateAssistantRequestModel)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateAssistantRequestModel
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateAssistantRequestModel
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateAssistantRequestModel -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateAssistantRequestModel
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateAssistantRequestModel -> m CreateAssistantRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateAssistantRequestModel -> m CreateAssistantRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateAssistantRequestModel -> m CreateAssistantRequestModel)
-> Data CreateAssistantRequestModel
CreateAssistantRequestModel -> Constr
CreateAssistantRequestModel -> DataType
(forall b. Data b => b -> b)
-> CreateAssistantRequestModel -> CreateAssistantRequestModel
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateAssistantRequestModel -> u
forall u.
(forall d. Data d => d -> u) -> CreateAssistantRequestModel -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequestModel
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequestModel
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequestModel -> m CreateAssistantRequestModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequestModel -> m CreateAssistantRequestModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateAssistantRequestModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateAssistantRequestModel
-> c CreateAssistantRequestModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateAssistantRequestModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateAssistantRequestModel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateAssistantRequestModel
-> c CreateAssistantRequestModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateAssistantRequestModel
-> c CreateAssistantRequestModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateAssistantRequestModel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateAssistantRequestModel
$ctoConstr :: CreateAssistantRequestModel -> Constr
toConstr :: CreateAssistantRequestModel -> Constr
$cdataTypeOf :: CreateAssistantRequestModel -> DataType
dataTypeOf :: CreateAssistantRequestModel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateAssistantRequestModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateAssistantRequestModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateAssistantRequestModel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateAssistantRequestModel)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateAssistantRequestModel -> CreateAssistantRequestModel
gmapT :: (forall b. Data b => b -> b)
-> CreateAssistantRequestModel -> CreateAssistantRequestModel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequestModel
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequestModel
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequestModel
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateAssistantRequestModel
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateAssistantRequestModel -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateAssistantRequestModel -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateAssistantRequestModel -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateAssistantRequestModel -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequestModel -> m CreateAssistantRequestModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequestModel -> m CreateAssistantRequestModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequestModel -> m CreateAssistantRequestModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequestModel -> m CreateAssistantRequestModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequestModel -> m CreateAssistantRequestModel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateAssistantRequestModel -> m CreateAssistantRequestModel
Data)

instance FromJSON CreateAssistantRequestModel where
  parseJSON :: Value -> Parser CreateAssistantRequestModel
parseJSON = Options -> Value -> Parser CreateAssistantRequestModel
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createAssistantRequestModel")
instance ToJSON CreateAssistantRequestModel where
  toJSON :: CreateAssistantRequestModel -> Value
toJSON = Options -> CreateAssistantRequestModel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createAssistantRequestModel")


-- | Represents a chat completion response returned by model, based on the provided input.
data CreateChatCompletionFunctionResponse = CreateChatCompletionFunctionResponse
  { CreateChatCompletionFunctionResponse -> Text
createChatCompletionFunctionResponseId :: Text -- ^ A unique identifier for the chat completion.
  , CreateChatCompletionFunctionResponse
-> [CreateChatCompletionFunctionResponseChoicesInner]
createChatCompletionFunctionResponseChoices :: [CreateChatCompletionFunctionResponseChoicesInner] -- ^ A list of chat completion choices. Can be more than one if `n` is greater than 1.
  , CreateChatCompletionFunctionResponse -> Int
createChatCompletionFunctionResponseCreated :: Int -- ^ The Unix timestamp (in seconds) of when the chat completion was created.
  , CreateChatCompletionFunctionResponse -> Text
createChatCompletionFunctionResponseModel :: Text -- ^ The model used for the chat completion.
  , CreateChatCompletionFunctionResponse -> Maybe Text
createChatCompletionFunctionResponseSystemUnderscorefingerprint :: Maybe Text -- ^ This fingerprint represents the backend configuration that the model runs with.  Can be used in conjunction with the `seed` request parameter to understand when backend changes have been made that might impact determinism. 
  , CreateChatCompletionFunctionResponse -> Text
createChatCompletionFunctionResponseObject :: Text -- ^ The object type, which is always `chat.completion`.
  , CreateChatCompletionFunctionResponse -> Maybe CompletionUsage
createChatCompletionFunctionResponseUsage :: Maybe CompletionUsage -- ^ 
  } deriving (Int -> CreateChatCompletionFunctionResponse -> ShowS
[CreateChatCompletionFunctionResponse] -> ShowS
CreateChatCompletionFunctionResponse -> String
(Int -> CreateChatCompletionFunctionResponse -> ShowS)
-> (CreateChatCompletionFunctionResponse -> String)
-> ([CreateChatCompletionFunctionResponse] -> ShowS)
-> Show CreateChatCompletionFunctionResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionFunctionResponse -> ShowS
showsPrec :: Int -> CreateChatCompletionFunctionResponse -> ShowS
$cshow :: CreateChatCompletionFunctionResponse -> String
show :: CreateChatCompletionFunctionResponse -> String
$cshowList :: [CreateChatCompletionFunctionResponse] -> ShowS
showList :: [CreateChatCompletionFunctionResponse] -> ShowS
Show, CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
(CreateChatCompletionFunctionResponse
 -> CreateChatCompletionFunctionResponse -> Bool)
-> (CreateChatCompletionFunctionResponse
    -> CreateChatCompletionFunctionResponse -> Bool)
-> Eq CreateChatCompletionFunctionResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
== :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
$c/= :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
/= :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
Eq, Eq CreateChatCompletionFunctionResponse
Eq CreateChatCompletionFunctionResponse =>
(CreateChatCompletionFunctionResponse
 -> CreateChatCompletionFunctionResponse -> Ordering)
-> (CreateChatCompletionFunctionResponse
    -> CreateChatCompletionFunctionResponse -> Bool)
-> (CreateChatCompletionFunctionResponse
    -> CreateChatCompletionFunctionResponse -> Bool)
-> (CreateChatCompletionFunctionResponse
    -> CreateChatCompletionFunctionResponse -> Bool)
-> (CreateChatCompletionFunctionResponse
    -> CreateChatCompletionFunctionResponse -> Bool)
-> (CreateChatCompletionFunctionResponse
    -> CreateChatCompletionFunctionResponse
    -> CreateChatCompletionFunctionResponse)
-> (CreateChatCompletionFunctionResponse
    -> CreateChatCompletionFunctionResponse
    -> CreateChatCompletionFunctionResponse)
-> Ord CreateChatCompletionFunctionResponse
CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Ordering
CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Ordering
compare :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Ordering
$c< :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
< :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
$c<= :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
<= :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
$c> :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
> :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
$c>= :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
>= :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse -> Bool
$cmax :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
max :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
$cmin :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
min :: CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
Ord, (forall x.
 CreateChatCompletionFunctionResponse
 -> Rep CreateChatCompletionFunctionResponse x)
-> (forall x.
    Rep CreateChatCompletionFunctionResponse x
    -> CreateChatCompletionFunctionResponse)
-> Generic CreateChatCompletionFunctionResponse
forall x.
Rep CreateChatCompletionFunctionResponse x
-> CreateChatCompletionFunctionResponse
forall x.
CreateChatCompletionFunctionResponse
-> Rep CreateChatCompletionFunctionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionFunctionResponse
-> Rep CreateChatCompletionFunctionResponse x
from :: forall x.
CreateChatCompletionFunctionResponse
-> Rep CreateChatCompletionFunctionResponse x
$cto :: forall x.
Rep CreateChatCompletionFunctionResponse x
-> CreateChatCompletionFunctionResponse
to :: forall x.
Rep CreateChatCompletionFunctionResponse x
-> CreateChatCompletionFunctionResponse
Generic, Typeable CreateChatCompletionFunctionResponse
Typeable CreateChatCompletionFunctionResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionFunctionResponse
 -> c CreateChatCompletionFunctionResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionFunctionResponse)
-> (CreateChatCompletionFunctionResponse -> Constr)
-> (CreateChatCompletionFunctionResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionFunctionResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionFunctionResponse))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionFunctionResponse
    -> CreateChatCompletionFunctionResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionFunctionResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionFunctionResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionFunctionResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionFunctionResponse
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionFunctionResponse
    -> m CreateChatCompletionFunctionResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionFunctionResponse
    -> m CreateChatCompletionFunctionResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionFunctionResponse
    -> m CreateChatCompletionFunctionResponse)
-> Data CreateChatCompletionFunctionResponse
CreateChatCompletionFunctionResponse -> Constr
CreateChatCompletionFunctionResponse -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponse
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponse
-> m CreateChatCompletionFunctionResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponse
-> m CreateChatCompletionFunctionResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionFunctionResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionFunctionResponse
-> c CreateChatCompletionFunctionResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionFunctionResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionFunctionResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionFunctionResponse
-> c CreateChatCompletionFunctionResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionFunctionResponse
-> c CreateChatCompletionFunctionResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionFunctionResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionFunctionResponse
$ctoConstr :: CreateChatCompletionFunctionResponse -> Constr
toConstr :: CreateChatCompletionFunctionResponse -> Constr
$cdataTypeOf :: CreateChatCompletionFunctionResponse -> DataType
dataTypeOf :: CreateChatCompletionFunctionResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionFunctionResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionFunctionResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionFunctionResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionFunctionResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionFunctionResponse
-> CreateChatCompletionFunctionResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponse -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponse
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponse
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponse
-> m CreateChatCompletionFunctionResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponse
-> m CreateChatCompletionFunctionResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponse
-> m CreateChatCompletionFunctionResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponse
-> m CreateChatCompletionFunctionResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponse
-> m CreateChatCompletionFunctionResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponse
-> m CreateChatCompletionFunctionResponse
Data)

instance FromJSON CreateChatCompletionFunctionResponse where
  parseJSON :: Value -> Parser CreateChatCompletionFunctionResponse
parseJSON = Options -> Value -> Parser CreateChatCompletionFunctionResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionFunctionResponse")
instance ToJSON CreateChatCompletionFunctionResponse where
  toJSON :: CreateChatCompletionFunctionResponse -> Value
toJSON = Options -> CreateChatCompletionFunctionResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionFunctionResponse")


-- | 
data CreateChatCompletionFunctionResponseChoicesInner = CreateChatCompletionFunctionResponseChoicesInner
  { CreateChatCompletionFunctionResponseChoicesInner -> Text
createChatCompletionFunctionResponseChoicesInnerFinishUnderscorereason :: Text -- ^ The reason the model stopped generating tokens. This will be `stop` if the model hit a natural stop point or a provided stop sequence, `length` if the maximum number of tokens specified in the request was reached, `content_filter` if content was omitted due to a flag from our content filters, or `function_call` if the model called a function. 
  , CreateChatCompletionFunctionResponseChoicesInner -> Int
createChatCompletionFunctionResponseChoicesInnerIndex :: Int -- ^ The index of the choice in the list of choices.
  , CreateChatCompletionFunctionResponseChoicesInner
-> ChatCompletionResponseMessage
createChatCompletionFunctionResponseChoicesInnerMessage :: ChatCompletionResponseMessage -- ^ 
  } deriving (Int -> CreateChatCompletionFunctionResponseChoicesInner -> ShowS
[CreateChatCompletionFunctionResponseChoicesInner] -> ShowS
CreateChatCompletionFunctionResponseChoicesInner -> String
(Int -> CreateChatCompletionFunctionResponseChoicesInner -> ShowS)
-> (CreateChatCompletionFunctionResponseChoicesInner -> String)
-> ([CreateChatCompletionFunctionResponseChoicesInner] -> ShowS)
-> Show CreateChatCompletionFunctionResponseChoicesInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionFunctionResponseChoicesInner -> ShowS
showsPrec :: Int -> CreateChatCompletionFunctionResponseChoicesInner -> ShowS
$cshow :: CreateChatCompletionFunctionResponseChoicesInner -> String
show :: CreateChatCompletionFunctionResponseChoicesInner -> String
$cshowList :: [CreateChatCompletionFunctionResponseChoicesInner] -> ShowS
showList :: [CreateChatCompletionFunctionResponseChoicesInner] -> ShowS
Show, CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
(CreateChatCompletionFunctionResponseChoicesInner
 -> CreateChatCompletionFunctionResponseChoicesInner -> Bool)
-> (CreateChatCompletionFunctionResponseChoicesInner
    -> CreateChatCompletionFunctionResponseChoicesInner -> Bool)
-> Eq CreateChatCompletionFunctionResponseChoicesInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
== :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
$c/= :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
/= :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
Eq, Eq CreateChatCompletionFunctionResponseChoicesInner
Eq CreateChatCompletionFunctionResponseChoicesInner =>
(CreateChatCompletionFunctionResponseChoicesInner
 -> CreateChatCompletionFunctionResponseChoicesInner -> Ordering)
-> (CreateChatCompletionFunctionResponseChoicesInner
    -> CreateChatCompletionFunctionResponseChoicesInner -> Bool)
-> (CreateChatCompletionFunctionResponseChoicesInner
    -> CreateChatCompletionFunctionResponseChoicesInner -> Bool)
-> (CreateChatCompletionFunctionResponseChoicesInner
    -> CreateChatCompletionFunctionResponseChoicesInner -> Bool)
-> (CreateChatCompletionFunctionResponseChoicesInner
    -> CreateChatCompletionFunctionResponseChoicesInner -> Bool)
-> (CreateChatCompletionFunctionResponseChoicesInner
    -> CreateChatCompletionFunctionResponseChoicesInner
    -> CreateChatCompletionFunctionResponseChoicesInner)
-> (CreateChatCompletionFunctionResponseChoicesInner
    -> CreateChatCompletionFunctionResponseChoicesInner
    -> CreateChatCompletionFunctionResponseChoicesInner)
-> Ord CreateChatCompletionFunctionResponseChoicesInner
CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Ordering
CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Ordering
compare :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Ordering
$c< :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
< :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
$c<= :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
<= :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
$c> :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
> :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
$c>= :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
>= :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner -> Bool
$cmax :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
max :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
$cmin :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
min :: CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
Ord, (forall x.
 CreateChatCompletionFunctionResponseChoicesInner
 -> Rep CreateChatCompletionFunctionResponseChoicesInner x)
-> (forall x.
    Rep CreateChatCompletionFunctionResponseChoicesInner x
    -> CreateChatCompletionFunctionResponseChoicesInner)
-> Generic CreateChatCompletionFunctionResponseChoicesInner
forall x.
Rep CreateChatCompletionFunctionResponseChoicesInner x
-> CreateChatCompletionFunctionResponseChoicesInner
forall x.
CreateChatCompletionFunctionResponseChoicesInner
-> Rep CreateChatCompletionFunctionResponseChoicesInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionFunctionResponseChoicesInner
-> Rep CreateChatCompletionFunctionResponseChoicesInner x
from :: forall x.
CreateChatCompletionFunctionResponseChoicesInner
-> Rep CreateChatCompletionFunctionResponseChoicesInner x
$cto :: forall x.
Rep CreateChatCompletionFunctionResponseChoicesInner x
-> CreateChatCompletionFunctionResponseChoicesInner
to :: forall x.
Rep CreateChatCompletionFunctionResponseChoicesInner x
-> CreateChatCompletionFunctionResponseChoicesInner
Generic, Typeable CreateChatCompletionFunctionResponseChoicesInner
Typeable CreateChatCompletionFunctionResponseChoicesInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionFunctionResponseChoicesInner
 -> c CreateChatCompletionFunctionResponseChoicesInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionFunctionResponseChoicesInner)
-> (CreateChatCompletionFunctionResponseChoicesInner -> Constr)
-> (CreateChatCompletionFunctionResponseChoicesInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionFunctionResponseChoicesInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionFunctionResponseChoicesInner))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionFunctionResponseChoicesInner
    -> CreateChatCompletionFunctionResponseChoicesInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionFunctionResponseChoicesInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionFunctionResponseChoicesInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionFunctionResponseChoicesInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionFunctionResponseChoicesInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionFunctionResponseChoicesInner
    -> m CreateChatCompletionFunctionResponseChoicesInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionFunctionResponseChoicesInner
    -> m CreateChatCompletionFunctionResponseChoicesInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionFunctionResponseChoicesInner
    -> m CreateChatCompletionFunctionResponseChoicesInner)
-> Data CreateChatCompletionFunctionResponseChoicesInner
CreateChatCompletionFunctionResponseChoicesInner -> Constr
CreateChatCompletionFunctionResponseChoicesInner -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponseChoicesInner
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponseChoicesInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponseChoicesInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponseChoicesInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponseChoicesInner
-> m CreateChatCompletionFunctionResponseChoicesInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponseChoicesInner
-> m CreateChatCompletionFunctionResponseChoicesInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionFunctionResponseChoicesInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionFunctionResponseChoicesInner
-> c CreateChatCompletionFunctionResponseChoicesInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionFunctionResponseChoicesInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionFunctionResponseChoicesInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionFunctionResponseChoicesInner
-> c CreateChatCompletionFunctionResponseChoicesInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionFunctionResponseChoicesInner
-> c CreateChatCompletionFunctionResponseChoicesInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionFunctionResponseChoicesInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionFunctionResponseChoicesInner
$ctoConstr :: CreateChatCompletionFunctionResponseChoicesInner -> Constr
toConstr :: CreateChatCompletionFunctionResponseChoicesInner -> Constr
$cdataTypeOf :: CreateChatCompletionFunctionResponseChoicesInner -> DataType
dataTypeOf :: CreateChatCompletionFunctionResponseChoicesInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionFunctionResponseChoicesInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionFunctionResponseChoicesInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionFunctionResponseChoicesInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionFunctionResponseChoicesInner)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionFunctionResponseChoicesInner
-> CreateChatCompletionFunctionResponseChoicesInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponseChoicesInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponseChoicesInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponseChoicesInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionFunctionResponseChoicesInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponseChoicesInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponseChoicesInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponseChoicesInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionFunctionResponseChoicesInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponseChoicesInner
-> m CreateChatCompletionFunctionResponseChoicesInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponseChoicesInner
-> m CreateChatCompletionFunctionResponseChoicesInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponseChoicesInner
-> m CreateChatCompletionFunctionResponseChoicesInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponseChoicesInner
-> m CreateChatCompletionFunctionResponseChoicesInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponseChoicesInner
-> m CreateChatCompletionFunctionResponseChoicesInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionFunctionResponseChoicesInner
-> m CreateChatCompletionFunctionResponseChoicesInner
Data)

instance FromJSON CreateChatCompletionFunctionResponseChoicesInner where
  parseJSON :: Value -> Parser CreateChatCompletionFunctionResponseChoicesInner
parseJSON = Options
-> Value -> Parser CreateChatCompletionFunctionResponseChoicesInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionFunctionResponseChoicesInner")
instance ToJSON CreateChatCompletionFunctionResponseChoicesInner where
  toJSON :: CreateChatCompletionFunctionResponseChoicesInner -> Value
toJSON = Options
-> CreateChatCompletionFunctionResponseChoicesInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionFunctionResponseChoicesInner")


-- | 
data CreateChatCompletionRequest = CreateChatCompletionRequest
  { CreateChatCompletionRequest -> [ChatCompletionRequestMessage]
createChatCompletionRequestMessages :: [ChatCompletionRequestMessage] -- ^ A list of messages comprising the conversation so far. [Example Python code](https://cookbook.openai.com/examples/how_to_format_inputs_to_chatgpt_models).
  , CreateChatCompletionRequest -> CreateChatCompletionRequestModel
createChatCompletionRequestModel :: CreateChatCompletionRequestModel -- ^ 
  , CreateChatCompletionRequest -> Maybe Double
createChatCompletionRequestFrequencyUnderscorepenalty :: Maybe Double -- ^ Number between -2.0 and 2.0. Positive values penalize new tokens based on their existing frequency in the text so far, decreasing the model's likelihood to repeat the same line verbatim.  [See more information about frequency and presence penalties.](/docs/guides/text-generation/parameter-details) 
  , CreateChatCompletionRequest -> Maybe (Map String Int)
createChatCompletionRequestLogitUnderscorebias :: Maybe (Map.Map String Int) -- ^ Modify the likelihood of specified tokens appearing in the completion.  Accepts a JSON object that maps tokens (specified by their token ID in the tokenizer) to an associated bias value from -100 to 100. Mathematically, the bias is added to the logits generated by the model prior to sampling. The exact effect will vary per model, but values between -1 and 1 should decrease or increase likelihood of selection; values like -100 or 100 should result in a ban or exclusive selection of the relevant token. 
  , CreateChatCompletionRequest -> Maybe Bool
createChatCompletionRequestLogprobs :: Maybe Bool -- ^ Whether to return log probabilities of the output tokens or not. If true, returns the log probabilities of each output token returned in the `content` of `message`. This option is currently not available on the `gpt-4-vision-preview` model.
  , CreateChatCompletionRequest -> Maybe Int
createChatCompletionRequestTopUnderscorelogprobs :: Maybe Int -- ^ An integer between 0 and 20 specifying the number of most likely tokens to return at each token position, each with an associated log probability. `logprobs` must be set to `true` if this parameter is used.
  , CreateChatCompletionRequest -> Maybe Int
createChatCompletionRequestMaxUnderscoretokens :: Maybe Int -- ^ The maximum number of [tokens](/tokenizer) that can be generated in the chat completion.  The total length of input tokens and generated tokens is limited by the model's context length. [Example Python code](https://cookbook.openai.com/examples/how_to_count_tokens_with_tiktoken) for counting tokens. 
  , CreateChatCompletionRequest -> Maybe Int
createChatCompletionRequestN :: Maybe Int -- ^ How many chat completion choices to generate for each input message. Note that you will be charged based on the number of generated tokens across all of the choices. Keep `n` as `1` to minimize costs.
  , CreateChatCompletionRequest -> Maybe Double
createChatCompletionRequestPresenceUnderscorepenalty :: Maybe Double -- ^ Number between -2.0 and 2.0. Positive values penalize new tokens based on whether they appear in the text so far, increasing the model's likelihood to talk about new topics.  [See more information about frequency and presence penalties.](/docs/guides/text-generation/parameter-details) 
  , CreateChatCompletionRequest
-> Maybe CreateChatCompletionRequestResponseFormat
createChatCompletionRequestResponseUnderscoreformat :: Maybe CreateChatCompletionRequestResponseFormat -- ^ 
  , CreateChatCompletionRequest -> Maybe Int
createChatCompletionRequestSeed :: Maybe Int -- ^ This feature is in Beta. If specified, our system will make a best effort to sample deterministically, such that repeated requests with the same `seed` and parameters should return the same result. Determinism is not guaranteed, and you should refer to the `system_fingerprint` response parameter to monitor changes in the backend. 
  , CreateChatCompletionRequest
-> Maybe CreateChatCompletionRequestStop
createChatCompletionRequestStop :: Maybe CreateChatCompletionRequestStop -- ^ 
  , CreateChatCompletionRequest -> Maybe Bool
createChatCompletionRequestStream :: Maybe Bool -- ^ If set, partial message deltas will be sent, like in ChatGPT. Tokens will be sent as data-only [server-sent events](https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events/Using_server-sent_events#Event_stream_format) as they become available, with the stream terminated by a `data: [DONE]` message. [Example Python code](https://cookbook.openai.com/examples/how_to_stream_completions). 
  , CreateChatCompletionRequest -> Maybe Double
createChatCompletionRequestTemperature :: Maybe Double -- ^ What sampling temperature to use, between 0 and 2. Higher values like 0.8 will make the output more random, while lower values like 0.2 will make it more focused and deterministic.  We generally recommend altering this or `top_p` but not both. 
  , CreateChatCompletionRequest -> Maybe Double
createChatCompletionRequestTopUnderscorep :: Maybe Double -- ^ An alternative to sampling with temperature, called nucleus sampling, where the model considers the results of the tokens with top_p probability mass. So 0.1 means only the tokens comprising the top 10% probability mass are considered.  We generally recommend altering this or `temperature` but not both. 
  , CreateChatCompletionRequest -> Maybe [ChatCompletionTool]
createChatCompletionRequestTools :: Maybe [ChatCompletionTool] -- ^ A list of tools the model may call. Currently, only functions are supported as a tool. Use this to provide a list of functions the model may generate JSON inputs for. 
  , CreateChatCompletionRequest -> Maybe ChatCompletionToolChoiceOption
createChatCompletionRequestToolUnderscorechoice :: Maybe ChatCompletionToolChoiceOption -- ^ 
  , CreateChatCompletionRequest -> Maybe Text
createChatCompletionRequestUser :: Maybe Text -- ^ A unique identifier representing your end-user, which can help OpenAI to monitor and detect abuse. [Learn more](/docs/guides/safety-best-practices/end-user-ids). 
  , CreateChatCompletionRequest
-> Maybe CreateChatCompletionRequestFunctionCall
createChatCompletionRequestFunctionUnderscorecall :: Maybe CreateChatCompletionRequestFunctionCall -- ^ 
  , CreateChatCompletionRequest -> Maybe [ChatCompletionFunctions]
createChatCompletionRequestFunctions :: Maybe [ChatCompletionFunctions] -- ^ Deprecated in favor of `tools`.  A list of functions the model may generate JSON inputs for. 
  } deriving (Int -> CreateChatCompletionRequest -> ShowS
[CreateChatCompletionRequest] -> ShowS
CreateChatCompletionRequest -> String
(Int -> CreateChatCompletionRequest -> ShowS)
-> (CreateChatCompletionRequest -> String)
-> ([CreateChatCompletionRequest] -> ShowS)
-> Show CreateChatCompletionRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionRequest -> ShowS
showsPrec :: Int -> CreateChatCompletionRequest -> ShowS
$cshow :: CreateChatCompletionRequest -> String
show :: CreateChatCompletionRequest -> String
$cshowList :: [CreateChatCompletionRequest] -> ShowS
showList :: [CreateChatCompletionRequest] -> ShowS
Show, CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
(CreateChatCompletionRequest
 -> CreateChatCompletionRequest -> Bool)
-> (CreateChatCompletionRequest
    -> CreateChatCompletionRequest -> Bool)
-> Eq CreateChatCompletionRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
== :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
$c/= :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
/= :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
Eq, Eq CreateChatCompletionRequest
Eq CreateChatCompletionRequest =>
(CreateChatCompletionRequest
 -> CreateChatCompletionRequest -> Ordering)
-> (CreateChatCompletionRequest
    -> CreateChatCompletionRequest -> Bool)
-> (CreateChatCompletionRequest
    -> CreateChatCompletionRequest -> Bool)
-> (CreateChatCompletionRequest
    -> CreateChatCompletionRequest -> Bool)
-> (CreateChatCompletionRequest
    -> CreateChatCompletionRequest -> Bool)
-> (CreateChatCompletionRequest
    -> CreateChatCompletionRequest -> CreateChatCompletionRequest)
-> (CreateChatCompletionRequest
    -> CreateChatCompletionRequest -> CreateChatCompletionRequest)
-> Ord CreateChatCompletionRequest
CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
CreateChatCompletionRequest
-> CreateChatCompletionRequest -> Ordering
CreateChatCompletionRequest
-> CreateChatCompletionRequest -> CreateChatCompletionRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionRequest
-> CreateChatCompletionRequest -> Ordering
compare :: CreateChatCompletionRequest
-> CreateChatCompletionRequest -> Ordering
$c< :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
< :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
$c<= :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
<= :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
$c> :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
> :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
$c>= :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
>= :: CreateChatCompletionRequest -> CreateChatCompletionRequest -> Bool
$cmax :: CreateChatCompletionRequest
-> CreateChatCompletionRequest -> CreateChatCompletionRequest
max :: CreateChatCompletionRequest
-> CreateChatCompletionRequest -> CreateChatCompletionRequest
$cmin :: CreateChatCompletionRequest
-> CreateChatCompletionRequest -> CreateChatCompletionRequest
min :: CreateChatCompletionRequest
-> CreateChatCompletionRequest -> CreateChatCompletionRequest
Ord, (forall x.
 CreateChatCompletionRequest -> Rep CreateChatCompletionRequest x)
-> (forall x.
    Rep CreateChatCompletionRequest x -> CreateChatCompletionRequest)
-> Generic CreateChatCompletionRequest
forall x.
Rep CreateChatCompletionRequest x -> CreateChatCompletionRequest
forall x.
CreateChatCompletionRequest -> Rep CreateChatCompletionRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionRequest -> Rep CreateChatCompletionRequest x
from :: forall x.
CreateChatCompletionRequest -> Rep CreateChatCompletionRequest x
$cto :: forall x.
Rep CreateChatCompletionRequest x -> CreateChatCompletionRequest
to :: forall x.
Rep CreateChatCompletionRequest x -> CreateChatCompletionRequest
Generic, Typeable CreateChatCompletionRequest
Typeable CreateChatCompletionRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionRequest
 -> c CreateChatCompletionRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateChatCompletionRequest)
-> (CreateChatCompletionRequest -> Constr)
-> (CreateChatCompletionRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionRequest))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionRequest -> CreateChatCompletionRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionRequest
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionRequest
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateChatCompletionRequest -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionRequest
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequest -> m CreateChatCompletionRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequest -> m CreateChatCompletionRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequest -> m CreateChatCompletionRequest)
-> Data CreateChatCompletionRequest
CreateChatCompletionRequest -> Constr
CreateChatCompletionRequest -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionRequest -> CreateChatCompletionRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateChatCompletionRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateChatCompletionRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequest
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequest
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequest -> m CreateChatCompletionRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequest -> m CreateChatCompletionRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateChatCompletionRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequest
-> c CreateChatCompletionRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequest
-> c CreateChatCompletionRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequest
-> c CreateChatCompletionRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateChatCompletionRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateChatCompletionRequest
$ctoConstr :: CreateChatCompletionRequest -> Constr
toConstr :: CreateChatCompletionRequest -> Constr
$cdataTypeOf :: CreateChatCompletionRequest -> DataType
dataTypeOf :: CreateChatCompletionRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionRequest -> CreateChatCompletionRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionRequest -> CreateChatCompletionRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequest
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequest
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequest
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequest
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateChatCompletionRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateChatCompletionRequest -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateChatCompletionRequest -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateChatCompletionRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequest -> m CreateChatCompletionRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequest -> m CreateChatCompletionRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequest -> m CreateChatCompletionRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequest -> m CreateChatCompletionRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequest -> m CreateChatCompletionRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequest -> m CreateChatCompletionRequest
Data)

instance FromJSON CreateChatCompletionRequest where
  parseJSON :: Value -> Parser CreateChatCompletionRequest
parseJSON = Options -> Value -> Parser CreateChatCompletionRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionRequest")
instance ToJSON CreateChatCompletionRequest where
  toJSON :: CreateChatCompletionRequest -> Value
toJSON = Options -> CreateChatCompletionRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionRequest")


-- | Deprecated in favor of &#x60;tool_choice&#x60;.  Controls which (if any) function is called by the model. &#x60;none&#x60; means the model will not call a function and instead generates a message. &#x60;auto&#x60; means the model can pick between generating a message or calling a function. Specifying a particular function via &#x60;{\&quot;name\&quot;: \&quot;my_function\&quot;}&#x60; forces the model to call that function.  &#x60;none&#x60; is the default when no functions are present. &#x60;auto&#x60; is the default if functions are present. 
data CreateChatCompletionRequestFunctionCall = CreateChatCompletionRequestFunctionCall
  { CreateChatCompletionRequestFunctionCall -> Text
createChatCompletionRequestFunctionCallName :: Text -- ^ The name of the function to call.
  } deriving (Int -> CreateChatCompletionRequestFunctionCall -> ShowS
[CreateChatCompletionRequestFunctionCall] -> ShowS
CreateChatCompletionRequestFunctionCall -> String
(Int -> CreateChatCompletionRequestFunctionCall -> ShowS)
-> (CreateChatCompletionRequestFunctionCall -> String)
-> ([CreateChatCompletionRequestFunctionCall] -> ShowS)
-> Show CreateChatCompletionRequestFunctionCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionRequestFunctionCall -> ShowS
showsPrec :: Int -> CreateChatCompletionRequestFunctionCall -> ShowS
$cshow :: CreateChatCompletionRequestFunctionCall -> String
show :: CreateChatCompletionRequestFunctionCall -> String
$cshowList :: [CreateChatCompletionRequestFunctionCall] -> ShowS
showList :: [CreateChatCompletionRequestFunctionCall] -> ShowS
Show, CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
(CreateChatCompletionRequestFunctionCall
 -> CreateChatCompletionRequestFunctionCall -> Bool)
-> (CreateChatCompletionRequestFunctionCall
    -> CreateChatCompletionRequestFunctionCall -> Bool)
-> Eq CreateChatCompletionRequestFunctionCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
== :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
$c/= :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
/= :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
Eq, Eq CreateChatCompletionRequestFunctionCall
Eq CreateChatCompletionRequestFunctionCall =>
(CreateChatCompletionRequestFunctionCall
 -> CreateChatCompletionRequestFunctionCall -> Ordering)
-> (CreateChatCompletionRequestFunctionCall
    -> CreateChatCompletionRequestFunctionCall -> Bool)
-> (CreateChatCompletionRequestFunctionCall
    -> CreateChatCompletionRequestFunctionCall -> Bool)
-> (CreateChatCompletionRequestFunctionCall
    -> CreateChatCompletionRequestFunctionCall -> Bool)
-> (CreateChatCompletionRequestFunctionCall
    -> CreateChatCompletionRequestFunctionCall -> Bool)
-> (CreateChatCompletionRequestFunctionCall
    -> CreateChatCompletionRequestFunctionCall
    -> CreateChatCompletionRequestFunctionCall)
-> (CreateChatCompletionRequestFunctionCall
    -> CreateChatCompletionRequestFunctionCall
    -> CreateChatCompletionRequestFunctionCall)
-> Ord CreateChatCompletionRequestFunctionCall
CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Ordering
CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Ordering
compare :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Ordering
$c< :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
< :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
$c<= :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
<= :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
$c> :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
> :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
$c>= :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
>= :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall -> Bool
$cmax :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
max :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
$cmin :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
min :: CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
Ord, (forall x.
 CreateChatCompletionRequestFunctionCall
 -> Rep CreateChatCompletionRequestFunctionCall x)
-> (forall x.
    Rep CreateChatCompletionRequestFunctionCall x
    -> CreateChatCompletionRequestFunctionCall)
-> Generic CreateChatCompletionRequestFunctionCall
forall x.
Rep CreateChatCompletionRequestFunctionCall x
-> CreateChatCompletionRequestFunctionCall
forall x.
CreateChatCompletionRequestFunctionCall
-> Rep CreateChatCompletionRequestFunctionCall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionRequestFunctionCall
-> Rep CreateChatCompletionRequestFunctionCall x
from :: forall x.
CreateChatCompletionRequestFunctionCall
-> Rep CreateChatCompletionRequestFunctionCall x
$cto :: forall x.
Rep CreateChatCompletionRequestFunctionCall x
-> CreateChatCompletionRequestFunctionCall
to :: forall x.
Rep CreateChatCompletionRequestFunctionCall x
-> CreateChatCompletionRequestFunctionCall
Generic, Typeable CreateChatCompletionRequestFunctionCall
Typeable CreateChatCompletionRequestFunctionCall =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionRequestFunctionCall
 -> c CreateChatCompletionRequestFunctionCall)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionRequestFunctionCall)
-> (CreateChatCompletionRequestFunctionCall -> Constr)
-> (CreateChatCompletionRequestFunctionCall -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionRequestFunctionCall))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionRequestFunctionCall))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionRequestFunctionCall
    -> CreateChatCompletionRequestFunctionCall)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionRequestFunctionCall
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionRequestFunctionCall
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionRequestFunctionCall -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionRequestFunctionCall
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestFunctionCall
    -> m CreateChatCompletionRequestFunctionCall)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestFunctionCall
    -> m CreateChatCompletionRequestFunctionCall)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestFunctionCall
    -> m CreateChatCompletionRequestFunctionCall)
-> Data CreateChatCompletionRequestFunctionCall
CreateChatCompletionRequestFunctionCall -> Constr
CreateChatCompletionRequestFunctionCall -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestFunctionCall
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestFunctionCall -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestFunctionCall
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestFunctionCall
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestFunctionCall
-> m CreateChatCompletionRequestFunctionCall
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestFunctionCall
-> m CreateChatCompletionRequestFunctionCall
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestFunctionCall
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestFunctionCall
-> c CreateChatCompletionRequestFunctionCall
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestFunctionCall)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestFunctionCall)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestFunctionCall
-> c CreateChatCompletionRequestFunctionCall
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestFunctionCall
-> c CreateChatCompletionRequestFunctionCall
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestFunctionCall
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestFunctionCall
$ctoConstr :: CreateChatCompletionRequestFunctionCall -> Constr
toConstr :: CreateChatCompletionRequestFunctionCall -> Constr
$cdataTypeOf :: CreateChatCompletionRequestFunctionCall -> DataType
dataTypeOf :: CreateChatCompletionRequestFunctionCall -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestFunctionCall)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestFunctionCall)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestFunctionCall)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestFunctionCall)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionRequestFunctionCall
-> CreateChatCompletionRequestFunctionCall
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestFunctionCall
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestFunctionCall
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestFunctionCall
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestFunctionCall
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestFunctionCall -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestFunctionCall -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestFunctionCall
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestFunctionCall
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestFunctionCall
-> m CreateChatCompletionRequestFunctionCall
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestFunctionCall
-> m CreateChatCompletionRequestFunctionCall
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestFunctionCall
-> m CreateChatCompletionRequestFunctionCall
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestFunctionCall
-> m CreateChatCompletionRequestFunctionCall
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestFunctionCall
-> m CreateChatCompletionRequestFunctionCall
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestFunctionCall
-> m CreateChatCompletionRequestFunctionCall
Data)

instance FromJSON CreateChatCompletionRequestFunctionCall where
  parseJSON :: Value -> Parser CreateChatCompletionRequestFunctionCall
parseJSON = Options -> Value -> Parser CreateChatCompletionRequestFunctionCall
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionRequestFunctionCall")
instance ToJSON CreateChatCompletionRequestFunctionCall where
  toJSON :: CreateChatCompletionRequestFunctionCall -> Value
toJSON = Options -> CreateChatCompletionRequestFunctionCall -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionRequestFunctionCall")


-- | ID of the model to use. See the [model endpoint compatibility](/docs/models/model-endpoint-compatibility) table for details on which models work with the Chat API.
newtype CreateChatCompletionRequestModel = CreateChatCompletionRequestModel Text deriving (Int -> CreateChatCompletionRequestModel -> ShowS
[CreateChatCompletionRequestModel] -> ShowS
CreateChatCompletionRequestModel -> String
(Int -> CreateChatCompletionRequestModel -> ShowS)
-> (CreateChatCompletionRequestModel -> String)
-> ([CreateChatCompletionRequestModel] -> ShowS)
-> Show CreateChatCompletionRequestModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionRequestModel -> ShowS
showsPrec :: Int -> CreateChatCompletionRequestModel -> ShowS
$cshow :: CreateChatCompletionRequestModel -> String
show :: CreateChatCompletionRequestModel -> String
$cshowList :: [CreateChatCompletionRequestModel] -> ShowS
showList :: [CreateChatCompletionRequestModel] -> ShowS
Show, CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
(CreateChatCompletionRequestModel
 -> CreateChatCompletionRequestModel -> Bool)
-> (CreateChatCompletionRequestModel
    -> CreateChatCompletionRequestModel -> Bool)
-> Eq CreateChatCompletionRequestModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
== :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
$c/= :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
/= :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
Eq, Eq CreateChatCompletionRequestModel
Eq CreateChatCompletionRequestModel =>
(CreateChatCompletionRequestModel
 -> CreateChatCompletionRequestModel -> Ordering)
-> (CreateChatCompletionRequestModel
    -> CreateChatCompletionRequestModel -> Bool)
-> (CreateChatCompletionRequestModel
    -> CreateChatCompletionRequestModel -> Bool)
-> (CreateChatCompletionRequestModel
    -> CreateChatCompletionRequestModel -> Bool)
-> (CreateChatCompletionRequestModel
    -> CreateChatCompletionRequestModel -> Bool)
-> (CreateChatCompletionRequestModel
    -> CreateChatCompletionRequestModel
    -> CreateChatCompletionRequestModel)
-> (CreateChatCompletionRequestModel
    -> CreateChatCompletionRequestModel
    -> CreateChatCompletionRequestModel)
-> Ord CreateChatCompletionRequestModel
CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Ordering
CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Ordering
compare :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Ordering
$c< :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
< :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
$c<= :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
<= :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
$c> :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
> :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
$c>= :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
>= :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel -> Bool
$cmax :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
max :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
$cmin :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
min :: CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
Ord, (forall x.
 CreateChatCompletionRequestModel
 -> Rep CreateChatCompletionRequestModel x)
-> (forall x.
    Rep CreateChatCompletionRequestModel x
    -> CreateChatCompletionRequestModel)
-> Generic CreateChatCompletionRequestModel
forall x.
Rep CreateChatCompletionRequestModel x
-> CreateChatCompletionRequestModel
forall x.
CreateChatCompletionRequestModel
-> Rep CreateChatCompletionRequestModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionRequestModel
-> Rep CreateChatCompletionRequestModel x
from :: forall x.
CreateChatCompletionRequestModel
-> Rep CreateChatCompletionRequestModel x
$cto :: forall x.
Rep CreateChatCompletionRequestModel x
-> CreateChatCompletionRequestModel
to :: forall x.
Rep CreateChatCompletionRequestModel x
-> CreateChatCompletionRequestModel
Generic, Typeable CreateChatCompletionRequestModel
Typeable CreateChatCompletionRequestModel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionRequestModel
 -> c CreateChatCompletionRequestModel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionRequestModel)
-> (CreateChatCompletionRequestModel -> Constr)
-> (CreateChatCompletionRequestModel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionRequestModel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionRequestModel))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionRequestModel
    -> CreateChatCompletionRequestModel)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionRequestModel
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionRequestModel
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionRequestModel -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionRequestModel
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestModel
    -> m CreateChatCompletionRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestModel
    -> m CreateChatCompletionRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestModel
    -> m CreateChatCompletionRequestModel)
-> Data CreateChatCompletionRequestModel
CreateChatCompletionRequestModel -> Constr
CreateChatCompletionRequestModel -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestModel
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestModel -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestModel
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestModel
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestModel
-> m CreateChatCompletionRequestModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestModel
-> m CreateChatCompletionRequestModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestModel
-> c CreateChatCompletionRequestModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestModel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestModel
-> c CreateChatCompletionRequestModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestModel
-> c CreateChatCompletionRequestModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestModel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestModel
$ctoConstr :: CreateChatCompletionRequestModel -> Constr
toConstr :: CreateChatCompletionRequestModel -> Constr
$cdataTypeOf :: CreateChatCompletionRequestModel -> DataType
dataTypeOf :: CreateChatCompletionRequestModel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestModel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestModel)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionRequestModel
-> CreateChatCompletionRequestModel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestModel
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestModel
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestModel
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestModel
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestModel -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestModel -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestModel
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestModel
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestModel
-> m CreateChatCompletionRequestModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestModel
-> m CreateChatCompletionRequestModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestModel
-> m CreateChatCompletionRequestModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestModel
-> m CreateChatCompletionRequestModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestModel
-> m CreateChatCompletionRequestModel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestModel
-> m CreateChatCompletionRequestModel
Data)

instance FromJSON CreateChatCompletionRequestModel where
  parseJSON :: Value -> Parser CreateChatCompletionRequestModel
parseJSON = Options -> Value -> Parser CreateChatCompletionRequestModel
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionRequestModel")
instance ToJSON CreateChatCompletionRequestModel where
  toJSON :: CreateChatCompletionRequestModel -> Value
toJSON = Options -> CreateChatCompletionRequestModel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionRequestModel")


-- | An object specifying the format that the model must output. Compatible with [GPT-4 Turbo](/docs/models/gpt-4-and-gpt-4-turbo) and all GPT-3.5 Turbo models newer than &#x60;gpt-3.5-turbo-1106&#x60;.  Setting to &#x60;{ \&quot;type\&quot;: \&quot;json_object\&quot; }&#x60; enables JSON mode, which guarantees the message the model generates is valid JSON.  **Important:** when using JSON mode, you **must** also instruct the model to produce JSON yourself via a system or user message. Without this, the model may generate an unending stream of whitespace until the generation reaches the token limit, resulting in a long-running and seemingly \&quot;stuck\&quot; request. Also note that the message content may be partially cut off if &#x60;finish_reason&#x3D;\&quot;length\&quot;&#x60;, which indicates the generation exceeded &#x60;max_tokens&#x60; or the conversation exceeded the max context length. 
data CreateChatCompletionRequestResponseFormat = CreateChatCompletionRequestResponseFormat
  { CreateChatCompletionRequestResponseFormat -> Maybe Text
createChatCompletionRequestResponseFormatType :: Maybe Text -- ^ Must be one of `text` or `json_object`.
  } deriving (Int -> CreateChatCompletionRequestResponseFormat -> ShowS
[CreateChatCompletionRequestResponseFormat] -> ShowS
CreateChatCompletionRequestResponseFormat -> String
(Int -> CreateChatCompletionRequestResponseFormat -> ShowS)
-> (CreateChatCompletionRequestResponseFormat -> String)
-> ([CreateChatCompletionRequestResponseFormat] -> ShowS)
-> Show CreateChatCompletionRequestResponseFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionRequestResponseFormat -> ShowS
showsPrec :: Int -> CreateChatCompletionRequestResponseFormat -> ShowS
$cshow :: CreateChatCompletionRequestResponseFormat -> String
show :: CreateChatCompletionRequestResponseFormat -> String
$cshowList :: [CreateChatCompletionRequestResponseFormat] -> ShowS
showList :: [CreateChatCompletionRequestResponseFormat] -> ShowS
Show, CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
(CreateChatCompletionRequestResponseFormat
 -> CreateChatCompletionRequestResponseFormat -> Bool)
-> (CreateChatCompletionRequestResponseFormat
    -> CreateChatCompletionRequestResponseFormat -> Bool)
-> Eq CreateChatCompletionRequestResponseFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
== :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
$c/= :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
/= :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
Eq, Eq CreateChatCompletionRequestResponseFormat
Eq CreateChatCompletionRequestResponseFormat =>
(CreateChatCompletionRequestResponseFormat
 -> CreateChatCompletionRequestResponseFormat -> Ordering)
-> (CreateChatCompletionRequestResponseFormat
    -> CreateChatCompletionRequestResponseFormat -> Bool)
-> (CreateChatCompletionRequestResponseFormat
    -> CreateChatCompletionRequestResponseFormat -> Bool)
-> (CreateChatCompletionRequestResponseFormat
    -> CreateChatCompletionRequestResponseFormat -> Bool)
-> (CreateChatCompletionRequestResponseFormat
    -> CreateChatCompletionRequestResponseFormat -> Bool)
-> (CreateChatCompletionRequestResponseFormat
    -> CreateChatCompletionRequestResponseFormat
    -> CreateChatCompletionRequestResponseFormat)
-> (CreateChatCompletionRequestResponseFormat
    -> CreateChatCompletionRequestResponseFormat
    -> CreateChatCompletionRequestResponseFormat)
-> Ord CreateChatCompletionRequestResponseFormat
CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Ordering
CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Ordering
compare :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Ordering
$c< :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
< :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
$c<= :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
<= :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
$c> :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
> :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
$c>= :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
>= :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat -> Bool
$cmax :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
max :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
$cmin :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
min :: CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
Ord, (forall x.
 CreateChatCompletionRequestResponseFormat
 -> Rep CreateChatCompletionRequestResponseFormat x)
-> (forall x.
    Rep CreateChatCompletionRequestResponseFormat x
    -> CreateChatCompletionRequestResponseFormat)
-> Generic CreateChatCompletionRequestResponseFormat
forall x.
Rep CreateChatCompletionRequestResponseFormat x
-> CreateChatCompletionRequestResponseFormat
forall x.
CreateChatCompletionRequestResponseFormat
-> Rep CreateChatCompletionRequestResponseFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionRequestResponseFormat
-> Rep CreateChatCompletionRequestResponseFormat x
from :: forall x.
CreateChatCompletionRequestResponseFormat
-> Rep CreateChatCompletionRequestResponseFormat x
$cto :: forall x.
Rep CreateChatCompletionRequestResponseFormat x
-> CreateChatCompletionRequestResponseFormat
to :: forall x.
Rep CreateChatCompletionRequestResponseFormat x
-> CreateChatCompletionRequestResponseFormat
Generic, Typeable CreateChatCompletionRequestResponseFormat
Typeable CreateChatCompletionRequestResponseFormat =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionRequestResponseFormat
 -> c CreateChatCompletionRequestResponseFormat)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionRequestResponseFormat)
-> (CreateChatCompletionRequestResponseFormat -> Constr)
-> (CreateChatCompletionRequestResponseFormat -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionRequestResponseFormat))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionRequestResponseFormat))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionRequestResponseFormat
    -> CreateChatCompletionRequestResponseFormat)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionRequestResponseFormat
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionRequestResponseFormat
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionRequestResponseFormat -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionRequestResponseFormat
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestResponseFormat
    -> m CreateChatCompletionRequestResponseFormat)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestResponseFormat
    -> m CreateChatCompletionRequestResponseFormat)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestResponseFormat
    -> m CreateChatCompletionRequestResponseFormat)
-> Data CreateChatCompletionRequestResponseFormat
CreateChatCompletionRequestResponseFormat -> Constr
CreateChatCompletionRequestResponseFormat -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestResponseFormat
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestResponseFormat -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestResponseFormat
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestResponseFormat
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestResponseFormat
-> m CreateChatCompletionRequestResponseFormat
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestResponseFormat
-> m CreateChatCompletionRequestResponseFormat
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestResponseFormat
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestResponseFormat
-> c CreateChatCompletionRequestResponseFormat
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestResponseFormat)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestResponseFormat)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestResponseFormat
-> c CreateChatCompletionRequestResponseFormat
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestResponseFormat
-> c CreateChatCompletionRequestResponseFormat
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestResponseFormat
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestResponseFormat
$ctoConstr :: CreateChatCompletionRequestResponseFormat -> Constr
toConstr :: CreateChatCompletionRequestResponseFormat -> Constr
$cdataTypeOf :: CreateChatCompletionRequestResponseFormat -> DataType
dataTypeOf :: CreateChatCompletionRequestResponseFormat -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestResponseFormat)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestResponseFormat)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestResponseFormat)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestResponseFormat)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionRequestResponseFormat
-> CreateChatCompletionRequestResponseFormat
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestResponseFormat
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestResponseFormat
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestResponseFormat
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestResponseFormat
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestResponseFormat -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestResponseFormat -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestResponseFormat
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestResponseFormat
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestResponseFormat
-> m CreateChatCompletionRequestResponseFormat
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestResponseFormat
-> m CreateChatCompletionRequestResponseFormat
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestResponseFormat
-> m CreateChatCompletionRequestResponseFormat
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestResponseFormat
-> m CreateChatCompletionRequestResponseFormat
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestResponseFormat
-> m CreateChatCompletionRequestResponseFormat
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestResponseFormat
-> m CreateChatCompletionRequestResponseFormat
Data)

instance FromJSON CreateChatCompletionRequestResponseFormat where
  parseJSON :: Value -> Parser CreateChatCompletionRequestResponseFormat
parseJSON = Options
-> Value -> Parser CreateChatCompletionRequestResponseFormat
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionRequestResponseFormat")
instance ToJSON CreateChatCompletionRequestResponseFormat where
  toJSON :: CreateChatCompletionRequestResponseFormat -> Value
toJSON = Options -> CreateChatCompletionRequestResponseFormat -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionRequestResponseFormat")


-- | Up to 4 sequences where the API will stop generating further tokens. 
data CreateChatCompletionRequestStop = CreateChatCompletionRequestStop
  { 
  } deriving (Int -> CreateChatCompletionRequestStop -> ShowS
[CreateChatCompletionRequestStop] -> ShowS
CreateChatCompletionRequestStop -> String
(Int -> CreateChatCompletionRequestStop -> ShowS)
-> (CreateChatCompletionRequestStop -> String)
-> ([CreateChatCompletionRequestStop] -> ShowS)
-> Show CreateChatCompletionRequestStop
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionRequestStop -> ShowS
showsPrec :: Int -> CreateChatCompletionRequestStop -> ShowS
$cshow :: CreateChatCompletionRequestStop -> String
show :: CreateChatCompletionRequestStop -> String
$cshowList :: [CreateChatCompletionRequestStop] -> ShowS
showList :: [CreateChatCompletionRequestStop] -> ShowS
Show, CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
(CreateChatCompletionRequestStop
 -> CreateChatCompletionRequestStop -> Bool)
-> (CreateChatCompletionRequestStop
    -> CreateChatCompletionRequestStop -> Bool)
-> Eq CreateChatCompletionRequestStop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
== :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
$c/= :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
/= :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
Eq, Eq CreateChatCompletionRequestStop
Eq CreateChatCompletionRequestStop =>
(CreateChatCompletionRequestStop
 -> CreateChatCompletionRequestStop -> Ordering)
-> (CreateChatCompletionRequestStop
    -> CreateChatCompletionRequestStop -> Bool)
-> (CreateChatCompletionRequestStop
    -> CreateChatCompletionRequestStop -> Bool)
-> (CreateChatCompletionRequestStop
    -> CreateChatCompletionRequestStop -> Bool)
-> (CreateChatCompletionRequestStop
    -> CreateChatCompletionRequestStop -> Bool)
-> (CreateChatCompletionRequestStop
    -> CreateChatCompletionRequestStop
    -> CreateChatCompletionRequestStop)
-> (CreateChatCompletionRequestStop
    -> CreateChatCompletionRequestStop
    -> CreateChatCompletionRequestStop)
-> Ord CreateChatCompletionRequestStop
CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Ordering
CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Ordering
compare :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Ordering
$c< :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
< :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
$c<= :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
<= :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
$c> :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
> :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
$c>= :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
>= :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop -> Bool
$cmax :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
max :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
$cmin :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
min :: CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
Ord, (forall x.
 CreateChatCompletionRequestStop
 -> Rep CreateChatCompletionRequestStop x)
-> (forall x.
    Rep CreateChatCompletionRequestStop x
    -> CreateChatCompletionRequestStop)
-> Generic CreateChatCompletionRequestStop
forall x.
Rep CreateChatCompletionRequestStop x
-> CreateChatCompletionRequestStop
forall x.
CreateChatCompletionRequestStop
-> Rep CreateChatCompletionRequestStop x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionRequestStop
-> Rep CreateChatCompletionRequestStop x
from :: forall x.
CreateChatCompletionRequestStop
-> Rep CreateChatCompletionRequestStop x
$cto :: forall x.
Rep CreateChatCompletionRequestStop x
-> CreateChatCompletionRequestStop
to :: forall x.
Rep CreateChatCompletionRequestStop x
-> CreateChatCompletionRequestStop
Generic, Typeable CreateChatCompletionRequestStop
Typeable CreateChatCompletionRequestStop =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionRequestStop
 -> c CreateChatCompletionRequestStop)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionRequestStop)
-> (CreateChatCompletionRequestStop -> Constr)
-> (CreateChatCompletionRequestStop -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionRequestStop))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionRequestStop))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionRequestStop
    -> CreateChatCompletionRequestStop)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionRequestStop
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionRequestStop
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionRequestStop -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionRequestStop
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestStop
    -> m CreateChatCompletionRequestStop)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestStop
    -> m CreateChatCompletionRequestStop)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionRequestStop
    -> m CreateChatCompletionRequestStop)
-> Data CreateChatCompletionRequestStop
CreateChatCompletionRequestStop -> Constr
CreateChatCompletionRequestStop -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestStop
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestStop -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestStop
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestStop
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestStop
-> m CreateChatCompletionRequestStop
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestStop
-> m CreateChatCompletionRequestStop
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestStop
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestStop
-> c CreateChatCompletionRequestStop
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestStop)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestStop)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestStop
-> c CreateChatCompletionRequestStop
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionRequestStop
-> c CreateChatCompletionRequestStop
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestStop
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionRequestStop
$ctoConstr :: CreateChatCompletionRequestStop -> Constr
toConstr :: CreateChatCompletionRequestStop -> Constr
$cdataTypeOf :: CreateChatCompletionRequestStop -> DataType
dataTypeOf :: CreateChatCompletionRequestStop -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestStop)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionRequestStop)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestStop)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionRequestStop)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionRequestStop
-> CreateChatCompletionRequestStop
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestStop
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestStop
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestStop
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionRequestStop
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestStop -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionRequestStop -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestStop
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionRequestStop
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestStop
-> m CreateChatCompletionRequestStop
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestStop
-> m CreateChatCompletionRequestStop
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestStop
-> m CreateChatCompletionRequestStop
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestStop
-> m CreateChatCompletionRequestStop
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestStop
-> m CreateChatCompletionRequestStop
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionRequestStop
-> m CreateChatCompletionRequestStop
Data)

instance FromJSON CreateChatCompletionRequestStop where
  parseJSON :: Value -> Parser CreateChatCompletionRequestStop
parseJSON = Options -> Value -> Parser CreateChatCompletionRequestStop
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionRequestStop")
instance ToJSON CreateChatCompletionRequestStop where
  toJSON :: CreateChatCompletionRequestStop -> Value
toJSON = Options -> CreateChatCompletionRequestStop -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionRequestStop")


-- | Represents a chat completion response returned by model, based on the provided input.
data CreateChatCompletionResponse = CreateChatCompletionResponse
  { CreateChatCompletionResponse -> Text
createChatCompletionResponseId :: Text -- ^ A unique identifier for the chat completion.
  , CreateChatCompletionResponse
-> [CreateChatCompletionResponseChoicesInner]
createChatCompletionResponseChoices :: [CreateChatCompletionResponseChoicesInner] -- ^ A list of chat completion choices. Can be more than one if `n` is greater than 1.
  , CreateChatCompletionResponse -> Int
createChatCompletionResponseCreated :: Int -- ^ The Unix timestamp (in seconds) of when the chat completion was created.
  , CreateChatCompletionResponse -> Text
createChatCompletionResponseModel :: Text -- ^ The model used for the chat completion.
  , CreateChatCompletionResponse -> Maybe Text
createChatCompletionResponseSystemUnderscorefingerprint :: Maybe Text -- ^ This fingerprint represents the backend configuration that the model runs with.  Can be used in conjunction with the `seed` request parameter to understand when backend changes have been made that might impact determinism. 
  , CreateChatCompletionResponse -> Text
createChatCompletionResponseObject :: Text -- ^ The object type, which is always `chat.completion`.
  , CreateChatCompletionResponse -> Maybe CompletionUsage
createChatCompletionResponseUsage :: Maybe CompletionUsage -- ^ 
  } deriving (Int -> CreateChatCompletionResponse -> ShowS
[CreateChatCompletionResponse] -> ShowS
CreateChatCompletionResponse -> String
(Int -> CreateChatCompletionResponse -> ShowS)
-> (CreateChatCompletionResponse -> String)
-> ([CreateChatCompletionResponse] -> ShowS)
-> Show CreateChatCompletionResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionResponse -> ShowS
showsPrec :: Int -> CreateChatCompletionResponse -> ShowS
$cshow :: CreateChatCompletionResponse -> String
show :: CreateChatCompletionResponse -> String
$cshowList :: [CreateChatCompletionResponse] -> ShowS
showList :: [CreateChatCompletionResponse] -> ShowS
Show, CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
(CreateChatCompletionResponse
 -> CreateChatCompletionResponse -> Bool)
-> (CreateChatCompletionResponse
    -> CreateChatCompletionResponse -> Bool)
-> Eq CreateChatCompletionResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
== :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
$c/= :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
/= :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
Eq, Eq CreateChatCompletionResponse
Eq CreateChatCompletionResponse =>
(CreateChatCompletionResponse
 -> CreateChatCompletionResponse -> Ordering)
-> (CreateChatCompletionResponse
    -> CreateChatCompletionResponse -> Bool)
-> (CreateChatCompletionResponse
    -> CreateChatCompletionResponse -> Bool)
-> (CreateChatCompletionResponse
    -> CreateChatCompletionResponse -> Bool)
-> (CreateChatCompletionResponse
    -> CreateChatCompletionResponse -> Bool)
-> (CreateChatCompletionResponse
    -> CreateChatCompletionResponse -> CreateChatCompletionResponse)
-> (CreateChatCompletionResponse
    -> CreateChatCompletionResponse -> CreateChatCompletionResponse)
-> Ord CreateChatCompletionResponse
CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Ordering
CreateChatCompletionResponse
-> CreateChatCompletionResponse -> CreateChatCompletionResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Ordering
compare :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Ordering
$c< :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
< :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
$c<= :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
<= :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
$c> :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
> :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
$c>= :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
>= :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> Bool
$cmax :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> CreateChatCompletionResponse
max :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> CreateChatCompletionResponse
$cmin :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> CreateChatCompletionResponse
min :: CreateChatCompletionResponse
-> CreateChatCompletionResponse -> CreateChatCompletionResponse
Ord, (forall x.
 CreateChatCompletionResponse -> Rep CreateChatCompletionResponse x)
-> (forall x.
    Rep CreateChatCompletionResponse x -> CreateChatCompletionResponse)
-> Generic CreateChatCompletionResponse
forall x.
Rep CreateChatCompletionResponse x -> CreateChatCompletionResponse
forall x.
CreateChatCompletionResponse -> Rep CreateChatCompletionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionResponse -> Rep CreateChatCompletionResponse x
from :: forall x.
CreateChatCompletionResponse -> Rep CreateChatCompletionResponse x
$cto :: forall x.
Rep CreateChatCompletionResponse x -> CreateChatCompletionResponse
to :: forall x.
Rep CreateChatCompletionResponse x -> CreateChatCompletionResponse
Generic, Typeable CreateChatCompletionResponse
Typeable CreateChatCompletionResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionResponse
 -> c CreateChatCompletionResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionResponse)
-> (CreateChatCompletionResponse -> Constr)
-> (CreateChatCompletionResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionResponse))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionResponse -> CreateChatCompletionResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionResponse
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionResponse -> m CreateChatCompletionResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionResponse -> m CreateChatCompletionResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionResponse -> m CreateChatCompletionResponse)
-> Data CreateChatCompletionResponse
CreateChatCompletionResponse -> Constr
CreateChatCompletionResponse -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionResponse -> CreateChatCompletionResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionResponse
-> u
forall u.
(forall d. Data d => d -> u) -> CreateChatCompletionResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponse -> m CreateChatCompletionResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponse -> m CreateChatCompletionResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateChatCompletionResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionResponse
-> c CreateChatCompletionResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionResponse
-> c CreateChatCompletionResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionResponse
-> c CreateChatCompletionResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateChatCompletionResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateChatCompletionResponse
$ctoConstr :: CreateChatCompletionResponse -> Constr
toConstr :: CreateChatCompletionResponse -> Constr
$cdataTypeOf :: CreateChatCompletionResponse -> DataType
dataTypeOf :: CreateChatCompletionResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionResponse -> CreateChatCompletionResponse
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionResponse -> CreateChatCompletionResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateChatCompletionResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateChatCompletionResponse -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionResponse
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionResponse
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponse -> m CreateChatCompletionResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponse -> m CreateChatCompletionResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponse -> m CreateChatCompletionResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponse -> m CreateChatCompletionResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponse -> m CreateChatCompletionResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponse -> m CreateChatCompletionResponse
Data)

instance FromJSON CreateChatCompletionResponse where
  parseJSON :: Value -> Parser CreateChatCompletionResponse
parseJSON = Options -> Value -> Parser CreateChatCompletionResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionResponse")
instance ToJSON CreateChatCompletionResponse where
  toJSON :: CreateChatCompletionResponse -> Value
toJSON = Options -> CreateChatCompletionResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionResponse")


-- | 
data CreateChatCompletionResponseChoicesInner = CreateChatCompletionResponseChoicesInner
  { CreateChatCompletionResponseChoicesInner -> Text
createChatCompletionResponseChoicesInnerFinishUnderscorereason :: Text -- ^ The reason the model stopped generating tokens. This will be `stop` if the model hit a natural stop point or a provided stop sequence, `length` if the maximum number of tokens specified in the request was reached, `content_filter` if content was omitted due to a flag from our content filters, `tool_calls` if the model called a tool, or `function_call` (deprecated) if the model called a function. 
  , CreateChatCompletionResponseChoicesInner -> Int
createChatCompletionResponseChoicesInnerIndex :: Int -- ^ The index of the choice in the list of choices.
  , CreateChatCompletionResponseChoicesInner
-> ChatCompletionResponseMessage
createChatCompletionResponseChoicesInnerMessage :: ChatCompletionResponseMessage -- ^ 
  , CreateChatCompletionResponseChoicesInner
-> Maybe CreateChatCompletionResponseChoicesInnerLogprobs
createChatCompletionResponseChoicesInnerLogprobs :: Maybe CreateChatCompletionResponseChoicesInnerLogprobs -- ^ 
  } deriving (Int -> CreateChatCompletionResponseChoicesInner -> ShowS
[CreateChatCompletionResponseChoicesInner] -> ShowS
CreateChatCompletionResponseChoicesInner -> String
(Int -> CreateChatCompletionResponseChoicesInner -> ShowS)
-> (CreateChatCompletionResponseChoicesInner -> String)
-> ([CreateChatCompletionResponseChoicesInner] -> ShowS)
-> Show CreateChatCompletionResponseChoicesInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionResponseChoicesInner -> ShowS
showsPrec :: Int -> CreateChatCompletionResponseChoicesInner -> ShowS
$cshow :: CreateChatCompletionResponseChoicesInner -> String
show :: CreateChatCompletionResponseChoicesInner -> String
$cshowList :: [CreateChatCompletionResponseChoicesInner] -> ShowS
showList :: [CreateChatCompletionResponseChoicesInner] -> ShowS
Show, CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
(CreateChatCompletionResponseChoicesInner
 -> CreateChatCompletionResponseChoicesInner -> Bool)
-> (CreateChatCompletionResponseChoicesInner
    -> CreateChatCompletionResponseChoicesInner -> Bool)
-> Eq CreateChatCompletionResponseChoicesInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
== :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
$c/= :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
/= :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
Eq, Eq CreateChatCompletionResponseChoicesInner
Eq CreateChatCompletionResponseChoicesInner =>
(CreateChatCompletionResponseChoicesInner
 -> CreateChatCompletionResponseChoicesInner -> Ordering)
-> (CreateChatCompletionResponseChoicesInner
    -> CreateChatCompletionResponseChoicesInner -> Bool)
-> (CreateChatCompletionResponseChoicesInner
    -> CreateChatCompletionResponseChoicesInner -> Bool)
-> (CreateChatCompletionResponseChoicesInner
    -> CreateChatCompletionResponseChoicesInner -> Bool)
-> (CreateChatCompletionResponseChoicesInner
    -> CreateChatCompletionResponseChoicesInner -> Bool)
-> (CreateChatCompletionResponseChoicesInner
    -> CreateChatCompletionResponseChoicesInner
    -> CreateChatCompletionResponseChoicesInner)
-> (CreateChatCompletionResponseChoicesInner
    -> CreateChatCompletionResponseChoicesInner
    -> CreateChatCompletionResponseChoicesInner)
-> Ord CreateChatCompletionResponseChoicesInner
CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Ordering
CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Ordering
compare :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Ordering
$c< :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
< :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
$c<= :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
<= :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
$c> :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
> :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
$c>= :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
>= :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner -> Bool
$cmax :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
max :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
$cmin :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
min :: CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
Ord, (forall x.
 CreateChatCompletionResponseChoicesInner
 -> Rep CreateChatCompletionResponseChoicesInner x)
-> (forall x.
    Rep CreateChatCompletionResponseChoicesInner x
    -> CreateChatCompletionResponseChoicesInner)
-> Generic CreateChatCompletionResponseChoicesInner
forall x.
Rep CreateChatCompletionResponseChoicesInner x
-> CreateChatCompletionResponseChoicesInner
forall x.
CreateChatCompletionResponseChoicesInner
-> Rep CreateChatCompletionResponseChoicesInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionResponseChoicesInner
-> Rep CreateChatCompletionResponseChoicesInner x
from :: forall x.
CreateChatCompletionResponseChoicesInner
-> Rep CreateChatCompletionResponseChoicesInner x
$cto :: forall x.
Rep CreateChatCompletionResponseChoicesInner x
-> CreateChatCompletionResponseChoicesInner
to :: forall x.
Rep CreateChatCompletionResponseChoicesInner x
-> CreateChatCompletionResponseChoicesInner
Generic, Typeable CreateChatCompletionResponseChoicesInner
Typeable CreateChatCompletionResponseChoicesInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionResponseChoicesInner
 -> c CreateChatCompletionResponseChoicesInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionResponseChoicesInner)
-> (CreateChatCompletionResponseChoicesInner -> Constr)
-> (CreateChatCompletionResponseChoicesInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionResponseChoicesInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionResponseChoicesInner))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionResponseChoicesInner
    -> CreateChatCompletionResponseChoicesInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionResponseChoicesInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionResponseChoicesInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionResponseChoicesInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionResponseChoicesInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionResponseChoicesInner
    -> m CreateChatCompletionResponseChoicesInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionResponseChoicesInner
    -> m CreateChatCompletionResponseChoicesInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionResponseChoicesInner
    -> m CreateChatCompletionResponseChoicesInner)
-> Data CreateChatCompletionResponseChoicesInner
CreateChatCompletionResponseChoicesInner -> Constr
CreateChatCompletionResponseChoicesInner -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInner
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInner
-> m CreateChatCompletionResponseChoicesInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInner
-> m CreateChatCompletionResponseChoicesInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionResponseChoicesInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionResponseChoicesInner
-> c CreateChatCompletionResponseChoicesInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionResponseChoicesInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionResponseChoicesInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionResponseChoicesInner
-> c CreateChatCompletionResponseChoicesInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionResponseChoicesInner
-> c CreateChatCompletionResponseChoicesInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionResponseChoicesInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionResponseChoicesInner
$ctoConstr :: CreateChatCompletionResponseChoicesInner -> Constr
toConstr :: CreateChatCompletionResponseChoicesInner -> Constr
$cdataTypeOf :: CreateChatCompletionResponseChoicesInner -> DataType
dataTypeOf :: CreateChatCompletionResponseChoicesInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionResponseChoicesInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionResponseChoicesInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionResponseChoicesInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionResponseChoicesInner)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionResponseChoicesInner
-> CreateChatCompletionResponseChoicesInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInner
-> m CreateChatCompletionResponseChoicesInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInner
-> m CreateChatCompletionResponseChoicesInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInner
-> m CreateChatCompletionResponseChoicesInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInner
-> m CreateChatCompletionResponseChoicesInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInner
-> m CreateChatCompletionResponseChoicesInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInner
-> m CreateChatCompletionResponseChoicesInner
Data)

instance FromJSON CreateChatCompletionResponseChoicesInner where
  parseJSON :: Value -> Parser CreateChatCompletionResponseChoicesInner
parseJSON = Options -> Value -> Parser CreateChatCompletionResponseChoicesInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionResponseChoicesInner")
instance ToJSON CreateChatCompletionResponseChoicesInner where
  toJSON :: CreateChatCompletionResponseChoicesInner -> Value
toJSON = Options -> CreateChatCompletionResponseChoicesInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionResponseChoicesInner")


-- | Log probability information for the choice.
data CreateChatCompletionResponseChoicesInnerLogprobs = CreateChatCompletionResponseChoicesInnerLogprobs
  { CreateChatCompletionResponseChoicesInnerLogprobs
-> [ChatCompletionTokenLogprob]
createChatCompletionResponseChoicesInnerLogprobsContent :: [ChatCompletionTokenLogprob] -- ^ A list of message content tokens with log probability information.
  } deriving (Int -> CreateChatCompletionResponseChoicesInnerLogprobs -> ShowS
[CreateChatCompletionResponseChoicesInnerLogprobs] -> ShowS
CreateChatCompletionResponseChoicesInnerLogprobs -> String
(Int -> CreateChatCompletionResponseChoicesInnerLogprobs -> ShowS)
-> (CreateChatCompletionResponseChoicesInnerLogprobs -> String)
-> ([CreateChatCompletionResponseChoicesInnerLogprobs] -> ShowS)
-> Show CreateChatCompletionResponseChoicesInnerLogprobs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionResponseChoicesInnerLogprobs -> ShowS
showsPrec :: Int -> CreateChatCompletionResponseChoicesInnerLogprobs -> ShowS
$cshow :: CreateChatCompletionResponseChoicesInnerLogprobs -> String
show :: CreateChatCompletionResponseChoicesInnerLogprobs -> String
$cshowList :: [CreateChatCompletionResponseChoicesInnerLogprobs] -> ShowS
showList :: [CreateChatCompletionResponseChoicesInnerLogprobs] -> ShowS
Show, CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
(CreateChatCompletionResponseChoicesInnerLogprobs
 -> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool)
-> (CreateChatCompletionResponseChoicesInnerLogprobs
    -> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool)
-> Eq CreateChatCompletionResponseChoicesInnerLogprobs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
== :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
$c/= :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
/= :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
Eq, Eq CreateChatCompletionResponseChoicesInnerLogprobs
Eq CreateChatCompletionResponseChoicesInnerLogprobs =>
(CreateChatCompletionResponseChoicesInnerLogprobs
 -> CreateChatCompletionResponseChoicesInnerLogprobs -> Ordering)
-> (CreateChatCompletionResponseChoicesInnerLogprobs
    -> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool)
-> (CreateChatCompletionResponseChoicesInnerLogprobs
    -> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool)
-> (CreateChatCompletionResponseChoicesInnerLogprobs
    -> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool)
-> (CreateChatCompletionResponseChoicesInnerLogprobs
    -> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool)
-> (CreateChatCompletionResponseChoicesInnerLogprobs
    -> CreateChatCompletionResponseChoicesInnerLogprobs
    -> CreateChatCompletionResponseChoicesInnerLogprobs)
-> (CreateChatCompletionResponseChoicesInnerLogprobs
    -> CreateChatCompletionResponseChoicesInnerLogprobs
    -> CreateChatCompletionResponseChoicesInnerLogprobs)
-> Ord CreateChatCompletionResponseChoicesInnerLogprobs
CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Ordering
CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Ordering
compare :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Ordering
$c< :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
< :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
$c<= :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
<= :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
$c> :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
> :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
$c>= :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
>= :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Bool
$cmax :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
max :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
$cmin :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
min :: CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
Ord, (forall x.
 CreateChatCompletionResponseChoicesInnerLogprobs
 -> Rep CreateChatCompletionResponseChoicesInnerLogprobs x)
-> (forall x.
    Rep CreateChatCompletionResponseChoicesInnerLogprobs x
    -> CreateChatCompletionResponseChoicesInnerLogprobs)
-> Generic CreateChatCompletionResponseChoicesInnerLogprobs
forall x.
Rep CreateChatCompletionResponseChoicesInnerLogprobs x
-> CreateChatCompletionResponseChoicesInnerLogprobs
forall x.
CreateChatCompletionResponseChoicesInnerLogprobs
-> Rep CreateChatCompletionResponseChoicesInnerLogprobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionResponseChoicesInnerLogprobs
-> Rep CreateChatCompletionResponseChoicesInnerLogprobs x
from :: forall x.
CreateChatCompletionResponseChoicesInnerLogprobs
-> Rep CreateChatCompletionResponseChoicesInnerLogprobs x
$cto :: forall x.
Rep CreateChatCompletionResponseChoicesInnerLogprobs x
-> CreateChatCompletionResponseChoicesInnerLogprobs
to :: forall x.
Rep CreateChatCompletionResponseChoicesInnerLogprobs x
-> CreateChatCompletionResponseChoicesInnerLogprobs
Generic, Typeable CreateChatCompletionResponseChoicesInnerLogprobs
Typeable CreateChatCompletionResponseChoicesInnerLogprobs =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionResponseChoicesInnerLogprobs
 -> c CreateChatCompletionResponseChoicesInnerLogprobs)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionResponseChoicesInnerLogprobs)
-> (CreateChatCompletionResponseChoicesInnerLogprobs -> Constr)
-> (CreateChatCompletionResponseChoicesInnerLogprobs -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionResponseChoicesInnerLogprobs))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionResponseChoicesInnerLogprobs))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionResponseChoicesInnerLogprobs
    -> CreateChatCompletionResponseChoicesInnerLogprobs)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionResponseChoicesInnerLogprobs
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionResponseChoicesInnerLogprobs
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionResponseChoicesInnerLogprobs -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionResponseChoicesInnerLogprobs
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionResponseChoicesInnerLogprobs
    -> m CreateChatCompletionResponseChoicesInnerLogprobs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionResponseChoicesInnerLogprobs
    -> m CreateChatCompletionResponseChoicesInnerLogprobs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionResponseChoicesInnerLogprobs
    -> m CreateChatCompletionResponseChoicesInnerLogprobs)
-> Data CreateChatCompletionResponseChoicesInnerLogprobs
CreateChatCompletionResponseChoicesInnerLogprobs -> Constr
CreateChatCompletionResponseChoicesInnerLogprobs -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInnerLogprobs -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> m CreateChatCompletionResponseChoicesInnerLogprobs
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> m CreateChatCompletionResponseChoicesInnerLogprobs
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionResponseChoicesInnerLogprobs
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> c CreateChatCompletionResponseChoicesInnerLogprobs
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionResponseChoicesInnerLogprobs)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionResponseChoicesInnerLogprobs)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> c CreateChatCompletionResponseChoicesInnerLogprobs
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> c CreateChatCompletionResponseChoicesInnerLogprobs
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionResponseChoicesInnerLogprobs
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionResponseChoicesInnerLogprobs
$ctoConstr :: CreateChatCompletionResponseChoicesInnerLogprobs -> Constr
toConstr :: CreateChatCompletionResponseChoicesInnerLogprobs -> Constr
$cdataTypeOf :: CreateChatCompletionResponseChoicesInnerLogprobs -> DataType
dataTypeOf :: CreateChatCompletionResponseChoicesInnerLogprobs -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionResponseChoicesInnerLogprobs)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionResponseChoicesInnerLogprobs)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionResponseChoicesInnerLogprobs)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionResponseChoicesInnerLogprobs)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> CreateChatCompletionResponseChoicesInnerLogprobs
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInnerLogprobs -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInnerLogprobs -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> m CreateChatCompletionResponseChoicesInnerLogprobs
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> m CreateChatCompletionResponseChoicesInnerLogprobs
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> m CreateChatCompletionResponseChoicesInnerLogprobs
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> m CreateChatCompletionResponseChoicesInnerLogprobs
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> m CreateChatCompletionResponseChoicesInnerLogprobs
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionResponseChoicesInnerLogprobs
-> m CreateChatCompletionResponseChoicesInnerLogprobs
Data)

instance FromJSON CreateChatCompletionResponseChoicesInnerLogprobs where
  parseJSON :: Value -> Parser CreateChatCompletionResponseChoicesInnerLogprobs
parseJSON = Options
-> Value -> Parser CreateChatCompletionResponseChoicesInnerLogprobs
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionResponseChoicesInnerLogprobs")
instance ToJSON CreateChatCompletionResponseChoicesInnerLogprobs where
  toJSON :: CreateChatCompletionResponseChoicesInnerLogprobs -> Value
toJSON = Options
-> CreateChatCompletionResponseChoicesInnerLogprobs -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionResponseChoicesInnerLogprobs")


-- | Represents a streamed chunk of a chat completion response returned by model, based on the provided input.
data CreateChatCompletionStreamResponse = CreateChatCompletionStreamResponse
  { CreateChatCompletionStreamResponse -> Text
createChatCompletionStreamResponseId :: Text -- ^ A unique identifier for the chat completion. Each chunk has the same ID.
  , CreateChatCompletionStreamResponse
-> [CreateChatCompletionStreamResponseChoicesInner]
createChatCompletionStreamResponseChoices :: [CreateChatCompletionStreamResponseChoicesInner] -- ^ A list of chat completion choices. Can be more than one if `n` is greater than 1.
  , CreateChatCompletionStreamResponse -> Int
createChatCompletionStreamResponseCreated :: Int -- ^ The Unix timestamp (in seconds) of when the chat completion was created. Each chunk has the same timestamp.
  , CreateChatCompletionStreamResponse -> Text
createChatCompletionStreamResponseModel :: Text -- ^ The model to generate the completion.
  , CreateChatCompletionStreamResponse -> Maybe Text
createChatCompletionStreamResponseSystemUnderscorefingerprint :: Maybe Text -- ^ This fingerprint represents the backend configuration that the model runs with. Can be used in conjunction with the `seed` request parameter to understand when backend changes have been made that might impact determinism. 
  , CreateChatCompletionStreamResponse -> Text
createChatCompletionStreamResponseObject :: Text -- ^ The object type, which is always `chat.completion.chunk`.
  } deriving (Int -> CreateChatCompletionStreamResponse -> ShowS
[CreateChatCompletionStreamResponse] -> ShowS
CreateChatCompletionStreamResponse -> String
(Int -> CreateChatCompletionStreamResponse -> ShowS)
-> (CreateChatCompletionStreamResponse -> String)
-> ([CreateChatCompletionStreamResponse] -> ShowS)
-> Show CreateChatCompletionStreamResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionStreamResponse -> ShowS
showsPrec :: Int -> CreateChatCompletionStreamResponse -> ShowS
$cshow :: CreateChatCompletionStreamResponse -> String
show :: CreateChatCompletionStreamResponse -> String
$cshowList :: [CreateChatCompletionStreamResponse] -> ShowS
showList :: [CreateChatCompletionStreamResponse] -> ShowS
Show, CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
(CreateChatCompletionStreamResponse
 -> CreateChatCompletionStreamResponse -> Bool)
-> (CreateChatCompletionStreamResponse
    -> CreateChatCompletionStreamResponse -> Bool)
-> Eq CreateChatCompletionStreamResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
== :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
$c/= :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
/= :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
Eq, Eq CreateChatCompletionStreamResponse
Eq CreateChatCompletionStreamResponse =>
(CreateChatCompletionStreamResponse
 -> CreateChatCompletionStreamResponse -> Ordering)
-> (CreateChatCompletionStreamResponse
    -> CreateChatCompletionStreamResponse -> Bool)
-> (CreateChatCompletionStreamResponse
    -> CreateChatCompletionStreamResponse -> Bool)
-> (CreateChatCompletionStreamResponse
    -> CreateChatCompletionStreamResponse -> Bool)
-> (CreateChatCompletionStreamResponse
    -> CreateChatCompletionStreamResponse -> Bool)
-> (CreateChatCompletionStreamResponse
    -> CreateChatCompletionStreamResponse
    -> CreateChatCompletionStreamResponse)
-> (CreateChatCompletionStreamResponse
    -> CreateChatCompletionStreamResponse
    -> CreateChatCompletionStreamResponse)
-> Ord CreateChatCompletionStreamResponse
CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Ordering
CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Ordering
compare :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Ordering
$c< :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
< :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
$c<= :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
<= :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
$c> :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
> :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
$c>= :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
>= :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse -> Bool
$cmax :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
max :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
$cmin :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
min :: CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
Ord, (forall x.
 CreateChatCompletionStreamResponse
 -> Rep CreateChatCompletionStreamResponse x)
-> (forall x.
    Rep CreateChatCompletionStreamResponse x
    -> CreateChatCompletionStreamResponse)
-> Generic CreateChatCompletionStreamResponse
forall x.
Rep CreateChatCompletionStreamResponse x
-> CreateChatCompletionStreamResponse
forall x.
CreateChatCompletionStreamResponse
-> Rep CreateChatCompletionStreamResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionStreamResponse
-> Rep CreateChatCompletionStreamResponse x
from :: forall x.
CreateChatCompletionStreamResponse
-> Rep CreateChatCompletionStreamResponse x
$cto :: forall x.
Rep CreateChatCompletionStreamResponse x
-> CreateChatCompletionStreamResponse
to :: forall x.
Rep CreateChatCompletionStreamResponse x
-> CreateChatCompletionStreamResponse
Generic, Typeable CreateChatCompletionStreamResponse
Typeable CreateChatCompletionStreamResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionStreamResponse
 -> c CreateChatCompletionStreamResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionStreamResponse)
-> (CreateChatCompletionStreamResponse -> Constr)
-> (CreateChatCompletionStreamResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionStreamResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionStreamResponse))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionStreamResponse
    -> CreateChatCompletionStreamResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionStreamResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionStreamResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionStreamResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionStreamResponse
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionStreamResponse
    -> m CreateChatCompletionStreamResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionStreamResponse
    -> m CreateChatCompletionStreamResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionStreamResponse
    -> m CreateChatCompletionStreamResponse)
-> Data CreateChatCompletionStreamResponse
CreateChatCompletionStreamResponse -> Constr
CreateChatCompletionStreamResponse -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponse
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponse
-> m CreateChatCompletionStreamResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponse
-> m CreateChatCompletionStreamResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionStreamResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionStreamResponse
-> c CreateChatCompletionStreamResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionStreamResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionStreamResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionStreamResponse
-> c CreateChatCompletionStreamResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionStreamResponse
-> c CreateChatCompletionStreamResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionStreamResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionStreamResponse
$ctoConstr :: CreateChatCompletionStreamResponse -> Constr
toConstr :: CreateChatCompletionStreamResponse -> Constr
$cdataTypeOf :: CreateChatCompletionStreamResponse -> DataType
dataTypeOf :: CreateChatCompletionStreamResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionStreamResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionStreamResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionStreamResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionStreamResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionStreamResponse
-> CreateChatCompletionStreamResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponse -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponse
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponse
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponse
-> m CreateChatCompletionStreamResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponse
-> m CreateChatCompletionStreamResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponse
-> m CreateChatCompletionStreamResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponse
-> m CreateChatCompletionStreamResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponse
-> m CreateChatCompletionStreamResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponse
-> m CreateChatCompletionStreamResponse
Data)

instance FromJSON CreateChatCompletionStreamResponse where
  parseJSON :: Value -> Parser CreateChatCompletionStreamResponse
parseJSON = Options -> Value -> Parser CreateChatCompletionStreamResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionStreamResponse")
instance ToJSON CreateChatCompletionStreamResponse where
  toJSON :: CreateChatCompletionStreamResponse -> Value
toJSON = Options -> CreateChatCompletionStreamResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionStreamResponse")


-- | 
data CreateChatCompletionStreamResponseChoicesInner = CreateChatCompletionStreamResponseChoicesInner
  { CreateChatCompletionStreamResponseChoicesInner
-> ChatCompletionStreamResponseDelta
createChatCompletionStreamResponseChoicesInnerDelta :: ChatCompletionStreamResponseDelta -- ^ 
  , CreateChatCompletionStreamResponseChoicesInner
-> Maybe CreateChatCompletionResponseChoicesInnerLogprobs
createChatCompletionStreamResponseChoicesInnerLogprobs :: Maybe CreateChatCompletionResponseChoicesInnerLogprobs -- ^ 
  , CreateChatCompletionStreamResponseChoicesInner -> Text
createChatCompletionStreamResponseChoicesInnerFinishUnderscorereason :: Text -- ^ The reason the model stopped generating tokens. This will be `stop` if the model hit a natural stop point or a provided stop sequence, `length` if the maximum number of tokens specified in the request was reached, `content_filter` if content was omitted due to a flag from our content filters, `tool_calls` if the model called a tool, or `function_call` (deprecated) if the model called a function. 
  , CreateChatCompletionStreamResponseChoicesInner -> Int
createChatCompletionStreamResponseChoicesInnerIndex :: Int -- ^ The index of the choice in the list of choices.
  } deriving (Int -> CreateChatCompletionStreamResponseChoicesInner -> ShowS
[CreateChatCompletionStreamResponseChoicesInner] -> ShowS
CreateChatCompletionStreamResponseChoicesInner -> String
(Int -> CreateChatCompletionStreamResponseChoicesInner -> ShowS)
-> (CreateChatCompletionStreamResponseChoicesInner -> String)
-> ([CreateChatCompletionStreamResponseChoicesInner] -> ShowS)
-> Show CreateChatCompletionStreamResponseChoicesInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateChatCompletionStreamResponseChoicesInner -> ShowS
showsPrec :: Int -> CreateChatCompletionStreamResponseChoicesInner -> ShowS
$cshow :: CreateChatCompletionStreamResponseChoicesInner -> String
show :: CreateChatCompletionStreamResponseChoicesInner -> String
$cshowList :: [CreateChatCompletionStreamResponseChoicesInner] -> ShowS
showList :: [CreateChatCompletionStreamResponseChoicesInner] -> ShowS
Show, CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
(CreateChatCompletionStreamResponseChoicesInner
 -> CreateChatCompletionStreamResponseChoicesInner -> Bool)
-> (CreateChatCompletionStreamResponseChoicesInner
    -> CreateChatCompletionStreamResponseChoicesInner -> Bool)
-> Eq CreateChatCompletionStreamResponseChoicesInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
== :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
$c/= :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
/= :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
Eq, Eq CreateChatCompletionStreamResponseChoicesInner
Eq CreateChatCompletionStreamResponseChoicesInner =>
(CreateChatCompletionStreamResponseChoicesInner
 -> CreateChatCompletionStreamResponseChoicesInner -> Ordering)
-> (CreateChatCompletionStreamResponseChoicesInner
    -> CreateChatCompletionStreamResponseChoicesInner -> Bool)
-> (CreateChatCompletionStreamResponseChoicesInner
    -> CreateChatCompletionStreamResponseChoicesInner -> Bool)
-> (CreateChatCompletionStreamResponseChoicesInner
    -> CreateChatCompletionStreamResponseChoicesInner -> Bool)
-> (CreateChatCompletionStreamResponseChoicesInner
    -> CreateChatCompletionStreamResponseChoicesInner -> Bool)
-> (CreateChatCompletionStreamResponseChoicesInner
    -> CreateChatCompletionStreamResponseChoicesInner
    -> CreateChatCompletionStreamResponseChoicesInner)
-> (CreateChatCompletionStreamResponseChoicesInner
    -> CreateChatCompletionStreamResponseChoicesInner
    -> CreateChatCompletionStreamResponseChoicesInner)
-> Ord CreateChatCompletionStreamResponseChoicesInner
CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Ordering
CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Ordering
compare :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Ordering
$c< :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
< :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
$c<= :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
<= :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
$c> :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
> :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
$c>= :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
>= :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner -> Bool
$cmax :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
max :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
$cmin :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
min :: CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
Ord, (forall x.
 CreateChatCompletionStreamResponseChoicesInner
 -> Rep CreateChatCompletionStreamResponseChoicesInner x)
-> (forall x.
    Rep CreateChatCompletionStreamResponseChoicesInner x
    -> CreateChatCompletionStreamResponseChoicesInner)
-> Generic CreateChatCompletionStreamResponseChoicesInner
forall x.
Rep CreateChatCompletionStreamResponseChoicesInner x
-> CreateChatCompletionStreamResponseChoicesInner
forall x.
CreateChatCompletionStreamResponseChoicesInner
-> Rep CreateChatCompletionStreamResponseChoicesInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateChatCompletionStreamResponseChoicesInner
-> Rep CreateChatCompletionStreamResponseChoicesInner x
from :: forall x.
CreateChatCompletionStreamResponseChoicesInner
-> Rep CreateChatCompletionStreamResponseChoicesInner x
$cto :: forall x.
Rep CreateChatCompletionStreamResponseChoicesInner x
-> CreateChatCompletionStreamResponseChoicesInner
to :: forall x.
Rep CreateChatCompletionStreamResponseChoicesInner x
-> CreateChatCompletionStreamResponseChoicesInner
Generic, Typeable CreateChatCompletionStreamResponseChoicesInner
Typeable CreateChatCompletionStreamResponseChoicesInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateChatCompletionStreamResponseChoicesInner
 -> c CreateChatCompletionStreamResponseChoicesInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateChatCompletionStreamResponseChoicesInner)
-> (CreateChatCompletionStreamResponseChoicesInner -> Constr)
-> (CreateChatCompletionStreamResponseChoicesInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateChatCompletionStreamResponseChoicesInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateChatCompletionStreamResponseChoicesInner))
-> ((forall b. Data b => b -> b)
    -> CreateChatCompletionStreamResponseChoicesInner
    -> CreateChatCompletionStreamResponseChoicesInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionStreamResponseChoicesInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateChatCompletionStreamResponseChoicesInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateChatCompletionStreamResponseChoicesInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateChatCompletionStreamResponseChoicesInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionStreamResponseChoicesInner
    -> m CreateChatCompletionStreamResponseChoicesInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionStreamResponseChoicesInner
    -> m CreateChatCompletionStreamResponseChoicesInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateChatCompletionStreamResponseChoicesInner
    -> m CreateChatCompletionStreamResponseChoicesInner)
-> Data CreateChatCompletionStreamResponseChoicesInner
CreateChatCompletionStreamResponseChoicesInner -> Constr
CreateChatCompletionStreamResponseChoicesInner -> DataType
(forall b. Data b => b -> b)
-> CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponseChoicesInner
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponseChoicesInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponseChoicesInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponseChoicesInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponseChoicesInner
-> m CreateChatCompletionStreamResponseChoicesInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponseChoicesInner
-> m CreateChatCompletionStreamResponseChoicesInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionStreamResponseChoicesInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionStreamResponseChoicesInner
-> c CreateChatCompletionStreamResponseChoicesInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionStreamResponseChoicesInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionStreamResponseChoicesInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionStreamResponseChoicesInner
-> c CreateChatCompletionStreamResponseChoicesInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateChatCompletionStreamResponseChoicesInner
-> c CreateChatCompletionStreamResponseChoicesInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionStreamResponseChoicesInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateChatCompletionStreamResponseChoicesInner
$ctoConstr :: CreateChatCompletionStreamResponseChoicesInner -> Constr
toConstr :: CreateChatCompletionStreamResponseChoicesInner -> Constr
$cdataTypeOf :: CreateChatCompletionStreamResponseChoicesInner -> DataType
dataTypeOf :: CreateChatCompletionStreamResponseChoicesInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionStreamResponseChoicesInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateChatCompletionStreamResponseChoicesInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionStreamResponseChoicesInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateChatCompletionStreamResponseChoicesInner)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
gmapT :: (forall b. Data b => b -> b)
-> CreateChatCompletionStreamResponseChoicesInner
-> CreateChatCompletionStreamResponseChoicesInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponseChoicesInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponseChoicesInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponseChoicesInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateChatCompletionStreamResponseChoicesInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponseChoicesInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponseChoicesInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponseChoicesInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateChatCompletionStreamResponseChoicesInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponseChoicesInner
-> m CreateChatCompletionStreamResponseChoicesInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponseChoicesInner
-> m CreateChatCompletionStreamResponseChoicesInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponseChoicesInner
-> m CreateChatCompletionStreamResponseChoicesInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponseChoicesInner
-> m CreateChatCompletionStreamResponseChoicesInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponseChoicesInner
-> m CreateChatCompletionStreamResponseChoicesInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateChatCompletionStreamResponseChoicesInner
-> m CreateChatCompletionStreamResponseChoicesInner
Data)

instance FromJSON CreateChatCompletionStreamResponseChoicesInner where
  parseJSON :: Value -> Parser CreateChatCompletionStreamResponseChoicesInner
parseJSON = Options
-> Value -> Parser CreateChatCompletionStreamResponseChoicesInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionStreamResponseChoicesInner")
instance ToJSON CreateChatCompletionStreamResponseChoicesInner where
  toJSON :: CreateChatCompletionStreamResponseChoicesInner -> Value
toJSON = Options -> CreateChatCompletionStreamResponseChoicesInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createChatCompletionStreamResponseChoicesInner")


-- | 
data CreateCompletionRequest = CreateCompletionRequest
  { CreateCompletionRequest -> CreateCompletionRequestModel
createCompletionRequestModel :: CreateCompletionRequestModel -- ^ 
  , CreateCompletionRequest -> CreateCompletionRequestPrompt
createCompletionRequestPrompt :: CreateCompletionRequestPrompt -- ^ 
  , CreateCompletionRequest -> Maybe Int
createCompletionRequestBestUnderscoreof :: Maybe Int -- ^ Generates `best_of` completions server-side and returns the \"best\" (the one with the highest log probability per token). Results cannot be streamed.  When used with `n`, `best_of` controls the number of candidate completions and `n` specifies how many to return – `best_of` must be greater than `n`.  **Note:** Because this parameter generates many completions, it can quickly consume your token quota. Use carefully and ensure that you have reasonable settings for `max_tokens` and `stop`. 
  , CreateCompletionRequest -> Maybe Bool
createCompletionRequestEcho :: Maybe Bool -- ^ Echo back the prompt in addition to the completion 
  , CreateCompletionRequest -> Maybe Double
createCompletionRequestFrequencyUnderscorepenalty :: Maybe Double -- ^ Number between -2.0 and 2.0. Positive values penalize new tokens based on their existing frequency in the text so far, decreasing the model's likelihood to repeat the same line verbatim.  [See more information about frequency and presence penalties.](/docs/guides/text-generation/parameter-details) 
  , CreateCompletionRequest -> Maybe (Map String Int)
createCompletionRequestLogitUnderscorebias :: Maybe (Map.Map String Int) -- ^ Modify the likelihood of specified tokens appearing in the completion.  Accepts a JSON object that maps tokens (specified by their token ID in the GPT tokenizer) to an associated bias value from -100 to 100. You can use this [tokenizer tool](/tokenizer?view=bpe) to convert text to token IDs. Mathematically, the bias is added to the logits generated by the model prior to sampling. The exact effect will vary per model, but values between -1 and 1 should decrease or increase likelihood of selection; values like -100 or 100 should result in a ban or exclusive selection of the relevant token.  As an example, you can pass `{\"50256\": -100}` to prevent the <|endoftext|> token from being generated. 
  , CreateCompletionRequest -> Maybe Int
createCompletionRequestLogprobs :: Maybe Int -- ^ Include the log probabilities on the `logprobs` most likely output tokens, as well the chosen tokens. For example, if `logprobs` is 5, the API will return a list of the 5 most likely tokens. The API will always return the `logprob` of the sampled token, so there may be up to `logprobs+1` elements in the response.  The maximum value for `logprobs` is 5. 
  , CreateCompletionRequest -> Maybe Int
createCompletionRequestMaxUnderscoretokens :: Maybe Int -- ^ The maximum number of [tokens](/tokenizer) that can be generated in the completion.  The token count of your prompt plus `max_tokens` cannot exceed the model's context length. [Example Python code](https://cookbook.openai.com/examples/how_to_count_tokens_with_tiktoken) for counting tokens. 
  , CreateCompletionRequest -> Maybe Int
createCompletionRequestN :: Maybe Int -- ^ How many completions to generate for each prompt.  **Note:** Because this parameter generates many completions, it can quickly consume your token quota. Use carefully and ensure that you have reasonable settings for `max_tokens` and `stop`. 
  , CreateCompletionRequest -> Maybe Double
createCompletionRequestPresenceUnderscorepenalty :: Maybe Double -- ^ Number between -2.0 and 2.0. Positive values penalize new tokens based on whether they appear in the text so far, increasing the model's likelihood to talk about new topics.  [See more information about frequency and presence penalties.](/docs/guides/text-generation/parameter-details) 
  , CreateCompletionRequest -> Maybe Int
createCompletionRequestSeed :: Maybe Int -- ^ If specified, our system will make a best effort to sample deterministically, such that repeated requests with the same `seed` and parameters should return the same result.  Determinism is not guaranteed, and you should refer to the `system_fingerprint` response parameter to monitor changes in the backend. 
  , CreateCompletionRequest -> Maybe CreateCompletionRequestStop
createCompletionRequestStop :: Maybe CreateCompletionRequestStop -- ^ 
  , CreateCompletionRequest -> Maybe Bool
createCompletionRequestStream :: Maybe Bool -- ^ Whether to stream back partial progress. If set, tokens will be sent as data-only [server-sent events](https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events/Using_server-sent_events#Event_stream_format) as they become available, with the stream terminated by a `data: [DONE]` message. [Example Python code](https://cookbook.openai.com/examples/how_to_stream_completions). 
  , CreateCompletionRequest -> Maybe Text
createCompletionRequestSuffix :: Maybe Text -- ^ The suffix that comes after a completion of inserted text.
  , CreateCompletionRequest -> Maybe Double
createCompletionRequestTemperature :: Maybe Double -- ^ What sampling temperature to use, between 0 and 2. Higher values like 0.8 will make the output more random, while lower values like 0.2 will make it more focused and deterministic.  We generally recommend altering this or `top_p` but not both. 
  , CreateCompletionRequest -> Maybe Double
createCompletionRequestTopUnderscorep :: Maybe Double -- ^ An alternative to sampling with temperature, called nucleus sampling, where the model considers the results of the tokens with top_p probability mass. So 0.1 means only the tokens comprising the top 10% probability mass are considered.  We generally recommend altering this or `temperature` but not both. 
  , CreateCompletionRequest -> Maybe Text
createCompletionRequestUser :: Maybe Text -- ^ A unique identifier representing your end-user, which can help OpenAI to monitor and detect abuse. [Learn more](/docs/guides/safety-best-practices/end-user-ids). 
  } deriving (Int -> CreateCompletionRequest -> ShowS
[CreateCompletionRequest] -> ShowS
CreateCompletionRequest -> String
(Int -> CreateCompletionRequest -> ShowS)
-> (CreateCompletionRequest -> String)
-> ([CreateCompletionRequest] -> ShowS)
-> Show CreateCompletionRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateCompletionRequest -> ShowS
showsPrec :: Int -> CreateCompletionRequest -> ShowS
$cshow :: CreateCompletionRequest -> String
show :: CreateCompletionRequest -> String
$cshowList :: [CreateCompletionRequest] -> ShowS
showList :: [CreateCompletionRequest] -> ShowS
Show, CreateCompletionRequest -> CreateCompletionRequest -> Bool
(CreateCompletionRequest -> CreateCompletionRequest -> Bool)
-> (CreateCompletionRequest -> CreateCompletionRequest -> Bool)
-> Eq CreateCompletionRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
== :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
$c/= :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
/= :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
Eq, Eq CreateCompletionRequest
Eq CreateCompletionRequest =>
(CreateCompletionRequest -> CreateCompletionRequest -> Ordering)
-> (CreateCompletionRequest -> CreateCompletionRequest -> Bool)
-> (CreateCompletionRequest -> CreateCompletionRequest -> Bool)
-> (CreateCompletionRequest -> CreateCompletionRequest -> Bool)
-> (CreateCompletionRequest -> CreateCompletionRequest -> Bool)
-> (CreateCompletionRequest
    -> CreateCompletionRequest -> CreateCompletionRequest)
-> (CreateCompletionRequest
    -> CreateCompletionRequest -> CreateCompletionRequest)
-> Ord CreateCompletionRequest
CreateCompletionRequest -> CreateCompletionRequest -> Bool
CreateCompletionRequest -> CreateCompletionRequest -> Ordering
CreateCompletionRequest
-> CreateCompletionRequest -> CreateCompletionRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateCompletionRequest -> CreateCompletionRequest -> Ordering
compare :: CreateCompletionRequest -> CreateCompletionRequest -> Ordering
$c< :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
< :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
$c<= :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
<= :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
$c> :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
> :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
$c>= :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
>= :: CreateCompletionRequest -> CreateCompletionRequest -> Bool
$cmax :: CreateCompletionRequest
-> CreateCompletionRequest -> CreateCompletionRequest
max :: CreateCompletionRequest
-> CreateCompletionRequest -> CreateCompletionRequest
$cmin :: CreateCompletionRequest
-> CreateCompletionRequest -> CreateCompletionRequest
min :: CreateCompletionRequest
-> CreateCompletionRequest -> CreateCompletionRequest
Ord, (forall x.
 CreateCompletionRequest -> Rep CreateCompletionRequest x)
-> (forall x.
    Rep CreateCompletionRequest x -> CreateCompletionRequest)
-> Generic CreateCompletionRequest
forall x. Rep CreateCompletionRequest x -> CreateCompletionRequest
forall x. CreateCompletionRequest -> Rep CreateCompletionRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateCompletionRequest -> Rep CreateCompletionRequest x
from :: forall x. CreateCompletionRequest -> Rep CreateCompletionRequest x
$cto :: forall x. Rep CreateCompletionRequest x -> CreateCompletionRequest
to :: forall x. Rep CreateCompletionRequest x -> CreateCompletionRequest
Generic, Typeable CreateCompletionRequest
Typeable CreateCompletionRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateCompletionRequest
 -> c CreateCompletionRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateCompletionRequest)
-> (CreateCompletionRequest -> Constr)
-> (CreateCompletionRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateCompletionRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateCompletionRequest))
-> ((forall b. Data b => b -> b)
    -> CreateCompletionRequest -> CreateCompletionRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionRequest
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionRequest
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateCompletionRequest -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> CreateCompletionRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequest -> m CreateCompletionRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequest -> m CreateCompletionRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequest -> m CreateCompletionRequest)
-> Data CreateCompletionRequest
CreateCompletionRequest -> Constr
CreateCompletionRequest -> DataType
(forall b. Data b => b -> b)
-> CreateCompletionRequest -> CreateCompletionRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateCompletionRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateCompletionRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequest
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequest
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequest -> m CreateCompletionRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequest -> m CreateCompletionRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequest
-> c CreateCompletionRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateCompletionRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequest
-> c CreateCompletionRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequest
-> c CreateCompletionRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionRequest
$ctoConstr :: CreateCompletionRequest -> Constr
toConstr :: CreateCompletionRequest -> Constr
$cdataTypeOf :: CreateCompletionRequest -> DataType
dataTypeOf :: CreateCompletionRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateCompletionRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateCompletionRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateCompletionRequest -> CreateCompletionRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateCompletionRequest -> CreateCompletionRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequest
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequest
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequest
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequest
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateCompletionRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateCompletionRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateCompletionRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateCompletionRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequest -> m CreateCompletionRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequest -> m CreateCompletionRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequest -> m CreateCompletionRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequest -> m CreateCompletionRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequest -> m CreateCompletionRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequest -> m CreateCompletionRequest
Data)

instance FromJSON CreateCompletionRequest where
  parseJSON :: Value -> Parser CreateCompletionRequest
parseJSON = Options -> Value -> Parser CreateCompletionRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionRequest")
instance ToJSON CreateCompletionRequest where
  toJSON :: CreateCompletionRequest -> Value
toJSON = Options -> CreateCompletionRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionRequest")


-- | ID of the model to use. You can use the [List models](/docs/api-reference/models/list) API to see all of your available models, or see our [Model overview](/docs/models/overview) for descriptions of them. 
data CreateCompletionRequestModel = CreateCompletionRequestModel Text  deriving (Int -> CreateCompletionRequestModel -> ShowS
[CreateCompletionRequestModel] -> ShowS
CreateCompletionRequestModel -> String
(Int -> CreateCompletionRequestModel -> ShowS)
-> (CreateCompletionRequestModel -> String)
-> ([CreateCompletionRequestModel] -> ShowS)
-> Show CreateCompletionRequestModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateCompletionRequestModel -> ShowS
showsPrec :: Int -> CreateCompletionRequestModel -> ShowS
$cshow :: CreateCompletionRequestModel -> String
show :: CreateCompletionRequestModel -> String
$cshowList :: [CreateCompletionRequestModel] -> ShowS
showList :: [CreateCompletionRequestModel] -> ShowS
Show, CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
(CreateCompletionRequestModel
 -> CreateCompletionRequestModel -> Bool)
-> (CreateCompletionRequestModel
    -> CreateCompletionRequestModel -> Bool)
-> Eq CreateCompletionRequestModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
== :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
$c/= :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
/= :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
Eq, Eq CreateCompletionRequestModel
Eq CreateCompletionRequestModel =>
(CreateCompletionRequestModel
 -> CreateCompletionRequestModel -> Ordering)
-> (CreateCompletionRequestModel
    -> CreateCompletionRequestModel -> Bool)
-> (CreateCompletionRequestModel
    -> CreateCompletionRequestModel -> Bool)
-> (CreateCompletionRequestModel
    -> CreateCompletionRequestModel -> Bool)
-> (CreateCompletionRequestModel
    -> CreateCompletionRequestModel -> Bool)
-> (CreateCompletionRequestModel
    -> CreateCompletionRequestModel -> CreateCompletionRequestModel)
-> (CreateCompletionRequestModel
    -> CreateCompletionRequestModel -> CreateCompletionRequestModel)
-> Ord CreateCompletionRequestModel
CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Ordering
CreateCompletionRequestModel
-> CreateCompletionRequestModel -> CreateCompletionRequestModel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Ordering
compare :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Ordering
$c< :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
< :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
$c<= :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
<= :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
$c> :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
> :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
$c>= :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
>= :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> Bool
$cmax :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> CreateCompletionRequestModel
max :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> CreateCompletionRequestModel
$cmin :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> CreateCompletionRequestModel
min :: CreateCompletionRequestModel
-> CreateCompletionRequestModel -> CreateCompletionRequestModel
Ord, (forall x.
 CreateCompletionRequestModel -> Rep CreateCompletionRequestModel x)
-> (forall x.
    Rep CreateCompletionRequestModel x -> CreateCompletionRequestModel)
-> Generic CreateCompletionRequestModel
forall x.
Rep CreateCompletionRequestModel x -> CreateCompletionRequestModel
forall x.
CreateCompletionRequestModel -> Rep CreateCompletionRequestModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateCompletionRequestModel -> Rep CreateCompletionRequestModel x
from :: forall x.
CreateCompletionRequestModel -> Rep CreateCompletionRequestModel x
$cto :: forall x.
Rep CreateCompletionRequestModel x -> CreateCompletionRequestModel
to :: forall x.
Rep CreateCompletionRequestModel x -> CreateCompletionRequestModel
Generic, Typeable CreateCompletionRequestModel
Typeable CreateCompletionRequestModel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateCompletionRequestModel
 -> c CreateCompletionRequestModel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateCompletionRequestModel)
-> (CreateCompletionRequestModel -> Constr)
-> (CreateCompletionRequestModel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateCompletionRequestModel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateCompletionRequestModel))
-> ((forall b. Data b => b -> b)
    -> CreateCompletionRequestModel -> CreateCompletionRequestModel)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionRequestModel
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionRequestModel
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateCompletionRequestModel -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateCompletionRequestModel
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequestModel -> m CreateCompletionRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequestModel -> m CreateCompletionRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequestModel -> m CreateCompletionRequestModel)
-> Data CreateCompletionRequestModel
CreateCompletionRequestModel -> Constr
CreateCompletionRequestModel -> DataType
(forall b. Data b => b -> b)
-> CreateCompletionRequestModel -> CreateCompletionRequestModel
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionRequestModel
-> u
forall u.
(forall d. Data d => d -> u) -> CreateCompletionRequestModel -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestModel
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestModel
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestModel -> m CreateCompletionRequestModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestModel -> m CreateCompletionRequestModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionRequestModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequestModel
-> c CreateCompletionRequestModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionRequestModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequestModel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequestModel
-> c CreateCompletionRequestModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequestModel
-> c CreateCompletionRequestModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionRequestModel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionRequestModel
$ctoConstr :: CreateCompletionRequestModel -> Constr
toConstr :: CreateCompletionRequestModel -> Constr
$cdataTypeOf :: CreateCompletionRequestModel -> DataType
dataTypeOf :: CreateCompletionRequestModel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionRequestModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionRequestModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequestModel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequestModel)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateCompletionRequestModel -> CreateCompletionRequestModel
gmapT :: (forall b. Data b => b -> b)
-> CreateCompletionRequestModel -> CreateCompletionRequestModel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestModel
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestModel
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestModel
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestModel
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateCompletionRequestModel -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateCompletionRequestModel -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionRequestModel
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionRequestModel
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestModel -> m CreateCompletionRequestModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestModel -> m CreateCompletionRequestModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestModel -> m CreateCompletionRequestModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestModel -> m CreateCompletionRequestModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestModel -> m CreateCompletionRequestModel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestModel -> m CreateCompletionRequestModel
Data)

instance FromJSON CreateCompletionRequestModel where
  parseJSON :: Value -> Parser CreateCompletionRequestModel
parseJSON = Options -> Value -> Parser CreateCompletionRequestModel
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionRequestModel")
instance ToJSON CreateCompletionRequestModel where
  toJSON :: CreateCompletionRequestModel -> Value
toJSON = Options -> CreateCompletionRequestModel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionRequestModel")


-- | The prompt(s) to generate completions for, encoded as a string, array of strings, array of tokens, or array of token arrays.  Note that &lt;|endoftext|&gt; is the document separator that the model sees during training, so if a prompt is not specified the model will generate as if from the beginning of a new document. 
data CreateCompletionRequestPrompt = CreateCompletionRequestPrompt
  { 
  } deriving (Int -> CreateCompletionRequestPrompt -> ShowS
[CreateCompletionRequestPrompt] -> ShowS
CreateCompletionRequestPrompt -> String
(Int -> CreateCompletionRequestPrompt -> ShowS)
-> (CreateCompletionRequestPrompt -> String)
-> ([CreateCompletionRequestPrompt] -> ShowS)
-> Show CreateCompletionRequestPrompt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateCompletionRequestPrompt -> ShowS
showsPrec :: Int -> CreateCompletionRequestPrompt -> ShowS
$cshow :: CreateCompletionRequestPrompt -> String
show :: CreateCompletionRequestPrompt -> String
$cshowList :: [CreateCompletionRequestPrompt] -> ShowS
showList :: [CreateCompletionRequestPrompt] -> ShowS
Show, CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
(CreateCompletionRequestPrompt
 -> CreateCompletionRequestPrompt -> Bool)
-> (CreateCompletionRequestPrompt
    -> CreateCompletionRequestPrompt -> Bool)
-> Eq CreateCompletionRequestPrompt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
== :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
$c/= :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
/= :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
Eq, Eq CreateCompletionRequestPrompt
Eq CreateCompletionRequestPrompt =>
(CreateCompletionRequestPrompt
 -> CreateCompletionRequestPrompt -> Ordering)
-> (CreateCompletionRequestPrompt
    -> CreateCompletionRequestPrompt -> Bool)
-> (CreateCompletionRequestPrompt
    -> CreateCompletionRequestPrompt -> Bool)
-> (CreateCompletionRequestPrompt
    -> CreateCompletionRequestPrompt -> Bool)
-> (CreateCompletionRequestPrompt
    -> CreateCompletionRequestPrompt -> Bool)
-> (CreateCompletionRequestPrompt
    -> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt)
-> (CreateCompletionRequestPrompt
    -> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt)
-> Ord CreateCompletionRequestPrompt
CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Ordering
CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Ordering
compare :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Ordering
$c< :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
< :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
$c<= :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
<= :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
$c> :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
> :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
$c>= :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
>= :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> Bool
$cmax :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt
max :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt
$cmin :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt
min :: CreateCompletionRequestPrompt
-> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt
Ord, (forall x.
 CreateCompletionRequestPrompt
 -> Rep CreateCompletionRequestPrompt x)
-> (forall x.
    Rep CreateCompletionRequestPrompt x
    -> CreateCompletionRequestPrompt)
-> Generic CreateCompletionRequestPrompt
forall x.
Rep CreateCompletionRequestPrompt x
-> CreateCompletionRequestPrompt
forall x.
CreateCompletionRequestPrompt
-> Rep CreateCompletionRequestPrompt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateCompletionRequestPrompt
-> Rep CreateCompletionRequestPrompt x
from :: forall x.
CreateCompletionRequestPrompt
-> Rep CreateCompletionRequestPrompt x
$cto :: forall x.
Rep CreateCompletionRequestPrompt x
-> CreateCompletionRequestPrompt
to :: forall x.
Rep CreateCompletionRequestPrompt x
-> CreateCompletionRequestPrompt
Generic, Typeable CreateCompletionRequestPrompt
Typeable CreateCompletionRequestPrompt =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateCompletionRequestPrompt
 -> c CreateCompletionRequestPrompt)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateCompletionRequestPrompt)
-> (CreateCompletionRequestPrompt -> Constr)
-> (CreateCompletionRequestPrompt -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateCompletionRequestPrompt))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateCompletionRequestPrompt))
-> ((forall b. Data b => b -> b)
    -> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionRequestPrompt
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionRequestPrompt
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateCompletionRequestPrompt -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateCompletionRequestPrompt
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequestPrompt
    -> m CreateCompletionRequestPrompt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequestPrompt
    -> m CreateCompletionRequestPrompt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequestPrompt
    -> m CreateCompletionRequestPrompt)
-> Data CreateCompletionRequestPrompt
CreateCompletionRequestPrompt -> Constr
CreateCompletionRequestPrompt -> DataType
(forall b. Data b => b -> b)
-> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionRequestPrompt
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateCompletionRequestPrompt -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestPrompt
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestPrompt
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestPrompt -> m CreateCompletionRequestPrompt
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestPrompt -> m CreateCompletionRequestPrompt
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateCompletionRequestPrompt
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequestPrompt
-> c CreateCompletionRequestPrompt
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionRequestPrompt)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequestPrompt)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequestPrompt
-> c CreateCompletionRequestPrompt
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequestPrompt
-> c CreateCompletionRequestPrompt
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateCompletionRequestPrompt
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateCompletionRequestPrompt
$ctoConstr :: CreateCompletionRequestPrompt -> Constr
toConstr :: CreateCompletionRequestPrompt -> Constr
$cdataTypeOf :: CreateCompletionRequestPrompt -> DataType
dataTypeOf :: CreateCompletionRequestPrompt -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionRequestPrompt)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionRequestPrompt)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequestPrompt)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequestPrompt)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt
gmapT :: (forall b. Data b => b -> b)
-> CreateCompletionRequestPrompt -> CreateCompletionRequestPrompt
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestPrompt
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestPrompt
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestPrompt
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestPrompt
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateCompletionRequestPrompt -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateCompletionRequestPrompt -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionRequestPrompt
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionRequestPrompt
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestPrompt -> m CreateCompletionRequestPrompt
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestPrompt -> m CreateCompletionRequestPrompt
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestPrompt -> m CreateCompletionRequestPrompt
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestPrompt -> m CreateCompletionRequestPrompt
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestPrompt -> m CreateCompletionRequestPrompt
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestPrompt -> m CreateCompletionRequestPrompt
Data)

instance FromJSON CreateCompletionRequestPrompt where
  parseJSON :: Value -> Parser CreateCompletionRequestPrompt
parseJSON = Options -> Value -> Parser CreateCompletionRequestPrompt
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionRequestPrompt")
instance ToJSON CreateCompletionRequestPrompt where
  toJSON :: CreateCompletionRequestPrompt -> Value
toJSON = Options -> CreateCompletionRequestPrompt -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionRequestPrompt")


-- | Up to 4 sequences where the API will stop generating further tokens. The returned text will not contain the stop sequence. 
data CreateCompletionRequestStop = CreateCompletionRequestStop
  { 
  } deriving (Int -> CreateCompletionRequestStop -> ShowS
[CreateCompletionRequestStop] -> ShowS
CreateCompletionRequestStop -> String
(Int -> CreateCompletionRequestStop -> ShowS)
-> (CreateCompletionRequestStop -> String)
-> ([CreateCompletionRequestStop] -> ShowS)
-> Show CreateCompletionRequestStop
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateCompletionRequestStop -> ShowS
showsPrec :: Int -> CreateCompletionRequestStop -> ShowS
$cshow :: CreateCompletionRequestStop -> String
show :: CreateCompletionRequestStop -> String
$cshowList :: [CreateCompletionRequestStop] -> ShowS
showList :: [CreateCompletionRequestStop] -> ShowS
Show, CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
(CreateCompletionRequestStop
 -> CreateCompletionRequestStop -> Bool)
-> (CreateCompletionRequestStop
    -> CreateCompletionRequestStop -> Bool)
-> Eq CreateCompletionRequestStop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
== :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
$c/= :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
/= :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
Eq, Eq CreateCompletionRequestStop
Eq CreateCompletionRequestStop =>
(CreateCompletionRequestStop
 -> CreateCompletionRequestStop -> Ordering)
-> (CreateCompletionRequestStop
    -> CreateCompletionRequestStop -> Bool)
-> (CreateCompletionRequestStop
    -> CreateCompletionRequestStop -> Bool)
-> (CreateCompletionRequestStop
    -> CreateCompletionRequestStop -> Bool)
-> (CreateCompletionRequestStop
    -> CreateCompletionRequestStop -> Bool)
-> (CreateCompletionRequestStop
    -> CreateCompletionRequestStop -> CreateCompletionRequestStop)
-> (CreateCompletionRequestStop
    -> CreateCompletionRequestStop -> CreateCompletionRequestStop)
-> Ord CreateCompletionRequestStop
CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
CreateCompletionRequestStop
-> CreateCompletionRequestStop -> Ordering
CreateCompletionRequestStop
-> CreateCompletionRequestStop -> CreateCompletionRequestStop
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateCompletionRequestStop
-> CreateCompletionRequestStop -> Ordering
compare :: CreateCompletionRequestStop
-> CreateCompletionRequestStop -> Ordering
$c< :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
< :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
$c<= :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
<= :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
$c> :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
> :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
$c>= :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
>= :: CreateCompletionRequestStop -> CreateCompletionRequestStop -> Bool
$cmax :: CreateCompletionRequestStop
-> CreateCompletionRequestStop -> CreateCompletionRequestStop
max :: CreateCompletionRequestStop
-> CreateCompletionRequestStop -> CreateCompletionRequestStop
$cmin :: CreateCompletionRequestStop
-> CreateCompletionRequestStop -> CreateCompletionRequestStop
min :: CreateCompletionRequestStop
-> CreateCompletionRequestStop -> CreateCompletionRequestStop
Ord, (forall x.
 CreateCompletionRequestStop -> Rep CreateCompletionRequestStop x)
-> (forall x.
    Rep CreateCompletionRequestStop x -> CreateCompletionRequestStop)
-> Generic CreateCompletionRequestStop
forall x.
Rep CreateCompletionRequestStop x -> CreateCompletionRequestStop
forall x.
CreateCompletionRequestStop -> Rep CreateCompletionRequestStop x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateCompletionRequestStop -> Rep CreateCompletionRequestStop x
from :: forall x.
CreateCompletionRequestStop -> Rep CreateCompletionRequestStop x
$cto :: forall x.
Rep CreateCompletionRequestStop x -> CreateCompletionRequestStop
to :: forall x.
Rep CreateCompletionRequestStop x -> CreateCompletionRequestStop
Generic, Typeable CreateCompletionRequestStop
Typeable CreateCompletionRequestStop =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateCompletionRequestStop
 -> c CreateCompletionRequestStop)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateCompletionRequestStop)
-> (CreateCompletionRequestStop -> Constr)
-> (CreateCompletionRequestStop -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateCompletionRequestStop))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateCompletionRequestStop))
-> ((forall b. Data b => b -> b)
    -> CreateCompletionRequestStop -> CreateCompletionRequestStop)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionRequestStop
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionRequestStop
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateCompletionRequestStop -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateCompletionRequestStop
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequestStop -> m CreateCompletionRequestStop)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequestStop -> m CreateCompletionRequestStop)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionRequestStop -> m CreateCompletionRequestStop)
-> Data CreateCompletionRequestStop
CreateCompletionRequestStop -> Constr
CreateCompletionRequestStop -> DataType
(forall b. Data b => b -> b)
-> CreateCompletionRequestStop -> CreateCompletionRequestStop
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateCompletionRequestStop -> u
forall u.
(forall d. Data d => d -> u) -> CreateCompletionRequestStop -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestStop
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestStop
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestStop -> m CreateCompletionRequestStop
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestStop -> m CreateCompletionRequestStop
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionRequestStop
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequestStop
-> c CreateCompletionRequestStop
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionRequestStop)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequestStop)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequestStop
-> c CreateCompletionRequestStop
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionRequestStop
-> c CreateCompletionRequestStop
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionRequestStop
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionRequestStop
$ctoConstr :: CreateCompletionRequestStop -> Constr
toConstr :: CreateCompletionRequestStop -> Constr
$cdataTypeOf :: CreateCompletionRequestStop -> DataType
dataTypeOf :: CreateCompletionRequestStop -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionRequestStop)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionRequestStop)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequestStop)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionRequestStop)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateCompletionRequestStop -> CreateCompletionRequestStop
gmapT :: (forall b. Data b => b -> b)
-> CreateCompletionRequestStop -> CreateCompletionRequestStop
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestStop
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestStop
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestStop
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionRequestStop
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateCompletionRequestStop -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateCompletionRequestStop -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateCompletionRequestStop -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateCompletionRequestStop -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestStop -> m CreateCompletionRequestStop
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestStop -> m CreateCompletionRequestStop
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestStop -> m CreateCompletionRequestStop
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestStop -> m CreateCompletionRequestStop
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestStop -> m CreateCompletionRequestStop
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionRequestStop -> m CreateCompletionRequestStop
Data)

instance FromJSON CreateCompletionRequestStop where
  parseJSON :: Value -> Parser CreateCompletionRequestStop
parseJSON = Options -> Value -> Parser CreateCompletionRequestStop
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionRequestStop")
instance ToJSON CreateCompletionRequestStop where
  toJSON :: CreateCompletionRequestStop -> Value
toJSON = Options -> CreateCompletionRequestStop -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionRequestStop")


-- | Represents a completion response from the API. Note: both the streamed and non-streamed response objects share the same shape (unlike the chat endpoint). 
data CreateCompletionResponse = CreateCompletionResponse
  { CreateCompletionResponse -> Text
createCompletionResponseId :: Text -- ^ A unique identifier for the completion.
  , CreateCompletionResponse -> [CreateCompletionResponseChoicesInner]
createCompletionResponseChoices :: [CreateCompletionResponseChoicesInner] -- ^ The list of completion choices the model generated for the input prompt.
  , CreateCompletionResponse -> Int
createCompletionResponseCreated :: Int -- ^ The Unix timestamp (in seconds) of when the completion was created.
  , CreateCompletionResponse -> Text
createCompletionResponseModel :: Text -- ^ The model used for completion.
  , CreateCompletionResponse -> Maybe Text
createCompletionResponseSystemUnderscorefingerprint :: Maybe Text -- ^ This fingerprint represents the backend configuration that the model runs with.  Can be used in conjunction with the `seed` request parameter to understand when backend changes have been made that might impact determinism. 
  , CreateCompletionResponse -> Text
createCompletionResponseObject :: Text -- ^ The object type, which is always \"text_completion\"
  , CreateCompletionResponse -> Maybe CompletionUsage
createCompletionResponseUsage :: Maybe CompletionUsage -- ^ 
  } deriving (Int -> CreateCompletionResponse -> ShowS
[CreateCompletionResponse] -> ShowS
CreateCompletionResponse -> String
(Int -> CreateCompletionResponse -> ShowS)
-> (CreateCompletionResponse -> String)
-> ([CreateCompletionResponse] -> ShowS)
-> Show CreateCompletionResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateCompletionResponse -> ShowS
showsPrec :: Int -> CreateCompletionResponse -> ShowS
$cshow :: CreateCompletionResponse -> String
show :: CreateCompletionResponse -> String
$cshowList :: [CreateCompletionResponse] -> ShowS
showList :: [CreateCompletionResponse] -> ShowS
Show, CreateCompletionResponse -> CreateCompletionResponse -> Bool
(CreateCompletionResponse -> CreateCompletionResponse -> Bool)
-> (CreateCompletionResponse -> CreateCompletionResponse -> Bool)
-> Eq CreateCompletionResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
== :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
$c/= :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
/= :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
Eq, Eq CreateCompletionResponse
Eq CreateCompletionResponse =>
(CreateCompletionResponse -> CreateCompletionResponse -> Ordering)
-> (CreateCompletionResponse -> CreateCompletionResponse -> Bool)
-> (CreateCompletionResponse -> CreateCompletionResponse -> Bool)
-> (CreateCompletionResponse -> CreateCompletionResponse -> Bool)
-> (CreateCompletionResponse -> CreateCompletionResponse -> Bool)
-> (CreateCompletionResponse
    -> CreateCompletionResponse -> CreateCompletionResponse)
-> (CreateCompletionResponse
    -> CreateCompletionResponse -> CreateCompletionResponse)
-> Ord CreateCompletionResponse
CreateCompletionResponse -> CreateCompletionResponse -> Bool
CreateCompletionResponse -> CreateCompletionResponse -> Ordering
CreateCompletionResponse
-> CreateCompletionResponse -> CreateCompletionResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateCompletionResponse -> CreateCompletionResponse -> Ordering
compare :: CreateCompletionResponse -> CreateCompletionResponse -> Ordering
$c< :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
< :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
$c<= :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
<= :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
$c> :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
> :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
$c>= :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
>= :: CreateCompletionResponse -> CreateCompletionResponse -> Bool
$cmax :: CreateCompletionResponse
-> CreateCompletionResponse -> CreateCompletionResponse
max :: CreateCompletionResponse
-> CreateCompletionResponse -> CreateCompletionResponse
$cmin :: CreateCompletionResponse
-> CreateCompletionResponse -> CreateCompletionResponse
min :: CreateCompletionResponse
-> CreateCompletionResponse -> CreateCompletionResponse
Ord, (forall x.
 CreateCompletionResponse -> Rep CreateCompletionResponse x)
-> (forall x.
    Rep CreateCompletionResponse x -> CreateCompletionResponse)
-> Generic CreateCompletionResponse
forall x.
Rep CreateCompletionResponse x -> CreateCompletionResponse
forall x.
CreateCompletionResponse -> Rep CreateCompletionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateCompletionResponse -> Rep CreateCompletionResponse x
from :: forall x.
CreateCompletionResponse -> Rep CreateCompletionResponse x
$cto :: forall x.
Rep CreateCompletionResponse x -> CreateCompletionResponse
to :: forall x.
Rep CreateCompletionResponse x -> CreateCompletionResponse
Generic, Typeable CreateCompletionResponse
Typeable CreateCompletionResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateCompletionResponse
 -> c CreateCompletionResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateCompletionResponse)
-> (CreateCompletionResponse -> Constr)
-> (CreateCompletionResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateCompletionResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateCompletionResponse))
-> ((forall b. Data b => b -> b)
    -> CreateCompletionResponse -> CreateCompletionResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateCompletionResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> CreateCompletionResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionResponse -> m CreateCompletionResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionResponse -> m CreateCompletionResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionResponse -> m CreateCompletionResponse)
-> Data CreateCompletionResponse
CreateCompletionResponse -> Constr
CreateCompletionResponse -> DataType
(forall b. Data b => b -> b)
-> CreateCompletionResponse -> CreateCompletionResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateCompletionResponse -> u
forall u.
(forall d. Data d => d -> u) -> CreateCompletionResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponse -> m CreateCompletionResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponse -> m CreateCompletionResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionResponse
-> c CreateCompletionResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateCompletionResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionResponse
-> c CreateCompletionResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionResponse
-> c CreateCompletionResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateCompletionResponse
$ctoConstr :: CreateCompletionResponse -> Constr
toConstr :: CreateCompletionResponse -> Constr
$cdataTypeOf :: CreateCompletionResponse -> DataType
dataTypeOf :: CreateCompletionResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateCompletionResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateCompletionResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateCompletionResponse -> CreateCompletionResponse
gmapT :: (forall b. Data b => b -> b)
-> CreateCompletionResponse -> CreateCompletionResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateCompletionResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateCompletionResponse -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateCompletionResponse -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateCompletionResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponse -> m CreateCompletionResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponse -> m CreateCompletionResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponse -> m CreateCompletionResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponse -> m CreateCompletionResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponse -> m CreateCompletionResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponse -> m CreateCompletionResponse
Data)

instance FromJSON CreateCompletionResponse where
  parseJSON :: Value -> Parser CreateCompletionResponse
parseJSON = Options -> Value -> Parser CreateCompletionResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionResponse")
instance ToJSON CreateCompletionResponse where
  toJSON :: CreateCompletionResponse -> Value
toJSON = Options -> CreateCompletionResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionResponse")


-- | 
data CreateCompletionResponseChoicesInner = CreateCompletionResponseChoicesInner
  { CreateCompletionResponseChoicesInner -> Text
createCompletionResponseChoicesInnerFinishUnderscorereason :: Text -- ^ The reason the model stopped generating tokens. This will be `stop` if the model hit a natural stop point or a provided stop sequence, `length` if the maximum number of tokens specified in the request was reached, or `content_filter` if content was omitted due to a flag from our content filters. 
  , CreateCompletionResponseChoicesInner -> Int
createCompletionResponseChoicesInnerIndex :: Int -- ^ 
  , CreateCompletionResponseChoicesInner
-> Maybe CreateCompletionResponseChoicesInnerLogprobs
createCompletionResponseChoicesInnerLogprobs :: Maybe CreateCompletionResponseChoicesInnerLogprobs -- ^ 
  , CreateCompletionResponseChoicesInner -> Text
createCompletionResponseChoicesInnerText :: Text -- ^ 
  } deriving (Int -> CreateCompletionResponseChoicesInner -> ShowS
[CreateCompletionResponseChoicesInner] -> ShowS
CreateCompletionResponseChoicesInner -> String
(Int -> CreateCompletionResponseChoicesInner -> ShowS)
-> (CreateCompletionResponseChoicesInner -> String)
-> ([CreateCompletionResponseChoicesInner] -> ShowS)
-> Show CreateCompletionResponseChoicesInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateCompletionResponseChoicesInner -> ShowS
showsPrec :: Int -> CreateCompletionResponseChoicesInner -> ShowS
$cshow :: CreateCompletionResponseChoicesInner -> String
show :: CreateCompletionResponseChoicesInner -> String
$cshowList :: [CreateCompletionResponseChoicesInner] -> ShowS
showList :: [CreateCompletionResponseChoicesInner] -> ShowS
Show, CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
(CreateCompletionResponseChoicesInner
 -> CreateCompletionResponseChoicesInner -> Bool)
-> (CreateCompletionResponseChoicesInner
    -> CreateCompletionResponseChoicesInner -> Bool)
-> Eq CreateCompletionResponseChoicesInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
== :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
$c/= :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
/= :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
Eq, Eq CreateCompletionResponseChoicesInner
Eq CreateCompletionResponseChoicesInner =>
(CreateCompletionResponseChoicesInner
 -> CreateCompletionResponseChoicesInner -> Ordering)
-> (CreateCompletionResponseChoicesInner
    -> CreateCompletionResponseChoicesInner -> Bool)
-> (CreateCompletionResponseChoicesInner
    -> CreateCompletionResponseChoicesInner -> Bool)
-> (CreateCompletionResponseChoicesInner
    -> CreateCompletionResponseChoicesInner -> Bool)
-> (CreateCompletionResponseChoicesInner
    -> CreateCompletionResponseChoicesInner -> Bool)
-> (CreateCompletionResponseChoicesInner
    -> CreateCompletionResponseChoicesInner
    -> CreateCompletionResponseChoicesInner)
-> (CreateCompletionResponseChoicesInner
    -> CreateCompletionResponseChoicesInner
    -> CreateCompletionResponseChoicesInner)
-> Ord CreateCompletionResponseChoicesInner
CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Ordering
CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Ordering
compare :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Ordering
$c< :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
< :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
$c<= :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
<= :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
$c> :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
> :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
$c>= :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
>= :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner -> Bool
$cmax :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
max :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
$cmin :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
min :: CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
Ord, (forall x.
 CreateCompletionResponseChoicesInner
 -> Rep CreateCompletionResponseChoicesInner x)
-> (forall x.
    Rep CreateCompletionResponseChoicesInner x
    -> CreateCompletionResponseChoicesInner)
-> Generic CreateCompletionResponseChoicesInner
forall x.
Rep CreateCompletionResponseChoicesInner x
-> CreateCompletionResponseChoicesInner
forall x.
CreateCompletionResponseChoicesInner
-> Rep CreateCompletionResponseChoicesInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateCompletionResponseChoicesInner
-> Rep CreateCompletionResponseChoicesInner x
from :: forall x.
CreateCompletionResponseChoicesInner
-> Rep CreateCompletionResponseChoicesInner x
$cto :: forall x.
Rep CreateCompletionResponseChoicesInner x
-> CreateCompletionResponseChoicesInner
to :: forall x.
Rep CreateCompletionResponseChoicesInner x
-> CreateCompletionResponseChoicesInner
Generic, Typeable CreateCompletionResponseChoicesInner
Typeable CreateCompletionResponseChoicesInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateCompletionResponseChoicesInner
 -> c CreateCompletionResponseChoicesInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateCompletionResponseChoicesInner)
-> (CreateCompletionResponseChoicesInner -> Constr)
-> (CreateCompletionResponseChoicesInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateCompletionResponseChoicesInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateCompletionResponseChoicesInner))
-> ((forall b. Data b => b -> b)
    -> CreateCompletionResponseChoicesInner
    -> CreateCompletionResponseChoicesInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionResponseChoicesInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionResponseChoicesInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateCompletionResponseChoicesInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateCompletionResponseChoicesInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionResponseChoicesInner
    -> m CreateCompletionResponseChoicesInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionResponseChoicesInner
    -> m CreateCompletionResponseChoicesInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionResponseChoicesInner
    -> m CreateCompletionResponseChoicesInner)
-> Data CreateCompletionResponseChoicesInner
CreateCompletionResponseChoicesInner -> Constr
CreateCompletionResponseChoicesInner -> DataType
(forall b. Data b => b -> b)
-> CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInner
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInner
-> m CreateCompletionResponseChoicesInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInner
-> m CreateCompletionResponseChoicesInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateCompletionResponseChoicesInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionResponseChoicesInner
-> c CreateCompletionResponseChoicesInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionResponseChoicesInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionResponseChoicesInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionResponseChoicesInner
-> c CreateCompletionResponseChoicesInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionResponseChoicesInner
-> c CreateCompletionResponseChoicesInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateCompletionResponseChoicesInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateCompletionResponseChoicesInner
$ctoConstr :: CreateCompletionResponseChoicesInner -> Constr
toConstr :: CreateCompletionResponseChoicesInner -> Constr
$cdataTypeOf :: CreateCompletionResponseChoicesInner -> DataType
dataTypeOf :: CreateCompletionResponseChoicesInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionResponseChoicesInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionResponseChoicesInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionResponseChoicesInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionResponseChoicesInner)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
gmapT :: (forall b. Data b => b -> b)
-> CreateCompletionResponseChoicesInner
-> CreateCompletionResponseChoicesInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInner
-> m CreateCompletionResponseChoicesInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInner
-> m CreateCompletionResponseChoicesInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInner
-> m CreateCompletionResponseChoicesInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInner
-> m CreateCompletionResponseChoicesInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInner
-> m CreateCompletionResponseChoicesInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInner
-> m CreateCompletionResponseChoicesInner
Data)

instance FromJSON CreateCompletionResponseChoicesInner where
  parseJSON :: Value -> Parser CreateCompletionResponseChoicesInner
parseJSON = Options -> Value -> Parser CreateCompletionResponseChoicesInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionResponseChoicesInner")
instance ToJSON CreateCompletionResponseChoicesInner where
  toJSON :: CreateCompletionResponseChoicesInner -> Value
toJSON = Options -> CreateCompletionResponseChoicesInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionResponseChoicesInner")


-- | 
data CreateCompletionResponseChoicesInnerLogprobs = CreateCompletionResponseChoicesInnerLogprobs
  { CreateCompletionResponseChoicesInnerLogprobs -> Maybe [Int]
createCompletionResponseChoicesInnerLogprobsTextUnderscoreoffset :: Maybe [Int] -- ^ 
  , CreateCompletionResponseChoicesInnerLogprobs -> Maybe [Double]
createCompletionResponseChoicesInnerLogprobsTokenUnderscorelogprobs :: Maybe [Double] -- ^ 
  , CreateCompletionResponseChoicesInnerLogprobs -> Maybe [Text]
createCompletionResponseChoicesInnerLogprobsTokens :: Maybe [Text] -- ^ 
  , CreateCompletionResponseChoicesInnerLogprobs
-> Maybe [Map String Double]
createCompletionResponseChoicesInnerLogprobsTopUnderscorelogprobs :: Maybe [(Map.Map String Double)] -- ^ 
  } deriving (Int -> CreateCompletionResponseChoicesInnerLogprobs -> ShowS
[CreateCompletionResponseChoicesInnerLogprobs] -> ShowS
CreateCompletionResponseChoicesInnerLogprobs -> String
(Int -> CreateCompletionResponseChoicesInnerLogprobs -> ShowS)
-> (CreateCompletionResponseChoicesInnerLogprobs -> String)
-> ([CreateCompletionResponseChoicesInnerLogprobs] -> ShowS)
-> Show CreateCompletionResponseChoicesInnerLogprobs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateCompletionResponseChoicesInnerLogprobs -> ShowS
showsPrec :: Int -> CreateCompletionResponseChoicesInnerLogprobs -> ShowS
$cshow :: CreateCompletionResponseChoicesInnerLogprobs -> String
show :: CreateCompletionResponseChoicesInnerLogprobs -> String
$cshowList :: [CreateCompletionResponseChoicesInnerLogprobs] -> ShowS
showList :: [CreateCompletionResponseChoicesInnerLogprobs] -> ShowS
Show, CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
(CreateCompletionResponseChoicesInnerLogprobs
 -> CreateCompletionResponseChoicesInnerLogprobs -> Bool)
-> (CreateCompletionResponseChoicesInnerLogprobs
    -> CreateCompletionResponseChoicesInnerLogprobs -> Bool)
-> Eq CreateCompletionResponseChoicesInnerLogprobs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
== :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
$c/= :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
/= :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
Eq, Eq CreateCompletionResponseChoicesInnerLogprobs
Eq CreateCompletionResponseChoicesInnerLogprobs =>
(CreateCompletionResponseChoicesInnerLogprobs
 -> CreateCompletionResponseChoicesInnerLogprobs -> Ordering)
-> (CreateCompletionResponseChoicesInnerLogprobs
    -> CreateCompletionResponseChoicesInnerLogprobs -> Bool)
-> (CreateCompletionResponseChoicesInnerLogprobs
    -> CreateCompletionResponseChoicesInnerLogprobs -> Bool)
-> (CreateCompletionResponseChoicesInnerLogprobs
    -> CreateCompletionResponseChoicesInnerLogprobs -> Bool)
-> (CreateCompletionResponseChoicesInnerLogprobs
    -> CreateCompletionResponseChoicesInnerLogprobs -> Bool)
-> (CreateCompletionResponseChoicesInnerLogprobs
    -> CreateCompletionResponseChoicesInnerLogprobs
    -> CreateCompletionResponseChoicesInnerLogprobs)
-> (CreateCompletionResponseChoicesInnerLogprobs
    -> CreateCompletionResponseChoicesInnerLogprobs
    -> CreateCompletionResponseChoicesInnerLogprobs)
-> Ord CreateCompletionResponseChoicesInnerLogprobs
CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Ordering
CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Ordering
compare :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Ordering
$c< :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
< :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
$c<= :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
<= :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
$c> :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
> :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
$c>= :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
>= :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs -> Bool
$cmax :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
max :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
$cmin :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
min :: CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
Ord, (forall x.
 CreateCompletionResponseChoicesInnerLogprobs
 -> Rep CreateCompletionResponseChoicesInnerLogprobs x)
-> (forall x.
    Rep CreateCompletionResponseChoicesInnerLogprobs x
    -> CreateCompletionResponseChoicesInnerLogprobs)
-> Generic CreateCompletionResponseChoicesInnerLogprobs
forall x.
Rep CreateCompletionResponseChoicesInnerLogprobs x
-> CreateCompletionResponseChoicesInnerLogprobs
forall x.
CreateCompletionResponseChoicesInnerLogprobs
-> Rep CreateCompletionResponseChoicesInnerLogprobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateCompletionResponseChoicesInnerLogprobs
-> Rep CreateCompletionResponseChoicesInnerLogprobs x
from :: forall x.
CreateCompletionResponseChoicesInnerLogprobs
-> Rep CreateCompletionResponseChoicesInnerLogprobs x
$cto :: forall x.
Rep CreateCompletionResponseChoicesInnerLogprobs x
-> CreateCompletionResponseChoicesInnerLogprobs
to :: forall x.
Rep CreateCompletionResponseChoicesInnerLogprobs x
-> CreateCompletionResponseChoicesInnerLogprobs
Generic, Typeable CreateCompletionResponseChoicesInnerLogprobs
Typeable CreateCompletionResponseChoicesInnerLogprobs =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateCompletionResponseChoicesInnerLogprobs
 -> c CreateCompletionResponseChoicesInnerLogprobs)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateCompletionResponseChoicesInnerLogprobs)
-> (CreateCompletionResponseChoicesInnerLogprobs -> Constr)
-> (CreateCompletionResponseChoicesInnerLogprobs -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateCompletionResponseChoicesInnerLogprobs))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateCompletionResponseChoicesInnerLogprobs))
-> ((forall b. Data b => b -> b)
    -> CreateCompletionResponseChoicesInnerLogprobs
    -> CreateCompletionResponseChoicesInnerLogprobs)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionResponseChoicesInnerLogprobs
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateCompletionResponseChoicesInnerLogprobs
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateCompletionResponseChoicesInnerLogprobs -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateCompletionResponseChoicesInnerLogprobs
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionResponseChoicesInnerLogprobs
    -> m CreateCompletionResponseChoicesInnerLogprobs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionResponseChoicesInnerLogprobs
    -> m CreateCompletionResponseChoicesInnerLogprobs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateCompletionResponseChoicesInnerLogprobs
    -> m CreateCompletionResponseChoicesInnerLogprobs)
-> Data CreateCompletionResponseChoicesInnerLogprobs
CreateCompletionResponseChoicesInnerLogprobs -> Constr
CreateCompletionResponseChoicesInnerLogprobs -> DataType
(forall b. Data b => b -> b)
-> CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInnerLogprobs
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInnerLogprobs -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInnerLogprobs
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInnerLogprobs
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInnerLogprobs
-> m CreateCompletionResponseChoicesInnerLogprobs
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInnerLogprobs
-> m CreateCompletionResponseChoicesInnerLogprobs
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateCompletionResponseChoicesInnerLogprobs
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionResponseChoicesInnerLogprobs
-> c CreateCompletionResponseChoicesInnerLogprobs
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionResponseChoicesInnerLogprobs)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionResponseChoicesInnerLogprobs)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionResponseChoicesInnerLogprobs
-> c CreateCompletionResponseChoicesInnerLogprobs
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateCompletionResponseChoicesInnerLogprobs
-> c CreateCompletionResponseChoicesInnerLogprobs
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateCompletionResponseChoicesInnerLogprobs
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateCompletionResponseChoicesInnerLogprobs
$ctoConstr :: CreateCompletionResponseChoicesInnerLogprobs -> Constr
toConstr :: CreateCompletionResponseChoicesInnerLogprobs -> Constr
$cdataTypeOf :: CreateCompletionResponseChoicesInnerLogprobs -> DataType
dataTypeOf :: CreateCompletionResponseChoicesInnerLogprobs -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionResponseChoicesInnerLogprobs)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateCompletionResponseChoicesInnerLogprobs)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionResponseChoicesInnerLogprobs)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateCompletionResponseChoicesInnerLogprobs)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
gmapT :: (forall b. Data b => b -> b)
-> CreateCompletionResponseChoicesInnerLogprobs
-> CreateCompletionResponseChoicesInnerLogprobs
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInnerLogprobs
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInnerLogprobs
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInnerLogprobs
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateCompletionResponseChoicesInnerLogprobs
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInnerLogprobs -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInnerLogprobs -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInnerLogprobs
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateCompletionResponseChoicesInnerLogprobs
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInnerLogprobs
-> m CreateCompletionResponseChoicesInnerLogprobs
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInnerLogprobs
-> m CreateCompletionResponseChoicesInnerLogprobs
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInnerLogprobs
-> m CreateCompletionResponseChoicesInnerLogprobs
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInnerLogprobs
-> m CreateCompletionResponseChoicesInnerLogprobs
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInnerLogprobs
-> m CreateCompletionResponseChoicesInnerLogprobs
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateCompletionResponseChoicesInnerLogprobs
-> m CreateCompletionResponseChoicesInnerLogprobs
Data)

instance FromJSON CreateCompletionResponseChoicesInnerLogprobs where
  parseJSON :: Value -> Parser CreateCompletionResponseChoicesInnerLogprobs
parseJSON = Options
-> Value -> Parser CreateCompletionResponseChoicesInnerLogprobs
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionResponseChoicesInnerLogprobs")
instance ToJSON CreateCompletionResponseChoicesInnerLogprobs where
  toJSON :: CreateCompletionResponseChoicesInnerLogprobs -> Value
toJSON = Options -> CreateCompletionResponseChoicesInnerLogprobs -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createCompletionResponseChoicesInnerLogprobs")


-- | 
data CreateEmbeddingRequest = CreateEmbeddingRequest
  { CreateEmbeddingRequest -> CreateEmbeddingRequestInput
createEmbeddingRequestInput :: CreateEmbeddingRequestInput -- ^ 
  , CreateEmbeddingRequest -> CreateEmbeddingRequestModel
createEmbeddingRequestModel :: CreateEmbeddingRequestModel -- ^ 
  , CreateEmbeddingRequest -> Maybe Text
createEmbeddingRequestEncodingUnderscoreformat :: Maybe Text -- ^ The format to return the embeddings in. Can be either `float` or [`base64`](https://pypi.org/project/pybase64/).
  , CreateEmbeddingRequest -> Maybe Int
createEmbeddingRequestDimensions :: Maybe Int -- ^ The number of dimensions the resulting output embeddings should have. Only supported in `text-embedding-3` and later models. 
  , CreateEmbeddingRequest -> Maybe Text
createEmbeddingRequestUser :: Maybe Text -- ^ A unique identifier representing your end-user, which can help OpenAI to monitor and detect abuse. [Learn more](/docs/guides/safety-best-practices/end-user-ids). 
  } deriving (Int -> CreateEmbeddingRequest -> ShowS
[CreateEmbeddingRequest] -> ShowS
CreateEmbeddingRequest -> String
(Int -> CreateEmbeddingRequest -> ShowS)
-> (CreateEmbeddingRequest -> String)
-> ([CreateEmbeddingRequest] -> ShowS)
-> Show CreateEmbeddingRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateEmbeddingRequest -> ShowS
showsPrec :: Int -> CreateEmbeddingRequest -> ShowS
$cshow :: CreateEmbeddingRequest -> String
show :: CreateEmbeddingRequest -> String
$cshowList :: [CreateEmbeddingRequest] -> ShowS
showList :: [CreateEmbeddingRequest] -> ShowS
Show, CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
(CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool)
-> (CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool)
-> Eq CreateEmbeddingRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
== :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
$c/= :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
/= :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
Eq, Eq CreateEmbeddingRequest
Eq CreateEmbeddingRequest =>
(CreateEmbeddingRequest -> CreateEmbeddingRequest -> Ordering)
-> (CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool)
-> (CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool)
-> (CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool)
-> (CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool)
-> (CreateEmbeddingRequest
    -> CreateEmbeddingRequest -> CreateEmbeddingRequest)
-> (CreateEmbeddingRequest
    -> CreateEmbeddingRequest -> CreateEmbeddingRequest)
-> Ord CreateEmbeddingRequest
CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
CreateEmbeddingRequest -> CreateEmbeddingRequest -> Ordering
CreateEmbeddingRequest
-> CreateEmbeddingRequest -> CreateEmbeddingRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Ordering
compare :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Ordering
$c< :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
< :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
$c<= :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
<= :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
$c> :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
> :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
$c>= :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
>= :: CreateEmbeddingRequest -> CreateEmbeddingRequest -> Bool
$cmax :: CreateEmbeddingRequest
-> CreateEmbeddingRequest -> CreateEmbeddingRequest
max :: CreateEmbeddingRequest
-> CreateEmbeddingRequest -> CreateEmbeddingRequest
$cmin :: CreateEmbeddingRequest
-> CreateEmbeddingRequest -> CreateEmbeddingRequest
min :: CreateEmbeddingRequest
-> CreateEmbeddingRequest -> CreateEmbeddingRequest
Ord, (forall x. CreateEmbeddingRequest -> Rep CreateEmbeddingRequest x)
-> (forall x.
    Rep CreateEmbeddingRequest x -> CreateEmbeddingRequest)
-> Generic CreateEmbeddingRequest
forall x. Rep CreateEmbeddingRequest x -> CreateEmbeddingRequest
forall x. CreateEmbeddingRequest -> Rep CreateEmbeddingRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateEmbeddingRequest -> Rep CreateEmbeddingRequest x
from :: forall x. CreateEmbeddingRequest -> Rep CreateEmbeddingRequest x
$cto :: forall x. Rep CreateEmbeddingRequest x -> CreateEmbeddingRequest
to :: forall x. Rep CreateEmbeddingRequest x -> CreateEmbeddingRequest
Generic, Typeable CreateEmbeddingRequest
Typeable CreateEmbeddingRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateEmbeddingRequest
 -> c CreateEmbeddingRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequest)
-> (CreateEmbeddingRequest -> Constr)
-> (CreateEmbeddingRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateEmbeddingRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateEmbeddingRequest))
-> ((forall b. Data b => b -> b)
    -> CreateEmbeddingRequest -> CreateEmbeddingRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateEmbeddingRequest
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateEmbeddingRequest
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateEmbeddingRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CreateEmbeddingRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingRequest -> m CreateEmbeddingRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingRequest -> m CreateEmbeddingRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingRequest -> m CreateEmbeddingRequest)
-> Data CreateEmbeddingRequest
CreateEmbeddingRequest -> Constr
CreateEmbeddingRequest -> DataType
(forall b. Data b => b -> b)
-> CreateEmbeddingRequest -> CreateEmbeddingRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateEmbeddingRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequest
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequest
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequest -> m CreateEmbeddingRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequest -> m CreateEmbeddingRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingRequest
-> c CreateEmbeddingRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateEmbeddingRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingRequest
-> c CreateEmbeddingRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingRequest
-> c CreateEmbeddingRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequest
$ctoConstr :: CreateEmbeddingRequest -> Constr
toConstr :: CreateEmbeddingRequest -> Constr
$cdataTypeOf :: CreateEmbeddingRequest -> DataType
dataTypeOf :: CreateEmbeddingRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateEmbeddingRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateEmbeddingRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateEmbeddingRequest -> CreateEmbeddingRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateEmbeddingRequest -> CreateEmbeddingRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequest
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequest
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequest
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequest
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateEmbeddingRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateEmbeddingRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequest -> m CreateEmbeddingRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequest -> m CreateEmbeddingRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequest -> m CreateEmbeddingRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequest -> m CreateEmbeddingRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequest -> m CreateEmbeddingRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequest -> m CreateEmbeddingRequest
Data)

instance FromJSON CreateEmbeddingRequest where
  parseJSON :: Value -> Parser CreateEmbeddingRequest
parseJSON = Options -> Value -> Parser CreateEmbeddingRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createEmbeddingRequest")
instance ToJSON CreateEmbeddingRequest where
  toJSON :: CreateEmbeddingRequest -> Value
toJSON = Options -> CreateEmbeddingRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createEmbeddingRequest")


-- | Input text to embed, encoded as a string or array of tokens. To embed multiple inputs in a single request, pass an array of strings or array of token arrays. The input must not exceed the max input tokens for the model (8192 tokens for &#x60;text-embedding-ada-002&#x60;), cannot be an empty string, and any array must be 2048 dimensions or less. [Example Python code](https://cookbook.openai.com/examples/how_to_count_tokens_with_tiktoken) for counting tokens. 
data CreateEmbeddingRequestInput = CreateEmbeddingRequestInput
  { 
  } deriving (Int -> CreateEmbeddingRequestInput -> ShowS
[CreateEmbeddingRequestInput] -> ShowS
CreateEmbeddingRequestInput -> String
(Int -> CreateEmbeddingRequestInput -> ShowS)
-> (CreateEmbeddingRequestInput -> String)
-> ([CreateEmbeddingRequestInput] -> ShowS)
-> Show CreateEmbeddingRequestInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateEmbeddingRequestInput -> ShowS
showsPrec :: Int -> CreateEmbeddingRequestInput -> ShowS
$cshow :: CreateEmbeddingRequestInput -> String
show :: CreateEmbeddingRequestInput -> String
$cshowList :: [CreateEmbeddingRequestInput] -> ShowS
showList :: [CreateEmbeddingRequestInput] -> ShowS
Show, CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
(CreateEmbeddingRequestInput
 -> CreateEmbeddingRequestInput -> Bool)
-> (CreateEmbeddingRequestInput
    -> CreateEmbeddingRequestInput -> Bool)
-> Eq CreateEmbeddingRequestInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
== :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
$c/= :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
/= :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
Eq, Eq CreateEmbeddingRequestInput
Eq CreateEmbeddingRequestInput =>
(CreateEmbeddingRequestInput
 -> CreateEmbeddingRequestInput -> Ordering)
-> (CreateEmbeddingRequestInput
    -> CreateEmbeddingRequestInput -> Bool)
-> (CreateEmbeddingRequestInput
    -> CreateEmbeddingRequestInput -> Bool)
-> (CreateEmbeddingRequestInput
    -> CreateEmbeddingRequestInput -> Bool)
-> (CreateEmbeddingRequestInput
    -> CreateEmbeddingRequestInput -> Bool)
-> (CreateEmbeddingRequestInput
    -> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput)
-> (CreateEmbeddingRequestInput
    -> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput)
-> Ord CreateEmbeddingRequestInput
CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
CreateEmbeddingRequestInput
-> CreateEmbeddingRequestInput -> Ordering
CreateEmbeddingRequestInput
-> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateEmbeddingRequestInput
-> CreateEmbeddingRequestInput -> Ordering
compare :: CreateEmbeddingRequestInput
-> CreateEmbeddingRequestInput -> Ordering
$c< :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
< :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
$c<= :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
<= :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
$c> :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
> :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
$c>= :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
>= :: CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput -> Bool
$cmax :: CreateEmbeddingRequestInput
-> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput
max :: CreateEmbeddingRequestInput
-> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput
$cmin :: CreateEmbeddingRequestInput
-> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput
min :: CreateEmbeddingRequestInput
-> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput
Ord, (forall x.
 CreateEmbeddingRequestInput -> Rep CreateEmbeddingRequestInput x)
-> (forall x.
    Rep CreateEmbeddingRequestInput x -> CreateEmbeddingRequestInput)
-> Generic CreateEmbeddingRequestInput
forall x.
Rep CreateEmbeddingRequestInput x -> CreateEmbeddingRequestInput
forall x.
CreateEmbeddingRequestInput -> Rep CreateEmbeddingRequestInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateEmbeddingRequestInput -> Rep CreateEmbeddingRequestInput x
from :: forall x.
CreateEmbeddingRequestInput -> Rep CreateEmbeddingRequestInput x
$cto :: forall x.
Rep CreateEmbeddingRequestInput x -> CreateEmbeddingRequestInput
to :: forall x.
Rep CreateEmbeddingRequestInput x -> CreateEmbeddingRequestInput
Generic, Typeable CreateEmbeddingRequestInput
Typeable CreateEmbeddingRequestInput =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateEmbeddingRequestInput
 -> c CreateEmbeddingRequestInput)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequestInput)
-> (CreateEmbeddingRequestInput -> Constr)
-> (CreateEmbeddingRequestInput -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateEmbeddingRequestInput))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateEmbeddingRequestInput))
-> ((forall b. Data b => b -> b)
    -> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateEmbeddingRequestInput
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateEmbeddingRequestInput
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateEmbeddingRequestInput -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateEmbeddingRequestInput
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput)
-> Data CreateEmbeddingRequestInput
CreateEmbeddingRequestInput -> Constr
CreateEmbeddingRequestInput -> DataType
(forall b. Data b => b -> b)
-> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateEmbeddingRequestInput -> u
forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingRequestInput -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestInput
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestInput
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequestInput
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingRequestInput
-> c CreateEmbeddingRequestInput
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateEmbeddingRequestInput)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingRequestInput)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingRequestInput
-> c CreateEmbeddingRequestInput
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingRequestInput
-> c CreateEmbeddingRequestInput
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequestInput
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequestInput
$ctoConstr :: CreateEmbeddingRequestInput -> Constr
toConstr :: CreateEmbeddingRequestInput -> Constr
$cdataTypeOf :: CreateEmbeddingRequestInput -> DataType
dataTypeOf :: CreateEmbeddingRequestInput -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateEmbeddingRequestInput)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateEmbeddingRequestInput)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingRequestInput)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingRequestInput)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput
gmapT :: (forall b. Data b => b -> b)
-> CreateEmbeddingRequestInput -> CreateEmbeddingRequestInput
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestInput
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestInput
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestInput
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestInput
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingRequestInput -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingRequestInput -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateEmbeddingRequestInput -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateEmbeddingRequestInput -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestInput -> m CreateEmbeddingRequestInput
Data)

instance FromJSON CreateEmbeddingRequestInput where
  parseJSON :: Value -> Parser CreateEmbeddingRequestInput
parseJSON = Options -> Value -> Parser CreateEmbeddingRequestInput
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createEmbeddingRequestInput")
instance ToJSON CreateEmbeddingRequestInput where
  toJSON :: CreateEmbeddingRequestInput -> Value
toJSON = Options -> CreateEmbeddingRequestInput -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createEmbeddingRequestInput")


-- | ID of the model to use. You can use the [List models](/docs/api-reference/models/list) API to see all of your available models, or see our [Model overview](/docs/models/overview) for descriptions of them. 
data CreateEmbeddingRequestModel = CreateEmbeddingRequestModel Text  deriving (Int -> CreateEmbeddingRequestModel -> ShowS
[CreateEmbeddingRequestModel] -> ShowS
CreateEmbeddingRequestModel -> String
(Int -> CreateEmbeddingRequestModel -> ShowS)
-> (CreateEmbeddingRequestModel -> String)
-> ([CreateEmbeddingRequestModel] -> ShowS)
-> Show CreateEmbeddingRequestModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateEmbeddingRequestModel -> ShowS
showsPrec :: Int -> CreateEmbeddingRequestModel -> ShowS
$cshow :: CreateEmbeddingRequestModel -> String
show :: CreateEmbeddingRequestModel -> String
$cshowList :: [CreateEmbeddingRequestModel] -> ShowS
showList :: [CreateEmbeddingRequestModel] -> ShowS
Show, CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
(CreateEmbeddingRequestModel
 -> CreateEmbeddingRequestModel -> Bool)
-> (CreateEmbeddingRequestModel
    -> CreateEmbeddingRequestModel -> Bool)
-> Eq CreateEmbeddingRequestModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
== :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
$c/= :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
/= :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
Eq, Eq CreateEmbeddingRequestModel
Eq CreateEmbeddingRequestModel =>
(CreateEmbeddingRequestModel
 -> CreateEmbeddingRequestModel -> Ordering)
-> (CreateEmbeddingRequestModel
    -> CreateEmbeddingRequestModel -> Bool)
-> (CreateEmbeddingRequestModel
    -> CreateEmbeddingRequestModel -> Bool)
-> (CreateEmbeddingRequestModel
    -> CreateEmbeddingRequestModel -> Bool)
-> (CreateEmbeddingRequestModel
    -> CreateEmbeddingRequestModel -> Bool)
-> (CreateEmbeddingRequestModel
    -> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel)
-> (CreateEmbeddingRequestModel
    -> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel)
-> Ord CreateEmbeddingRequestModel
CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
CreateEmbeddingRequestModel
-> CreateEmbeddingRequestModel -> Ordering
CreateEmbeddingRequestModel
-> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateEmbeddingRequestModel
-> CreateEmbeddingRequestModel -> Ordering
compare :: CreateEmbeddingRequestModel
-> CreateEmbeddingRequestModel -> Ordering
$c< :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
< :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
$c<= :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
<= :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
$c> :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
> :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
$c>= :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
>= :: CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel -> Bool
$cmax :: CreateEmbeddingRequestModel
-> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel
max :: CreateEmbeddingRequestModel
-> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel
$cmin :: CreateEmbeddingRequestModel
-> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel
min :: CreateEmbeddingRequestModel
-> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel
Ord, (forall x.
 CreateEmbeddingRequestModel -> Rep CreateEmbeddingRequestModel x)
-> (forall x.
    Rep CreateEmbeddingRequestModel x -> CreateEmbeddingRequestModel)
-> Generic CreateEmbeddingRequestModel
forall x.
Rep CreateEmbeddingRequestModel x -> CreateEmbeddingRequestModel
forall x.
CreateEmbeddingRequestModel -> Rep CreateEmbeddingRequestModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateEmbeddingRequestModel -> Rep CreateEmbeddingRequestModel x
from :: forall x.
CreateEmbeddingRequestModel -> Rep CreateEmbeddingRequestModel x
$cto :: forall x.
Rep CreateEmbeddingRequestModel x -> CreateEmbeddingRequestModel
to :: forall x.
Rep CreateEmbeddingRequestModel x -> CreateEmbeddingRequestModel
Generic, Typeable CreateEmbeddingRequestModel
Typeable CreateEmbeddingRequestModel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateEmbeddingRequestModel
 -> c CreateEmbeddingRequestModel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequestModel)
-> (CreateEmbeddingRequestModel -> Constr)
-> (CreateEmbeddingRequestModel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateEmbeddingRequestModel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateEmbeddingRequestModel))
-> ((forall b. Data b => b -> b)
    -> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateEmbeddingRequestModel
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateEmbeddingRequestModel
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateEmbeddingRequestModel -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateEmbeddingRequestModel
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel)
-> Data CreateEmbeddingRequestModel
CreateEmbeddingRequestModel -> Constr
CreateEmbeddingRequestModel -> DataType
(forall b. Data b => b -> b)
-> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateEmbeddingRequestModel -> u
forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingRequestModel -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestModel
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestModel
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequestModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingRequestModel
-> c CreateEmbeddingRequestModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateEmbeddingRequestModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingRequestModel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingRequestModel
-> c CreateEmbeddingRequestModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingRequestModel
-> c CreateEmbeddingRequestModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequestModel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingRequestModel
$ctoConstr :: CreateEmbeddingRequestModel -> Constr
toConstr :: CreateEmbeddingRequestModel -> Constr
$cdataTypeOf :: CreateEmbeddingRequestModel -> DataType
dataTypeOf :: CreateEmbeddingRequestModel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateEmbeddingRequestModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateEmbeddingRequestModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingRequestModel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingRequestModel)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel
gmapT :: (forall b. Data b => b -> b)
-> CreateEmbeddingRequestModel -> CreateEmbeddingRequestModel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestModel
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestModel
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestModel
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingRequestModel
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingRequestModel -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingRequestModel -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateEmbeddingRequestModel -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateEmbeddingRequestModel -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingRequestModel -> m CreateEmbeddingRequestModel
Data)

instance FromJSON CreateEmbeddingRequestModel where
  parseJSON :: Value -> Parser CreateEmbeddingRequestModel
parseJSON = Options -> Value -> Parser CreateEmbeddingRequestModel
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createEmbeddingRequestModel")
instance ToJSON CreateEmbeddingRequestModel where
  toJSON :: CreateEmbeddingRequestModel -> Value
toJSON = Options -> CreateEmbeddingRequestModel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createEmbeddingRequestModel")


-- | 
data CreateEmbeddingResponse = CreateEmbeddingResponse
  { CreateEmbeddingResponse -> [Embedding]
createEmbeddingResponseData :: [Embedding] -- ^ The list of embeddings generated by the model.
  , CreateEmbeddingResponse -> Text
createEmbeddingResponseModel :: Text -- ^ The name of the model used to generate the embedding.
  , CreateEmbeddingResponse -> Text
createEmbeddingResponseObject :: Text -- ^ The object type, which is always \"list\".
  , CreateEmbeddingResponse -> CreateEmbeddingResponseUsage
createEmbeddingResponseUsage :: CreateEmbeddingResponseUsage -- ^ 
  } deriving (Int -> CreateEmbeddingResponse -> ShowS
[CreateEmbeddingResponse] -> ShowS
CreateEmbeddingResponse -> String
(Int -> CreateEmbeddingResponse -> ShowS)
-> (CreateEmbeddingResponse -> String)
-> ([CreateEmbeddingResponse] -> ShowS)
-> Show CreateEmbeddingResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateEmbeddingResponse -> ShowS
showsPrec :: Int -> CreateEmbeddingResponse -> ShowS
$cshow :: CreateEmbeddingResponse -> String
show :: CreateEmbeddingResponse -> String
$cshowList :: [CreateEmbeddingResponse] -> ShowS
showList :: [CreateEmbeddingResponse] -> ShowS
Show, CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
(CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool)
-> (CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool)
-> Eq CreateEmbeddingResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
== :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
$c/= :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
/= :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
Eq, Eq CreateEmbeddingResponse
Eq CreateEmbeddingResponse =>
(CreateEmbeddingResponse -> CreateEmbeddingResponse -> Ordering)
-> (CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool)
-> (CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool)
-> (CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool)
-> (CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool)
-> (CreateEmbeddingResponse
    -> CreateEmbeddingResponse -> CreateEmbeddingResponse)
-> (CreateEmbeddingResponse
    -> CreateEmbeddingResponse -> CreateEmbeddingResponse)
-> Ord CreateEmbeddingResponse
CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
CreateEmbeddingResponse -> CreateEmbeddingResponse -> Ordering
CreateEmbeddingResponse
-> CreateEmbeddingResponse -> CreateEmbeddingResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Ordering
compare :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Ordering
$c< :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
< :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
$c<= :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
<= :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
$c> :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
> :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
$c>= :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
>= :: CreateEmbeddingResponse -> CreateEmbeddingResponse -> Bool
$cmax :: CreateEmbeddingResponse
-> CreateEmbeddingResponse -> CreateEmbeddingResponse
max :: CreateEmbeddingResponse
-> CreateEmbeddingResponse -> CreateEmbeddingResponse
$cmin :: CreateEmbeddingResponse
-> CreateEmbeddingResponse -> CreateEmbeddingResponse
min :: CreateEmbeddingResponse
-> CreateEmbeddingResponse -> CreateEmbeddingResponse
Ord, (forall x.
 CreateEmbeddingResponse -> Rep CreateEmbeddingResponse x)
-> (forall x.
    Rep CreateEmbeddingResponse x -> CreateEmbeddingResponse)
-> Generic CreateEmbeddingResponse
forall x. Rep CreateEmbeddingResponse x -> CreateEmbeddingResponse
forall x. CreateEmbeddingResponse -> Rep CreateEmbeddingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateEmbeddingResponse -> Rep CreateEmbeddingResponse x
from :: forall x. CreateEmbeddingResponse -> Rep CreateEmbeddingResponse x
$cto :: forall x. Rep CreateEmbeddingResponse x -> CreateEmbeddingResponse
to :: forall x. Rep CreateEmbeddingResponse x -> CreateEmbeddingResponse
Generic, Typeable CreateEmbeddingResponse
Typeable CreateEmbeddingResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateEmbeddingResponse
 -> c CreateEmbeddingResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateEmbeddingResponse)
-> (CreateEmbeddingResponse -> Constr)
-> (CreateEmbeddingResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateEmbeddingResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateEmbeddingResponse))
-> ((forall b. Data b => b -> b)
    -> CreateEmbeddingResponse -> CreateEmbeddingResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateEmbeddingResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateEmbeddingResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateEmbeddingResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> CreateEmbeddingResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingResponse -> m CreateEmbeddingResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingResponse -> m CreateEmbeddingResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingResponse -> m CreateEmbeddingResponse)
-> Data CreateEmbeddingResponse
CreateEmbeddingResponse -> Constr
CreateEmbeddingResponse -> DataType
(forall b. Data b => b -> b)
-> CreateEmbeddingResponse -> CreateEmbeddingResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateEmbeddingResponse -> u
forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponse -> m CreateEmbeddingResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponse -> m CreateEmbeddingResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingResponse
-> c CreateEmbeddingResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateEmbeddingResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingResponse
-> c CreateEmbeddingResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingResponse
-> c CreateEmbeddingResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingResponse
$ctoConstr :: CreateEmbeddingResponse -> Constr
toConstr :: CreateEmbeddingResponse -> Constr
$cdataTypeOf :: CreateEmbeddingResponse -> DataType
dataTypeOf :: CreateEmbeddingResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateEmbeddingResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateEmbeddingResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateEmbeddingResponse -> CreateEmbeddingResponse
gmapT :: (forall b. Data b => b -> b)
-> CreateEmbeddingResponse -> CreateEmbeddingResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateEmbeddingResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateEmbeddingResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponse -> m CreateEmbeddingResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponse -> m CreateEmbeddingResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponse -> m CreateEmbeddingResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponse -> m CreateEmbeddingResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponse -> m CreateEmbeddingResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponse -> m CreateEmbeddingResponse
Data)

instance FromJSON CreateEmbeddingResponse where
  parseJSON :: Value -> Parser CreateEmbeddingResponse
parseJSON = Options -> Value -> Parser CreateEmbeddingResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createEmbeddingResponse")
instance ToJSON CreateEmbeddingResponse where
  toJSON :: CreateEmbeddingResponse -> Value
toJSON = Options -> CreateEmbeddingResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createEmbeddingResponse")


-- | The usage information for the request.
data CreateEmbeddingResponseUsage = CreateEmbeddingResponseUsage
  { CreateEmbeddingResponseUsage -> Int
createEmbeddingResponseUsagePromptUnderscoretokens :: Int -- ^ The number of tokens used by the prompt.
  , CreateEmbeddingResponseUsage -> Int
createEmbeddingResponseUsageTotalUnderscoretokens :: Int -- ^ The total number of tokens used by the request.
  } deriving (Int -> CreateEmbeddingResponseUsage -> ShowS
[CreateEmbeddingResponseUsage] -> ShowS
CreateEmbeddingResponseUsage -> String
(Int -> CreateEmbeddingResponseUsage -> ShowS)
-> (CreateEmbeddingResponseUsage -> String)
-> ([CreateEmbeddingResponseUsage] -> ShowS)
-> Show CreateEmbeddingResponseUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateEmbeddingResponseUsage -> ShowS
showsPrec :: Int -> CreateEmbeddingResponseUsage -> ShowS
$cshow :: CreateEmbeddingResponseUsage -> String
show :: CreateEmbeddingResponseUsage -> String
$cshowList :: [CreateEmbeddingResponseUsage] -> ShowS
showList :: [CreateEmbeddingResponseUsage] -> ShowS
Show, CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
(CreateEmbeddingResponseUsage
 -> CreateEmbeddingResponseUsage -> Bool)
-> (CreateEmbeddingResponseUsage
    -> CreateEmbeddingResponseUsage -> Bool)
-> Eq CreateEmbeddingResponseUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
== :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
$c/= :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
/= :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
Eq, Eq CreateEmbeddingResponseUsage
Eq CreateEmbeddingResponseUsage =>
(CreateEmbeddingResponseUsage
 -> CreateEmbeddingResponseUsage -> Ordering)
-> (CreateEmbeddingResponseUsage
    -> CreateEmbeddingResponseUsage -> Bool)
-> (CreateEmbeddingResponseUsage
    -> CreateEmbeddingResponseUsage -> Bool)
-> (CreateEmbeddingResponseUsage
    -> CreateEmbeddingResponseUsage -> Bool)
-> (CreateEmbeddingResponseUsage
    -> CreateEmbeddingResponseUsage -> Bool)
-> (CreateEmbeddingResponseUsage
    -> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage)
-> (CreateEmbeddingResponseUsage
    -> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage)
-> Ord CreateEmbeddingResponseUsage
CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Ordering
CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Ordering
compare :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Ordering
$c< :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
< :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
$c<= :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
<= :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
$c> :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
> :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
$c>= :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
>= :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> Bool
$cmax :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage
max :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage
$cmin :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage
min :: CreateEmbeddingResponseUsage
-> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage
Ord, (forall x.
 CreateEmbeddingResponseUsage -> Rep CreateEmbeddingResponseUsage x)
-> (forall x.
    Rep CreateEmbeddingResponseUsage x -> CreateEmbeddingResponseUsage)
-> Generic CreateEmbeddingResponseUsage
forall x.
Rep CreateEmbeddingResponseUsage x -> CreateEmbeddingResponseUsage
forall x.
CreateEmbeddingResponseUsage -> Rep CreateEmbeddingResponseUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateEmbeddingResponseUsage -> Rep CreateEmbeddingResponseUsage x
from :: forall x.
CreateEmbeddingResponseUsage -> Rep CreateEmbeddingResponseUsage x
$cto :: forall x.
Rep CreateEmbeddingResponseUsage x -> CreateEmbeddingResponseUsage
to :: forall x.
Rep CreateEmbeddingResponseUsage x -> CreateEmbeddingResponseUsage
Generic, Typeable CreateEmbeddingResponseUsage
Typeable CreateEmbeddingResponseUsage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateEmbeddingResponseUsage
 -> c CreateEmbeddingResponseUsage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateEmbeddingResponseUsage)
-> (CreateEmbeddingResponseUsage -> Constr)
-> (CreateEmbeddingResponseUsage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateEmbeddingResponseUsage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateEmbeddingResponseUsage))
-> ((forall b. Data b => b -> b)
    -> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateEmbeddingResponseUsage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateEmbeddingResponseUsage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateEmbeddingResponseUsage -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateEmbeddingResponseUsage
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage)
-> Data CreateEmbeddingResponseUsage
CreateEmbeddingResponseUsage -> Constr
CreateEmbeddingResponseUsage -> DataType
(forall b. Data b => b -> b)
-> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateEmbeddingResponseUsage
-> u
forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingResponseUsage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponseUsage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponseUsage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingResponseUsage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingResponseUsage
-> c CreateEmbeddingResponseUsage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateEmbeddingResponseUsage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingResponseUsage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingResponseUsage
-> c CreateEmbeddingResponseUsage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateEmbeddingResponseUsage
-> c CreateEmbeddingResponseUsage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingResponseUsage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateEmbeddingResponseUsage
$ctoConstr :: CreateEmbeddingResponseUsage -> Constr
toConstr :: CreateEmbeddingResponseUsage -> Constr
$cdataTypeOf :: CreateEmbeddingResponseUsage -> DataType
dataTypeOf :: CreateEmbeddingResponseUsage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateEmbeddingResponseUsage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateEmbeddingResponseUsage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingResponseUsage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateEmbeddingResponseUsage)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage
gmapT :: (forall b. Data b => b -> b)
-> CreateEmbeddingResponseUsage -> CreateEmbeddingResponseUsage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponseUsage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponseUsage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponseUsage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateEmbeddingResponseUsage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingResponseUsage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateEmbeddingResponseUsage -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateEmbeddingResponseUsage
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateEmbeddingResponseUsage
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateEmbeddingResponseUsage -> m CreateEmbeddingResponseUsage
Data)

instance FromJSON CreateEmbeddingResponseUsage where
  parseJSON :: Value -> Parser CreateEmbeddingResponseUsage
parseJSON = Options -> Value -> Parser CreateEmbeddingResponseUsage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createEmbeddingResponseUsage")
instance ToJSON CreateEmbeddingResponseUsage where
  toJSON :: CreateEmbeddingResponseUsage -> Value
toJSON = Options -> CreateEmbeddingResponseUsage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createEmbeddingResponseUsage")


-- | 
data CreateFineTuningJobRequest = CreateFineTuningJobRequest
  { CreateFineTuningJobRequest -> CreateFineTuningJobRequestModel
createFineTuningJobRequestModel :: CreateFineTuningJobRequestModel -- ^ 
  , CreateFineTuningJobRequest -> Text
createFineTuningJobRequestTrainingUnderscorefile :: Text -- ^ The ID of an uploaded file that contains training data.  See [upload file](/docs/api-reference/files/upload) for how to upload a file.  Your dataset must be formatted as a JSONL file. Additionally, you must upload your file with the purpose `fine-tune`.  See the [fine-tuning guide](/docs/guides/fine-tuning) for more details. 
  , CreateFineTuningJobRequest
-> Maybe CreateFineTuningJobRequestHyperparameters
createFineTuningJobRequestHyperparameters :: Maybe CreateFineTuningJobRequestHyperparameters -- ^ 
  , CreateFineTuningJobRequest -> Maybe Text
createFineTuningJobRequestSuffix :: Maybe Text -- ^ A string of up to 18 characters that will be added to your fine-tuned model name.  For example, a `suffix` of \"custom-model-name\" would produce a model name like `ft:gpt-3.5-turbo:openai:custom-model-name:7p4lURel`. 
  , CreateFineTuningJobRequest -> Maybe Text
createFineTuningJobRequestValidationUnderscorefile :: Maybe Text -- ^ The ID of an uploaded file that contains validation data.  If you provide this file, the data is used to generate validation metrics periodically during fine-tuning. These metrics can be viewed in the fine-tuning results file. The same data should not be present in both train and validation files.  Your dataset must be formatted as a JSONL file. You must upload your file with the purpose `fine-tune`.  See the [fine-tuning guide](/docs/guides/fine-tuning) for more details. 
  } deriving (Int -> CreateFineTuningJobRequest -> ShowS
[CreateFineTuningJobRequest] -> ShowS
CreateFineTuningJobRequest -> String
(Int -> CreateFineTuningJobRequest -> ShowS)
-> (CreateFineTuningJobRequest -> String)
-> ([CreateFineTuningJobRequest] -> ShowS)
-> Show CreateFineTuningJobRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateFineTuningJobRequest -> ShowS
showsPrec :: Int -> CreateFineTuningJobRequest -> ShowS
$cshow :: CreateFineTuningJobRequest -> String
show :: CreateFineTuningJobRequest -> String
$cshowList :: [CreateFineTuningJobRequest] -> ShowS
showList :: [CreateFineTuningJobRequest] -> ShowS
Show, CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
(CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool)
-> (CreateFineTuningJobRequest
    -> CreateFineTuningJobRequest -> Bool)
-> Eq CreateFineTuningJobRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
== :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
$c/= :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
/= :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
Eq, Eq CreateFineTuningJobRequest
Eq CreateFineTuningJobRequest =>
(CreateFineTuningJobRequest
 -> CreateFineTuningJobRequest -> Ordering)
-> (CreateFineTuningJobRequest
    -> CreateFineTuningJobRequest -> Bool)
-> (CreateFineTuningJobRequest
    -> CreateFineTuningJobRequest -> Bool)
-> (CreateFineTuningJobRequest
    -> CreateFineTuningJobRequest -> Bool)
-> (CreateFineTuningJobRequest
    -> CreateFineTuningJobRequest -> Bool)
-> (CreateFineTuningJobRequest
    -> CreateFineTuningJobRequest -> CreateFineTuningJobRequest)
-> (CreateFineTuningJobRequest
    -> CreateFineTuningJobRequest -> CreateFineTuningJobRequest)
-> Ord CreateFineTuningJobRequest
CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
CreateFineTuningJobRequest
-> CreateFineTuningJobRequest -> Ordering
CreateFineTuningJobRequest
-> CreateFineTuningJobRequest -> CreateFineTuningJobRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateFineTuningJobRequest
-> CreateFineTuningJobRequest -> Ordering
compare :: CreateFineTuningJobRequest
-> CreateFineTuningJobRequest -> Ordering
$c< :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
< :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
$c<= :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
<= :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
$c> :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
> :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
$c>= :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
>= :: CreateFineTuningJobRequest -> CreateFineTuningJobRequest -> Bool
$cmax :: CreateFineTuningJobRequest
-> CreateFineTuningJobRequest -> CreateFineTuningJobRequest
max :: CreateFineTuningJobRequest
-> CreateFineTuningJobRequest -> CreateFineTuningJobRequest
$cmin :: CreateFineTuningJobRequest
-> CreateFineTuningJobRequest -> CreateFineTuningJobRequest
min :: CreateFineTuningJobRequest
-> CreateFineTuningJobRequest -> CreateFineTuningJobRequest
Ord, (forall x.
 CreateFineTuningJobRequest -> Rep CreateFineTuningJobRequest x)
-> (forall x.
    Rep CreateFineTuningJobRequest x -> CreateFineTuningJobRequest)
-> Generic CreateFineTuningJobRequest
forall x.
Rep CreateFineTuningJobRequest x -> CreateFineTuningJobRequest
forall x.
CreateFineTuningJobRequest -> Rep CreateFineTuningJobRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateFineTuningJobRequest -> Rep CreateFineTuningJobRequest x
from :: forall x.
CreateFineTuningJobRequest -> Rep CreateFineTuningJobRequest x
$cto :: forall x.
Rep CreateFineTuningJobRequest x -> CreateFineTuningJobRequest
to :: forall x.
Rep CreateFineTuningJobRequest x -> CreateFineTuningJobRequest
Generic, Typeable CreateFineTuningJobRequest
Typeable CreateFineTuningJobRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateFineTuningJobRequest
 -> c CreateFineTuningJobRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateFineTuningJobRequest)
-> (CreateFineTuningJobRequest -> Constr)
-> (CreateFineTuningJobRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateFineTuningJobRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateFineTuningJobRequest))
-> ((forall b. Data b => b -> b)
    -> CreateFineTuningJobRequest -> CreateFineTuningJobRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequest
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequest
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateFineTuningJobRequest -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> CreateFineTuningJobRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest)
-> Data CreateFineTuningJobRequest
CreateFineTuningJobRequest -> Constr
CreateFineTuningJobRequest -> DataType
(forall b. Data b => b -> b)
-> CreateFineTuningJobRequest -> CreateFineTuningJobRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateFineTuningJobRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateFineTuningJobRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequest
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequest
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateFineTuningJobRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequest
-> c CreateFineTuningJobRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequest
-> c CreateFineTuningJobRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequest
-> c CreateFineTuningJobRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateFineTuningJobRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateFineTuningJobRequest
$ctoConstr :: CreateFineTuningJobRequest -> Constr
toConstr :: CreateFineTuningJobRequest -> Constr
$cdataTypeOf :: CreateFineTuningJobRequest -> DataType
dataTypeOf :: CreateFineTuningJobRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequest -> CreateFineTuningJobRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequest -> CreateFineTuningJobRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequest
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequest
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequest
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequest
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateFineTuningJobRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateFineTuningJobRequest -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateFineTuningJobRequest -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateFineTuningJobRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequest -> m CreateFineTuningJobRequest
Data)

instance FromJSON CreateFineTuningJobRequest where
  parseJSON :: Value -> Parser CreateFineTuningJobRequest
parseJSON = Options -> Value -> Parser CreateFineTuningJobRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequest")
instance ToJSON CreateFineTuningJobRequest where
  toJSON :: CreateFineTuningJobRequest -> Value
toJSON = Options -> CreateFineTuningJobRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequest")


-- | The hyperparameters used for the fine-tuning job.
data CreateFineTuningJobRequestHyperparameters = CreateFineTuningJobRequestHyperparameters
  { CreateFineTuningJobRequestHyperparameters
-> Maybe CreateFineTuningJobRequestHyperparametersBatchSize
createFineTuningJobRequestHyperparametersBatchUnderscoresize :: Maybe CreateFineTuningJobRequestHyperparametersBatchSize -- ^ 
  , CreateFineTuningJobRequestHyperparameters
-> Maybe
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
createFineTuningJobRequestHyperparametersLearningUnderscorerateUnderscoremultiplier :: Maybe CreateFineTuningJobRequestHyperparametersLearningRateMultiplier -- ^ 
  , CreateFineTuningJobRequestHyperparameters
-> Maybe CreateFineTuningJobRequestHyperparametersNEpochs
createFineTuningJobRequestHyperparametersNUnderscoreepochs :: Maybe CreateFineTuningJobRequestHyperparametersNEpochs -- ^ 
  } deriving (Int -> CreateFineTuningJobRequestHyperparameters -> ShowS
[CreateFineTuningJobRequestHyperparameters] -> ShowS
CreateFineTuningJobRequestHyperparameters -> String
(Int -> CreateFineTuningJobRequestHyperparameters -> ShowS)
-> (CreateFineTuningJobRequestHyperparameters -> String)
-> ([CreateFineTuningJobRequestHyperparameters] -> ShowS)
-> Show CreateFineTuningJobRequestHyperparameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateFineTuningJobRequestHyperparameters -> ShowS
showsPrec :: Int -> CreateFineTuningJobRequestHyperparameters -> ShowS
$cshow :: CreateFineTuningJobRequestHyperparameters -> String
show :: CreateFineTuningJobRequestHyperparameters -> String
$cshowList :: [CreateFineTuningJobRequestHyperparameters] -> ShowS
showList :: [CreateFineTuningJobRequestHyperparameters] -> ShowS
Show, CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
(CreateFineTuningJobRequestHyperparameters
 -> CreateFineTuningJobRequestHyperparameters -> Bool)
-> (CreateFineTuningJobRequestHyperparameters
    -> CreateFineTuningJobRequestHyperparameters -> Bool)
-> Eq CreateFineTuningJobRequestHyperparameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
== :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
$c/= :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
/= :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
Eq, Eq CreateFineTuningJobRequestHyperparameters
Eq CreateFineTuningJobRequestHyperparameters =>
(CreateFineTuningJobRequestHyperparameters
 -> CreateFineTuningJobRequestHyperparameters -> Ordering)
-> (CreateFineTuningJobRequestHyperparameters
    -> CreateFineTuningJobRequestHyperparameters -> Bool)
-> (CreateFineTuningJobRequestHyperparameters
    -> CreateFineTuningJobRequestHyperparameters -> Bool)
-> (CreateFineTuningJobRequestHyperparameters
    -> CreateFineTuningJobRequestHyperparameters -> Bool)
-> (CreateFineTuningJobRequestHyperparameters
    -> CreateFineTuningJobRequestHyperparameters -> Bool)
-> (CreateFineTuningJobRequestHyperparameters
    -> CreateFineTuningJobRequestHyperparameters
    -> CreateFineTuningJobRequestHyperparameters)
-> (CreateFineTuningJobRequestHyperparameters
    -> CreateFineTuningJobRequestHyperparameters
    -> CreateFineTuningJobRequestHyperparameters)
-> Ord CreateFineTuningJobRequestHyperparameters
CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Ordering
CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Ordering
compare :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Ordering
$c< :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
< :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
$c<= :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
<= :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
$c> :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
> :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
$c>= :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
>= :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters -> Bool
$cmax :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
max :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
$cmin :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
min :: CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
Ord, (forall x.
 CreateFineTuningJobRequestHyperparameters
 -> Rep CreateFineTuningJobRequestHyperparameters x)
-> (forall x.
    Rep CreateFineTuningJobRequestHyperparameters x
    -> CreateFineTuningJobRequestHyperparameters)
-> Generic CreateFineTuningJobRequestHyperparameters
forall x.
Rep CreateFineTuningJobRequestHyperparameters x
-> CreateFineTuningJobRequestHyperparameters
forall x.
CreateFineTuningJobRequestHyperparameters
-> Rep CreateFineTuningJobRequestHyperparameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateFineTuningJobRequestHyperparameters
-> Rep CreateFineTuningJobRequestHyperparameters x
from :: forall x.
CreateFineTuningJobRequestHyperparameters
-> Rep CreateFineTuningJobRequestHyperparameters x
$cto :: forall x.
Rep CreateFineTuningJobRequestHyperparameters x
-> CreateFineTuningJobRequestHyperparameters
to :: forall x.
Rep CreateFineTuningJobRequestHyperparameters x
-> CreateFineTuningJobRequestHyperparameters
Generic, Typeable CreateFineTuningJobRequestHyperparameters
Typeable CreateFineTuningJobRequestHyperparameters =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateFineTuningJobRequestHyperparameters
 -> c CreateFineTuningJobRequestHyperparameters)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateFineTuningJobRequestHyperparameters)
-> (CreateFineTuningJobRequestHyperparameters -> Constr)
-> (CreateFineTuningJobRequestHyperparameters -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateFineTuningJobRequestHyperparameters))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateFineTuningJobRequestHyperparameters))
-> ((forall b. Data b => b -> b)
    -> CreateFineTuningJobRequestHyperparameters
    -> CreateFineTuningJobRequestHyperparameters)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequestHyperparameters
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequestHyperparameters
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateFineTuningJobRequestHyperparameters -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateFineTuningJobRequestHyperparameters
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparameters
    -> m CreateFineTuningJobRequestHyperparameters)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparameters
    -> m CreateFineTuningJobRequestHyperparameters)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparameters
    -> m CreateFineTuningJobRequestHyperparameters)
-> Data CreateFineTuningJobRequestHyperparameters
CreateFineTuningJobRequestHyperparameters -> Constr
CreateFineTuningJobRequestHyperparameters -> DataType
(forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparameters
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparameters -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparameters
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparameters
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparameters
-> m CreateFineTuningJobRequestHyperparameters
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparameters
-> m CreateFineTuningJobRequestHyperparameters
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparameters
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparameters
-> c CreateFineTuningJobRequestHyperparameters
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestHyperparameters)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestHyperparameters)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparameters
-> c CreateFineTuningJobRequestHyperparameters
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparameters
-> c CreateFineTuningJobRequestHyperparameters
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparameters
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparameters
$ctoConstr :: CreateFineTuningJobRequestHyperparameters -> Constr
toConstr :: CreateFineTuningJobRequestHyperparameters -> Constr
$cdataTypeOf :: CreateFineTuningJobRequestHyperparameters -> DataType
dataTypeOf :: CreateFineTuningJobRequestHyperparameters -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestHyperparameters)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestHyperparameters)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestHyperparameters)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestHyperparameters)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
gmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparameters
-> CreateFineTuningJobRequestHyperparameters
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparameters
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparameters
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparameters
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparameters
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparameters -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparameters -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparameters
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparameters
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparameters
-> m CreateFineTuningJobRequestHyperparameters
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparameters
-> m CreateFineTuningJobRequestHyperparameters
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparameters
-> m CreateFineTuningJobRequestHyperparameters
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparameters
-> m CreateFineTuningJobRequestHyperparameters
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparameters
-> m CreateFineTuningJobRequestHyperparameters
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparameters
-> m CreateFineTuningJobRequestHyperparameters
Data)

instance FromJSON CreateFineTuningJobRequestHyperparameters where
  parseJSON :: Value -> Parser CreateFineTuningJobRequestHyperparameters
parseJSON = Options
-> Value -> Parser CreateFineTuningJobRequestHyperparameters
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequestHyperparameters")
instance ToJSON CreateFineTuningJobRequestHyperparameters where
  toJSON :: CreateFineTuningJobRequestHyperparameters -> Value
toJSON = Options -> CreateFineTuningJobRequestHyperparameters -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequestHyperparameters")


-- | Number of examples in each batch. A larger batch size means that model parameters are updated less frequently, but with lower variance. 
data CreateFineTuningJobRequestHyperparametersBatchSize = CreateFineTuningJobRequestHyperparametersBatchSize
  { 
  } deriving (Int -> CreateFineTuningJobRequestHyperparametersBatchSize -> ShowS
[CreateFineTuningJobRequestHyperparametersBatchSize] -> ShowS
CreateFineTuningJobRequestHyperparametersBatchSize -> String
(Int
 -> CreateFineTuningJobRequestHyperparametersBatchSize -> ShowS)
-> (CreateFineTuningJobRequestHyperparametersBatchSize -> String)
-> ([CreateFineTuningJobRequestHyperparametersBatchSize] -> ShowS)
-> Show CreateFineTuningJobRequestHyperparametersBatchSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateFineTuningJobRequestHyperparametersBatchSize -> ShowS
showsPrec :: Int -> CreateFineTuningJobRequestHyperparametersBatchSize -> ShowS
$cshow :: CreateFineTuningJobRequestHyperparametersBatchSize -> String
show :: CreateFineTuningJobRequestHyperparametersBatchSize -> String
$cshowList :: [CreateFineTuningJobRequestHyperparametersBatchSize] -> ShowS
showList :: [CreateFineTuningJobRequestHyperparametersBatchSize] -> ShowS
Show, CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
(CreateFineTuningJobRequestHyperparametersBatchSize
 -> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool)
-> (CreateFineTuningJobRequestHyperparametersBatchSize
    -> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool)
-> Eq CreateFineTuningJobRequestHyperparametersBatchSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
== :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
$c/= :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
/= :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
Eq, Eq CreateFineTuningJobRequestHyperparametersBatchSize
Eq CreateFineTuningJobRequestHyperparametersBatchSize =>
(CreateFineTuningJobRequestHyperparametersBatchSize
 -> CreateFineTuningJobRequestHyperparametersBatchSize -> Ordering)
-> (CreateFineTuningJobRequestHyperparametersBatchSize
    -> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool)
-> (CreateFineTuningJobRequestHyperparametersBatchSize
    -> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool)
-> (CreateFineTuningJobRequestHyperparametersBatchSize
    -> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool)
-> (CreateFineTuningJobRequestHyperparametersBatchSize
    -> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool)
-> (CreateFineTuningJobRequestHyperparametersBatchSize
    -> CreateFineTuningJobRequestHyperparametersBatchSize
    -> CreateFineTuningJobRequestHyperparametersBatchSize)
-> (CreateFineTuningJobRequestHyperparametersBatchSize
    -> CreateFineTuningJobRequestHyperparametersBatchSize
    -> CreateFineTuningJobRequestHyperparametersBatchSize)
-> Ord CreateFineTuningJobRequestHyperparametersBatchSize
CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Ordering
CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Ordering
compare :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Ordering
$c< :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
< :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
$c<= :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
<= :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
$c> :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
> :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
$c>= :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
>= :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Bool
$cmax :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
max :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
$cmin :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
min :: CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
Ord, (forall x.
 CreateFineTuningJobRequestHyperparametersBatchSize
 -> Rep CreateFineTuningJobRequestHyperparametersBatchSize x)
-> (forall x.
    Rep CreateFineTuningJobRequestHyperparametersBatchSize x
    -> CreateFineTuningJobRequestHyperparametersBatchSize)
-> Generic CreateFineTuningJobRequestHyperparametersBatchSize
forall x.
Rep CreateFineTuningJobRequestHyperparametersBatchSize x
-> CreateFineTuningJobRequestHyperparametersBatchSize
forall x.
CreateFineTuningJobRequestHyperparametersBatchSize
-> Rep CreateFineTuningJobRequestHyperparametersBatchSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateFineTuningJobRequestHyperparametersBatchSize
-> Rep CreateFineTuningJobRequestHyperparametersBatchSize x
from :: forall x.
CreateFineTuningJobRequestHyperparametersBatchSize
-> Rep CreateFineTuningJobRequestHyperparametersBatchSize x
$cto :: forall x.
Rep CreateFineTuningJobRequestHyperparametersBatchSize x
-> CreateFineTuningJobRequestHyperparametersBatchSize
to :: forall x.
Rep CreateFineTuningJobRequestHyperparametersBatchSize x
-> CreateFineTuningJobRequestHyperparametersBatchSize
Generic, Typeable CreateFineTuningJobRequestHyperparametersBatchSize
Typeable CreateFineTuningJobRequestHyperparametersBatchSize =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateFineTuningJobRequestHyperparametersBatchSize
 -> c CreateFineTuningJobRequestHyperparametersBatchSize)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateFineTuningJobRequestHyperparametersBatchSize)
-> (CreateFineTuningJobRequestHyperparametersBatchSize -> Constr)
-> (CreateFineTuningJobRequestHyperparametersBatchSize -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateFineTuningJobRequestHyperparametersBatchSize))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateFineTuningJobRequestHyperparametersBatchSize))
-> ((forall b. Data b => b -> b)
    -> CreateFineTuningJobRequestHyperparametersBatchSize
    -> CreateFineTuningJobRequestHyperparametersBatchSize)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequestHyperparametersBatchSize
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequestHyperparametersBatchSize
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateFineTuningJobRequestHyperparametersBatchSize -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateFineTuningJobRequestHyperparametersBatchSize
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparametersBatchSize
    -> m CreateFineTuningJobRequestHyperparametersBatchSize)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparametersBatchSize
    -> m CreateFineTuningJobRequestHyperparametersBatchSize)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparametersBatchSize
    -> m CreateFineTuningJobRequestHyperparametersBatchSize)
-> Data CreateFineTuningJobRequestHyperparametersBatchSize
CreateFineTuningJobRequestHyperparametersBatchSize -> Constr
CreateFineTuningJobRequestHyperparametersBatchSize -> DataType
(forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersBatchSize -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> m CreateFineTuningJobRequestHyperparametersBatchSize
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> m CreateFineTuningJobRequestHyperparametersBatchSize
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparametersBatchSize
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> c CreateFineTuningJobRequestHyperparametersBatchSize
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestHyperparametersBatchSize)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestHyperparametersBatchSize)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> c CreateFineTuningJobRequestHyperparametersBatchSize
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> c CreateFineTuningJobRequestHyperparametersBatchSize
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparametersBatchSize
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparametersBatchSize
$ctoConstr :: CreateFineTuningJobRequestHyperparametersBatchSize -> Constr
toConstr :: CreateFineTuningJobRequestHyperparametersBatchSize -> Constr
$cdataTypeOf :: CreateFineTuningJobRequestHyperparametersBatchSize -> DataType
dataTypeOf :: CreateFineTuningJobRequestHyperparametersBatchSize -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestHyperparametersBatchSize)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestHyperparametersBatchSize)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestHyperparametersBatchSize)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestHyperparametersBatchSize)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
gmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> CreateFineTuningJobRequestHyperparametersBatchSize
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersBatchSize -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersBatchSize -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> m CreateFineTuningJobRequestHyperparametersBatchSize
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> m CreateFineTuningJobRequestHyperparametersBatchSize
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> m CreateFineTuningJobRequestHyperparametersBatchSize
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> m CreateFineTuningJobRequestHyperparametersBatchSize
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> m CreateFineTuningJobRequestHyperparametersBatchSize
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersBatchSize
-> m CreateFineTuningJobRequestHyperparametersBatchSize
Data)

instance FromJSON CreateFineTuningJobRequestHyperparametersBatchSize where
  parseJSON :: Value -> Parser CreateFineTuningJobRequestHyperparametersBatchSize
parseJSON = Options
-> Value
-> Parser CreateFineTuningJobRequestHyperparametersBatchSize
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequestHyperparametersBatchSize")
instance ToJSON CreateFineTuningJobRequestHyperparametersBatchSize where
  toJSON :: CreateFineTuningJobRequestHyperparametersBatchSize -> Value
toJSON = Options
-> CreateFineTuningJobRequestHyperparametersBatchSize -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequestHyperparametersBatchSize")


-- | Scaling factor for the learning rate. A smaller learning rate may be useful to avoid overfitting. 
data CreateFineTuningJobRequestHyperparametersLearningRateMultiplier = CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
  { 
  } deriving (Int
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> ShowS
[CreateFineTuningJobRequestHyperparametersLearningRateMultiplier]
-> ShowS
CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> String
(Int
 -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
 -> ShowS)
-> (CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> String)
-> ([CreateFineTuningJobRequestHyperparametersLearningRateMultiplier]
    -> ShowS)
-> Show
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> ShowS
showsPrec :: Int
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> ShowS
$cshow :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> String
show :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> String
$cshowList :: [CreateFineTuningJobRequestHyperparametersLearningRateMultiplier]
-> ShowS
showList :: [CreateFineTuningJobRequestHyperparametersLearningRateMultiplier]
-> ShowS
Show, CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
(CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
 -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
 -> Bool)
-> (CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> Bool)
-> Eq
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
== :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
$c/= :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
/= :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
Eq, Eq CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
Eq
  CreateFineTuningJobRequestHyperparametersLearningRateMultiplier =>
(CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
 -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
 -> Ordering)
-> (CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> Bool)
-> (CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> Bool)
-> (CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> Bool)
-> (CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> Bool)
-> (CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
-> (CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
-> Ord
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Ordering
CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Ordering
compare :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Ordering
$c< :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
< :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
$c<= :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
<= :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
$c> :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
> :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
$c>= :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
>= :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Bool
$cmax :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
max :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
$cmin :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
min :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
Ord, (forall x.
 CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
 -> Rep
      CreateFineTuningJobRequestHyperparametersLearningRateMultiplier x)
-> (forall x.
    Rep
      CreateFineTuningJobRequestHyperparametersLearningRateMultiplier x
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
-> Generic
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall x.
Rep
  CreateFineTuningJobRequestHyperparametersLearningRateMultiplier x
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall x.
CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Rep
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Rep
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier x
from :: forall x.
CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Rep
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier x
$cto :: forall x.
Rep
  CreateFineTuningJobRequestHyperparametersLearningRateMultiplier x
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
to :: forall x.
Rep
  CreateFineTuningJobRequestHyperparametersLearningRateMultiplier x
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
Generic, Typeable
  CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
Typeable
  CreateFineTuningJobRequestHyperparametersLearningRateMultiplier =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
 -> c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
-> (CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> Constr)
-> (CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe
         (c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe
         (c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier))
-> ((forall b. Data b => b -> b)
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
    -> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
-> Data
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Constr
CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> DataType
(forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
$ctoConstr :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Constr
toConstr :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Constr
$cdataTypeOf :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> DataType
dataTypeOf :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c CreateFineTuningJobRequestHyperparametersLearningRateMultiplier)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
gmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> m CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
Data)

instance FromJSON CreateFineTuningJobRequestHyperparametersLearningRateMultiplier where
  parseJSON :: Value
-> Parser
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
parseJSON = Options
-> Value
-> Parser
     CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequestHyperparametersLearningRateMultiplier")
instance ToJSON CreateFineTuningJobRequestHyperparametersLearningRateMultiplier where
  toJSON :: CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Value
toJSON = Options
-> CreateFineTuningJobRequestHyperparametersLearningRateMultiplier
-> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequestHyperparametersLearningRateMultiplier")


-- | The number of epochs to train the model for. An epoch refers to one full cycle through the training dataset. 
data CreateFineTuningJobRequestHyperparametersNEpochs = CreateFineTuningJobRequestHyperparametersNEpochs
  { 
  } deriving (Int -> CreateFineTuningJobRequestHyperparametersNEpochs -> ShowS
[CreateFineTuningJobRequestHyperparametersNEpochs] -> ShowS
CreateFineTuningJobRequestHyperparametersNEpochs -> String
(Int -> CreateFineTuningJobRequestHyperparametersNEpochs -> ShowS)
-> (CreateFineTuningJobRequestHyperparametersNEpochs -> String)
-> ([CreateFineTuningJobRequestHyperparametersNEpochs] -> ShowS)
-> Show CreateFineTuningJobRequestHyperparametersNEpochs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateFineTuningJobRequestHyperparametersNEpochs -> ShowS
showsPrec :: Int -> CreateFineTuningJobRequestHyperparametersNEpochs -> ShowS
$cshow :: CreateFineTuningJobRequestHyperparametersNEpochs -> String
show :: CreateFineTuningJobRequestHyperparametersNEpochs -> String
$cshowList :: [CreateFineTuningJobRequestHyperparametersNEpochs] -> ShowS
showList :: [CreateFineTuningJobRequestHyperparametersNEpochs] -> ShowS
Show, CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
(CreateFineTuningJobRequestHyperparametersNEpochs
 -> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool)
-> (CreateFineTuningJobRequestHyperparametersNEpochs
    -> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool)
-> Eq CreateFineTuningJobRequestHyperparametersNEpochs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
== :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
$c/= :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
/= :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
Eq, Eq CreateFineTuningJobRequestHyperparametersNEpochs
Eq CreateFineTuningJobRequestHyperparametersNEpochs =>
(CreateFineTuningJobRequestHyperparametersNEpochs
 -> CreateFineTuningJobRequestHyperparametersNEpochs -> Ordering)
-> (CreateFineTuningJobRequestHyperparametersNEpochs
    -> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool)
-> (CreateFineTuningJobRequestHyperparametersNEpochs
    -> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool)
-> (CreateFineTuningJobRequestHyperparametersNEpochs
    -> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool)
-> (CreateFineTuningJobRequestHyperparametersNEpochs
    -> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool)
-> (CreateFineTuningJobRequestHyperparametersNEpochs
    -> CreateFineTuningJobRequestHyperparametersNEpochs
    -> CreateFineTuningJobRequestHyperparametersNEpochs)
-> (CreateFineTuningJobRequestHyperparametersNEpochs
    -> CreateFineTuningJobRequestHyperparametersNEpochs
    -> CreateFineTuningJobRequestHyperparametersNEpochs)
-> Ord CreateFineTuningJobRequestHyperparametersNEpochs
CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Ordering
CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Ordering
compare :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Ordering
$c< :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
< :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
$c<= :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
<= :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
$c> :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
> :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
$c>= :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
>= :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Bool
$cmax :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
max :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
$cmin :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
min :: CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
Ord, (forall x.
 CreateFineTuningJobRequestHyperparametersNEpochs
 -> Rep CreateFineTuningJobRequestHyperparametersNEpochs x)
-> (forall x.
    Rep CreateFineTuningJobRequestHyperparametersNEpochs x
    -> CreateFineTuningJobRequestHyperparametersNEpochs)
-> Generic CreateFineTuningJobRequestHyperparametersNEpochs
forall x.
Rep CreateFineTuningJobRequestHyperparametersNEpochs x
-> CreateFineTuningJobRequestHyperparametersNEpochs
forall x.
CreateFineTuningJobRequestHyperparametersNEpochs
-> Rep CreateFineTuningJobRequestHyperparametersNEpochs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateFineTuningJobRequestHyperparametersNEpochs
-> Rep CreateFineTuningJobRequestHyperparametersNEpochs x
from :: forall x.
CreateFineTuningJobRequestHyperparametersNEpochs
-> Rep CreateFineTuningJobRequestHyperparametersNEpochs x
$cto :: forall x.
Rep CreateFineTuningJobRequestHyperparametersNEpochs x
-> CreateFineTuningJobRequestHyperparametersNEpochs
to :: forall x.
Rep CreateFineTuningJobRequestHyperparametersNEpochs x
-> CreateFineTuningJobRequestHyperparametersNEpochs
Generic, Typeable CreateFineTuningJobRequestHyperparametersNEpochs
Typeable CreateFineTuningJobRequestHyperparametersNEpochs =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateFineTuningJobRequestHyperparametersNEpochs
 -> c CreateFineTuningJobRequestHyperparametersNEpochs)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateFineTuningJobRequestHyperparametersNEpochs)
-> (CreateFineTuningJobRequestHyperparametersNEpochs -> Constr)
-> (CreateFineTuningJobRequestHyperparametersNEpochs -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateFineTuningJobRequestHyperparametersNEpochs))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateFineTuningJobRequestHyperparametersNEpochs))
-> ((forall b. Data b => b -> b)
    -> CreateFineTuningJobRequestHyperparametersNEpochs
    -> CreateFineTuningJobRequestHyperparametersNEpochs)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequestHyperparametersNEpochs
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequestHyperparametersNEpochs
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateFineTuningJobRequestHyperparametersNEpochs -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateFineTuningJobRequestHyperparametersNEpochs
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparametersNEpochs
    -> m CreateFineTuningJobRequestHyperparametersNEpochs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparametersNEpochs
    -> m CreateFineTuningJobRequestHyperparametersNEpochs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestHyperparametersNEpochs
    -> m CreateFineTuningJobRequestHyperparametersNEpochs)
-> Data CreateFineTuningJobRequestHyperparametersNEpochs
CreateFineTuningJobRequestHyperparametersNEpochs -> Constr
CreateFineTuningJobRequestHyperparametersNEpochs -> DataType
(forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersNEpochs -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> m CreateFineTuningJobRequestHyperparametersNEpochs
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> m CreateFineTuningJobRequestHyperparametersNEpochs
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparametersNEpochs
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> c CreateFineTuningJobRequestHyperparametersNEpochs
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestHyperparametersNEpochs)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestHyperparametersNEpochs)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> c CreateFineTuningJobRequestHyperparametersNEpochs
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> c CreateFineTuningJobRequestHyperparametersNEpochs
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparametersNEpochs
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestHyperparametersNEpochs
$ctoConstr :: CreateFineTuningJobRequestHyperparametersNEpochs -> Constr
toConstr :: CreateFineTuningJobRequestHyperparametersNEpochs -> Constr
$cdataTypeOf :: CreateFineTuningJobRequestHyperparametersNEpochs -> DataType
dataTypeOf :: CreateFineTuningJobRequestHyperparametersNEpochs -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestHyperparametersNEpochs)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestHyperparametersNEpochs)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestHyperparametersNEpochs)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestHyperparametersNEpochs)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
gmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> CreateFineTuningJobRequestHyperparametersNEpochs
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersNEpochs -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersNEpochs -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> m CreateFineTuningJobRequestHyperparametersNEpochs
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> m CreateFineTuningJobRequestHyperparametersNEpochs
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> m CreateFineTuningJobRequestHyperparametersNEpochs
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> m CreateFineTuningJobRequestHyperparametersNEpochs
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> m CreateFineTuningJobRequestHyperparametersNEpochs
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestHyperparametersNEpochs
-> m CreateFineTuningJobRequestHyperparametersNEpochs
Data)

instance FromJSON CreateFineTuningJobRequestHyperparametersNEpochs where
  parseJSON :: Value -> Parser CreateFineTuningJobRequestHyperparametersNEpochs
parseJSON = Options
-> Value -> Parser CreateFineTuningJobRequestHyperparametersNEpochs
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequestHyperparametersNEpochs")
instance ToJSON CreateFineTuningJobRequestHyperparametersNEpochs where
  toJSON :: CreateFineTuningJobRequestHyperparametersNEpochs -> Value
toJSON = Options
-> CreateFineTuningJobRequestHyperparametersNEpochs -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequestHyperparametersNEpochs")


-- | The name of the model to fine-tune. You can select one of the [supported models](/docs/guides/fine-tuning/what-models-can-be-fine-tuned). 
data CreateFineTuningJobRequestModel = CreateFineTuningJobRequestModel Text  deriving (Int -> CreateFineTuningJobRequestModel -> ShowS
[CreateFineTuningJobRequestModel] -> ShowS
CreateFineTuningJobRequestModel -> String
(Int -> CreateFineTuningJobRequestModel -> ShowS)
-> (CreateFineTuningJobRequestModel -> String)
-> ([CreateFineTuningJobRequestModel] -> ShowS)
-> Show CreateFineTuningJobRequestModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateFineTuningJobRequestModel -> ShowS
showsPrec :: Int -> CreateFineTuningJobRequestModel -> ShowS
$cshow :: CreateFineTuningJobRequestModel -> String
show :: CreateFineTuningJobRequestModel -> String
$cshowList :: [CreateFineTuningJobRequestModel] -> ShowS
showList :: [CreateFineTuningJobRequestModel] -> ShowS
Show, CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
(CreateFineTuningJobRequestModel
 -> CreateFineTuningJobRequestModel -> Bool)
-> (CreateFineTuningJobRequestModel
    -> CreateFineTuningJobRequestModel -> Bool)
-> Eq CreateFineTuningJobRequestModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
== :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
$c/= :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
/= :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
Eq, Eq CreateFineTuningJobRequestModel
Eq CreateFineTuningJobRequestModel =>
(CreateFineTuningJobRequestModel
 -> CreateFineTuningJobRequestModel -> Ordering)
-> (CreateFineTuningJobRequestModel
    -> CreateFineTuningJobRequestModel -> Bool)
-> (CreateFineTuningJobRequestModel
    -> CreateFineTuningJobRequestModel -> Bool)
-> (CreateFineTuningJobRequestModel
    -> CreateFineTuningJobRequestModel -> Bool)
-> (CreateFineTuningJobRequestModel
    -> CreateFineTuningJobRequestModel -> Bool)
-> (CreateFineTuningJobRequestModel
    -> CreateFineTuningJobRequestModel
    -> CreateFineTuningJobRequestModel)
-> (CreateFineTuningJobRequestModel
    -> CreateFineTuningJobRequestModel
    -> CreateFineTuningJobRequestModel)
-> Ord CreateFineTuningJobRequestModel
CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Ordering
CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Ordering
compare :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Ordering
$c< :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
< :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
$c<= :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
<= :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
$c> :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
> :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
$c>= :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
>= :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel -> Bool
$cmax :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
max :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
$cmin :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
min :: CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
Ord, (forall x.
 CreateFineTuningJobRequestModel
 -> Rep CreateFineTuningJobRequestModel x)
-> (forall x.
    Rep CreateFineTuningJobRequestModel x
    -> CreateFineTuningJobRequestModel)
-> Generic CreateFineTuningJobRequestModel
forall x.
Rep CreateFineTuningJobRequestModel x
-> CreateFineTuningJobRequestModel
forall x.
CreateFineTuningJobRequestModel
-> Rep CreateFineTuningJobRequestModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateFineTuningJobRequestModel
-> Rep CreateFineTuningJobRequestModel x
from :: forall x.
CreateFineTuningJobRequestModel
-> Rep CreateFineTuningJobRequestModel x
$cto :: forall x.
Rep CreateFineTuningJobRequestModel x
-> CreateFineTuningJobRequestModel
to :: forall x.
Rep CreateFineTuningJobRequestModel x
-> CreateFineTuningJobRequestModel
Generic, Typeable CreateFineTuningJobRequestModel
Typeable CreateFineTuningJobRequestModel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateFineTuningJobRequestModel
 -> c CreateFineTuningJobRequestModel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateFineTuningJobRequestModel)
-> (CreateFineTuningJobRequestModel -> Constr)
-> (CreateFineTuningJobRequestModel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateFineTuningJobRequestModel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateFineTuningJobRequestModel))
-> ((forall b. Data b => b -> b)
    -> CreateFineTuningJobRequestModel
    -> CreateFineTuningJobRequestModel)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequestModel
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateFineTuningJobRequestModel
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateFineTuningJobRequestModel -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateFineTuningJobRequestModel
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestModel
    -> m CreateFineTuningJobRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestModel
    -> m CreateFineTuningJobRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateFineTuningJobRequestModel
    -> m CreateFineTuningJobRequestModel)
-> Data CreateFineTuningJobRequestModel
CreateFineTuningJobRequestModel -> Constr
CreateFineTuningJobRequestModel -> DataType
(forall b. Data b => b -> b)
-> CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestModel
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestModel -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestModel
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestModel
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestModel
-> m CreateFineTuningJobRequestModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestModel
-> m CreateFineTuningJobRequestModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestModel
-> c CreateFineTuningJobRequestModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestModel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestModel
-> c CreateFineTuningJobRequestModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateFineTuningJobRequestModel
-> c CreateFineTuningJobRequestModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestModel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateFineTuningJobRequestModel
$ctoConstr :: CreateFineTuningJobRequestModel -> Constr
toConstr :: CreateFineTuningJobRequestModel -> Constr
$cdataTypeOf :: CreateFineTuningJobRequestModel -> DataType
dataTypeOf :: CreateFineTuningJobRequestModel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateFineTuningJobRequestModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestModel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateFineTuningJobRequestModel)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
gmapT :: (forall b. Data b => b -> b)
-> CreateFineTuningJobRequestModel
-> CreateFineTuningJobRequestModel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestModel
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestModel
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestModel
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateFineTuningJobRequestModel
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestModel -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateFineTuningJobRequestModel -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestModel
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateFineTuningJobRequestModel
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestModel
-> m CreateFineTuningJobRequestModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestModel
-> m CreateFineTuningJobRequestModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestModel
-> m CreateFineTuningJobRequestModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestModel
-> m CreateFineTuningJobRequestModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestModel
-> m CreateFineTuningJobRequestModel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateFineTuningJobRequestModel
-> m CreateFineTuningJobRequestModel
Data)

instance FromJSON CreateFineTuningJobRequestModel where
  parseJSON :: Value -> Parser CreateFineTuningJobRequestModel
parseJSON = Options -> Value -> Parser CreateFineTuningJobRequestModel
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequestModel")
instance ToJSON CreateFineTuningJobRequestModel where
  toJSON :: CreateFineTuningJobRequestModel -> Value
toJSON = Options -> CreateFineTuningJobRequestModel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createFineTuningJobRequestModel")


-- | 
data CreateImageRequest = CreateImageRequest
  { CreateImageRequest -> Text
createImageRequestPrompt :: Text -- ^ A text description of the desired image(s). The maximum length is 1000 characters for `dall-e-2` and 4000 characters for `dall-e-3`.
  , CreateImageRequest -> Maybe CreateImageRequestModel
createImageRequestModel :: Maybe CreateImageRequestModel -- ^ 
  , CreateImageRequest -> Maybe Int
createImageRequestN :: Maybe Int -- ^ The number of images to generate. Must be between 1 and 10. For `dall-e-3`, only `n=1` is supported.
  , CreateImageRequest -> Maybe Text
createImageRequestQuality :: Maybe Text -- ^ The quality of the image that will be generated. `hd` creates images with finer details and greater consistency across the image. This param is only supported for `dall-e-3`.
  , CreateImageRequest -> Maybe Text
createImageRequestResponseUnderscoreformat :: Maybe Text -- ^ The format in which the generated images are returned. Must be one of `url` or `b64_json`. URLs are only valid for 60 minutes after the image has been generated.
  , CreateImageRequest -> Maybe Text
createImageRequestSize :: Maybe Text -- ^ The size of the generated images. Must be one of `256x256`, `512x512`, or `1024x1024` for `dall-e-2`. Must be one of `1024x1024`, `1792x1024`, or `1024x1792` for `dall-e-3` models.
  , CreateImageRequest -> Maybe Text
createImageRequestStyle :: Maybe Text -- ^ The style of the generated images. Must be one of `vivid` or `natural`. Vivid causes the model to lean towards generating hyper-real and dramatic images. Natural causes the model to produce more natural, less hyper-real looking images. This param is only supported for `dall-e-3`.
  , CreateImageRequest -> Maybe Text
createImageRequestUser :: Maybe Text -- ^ A unique identifier representing your end-user, which can help OpenAI to monitor and detect abuse. [Learn more](/docs/guides/safety-best-practices/end-user-ids). 
  } deriving (Int -> CreateImageRequest -> ShowS
[CreateImageRequest] -> ShowS
CreateImageRequest -> String
(Int -> CreateImageRequest -> ShowS)
-> (CreateImageRequest -> String)
-> ([CreateImageRequest] -> ShowS)
-> Show CreateImageRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateImageRequest -> ShowS
showsPrec :: Int -> CreateImageRequest -> ShowS
$cshow :: CreateImageRequest -> String
show :: CreateImageRequest -> String
$cshowList :: [CreateImageRequest] -> ShowS
showList :: [CreateImageRequest] -> ShowS
Show, CreateImageRequest -> CreateImageRequest -> Bool
(CreateImageRequest -> CreateImageRequest -> Bool)
-> (CreateImageRequest -> CreateImageRequest -> Bool)
-> Eq CreateImageRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateImageRequest -> CreateImageRequest -> Bool
== :: CreateImageRequest -> CreateImageRequest -> Bool
$c/= :: CreateImageRequest -> CreateImageRequest -> Bool
/= :: CreateImageRequest -> CreateImageRequest -> Bool
Eq, Eq CreateImageRequest
Eq CreateImageRequest =>
(CreateImageRequest -> CreateImageRequest -> Ordering)
-> (CreateImageRequest -> CreateImageRequest -> Bool)
-> (CreateImageRequest -> CreateImageRequest -> Bool)
-> (CreateImageRequest -> CreateImageRequest -> Bool)
-> (CreateImageRequest -> CreateImageRequest -> Bool)
-> (CreateImageRequest -> CreateImageRequest -> CreateImageRequest)
-> (CreateImageRequest -> CreateImageRequest -> CreateImageRequest)
-> Ord CreateImageRequest
CreateImageRequest -> CreateImageRequest -> Bool
CreateImageRequest -> CreateImageRequest -> Ordering
CreateImageRequest -> CreateImageRequest -> CreateImageRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateImageRequest -> CreateImageRequest -> Ordering
compare :: CreateImageRequest -> CreateImageRequest -> Ordering
$c< :: CreateImageRequest -> CreateImageRequest -> Bool
< :: CreateImageRequest -> CreateImageRequest -> Bool
$c<= :: CreateImageRequest -> CreateImageRequest -> Bool
<= :: CreateImageRequest -> CreateImageRequest -> Bool
$c> :: CreateImageRequest -> CreateImageRequest -> Bool
> :: CreateImageRequest -> CreateImageRequest -> Bool
$c>= :: CreateImageRequest -> CreateImageRequest -> Bool
>= :: CreateImageRequest -> CreateImageRequest -> Bool
$cmax :: CreateImageRequest -> CreateImageRequest -> CreateImageRequest
max :: CreateImageRequest -> CreateImageRequest -> CreateImageRequest
$cmin :: CreateImageRequest -> CreateImageRequest -> CreateImageRequest
min :: CreateImageRequest -> CreateImageRequest -> CreateImageRequest
Ord, (forall x. CreateImageRequest -> Rep CreateImageRequest x)
-> (forall x. Rep CreateImageRequest x -> CreateImageRequest)
-> Generic CreateImageRequest
forall x. Rep CreateImageRequest x -> CreateImageRequest
forall x. CreateImageRequest -> Rep CreateImageRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateImageRequest -> Rep CreateImageRequest x
from :: forall x. CreateImageRequest -> Rep CreateImageRequest x
$cto :: forall x. Rep CreateImageRequest x -> CreateImageRequest
to :: forall x. Rep CreateImageRequest x -> CreateImageRequest
Generic, Typeable CreateImageRequest
Typeable CreateImageRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateImageRequest
 -> c CreateImageRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateImageRequest)
-> (CreateImageRequest -> Constr)
-> (CreateImageRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateImageRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateImageRequest))
-> ((forall b. Data b => b -> b)
    -> CreateImageRequest -> CreateImageRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateImageRequest -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateImageRequest -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateImageRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CreateImageRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateImageRequest -> m CreateImageRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateImageRequest -> m CreateImageRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateImageRequest -> m CreateImageRequest)
-> Data CreateImageRequest
CreateImageRequest -> Constr
CreateImageRequest -> DataType
(forall b. Data b => b -> b)
-> CreateImageRequest -> CreateImageRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateImageRequest -> u
forall u. (forall d. Data d => d -> u) -> CreateImageRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateImageRequest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateImageRequest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateImageRequest -> m CreateImageRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateImageRequest -> m CreateImageRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateImageRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateImageRequest
-> c CreateImageRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateImageRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateImageRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateImageRequest
-> c CreateImageRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateImageRequest
-> c CreateImageRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateImageRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateImageRequest
$ctoConstr :: CreateImageRequest -> Constr
toConstr :: CreateImageRequest -> Constr
$cdataTypeOf :: CreateImageRequest -> DataType
dataTypeOf :: CreateImageRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateImageRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateImageRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateImageRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateImageRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateImageRequest -> CreateImageRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateImageRequest -> CreateImageRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateImageRequest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateImageRequest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateImageRequest -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateImageRequest -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CreateImageRequest -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CreateImageRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateImageRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateImageRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateImageRequest -> m CreateImageRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateImageRequest -> m CreateImageRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateImageRequest -> m CreateImageRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateImageRequest -> m CreateImageRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateImageRequest -> m CreateImageRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateImageRequest -> m CreateImageRequest
Data)

instance FromJSON CreateImageRequest where
  parseJSON :: Value -> Parser CreateImageRequest
parseJSON = Options -> Value -> Parser CreateImageRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createImageRequest")
instance ToJSON CreateImageRequest where
  toJSON :: CreateImageRequest -> Value
toJSON = Options -> CreateImageRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createImageRequest")


-- | The model to use for image generation.
data CreateImageRequestModel = CreateImageRequestModel Text  deriving (Int -> CreateImageRequestModel -> ShowS
[CreateImageRequestModel] -> ShowS
CreateImageRequestModel -> String
(Int -> CreateImageRequestModel -> ShowS)
-> (CreateImageRequestModel -> String)
-> ([CreateImageRequestModel] -> ShowS)
-> Show CreateImageRequestModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateImageRequestModel -> ShowS
showsPrec :: Int -> CreateImageRequestModel -> ShowS
$cshow :: CreateImageRequestModel -> String
show :: CreateImageRequestModel -> String
$cshowList :: [CreateImageRequestModel] -> ShowS
showList :: [CreateImageRequestModel] -> ShowS
Show, CreateImageRequestModel -> CreateImageRequestModel -> Bool
(CreateImageRequestModel -> CreateImageRequestModel -> Bool)
-> (CreateImageRequestModel -> CreateImageRequestModel -> Bool)
-> Eq CreateImageRequestModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
== :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
$c/= :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
/= :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
Eq, Eq CreateImageRequestModel
Eq CreateImageRequestModel =>
(CreateImageRequestModel -> CreateImageRequestModel -> Ordering)
-> (CreateImageRequestModel -> CreateImageRequestModel -> Bool)
-> (CreateImageRequestModel -> CreateImageRequestModel -> Bool)
-> (CreateImageRequestModel -> CreateImageRequestModel -> Bool)
-> (CreateImageRequestModel -> CreateImageRequestModel -> Bool)
-> (CreateImageRequestModel
    -> CreateImageRequestModel -> CreateImageRequestModel)
-> (CreateImageRequestModel
    -> CreateImageRequestModel -> CreateImageRequestModel)
-> Ord CreateImageRequestModel
CreateImageRequestModel -> CreateImageRequestModel -> Bool
CreateImageRequestModel -> CreateImageRequestModel -> Ordering
CreateImageRequestModel
-> CreateImageRequestModel -> CreateImageRequestModel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateImageRequestModel -> CreateImageRequestModel -> Ordering
compare :: CreateImageRequestModel -> CreateImageRequestModel -> Ordering
$c< :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
< :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
$c<= :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
<= :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
$c> :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
> :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
$c>= :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
>= :: CreateImageRequestModel -> CreateImageRequestModel -> Bool
$cmax :: CreateImageRequestModel
-> CreateImageRequestModel -> CreateImageRequestModel
max :: CreateImageRequestModel
-> CreateImageRequestModel -> CreateImageRequestModel
$cmin :: CreateImageRequestModel
-> CreateImageRequestModel -> CreateImageRequestModel
min :: CreateImageRequestModel
-> CreateImageRequestModel -> CreateImageRequestModel
Ord, (forall x.
 CreateImageRequestModel -> Rep CreateImageRequestModel x)
-> (forall x.
    Rep CreateImageRequestModel x -> CreateImageRequestModel)
-> Generic CreateImageRequestModel
forall x. Rep CreateImageRequestModel x -> CreateImageRequestModel
forall x. CreateImageRequestModel -> Rep CreateImageRequestModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateImageRequestModel -> Rep CreateImageRequestModel x
from :: forall x. CreateImageRequestModel -> Rep CreateImageRequestModel x
$cto :: forall x. Rep CreateImageRequestModel x -> CreateImageRequestModel
to :: forall x. Rep CreateImageRequestModel x -> CreateImageRequestModel
Generic, Typeable CreateImageRequestModel
Typeable CreateImageRequestModel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateImageRequestModel
 -> c CreateImageRequestModel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateImageRequestModel)
-> (CreateImageRequestModel -> Constr)
-> (CreateImageRequestModel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateImageRequestModel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateImageRequestModel))
-> ((forall b. Data b => b -> b)
    -> CreateImageRequestModel -> CreateImageRequestModel)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateImageRequestModel
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateImageRequestModel
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateImageRequestModel -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> CreateImageRequestModel -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateImageRequestModel -> m CreateImageRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateImageRequestModel -> m CreateImageRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateImageRequestModel -> m CreateImageRequestModel)
-> Data CreateImageRequestModel
CreateImageRequestModel -> Constr
CreateImageRequestModel -> DataType
(forall b. Data b => b -> b)
-> CreateImageRequestModel -> CreateImageRequestModel
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateImageRequestModel -> u
forall u.
(forall d. Data d => d -> u) -> CreateImageRequestModel -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateImageRequestModel
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateImageRequestModel
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateImageRequestModel -> m CreateImageRequestModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateImageRequestModel -> m CreateImageRequestModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateImageRequestModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateImageRequestModel
-> c CreateImageRequestModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateImageRequestModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateImageRequestModel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateImageRequestModel
-> c CreateImageRequestModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateImageRequestModel
-> c CreateImageRequestModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateImageRequestModel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateImageRequestModel
$ctoConstr :: CreateImageRequestModel -> Constr
toConstr :: CreateImageRequestModel -> Constr
$cdataTypeOf :: CreateImageRequestModel -> DataType
dataTypeOf :: CreateImageRequestModel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateImageRequestModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateImageRequestModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateImageRequestModel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateImageRequestModel)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateImageRequestModel -> CreateImageRequestModel
gmapT :: (forall b. Data b => b -> b)
-> CreateImageRequestModel -> CreateImageRequestModel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateImageRequestModel
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateImageRequestModel
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateImageRequestModel
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateImageRequestModel
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateImageRequestModel -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateImageRequestModel -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateImageRequestModel -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateImageRequestModel -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateImageRequestModel -> m CreateImageRequestModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateImageRequestModel -> m CreateImageRequestModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateImageRequestModel -> m CreateImageRequestModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateImageRequestModel -> m CreateImageRequestModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateImageRequestModel -> m CreateImageRequestModel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateImageRequestModel -> m CreateImageRequestModel
Data)

instance FromJSON CreateImageRequestModel where
  parseJSON :: Value -> Parser CreateImageRequestModel
parseJSON = Options -> Value -> Parser CreateImageRequestModel
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createImageRequestModel")
instance ToJSON CreateImageRequestModel where
  toJSON :: CreateImageRequestModel -> Value
toJSON = Options -> CreateImageRequestModel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createImageRequestModel")


-- | 
data CreateMessageRequest = CreateMessageRequest
  { CreateMessageRequest -> Text
createMessageRequestRole :: Text -- ^ The role of the entity that is creating the message. Currently only `user` is supported.
  , CreateMessageRequest -> Text
createMessageRequestContent :: Text -- ^ The content of the message.
  , CreateMessageRequest -> Maybe [Text]
createMessageRequestFileUnderscoreids :: Maybe [Text] -- ^ A list of [File](/docs/api-reference/files) IDs that the message should use. There can be a maximum of 10 files attached to a message. Useful for tools like `retrieval` and `code_interpreter` that can access and use files.
  , CreateMessageRequest -> Maybe Value
createMessageRequestMetadata :: Maybe Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> CreateMessageRequest -> ShowS
[CreateMessageRequest] -> ShowS
CreateMessageRequest -> String
(Int -> CreateMessageRequest -> ShowS)
-> (CreateMessageRequest -> String)
-> ([CreateMessageRequest] -> ShowS)
-> Show CreateMessageRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateMessageRequest -> ShowS
showsPrec :: Int -> CreateMessageRequest -> ShowS
$cshow :: CreateMessageRequest -> String
show :: CreateMessageRequest -> String
$cshowList :: [CreateMessageRequest] -> ShowS
showList :: [CreateMessageRequest] -> ShowS
Show, CreateMessageRequest -> CreateMessageRequest -> Bool
(CreateMessageRequest -> CreateMessageRequest -> Bool)
-> (CreateMessageRequest -> CreateMessageRequest -> Bool)
-> Eq CreateMessageRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateMessageRequest -> CreateMessageRequest -> Bool
== :: CreateMessageRequest -> CreateMessageRequest -> Bool
$c/= :: CreateMessageRequest -> CreateMessageRequest -> Bool
/= :: CreateMessageRequest -> CreateMessageRequest -> Bool
Eq, Eq CreateMessageRequest
Eq CreateMessageRequest =>
(CreateMessageRequest -> CreateMessageRequest -> Ordering)
-> (CreateMessageRequest -> CreateMessageRequest -> Bool)
-> (CreateMessageRequest -> CreateMessageRequest -> Bool)
-> (CreateMessageRequest -> CreateMessageRequest -> Bool)
-> (CreateMessageRequest -> CreateMessageRequest -> Bool)
-> (CreateMessageRequest
    -> CreateMessageRequest -> CreateMessageRequest)
-> (CreateMessageRequest
    -> CreateMessageRequest -> CreateMessageRequest)
-> Ord CreateMessageRequest
CreateMessageRequest -> CreateMessageRequest -> Bool
CreateMessageRequest -> CreateMessageRequest -> Ordering
CreateMessageRequest
-> CreateMessageRequest -> CreateMessageRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateMessageRequest -> CreateMessageRequest -> Ordering
compare :: CreateMessageRequest -> CreateMessageRequest -> Ordering
$c< :: CreateMessageRequest -> CreateMessageRequest -> Bool
< :: CreateMessageRequest -> CreateMessageRequest -> Bool
$c<= :: CreateMessageRequest -> CreateMessageRequest -> Bool
<= :: CreateMessageRequest -> CreateMessageRequest -> Bool
$c> :: CreateMessageRequest -> CreateMessageRequest -> Bool
> :: CreateMessageRequest -> CreateMessageRequest -> Bool
$c>= :: CreateMessageRequest -> CreateMessageRequest -> Bool
>= :: CreateMessageRequest -> CreateMessageRequest -> Bool
$cmax :: CreateMessageRequest
-> CreateMessageRequest -> CreateMessageRequest
max :: CreateMessageRequest
-> CreateMessageRequest -> CreateMessageRequest
$cmin :: CreateMessageRequest
-> CreateMessageRequest -> CreateMessageRequest
min :: CreateMessageRequest
-> CreateMessageRequest -> CreateMessageRequest
Ord, (forall x. CreateMessageRequest -> Rep CreateMessageRequest x)
-> (forall x. Rep CreateMessageRequest x -> CreateMessageRequest)
-> Generic CreateMessageRequest
forall x. Rep CreateMessageRequest x -> CreateMessageRequest
forall x. CreateMessageRequest -> Rep CreateMessageRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateMessageRequest -> Rep CreateMessageRequest x
from :: forall x. CreateMessageRequest -> Rep CreateMessageRequest x
$cto :: forall x. Rep CreateMessageRequest x -> CreateMessageRequest
to :: forall x. Rep CreateMessageRequest x -> CreateMessageRequest
Generic, Typeable CreateMessageRequest
Typeable CreateMessageRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateMessageRequest
 -> c CreateMessageRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateMessageRequest)
-> (CreateMessageRequest -> Constr)
-> (CreateMessageRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateMessageRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateMessageRequest))
-> ((forall b. Data b => b -> b)
    -> CreateMessageRequest -> CreateMessageRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateMessageRequest -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateMessageRequest -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateMessageRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CreateMessageRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateMessageRequest -> m CreateMessageRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateMessageRequest -> m CreateMessageRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateMessageRequest -> m CreateMessageRequest)
-> Data CreateMessageRequest
CreateMessageRequest -> Constr
CreateMessageRequest -> DataType
(forall b. Data b => b -> b)
-> CreateMessageRequest -> CreateMessageRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateMessageRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateMessageRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateMessageRequest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateMessageRequest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateMessageRequest -> m CreateMessageRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateMessageRequest -> m CreateMessageRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateMessageRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateMessageRequest
-> c CreateMessageRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateMessageRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateMessageRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateMessageRequest
-> c CreateMessageRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateMessageRequest
-> c CreateMessageRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateMessageRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateMessageRequest
$ctoConstr :: CreateMessageRequest -> Constr
toConstr :: CreateMessageRequest -> Constr
$cdataTypeOf :: CreateMessageRequest -> DataType
dataTypeOf :: CreateMessageRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateMessageRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateMessageRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateMessageRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateMessageRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateMessageRequest -> CreateMessageRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateMessageRequest -> CreateMessageRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateMessageRequest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateMessageRequest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateMessageRequest -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateMessageRequest -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateMessageRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateMessageRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateMessageRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateMessageRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateMessageRequest -> m CreateMessageRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateMessageRequest -> m CreateMessageRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateMessageRequest -> m CreateMessageRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateMessageRequest -> m CreateMessageRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateMessageRequest -> m CreateMessageRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateMessageRequest -> m CreateMessageRequest
Data)

instance FromJSON CreateMessageRequest where
  parseJSON :: Value -> Parser CreateMessageRequest
parseJSON = Options -> Value -> Parser CreateMessageRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createMessageRequest")
instance ToJSON CreateMessageRequest where
  toJSON :: CreateMessageRequest -> Value
toJSON = Options -> CreateMessageRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createMessageRequest")


-- | 
data CreateModerationRequest = CreateModerationRequest
  { CreateModerationRequest -> CreateModerationRequestInput
createModerationRequestInput :: CreateModerationRequestInput -- ^ 
  , CreateModerationRequest -> Maybe CreateModerationRequestModel
createModerationRequestModel :: Maybe CreateModerationRequestModel -- ^ 
  } deriving (Int -> CreateModerationRequest -> ShowS
[CreateModerationRequest] -> ShowS
CreateModerationRequest -> String
(Int -> CreateModerationRequest -> ShowS)
-> (CreateModerationRequest -> String)
-> ([CreateModerationRequest] -> ShowS)
-> Show CreateModerationRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateModerationRequest -> ShowS
showsPrec :: Int -> CreateModerationRequest -> ShowS
$cshow :: CreateModerationRequest -> String
show :: CreateModerationRequest -> String
$cshowList :: [CreateModerationRequest] -> ShowS
showList :: [CreateModerationRequest] -> ShowS
Show, CreateModerationRequest -> CreateModerationRequest -> Bool
(CreateModerationRequest -> CreateModerationRequest -> Bool)
-> (CreateModerationRequest -> CreateModerationRequest -> Bool)
-> Eq CreateModerationRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateModerationRequest -> CreateModerationRequest -> Bool
== :: CreateModerationRequest -> CreateModerationRequest -> Bool
$c/= :: CreateModerationRequest -> CreateModerationRequest -> Bool
/= :: CreateModerationRequest -> CreateModerationRequest -> Bool
Eq, Eq CreateModerationRequest
Eq CreateModerationRequest =>
(CreateModerationRequest -> CreateModerationRequest -> Ordering)
-> (CreateModerationRequest -> CreateModerationRequest -> Bool)
-> (CreateModerationRequest -> CreateModerationRequest -> Bool)
-> (CreateModerationRequest -> CreateModerationRequest -> Bool)
-> (CreateModerationRequest -> CreateModerationRequest -> Bool)
-> (CreateModerationRequest
    -> CreateModerationRequest -> CreateModerationRequest)
-> (CreateModerationRequest
    -> CreateModerationRequest -> CreateModerationRequest)
-> Ord CreateModerationRequest
CreateModerationRequest -> CreateModerationRequest -> Bool
CreateModerationRequest -> CreateModerationRequest -> Ordering
CreateModerationRequest
-> CreateModerationRequest -> CreateModerationRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateModerationRequest -> CreateModerationRequest -> Ordering
compare :: CreateModerationRequest -> CreateModerationRequest -> Ordering
$c< :: CreateModerationRequest -> CreateModerationRequest -> Bool
< :: CreateModerationRequest -> CreateModerationRequest -> Bool
$c<= :: CreateModerationRequest -> CreateModerationRequest -> Bool
<= :: CreateModerationRequest -> CreateModerationRequest -> Bool
$c> :: CreateModerationRequest -> CreateModerationRequest -> Bool
> :: CreateModerationRequest -> CreateModerationRequest -> Bool
$c>= :: CreateModerationRequest -> CreateModerationRequest -> Bool
>= :: CreateModerationRequest -> CreateModerationRequest -> Bool
$cmax :: CreateModerationRequest
-> CreateModerationRequest -> CreateModerationRequest
max :: CreateModerationRequest
-> CreateModerationRequest -> CreateModerationRequest
$cmin :: CreateModerationRequest
-> CreateModerationRequest -> CreateModerationRequest
min :: CreateModerationRequest
-> CreateModerationRequest -> CreateModerationRequest
Ord, (forall x.
 CreateModerationRequest -> Rep CreateModerationRequest x)
-> (forall x.
    Rep CreateModerationRequest x -> CreateModerationRequest)
-> Generic CreateModerationRequest
forall x. Rep CreateModerationRequest x -> CreateModerationRequest
forall x. CreateModerationRequest -> Rep CreateModerationRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateModerationRequest -> Rep CreateModerationRequest x
from :: forall x. CreateModerationRequest -> Rep CreateModerationRequest x
$cto :: forall x. Rep CreateModerationRequest x -> CreateModerationRequest
to :: forall x. Rep CreateModerationRequest x -> CreateModerationRequest
Generic, Typeable CreateModerationRequest
Typeable CreateModerationRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateModerationRequest
 -> c CreateModerationRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateModerationRequest)
-> (CreateModerationRequest -> Constr)
-> (CreateModerationRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateModerationRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateModerationRequest))
-> ((forall b. Data b => b -> b)
    -> CreateModerationRequest -> CreateModerationRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationRequest
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationRequest
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateModerationRequest -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> CreateModerationRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationRequest -> m CreateModerationRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationRequest -> m CreateModerationRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationRequest -> m CreateModerationRequest)
-> Data CreateModerationRequest
CreateModerationRequest -> Constr
CreateModerationRequest -> DataType
(forall b. Data b => b -> b)
-> CreateModerationRequest -> CreateModerationRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateModerationRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateModerationRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequest
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequest
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequest -> m CreateModerationRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequest -> m CreateModerationRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationRequest
-> c CreateModerationRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateModerationRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationRequest
-> c CreateModerationRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationRequest
-> c CreateModerationRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationRequest
$ctoConstr :: CreateModerationRequest -> Constr
toConstr :: CreateModerationRequest -> Constr
$cdataTypeOf :: CreateModerationRequest -> DataType
dataTypeOf :: CreateModerationRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateModerationRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateModerationRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateModerationRequest -> CreateModerationRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateModerationRequest -> CreateModerationRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequest
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequest
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequest
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequest
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateModerationRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateModerationRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateModerationRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateModerationRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequest -> m CreateModerationRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequest -> m CreateModerationRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequest -> m CreateModerationRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequest -> m CreateModerationRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequest -> m CreateModerationRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequest -> m CreateModerationRequest
Data)

instance FromJSON CreateModerationRequest where
  parseJSON :: Value -> Parser CreateModerationRequest
parseJSON = Options -> Value -> Parser CreateModerationRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createModerationRequest")
instance ToJSON CreateModerationRequest where
  toJSON :: CreateModerationRequest -> Value
toJSON = Options -> CreateModerationRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createModerationRequest")


-- | The input text to classify
data CreateModerationRequestInput = CreateModerationRequestInput
  { 
  } deriving (Int -> CreateModerationRequestInput -> ShowS
[CreateModerationRequestInput] -> ShowS
CreateModerationRequestInput -> String
(Int -> CreateModerationRequestInput -> ShowS)
-> (CreateModerationRequestInput -> String)
-> ([CreateModerationRequestInput] -> ShowS)
-> Show CreateModerationRequestInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateModerationRequestInput -> ShowS
showsPrec :: Int -> CreateModerationRequestInput -> ShowS
$cshow :: CreateModerationRequestInput -> String
show :: CreateModerationRequestInput -> String
$cshowList :: [CreateModerationRequestInput] -> ShowS
showList :: [CreateModerationRequestInput] -> ShowS
Show, CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
(CreateModerationRequestInput
 -> CreateModerationRequestInput -> Bool)
-> (CreateModerationRequestInput
    -> CreateModerationRequestInput -> Bool)
-> Eq CreateModerationRequestInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
== :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
$c/= :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
/= :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
Eq, Eq CreateModerationRequestInput
Eq CreateModerationRequestInput =>
(CreateModerationRequestInput
 -> CreateModerationRequestInput -> Ordering)
-> (CreateModerationRequestInput
    -> CreateModerationRequestInput -> Bool)
-> (CreateModerationRequestInput
    -> CreateModerationRequestInput -> Bool)
-> (CreateModerationRequestInput
    -> CreateModerationRequestInput -> Bool)
-> (CreateModerationRequestInput
    -> CreateModerationRequestInput -> Bool)
-> (CreateModerationRequestInput
    -> CreateModerationRequestInput -> CreateModerationRequestInput)
-> (CreateModerationRequestInput
    -> CreateModerationRequestInput -> CreateModerationRequestInput)
-> Ord CreateModerationRequestInput
CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
CreateModerationRequestInput
-> CreateModerationRequestInput -> Ordering
CreateModerationRequestInput
-> CreateModerationRequestInput -> CreateModerationRequestInput
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Ordering
compare :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Ordering
$c< :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
< :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
$c<= :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
<= :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
$c> :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
> :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
$c>= :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
>= :: CreateModerationRequestInput
-> CreateModerationRequestInput -> Bool
$cmax :: CreateModerationRequestInput
-> CreateModerationRequestInput -> CreateModerationRequestInput
max :: CreateModerationRequestInput
-> CreateModerationRequestInput -> CreateModerationRequestInput
$cmin :: CreateModerationRequestInput
-> CreateModerationRequestInput -> CreateModerationRequestInput
min :: CreateModerationRequestInput
-> CreateModerationRequestInput -> CreateModerationRequestInput
Ord, (forall x.
 CreateModerationRequestInput -> Rep CreateModerationRequestInput x)
-> (forall x.
    Rep CreateModerationRequestInput x -> CreateModerationRequestInput)
-> Generic CreateModerationRequestInput
forall x.
Rep CreateModerationRequestInput x -> CreateModerationRequestInput
forall x.
CreateModerationRequestInput -> Rep CreateModerationRequestInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateModerationRequestInput -> Rep CreateModerationRequestInput x
from :: forall x.
CreateModerationRequestInput -> Rep CreateModerationRequestInput x
$cto :: forall x.
Rep CreateModerationRequestInput x -> CreateModerationRequestInput
to :: forall x.
Rep CreateModerationRequestInput x -> CreateModerationRequestInput
Generic, Typeable CreateModerationRequestInput
Typeable CreateModerationRequestInput =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateModerationRequestInput
 -> c CreateModerationRequestInput)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateModerationRequestInput)
-> (CreateModerationRequestInput -> Constr)
-> (CreateModerationRequestInput -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateModerationRequestInput))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateModerationRequestInput))
-> ((forall b. Data b => b -> b)
    -> CreateModerationRequestInput -> CreateModerationRequestInput)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationRequestInput
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationRequestInput
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateModerationRequestInput -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateModerationRequestInput
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationRequestInput -> m CreateModerationRequestInput)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationRequestInput -> m CreateModerationRequestInput)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationRequestInput -> m CreateModerationRequestInput)
-> Data CreateModerationRequestInput
CreateModerationRequestInput -> Constr
CreateModerationRequestInput -> DataType
(forall b. Data b => b -> b)
-> CreateModerationRequestInput -> CreateModerationRequestInput
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationRequestInput
-> u
forall u.
(forall d. Data d => d -> u) -> CreateModerationRequestInput -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestInput
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestInput
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestInput -> m CreateModerationRequestInput
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestInput -> m CreateModerationRequestInput
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationRequestInput
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationRequestInput
-> c CreateModerationRequestInput
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationRequestInput)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationRequestInput)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationRequestInput
-> c CreateModerationRequestInput
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationRequestInput
-> c CreateModerationRequestInput
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationRequestInput
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationRequestInput
$ctoConstr :: CreateModerationRequestInput -> Constr
toConstr :: CreateModerationRequestInput -> Constr
$cdataTypeOf :: CreateModerationRequestInput -> DataType
dataTypeOf :: CreateModerationRequestInput -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationRequestInput)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationRequestInput)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationRequestInput)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationRequestInput)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateModerationRequestInput -> CreateModerationRequestInput
gmapT :: (forall b. Data b => b -> b)
-> CreateModerationRequestInput -> CreateModerationRequestInput
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestInput
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestInput
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestInput
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestInput
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateModerationRequestInput -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateModerationRequestInput -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationRequestInput
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationRequestInput
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestInput -> m CreateModerationRequestInput
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestInput -> m CreateModerationRequestInput
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestInput -> m CreateModerationRequestInput
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestInput -> m CreateModerationRequestInput
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestInput -> m CreateModerationRequestInput
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestInput -> m CreateModerationRequestInput
Data)

instance FromJSON CreateModerationRequestInput where
  parseJSON :: Value -> Parser CreateModerationRequestInput
parseJSON = Options -> Value -> Parser CreateModerationRequestInput
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createModerationRequestInput")
instance ToJSON CreateModerationRequestInput where
  toJSON :: CreateModerationRequestInput -> Value
toJSON = Options -> CreateModerationRequestInput -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createModerationRequestInput")


-- | Two content moderations models are available: &#x60;text-moderation-stable&#x60; and &#x60;text-moderation-latest&#x60;.  The default is &#x60;text-moderation-latest&#x60; which will be automatically upgraded over time. This ensures you are always using our most accurate model. If you use &#x60;text-moderation-stable&#x60;, we will provide advanced notice before updating the model. Accuracy of &#x60;text-moderation-stable&#x60; may be slightly lower than for &#x60;text-moderation-latest&#x60;. 
data CreateModerationRequestModel = CreateModerationRequestModel Text  deriving (Int -> CreateModerationRequestModel -> ShowS
[CreateModerationRequestModel] -> ShowS
CreateModerationRequestModel -> String
(Int -> CreateModerationRequestModel -> ShowS)
-> (CreateModerationRequestModel -> String)
-> ([CreateModerationRequestModel] -> ShowS)
-> Show CreateModerationRequestModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateModerationRequestModel -> ShowS
showsPrec :: Int -> CreateModerationRequestModel -> ShowS
$cshow :: CreateModerationRequestModel -> String
show :: CreateModerationRequestModel -> String
$cshowList :: [CreateModerationRequestModel] -> ShowS
showList :: [CreateModerationRequestModel] -> ShowS
Show, CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
(CreateModerationRequestModel
 -> CreateModerationRequestModel -> Bool)
-> (CreateModerationRequestModel
    -> CreateModerationRequestModel -> Bool)
-> Eq CreateModerationRequestModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
== :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
$c/= :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
/= :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
Eq, Eq CreateModerationRequestModel
Eq CreateModerationRequestModel =>
(CreateModerationRequestModel
 -> CreateModerationRequestModel -> Ordering)
-> (CreateModerationRequestModel
    -> CreateModerationRequestModel -> Bool)
-> (CreateModerationRequestModel
    -> CreateModerationRequestModel -> Bool)
-> (CreateModerationRequestModel
    -> CreateModerationRequestModel -> Bool)
-> (CreateModerationRequestModel
    -> CreateModerationRequestModel -> Bool)
-> (CreateModerationRequestModel
    -> CreateModerationRequestModel -> CreateModerationRequestModel)
-> (CreateModerationRequestModel
    -> CreateModerationRequestModel -> CreateModerationRequestModel)
-> Ord CreateModerationRequestModel
CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
CreateModerationRequestModel
-> CreateModerationRequestModel -> Ordering
CreateModerationRequestModel
-> CreateModerationRequestModel -> CreateModerationRequestModel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Ordering
compare :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Ordering
$c< :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
< :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
$c<= :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
<= :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
$c> :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
> :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
$c>= :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
>= :: CreateModerationRequestModel
-> CreateModerationRequestModel -> Bool
$cmax :: CreateModerationRequestModel
-> CreateModerationRequestModel -> CreateModerationRequestModel
max :: CreateModerationRequestModel
-> CreateModerationRequestModel -> CreateModerationRequestModel
$cmin :: CreateModerationRequestModel
-> CreateModerationRequestModel -> CreateModerationRequestModel
min :: CreateModerationRequestModel
-> CreateModerationRequestModel -> CreateModerationRequestModel
Ord, (forall x.
 CreateModerationRequestModel -> Rep CreateModerationRequestModel x)
-> (forall x.
    Rep CreateModerationRequestModel x -> CreateModerationRequestModel)
-> Generic CreateModerationRequestModel
forall x.
Rep CreateModerationRequestModel x -> CreateModerationRequestModel
forall x.
CreateModerationRequestModel -> Rep CreateModerationRequestModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateModerationRequestModel -> Rep CreateModerationRequestModel x
from :: forall x.
CreateModerationRequestModel -> Rep CreateModerationRequestModel x
$cto :: forall x.
Rep CreateModerationRequestModel x -> CreateModerationRequestModel
to :: forall x.
Rep CreateModerationRequestModel x -> CreateModerationRequestModel
Generic, Typeable CreateModerationRequestModel
Typeable CreateModerationRequestModel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateModerationRequestModel
 -> c CreateModerationRequestModel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateModerationRequestModel)
-> (CreateModerationRequestModel -> Constr)
-> (CreateModerationRequestModel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateModerationRequestModel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateModerationRequestModel))
-> ((forall b. Data b => b -> b)
    -> CreateModerationRequestModel -> CreateModerationRequestModel)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationRequestModel
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationRequestModel
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateModerationRequestModel -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateModerationRequestModel
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationRequestModel -> m CreateModerationRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationRequestModel -> m CreateModerationRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationRequestModel -> m CreateModerationRequestModel)
-> Data CreateModerationRequestModel
CreateModerationRequestModel -> Constr
CreateModerationRequestModel -> DataType
(forall b. Data b => b -> b)
-> CreateModerationRequestModel -> CreateModerationRequestModel
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationRequestModel
-> u
forall u.
(forall d. Data d => d -> u) -> CreateModerationRequestModel -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestModel
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestModel
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestModel -> m CreateModerationRequestModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestModel -> m CreateModerationRequestModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationRequestModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationRequestModel
-> c CreateModerationRequestModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationRequestModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationRequestModel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationRequestModel
-> c CreateModerationRequestModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationRequestModel
-> c CreateModerationRequestModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationRequestModel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationRequestModel
$ctoConstr :: CreateModerationRequestModel -> Constr
toConstr :: CreateModerationRequestModel -> Constr
$cdataTypeOf :: CreateModerationRequestModel -> DataType
dataTypeOf :: CreateModerationRequestModel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationRequestModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationRequestModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationRequestModel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationRequestModel)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateModerationRequestModel -> CreateModerationRequestModel
gmapT :: (forall b. Data b => b -> b)
-> CreateModerationRequestModel -> CreateModerationRequestModel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestModel
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestModel
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestModel
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationRequestModel
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateModerationRequestModel -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateModerationRequestModel -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationRequestModel
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationRequestModel
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestModel -> m CreateModerationRequestModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestModel -> m CreateModerationRequestModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestModel -> m CreateModerationRequestModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestModel -> m CreateModerationRequestModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestModel -> m CreateModerationRequestModel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationRequestModel -> m CreateModerationRequestModel
Data)

instance FromJSON CreateModerationRequestModel where
  parseJSON :: Value -> Parser CreateModerationRequestModel
parseJSON = Options -> Value -> Parser CreateModerationRequestModel
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createModerationRequestModel")
instance ToJSON CreateModerationRequestModel where
  toJSON :: CreateModerationRequestModel -> Value
toJSON = Options -> CreateModerationRequestModel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createModerationRequestModel")


-- | Represents if a given text input is potentially harmful.
data CreateModerationResponse = CreateModerationResponse
  { CreateModerationResponse -> Text
createModerationResponseId :: Text -- ^ The unique identifier for the moderation request.
  , CreateModerationResponse -> Text
createModerationResponseModel :: Text -- ^ The model used to generate the moderation results.
  , CreateModerationResponse -> [CreateModerationResponseResultsInner]
createModerationResponseResults :: [CreateModerationResponseResultsInner] -- ^ A list of moderation objects.
  } deriving (Int -> CreateModerationResponse -> ShowS
[CreateModerationResponse] -> ShowS
CreateModerationResponse -> String
(Int -> CreateModerationResponse -> ShowS)
-> (CreateModerationResponse -> String)
-> ([CreateModerationResponse] -> ShowS)
-> Show CreateModerationResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateModerationResponse -> ShowS
showsPrec :: Int -> CreateModerationResponse -> ShowS
$cshow :: CreateModerationResponse -> String
show :: CreateModerationResponse -> String
$cshowList :: [CreateModerationResponse] -> ShowS
showList :: [CreateModerationResponse] -> ShowS
Show, CreateModerationResponse -> CreateModerationResponse -> Bool
(CreateModerationResponse -> CreateModerationResponse -> Bool)
-> (CreateModerationResponse -> CreateModerationResponse -> Bool)
-> Eq CreateModerationResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateModerationResponse -> CreateModerationResponse -> Bool
== :: CreateModerationResponse -> CreateModerationResponse -> Bool
$c/= :: CreateModerationResponse -> CreateModerationResponse -> Bool
/= :: CreateModerationResponse -> CreateModerationResponse -> Bool
Eq, Eq CreateModerationResponse
Eq CreateModerationResponse =>
(CreateModerationResponse -> CreateModerationResponse -> Ordering)
-> (CreateModerationResponse -> CreateModerationResponse -> Bool)
-> (CreateModerationResponse -> CreateModerationResponse -> Bool)
-> (CreateModerationResponse -> CreateModerationResponse -> Bool)
-> (CreateModerationResponse -> CreateModerationResponse -> Bool)
-> (CreateModerationResponse
    -> CreateModerationResponse -> CreateModerationResponse)
-> (CreateModerationResponse
    -> CreateModerationResponse -> CreateModerationResponse)
-> Ord CreateModerationResponse
CreateModerationResponse -> CreateModerationResponse -> Bool
CreateModerationResponse -> CreateModerationResponse -> Ordering
CreateModerationResponse
-> CreateModerationResponse -> CreateModerationResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateModerationResponse -> CreateModerationResponse -> Ordering
compare :: CreateModerationResponse -> CreateModerationResponse -> Ordering
$c< :: CreateModerationResponse -> CreateModerationResponse -> Bool
< :: CreateModerationResponse -> CreateModerationResponse -> Bool
$c<= :: CreateModerationResponse -> CreateModerationResponse -> Bool
<= :: CreateModerationResponse -> CreateModerationResponse -> Bool
$c> :: CreateModerationResponse -> CreateModerationResponse -> Bool
> :: CreateModerationResponse -> CreateModerationResponse -> Bool
$c>= :: CreateModerationResponse -> CreateModerationResponse -> Bool
>= :: CreateModerationResponse -> CreateModerationResponse -> Bool
$cmax :: CreateModerationResponse
-> CreateModerationResponse -> CreateModerationResponse
max :: CreateModerationResponse
-> CreateModerationResponse -> CreateModerationResponse
$cmin :: CreateModerationResponse
-> CreateModerationResponse -> CreateModerationResponse
min :: CreateModerationResponse
-> CreateModerationResponse -> CreateModerationResponse
Ord, (forall x.
 CreateModerationResponse -> Rep CreateModerationResponse x)
-> (forall x.
    Rep CreateModerationResponse x -> CreateModerationResponse)
-> Generic CreateModerationResponse
forall x.
Rep CreateModerationResponse x -> CreateModerationResponse
forall x.
CreateModerationResponse -> Rep CreateModerationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateModerationResponse -> Rep CreateModerationResponse x
from :: forall x.
CreateModerationResponse -> Rep CreateModerationResponse x
$cto :: forall x.
Rep CreateModerationResponse x -> CreateModerationResponse
to :: forall x.
Rep CreateModerationResponse x -> CreateModerationResponse
Generic, Typeable CreateModerationResponse
Typeable CreateModerationResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateModerationResponse
 -> c CreateModerationResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateModerationResponse)
-> (CreateModerationResponse -> Constr)
-> (CreateModerationResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateModerationResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateModerationResponse))
-> ((forall b. Data b => b -> b)
    -> CreateModerationResponse -> CreateModerationResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateModerationResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> CreateModerationResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponse -> m CreateModerationResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponse -> m CreateModerationResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponse -> m CreateModerationResponse)
-> Data CreateModerationResponse
CreateModerationResponse -> Constr
CreateModerationResponse -> DataType
(forall b. Data b => b -> b)
-> CreateModerationResponse -> CreateModerationResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateModerationResponse -> u
forall u.
(forall d. Data d => d -> u) -> CreateModerationResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponse -> m CreateModerationResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponse -> m CreateModerationResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponse
-> c CreateModerationResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateModerationResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponse
-> c CreateModerationResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponse
-> c CreateModerationResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateModerationResponse
$ctoConstr :: CreateModerationResponse -> Constr
toConstr :: CreateModerationResponse -> Constr
$cdataTypeOf :: CreateModerationResponse -> DataType
dataTypeOf :: CreateModerationResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateModerationResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateModerationResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateModerationResponse -> CreateModerationResponse
gmapT :: (forall b. Data b => b -> b)
-> CreateModerationResponse -> CreateModerationResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateModerationResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateModerationResponse -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateModerationResponse -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateModerationResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponse -> m CreateModerationResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponse -> m CreateModerationResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponse -> m CreateModerationResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponse -> m CreateModerationResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponse -> m CreateModerationResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponse -> m CreateModerationResponse
Data)

instance FromJSON CreateModerationResponse where
  parseJSON :: Value -> Parser CreateModerationResponse
parseJSON = Options -> Value -> Parser CreateModerationResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createModerationResponse")
instance ToJSON CreateModerationResponse where
  toJSON :: CreateModerationResponse -> Value
toJSON = Options -> CreateModerationResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createModerationResponse")


-- | 
data CreateModerationResponseResultsInner = CreateModerationResponseResultsInner
  { CreateModerationResponseResultsInner -> Bool
createModerationResponseResultsInnerFlagged :: Bool -- ^ Whether any of the below categories are flagged.
  , CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInnerCategories
createModerationResponseResultsInnerCategories :: CreateModerationResponseResultsInnerCategories -- ^ 
  , CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInnerCategoryScores
createModerationResponseResultsInnerCategoryUnderscorescores :: CreateModerationResponseResultsInnerCategoryScores -- ^ 
  } deriving (Int -> CreateModerationResponseResultsInner -> ShowS
[CreateModerationResponseResultsInner] -> ShowS
CreateModerationResponseResultsInner -> String
(Int -> CreateModerationResponseResultsInner -> ShowS)
-> (CreateModerationResponseResultsInner -> String)
-> ([CreateModerationResponseResultsInner] -> ShowS)
-> Show CreateModerationResponseResultsInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateModerationResponseResultsInner -> ShowS
showsPrec :: Int -> CreateModerationResponseResultsInner -> ShowS
$cshow :: CreateModerationResponseResultsInner -> String
show :: CreateModerationResponseResultsInner -> String
$cshowList :: [CreateModerationResponseResultsInner] -> ShowS
showList :: [CreateModerationResponseResultsInner] -> ShowS
Show, CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
(CreateModerationResponseResultsInner
 -> CreateModerationResponseResultsInner -> Bool)
-> (CreateModerationResponseResultsInner
    -> CreateModerationResponseResultsInner -> Bool)
-> Eq CreateModerationResponseResultsInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
== :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
$c/= :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
/= :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
Eq, Eq CreateModerationResponseResultsInner
Eq CreateModerationResponseResultsInner =>
(CreateModerationResponseResultsInner
 -> CreateModerationResponseResultsInner -> Ordering)
-> (CreateModerationResponseResultsInner
    -> CreateModerationResponseResultsInner -> Bool)
-> (CreateModerationResponseResultsInner
    -> CreateModerationResponseResultsInner -> Bool)
-> (CreateModerationResponseResultsInner
    -> CreateModerationResponseResultsInner -> Bool)
-> (CreateModerationResponseResultsInner
    -> CreateModerationResponseResultsInner -> Bool)
-> (CreateModerationResponseResultsInner
    -> CreateModerationResponseResultsInner
    -> CreateModerationResponseResultsInner)
-> (CreateModerationResponseResultsInner
    -> CreateModerationResponseResultsInner
    -> CreateModerationResponseResultsInner)
-> Ord CreateModerationResponseResultsInner
CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Ordering
CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Ordering
compare :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Ordering
$c< :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
< :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
$c<= :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
<= :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
$c> :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
> :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
$c>= :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
>= :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner -> Bool
$cmax :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
max :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
$cmin :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
min :: CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
Ord, (forall x.
 CreateModerationResponseResultsInner
 -> Rep CreateModerationResponseResultsInner x)
-> (forall x.
    Rep CreateModerationResponseResultsInner x
    -> CreateModerationResponseResultsInner)
-> Generic CreateModerationResponseResultsInner
forall x.
Rep CreateModerationResponseResultsInner x
-> CreateModerationResponseResultsInner
forall x.
CreateModerationResponseResultsInner
-> Rep CreateModerationResponseResultsInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateModerationResponseResultsInner
-> Rep CreateModerationResponseResultsInner x
from :: forall x.
CreateModerationResponseResultsInner
-> Rep CreateModerationResponseResultsInner x
$cto :: forall x.
Rep CreateModerationResponseResultsInner x
-> CreateModerationResponseResultsInner
to :: forall x.
Rep CreateModerationResponseResultsInner x
-> CreateModerationResponseResultsInner
Generic, Typeable CreateModerationResponseResultsInner
Typeable CreateModerationResponseResultsInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateModerationResponseResultsInner
 -> c CreateModerationResponseResultsInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateModerationResponseResultsInner)
-> (CreateModerationResponseResultsInner -> Constr)
-> (CreateModerationResponseResultsInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateModerationResponseResultsInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateModerationResponseResultsInner))
-> ((forall b. Data b => b -> b)
    -> CreateModerationResponseResultsInner
    -> CreateModerationResponseResultsInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationResponseResultsInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationResponseResultsInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateModerationResponseResultsInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateModerationResponseResultsInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponseResultsInner
    -> m CreateModerationResponseResultsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponseResultsInner
    -> m CreateModerationResponseResultsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponseResultsInner
    -> m CreateModerationResponseResultsInner)
-> Data CreateModerationResponseResultsInner
CreateModerationResponseResultsInner -> Constr
CreateModerationResponseResultsInner -> DataType
(forall b. Data b => b -> b)
-> CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationResponseResultsInner
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateModerationResponseResultsInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInner
-> m CreateModerationResponseResultsInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInner
-> m CreateModerationResponseResultsInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateModerationResponseResultsInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponseResultsInner
-> c CreateModerationResponseResultsInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationResponseResultsInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponseResultsInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponseResultsInner
-> c CreateModerationResponseResultsInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponseResultsInner
-> c CreateModerationResponseResultsInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateModerationResponseResultsInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateModerationResponseResultsInner
$ctoConstr :: CreateModerationResponseResultsInner -> Constr
toConstr :: CreateModerationResponseResultsInner -> Constr
$cdataTypeOf :: CreateModerationResponseResultsInner -> DataType
dataTypeOf :: CreateModerationResponseResultsInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationResponseResultsInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationResponseResultsInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponseResultsInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponseResultsInner)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
gmapT :: (forall b. Data b => b -> b)
-> CreateModerationResponseResultsInner
-> CreateModerationResponseResultsInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateModerationResponseResultsInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateModerationResponseResultsInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationResponseResultsInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationResponseResultsInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInner
-> m CreateModerationResponseResultsInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInner
-> m CreateModerationResponseResultsInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInner
-> m CreateModerationResponseResultsInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInner
-> m CreateModerationResponseResultsInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInner
-> m CreateModerationResponseResultsInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInner
-> m CreateModerationResponseResultsInner
Data)

instance FromJSON CreateModerationResponseResultsInner where
  parseJSON :: Value -> Parser CreateModerationResponseResultsInner
parseJSON = Options -> Value -> Parser CreateModerationResponseResultsInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createModerationResponseResultsInner")
instance ToJSON CreateModerationResponseResultsInner where
  toJSON :: CreateModerationResponseResultsInner -> Value
toJSON = Options -> CreateModerationResponseResultsInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createModerationResponseResultsInner")


-- | A list of the categories, and whether they are flagged or not.
data CreateModerationResponseResultsInnerCategories = CreateModerationResponseResultsInnerCategories
  { CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesHate :: Bool -- ^ Content that expresses, incites, or promotes hate based on race, gender, ethnicity, religion, nationality, sexual orientation, disability status, or caste. Hateful content aimed at non-protected groups (e.g., chess players) is harassment.
  , CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesHateSlashthreatening :: Bool -- ^ Hateful content that also includes violence or serious harm towards the targeted group based on race, gender, ethnicity, religion, nationality, sexual orientation, disability status, or caste.
  , CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesHarassment :: Bool -- ^ Content that expresses, incites, or promotes harassing language towards any target.
  , CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesHarassmentSlashthreatening :: Bool -- ^ Harassment content that also includes violence or serious harm towards any target.
  , CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesSelfDashharm :: Bool -- ^ Content that promotes, encourages, or depicts acts of self-harm, such as suicide, cutting, and eating disorders.
  , CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesSelfDashharmSlashintent :: Bool -- ^ Content where the speaker expresses that they are engaging or intend to engage in acts of self-harm, such as suicide, cutting, and eating disorders.
  , CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesSelfDashharmSlashinstructions :: Bool -- ^ Content that encourages performing acts of self-harm, such as suicide, cutting, and eating disorders, or that gives instructions or advice on how to commit such acts.
  , CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesSexual :: Bool -- ^ Content meant to arouse sexual excitement, such as the description of sexual activity, or that promotes sexual services (excluding sex education and wellness).
  , CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesSexualSlashminors :: Bool -- ^ Sexual content that includes an individual who is under 18 years old.
  , CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesViolence :: Bool -- ^ Content that depicts death, violence, or physical injury.
  , CreateModerationResponseResultsInnerCategories -> Bool
createModerationResponseResultsInnerCategoriesViolenceSlashgraphic :: Bool -- ^ Content that depicts death, violence, or physical injury in graphic detail.
  } deriving (Int -> CreateModerationResponseResultsInnerCategories -> ShowS
[CreateModerationResponseResultsInnerCategories] -> ShowS
CreateModerationResponseResultsInnerCategories -> String
(Int -> CreateModerationResponseResultsInnerCategories -> ShowS)
-> (CreateModerationResponseResultsInnerCategories -> String)
-> ([CreateModerationResponseResultsInnerCategories] -> ShowS)
-> Show CreateModerationResponseResultsInnerCategories
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateModerationResponseResultsInnerCategories -> ShowS
showsPrec :: Int -> CreateModerationResponseResultsInnerCategories -> ShowS
$cshow :: CreateModerationResponseResultsInnerCategories -> String
show :: CreateModerationResponseResultsInnerCategories -> String
$cshowList :: [CreateModerationResponseResultsInnerCategories] -> ShowS
showList :: [CreateModerationResponseResultsInnerCategories] -> ShowS
Show, CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
(CreateModerationResponseResultsInnerCategories
 -> CreateModerationResponseResultsInnerCategories -> Bool)
-> (CreateModerationResponseResultsInnerCategories
    -> CreateModerationResponseResultsInnerCategories -> Bool)
-> Eq CreateModerationResponseResultsInnerCategories
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
== :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
$c/= :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
/= :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
Eq, Eq CreateModerationResponseResultsInnerCategories
Eq CreateModerationResponseResultsInnerCategories =>
(CreateModerationResponseResultsInnerCategories
 -> CreateModerationResponseResultsInnerCategories -> Ordering)
-> (CreateModerationResponseResultsInnerCategories
    -> CreateModerationResponseResultsInnerCategories -> Bool)
-> (CreateModerationResponseResultsInnerCategories
    -> CreateModerationResponseResultsInnerCategories -> Bool)
-> (CreateModerationResponseResultsInnerCategories
    -> CreateModerationResponseResultsInnerCategories -> Bool)
-> (CreateModerationResponseResultsInnerCategories
    -> CreateModerationResponseResultsInnerCategories -> Bool)
-> (CreateModerationResponseResultsInnerCategories
    -> CreateModerationResponseResultsInnerCategories
    -> CreateModerationResponseResultsInnerCategories)
-> (CreateModerationResponseResultsInnerCategories
    -> CreateModerationResponseResultsInnerCategories
    -> CreateModerationResponseResultsInnerCategories)
-> Ord CreateModerationResponseResultsInnerCategories
CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Ordering
CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Ordering
compare :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Ordering
$c< :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
< :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
$c<= :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
<= :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
$c> :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
> :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
$c>= :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
>= :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories -> Bool
$cmax :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
max :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
$cmin :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
min :: CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
Ord, (forall x.
 CreateModerationResponseResultsInnerCategories
 -> Rep CreateModerationResponseResultsInnerCategories x)
-> (forall x.
    Rep CreateModerationResponseResultsInnerCategories x
    -> CreateModerationResponseResultsInnerCategories)
-> Generic CreateModerationResponseResultsInnerCategories
forall x.
Rep CreateModerationResponseResultsInnerCategories x
-> CreateModerationResponseResultsInnerCategories
forall x.
CreateModerationResponseResultsInnerCategories
-> Rep CreateModerationResponseResultsInnerCategories x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateModerationResponseResultsInnerCategories
-> Rep CreateModerationResponseResultsInnerCategories x
from :: forall x.
CreateModerationResponseResultsInnerCategories
-> Rep CreateModerationResponseResultsInnerCategories x
$cto :: forall x.
Rep CreateModerationResponseResultsInnerCategories x
-> CreateModerationResponseResultsInnerCategories
to :: forall x.
Rep CreateModerationResponseResultsInnerCategories x
-> CreateModerationResponseResultsInnerCategories
Generic, Typeable CreateModerationResponseResultsInnerCategories
Typeable CreateModerationResponseResultsInnerCategories =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateModerationResponseResultsInnerCategories
 -> c CreateModerationResponseResultsInnerCategories)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateModerationResponseResultsInnerCategories)
-> (CreateModerationResponseResultsInnerCategories -> Constr)
-> (CreateModerationResponseResultsInnerCategories -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateModerationResponseResultsInnerCategories))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateModerationResponseResultsInnerCategories))
-> ((forall b. Data b => b -> b)
    -> CreateModerationResponseResultsInnerCategories
    -> CreateModerationResponseResultsInnerCategories)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationResponseResultsInnerCategories
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationResponseResultsInnerCategories
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateModerationResponseResultsInnerCategories -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateModerationResponseResultsInnerCategories
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponseResultsInnerCategories
    -> m CreateModerationResponseResultsInnerCategories)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponseResultsInnerCategories
    -> m CreateModerationResponseResultsInnerCategories)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponseResultsInnerCategories
    -> m CreateModerationResponseResultsInnerCategories)
-> Data CreateModerationResponseResultsInnerCategories
CreateModerationResponseResultsInnerCategories -> Constr
CreateModerationResponseResultsInnerCategories -> DataType
(forall b. Data b => b -> b)
-> CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategories
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategories -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategories
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategories
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategories
-> m CreateModerationResponseResultsInnerCategories
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategories
-> m CreateModerationResponseResultsInnerCategories
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateModerationResponseResultsInnerCategories
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponseResultsInnerCategories
-> c CreateModerationResponseResultsInnerCategories
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationResponseResultsInnerCategories)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponseResultsInnerCategories)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponseResultsInnerCategories
-> c CreateModerationResponseResultsInnerCategories
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponseResultsInnerCategories
-> c CreateModerationResponseResultsInnerCategories
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateModerationResponseResultsInnerCategories
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateModerationResponseResultsInnerCategories
$ctoConstr :: CreateModerationResponseResultsInnerCategories -> Constr
toConstr :: CreateModerationResponseResultsInnerCategories -> Constr
$cdataTypeOf :: CreateModerationResponseResultsInnerCategories -> DataType
dataTypeOf :: CreateModerationResponseResultsInnerCategories -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationResponseResultsInnerCategories)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationResponseResultsInnerCategories)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponseResultsInnerCategories)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponseResultsInnerCategories)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
gmapT :: (forall b. Data b => b -> b)
-> CreateModerationResponseResultsInnerCategories
-> CreateModerationResponseResultsInnerCategories
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategories
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategories
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategories
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategories
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategories -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategories -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategories
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategories
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategories
-> m CreateModerationResponseResultsInnerCategories
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategories
-> m CreateModerationResponseResultsInnerCategories
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategories
-> m CreateModerationResponseResultsInnerCategories
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategories
-> m CreateModerationResponseResultsInnerCategories
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategories
-> m CreateModerationResponseResultsInnerCategories
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategories
-> m CreateModerationResponseResultsInnerCategories
Data)

instance FromJSON CreateModerationResponseResultsInnerCategories where
  parseJSON :: Value -> Parser CreateModerationResponseResultsInnerCategories
parseJSON = Options
-> Value -> Parser CreateModerationResponseResultsInnerCategories
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createModerationResponseResultsInnerCategories")
instance ToJSON CreateModerationResponseResultsInnerCategories where
  toJSON :: CreateModerationResponseResultsInnerCategories -> Value
toJSON = Options -> CreateModerationResponseResultsInnerCategories -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createModerationResponseResultsInnerCategories")


-- | A list of the categories along with their scores as predicted by model.
data CreateModerationResponseResultsInnerCategoryScores = CreateModerationResponseResultsInnerCategoryScores
  { CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresHate :: Double -- ^ The score for the category 'hate'.
  , CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresHateSlashthreatening :: Double -- ^ The score for the category 'hate/threatening'.
  , CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresHarassment :: Double -- ^ The score for the category 'harassment'.
  , CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresHarassmentSlashthreatening :: Double -- ^ The score for the category 'harassment/threatening'.
  , CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresSelfDashharm :: Double -- ^ The score for the category 'self-harm'.
  , CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresSelfDashharmSlashintent :: Double -- ^ The score for the category 'self-harm/intent'.
  , CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresSelfDashharmSlashinstructions :: Double -- ^ The score for the category 'self-harm/instructions'.
  , CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresSexual :: Double -- ^ The score for the category 'sexual'.
  , CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresSexualSlashminors :: Double -- ^ The score for the category 'sexual/minors'.
  , CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresViolence :: Double -- ^ The score for the category 'violence'.
  , CreateModerationResponseResultsInnerCategoryScores -> Double
createModerationResponseResultsInnerCategoryScoresViolenceSlashgraphic :: Double -- ^ The score for the category 'violence/graphic'.
  } deriving (Int -> CreateModerationResponseResultsInnerCategoryScores -> ShowS
[CreateModerationResponseResultsInnerCategoryScores] -> ShowS
CreateModerationResponseResultsInnerCategoryScores -> String
(Int
 -> CreateModerationResponseResultsInnerCategoryScores -> ShowS)
-> (CreateModerationResponseResultsInnerCategoryScores -> String)
-> ([CreateModerationResponseResultsInnerCategoryScores] -> ShowS)
-> Show CreateModerationResponseResultsInnerCategoryScores
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateModerationResponseResultsInnerCategoryScores -> ShowS
showsPrec :: Int -> CreateModerationResponseResultsInnerCategoryScores -> ShowS
$cshow :: CreateModerationResponseResultsInnerCategoryScores -> String
show :: CreateModerationResponseResultsInnerCategoryScores -> String
$cshowList :: [CreateModerationResponseResultsInnerCategoryScores] -> ShowS
showList :: [CreateModerationResponseResultsInnerCategoryScores] -> ShowS
Show, CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
(CreateModerationResponseResultsInnerCategoryScores
 -> CreateModerationResponseResultsInnerCategoryScores -> Bool)
-> (CreateModerationResponseResultsInnerCategoryScores
    -> CreateModerationResponseResultsInnerCategoryScores -> Bool)
-> Eq CreateModerationResponseResultsInnerCategoryScores
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
== :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
$c/= :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
/= :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
Eq, Eq CreateModerationResponseResultsInnerCategoryScores
Eq CreateModerationResponseResultsInnerCategoryScores =>
(CreateModerationResponseResultsInnerCategoryScores
 -> CreateModerationResponseResultsInnerCategoryScores -> Ordering)
-> (CreateModerationResponseResultsInnerCategoryScores
    -> CreateModerationResponseResultsInnerCategoryScores -> Bool)
-> (CreateModerationResponseResultsInnerCategoryScores
    -> CreateModerationResponseResultsInnerCategoryScores -> Bool)
-> (CreateModerationResponseResultsInnerCategoryScores
    -> CreateModerationResponseResultsInnerCategoryScores -> Bool)
-> (CreateModerationResponseResultsInnerCategoryScores
    -> CreateModerationResponseResultsInnerCategoryScores -> Bool)
-> (CreateModerationResponseResultsInnerCategoryScores
    -> CreateModerationResponseResultsInnerCategoryScores
    -> CreateModerationResponseResultsInnerCategoryScores)
-> (CreateModerationResponseResultsInnerCategoryScores
    -> CreateModerationResponseResultsInnerCategoryScores
    -> CreateModerationResponseResultsInnerCategoryScores)
-> Ord CreateModerationResponseResultsInnerCategoryScores
CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Ordering
CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Ordering
compare :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Ordering
$c< :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
< :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
$c<= :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
<= :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
$c> :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
> :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
$c>= :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
>= :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores -> Bool
$cmax :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
max :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
$cmin :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
min :: CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
Ord, (forall x.
 CreateModerationResponseResultsInnerCategoryScores
 -> Rep CreateModerationResponseResultsInnerCategoryScores x)
-> (forall x.
    Rep CreateModerationResponseResultsInnerCategoryScores x
    -> CreateModerationResponseResultsInnerCategoryScores)
-> Generic CreateModerationResponseResultsInnerCategoryScores
forall x.
Rep CreateModerationResponseResultsInnerCategoryScores x
-> CreateModerationResponseResultsInnerCategoryScores
forall x.
CreateModerationResponseResultsInnerCategoryScores
-> Rep CreateModerationResponseResultsInnerCategoryScores x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateModerationResponseResultsInnerCategoryScores
-> Rep CreateModerationResponseResultsInnerCategoryScores x
from :: forall x.
CreateModerationResponseResultsInnerCategoryScores
-> Rep CreateModerationResponseResultsInnerCategoryScores x
$cto :: forall x.
Rep CreateModerationResponseResultsInnerCategoryScores x
-> CreateModerationResponseResultsInnerCategoryScores
to :: forall x.
Rep CreateModerationResponseResultsInnerCategoryScores x
-> CreateModerationResponseResultsInnerCategoryScores
Generic, Typeable CreateModerationResponseResultsInnerCategoryScores
Typeable CreateModerationResponseResultsInnerCategoryScores =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateModerationResponseResultsInnerCategoryScores
 -> c CreateModerationResponseResultsInnerCategoryScores)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateModerationResponseResultsInnerCategoryScores)
-> (CreateModerationResponseResultsInnerCategoryScores -> Constr)
-> (CreateModerationResponseResultsInnerCategoryScores -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateModerationResponseResultsInnerCategoryScores))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateModerationResponseResultsInnerCategoryScores))
-> ((forall b. Data b => b -> b)
    -> CreateModerationResponseResultsInnerCategoryScores
    -> CreateModerationResponseResultsInnerCategoryScores)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationResponseResultsInnerCategoryScores
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateModerationResponseResultsInnerCategoryScores
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateModerationResponseResultsInnerCategoryScores -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateModerationResponseResultsInnerCategoryScores
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponseResultsInnerCategoryScores
    -> m CreateModerationResponseResultsInnerCategoryScores)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponseResultsInnerCategoryScores
    -> m CreateModerationResponseResultsInnerCategoryScores)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateModerationResponseResultsInnerCategoryScores
    -> m CreateModerationResponseResultsInnerCategoryScores)
-> Data CreateModerationResponseResultsInnerCategoryScores
CreateModerationResponseResultsInnerCategoryScores -> Constr
CreateModerationResponseResultsInnerCategoryScores -> DataType
(forall b. Data b => b -> b)
-> CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategoryScores
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategoryScores -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategoryScores
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategoryScores
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategoryScores
-> m CreateModerationResponseResultsInnerCategoryScores
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategoryScores
-> m CreateModerationResponseResultsInnerCategoryScores
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateModerationResponseResultsInnerCategoryScores
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponseResultsInnerCategoryScores
-> c CreateModerationResponseResultsInnerCategoryScores
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationResponseResultsInnerCategoryScores)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponseResultsInnerCategoryScores)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponseResultsInnerCategoryScores
-> c CreateModerationResponseResultsInnerCategoryScores
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateModerationResponseResultsInnerCategoryScores
-> c CreateModerationResponseResultsInnerCategoryScores
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateModerationResponseResultsInnerCategoryScores
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateModerationResponseResultsInnerCategoryScores
$ctoConstr :: CreateModerationResponseResultsInnerCategoryScores -> Constr
toConstr :: CreateModerationResponseResultsInnerCategoryScores -> Constr
$cdataTypeOf :: CreateModerationResponseResultsInnerCategoryScores -> DataType
dataTypeOf :: CreateModerationResponseResultsInnerCategoryScores -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationResponseResultsInnerCategoryScores)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateModerationResponseResultsInnerCategoryScores)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponseResultsInnerCategoryScores)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateModerationResponseResultsInnerCategoryScores)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
gmapT :: (forall b. Data b => b -> b)
-> CreateModerationResponseResultsInnerCategoryScores
-> CreateModerationResponseResultsInnerCategoryScores
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategoryScores
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategoryScores
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategoryScores
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateModerationResponseResultsInnerCategoryScores
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategoryScores -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategoryScores -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategoryScores
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateModerationResponseResultsInnerCategoryScores
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategoryScores
-> m CreateModerationResponseResultsInnerCategoryScores
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategoryScores
-> m CreateModerationResponseResultsInnerCategoryScores
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategoryScores
-> m CreateModerationResponseResultsInnerCategoryScores
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategoryScores
-> m CreateModerationResponseResultsInnerCategoryScores
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategoryScores
-> m CreateModerationResponseResultsInnerCategoryScores
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateModerationResponseResultsInnerCategoryScores
-> m CreateModerationResponseResultsInnerCategoryScores
Data)

instance FromJSON CreateModerationResponseResultsInnerCategoryScores where
  parseJSON :: Value -> Parser CreateModerationResponseResultsInnerCategoryScores
parseJSON = Options
-> Value
-> Parser CreateModerationResponseResultsInnerCategoryScores
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createModerationResponseResultsInnerCategoryScores")
instance ToJSON CreateModerationResponseResultsInnerCategoryScores where
  toJSON :: CreateModerationResponseResultsInnerCategoryScores -> Value
toJSON = Options
-> CreateModerationResponseResultsInnerCategoryScores -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createModerationResponseResultsInnerCategoryScores")


-- | 
data CreateRunRequest = CreateRunRequest
  { CreateRunRequest -> Text
createRunRequestAssistantUnderscoreid :: Text -- ^ The ID of the [assistant](/docs/api-reference/assistants) to use to execute this run.
  , CreateRunRequest -> Maybe Text
createRunRequestModel :: Maybe Text -- ^ The ID of the [Model](/docs/api-reference/models) to be used to execute this run. If a value is provided here, it will override the model associated with the assistant. If not, the model associated with the assistant will be used.
  , CreateRunRequest -> Maybe Text
createRunRequestInstructions :: Maybe Text -- ^ Overrides the [instructions](/docs/api-reference/assistants/createAssistant) of the assistant. This is useful for modifying the behavior on a per-run basis.
  , CreateRunRequest -> Maybe Text
createRunRequestAdditionalUnderscoreinstructions :: Maybe Text -- ^ Appends additional instructions at the end of the instructions for the run. This is useful for modifying the behavior on a per-run basis without overriding other instructions.
  , CreateRunRequest -> Maybe [AssistantObjectToolsInner]
createRunRequestTools :: Maybe [AssistantObjectToolsInner] -- ^ Override the tools the assistant can use for this run. This is useful for modifying the behavior on a per-run basis.
  , CreateRunRequest -> Maybe Value
createRunRequestMetadata :: Maybe Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> CreateRunRequest -> ShowS
[CreateRunRequest] -> ShowS
CreateRunRequest -> String
(Int -> CreateRunRequest -> ShowS)
-> (CreateRunRequest -> String)
-> ([CreateRunRequest] -> ShowS)
-> Show CreateRunRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateRunRequest -> ShowS
showsPrec :: Int -> CreateRunRequest -> ShowS
$cshow :: CreateRunRequest -> String
show :: CreateRunRequest -> String
$cshowList :: [CreateRunRequest] -> ShowS
showList :: [CreateRunRequest] -> ShowS
Show, CreateRunRequest -> CreateRunRequest -> Bool
(CreateRunRequest -> CreateRunRequest -> Bool)
-> (CreateRunRequest -> CreateRunRequest -> Bool)
-> Eq CreateRunRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateRunRequest -> CreateRunRequest -> Bool
== :: CreateRunRequest -> CreateRunRequest -> Bool
$c/= :: CreateRunRequest -> CreateRunRequest -> Bool
/= :: CreateRunRequest -> CreateRunRequest -> Bool
Eq, Eq CreateRunRequest
Eq CreateRunRequest =>
(CreateRunRequest -> CreateRunRequest -> Ordering)
-> (CreateRunRequest -> CreateRunRequest -> Bool)
-> (CreateRunRequest -> CreateRunRequest -> Bool)
-> (CreateRunRequest -> CreateRunRequest -> Bool)
-> (CreateRunRequest -> CreateRunRequest -> Bool)
-> (CreateRunRequest -> CreateRunRequest -> CreateRunRequest)
-> (CreateRunRequest -> CreateRunRequest -> CreateRunRequest)
-> Ord CreateRunRequest
CreateRunRequest -> CreateRunRequest -> Bool
CreateRunRequest -> CreateRunRequest -> Ordering
CreateRunRequest -> CreateRunRequest -> CreateRunRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateRunRequest -> CreateRunRequest -> Ordering
compare :: CreateRunRequest -> CreateRunRequest -> Ordering
$c< :: CreateRunRequest -> CreateRunRequest -> Bool
< :: CreateRunRequest -> CreateRunRequest -> Bool
$c<= :: CreateRunRequest -> CreateRunRequest -> Bool
<= :: CreateRunRequest -> CreateRunRequest -> Bool
$c> :: CreateRunRequest -> CreateRunRequest -> Bool
> :: CreateRunRequest -> CreateRunRequest -> Bool
$c>= :: CreateRunRequest -> CreateRunRequest -> Bool
>= :: CreateRunRequest -> CreateRunRequest -> Bool
$cmax :: CreateRunRequest -> CreateRunRequest -> CreateRunRequest
max :: CreateRunRequest -> CreateRunRequest -> CreateRunRequest
$cmin :: CreateRunRequest -> CreateRunRequest -> CreateRunRequest
min :: CreateRunRequest -> CreateRunRequest -> CreateRunRequest
Ord, (forall x. CreateRunRequest -> Rep CreateRunRequest x)
-> (forall x. Rep CreateRunRequest x -> CreateRunRequest)
-> Generic CreateRunRequest
forall x. Rep CreateRunRequest x -> CreateRunRequest
forall x. CreateRunRequest -> Rep CreateRunRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateRunRequest -> Rep CreateRunRequest x
from :: forall x. CreateRunRequest -> Rep CreateRunRequest x
$cto :: forall x. Rep CreateRunRequest x -> CreateRunRequest
to :: forall x. Rep CreateRunRequest x -> CreateRunRequest
Generic, Typeable CreateRunRequest
Typeable CreateRunRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CreateRunRequest -> c CreateRunRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateRunRequest)
-> (CreateRunRequest -> Constr)
-> (CreateRunRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateRunRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateRunRequest))
-> ((forall b. Data b => b -> b)
    -> CreateRunRequest -> CreateRunRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateRunRequest -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateRunRequest -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateRunRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CreateRunRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateRunRequest -> m CreateRunRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateRunRequest -> m CreateRunRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateRunRequest -> m CreateRunRequest)
-> Data CreateRunRequest
CreateRunRequest -> Constr
CreateRunRequest -> DataType
(forall b. Data b => b -> b)
-> CreateRunRequest -> CreateRunRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateRunRequest -> u
forall u. (forall d. Data d => d -> u) -> CreateRunRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRunRequest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRunRequest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateRunRequest -> m CreateRunRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateRunRequest -> m CreateRunRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateRunRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CreateRunRequest -> c CreateRunRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateRunRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateRunRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CreateRunRequest -> c CreateRunRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CreateRunRequest -> c CreateRunRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateRunRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateRunRequest
$ctoConstr :: CreateRunRequest -> Constr
toConstr :: CreateRunRequest -> Constr
$cdataTypeOf :: CreateRunRequest -> DataType
dataTypeOf :: CreateRunRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateRunRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateRunRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateRunRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateRunRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateRunRequest -> CreateRunRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateRunRequest -> CreateRunRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRunRequest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRunRequest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRunRequest -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRunRequest -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CreateRunRequest -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CreateRunRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateRunRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateRunRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateRunRequest -> m CreateRunRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateRunRequest -> m CreateRunRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateRunRequest -> m CreateRunRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateRunRequest -> m CreateRunRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateRunRequest -> m CreateRunRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateRunRequest -> m CreateRunRequest
Data)

instance FromJSON CreateRunRequest where
  parseJSON :: Value -> Parser CreateRunRequest
parseJSON = Options -> Value -> Parser CreateRunRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createRunRequest")
instance ToJSON CreateRunRequest where
  toJSON :: CreateRunRequest -> Value
toJSON = Options -> CreateRunRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createRunRequest")


-- | 
data CreateSpeechRequest = CreateSpeechRequest
  { CreateSpeechRequest -> CreateSpeechRequestModel
createSpeechRequestModel :: CreateSpeechRequestModel -- ^ 
  , CreateSpeechRequest -> Text
createSpeechRequestInput :: Text -- ^ The text to generate audio for. The maximum length is 4096 characters.
  , CreateSpeechRequest -> Text
createSpeechRequestVoice :: Text -- ^ The voice to use when generating the audio. Supported voices are `alloy`, `echo`, `fable`, `onyx`, `nova`, and `shimmer`. Previews of the voices are available in the [Text to speech guide](/docs/guides/text-to-speech/voice-options).
  , CreateSpeechRequest -> Maybe Text
createSpeechRequestResponseUnderscoreformat :: Maybe Text -- ^ The format to audio in. Supported formats are `mp3`, `opus`, `aac`, `flac`, `wav`, and `pcm`.
  , CreateSpeechRequest -> Maybe Double
createSpeechRequestSpeed :: Maybe Double -- ^ The speed of the generated audio. Select a value from `0.25` to `4.0`. `1.0` is the default.
  } deriving (Int -> CreateSpeechRequest -> ShowS
[CreateSpeechRequest] -> ShowS
CreateSpeechRequest -> String
(Int -> CreateSpeechRequest -> ShowS)
-> (CreateSpeechRequest -> String)
-> ([CreateSpeechRequest] -> ShowS)
-> Show CreateSpeechRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateSpeechRequest -> ShowS
showsPrec :: Int -> CreateSpeechRequest -> ShowS
$cshow :: CreateSpeechRequest -> String
show :: CreateSpeechRequest -> String
$cshowList :: [CreateSpeechRequest] -> ShowS
showList :: [CreateSpeechRequest] -> ShowS
Show, CreateSpeechRequest -> CreateSpeechRequest -> Bool
(CreateSpeechRequest -> CreateSpeechRequest -> Bool)
-> (CreateSpeechRequest -> CreateSpeechRequest -> Bool)
-> Eq CreateSpeechRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
== :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
$c/= :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
/= :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
Eq, Eq CreateSpeechRequest
Eq CreateSpeechRequest =>
(CreateSpeechRequest -> CreateSpeechRequest -> Ordering)
-> (CreateSpeechRequest -> CreateSpeechRequest -> Bool)
-> (CreateSpeechRequest -> CreateSpeechRequest -> Bool)
-> (CreateSpeechRequest -> CreateSpeechRequest -> Bool)
-> (CreateSpeechRequest -> CreateSpeechRequest -> Bool)
-> (CreateSpeechRequest
    -> CreateSpeechRequest -> CreateSpeechRequest)
-> (CreateSpeechRequest
    -> CreateSpeechRequest -> CreateSpeechRequest)
-> Ord CreateSpeechRequest
CreateSpeechRequest -> CreateSpeechRequest -> Bool
CreateSpeechRequest -> CreateSpeechRequest -> Ordering
CreateSpeechRequest -> CreateSpeechRequest -> CreateSpeechRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateSpeechRequest -> CreateSpeechRequest -> Ordering
compare :: CreateSpeechRequest -> CreateSpeechRequest -> Ordering
$c< :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
< :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
$c<= :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
<= :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
$c> :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
> :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
$c>= :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
>= :: CreateSpeechRequest -> CreateSpeechRequest -> Bool
$cmax :: CreateSpeechRequest -> CreateSpeechRequest -> CreateSpeechRequest
max :: CreateSpeechRequest -> CreateSpeechRequest -> CreateSpeechRequest
$cmin :: CreateSpeechRequest -> CreateSpeechRequest -> CreateSpeechRequest
min :: CreateSpeechRequest -> CreateSpeechRequest -> CreateSpeechRequest
Ord, (forall x. CreateSpeechRequest -> Rep CreateSpeechRequest x)
-> (forall x. Rep CreateSpeechRequest x -> CreateSpeechRequest)
-> Generic CreateSpeechRequest
forall x. Rep CreateSpeechRequest x -> CreateSpeechRequest
forall x. CreateSpeechRequest -> Rep CreateSpeechRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateSpeechRequest -> Rep CreateSpeechRequest x
from :: forall x. CreateSpeechRequest -> Rep CreateSpeechRequest x
$cto :: forall x. Rep CreateSpeechRequest x -> CreateSpeechRequest
to :: forall x. Rep CreateSpeechRequest x -> CreateSpeechRequest
Generic, Typeable CreateSpeechRequest
Typeable CreateSpeechRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateSpeechRequest
 -> c CreateSpeechRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateSpeechRequest)
-> (CreateSpeechRequest -> Constr)
-> (CreateSpeechRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateSpeechRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateSpeechRequest))
-> ((forall b. Data b => b -> b)
    -> CreateSpeechRequest -> CreateSpeechRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateSpeechRequest -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateSpeechRequest -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateSpeechRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CreateSpeechRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateSpeechRequest -> m CreateSpeechRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateSpeechRequest -> m CreateSpeechRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateSpeechRequest -> m CreateSpeechRequest)
-> Data CreateSpeechRequest
CreateSpeechRequest -> Constr
CreateSpeechRequest -> DataType
(forall b. Data b => b -> b)
-> CreateSpeechRequest -> CreateSpeechRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateSpeechRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateSpeechRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateSpeechRequest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateSpeechRequest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequest -> m CreateSpeechRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequest -> m CreateSpeechRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateSpeechRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateSpeechRequest
-> c CreateSpeechRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateSpeechRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateSpeechRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateSpeechRequest
-> c CreateSpeechRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateSpeechRequest
-> c CreateSpeechRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateSpeechRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateSpeechRequest
$ctoConstr :: CreateSpeechRequest -> Constr
toConstr :: CreateSpeechRequest -> Constr
$cdataTypeOf :: CreateSpeechRequest -> DataType
dataTypeOf :: CreateSpeechRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateSpeechRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateSpeechRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateSpeechRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateSpeechRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateSpeechRequest -> CreateSpeechRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateSpeechRequest -> CreateSpeechRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateSpeechRequest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateSpeechRequest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateSpeechRequest -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateSpeechRequest -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateSpeechRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateSpeechRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateSpeechRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateSpeechRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequest -> m CreateSpeechRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequest -> m CreateSpeechRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequest -> m CreateSpeechRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequest -> m CreateSpeechRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequest -> m CreateSpeechRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequest -> m CreateSpeechRequest
Data)

instance FromJSON CreateSpeechRequest where
  parseJSON :: Value -> Parser CreateSpeechRequest
parseJSON = Options -> Value -> Parser CreateSpeechRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createSpeechRequest")
instance ToJSON CreateSpeechRequest where
  toJSON :: CreateSpeechRequest -> Value
toJSON = Options -> CreateSpeechRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createSpeechRequest")


-- | One of the available [TTS models](/docs/models/tts): &#x60;tts-1&#x60; or &#x60;tts-1-hd&#x60; 
data CreateSpeechRequestModel = CreateSpeechRequestModel Text  deriving (Int -> CreateSpeechRequestModel -> ShowS
[CreateSpeechRequestModel] -> ShowS
CreateSpeechRequestModel -> String
(Int -> CreateSpeechRequestModel -> ShowS)
-> (CreateSpeechRequestModel -> String)
-> ([CreateSpeechRequestModel] -> ShowS)
-> Show CreateSpeechRequestModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateSpeechRequestModel -> ShowS
showsPrec :: Int -> CreateSpeechRequestModel -> ShowS
$cshow :: CreateSpeechRequestModel -> String
show :: CreateSpeechRequestModel -> String
$cshowList :: [CreateSpeechRequestModel] -> ShowS
showList :: [CreateSpeechRequestModel] -> ShowS
Show, CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
(CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool)
-> (CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool)
-> Eq CreateSpeechRequestModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
== :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
$c/= :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
/= :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
Eq, Eq CreateSpeechRequestModel
Eq CreateSpeechRequestModel =>
(CreateSpeechRequestModel -> CreateSpeechRequestModel -> Ordering)
-> (CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool)
-> (CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool)
-> (CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool)
-> (CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool)
-> (CreateSpeechRequestModel
    -> CreateSpeechRequestModel -> CreateSpeechRequestModel)
-> (CreateSpeechRequestModel
    -> CreateSpeechRequestModel -> CreateSpeechRequestModel)
-> Ord CreateSpeechRequestModel
CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
CreateSpeechRequestModel -> CreateSpeechRequestModel -> Ordering
CreateSpeechRequestModel
-> CreateSpeechRequestModel -> CreateSpeechRequestModel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Ordering
compare :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Ordering
$c< :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
< :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
$c<= :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
<= :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
$c> :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
> :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
$c>= :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
>= :: CreateSpeechRequestModel -> CreateSpeechRequestModel -> Bool
$cmax :: CreateSpeechRequestModel
-> CreateSpeechRequestModel -> CreateSpeechRequestModel
max :: CreateSpeechRequestModel
-> CreateSpeechRequestModel -> CreateSpeechRequestModel
$cmin :: CreateSpeechRequestModel
-> CreateSpeechRequestModel -> CreateSpeechRequestModel
min :: CreateSpeechRequestModel
-> CreateSpeechRequestModel -> CreateSpeechRequestModel
Ord, (forall x.
 CreateSpeechRequestModel -> Rep CreateSpeechRequestModel x)
-> (forall x.
    Rep CreateSpeechRequestModel x -> CreateSpeechRequestModel)
-> Generic CreateSpeechRequestModel
forall x.
Rep CreateSpeechRequestModel x -> CreateSpeechRequestModel
forall x.
CreateSpeechRequestModel -> Rep CreateSpeechRequestModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateSpeechRequestModel -> Rep CreateSpeechRequestModel x
from :: forall x.
CreateSpeechRequestModel -> Rep CreateSpeechRequestModel x
$cto :: forall x.
Rep CreateSpeechRequestModel x -> CreateSpeechRequestModel
to :: forall x.
Rep CreateSpeechRequestModel x -> CreateSpeechRequestModel
Generic, Typeable CreateSpeechRequestModel
Typeable CreateSpeechRequestModel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateSpeechRequestModel
 -> c CreateSpeechRequestModel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateSpeechRequestModel)
-> (CreateSpeechRequestModel -> Constr)
-> (CreateSpeechRequestModel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateSpeechRequestModel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateSpeechRequestModel))
-> ((forall b. Data b => b -> b)
    -> CreateSpeechRequestModel -> CreateSpeechRequestModel)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateSpeechRequestModel
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateSpeechRequestModel
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateSpeechRequestModel -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> CreateSpeechRequestModel -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateSpeechRequestModel -> m CreateSpeechRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateSpeechRequestModel -> m CreateSpeechRequestModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateSpeechRequestModel -> m CreateSpeechRequestModel)
-> Data CreateSpeechRequestModel
CreateSpeechRequestModel -> Constr
CreateSpeechRequestModel -> DataType
(forall b. Data b => b -> b)
-> CreateSpeechRequestModel -> CreateSpeechRequestModel
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateSpeechRequestModel -> u
forall u.
(forall d. Data d => d -> u) -> CreateSpeechRequestModel -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateSpeechRequestModel
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateSpeechRequestModel
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequestModel -> m CreateSpeechRequestModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequestModel -> m CreateSpeechRequestModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateSpeechRequestModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateSpeechRequestModel
-> c CreateSpeechRequestModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateSpeechRequestModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateSpeechRequestModel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateSpeechRequestModel
-> c CreateSpeechRequestModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateSpeechRequestModel
-> c CreateSpeechRequestModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateSpeechRequestModel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateSpeechRequestModel
$ctoConstr :: CreateSpeechRequestModel -> Constr
toConstr :: CreateSpeechRequestModel -> Constr
$cdataTypeOf :: CreateSpeechRequestModel -> DataType
dataTypeOf :: CreateSpeechRequestModel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateSpeechRequestModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateSpeechRequestModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateSpeechRequestModel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateSpeechRequestModel)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateSpeechRequestModel -> CreateSpeechRequestModel
gmapT :: (forall b. Data b => b -> b)
-> CreateSpeechRequestModel -> CreateSpeechRequestModel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateSpeechRequestModel
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateSpeechRequestModel
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateSpeechRequestModel
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateSpeechRequestModel
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateSpeechRequestModel -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateSpeechRequestModel -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateSpeechRequestModel -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateSpeechRequestModel -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequestModel -> m CreateSpeechRequestModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequestModel -> m CreateSpeechRequestModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequestModel -> m CreateSpeechRequestModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequestModel -> m CreateSpeechRequestModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequestModel -> m CreateSpeechRequestModel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateSpeechRequestModel -> m CreateSpeechRequestModel
Data)

instance FromJSON CreateSpeechRequestModel where
  parseJSON :: Value -> Parser CreateSpeechRequestModel
parseJSON = Options -> Value -> Parser CreateSpeechRequestModel
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createSpeechRequestModel")
instance ToJSON CreateSpeechRequestModel where
  toJSON :: CreateSpeechRequestModel -> Value
toJSON = Options -> CreateSpeechRequestModel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createSpeechRequestModel")


-- | 
data CreateThreadAndRunRequest = CreateThreadAndRunRequest
  { CreateThreadAndRunRequest -> Text
createThreadAndRunRequestAssistantUnderscoreid :: Text -- ^ The ID of the [assistant](/docs/api-reference/assistants) to use to execute this run.
  , CreateThreadAndRunRequest -> Maybe CreateThreadRequest
createThreadAndRunRequestThread :: Maybe CreateThreadRequest -- ^ 
  , CreateThreadAndRunRequest -> Maybe Text
createThreadAndRunRequestModel :: Maybe Text -- ^ The ID of the [Model](/docs/api-reference/models) to be used to execute this run. If a value is provided here, it will override the model associated with the assistant. If not, the model associated with the assistant will be used.
  , CreateThreadAndRunRequest -> Maybe Text
createThreadAndRunRequestInstructions :: Maybe Text -- ^ Override the default system message of the assistant. This is useful for modifying the behavior on a per-run basis.
  , CreateThreadAndRunRequest
-> Maybe [CreateThreadAndRunRequestToolsInner]
createThreadAndRunRequestTools :: Maybe [CreateThreadAndRunRequestToolsInner] -- ^ Override the tools the assistant can use for this run. This is useful for modifying the behavior on a per-run basis.
  , CreateThreadAndRunRequest -> Maybe Value
createThreadAndRunRequestMetadata :: Maybe Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> CreateThreadAndRunRequest -> ShowS
[CreateThreadAndRunRequest] -> ShowS
CreateThreadAndRunRequest -> String
(Int -> CreateThreadAndRunRequest -> ShowS)
-> (CreateThreadAndRunRequest -> String)
-> ([CreateThreadAndRunRequest] -> ShowS)
-> Show CreateThreadAndRunRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateThreadAndRunRequest -> ShowS
showsPrec :: Int -> CreateThreadAndRunRequest -> ShowS
$cshow :: CreateThreadAndRunRequest -> String
show :: CreateThreadAndRunRequest -> String
$cshowList :: [CreateThreadAndRunRequest] -> ShowS
showList :: [CreateThreadAndRunRequest] -> ShowS
Show, CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
(CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool)
-> (CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool)
-> Eq CreateThreadAndRunRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
== :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
$c/= :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
/= :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
Eq, Eq CreateThreadAndRunRequest
Eq CreateThreadAndRunRequest =>
(CreateThreadAndRunRequest
 -> CreateThreadAndRunRequest -> Ordering)
-> (CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool)
-> (CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool)
-> (CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool)
-> (CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool)
-> (CreateThreadAndRunRequest
    -> CreateThreadAndRunRequest -> CreateThreadAndRunRequest)
-> (CreateThreadAndRunRequest
    -> CreateThreadAndRunRequest -> CreateThreadAndRunRequest)
-> Ord CreateThreadAndRunRequest
CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Ordering
CreateThreadAndRunRequest
-> CreateThreadAndRunRequest -> CreateThreadAndRunRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Ordering
compare :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Ordering
$c< :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
< :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
$c<= :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
<= :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
$c> :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
> :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
$c>= :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
>= :: CreateThreadAndRunRequest -> CreateThreadAndRunRequest -> Bool
$cmax :: CreateThreadAndRunRequest
-> CreateThreadAndRunRequest -> CreateThreadAndRunRequest
max :: CreateThreadAndRunRequest
-> CreateThreadAndRunRequest -> CreateThreadAndRunRequest
$cmin :: CreateThreadAndRunRequest
-> CreateThreadAndRunRequest -> CreateThreadAndRunRequest
min :: CreateThreadAndRunRequest
-> CreateThreadAndRunRequest -> CreateThreadAndRunRequest
Ord, (forall x.
 CreateThreadAndRunRequest -> Rep CreateThreadAndRunRequest x)
-> (forall x.
    Rep CreateThreadAndRunRequest x -> CreateThreadAndRunRequest)
-> Generic CreateThreadAndRunRequest
forall x.
Rep CreateThreadAndRunRequest x -> CreateThreadAndRunRequest
forall x.
CreateThreadAndRunRequest -> Rep CreateThreadAndRunRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateThreadAndRunRequest -> Rep CreateThreadAndRunRequest x
from :: forall x.
CreateThreadAndRunRequest -> Rep CreateThreadAndRunRequest x
$cto :: forall x.
Rep CreateThreadAndRunRequest x -> CreateThreadAndRunRequest
to :: forall x.
Rep CreateThreadAndRunRequest x -> CreateThreadAndRunRequest
Generic, Typeable CreateThreadAndRunRequest
Typeable CreateThreadAndRunRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateThreadAndRunRequest
 -> c CreateThreadAndRunRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateThreadAndRunRequest)
-> (CreateThreadAndRunRequest -> Constr)
-> (CreateThreadAndRunRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateThreadAndRunRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateThreadAndRunRequest))
-> ((forall b. Data b => b -> b)
    -> CreateThreadAndRunRequest -> CreateThreadAndRunRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateThreadAndRunRequest
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateThreadAndRunRequest
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateThreadAndRunRequest -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> CreateThreadAndRunRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest)
-> Data CreateThreadAndRunRequest
CreateThreadAndRunRequest -> Constr
CreateThreadAndRunRequest -> DataType
(forall b. Data b => b -> b)
-> CreateThreadAndRunRequest -> CreateThreadAndRunRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> CreateThreadAndRunRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateThreadAndRunRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequest
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequest
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateThreadAndRunRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateThreadAndRunRequest
-> c CreateThreadAndRunRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateThreadAndRunRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateThreadAndRunRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateThreadAndRunRequest
-> c CreateThreadAndRunRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateThreadAndRunRequest
-> c CreateThreadAndRunRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateThreadAndRunRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateThreadAndRunRequest
$ctoConstr :: CreateThreadAndRunRequest -> Constr
toConstr :: CreateThreadAndRunRequest -> Constr
$cdataTypeOf :: CreateThreadAndRunRequest -> DataType
dataTypeOf :: CreateThreadAndRunRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateThreadAndRunRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateThreadAndRunRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateThreadAndRunRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateThreadAndRunRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateThreadAndRunRequest -> CreateThreadAndRunRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateThreadAndRunRequest -> CreateThreadAndRunRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequest
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequest
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequest
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequest
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateThreadAndRunRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateThreadAndRunRequest -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateThreadAndRunRequest -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> CreateThreadAndRunRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequest -> m CreateThreadAndRunRequest
Data)

instance FromJSON CreateThreadAndRunRequest where
  parseJSON :: Value -> Parser CreateThreadAndRunRequest
parseJSON = Options -> Value -> Parser CreateThreadAndRunRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createThreadAndRunRequest")
instance ToJSON CreateThreadAndRunRequest where
  toJSON :: CreateThreadAndRunRequest -> Value
toJSON = Options -> CreateThreadAndRunRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createThreadAndRunRequest")


-- | 
data CreateThreadAndRunRequestToolsInner = CreateThreadAndRunRequestToolsInner
  { CreateThreadAndRunRequestToolsInner -> Text
createThreadAndRunRequestToolsInnerType :: Text -- ^ The type of tool being defined: `function`
  , CreateThreadAndRunRequestToolsInner -> FunctionObject
createThreadAndRunRequestToolsInnerFunction :: FunctionObject -- ^ 
  } deriving (Int -> CreateThreadAndRunRequestToolsInner -> ShowS
[CreateThreadAndRunRequestToolsInner] -> ShowS
CreateThreadAndRunRequestToolsInner -> String
(Int -> CreateThreadAndRunRequestToolsInner -> ShowS)
-> (CreateThreadAndRunRequestToolsInner -> String)
-> ([CreateThreadAndRunRequestToolsInner] -> ShowS)
-> Show CreateThreadAndRunRequestToolsInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateThreadAndRunRequestToolsInner -> ShowS
showsPrec :: Int -> CreateThreadAndRunRequestToolsInner -> ShowS
$cshow :: CreateThreadAndRunRequestToolsInner -> String
show :: CreateThreadAndRunRequestToolsInner -> String
$cshowList :: [CreateThreadAndRunRequestToolsInner] -> ShowS
showList :: [CreateThreadAndRunRequestToolsInner] -> ShowS
Show, CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
(CreateThreadAndRunRequestToolsInner
 -> CreateThreadAndRunRequestToolsInner -> Bool)
-> (CreateThreadAndRunRequestToolsInner
    -> CreateThreadAndRunRequestToolsInner -> Bool)
-> Eq CreateThreadAndRunRequestToolsInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
== :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
$c/= :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
/= :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
Eq, Eq CreateThreadAndRunRequestToolsInner
Eq CreateThreadAndRunRequestToolsInner =>
(CreateThreadAndRunRequestToolsInner
 -> CreateThreadAndRunRequestToolsInner -> Ordering)
-> (CreateThreadAndRunRequestToolsInner
    -> CreateThreadAndRunRequestToolsInner -> Bool)
-> (CreateThreadAndRunRequestToolsInner
    -> CreateThreadAndRunRequestToolsInner -> Bool)
-> (CreateThreadAndRunRequestToolsInner
    -> CreateThreadAndRunRequestToolsInner -> Bool)
-> (CreateThreadAndRunRequestToolsInner
    -> CreateThreadAndRunRequestToolsInner -> Bool)
-> (CreateThreadAndRunRequestToolsInner
    -> CreateThreadAndRunRequestToolsInner
    -> CreateThreadAndRunRequestToolsInner)
-> (CreateThreadAndRunRequestToolsInner
    -> CreateThreadAndRunRequestToolsInner
    -> CreateThreadAndRunRequestToolsInner)
-> Ord CreateThreadAndRunRequestToolsInner
CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Ordering
CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Ordering
compare :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Ordering
$c< :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
< :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
$c<= :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
<= :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
$c> :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
> :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
$c>= :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
>= :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner -> Bool
$cmax :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
max :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
$cmin :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
min :: CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
Ord, (forall x.
 CreateThreadAndRunRequestToolsInner
 -> Rep CreateThreadAndRunRequestToolsInner x)
-> (forall x.
    Rep CreateThreadAndRunRequestToolsInner x
    -> CreateThreadAndRunRequestToolsInner)
-> Generic CreateThreadAndRunRequestToolsInner
forall x.
Rep CreateThreadAndRunRequestToolsInner x
-> CreateThreadAndRunRequestToolsInner
forall x.
CreateThreadAndRunRequestToolsInner
-> Rep CreateThreadAndRunRequestToolsInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateThreadAndRunRequestToolsInner
-> Rep CreateThreadAndRunRequestToolsInner x
from :: forall x.
CreateThreadAndRunRequestToolsInner
-> Rep CreateThreadAndRunRequestToolsInner x
$cto :: forall x.
Rep CreateThreadAndRunRequestToolsInner x
-> CreateThreadAndRunRequestToolsInner
to :: forall x.
Rep CreateThreadAndRunRequestToolsInner x
-> CreateThreadAndRunRequestToolsInner
Generic, Typeable CreateThreadAndRunRequestToolsInner
Typeable CreateThreadAndRunRequestToolsInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateThreadAndRunRequestToolsInner
 -> c CreateThreadAndRunRequestToolsInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateThreadAndRunRequestToolsInner)
-> (CreateThreadAndRunRequestToolsInner -> Constr)
-> (CreateThreadAndRunRequestToolsInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateThreadAndRunRequestToolsInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateThreadAndRunRequestToolsInner))
-> ((forall b. Data b => b -> b)
    -> CreateThreadAndRunRequestToolsInner
    -> CreateThreadAndRunRequestToolsInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateThreadAndRunRequestToolsInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateThreadAndRunRequestToolsInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateThreadAndRunRequestToolsInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateThreadAndRunRequestToolsInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateThreadAndRunRequestToolsInner
    -> m CreateThreadAndRunRequestToolsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateThreadAndRunRequestToolsInner
    -> m CreateThreadAndRunRequestToolsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateThreadAndRunRequestToolsInner
    -> m CreateThreadAndRunRequestToolsInner)
-> Data CreateThreadAndRunRequestToolsInner
CreateThreadAndRunRequestToolsInner -> Constr
CreateThreadAndRunRequestToolsInner -> DataType
(forall b. Data b => b -> b)
-> CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateThreadAndRunRequestToolsInner
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateThreadAndRunRequestToolsInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequestToolsInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequestToolsInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequestToolsInner
-> m CreateThreadAndRunRequestToolsInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequestToolsInner
-> m CreateThreadAndRunRequestToolsInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateThreadAndRunRequestToolsInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateThreadAndRunRequestToolsInner
-> c CreateThreadAndRunRequestToolsInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateThreadAndRunRequestToolsInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateThreadAndRunRequestToolsInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateThreadAndRunRequestToolsInner
-> c CreateThreadAndRunRequestToolsInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateThreadAndRunRequestToolsInner
-> c CreateThreadAndRunRequestToolsInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateThreadAndRunRequestToolsInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateThreadAndRunRequestToolsInner
$ctoConstr :: CreateThreadAndRunRequestToolsInner -> Constr
toConstr :: CreateThreadAndRunRequestToolsInner -> Constr
$cdataTypeOf :: CreateThreadAndRunRequestToolsInner -> DataType
dataTypeOf :: CreateThreadAndRunRequestToolsInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateThreadAndRunRequestToolsInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateThreadAndRunRequestToolsInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateThreadAndRunRequestToolsInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateThreadAndRunRequestToolsInner)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
gmapT :: (forall b. Data b => b -> b)
-> CreateThreadAndRunRequestToolsInner
-> CreateThreadAndRunRequestToolsInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequestToolsInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequestToolsInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequestToolsInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateThreadAndRunRequestToolsInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateThreadAndRunRequestToolsInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateThreadAndRunRequestToolsInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateThreadAndRunRequestToolsInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateThreadAndRunRequestToolsInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequestToolsInner
-> m CreateThreadAndRunRequestToolsInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequestToolsInner
-> m CreateThreadAndRunRequestToolsInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequestToolsInner
-> m CreateThreadAndRunRequestToolsInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequestToolsInner
-> m CreateThreadAndRunRequestToolsInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequestToolsInner
-> m CreateThreadAndRunRequestToolsInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadAndRunRequestToolsInner
-> m CreateThreadAndRunRequestToolsInner
Data)

instance FromJSON CreateThreadAndRunRequestToolsInner where
  parseJSON :: Value -> Parser CreateThreadAndRunRequestToolsInner
parseJSON = Options -> Value -> Parser CreateThreadAndRunRequestToolsInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createThreadAndRunRequestToolsInner")
instance ToJSON CreateThreadAndRunRequestToolsInner where
  toJSON :: CreateThreadAndRunRequestToolsInner -> Value
toJSON = Options -> CreateThreadAndRunRequestToolsInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createThreadAndRunRequestToolsInner")


-- | 
data CreateThreadRequest = CreateThreadRequest
  { CreateThreadRequest -> Maybe [CreateMessageRequest]
createThreadRequestMessages :: Maybe [CreateMessageRequest] -- ^ A list of [messages](/docs/api-reference/messages) to start the thread with.
  , CreateThreadRequest -> Maybe Value
createThreadRequestMetadata :: Maybe Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> CreateThreadRequest -> ShowS
[CreateThreadRequest] -> ShowS
CreateThreadRequest -> String
(Int -> CreateThreadRequest -> ShowS)
-> (CreateThreadRequest -> String)
-> ([CreateThreadRequest] -> ShowS)
-> Show CreateThreadRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateThreadRequest -> ShowS
showsPrec :: Int -> CreateThreadRequest -> ShowS
$cshow :: CreateThreadRequest -> String
show :: CreateThreadRequest -> String
$cshowList :: [CreateThreadRequest] -> ShowS
showList :: [CreateThreadRequest] -> ShowS
Show, CreateThreadRequest -> CreateThreadRequest -> Bool
(CreateThreadRequest -> CreateThreadRequest -> Bool)
-> (CreateThreadRequest -> CreateThreadRequest -> Bool)
-> Eq CreateThreadRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateThreadRequest -> CreateThreadRequest -> Bool
== :: CreateThreadRequest -> CreateThreadRequest -> Bool
$c/= :: CreateThreadRequest -> CreateThreadRequest -> Bool
/= :: CreateThreadRequest -> CreateThreadRequest -> Bool
Eq, Eq CreateThreadRequest
Eq CreateThreadRequest =>
(CreateThreadRequest -> CreateThreadRequest -> Ordering)
-> (CreateThreadRequest -> CreateThreadRequest -> Bool)
-> (CreateThreadRequest -> CreateThreadRequest -> Bool)
-> (CreateThreadRequest -> CreateThreadRequest -> Bool)
-> (CreateThreadRequest -> CreateThreadRequest -> Bool)
-> (CreateThreadRequest
    -> CreateThreadRequest -> CreateThreadRequest)
-> (CreateThreadRequest
    -> CreateThreadRequest -> CreateThreadRequest)
-> Ord CreateThreadRequest
CreateThreadRequest -> CreateThreadRequest -> Bool
CreateThreadRequest -> CreateThreadRequest -> Ordering
CreateThreadRequest -> CreateThreadRequest -> CreateThreadRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateThreadRequest -> CreateThreadRequest -> Ordering
compare :: CreateThreadRequest -> CreateThreadRequest -> Ordering
$c< :: CreateThreadRequest -> CreateThreadRequest -> Bool
< :: CreateThreadRequest -> CreateThreadRequest -> Bool
$c<= :: CreateThreadRequest -> CreateThreadRequest -> Bool
<= :: CreateThreadRequest -> CreateThreadRequest -> Bool
$c> :: CreateThreadRequest -> CreateThreadRequest -> Bool
> :: CreateThreadRequest -> CreateThreadRequest -> Bool
$c>= :: CreateThreadRequest -> CreateThreadRequest -> Bool
>= :: CreateThreadRequest -> CreateThreadRequest -> Bool
$cmax :: CreateThreadRequest -> CreateThreadRequest -> CreateThreadRequest
max :: CreateThreadRequest -> CreateThreadRequest -> CreateThreadRequest
$cmin :: CreateThreadRequest -> CreateThreadRequest -> CreateThreadRequest
min :: CreateThreadRequest -> CreateThreadRequest -> CreateThreadRequest
Ord, (forall x. CreateThreadRequest -> Rep CreateThreadRequest x)
-> (forall x. Rep CreateThreadRequest x -> CreateThreadRequest)
-> Generic CreateThreadRequest
forall x. Rep CreateThreadRequest x -> CreateThreadRequest
forall x. CreateThreadRequest -> Rep CreateThreadRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateThreadRequest -> Rep CreateThreadRequest x
from :: forall x. CreateThreadRequest -> Rep CreateThreadRequest x
$cto :: forall x. Rep CreateThreadRequest x -> CreateThreadRequest
to :: forall x. Rep CreateThreadRequest x -> CreateThreadRequest
Generic, Typeable CreateThreadRequest
Typeable CreateThreadRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateThreadRequest
 -> c CreateThreadRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateThreadRequest)
-> (CreateThreadRequest -> Constr)
-> (CreateThreadRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateThreadRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateThreadRequest))
-> ((forall b. Data b => b -> b)
    -> CreateThreadRequest -> CreateThreadRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateThreadRequest -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateThreadRequest -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateThreadRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CreateThreadRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateThreadRequest -> m CreateThreadRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateThreadRequest -> m CreateThreadRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateThreadRequest -> m CreateThreadRequest)
-> Data CreateThreadRequest
CreateThreadRequest -> Constr
CreateThreadRequest -> DataType
(forall b. Data b => b -> b)
-> CreateThreadRequest -> CreateThreadRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateThreadRequest -> u
forall u.
(forall d. Data d => d -> u) -> CreateThreadRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateThreadRequest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateThreadRequest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateThreadRequest -> m CreateThreadRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadRequest -> m CreateThreadRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateThreadRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateThreadRequest
-> c CreateThreadRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateThreadRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateThreadRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateThreadRequest
-> c CreateThreadRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateThreadRequest
-> c CreateThreadRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateThreadRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateThreadRequest
$ctoConstr :: CreateThreadRequest -> Constr
toConstr :: CreateThreadRequest -> Constr
$cdataTypeOf :: CreateThreadRequest -> DataType
dataTypeOf :: CreateThreadRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateThreadRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateThreadRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateThreadRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateThreadRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateThreadRequest -> CreateThreadRequest
gmapT :: (forall b. Data b => b -> b)
-> CreateThreadRequest -> CreateThreadRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateThreadRequest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateThreadRequest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateThreadRequest -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateThreadRequest -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateThreadRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateThreadRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateThreadRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateThreadRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateThreadRequest -> m CreateThreadRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateThreadRequest -> m CreateThreadRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadRequest -> m CreateThreadRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadRequest -> m CreateThreadRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadRequest -> m CreateThreadRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateThreadRequest -> m CreateThreadRequest
Data)

instance FromJSON CreateThreadRequest where
  parseJSON :: Value -> Parser CreateThreadRequest
parseJSON = Options -> Value -> Parser CreateThreadRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createThreadRequest")
instance ToJSON CreateThreadRequest where
  toJSON :: CreateThreadRequest -> Value
toJSON = Options -> CreateThreadRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createThreadRequest")


-- | 
data CreateTranscription200Response = CreateTranscription200Response
  { CreateTranscription200Response -> Text
createTranscription200ResponseText :: Text -- ^ The transcribed text.
  , CreateTranscription200Response -> Text
createTranscription200ResponseLanguage :: Text -- ^ The language of the input audio.
  , CreateTranscription200Response -> Text
createTranscription200ResponseDuration :: Text -- ^ The duration of the input audio.
  , CreateTranscription200Response -> Maybe [TranscriptionWord]
createTranscription200ResponseWords :: Maybe [TranscriptionWord] -- ^ Extracted words and their corresponding timestamps.
  , CreateTranscription200Response -> Maybe [TranscriptionSegment]
createTranscription200ResponseSegments :: Maybe [TranscriptionSegment] -- ^ Segments of the transcribed text and their corresponding details.
  } deriving (Int -> CreateTranscription200Response -> ShowS
[CreateTranscription200Response] -> ShowS
CreateTranscription200Response -> String
(Int -> CreateTranscription200Response -> ShowS)
-> (CreateTranscription200Response -> String)
-> ([CreateTranscription200Response] -> ShowS)
-> Show CreateTranscription200Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTranscription200Response -> ShowS
showsPrec :: Int -> CreateTranscription200Response -> ShowS
$cshow :: CreateTranscription200Response -> String
show :: CreateTranscription200Response -> String
$cshowList :: [CreateTranscription200Response] -> ShowS
showList :: [CreateTranscription200Response] -> ShowS
Show, CreateTranscription200Response
-> CreateTranscription200Response -> Bool
(CreateTranscription200Response
 -> CreateTranscription200Response -> Bool)
-> (CreateTranscription200Response
    -> CreateTranscription200Response -> Bool)
-> Eq CreateTranscription200Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
== :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
$c/= :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
/= :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
Eq, Eq CreateTranscription200Response
Eq CreateTranscription200Response =>
(CreateTranscription200Response
 -> CreateTranscription200Response -> Ordering)
-> (CreateTranscription200Response
    -> CreateTranscription200Response -> Bool)
-> (CreateTranscription200Response
    -> CreateTranscription200Response -> Bool)
-> (CreateTranscription200Response
    -> CreateTranscription200Response -> Bool)
-> (CreateTranscription200Response
    -> CreateTranscription200Response -> Bool)
-> (CreateTranscription200Response
    -> CreateTranscription200Response
    -> CreateTranscription200Response)
-> (CreateTranscription200Response
    -> CreateTranscription200Response
    -> CreateTranscription200Response)
-> Ord CreateTranscription200Response
CreateTranscription200Response
-> CreateTranscription200Response -> Bool
CreateTranscription200Response
-> CreateTranscription200Response -> Ordering
CreateTranscription200Response
-> CreateTranscription200Response -> CreateTranscription200Response
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateTranscription200Response
-> CreateTranscription200Response -> Ordering
compare :: CreateTranscription200Response
-> CreateTranscription200Response -> Ordering
$c< :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
< :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
$c<= :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
<= :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
$c> :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
> :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
$c>= :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
>= :: CreateTranscription200Response
-> CreateTranscription200Response -> Bool
$cmax :: CreateTranscription200Response
-> CreateTranscription200Response -> CreateTranscription200Response
max :: CreateTranscription200Response
-> CreateTranscription200Response -> CreateTranscription200Response
$cmin :: CreateTranscription200Response
-> CreateTranscription200Response -> CreateTranscription200Response
min :: CreateTranscription200Response
-> CreateTranscription200Response -> CreateTranscription200Response
Ord, (forall x.
 CreateTranscription200Response
 -> Rep CreateTranscription200Response x)
-> (forall x.
    Rep CreateTranscription200Response x
    -> CreateTranscription200Response)
-> Generic CreateTranscription200Response
forall x.
Rep CreateTranscription200Response x
-> CreateTranscription200Response
forall x.
CreateTranscription200Response
-> Rep CreateTranscription200Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateTranscription200Response
-> Rep CreateTranscription200Response x
from :: forall x.
CreateTranscription200Response
-> Rep CreateTranscription200Response x
$cto :: forall x.
Rep CreateTranscription200Response x
-> CreateTranscription200Response
to :: forall x.
Rep CreateTranscription200Response x
-> CreateTranscription200Response
Generic, Typeable CreateTranscription200Response
Typeable CreateTranscription200Response =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateTranscription200Response
 -> c CreateTranscription200Response)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateTranscription200Response)
-> (CreateTranscription200Response -> Constr)
-> (CreateTranscription200Response -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateTranscription200Response))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateTranscription200Response))
-> ((forall b. Data b => b -> b)
    -> CreateTranscription200Response
    -> CreateTranscription200Response)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranscription200Response
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranscription200Response
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateTranscription200Response -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateTranscription200Response
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateTranscription200Response
    -> m CreateTranscription200Response)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranscription200Response
    -> m CreateTranscription200Response)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranscription200Response
    -> m CreateTranscription200Response)
-> Data CreateTranscription200Response
CreateTranscription200Response -> Constr
CreateTranscription200Response -> DataType
(forall b. Data b => b -> b)
-> CreateTranscription200Response -> CreateTranscription200Response
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranscription200Response
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateTranscription200Response -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscription200Response
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscription200Response
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranscription200Response
-> m CreateTranscription200Response
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscription200Response
-> m CreateTranscription200Response
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranscription200Response
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranscription200Response
-> c CreateTranscription200Response
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranscription200Response)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranscription200Response)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranscription200Response
-> c CreateTranscription200Response
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranscription200Response
-> c CreateTranscription200Response
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranscription200Response
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranscription200Response
$ctoConstr :: CreateTranscription200Response -> Constr
toConstr :: CreateTranscription200Response -> Constr
$cdataTypeOf :: CreateTranscription200Response -> DataType
dataTypeOf :: CreateTranscription200Response -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranscription200Response)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranscription200Response)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranscription200Response)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranscription200Response)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateTranscription200Response -> CreateTranscription200Response
gmapT :: (forall b. Data b => b -> b)
-> CreateTranscription200Response -> CreateTranscription200Response
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscription200Response
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscription200Response
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscription200Response
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscription200Response
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateTranscription200Response -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateTranscription200Response -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranscription200Response
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranscription200Response
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranscription200Response
-> m CreateTranscription200Response
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranscription200Response
-> m CreateTranscription200Response
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscription200Response
-> m CreateTranscription200Response
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscription200Response
-> m CreateTranscription200Response
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscription200Response
-> m CreateTranscription200Response
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscription200Response
-> m CreateTranscription200Response
Data)

instance FromJSON CreateTranscription200Response where
  parseJSON :: Value -> Parser CreateTranscription200Response
parseJSON = Options -> Value -> Parser CreateTranscription200Response
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createTranscription200Response")
instance ToJSON CreateTranscription200Response where
  toJSON :: CreateTranscription200Response -> Value
toJSON = Options -> CreateTranscription200Response -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createTranscription200Response")


-- | Represents a transcription response returned by model, based on the provided input.
data CreateTranscriptionResponseJson = CreateTranscriptionResponseJson
  { CreateTranscriptionResponseJson -> Text
createTranscriptionResponseJsonText :: Text -- ^ The transcribed text.
  } deriving (Int -> CreateTranscriptionResponseJson -> ShowS
[CreateTranscriptionResponseJson] -> ShowS
CreateTranscriptionResponseJson -> String
(Int -> CreateTranscriptionResponseJson -> ShowS)
-> (CreateTranscriptionResponseJson -> String)
-> ([CreateTranscriptionResponseJson] -> ShowS)
-> Show CreateTranscriptionResponseJson
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTranscriptionResponseJson -> ShowS
showsPrec :: Int -> CreateTranscriptionResponseJson -> ShowS
$cshow :: CreateTranscriptionResponseJson -> String
show :: CreateTranscriptionResponseJson -> String
$cshowList :: [CreateTranscriptionResponseJson] -> ShowS
showList :: [CreateTranscriptionResponseJson] -> ShowS
Show, CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
(CreateTranscriptionResponseJson
 -> CreateTranscriptionResponseJson -> Bool)
-> (CreateTranscriptionResponseJson
    -> CreateTranscriptionResponseJson -> Bool)
-> Eq CreateTranscriptionResponseJson
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
== :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
$c/= :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
/= :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
Eq, Eq CreateTranscriptionResponseJson
Eq CreateTranscriptionResponseJson =>
(CreateTranscriptionResponseJson
 -> CreateTranscriptionResponseJson -> Ordering)
-> (CreateTranscriptionResponseJson
    -> CreateTranscriptionResponseJson -> Bool)
-> (CreateTranscriptionResponseJson
    -> CreateTranscriptionResponseJson -> Bool)
-> (CreateTranscriptionResponseJson
    -> CreateTranscriptionResponseJson -> Bool)
-> (CreateTranscriptionResponseJson
    -> CreateTranscriptionResponseJson -> Bool)
-> (CreateTranscriptionResponseJson
    -> CreateTranscriptionResponseJson
    -> CreateTranscriptionResponseJson)
-> (CreateTranscriptionResponseJson
    -> CreateTranscriptionResponseJson
    -> CreateTranscriptionResponseJson)
-> Ord CreateTranscriptionResponseJson
CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Ordering
CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Ordering
compare :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Ordering
$c< :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
< :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
$c<= :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
<= :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
$c> :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
> :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
$c>= :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
>= :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson -> Bool
$cmax :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
max :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
$cmin :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
min :: CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
Ord, (forall x.
 CreateTranscriptionResponseJson
 -> Rep CreateTranscriptionResponseJson x)
-> (forall x.
    Rep CreateTranscriptionResponseJson x
    -> CreateTranscriptionResponseJson)
-> Generic CreateTranscriptionResponseJson
forall x.
Rep CreateTranscriptionResponseJson x
-> CreateTranscriptionResponseJson
forall x.
CreateTranscriptionResponseJson
-> Rep CreateTranscriptionResponseJson x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateTranscriptionResponseJson
-> Rep CreateTranscriptionResponseJson x
from :: forall x.
CreateTranscriptionResponseJson
-> Rep CreateTranscriptionResponseJson x
$cto :: forall x.
Rep CreateTranscriptionResponseJson x
-> CreateTranscriptionResponseJson
to :: forall x.
Rep CreateTranscriptionResponseJson x
-> CreateTranscriptionResponseJson
Generic, Typeable CreateTranscriptionResponseJson
Typeable CreateTranscriptionResponseJson =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateTranscriptionResponseJson
 -> c CreateTranscriptionResponseJson)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateTranscriptionResponseJson)
-> (CreateTranscriptionResponseJson -> Constr)
-> (CreateTranscriptionResponseJson -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateTranscriptionResponseJson))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateTranscriptionResponseJson))
-> ((forall b. Data b => b -> b)
    -> CreateTranscriptionResponseJson
    -> CreateTranscriptionResponseJson)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranscriptionResponseJson
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranscriptionResponseJson
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateTranscriptionResponseJson -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateTranscriptionResponseJson
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateTranscriptionResponseJson
    -> m CreateTranscriptionResponseJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranscriptionResponseJson
    -> m CreateTranscriptionResponseJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranscriptionResponseJson
    -> m CreateTranscriptionResponseJson)
-> Data CreateTranscriptionResponseJson
CreateTranscriptionResponseJson -> Constr
CreateTranscriptionResponseJson -> DataType
(forall b. Data b => b -> b)
-> CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranscriptionResponseJson
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateTranscriptionResponseJson -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseJson
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseJson
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseJson
-> m CreateTranscriptionResponseJson
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseJson
-> m CreateTranscriptionResponseJson
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranscriptionResponseJson
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranscriptionResponseJson
-> c CreateTranscriptionResponseJson
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranscriptionResponseJson)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranscriptionResponseJson)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranscriptionResponseJson
-> c CreateTranscriptionResponseJson
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranscriptionResponseJson
-> c CreateTranscriptionResponseJson
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranscriptionResponseJson
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranscriptionResponseJson
$ctoConstr :: CreateTranscriptionResponseJson -> Constr
toConstr :: CreateTranscriptionResponseJson -> Constr
$cdataTypeOf :: CreateTranscriptionResponseJson -> DataType
dataTypeOf :: CreateTranscriptionResponseJson -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranscriptionResponseJson)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranscriptionResponseJson)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranscriptionResponseJson)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranscriptionResponseJson)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
gmapT :: (forall b. Data b => b -> b)
-> CreateTranscriptionResponseJson
-> CreateTranscriptionResponseJson
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseJson
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseJson
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseJson
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseJson
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateTranscriptionResponseJson -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateTranscriptionResponseJson -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranscriptionResponseJson
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranscriptionResponseJson
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseJson
-> m CreateTranscriptionResponseJson
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseJson
-> m CreateTranscriptionResponseJson
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseJson
-> m CreateTranscriptionResponseJson
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseJson
-> m CreateTranscriptionResponseJson
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseJson
-> m CreateTranscriptionResponseJson
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseJson
-> m CreateTranscriptionResponseJson
Data)

instance FromJSON CreateTranscriptionResponseJson where
  parseJSON :: Value -> Parser CreateTranscriptionResponseJson
parseJSON = Options -> Value -> Parser CreateTranscriptionResponseJson
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createTranscriptionResponseJson")
instance ToJSON CreateTranscriptionResponseJson where
  toJSON :: CreateTranscriptionResponseJson -> Value
toJSON = Options -> CreateTranscriptionResponseJson -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createTranscriptionResponseJson")


-- | Represents a verbose json transcription response returned by model, based on the provided input.
data CreateTranscriptionResponseVerboseJson = CreateTranscriptionResponseVerboseJson
  { CreateTranscriptionResponseVerboseJson -> Text
createTranscriptionResponseVerboseJsonLanguage :: Text -- ^ The language of the input audio.
  , CreateTranscriptionResponseVerboseJson -> Text
createTranscriptionResponseVerboseJsonDuration :: Text -- ^ The duration of the input audio.
  , CreateTranscriptionResponseVerboseJson -> Text
createTranscriptionResponseVerboseJsonText :: Text -- ^ The transcribed text.
  , CreateTranscriptionResponseVerboseJson -> Maybe [TranscriptionWord]
createTranscriptionResponseVerboseJsonWords :: Maybe [TranscriptionWord] -- ^ Extracted words and their corresponding timestamps.
  , CreateTranscriptionResponseVerboseJson
-> Maybe [TranscriptionSegment]
createTranscriptionResponseVerboseJsonSegments :: Maybe [TranscriptionSegment] -- ^ Segments of the transcribed text and their corresponding details.
  } deriving (Int -> CreateTranscriptionResponseVerboseJson -> ShowS
[CreateTranscriptionResponseVerboseJson] -> ShowS
CreateTranscriptionResponseVerboseJson -> String
(Int -> CreateTranscriptionResponseVerboseJson -> ShowS)
-> (CreateTranscriptionResponseVerboseJson -> String)
-> ([CreateTranscriptionResponseVerboseJson] -> ShowS)
-> Show CreateTranscriptionResponseVerboseJson
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTranscriptionResponseVerboseJson -> ShowS
showsPrec :: Int -> CreateTranscriptionResponseVerboseJson -> ShowS
$cshow :: CreateTranscriptionResponseVerboseJson -> String
show :: CreateTranscriptionResponseVerboseJson -> String
$cshowList :: [CreateTranscriptionResponseVerboseJson] -> ShowS
showList :: [CreateTranscriptionResponseVerboseJson] -> ShowS
Show, CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
(CreateTranscriptionResponseVerboseJson
 -> CreateTranscriptionResponseVerboseJson -> Bool)
-> (CreateTranscriptionResponseVerboseJson
    -> CreateTranscriptionResponseVerboseJson -> Bool)
-> Eq CreateTranscriptionResponseVerboseJson
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
== :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
$c/= :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
/= :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
Eq, Eq CreateTranscriptionResponseVerboseJson
Eq CreateTranscriptionResponseVerboseJson =>
(CreateTranscriptionResponseVerboseJson
 -> CreateTranscriptionResponseVerboseJson -> Ordering)
-> (CreateTranscriptionResponseVerboseJson
    -> CreateTranscriptionResponseVerboseJson -> Bool)
-> (CreateTranscriptionResponseVerboseJson
    -> CreateTranscriptionResponseVerboseJson -> Bool)
-> (CreateTranscriptionResponseVerboseJson
    -> CreateTranscriptionResponseVerboseJson -> Bool)
-> (CreateTranscriptionResponseVerboseJson
    -> CreateTranscriptionResponseVerboseJson -> Bool)
-> (CreateTranscriptionResponseVerboseJson
    -> CreateTranscriptionResponseVerboseJson
    -> CreateTranscriptionResponseVerboseJson)
-> (CreateTranscriptionResponseVerboseJson
    -> CreateTranscriptionResponseVerboseJson
    -> CreateTranscriptionResponseVerboseJson)
-> Ord CreateTranscriptionResponseVerboseJson
CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Ordering
CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Ordering
compare :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Ordering
$c< :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
< :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
$c<= :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
<= :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
$c> :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
> :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
$c>= :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
>= :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson -> Bool
$cmax :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
max :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
$cmin :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
min :: CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
Ord, (forall x.
 CreateTranscriptionResponseVerboseJson
 -> Rep CreateTranscriptionResponseVerboseJson x)
-> (forall x.
    Rep CreateTranscriptionResponseVerboseJson x
    -> CreateTranscriptionResponseVerboseJson)
-> Generic CreateTranscriptionResponseVerboseJson
forall x.
Rep CreateTranscriptionResponseVerboseJson x
-> CreateTranscriptionResponseVerboseJson
forall x.
CreateTranscriptionResponseVerboseJson
-> Rep CreateTranscriptionResponseVerboseJson x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateTranscriptionResponseVerboseJson
-> Rep CreateTranscriptionResponseVerboseJson x
from :: forall x.
CreateTranscriptionResponseVerboseJson
-> Rep CreateTranscriptionResponseVerboseJson x
$cto :: forall x.
Rep CreateTranscriptionResponseVerboseJson x
-> CreateTranscriptionResponseVerboseJson
to :: forall x.
Rep CreateTranscriptionResponseVerboseJson x
-> CreateTranscriptionResponseVerboseJson
Generic, Typeable CreateTranscriptionResponseVerboseJson
Typeable CreateTranscriptionResponseVerboseJson =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateTranscriptionResponseVerboseJson
 -> c CreateTranscriptionResponseVerboseJson)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateTranscriptionResponseVerboseJson)
-> (CreateTranscriptionResponseVerboseJson -> Constr)
-> (CreateTranscriptionResponseVerboseJson -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateTranscriptionResponseVerboseJson))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateTranscriptionResponseVerboseJson))
-> ((forall b. Data b => b -> b)
    -> CreateTranscriptionResponseVerboseJson
    -> CreateTranscriptionResponseVerboseJson)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranscriptionResponseVerboseJson
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranscriptionResponseVerboseJson
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateTranscriptionResponseVerboseJson -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateTranscriptionResponseVerboseJson
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateTranscriptionResponseVerboseJson
    -> m CreateTranscriptionResponseVerboseJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranscriptionResponseVerboseJson
    -> m CreateTranscriptionResponseVerboseJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranscriptionResponseVerboseJson
    -> m CreateTranscriptionResponseVerboseJson)
-> Data CreateTranscriptionResponseVerboseJson
CreateTranscriptionResponseVerboseJson -> Constr
CreateTranscriptionResponseVerboseJson -> DataType
(forall b. Data b => b -> b)
-> CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranscriptionResponseVerboseJson
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateTranscriptionResponseVerboseJson -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseVerboseJson
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseVerboseJson
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseVerboseJson
-> m CreateTranscriptionResponseVerboseJson
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseVerboseJson
-> m CreateTranscriptionResponseVerboseJson
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranscriptionResponseVerboseJson
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranscriptionResponseVerboseJson
-> c CreateTranscriptionResponseVerboseJson
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranscriptionResponseVerboseJson)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranscriptionResponseVerboseJson)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranscriptionResponseVerboseJson
-> c CreateTranscriptionResponseVerboseJson
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranscriptionResponseVerboseJson
-> c CreateTranscriptionResponseVerboseJson
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranscriptionResponseVerboseJson
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranscriptionResponseVerboseJson
$ctoConstr :: CreateTranscriptionResponseVerboseJson -> Constr
toConstr :: CreateTranscriptionResponseVerboseJson -> Constr
$cdataTypeOf :: CreateTranscriptionResponseVerboseJson -> DataType
dataTypeOf :: CreateTranscriptionResponseVerboseJson -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranscriptionResponseVerboseJson)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranscriptionResponseVerboseJson)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranscriptionResponseVerboseJson)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranscriptionResponseVerboseJson)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
gmapT :: (forall b. Data b => b -> b)
-> CreateTranscriptionResponseVerboseJson
-> CreateTranscriptionResponseVerboseJson
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseVerboseJson
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseVerboseJson
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseVerboseJson
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranscriptionResponseVerboseJson
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateTranscriptionResponseVerboseJson -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateTranscriptionResponseVerboseJson -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranscriptionResponseVerboseJson
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranscriptionResponseVerboseJson
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseVerboseJson
-> m CreateTranscriptionResponseVerboseJson
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseVerboseJson
-> m CreateTranscriptionResponseVerboseJson
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseVerboseJson
-> m CreateTranscriptionResponseVerboseJson
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseVerboseJson
-> m CreateTranscriptionResponseVerboseJson
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseVerboseJson
-> m CreateTranscriptionResponseVerboseJson
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranscriptionResponseVerboseJson
-> m CreateTranscriptionResponseVerboseJson
Data)

instance FromJSON CreateTranscriptionResponseVerboseJson where
  parseJSON :: Value -> Parser CreateTranscriptionResponseVerboseJson
parseJSON = Options -> Value -> Parser CreateTranscriptionResponseVerboseJson
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createTranscriptionResponseVerboseJson")
instance ToJSON CreateTranscriptionResponseVerboseJson where
  toJSON :: CreateTranscriptionResponseVerboseJson -> Value
toJSON = Options -> CreateTranscriptionResponseVerboseJson -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createTranscriptionResponseVerboseJson")


-- | 
data CreateTranslation200Response = CreateTranslation200Response
  { CreateTranslation200Response -> Text
createTranslation200ResponseText :: Text -- ^ The translated text.
  , CreateTranslation200Response -> Text
createTranslation200ResponseLanguage :: Text -- ^ The language of the output translation (always `english`).
  , CreateTranslation200Response -> Text
createTranslation200ResponseDuration :: Text -- ^ The duration of the input audio.
  , CreateTranslation200Response -> Maybe [TranscriptionSegment]
createTranslation200ResponseSegments :: Maybe [TranscriptionSegment] -- ^ Segments of the translated text and their corresponding details.
  } deriving (Int -> CreateTranslation200Response -> ShowS
[CreateTranslation200Response] -> ShowS
CreateTranslation200Response -> String
(Int -> CreateTranslation200Response -> ShowS)
-> (CreateTranslation200Response -> String)
-> ([CreateTranslation200Response] -> ShowS)
-> Show CreateTranslation200Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTranslation200Response -> ShowS
showsPrec :: Int -> CreateTranslation200Response -> ShowS
$cshow :: CreateTranslation200Response -> String
show :: CreateTranslation200Response -> String
$cshowList :: [CreateTranslation200Response] -> ShowS
showList :: [CreateTranslation200Response] -> ShowS
Show, CreateTranslation200Response
-> CreateTranslation200Response -> Bool
(CreateTranslation200Response
 -> CreateTranslation200Response -> Bool)
-> (CreateTranslation200Response
    -> CreateTranslation200Response -> Bool)
-> Eq CreateTranslation200Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
== :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
$c/= :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
/= :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
Eq, Eq CreateTranslation200Response
Eq CreateTranslation200Response =>
(CreateTranslation200Response
 -> CreateTranslation200Response -> Ordering)
-> (CreateTranslation200Response
    -> CreateTranslation200Response -> Bool)
-> (CreateTranslation200Response
    -> CreateTranslation200Response -> Bool)
-> (CreateTranslation200Response
    -> CreateTranslation200Response -> Bool)
-> (CreateTranslation200Response
    -> CreateTranslation200Response -> Bool)
-> (CreateTranslation200Response
    -> CreateTranslation200Response -> CreateTranslation200Response)
-> (CreateTranslation200Response
    -> CreateTranslation200Response -> CreateTranslation200Response)
-> Ord CreateTranslation200Response
CreateTranslation200Response
-> CreateTranslation200Response -> Bool
CreateTranslation200Response
-> CreateTranslation200Response -> Ordering
CreateTranslation200Response
-> CreateTranslation200Response -> CreateTranslation200Response
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateTranslation200Response
-> CreateTranslation200Response -> Ordering
compare :: CreateTranslation200Response
-> CreateTranslation200Response -> Ordering
$c< :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
< :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
$c<= :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
<= :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
$c> :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
> :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
$c>= :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
>= :: CreateTranslation200Response
-> CreateTranslation200Response -> Bool
$cmax :: CreateTranslation200Response
-> CreateTranslation200Response -> CreateTranslation200Response
max :: CreateTranslation200Response
-> CreateTranslation200Response -> CreateTranslation200Response
$cmin :: CreateTranslation200Response
-> CreateTranslation200Response -> CreateTranslation200Response
min :: CreateTranslation200Response
-> CreateTranslation200Response -> CreateTranslation200Response
Ord, (forall x.
 CreateTranslation200Response -> Rep CreateTranslation200Response x)
-> (forall x.
    Rep CreateTranslation200Response x -> CreateTranslation200Response)
-> Generic CreateTranslation200Response
forall x.
Rep CreateTranslation200Response x -> CreateTranslation200Response
forall x.
CreateTranslation200Response -> Rep CreateTranslation200Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateTranslation200Response -> Rep CreateTranslation200Response x
from :: forall x.
CreateTranslation200Response -> Rep CreateTranslation200Response x
$cto :: forall x.
Rep CreateTranslation200Response x -> CreateTranslation200Response
to :: forall x.
Rep CreateTranslation200Response x -> CreateTranslation200Response
Generic, Typeable CreateTranslation200Response
Typeable CreateTranslation200Response =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateTranslation200Response
 -> c CreateTranslation200Response)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateTranslation200Response)
-> (CreateTranslation200Response -> Constr)
-> (CreateTranslation200Response -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateTranslation200Response))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateTranslation200Response))
-> ((forall b. Data b => b -> b)
    -> CreateTranslation200Response -> CreateTranslation200Response)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranslation200Response
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranslation200Response
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateTranslation200Response -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateTranslation200Response
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateTranslation200Response -> m CreateTranslation200Response)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranslation200Response -> m CreateTranslation200Response)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranslation200Response -> m CreateTranslation200Response)
-> Data CreateTranslation200Response
CreateTranslation200Response -> Constr
CreateTranslation200Response -> DataType
(forall b. Data b => b -> b)
-> CreateTranslation200Response -> CreateTranslation200Response
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranslation200Response
-> u
forall u.
(forall d. Data d => d -> u) -> CreateTranslation200Response -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslation200Response
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslation200Response
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranslation200Response -> m CreateTranslation200Response
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslation200Response -> m CreateTranslation200Response
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateTranslation200Response
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranslation200Response
-> c CreateTranslation200Response
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranslation200Response)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranslation200Response)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranslation200Response
-> c CreateTranslation200Response
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranslation200Response
-> c CreateTranslation200Response
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateTranslation200Response
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateTranslation200Response
$ctoConstr :: CreateTranslation200Response -> Constr
toConstr :: CreateTranslation200Response -> Constr
$cdataTypeOf :: CreateTranslation200Response -> DataType
dataTypeOf :: CreateTranslation200Response -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranslation200Response)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranslation200Response)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranslation200Response)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranslation200Response)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateTranslation200Response -> CreateTranslation200Response
gmapT :: (forall b. Data b => b -> b)
-> CreateTranslation200Response -> CreateTranslation200Response
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslation200Response
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslation200Response
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslation200Response
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslation200Response
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateTranslation200Response -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateTranslation200Response -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranslation200Response
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranslation200Response
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranslation200Response -> m CreateTranslation200Response
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranslation200Response -> m CreateTranslation200Response
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslation200Response -> m CreateTranslation200Response
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslation200Response -> m CreateTranslation200Response
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslation200Response -> m CreateTranslation200Response
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslation200Response -> m CreateTranslation200Response
Data)

instance FromJSON CreateTranslation200Response where
  parseJSON :: Value -> Parser CreateTranslation200Response
parseJSON = Options -> Value -> Parser CreateTranslation200Response
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createTranslation200Response")
instance ToJSON CreateTranslation200Response where
  toJSON :: CreateTranslation200Response -> Value
toJSON = Options -> CreateTranslation200Response -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createTranslation200Response")


-- | 
data CreateTranslationResponseJson = CreateTranslationResponseJson
  { CreateTranslationResponseJson -> Text
createTranslationResponseJsonText :: Text -- ^ 
  } deriving (Int -> CreateTranslationResponseJson -> ShowS
[CreateTranslationResponseJson] -> ShowS
CreateTranslationResponseJson -> String
(Int -> CreateTranslationResponseJson -> ShowS)
-> (CreateTranslationResponseJson -> String)
-> ([CreateTranslationResponseJson] -> ShowS)
-> Show CreateTranslationResponseJson
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTranslationResponseJson -> ShowS
showsPrec :: Int -> CreateTranslationResponseJson -> ShowS
$cshow :: CreateTranslationResponseJson -> String
show :: CreateTranslationResponseJson -> String
$cshowList :: [CreateTranslationResponseJson] -> ShowS
showList :: [CreateTranslationResponseJson] -> ShowS
Show, CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
(CreateTranslationResponseJson
 -> CreateTranslationResponseJson -> Bool)
-> (CreateTranslationResponseJson
    -> CreateTranslationResponseJson -> Bool)
-> Eq CreateTranslationResponseJson
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
== :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
$c/= :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
/= :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
Eq, Eq CreateTranslationResponseJson
Eq CreateTranslationResponseJson =>
(CreateTranslationResponseJson
 -> CreateTranslationResponseJson -> Ordering)
-> (CreateTranslationResponseJson
    -> CreateTranslationResponseJson -> Bool)
-> (CreateTranslationResponseJson
    -> CreateTranslationResponseJson -> Bool)
-> (CreateTranslationResponseJson
    -> CreateTranslationResponseJson -> Bool)
-> (CreateTranslationResponseJson
    -> CreateTranslationResponseJson -> Bool)
-> (CreateTranslationResponseJson
    -> CreateTranslationResponseJson -> CreateTranslationResponseJson)
-> (CreateTranslationResponseJson
    -> CreateTranslationResponseJson -> CreateTranslationResponseJson)
-> Ord CreateTranslationResponseJson
CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Ordering
CreateTranslationResponseJson
-> CreateTranslationResponseJson -> CreateTranslationResponseJson
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Ordering
compare :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Ordering
$c< :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
< :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
$c<= :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
<= :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
$c> :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
> :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
$c>= :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
>= :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> Bool
$cmax :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> CreateTranslationResponseJson
max :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> CreateTranslationResponseJson
$cmin :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> CreateTranslationResponseJson
min :: CreateTranslationResponseJson
-> CreateTranslationResponseJson -> CreateTranslationResponseJson
Ord, (forall x.
 CreateTranslationResponseJson
 -> Rep CreateTranslationResponseJson x)
-> (forall x.
    Rep CreateTranslationResponseJson x
    -> CreateTranslationResponseJson)
-> Generic CreateTranslationResponseJson
forall x.
Rep CreateTranslationResponseJson x
-> CreateTranslationResponseJson
forall x.
CreateTranslationResponseJson
-> Rep CreateTranslationResponseJson x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateTranslationResponseJson
-> Rep CreateTranslationResponseJson x
from :: forall x.
CreateTranslationResponseJson
-> Rep CreateTranslationResponseJson x
$cto :: forall x.
Rep CreateTranslationResponseJson x
-> CreateTranslationResponseJson
to :: forall x.
Rep CreateTranslationResponseJson x
-> CreateTranslationResponseJson
Generic, Typeable CreateTranslationResponseJson
Typeable CreateTranslationResponseJson =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateTranslationResponseJson
 -> c CreateTranslationResponseJson)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateTranslationResponseJson)
-> (CreateTranslationResponseJson -> Constr)
-> (CreateTranslationResponseJson -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateTranslationResponseJson))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateTranslationResponseJson))
-> ((forall b. Data b => b -> b)
    -> CreateTranslationResponseJson -> CreateTranslationResponseJson)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranslationResponseJson
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranslationResponseJson
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateTranslationResponseJson -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateTranslationResponseJson
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateTranslationResponseJson
    -> m CreateTranslationResponseJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranslationResponseJson
    -> m CreateTranslationResponseJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranslationResponseJson
    -> m CreateTranslationResponseJson)
-> Data CreateTranslationResponseJson
CreateTranslationResponseJson -> Constr
CreateTranslationResponseJson -> DataType
(forall b. Data b => b -> b)
-> CreateTranslationResponseJson -> CreateTranslationResponseJson
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranslationResponseJson
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateTranslationResponseJson -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseJson
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseJson
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseJson -> m CreateTranslationResponseJson
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseJson -> m CreateTranslationResponseJson
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranslationResponseJson
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranslationResponseJson
-> c CreateTranslationResponseJson
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranslationResponseJson)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranslationResponseJson)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranslationResponseJson
-> c CreateTranslationResponseJson
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranslationResponseJson
-> c CreateTranslationResponseJson
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranslationResponseJson
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranslationResponseJson
$ctoConstr :: CreateTranslationResponseJson -> Constr
toConstr :: CreateTranslationResponseJson -> Constr
$cdataTypeOf :: CreateTranslationResponseJson -> DataType
dataTypeOf :: CreateTranslationResponseJson -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranslationResponseJson)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranslationResponseJson)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranslationResponseJson)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranslationResponseJson)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateTranslationResponseJson -> CreateTranslationResponseJson
gmapT :: (forall b. Data b => b -> b)
-> CreateTranslationResponseJson -> CreateTranslationResponseJson
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseJson
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseJson
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseJson
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseJson
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateTranslationResponseJson -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateTranslationResponseJson -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranslationResponseJson
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranslationResponseJson
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseJson -> m CreateTranslationResponseJson
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseJson -> m CreateTranslationResponseJson
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseJson -> m CreateTranslationResponseJson
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseJson -> m CreateTranslationResponseJson
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseJson -> m CreateTranslationResponseJson
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseJson -> m CreateTranslationResponseJson
Data)

instance FromJSON CreateTranslationResponseJson where
  parseJSON :: Value -> Parser CreateTranslationResponseJson
parseJSON = Options -> Value -> Parser CreateTranslationResponseJson
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createTranslationResponseJson")
instance ToJSON CreateTranslationResponseJson where
  toJSON :: CreateTranslationResponseJson -> Value
toJSON = Options -> CreateTranslationResponseJson -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createTranslationResponseJson")


-- | 
data CreateTranslationResponseVerboseJson = CreateTranslationResponseVerboseJson
  { CreateTranslationResponseVerboseJson -> Text
createTranslationResponseVerboseJsonLanguage :: Text -- ^ The language of the output translation (always `english`).
  , CreateTranslationResponseVerboseJson -> Text
createTranslationResponseVerboseJsonDuration :: Text -- ^ The duration of the input audio.
  , CreateTranslationResponseVerboseJson -> Text
createTranslationResponseVerboseJsonText :: Text -- ^ The translated text.
  , CreateTranslationResponseVerboseJson
-> Maybe [TranscriptionSegment]
createTranslationResponseVerboseJsonSegments :: Maybe [TranscriptionSegment] -- ^ Segments of the translated text and their corresponding details.
  } deriving (Int -> CreateTranslationResponseVerboseJson -> ShowS
[CreateTranslationResponseVerboseJson] -> ShowS
CreateTranslationResponseVerboseJson -> String
(Int -> CreateTranslationResponseVerboseJson -> ShowS)
-> (CreateTranslationResponseVerboseJson -> String)
-> ([CreateTranslationResponseVerboseJson] -> ShowS)
-> Show CreateTranslationResponseVerboseJson
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTranslationResponseVerboseJson -> ShowS
showsPrec :: Int -> CreateTranslationResponseVerboseJson -> ShowS
$cshow :: CreateTranslationResponseVerboseJson -> String
show :: CreateTranslationResponseVerboseJson -> String
$cshowList :: [CreateTranslationResponseVerboseJson] -> ShowS
showList :: [CreateTranslationResponseVerboseJson] -> ShowS
Show, CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
(CreateTranslationResponseVerboseJson
 -> CreateTranslationResponseVerboseJson -> Bool)
-> (CreateTranslationResponseVerboseJson
    -> CreateTranslationResponseVerboseJson -> Bool)
-> Eq CreateTranslationResponseVerboseJson
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
== :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
$c/= :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
/= :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
Eq, Eq CreateTranslationResponseVerboseJson
Eq CreateTranslationResponseVerboseJson =>
(CreateTranslationResponseVerboseJson
 -> CreateTranslationResponseVerboseJson -> Ordering)
-> (CreateTranslationResponseVerboseJson
    -> CreateTranslationResponseVerboseJson -> Bool)
-> (CreateTranslationResponseVerboseJson
    -> CreateTranslationResponseVerboseJson -> Bool)
-> (CreateTranslationResponseVerboseJson
    -> CreateTranslationResponseVerboseJson -> Bool)
-> (CreateTranslationResponseVerboseJson
    -> CreateTranslationResponseVerboseJson -> Bool)
-> (CreateTranslationResponseVerboseJson
    -> CreateTranslationResponseVerboseJson
    -> CreateTranslationResponseVerboseJson)
-> (CreateTranslationResponseVerboseJson
    -> CreateTranslationResponseVerboseJson
    -> CreateTranslationResponseVerboseJson)
-> Ord CreateTranslationResponseVerboseJson
CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Ordering
CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Ordering
compare :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Ordering
$c< :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
< :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
$c<= :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
<= :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
$c> :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
> :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
$c>= :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
>= :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson -> Bool
$cmax :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
max :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
$cmin :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
min :: CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
Ord, (forall x.
 CreateTranslationResponseVerboseJson
 -> Rep CreateTranslationResponseVerboseJson x)
-> (forall x.
    Rep CreateTranslationResponseVerboseJson x
    -> CreateTranslationResponseVerboseJson)
-> Generic CreateTranslationResponseVerboseJson
forall x.
Rep CreateTranslationResponseVerboseJson x
-> CreateTranslationResponseVerboseJson
forall x.
CreateTranslationResponseVerboseJson
-> Rep CreateTranslationResponseVerboseJson x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateTranslationResponseVerboseJson
-> Rep CreateTranslationResponseVerboseJson x
from :: forall x.
CreateTranslationResponseVerboseJson
-> Rep CreateTranslationResponseVerboseJson x
$cto :: forall x.
Rep CreateTranslationResponseVerboseJson x
-> CreateTranslationResponseVerboseJson
to :: forall x.
Rep CreateTranslationResponseVerboseJson x
-> CreateTranslationResponseVerboseJson
Generic, Typeable CreateTranslationResponseVerboseJson
Typeable CreateTranslationResponseVerboseJson =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CreateTranslationResponseVerboseJson
 -> c CreateTranslationResponseVerboseJson)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CreateTranslationResponseVerboseJson)
-> (CreateTranslationResponseVerboseJson -> Constr)
-> (CreateTranslationResponseVerboseJson -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CreateTranslationResponseVerboseJson))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateTranslationResponseVerboseJson))
-> ((forall b. Data b => b -> b)
    -> CreateTranslationResponseVerboseJson
    -> CreateTranslationResponseVerboseJson)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranslationResponseVerboseJson
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CreateTranslationResponseVerboseJson
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CreateTranslationResponseVerboseJson -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CreateTranslationResponseVerboseJson
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateTranslationResponseVerboseJson
    -> m CreateTranslationResponseVerboseJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranslationResponseVerboseJson
    -> m CreateTranslationResponseVerboseJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateTranslationResponseVerboseJson
    -> m CreateTranslationResponseVerboseJson)
-> Data CreateTranslationResponseVerboseJson
CreateTranslationResponseVerboseJson -> Constr
CreateTranslationResponseVerboseJson -> DataType
(forall b. Data b => b -> b)
-> CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranslationResponseVerboseJson
-> u
forall u.
(forall d. Data d => d -> u)
-> CreateTranslationResponseVerboseJson -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseVerboseJson
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseVerboseJson
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseVerboseJson
-> m CreateTranslationResponseVerboseJson
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseVerboseJson
-> m CreateTranslationResponseVerboseJson
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranslationResponseVerboseJson
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranslationResponseVerboseJson
-> c CreateTranslationResponseVerboseJson
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranslationResponseVerboseJson)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranslationResponseVerboseJson)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranslationResponseVerboseJson
-> c CreateTranslationResponseVerboseJson
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateTranslationResponseVerboseJson
-> c CreateTranslationResponseVerboseJson
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranslationResponseVerboseJson
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CreateTranslationResponseVerboseJson
$ctoConstr :: CreateTranslationResponseVerboseJson -> Constr
toConstr :: CreateTranslationResponseVerboseJson -> Constr
$cdataTypeOf :: CreateTranslationResponseVerboseJson -> DataType
dataTypeOf :: CreateTranslationResponseVerboseJson -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranslationResponseVerboseJson)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CreateTranslationResponseVerboseJson)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranslationResponseVerboseJson)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateTranslationResponseVerboseJson)
$cgmapT :: (forall b. Data b => b -> b)
-> CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
gmapT :: (forall b. Data b => b -> b)
-> CreateTranslationResponseVerboseJson
-> CreateTranslationResponseVerboseJson
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseVerboseJson
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseVerboseJson
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseVerboseJson
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateTranslationResponseVerboseJson
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateTranslationResponseVerboseJson -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> CreateTranslationResponseVerboseJson -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranslationResponseVerboseJson
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CreateTranslationResponseVerboseJson
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseVerboseJson
-> m CreateTranslationResponseVerboseJson
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseVerboseJson
-> m CreateTranslationResponseVerboseJson
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseVerboseJson
-> m CreateTranslationResponseVerboseJson
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseVerboseJson
-> m CreateTranslationResponseVerboseJson
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseVerboseJson
-> m CreateTranslationResponseVerboseJson
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateTranslationResponseVerboseJson
-> m CreateTranslationResponseVerboseJson
Data)

instance FromJSON CreateTranslationResponseVerboseJson where
  parseJSON :: Value -> Parser CreateTranslationResponseVerboseJson
parseJSON = Options -> Value -> Parser CreateTranslationResponseVerboseJson
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"createTranslationResponseVerboseJson")
instance ToJSON CreateTranslationResponseVerboseJson where
  toJSON :: CreateTranslationResponseVerboseJson -> Value
toJSON = Options -> CreateTranslationResponseVerboseJson -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"createTranslationResponseVerboseJson")


-- | Deletes the association between the assistant and the file, but does not delete the [File](/docs/api-reference/files) object itself.
data DeleteAssistantFileResponse = DeleteAssistantFileResponse
  { DeleteAssistantFileResponse -> Text
deleteAssistantFileResponseId :: Text -- ^ 
  , DeleteAssistantFileResponse -> Bool
deleteAssistantFileResponseDeleted :: Bool -- ^ 
  , DeleteAssistantFileResponse -> Text
deleteAssistantFileResponseObject :: Text -- ^ 
  } deriving (Int -> DeleteAssistantFileResponse -> ShowS
[DeleteAssistantFileResponse] -> ShowS
DeleteAssistantFileResponse -> String
(Int -> DeleteAssistantFileResponse -> ShowS)
-> (DeleteAssistantFileResponse -> String)
-> ([DeleteAssistantFileResponse] -> ShowS)
-> Show DeleteAssistantFileResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteAssistantFileResponse -> ShowS
showsPrec :: Int -> DeleteAssistantFileResponse -> ShowS
$cshow :: DeleteAssistantFileResponse -> String
show :: DeleteAssistantFileResponse -> String
$cshowList :: [DeleteAssistantFileResponse] -> ShowS
showList :: [DeleteAssistantFileResponse] -> ShowS
Show, DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
(DeleteAssistantFileResponse
 -> DeleteAssistantFileResponse -> Bool)
-> (DeleteAssistantFileResponse
    -> DeleteAssistantFileResponse -> Bool)
-> Eq DeleteAssistantFileResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
== :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
$c/= :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
/= :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
Eq, Eq DeleteAssistantFileResponse
Eq DeleteAssistantFileResponse =>
(DeleteAssistantFileResponse
 -> DeleteAssistantFileResponse -> Ordering)
-> (DeleteAssistantFileResponse
    -> DeleteAssistantFileResponse -> Bool)
-> (DeleteAssistantFileResponse
    -> DeleteAssistantFileResponse -> Bool)
-> (DeleteAssistantFileResponse
    -> DeleteAssistantFileResponse -> Bool)
-> (DeleteAssistantFileResponse
    -> DeleteAssistantFileResponse -> Bool)
-> (DeleteAssistantFileResponse
    -> DeleteAssistantFileResponse -> DeleteAssistantFileResponse)
-> (DeleteAssistantFileResponse
    -> DeleteAssistantFileResponse -> DeleteAssistantFileResponse)
-> Ord DeleteAssistantFileResponse
DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
DeleteAssistantFileResponse
-> DeleteAssistantFileResponse -> Ordering
DeleteAssistantFileResponse
-> DeleteAssistantFileResponse -> DeleteAssistantFileResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeleteAssistantFileResponse
-> DeleteAssistantFileResponse -> Ordering
compare :: DeleteAssistantFileResponse
-> DeleteAssistantFileResponse -> Ordering
$c< :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
< :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
$c<= :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
<= :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
$c> :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
> :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
$c>= :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
>= :: DeleteAssistantFileResponse -> DeleteAssistantFileResponse -> Bool
$cmax :: DeleteAssistantFileResponse
-> DeleteAssistantFileResponse -> DeleteAssistantFileResponse
max :: DeleteAssistantFileResponse
-> DeleteAssistantFileResponse -> DeleteAssistantFileResponse
$cmin :: DeleteAssistantFileResponse
-> DeleteAssistantFileResponse -> DeleteAssistantFileResponse
min :: DeleteAssistantFileResponse
-> DeleteAssistantFileResponse -> DeleteAssistantFileResponse
Ord, (forall x.
 DeleteAssistantFileResponse -> Rep DeleteAssistantFileResponse x)
-> (forall x.
    Rep DeleteAssistantFileResponse x -> DeleteAssistantFileResponse)
-> Generic DeleteAssistantFileResponse
forall x.
Rep DeleteAssistantFileResponse x -> DeleteAssistantFileResponse
forall x.
DeleteAssistantFileResponse -> Rep DeleteAssistantFileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
DeleteAssistantFileResponse -> Rep DeleteAssistantFileResponse x
from :: forall x.
DeleteAssistantFileResponse -> Rep DeleteAssistantFileResponse x
$cto :: forall x.
Rep DeleteAssistantFileResponse x -> DeleteAssistantFileResponse
to :: forall x.
Rep DeleteAssistantFileResponse x -> DeleteAssistantFileResponse
Generic, Typeable DeleteAssistantFileResponse
Typeable DeleteAssistantFileResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> DeleteAssistantFileResponse
 -> c DeleteAssistantFileResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DeleteAssistantFileResponse)
-> (DeleteAssistantFileResponse -> Constr)
-> (DeleteAssistantFileResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c DeleteAssistantFileResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DeleteAssistantFileResponse))
-> ((forall b. Data b => b -> b)
    -> DeleteAssistantFileResponse -> DeleteAssistantFileResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DeleteAssistantFileResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DeleteAssistantFileResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DeleteAssistantFileResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> DeleteAssistantFileResponse
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse)
-> Data DeleteAssistantFileResponse
DeleteAssistantFileResponse -> Constr
DeleteAssistantFileResponse -> DataType
(forall b. Data b => b -> b)
-> DeleteAssistantFileResponse -> DeleteAssistantFileResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> DeleteAssistantFileResponse -> u
forall u.
(forall d. Data d => d -> u) -> DeleteAssistantFileResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantFileResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantFileResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteAssistantFileResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteAssistantFileResponse
-> c DeleteAssistantFileResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c DeleteAssistantFileResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteAssistantFileResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteAssistantFileResponse
-> c DeleteAssistantFileResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteAssistantFileResponse
-> c DeleteAssistantFileResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteAssistantFileResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteAssistantFileResponse
$ctoConstr :: DeleteAssistantFileResponse -> Constr
toConstr :: DeleteAssistantFileResponse -> Constr
$cdataTypeOf :: DeleteAssistantFileResponse -> DataType
dataTypeOf :: DeleteAssistantFileResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c DeleteAssistantFileResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c DeleteAssistantFileResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteAssistantFileResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteAssistantFileResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> DeleteAssistantFileResponse -> DeleteAssistantFileResponse
gmapT :: (forall b. Data b => b -> b)
-> DeleteAssistantFileResponse -> DeleteAssistantFileResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantFileResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantFileResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantFileResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantFileResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DeleteAssistantFileResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> DeleteAssistantFileResponse -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> DeleteAssistantFileResponse -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> DeleteAssistantFileResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantFileResponse -> m DeleteAssistantFileResponse
Data)

instance FromJSON DeleteAssistantFileResponse where
  parseJSON :: Value -> Parser DeleteAssistantFileResponse
parseJSON = Options -> Value -> Parser DeleteAssistantFileResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"deleteAssistantFileResponse")
instance ToJSON DeleteAssistantFileResponse where
  toJSON :: DeleteAssistantFileResponse -> Value
toJSON = Options -> DeleteAssistantFileResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"deleteAssistantFileResponse")


-- | 
data DeleteAssistantResponse = DeleteAssistantResponse
  { DeleteAssistantResponse -> Text
deleteAssistantResponseId :: Text -- ^ 
  , DeleteAssistantResponse -> Bool
deleteAssistantResponseDeleted :: Bool -- ^ 
  , DeleteAssistantResponse -> Text
deleteAssistantResponseObject :: Text -- ^ 
  } deriving (Int -> DeleteAssistantResponse -> ShowS
[DeleteAssistantResponse] -> ShowS
DeleteAssistantResponse -> String
(Int -> DeleteAssistantResponse -> ShowS)
-> (DeleteAssistantResponse -> String)
-> ([DeleteAssistantResponse] -> ShowS)
-> Show DeleteAssistantResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteAssistantResponse -> ShowS
showsPrec :: Int -> DeleteAssistantResponse -> ShowS
$cshow :: DeleteAssistantResponse -> String
show :: DeleteAssistantResponse -> String
$cshowList :: [DeleteAssistantResponse] -> ShowS
showList :: [DeleteAssistantResponse] -> ShowS
Show, DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
(DeleteAssistantResponse -> DeleteAssistantResponse -> Bool)
-> (DeleteAssistantResponse -> DeleteAssistantResponse -> Bool)
-> Eq DeleteAssistantResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
== :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
$c/= :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
/= :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
Eq, Eq DeleteAssistantResponse
Eq DeleteAssistantResponse =>
(DeleteAssistantResponse -> DeleteAssistantResponse -> Ordering)
-> (DeleteAssistantResponse -> DeleteAssistantResponse -> Bool)
-> (DeleteAssistantResponse -> DeleteAssistantResponse -> Bool)
-> (DeleteAssistantResponse -> DeleteAssistantResponse -> Bool)
-> (DeleteAssistantResponse -> DeleteAssistantResponse -> Bool)
-> (DeleteAssistantResponse
    -> DeleteAssistantResponse -> DeleteAssistantResponse)
-> (DeleteAssistantResponse
    -> DeleteAssistantResponse -> DeleteAssistantResponse)
-> Ord DeleteAssistantResponse
DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
DeleteAssistantResponse -> DeleteAssistantResponse -> Ordering
DeleteAssistantResponse
-> DeleteAssistantResponse -> DeleteAssistantResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeleteAssistantResponse -> DeleteAssistantResponse -> Ordering
compare :: DeleteAssistantResponse -> DeleteAssistantResponse -> Ordering
$c< :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
< :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
$c<= :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
<= :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
$c> :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
> :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
$c>= :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
>= :: DeleteAssistantResponse -> DeleteAssistantResponse -> Bool
$cmax :: DeleteAssistantResponse
-> DeleteAssistantResponse -> DeleteAssistantResponse
max :: DeleteAssistantResponse
-> DeleteAssistantResponse -> DeleteAssistantResponse
$cmin :: DeleteAssistantResponse
-> DeleteAssistantResponse -> DeleteAssistantResponse
min :: DeleteAssistantResponse
-> DeleteAssistantResponse -> DeleteAssistantResponse
Ord, (forall x.
 DeleteAssistantResponse -> Rep DeleteAssistantResponse x)
-> (forall x.
    Rep DeleteAssistantResponse x -> DeleteAssistantResponse)
-> Generic DeleteAssistantResponse
forall x. Rep DeleteAssistantResponse x -> DeleteAssistantResponse
forall x. DeleteAssistantResponse -> Rep DeleteAssistantResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeleteAssistantResponse -> Rep DeleteAssistantResponse x
from :: forall x. DeleteAssistantResponse -> Rep DeleteAssistantResponse x
$cto :: forall x. Rep DeleteAssistantResponse x -> DeleteAssistantResponse
to :: forall x. Rep DeleteAssistantResponse x -> DeleteAssistantResponse
Generic, Typeable DeleteAssistantResponse
Typeable DeleteAssistantResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> DeleteAssistantResponse
 -> c DeleteAssistantResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DeleteAssistantResponse)
-> (DeleteAssistantResponse -> Constr)
-> (DeleteAssistantResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DeleteAssistantResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DeleteAssistantResponse))
-> ((forall b. Data b => b -> b)
    -> DeleteAssistantResponse -> DeleteAssistantResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DeleteAssistantResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DeleteAssistantResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DeleteAssistantResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> DeleteAssistantResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DeleteAssistantResponse -> m DeleteAssistantResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteAssistantResponse -> m DeleteAssistantResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteAssistantResponse -> m DeleteAssistantResponse)
-> Data DeleteAssistantResponse
DeleteAssistantResponse -> Constr
DeleteAssistantResponse -> DataType
(forall b. Data b => b -> b)
-> DeleteAssistantResponse -> DeleteAssistantResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DeleteAssistantResponse -> u
forall u.
(forall d. Data d => d -> u) -> DeleteAssistantResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantResponse -> m DeleteAssistantResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantResponse -> m DeleteAssistantResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteAssistantResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteAssistantResponse
-> c DeleteAssistantResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteAssistantResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteAssistantResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteAssistantResponse
-> c DeleteAssistantResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteAssistantResponse
-> c DeleteAssistantResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteAssistantResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteAssistantResponse
$ctoConstr :: DeleteAssistantResponse -> Constr
toConstr :: DeleteAssistantResponse -> Constr
$cdataTypeOf :: DeleteAssistantResponse -> DataType
dataTypeOf :: DeleteAssistantResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteAssistantResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteAssistantResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteAssistantResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteAssistantResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> DeleteAssistantResponse -> DeleteAssistantResponse
gmapT :: (forall b. Data b => b -> b)
-> DeleteAssistantResponse -> DeleteAssistantResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DeleteAssistantResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DeleteAssistantResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> DeleteAssistantResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeleteAssistantResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeleteAssistantResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantResponse -> m DeleteAssistantResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantResponse -> m DeleteAssistantResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantResponse -> m DeleteAssistantResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantResponse -> m DeleteAssistantResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantResponse -> m DeleteAssistantResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteAssistantResponse -> m DeleteAssistantResponse
Data)

instance FromJSON DeleteAssistantResponse where
  parseJSON :: Value -> Parser DeleteAssistantResponse
parseJSON = Options -> Value -> Parser DeleteAssistantResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"deleteAssistantResponse")
instance ToJSON DeleteAssistantResponse where
  toJSON :: DeleteAssistantResponse -> Value
toJSON = Options -> DeleteAssistantResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"deleteAssistantResponse")


-- | 
data DeleteFileResponse = DeleteFileResponse
  { DeleteFileResponse -> Text
deleteFileResponseId :: Text -- ^ 
  , DeleteFileResponse -> Text
deleteFileResponseObject :: Text -- ^ 
  , DeleteFileResponse -> Bool
deleteFileResponseDeleted :: Bool -- ^ 
  } deriving (Int -> DeleteFileResponse -> ShowS
[DeleteFileResponse] -> ShowS
DeleteFileResponse -> String
(Int -> DeleteFileResponse -> ShowS)
-> (DeleteFileResponse -> String)
-> ([DeleteFileResponse] -> ShowS)
-> Show DeleteFileResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteFileResponse -> ShowS
showsPrec :: Int -> DeleteFileResponse -> ShowS
$cshow :: DeleteFileResponse -> String
show :: DeleteFileResponse -> String
$cshowList :: [DeleteFileResponse] -> ShowS
showList :: [DeleteFileResponse] -> ShowS
Show, DeleteFileResponse -> DeleteFileResponse -> Bool
(DeleteFileResponse -> DeleteFileResponse -> Bool)
-> (DeleteFileResponse -> DeleteFileResponse -> Bool)
-> Eq DeleteFileResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteFileResponse -> DeleteFileResponse -> Bool
== :: DeleteFileResponse -> DeleteFileResponse -> Bool
$c/= :: DeleteFileResponse -> DeleteFileResponse -> Bool
/= :: DeleteFileResponse -> DeleteFileResponse -> Bool
Eq, Eq DeleteFileResponse
Eq DeleteFileResponse =>
(DeleteFileResponse -> DeleteFileResponse -> Ordering)
-> (DeleteFileResponse -> DeleteFileResponse -> Bool)
-> (DeleteFileResponse -> DeleteFileResponse -> Bool)
-> (DeleteFileResponse -> DeleteFileResponse -> Bool)
-> (DeleteFileResponse -> DeleteFileResponse -> Bool)
-> (DeleteFileResponse -> DeleteFileResponse -> DeleteFileResponse)
-> (DeleteFileResponse -> DeleteFileResponse -> DeleteFileResponse)
-> Ord DeleteFileResponse
DeleteFileResponse -> DeleteFileResponse -> Bool
DeleteFileResponse -> DeleteFileResponse -> Ordering
DeleteFileResponse -> DeleteFileResponse -> DeleteFileResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeleteFileResponse -> DeleteFileResponse -> Ordering
compare :: DeleteFileResponse -> DeleteFileResponse -> Ordering
$c< :: DeleteFileResponse -> DeleteFileResponse -> Bool
< :: DeleteFileResponse -> DeleteFileResponse -> Bool
$c<= :: DeleteFileResponse -> DeleteFileResponse -> Bool
<= :: DeleteFileResponse -> DeleteFileResponse -> Bool
$c> :: DeleteFileResponse -> DeleteFileResponse -> Bool
> :: DeleteFileResponse -> DeleteFileResponse -> Bool
$c>= :: DeleteFileResponse -> DeleteFileResponse -> Bool
>= :: DeleteFileResponse -> DeleteFileResponse -> Bool
$cmax :: DeleteFileResponse -> DeleteFileResponse -> DeleteFileResponse
max :: DeleteFileResponse -> DeleteFileResponse -> DeleteFileResponse
$cmin :: DeleteFileResponse -> DeleteFileResponse -> DeleteFileResponse
min :: DeleteFileResponse -> DeleteFileResponse -> DeleteFileResponse
Ord, (forall x. DeleteFileResponse -> Rep DeleteFileResponse x)
-> (forall x. Rep DeleteFileResponse x -> DeleteFileResponse)
-> Generic DeleteFileResponse
forall x. Rep DeleteFileResponse x -> DeleteFileResponse
forall x. DeleteFileResponse -> Rep DeleteFileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeleteFileResponse -> Rep DeleteFileResponse x
from :: forall x. DeleteFileResponse -> Rep DeleteFileResponse x
$cto :: forall x. Rep DeleteFileResponse x -> DeleteFileResponse
to :: forall x. Rep DeleteFileResponse x -> DeleteFileResponse
Generic, Typeable DeleteFileResponse
Typeable DeleteFileResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> DeleteFileResponse
 -> c DeleteFileResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DeleteFileResponse)
-> (DeleteFileResponse -> Constr)
-> (DeleteFileResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DeleteFileResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DeleteFileResponse))
-> ((forall b. Data b => b -> b)
    -> DeleteFileResponse -> DeleteFileResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DeleteFileResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DeleteFileResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DeleteFileResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DeleteFileResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DeleteFileResponse -> m DeleteFileResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteFileResponse -> m DeleteFileResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteFileResponse -> m DeleteFileResponse)
-> Data DeleteFileResponse
DeleteFileResponse -> Constr
DeleteFileResponse -> DataType
(forall b. Data b => b -> b)
-> DeleteFileResponse -> DeleteFileResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DeleteFileResponse -> u
forall u. (forall d. Data d => d -> u) -> DeleteFileResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFileResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFileResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteFileResponse -> m DeleteFileResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteFileResponse -> m DeleteFileResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteFileResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteFileResponse
-> c DeleteFileResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteFileResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteFileResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteFileResponse
-> c DeleteFileResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteFileResponse
-> c DeleteFileResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteFileResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteFileResponse
$ctoConstr :: DeleteFileResponse -> Constr
toConstr :: DeleteFileResponse -> Constr
$cdataTypeOf :: DeleteFileResponse -> DataType
dataTypeOf :: DeleteFileResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteFileResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteFileResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteFileResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteFileResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> DeleteFileResponse -> DeleteFileResponse
gmapT :: (forall b. Data b => b -> b)
-> DeleteFileResponse -> DeleteFileResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFileResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFileResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFileResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFileResponse -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DeleteFileResponse -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> DeleteFileResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeleteFileResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeleteFileResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteFileResponse -> m DeleteFileResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteFileResponse -> m DeleteFileResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteFileResponse -> m DeleteFileResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteFileResponse -> m DeleteFileResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteFileResponse -> m DeleteFileResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteFileResponse -> m DeleteFileResponse
Data)

instance FromJSON DeleteFileResponse where
  parseJSON :: Value -> Parser DeleteFileResponse
parseJSON = Options -> Value -> Parser DeleteFileResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"deleteFileResponse")
instance ToJSON DeleteFileResponse where
  toJSON :: DeleteFileResponse -> Value
toJSON = Options -> DeleteFileResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"deleteFileResponse")


-- | 
data DeleteMessageResponse = DeleteMessageResponse
  { DeleteMessageResponse -> Text
deleteMessageResponseId :: Text -- ^ 
  , DeleteMessageResponse -> Bool
deleteMessageResponseDeleted :: Bool -- ^ 
  , DeleteMessageResponse -> Text
deleteMessageResponseObject :: Text -- ^ 
  } deriving (Int -> DeleteMessageResponse -> ShowS
[DeleteMessageResponse] -> ShowS
DeleteMessageResponse -> String
(Int -> DeleteMessageResponse -> ShowS)
-> (DeleteMessageResponse -> String)
-> ([DeleteMessageResponse] -> ShowS)
-> Show DeleteMessageResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteMessageResponse -> ShowS
showsPrec :: Int -> DeleteMessageResponse -> ShowS
$cshow :: DeleteMessageResponse -> String
show :: DeleteMessageResponse -> String
$cshowList :: [DeleteMessageResponse] -> ShowS
showList :: [DeleteMessageResponse] -> ShowS
Show, DeleteMessageResponse -> DeleteMessageResponse -> Bool
(DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> (DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> Eq DeleteMessageResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
== :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
$c/= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
/= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
Eq, Eq DeleteMessageResponse
Eq DeleteMessageResponse =>
(DeleteMessageResponse -> DeleteMessageResponse -> Ordering)
-> (DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> (DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> (DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> (DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> (DeleteMessageResponse
    -> DeleteMessageResponse -> DeleteMessageResponse)
-> (DeleteMessageResponse
    -> DeleteMessageResponse -> DeleteMessageResponse)
-> Ord DeleteMessageResponse
DeleteMessageResponse -> DeleteMessageResponse -> Bool
DeleteMessageResponse -> DeleteMessageResponse -> Ordering
DeleteMessageResponse
-> DeleteMessageResponse -> DeleteMessageResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeleteMessageResponse -> DeleteMessageResponse -> Ordering
compare :: DeleteMessageResponse -> DeleteMessageResponse -> Ordering
$c< :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
< :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
$c<= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
<= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
$c> :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
> :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
$c>= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
>= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
$cmax :: DeleteMessageResponse
-> DeleteMessageResponse -> DeleteMessageResponse
max :: DeleteMessageResponse
-> DeleteMessageResponse -> DeleteMessageResponse
$cmin :: DeleteMessageResponse
-> DeleteMessageResponse -> DeleteMessageResponse
min :: DeleteMessageResponse
-> DeleteMessageResponse -> DeleteMessageResponse
Ord, (forall x. DeleteMessageResponse -> Rep DeleteMessageResponse x)
-> (forall x. Rep DeleteMessageResponse x -> DeleteMessageResponse)
-> Generic DeleteMessageResponse
forall x. Rep DeleteMessageResponse x -> DeleteMessageResponse
forall x. DeleteMessageResponse -> Rep DeleteMessageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeleteMessageResponse -> Rep DeleteMessageResponse x
from :: forall x. DeleteMessageResponse -> Rep DeleteMessageResponse x
$cto :: forall x. Rep DeleteMessageResponse x -> DeleteMessageResponse
to :: forall x. Rep DeleteMessageResponse x -> DeleteMessageResponse
Generic, Typeable DeleteMessageResponse
Typeable DeleteMessageResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> DeleteMessageResponse
 -> c DeleteMessageResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DeleteMessageResponse)
-> (DeleteMessageResponse -> Constr)
-> (DeleteMessageResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DeleteMessageResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DeleteMessageResponse))
-> ((forall b. Data b => b -> b)
    -> DeleteMessageResponse -> DeleteMessageResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DeleteMessageResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DeleteMessageResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DeleteMessageResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DeleteMessageResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DeleteMessageResponse -> m DeleteMessageResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteMessageResponse -> m DeleteMessageResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteMessageResponse -> m DeleteMessageResponse)
-> Data DeleteMessageResponse
DeleteMessageResponse -> Constr
DeleteMessageResponse -> DataType
(forall b. Data b => b -> b)
-> DeleteMessageResponse -> DeleteMessageResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DeleteMessageResponse -> u
forall u.
(forall d. Data d => d -> u) -> DeleteMessageResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteMessageResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteMessageResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteMessageResponse -> m DeleteMessageResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteMessageResponse -> m DeleteMessageResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteMessageResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteMessageResponse
-> c DeleteMessageResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteMessageResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteMessageResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteMessageResponse
-> c DeleteMessageResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteMessageResponse
-> c DeleteMessageResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteMessageResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteMessageResponse
$ctoConstr :: DeleteMessageResponse -> Constr
toConstr :: DeleteMessageResponse -> Constr
$cdataTypeOf :: DeleteMessageResponse -> DataType
dataTypeOf :: DeleteMessageResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteMessageResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteMessageResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteMessageResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteMessageResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> DeleteMessageResponse -> DeleteMessageResponse
gmapT :: (forall b. Data b => b -> b)
-> DeleteMessageResponse -> DeleteMessageResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteMessageResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteMessageResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteMessageResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteMessageResponse -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DeleteMessageResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> DeleteMessageResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeleteMessageResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeleteMessageResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteMessageResponse -> m DeleteMessageResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteMessageResponse -> m DeleteMessageResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteMessageResponse -> m DeleteMessageResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteMessageResponse -> m DeleteMessageResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteMessageResponse -> m DeleteMessageResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteMessageResponse -> m DeleteMessageResponse
Data)

instance FromJSON DeleteMessageResponse where
  parseJSON :: Value -> Parser DeleteMessageResponse
parseJSON = Options -> Value -> Parser DeleteMessageResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"deleteMessageResponse")
instance ToJSON DeleteMessageResponse where
  toJSON :: DeleteMessageResponse -> Value
toJSON = Options -> DeleteMessageResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"deleteMessageResponse")


-- | 
data DeleteModelResponse = DeleteModelResponse
  { DeleteModelResponse -> Text
deleteModelResponseId :: Text -- ^ 
  , DeleteModelResponse -> Bool
deleteModelResponseDeleted :: Bool -- ^ 
  , DeleteModelResponse -> Text
deleteModelResponseObject :: Text -- ^ 
  } deriving (Int -> DeleteModelResponse -> ShowS
[DeleteModelResponse] -> ShowS
DeleteModelResponse -> String
(Int -> DeleteModelResponse -> ShowS)
-> (DeleteModelResponse -> String)
-> ([DeleteModelResponse] -> ShowS)
-> Show DeleteModelResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteModelResponse -> ShowS
showsPrec :: Int -> DeleteModelResponse -> ShowS
$cshow :: DeleteModelResponse -> String
show :: DeleteModelResponse -> String
$cshowList :: [DeleteModelResponse] -> ShowS
showList :: [DeleteModelResponse] -> ShowS
Show, DeleteModelResponse -> DeleteModelResponse -> Bool
(DeleteModelResponse -> DeleteModelResponse -> Bool)
-> (DeleteModelResponse -> DeleteModelResponse -> Bool)
-> Eq DeleteModelResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteModelResponse -> DeleteModelResponse -> Bool
== :: DeleteModelResponse -> DeleteModelResponse -> Bool
$c/= :: DeleteModelResponse -> DeleteModelResponse -> Bool
/= :: DeleteModelResponse -> DeleteModelResponse -> Bool
Eq, Eq DeleteModelResponse
Eq DeleteModelResponse =>
(DeleteModelResponse -> DeleteModelResponse -> Ordering)
-> (DeleteModelResponse -> DeleteModelResponse -> Bool)
-> (DeleteModelResponse -> DeleteModelResponse -> Bool)
-> (DeleteModelResponse -> DeleteModelResponse -> Bool)
-> (DeleteModelResponse -> DeleteModelResponse -> Bool)
-> (DeleteModelResponse
    -> DeleteModelResponse -> DeleteModelResponse)
-> (DeleteModelResponse
    -> DeleteModelResponse -> DeleteModelResponse)
-> Ord DeleteModelResponse
DeleteModelResponse -> DeleteModelResponse -> Bool
DeleteModelResponse -> DeleteModelResponse -> Ordering
DeleteModelResponse -> DeleteModelResponse -> DeleteModelResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeleteModelResponse -> DeleteModelResponse -> Ordering
compare :: DeleteModelResponse -> DeleteModelResponse -> Ordering
$c< :: DeleteModelResponse -> DeleteModelResponse -> Bool
< :: DeleteModelResponse -> DeleteModelResponse -> Bool
$c<= :: DeleteModelResponse -> DeleteModelResponse -> Bool
<= :: DeleteModelResponse -> DeleteModelResponse -> Bool
$c> :: DeleteModelResponse -> DeleteModelResponse -> Bool
> :: DeleteModelResponse -> DeleteModelResponse -> Bool
$c>= :: DeleteModelResponse -> DeleteModelResponse -> Bool
>= :: DeleteModelResponse -> DeleteModelResponse -> Bool
$cmax :: DeleteModelResponse -> DeleteModelResponse -> DeleteModelResponse
max :: DeleteModelResponse -> DeleteModelResponse -> DeleteModelResponse
$cmin :: DeleteModelResponse -> DeleteModelResponse -> DeleteModelResponse
min :: DeleteModelResponse -> DeleteModelResponse -> DeleteModelResponse
Ord, (forall x. DeleteModelResponse -> Rep DeleteModelResponse x)
-> (forall x. Rep DeleteModelResponse x -> DeleteModelResponse)
-> Generic DeleteModelResponse
forall x. Rep DeleteModelResponse x -> DeleteModelResponse
forall x. DeleteModelResponse -> Rep DeleteModelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeleteModelResponse -> Rep DeleteModelResponse x
from :: forall x. DeleteModelResponse -> Rep DeleteModelResponse x
$cto :: forall x. Rep DeleteModelResponse x -> DeleteModelResponse
to :: forall x. Rep DeleteModelResponse x -> DeleteModelResponse
Generic, Typeable DeleteModelResponse
Typeable DeleteModelResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> DeleteModelResponse
 -> c DeleteModelResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DeleteModelResponse)
-> (DeleteModelResponse -> Constr)
-> (DeleteModelResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DeleteModelResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DeleteModelResponse))
-> ((forall b. Data b => b -> b)
    -> DeleteModelResponse -> DeleteModelResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DeleteModelResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DeleteModelResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DeleteModelResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DeleteModelResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DeleteModelResponse -> m DeleteModelResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteModelResponse -> m DeleteModelResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteModelResponse -> m DeleteModelResponse)
-> Data DeleteModelResponse
DeleteModelResponse -> Constr
DeleteModelResponse -> DataType
(forall b. Data b => b -> b)
-> DeleteModelResponse -> DeleteModelResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DeleteModelResponse -> u
forall u.
(forall d. Data d => d -> u) -> DeleteModelResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteModelResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteModelResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteModelResponse -> m DeleteModelResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteModelResponse -> m DeleteModelResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteModelResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteModelResponse
-> c DeleteModelResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteModelResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteModelResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteModelResponse
-> c DeleteModelResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteModelResponse
-> c DeleteModelResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteModelResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteModelResponse
$ctoConstr :: DeleteModelResponse -> Constr
toConstr :: DeleteModelResponse -> Constr
$cdataTypeOf :: DeleteModelResponse -> DataType
dataTypeOf :: DeleteModelResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteModelResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteModelResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteModelResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteModelResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> DeleteModelResponse -> DeleteModelResponse
gmapT :: (forall b. Data b => b -> b)
-> DeleteModelResponse -> DeleteModelResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteModelResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteModelResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteModelResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteModelResponse -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DeleteModelResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> DeleteModelResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeleteModelResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeleteModelResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteModelResponse -> m DeleteModelResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteModelResponse -> m DeleteModelResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteModelResponse -> m DeleteModelResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteModelResponse -> m DeleteModelResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteModelResponse -> m DeleteModelResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteModelResponse -> m DeleteModelResponse
Data)

instance FromJSON DeleteModelResponse where
  parseJSON :: Value -> Parser DeleteModelResponse
parseJSON = Options -> Value -> Parser DeleteModelResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"deleteModelResponse")
instance ToJSON DeleteModelResponse where
  toJSON :: DeleteModelResponse -> Value
toJSON = Options -> DeleteModelResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"deleteModelResponse")


-- | 
data DeleteThreadResponse = DeleteThreadResponse
  { DeleteThreadResponse -> Text
deleteThreadResponseId :: Text -- ^ 
  , DeleteThreadResponse -> Bool
deleteThreadResponseDeleted :: Bool -- ^ 
  , DeleteThreadResponse -> Text
deleteThreadResponseObject :: Text -- ^ 
  } deriving (Int -> DeleteThreadResponse -> ShowS
[DeleteThreadResponse] -> ShowS
DeleteThreadResponse -> String
(Int -> DeleteThreadResponse -> ShowS)
-> (DeleteThreadResponse -> String)
-> ([DeleteThreadResponse] -> ShowS)
-> Show DeleteThreadResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteThreadResponse -> ShowS
showsPrec :: Int -> DeleteThreadResponse -> ShowS
$cshow :: DeleteThreadResponse -> String
show :: DeleteThreadResponse -> String
$cshowList :: [DeleteThreadResponse] -> ShowS
showList :: [DeleteThreadResponse] -> ShowS
Show, DeleteThreadResponse -> DeleteThreadResponse -> Bool
(DeleteThreadResponse -> DeleteThreadResponse -> Bool)
-> (DeleteThreadResponse -> DeleteThreadResponse -> Bool)
-> Eq DeleteThreadResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
== :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
$c/= :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
/= :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
Eq, Eq DeleteThreadResponse
Eq DeleteThreadResponse =>
(DeleteThreadResponse -> DeleteThreadResponse -> Ordering)
-> (DeleteThreadResponse -> DeleteThreadResponse -> Bool)
-> (DeleteThreadResponse -> DeleteThreadResponse -> Bool)
-> (DeleteThreadResponse -> DeleteThreadResponse -> Bool)
-> (DeleteThreadResponse -> DeleteThreadResponse -> Bool)
-> (DeleteThreadResponse
    -> DeleteThreadResponse -> DeleteThreadResponse)
-> (DeleteThreadResponse
    -> DeleteThreadResponse -> DeleteThreadResponse)
-> Ord DeleteThreadResponse
DeleteThreadResponse -> DeleteThreadResponse -> Bool
DeleteThreadResponse -> DeleteThreadResponse -> Ordering
DeleteThreadResponse
-> DeleteThreadResponse -> DeleteThreadResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeleteThreadResponse -> DeleteThreadResponse -> Ordering
compare :: DeleteThreadResponse -> DeleteThreadResponse -> Ordering
$c< :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
< :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
$c<= :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
<= :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
$c> :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
> :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
$c>= :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
>= :: DeleteThreadResponse -> DeleteThreadResponse -> Bool
$cmax :: DeleteThreadResponse
-> DeleteThreadResponse -> DeleteThreadResponse
max :: DeleteThreadResponse
-> DeleteThreadResponse -> DeleteThreadResponse
$cmin :: DeleteThreadResponse
-> DeleteThreadResponse -> DeleteThreadResponse
min :: DeleteThreadResponse
-> DeleteThreadResponse -> DeleteThreadResponse
Ord, (forall x. DeleteThreadResponse -> Rep DeleteThreadResponse x)
-> (forall x. Rep DeleteThreadResponse x -> DeleteThreadResponse)
-> Generic DeleteThreadResponse
forall x. Rep DeleteThreadResponse x -> DeleteThreadResponse
forall x. DeleteThreadResponse -> Rep DeleteThreadResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeleteThreadResponse -> Rep DeleteThreadResponse x
from :: forall x. DeleteThreadResponse -> Rep DeleteThreadResponse x
$cto :: forall x. Rep DeleteThreadResponse x -> DeleteThreadResponse
to :: forall x. Rep DeleteThreadResponse x -> DeleteThreadResponse
Generic, Typeable DeleteThreadResponse
Typeable DeleteThreadResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> DeleteThreadResponse
 -> c DeleteThreadResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DeleteThreadResponse)
-> (DeleteThreadResponse -> Constr)
-> (DeleteThreadResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DeleteThreadResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DeleteThreadResponse))
-> ((forall b. Data b => b -> b)
    -> DeleteThreadResponse -> DeleteThreadResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DeleteThreadResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DeleteThreadResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DeleteThreadResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DeleteThreadResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DeleteThreadResponse -> m DeleteThreadResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteThreadResponse -> m DeleteThreadResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeleteThreadResponse -> m DeleteThreadResponse)
-> Data DeleteThreadResponse
DeleteThreadResponse -> Constr
DeleteThreadResponse -> DataType
(forall b. Data b => b -> b)
-> DeleteThreadResponse -> DeleteThreadResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DeleteThreadResponse -> u
forall u.
(forall d. Data d => d -> u) -> DeleteThreadResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteThreadResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteThreadResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteThreadResponse -> m DeleteThreadResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteThreadResponse -> m DeleteThreadResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteThreadResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteThreadResponse
-> c DeleteThreadResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteThreadResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteThreadResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteThreadResponse
-> c DeleteThreadResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeleteThreadResponse
-> c DeleteThreadResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteThreadResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteThreadResponse
$ctoConstr :: DeleteThreadResponse -> Constr
toConstr :: DeleteThreadResponse -> Constr
$cdataTypeOf :: DeleteThreadResponse -> DataType
dataTypeOf :: DeleteThreadResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteThreadResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteThreadResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteThreadResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeleteThreadResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> DeleteThreadResponse -> DeleteThreadResponse
gmapT :: (forall b. Data b => b -> b)
-> DeleteThreadResponse -> DeleteThreadResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteThreadResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteThreadResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteThreadResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteThreadResponse -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DeleteThreadResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> DeleteThreadResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeleteThreadResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeleteThreadResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteThreadResponse -> m DeleteThreadResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeleteThreadResponse -> m DeleteThreadResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteThreadResponse -> m DeleteThreadResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteThreadResponse -> m DeleteThreadResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteThreadResponse -> m DeleteThreadResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeleteThreadResponse -> m DeleteThreadResponse
Data)

instance FromJSON DeleteThreadResponse where
  parseJSON :: Value -> Parser DeleteThreadResponse
parseJSON = Options -> Value -> Parser DeleteThreadResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"deleteThreadResponse")
instance ToJSON DeleteThreadResponse where
  toJSON :: DeleteThreadResponse -> Value
toJSON = Options -> DeleteThreadResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"deleteThreadResponse")


-- | Represents an embedding vector returned by embedding endpoint. 
data Embedding = Embedding
  { Embedding -> Int
embeddingIndex :: Int -- ^ The index of the embedding in the list of embeddings.
  , Embedding -> [Double]
embeddingEmbedding :: [Double] -- ^ The embedding vector, which is a list of floats. The length of vector depends on the model as listed in the [embedding guide](/docs/guides/embeddings). 
  , Embedding -> Text
embeddingObject :: Text -- ^ The object type, which is always \"embedding\".
  } deriving (Int -> Embedding -> ShowS
[Embedding] -> ShowS
Embedding -> String
(Int -> Embedding -> ShowS)
-> (Embedding -> String)
-> ([Embedding] -> ShowS)
-> Show Embedding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Embedding -> ShowS
showsPrec :: Int -> Embedding -> ShowS
$cshow :: Embedding -> String
show :: Embedding -> String
$cshowList :: [Embedding] -> ShowS
showList :: [Embedding] -> ShowS
Show, Embedding -> Embedding -> Bool
(Embedding -> Embedding -> Bool)
-> (Embedding -> Embedding -> Bool) -> Eq Embedding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Embedding -> Embedding -> Bool
== :: Embedding -> Embedding -> Bool
$c/= :: Embedding -> Embedding -> Bool
/= :: Embedding -> Embedding -> Bool
Eq, Eq Embedding
Eq Embedding =>
(Embedding -> Embedding -> Ordering)
-> (Embedding -> Embedding -> Bool)
-> (Embedding -> Embedding -> Bool)
-> (Embedding -> Embedding -> Bool)
-> (Embedding -> Embedding -> Bool)
-> (Embedding -> Embedding -> Embedding)
-> (Embedding -> Embedding -> Embedding)
-> Ord Embedding
Embedding -> Embedding -> Bool
Embedding -> Embedding -> Ordering
Embedding -> Embedding -> Embedding
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Embedding -> Embedding -> Ordering
compare :: Embedding -> Embedding -> Ordering
$c< :: Embedding -> Embedding -> Bool
< :: Embedding -> Embedding -> Bool
$c<= :: Embedding -> Embedding -> Bool
<= :: Embedding -> Embedding -> Bool
$c> :: Embedding -> Embedding -> Bool
> :: Embedding -> Embedding -> Bool
$c>= :: Embedding -> Embedding -> Bool
>= :: Embedding -> Embedding -> Bool
$cmax :: Embedding -> Embedding -> Embedding
max :: Embedding -> Embedding -> Embedding
$cmin :: Embedding -> Embedding -> Embedding
min :: Embedding -> Embedding -> Embedding
Ord, (forall x. Embedding -> Rep Embedding x)
-> (forall x. Rep Embedding x -> Embedding) -> Generic Embedding
forall x. Rep Embedding x -> Embedding
forall x. Embedding -> Rep Embedding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Embedding -> Rep Embedding x
from :: forall x. Embedding -> Rep Embedding x
$cto :: forall x. Rep Embedding x -> Embedding
to :: forall x. Rep Embedding x -> Embedding
Generic, Typeable Embedding
Typeable Embedding =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Embedding -> c Embedding)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Embedding)
-> (Embedding -> Constr)
-> (Embedding -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Embedding))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Embedding))
-> ((forall b. Data b => b -> b) -> Embedding -> Embedding)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Embedding -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Embedding -> r)
-> (forall u. (forall d. Data d => d -> u) -> Embedding -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Embedding -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Embedding -> m Embedding)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Embedding -> m Embedding)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Embedding -> m Embedding)
-> Data Embedding
Embedding -> Constr
Embedding -> DataType
(forall b. Data b => b -> b) -> Embedding -> Embedding
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Embedding -> u
forall u. (forall d. Data d => d -> u) -> Embedding -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Embedding -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Embedding -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Embedding -> m Embedding
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Embedding -> m Embedding
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Embedding
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Embedding -> c Embedding
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Embedding)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Embedding)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Embedding -> c Embedding
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Embedding -> c Embedding
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Embedding
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Embedding
$ctoConstr :: Embedding -> Constr
toConstr :: Embedding -> Constr
$cdataTypeOf :: Embedding -> DataType
dataTypeOf :: Embedding -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Embedding)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Embedding)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Embedding)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Embedding)
$cgmapT :: (forall b. Data b => b -> b) -> Embedding -> Embedding
gmapT :: (forall b. Data b => b -> b) -> Embedding -> Embedding
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Embedding -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Embedding -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Embedding -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Embedding -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Embedding -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Embedding -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Embedding -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Embedding -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Embedding -> m Embedding
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Embedding -> m Embedding
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Embedding -> m Embedding
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Embedding -> m Embedding
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Embedding -> m Embedding
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Embedding -> m Embedding
Data)

instance FromJSON Embedding where
  parseJSON :: Value -> Parser Embedding
parseJSON = Options -> Value -> Parser Embedding
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"embedding")
instance ToJSON Embedding where
  toJSON :: Embedding -> Value
toJSON = Options -> Embedding -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"embedding")


-- | 
data Error = Error
  { Error -> Text
errorCode :: Text -- ^ 
  , Error -> Text
errorMessage :: Text -- ^ 
  , Error -> Text
errorParam :: Text -- ^ 
  , Error -> Text
errorType :: Text -- ^ 
  } deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq, Eq Error
Eq Error =>
(Error -> Error -> Ordering)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Error)
-> (Error -> Error -> Error)
-> Ord Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Error -> Error -> Ordering
compare :: Error -> Error -> Ordering
$c< :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
>= :: Error -> Error -> Bool
$cmax :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
min :: Error -> Error -> Error
Ord, (forall x. Error -> Rep Error x)
-> (forall x. Rep Error x -> Error) -> Generic Error
forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Error -> Rep Error x
from :: forall x. Error -> Rep Error x
$cto :: forall x. Rep Error x -> Error
to :: forall x. Rep Error x -> Error
Generic, Typeable Error
Typeable Error =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Error -> c Error)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Error)
-> (Error -> Constr)
-> (Error -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Error))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error))
-> ((forall b. Data b => b -> b) -> Error -> Error)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r)
-> (forall u. (forall d. Data d => d -> u) -> Error -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Error -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> Data Error
Error -> Constr
Error -> DataType
(forall b. Data b => b -> b) -> Error -> Error
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
forall u. (forall d. Data d => d -> u) -> Error -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
$ctoConstr :: Error -> Constr
toConstr :: Error -> Constr
$cdataTypeOf :: Error -> DataType
dataTypeOf :: Error -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
$cgmapT :: (forall b. Data b => b -> b) -> Error -> Error
gmapT :: (forall b. Data b => b -> b) -> Error -> Error
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Error -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Error -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
Data)

instance FromJSON Error where
  parseJSON :: Value -> Parser Error
parseJSON = Options -> Value -> Parser Error
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"error")
instance ToJSON Error where
  toJSON :: Error -> Value
toJSON = Options -> Error -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"error")


-- | 
data ErrorResponse = ErrorResponse
  { ErrorResponse -> Error
errorResponseError :: Error -- ^ 
  } deriving (Int -> ErrorResponse -> ShowS
[ErrorResponse] -> ShowS
ErrorResponse -> String
(Int -> ErrorResponse -> ShowS)
-> (ErrorResponse -> String)
-> ([ErrorResponse] -> ShowS)
-> Show ErrorResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorResponse -> ShowS
showsPrec :: Int -> ErrorResponse -> ShowS
$cshow :: ErrorResponse -> String
show :: ErrorResponse -> String
$cshowList :: [ErrorResponse] -> ShowS
showList :: [ErrorResponse] -> ShowS
Show, ErrorResponse -> ErrorResponse -> Bool
(ErrorResponse -> ErrorResponse -> Bool)
-> (ErrorResponse -> ErrorResponse -> Bool) -> Eq ErrorResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorResponse -> ErrorResponse -> Bool
== :: ErrorResponse -> ErrorResponse -> Bool
$c/= :: ErrorResponse -> ErrorResponse -> Bool
/= :: ErrorResponse -> ErrorResponse -> Bool
Eq, Eq ErrorResponse
Eq ErrorResponse =>
(ErrorResponse -> ErrorResponse -> Ordering)
-> (ErrorResponse -> ErrorResponse -> Bool)
-> (ErrorResponse -> ErrorResponse -> Bool)
-> (ErrorResponse -> ErrorResponse -> Bool)
-> (ErrorResponse -> ErrorResponse -> Bool)
-> (ErrorResponse -> ErrorResponse -> ErrorResponse)
-> (ErrorResponse -> ErrorResponse -> ErrorResponse)
-> Ord ErrorResponse
ErrorResponse -> ErrorResponse -> Bool
ErrorResponse -> ErrorResponse -> Ordering
ErrorResponse -> ErrorResponse -> ErrorResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ErrorResponse -> ErrorResponse -> Ordering
compare :: ErrorResponse -> ErrorResponse -> Ordering
$c< :: ErrorResponse -> ErrorResponse -> Bool
< :: ErrorResponse -> ErrorResponse -> Bool
$c<= :: ErrorResponse -> ErrorResponse -> Bool
<= :: ErrorResponse -> ErrorResponse -> Bool
$c> :: ErrorResponse -> ErrorResponse -> Bool
> :: ErrorResponse -> ErrorResponse -> Bool
$c>= :: ErrorResponse -> ErrorResponse -> Bool
>= :: ErrorResponse -> ErrorResponse -> Bool
$cmax :: ErrorResponse -> ErrorResponse -> ErrorResponse
max :: ErrorResponse -> ErrorResponse -> ErrorResponse
$cmin :: ErrorResponse -> ErrorResponse -> ErrorResponse
min :: ErrorResponse -> ErrorResponse -> ErrorResponse
Ord, (forall x. ErrorResponse -> Rep ErrorResponse x)
-> (forall x. Rep ErrorResponse x -> ErrorResponse)
-> Generic ErrorResponse
forall x. Rep ErrorResponse x -> ErrorResponse
forall x. ErrorResponse -> Rep ErrorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ErrorResponse -> Rep ErrorResponse x
from :: forall x. ErrorResponse -> Rep ErrorResponse x
$cto :: forall x. Rep ErrorResponse x -> ErrorResponse
to :: forall x. Rep ErrorResponse x -> ErrorResponse
Generic, Typeable ErrorResponse
Typeable ErrorResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ErrorResponse -> c ErrorResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ErrorResponse)
-> (ErrorResponse -> Constr)
-> (ErrorResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ErrorResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ErrorResponse))
-> ((forall b. Data b => b -> b) -> ErrorResponse -> ErrorResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ErrorResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ErrorResponse -> r)
-> (forall u. (forall d. Data d => d -> u) -> ErrorResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ErrorResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse)
-> Data ErrorResponse
ErrorResponse -> Constr
ErrorResponse -> DataType
(forall b. Data b => b -> b) -> ErrorResponse -> ErrorResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ErrorResponse -> u
forall u. (forall d. Data d => d -> u) -> ErrorResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorResponse -> c ErrorResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ErrorResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorResponse -> c ErrorResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorResponse -> c ErrorResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorResponse
$ctoConstr :: ErrorResponse -> Constr
toConstr :: ErrorResponse -> Constr
$cdataTypeOf :: ErrorResponse -> DataType
dataTypeOf :: ErrorResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ErrorResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ErrorResponse)
$cgmapT :: (forall b. Data b => b -> b) -> ErrorResponse -> ErrorResponse
gmapT :: (forall b. Data b => b -> b) -> ErrorResponse -> ErrorResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorResponse -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorResponse -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorResponse -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorResponse -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorResponse -> m ErrorResponse
Data)

instance FromJSON ErrorResponse where
  parseJSON :: Value -> Parser ErrorResponse
parseJSON = Options -> Value -> Parser ErrorResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"errorResponse")
instance ToJSON ErrorResponse where
  toJSON :: ErrorResponse -> Value
toJSON = Options -> ErrorResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"errorResponse")


-- | The &#x60;fine_tuning.job&#x60; object represents a fine-tuning job that has been created through the API. 
data FineTuningJob = FineTuningJob
  { FineTuningJob -> Text
fineTuningJobId :: Text -- ^ The object identifier, which can be referenced in the API endpoints.
  , FineTuningJob -> Int
fineTuningJobCreatedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the fine-tuning job was created.
  , FineTuningJob -> FineTuningJobError
fineTuningJobError :: FineTuningJobError -- ^ 
  , FineTuningJob -> Text
fineTuningJobFineUnderscoretunedUnderscoremodel :: Text -- ^ The name of the fine-tuned model that is being created. The value will be null if the fine-tuning job is still running.
  , FineTuningJob -> Int
fineTuningJobFinishedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the fine-tuning job was finished. The value will be null if the fine-tuning job is still running.
  , FineTuningJob -> FineTuningJobHyperparameters
fineTuningJobHyperparameters :: FineTuningJobHyperparameters -- ^ 
  , FineTuningJob -> Text
fineTuningJobModel :: Text -- ^ The base model that is being fine-tuned.
  , FineTuningJob -> Text
fineTuningJobObject :: Text -- ^ The object type, which is always \"fine_tuning.job\".
  , FineTuningJob -> Text
fineTuningJobOrganizationUnderscoreid :: Text -- ^ The organization that owns the fine-tuning job.
  , FineTuningJob -> [Text]
fineTuningJobResultUnderscorefiles :: [Text] -- ^ The compiled results file ID(s) for the fine-tuning job. You can retrieve the results with the [Files API](/docs/api-reference/files/retrieve-contents).
  , FineTuningJob -> Text
fineTuningJobStatus :: Text -- ^ The current status of the fine-tuning job, which can be either `validating_files`, `queued`, `running`, `succeeded`, `failed`, or `cancelled`.
  , FineTuningJob -> Int
fineTuningJobTrainedUnderscoretokens :: Int -- ^ The total number of billable tokens processed by this fine-tuning job. The value will be null if the fine-tuning job is still running.
  , FineTuningJob -> Text
fineTuningJobTrainingUnderscorefile :: Text -- ^ The file ID used for training. You can retrieve the training data with the [Files API](/docs/api-reference/files/retrieve-contents).
  , FineTuningJob -> Text
fineTuningJobValidationUnderscorefile :: Text -- ^ The file ID used for validation. You can retrieve the validation results with the [Files API](/docs/api-reference/files/retrieve-contents).
  } deriving (Int -> FineTuningJob -> ShowS
[FineTuningJob] -> ShowS
FineTuningJob -> String
(Int -> FineTuningJob -> ShowS)
-> (FineTuningJob -> String)
-> ([FineTuningJob] -> ShowS)
-> Show FineTuningJob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FineTuningJob -> ShowS
showsPrec :: Int -> FineTuningJob -> ShowS
$cshow :: FineTuningJob -> String
show :: FineTuningJob -> String
$cshowList :: [FineTuningJob] -> ShowS
showList :: [FineTuningJob] -> ShowS
Show, FineTuningJob -> FineTuningJob -> Bool
(FineTuningJob -> FineTuningJob -> Bool)
-> (FineTuningJob -> FineTuningJob -> Bool) -> Eq FineTuningJob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FineTuningJob -> FineTuningJob -> Bool
== :: FineTuningJob -> FineTuningJob -> Bool
$c/= :: FineTuningJob -> FineTuningJob -> Bool
/= :: FineTuningJob -> FineTuningJob -> Bool
Eq, Eq FineTuningJob
Eq FineTuningJob =>
(FineTuningJob -> FineTuningJob -> Ordering)
-> (FineTuningJob -> FineTuningJob -> Bool)
-> (FineTuningJob -> FineTuningJob -> Bool)
-> (FineTuningJob -> FineTuningJob -> Bool)
-> (FineTuningJob -> FineTuningJob -> Bool)
-> (FineTuningJob -> FineTuningJob -> FineTuningJob)
-> (FineTuningJob -> FineTuningJob -> FineTuningJob)
-> Ord FineTuningJob
FineTuningJob -> FineTuningJob -> Bool
FineTuningJob -> FineTuningJob -> Ordering
FineTuningJob -> FineTuningJob -> FineTuningJob
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FineTuningJob -> FineTuningJob -> Ordering
compare :: FineTuningJob -> FineTuningJob -> Ordering
$c< :: FineTuningJob -> FineTuningJob -> Bool
< :: FineTuningJob -> FineTuningJob -> Bool
$c<= :: FineTuningJob -> FineTuningJob -> Bool
<= :: FineTuningJob -> FineTuningJob -> Bool
$c> :: FineTuningJob -> FineTuningJob -> Bool
> :: FineTuningJob -> FineTuningJob -> Bool
$c>= :: FineTuningJob -> FineTuningJob -> Bool
>= :: FineTuningJob -> FineTuningJob -> Bool
$cmax :: FineTuningJob -> FineTuningJob -> FineTuningJob
max :: FineTuningJob -> FineTuningJob -> FineTuningJob
$cmin :: FineTuningJob -> FineTuningJob -> FineTuningJob
min :: FineTuningJob -> FineTuningJob -> FineTuningJob
Ord, (forall x. FineTuningJob -> Rep FineTuningJob x)
-> (forall x. Rep FineTuningJob x -> FineTuningJob)
-> Generic FineTuningJob
forall x. Rep FineTuningJob x -> FineTuningJob
forall x. FineTuningJob -> Rep FineTuningJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FineTuningJob -> Rep FineTuningJob x
from :: forall x. FineTuningJob -> Rep FineTuningJob x
$cto :: forall x. Rep FineTuningJob x -> FineTuningJob
to :: forall x. Rep FineTuningJob x -> FineTuningJob
Generic, Typeable FineTuningJob
Typeable FineTuningJob =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FineTuningJob -> c FineTuningJob)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FineTuningJob)
-> (FineTuningJob -> Constr)
-> (FineTuningJob -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FineTuningJob))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FineTuningJob))
-> ((forall b. Data b => b -> b) -> FineTuningJob -> FineTuningJob)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FineTuningJob -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FineTuningJob -> r)
-> (forall u. (forall d. Data d => d -> u) -> FineTuningJob -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FineTuningJob -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob)
-> Data FineTuningJob
FineTuningJob -> Constr
FineTuningJob -> DataType
(forall b. Data b => b -> b) -> FineTuningJob -> FineTuningJob
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FineTuningJob -> u
forall u. (forall d. Data d => d -> u) -> FineTuningJob -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJob -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJob -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJob
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FineTuningJob -> c FineTuningJob
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FineTuningJob)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJob)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FineTuningJob -> c FineTuningJob
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FineTuningJob -> c FineTuningJob
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJob
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJob
$ctoConstr :: FineTuningJob -> Constr
toConstr :: FineTuningJob -> Constr
$cdataTypeOf :: FineTuningJob -> DataType
dataTypeOf :: FineTuningJob -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FineTuningJob)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FineTuningJob)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJob)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJob)
$cgmapT :: (forall b. Data b => b -> b) -> FineTuningJob -> FineTuningJob
gmapT :: (forall b. Data b => b -> b) -> FineTuningJob -> FineTuningJob
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJob -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJob -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJob -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJob -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FineTuningJob -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FineTuningJob -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FineTuningJob -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FineTuningJob -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FineTuningJob -> m FineTuningJob
Data)

instance FromJSON FineTuningJob where
  parseJSON :: Value -> Parser FineTuningJob
parseJSON = Options -> Value -> Parser FineTuningJob
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"fineTuningJob")
instance ToJSON FineTuningJob where
  toJSON :: FineTuningJob -> Value
toJSON = Options -> FineTuningJob -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"fineTuningJob")


-- | For fine-tuning jobs that have &#x60;failed&#x60;, this will contain more information on the cause of the failure.
data FineTuningJobError = FineTuningJobError
  { FineTuningJobError -> Text
fineTuningJobErrorCode :: Text -- ^ A machine-readable error code.
  , FineTuningJobError -> Text
fineTuningJobErrorMessage :: Text -- ^ A human-readable error message.
  , FineTuningJobError -> Text
fineTuningJobErrorParam :: Text -- ^ The parameter that was invalid, usually `training_file` or `validation_file`. This field will be null if the failure was not parameter-specific.
  } deriving (Int -> FineTuningJobError -> ShowS
[FineTuningJobError] -> ShowS
FineTuningJobError -> String
(Int -> FineTuningJobError -> ShowS)
-> (FineTuningJobError -> String)
-> ([FineTuningJobError] -> ShowS)
-> Show FineTuningJobError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FineTuningJobError -> ShowS
showsPrec :: Int -> FineTuningJobError -> ShowS
$cshow :: FineTuningJobError -> String
show :: FineTuningJobError -> String
$cshowList :: [FineTuningJobError] -> ShowS
showList :: [FineTuningJobError] -> ShowS
Show, FineTuningJobError -> FineTuningJobError -> Bool
(FineTuningJobError -> FineTuningJobError -> Bool)
-> (FineTuningJobError -> FineTuningJobError -> Bool)
-> Eq FineTuningJobError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FineTuningJobError -> FineTuningJobError -> Bool
== :: FineTuningJobError -> FineTuningJobError -> Bool
$c/= :: FineTuningJobError -> FineTuningJobError -> Bool
/= :: FineTuningJobError -> FineTuningJobError -> Bool
Eq, Eq FineTuningJobError
Eq FineTuningJobError =>
(FineTuningJobError -> FineTuningJobError -> Ordering)
-> (FineTuningJobError -> FineTuningJobError -> Bool)
-> (FineTuningJobError -> FineTuningJobError -> Bool)
-> (FineTuningJobError -> FineTuningJobError -> Bool)
-> (FineTuningJobError -> FineTuningJobError -> Bool)
-> (FineTuningJobError -> FineTuningJobError -> FineTuningJobError)
-> (FineTuningJobError -> FineTuningJobError -> FineTuningJobError)
-> Ord FineTuningJobError
FineTuningJobError -> FineTuningJobError -> Bool
FineTuningJobError -> FineTuningJobError -> Ordering
FineTuningJobError -> FineTuningJobError -> FineTuningJobError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FineTuningJobError -> FineTuningJobError -> Ordering
compare :: FineTuningJobError -> FineTuningJobError -> Ordering
$c< :: FineTuningJobError -> FineTuningJobError -> Bool
< :: FineTuningJobError -> FineTuningJobError -> Bool
$c<= :: FineTuningJobError -> FineTuningJobError -> Bool
<= :: FineTuningJobError -> FineTuningJobError -> Bool
$c> :: FineTuningJobError -> FineTuningJobError -> Bool
> :: FineTuningJobError -> FineTuningJobError -> Bool
$c>= :: FineTuningJobError -> FineTuningJobError -> Bool
>= :: FineTuningJobError -> FineTuningJobError -> Bool
$cmax :: FineTuningJobError -> FineTuningJobError -> FineTuningJobError
max :: FineTuningJobError -> FineTuningJobError -> FineTuningJobError
$cmin :: FineTuningJobError -> FineTuningJobError -> FineTuningJobError
min :: FineTuningJobError -> FineTuningJobError -> FineTuningJobError
Ord, (forall x. FineTuningJobError -> Rep FineTuningJobError x)
-> (forall x. Rep FineTuningJobError x -> FineTuningJobError)
-> Generic FineTuningJobError
forall x. Rep FineTuningJobError x -> FineTuningJobError
forall x. FineTuningJobError -> Rep FineTuningJobError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FineTuningJobError -> Rep FineTuningJobError x
from :: forall x. FineTuningJobError -> Rep FineTuningJobError x
$cto :: forall x. Rep FineTuningJobError x -> FineTuningJobError
to :: forall x. Rep FineTuningJobError x -> FineTuningJobError
Generic, Typeable FineTuningJobError
Typeable FineTuningJobError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> FineTuningJobError
 -> c FineTuningJobError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FineTuningJobError)
-> (FineTuningJobError -> Constr)
-> (FineTuningJobError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FineTuningJobError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FineTuningJobError))
-> ((forall b. Data b => b -> b)
    -> FineTuningJobError -> FineTuningJobError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FineTuningJobError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FineTuningJobError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FineTuningJobError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FineTuningJobError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobError -> m FineTuningJobError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobError -> m FineTuningJobError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobError -> m FineTuningJobError)
-> Data FineTuningJobError
FineTuningJobError -> Constr
FineTuningJobError -> DataType
(forall b. Data b => b -> b)
-> FineTuningJobError -> FineTuningJobError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FineTuningJobError -> u
forall u. (forall d. Data d => d -> u) -> FineTuningJobError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobError -> m FineTuningJobError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobError -> m FineTuningJobError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJobError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobError
-> c FineTuningJobError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FineTuningJobError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobError
-> c FineTuningJobError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobError
-> c FineTuningJobError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJobError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJobError
$ctoConstr :: FineTuningJobError -> Constr
toConstr :: FineTuningJobError -> Constr
$cdataTypeOf :: FineTuningJobError -> DataType
dataTypeOf :: FineTuningJobError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FineTuningJobError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FineTuningJobError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobError)
$cgmapT :: (forall b. Data b => b -> b)
-> FineTuningJobError -> FineTuningJobError
gmapT :: (forall b. Data b => b -> b)
-> FineTuningJobError -> FineTuningJobError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobError -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FineTuningJobError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FineTuningJobError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FineTuningJobError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FineTuningJobError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobError -> m FineTuningJobError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobError -> m FineTuningJobError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobError -> m FineTuningJobError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobError -> m FineTuningJobError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobError -> m FineTuningJobError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobError -> m FineTuningJobError
Data)

instance FromJSON FineTuningJobError where
  parseJSON :: Value -> Parser FineTuningJobError
parseJSON = Options -> Value -> Parser FineTuningJobError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"fineTuningJobError")
instance ToJSON FineTuningJobError where
  toJSON :: FineTuningJobError -> Value
toJSON = Options -> FineTuningJobError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"fineTuningJobError")


-- | Fine-tuning job event object
data FineTuningJobEvent = FineTuningJobEvent
  { FineTuningJobEvent -> Text
fineTuningJobEventId :: Text -- ^ 
  , FineTuningJobEvent -> Int
fineTuningJobEventCreatedUnderscoreat :: Int -- ^ 
  , FineTuningJobEvent -> Text
fineTuningJobEventLevel :: Text -- ^ 
  , FineTuningJobEvent -> Text
fineTuningJobEventMessage :: Text -- ^ 
  , FineTuningJobEvent -> Text
fineTuningJobEventObject :: Text -- ^ 
  } deriving (Int -> FineTuningJobEvent -> ShowS
[FineTuningJobEvent] -> ShowS
FineTuningJobEvent -> String
(Int -> FineTuningJobEvent -> ShowS)
-> (FineTuningJobEvent -> String)
-> ([FineTuningJobEvent] -> ShowS)
-> Show FineTuningJobEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FineTuningJobEvent -> ShowS
showsPrec :: Int -> FineTuningJobEvent -> ShowS
$cshow :: FineTuningJobEvent -> String
show :: FineTuningJobEvent -> String
$cshowList :: [FineTuningJobEvent] -> ShowS
showList :: [FineTuningJobEvent] -> ShowS
Show, FineTuningJobEvent -> FineTuningJobEvent -> Bool
(FineTuningJobEvent -> FineTuningJobEvent -> Bool)
-> (FineTuningJobEvent -> FineTuningJobEvent -> Bool)
-> Eq FineTuningJobEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
== :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
$c/= :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
/= :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
Eq, Eq FineTuningJobEvent
Eq FineTuningJobEvent =>
(FineTuningJobEvent -> FineTuningJobEvent -> Ordering)
-> (FineTuningJobEvent -> FineTuningJobEvent -> Bool)
-> (FineTuningJobEvent -> FineTuningJobEvent -> Bool)
-> (FineTuningJobEvent -> FineTuningJobEvent -> Bool)
-> (FineTuningJobEvent -> FineTuningJobEvent -> Bool)
-> (FineTuningJobEvent -> FineTuningJobEvent -> FineTuningJobEvent)
-> (FineTuningJobEvent -> FineTuningJobEvent -> FineTuningJobEvent)
-> Ord FineTuningJobEvent
FineTuningJobEvent -> FineTuningJobEvent -> Bool
FineTuningJobEvent -> FineTuningJobEvent -> Ordering
FineTuningJobEvent -> FineTuningJobEvent -> FineTuningJobEvent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FineTuningJobEvent -> FineTuningJobEvent -> Ordering
compare :: FineTuningJobEvent -> FineTuningJobEvent -> Ordering
$c< :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
< :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
$c<= :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
<= :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
$c> :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
> :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
$c>= :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
>= :: FineTuningJobEvent -> FineTuningJobEvent -> Bool
$cmax :: FineTuningJobEvent -> FineTuningJobEvent -> FineTuningJobEvent
max :: FineTuningJobEvent -> FineTuningJobEvent -> FineTuningJobEvent
$cmin :: FineTuningJobEvent -> FineTuningJobEvent -> FineTuningJobEvent
min :: FineTuningJobEvent -> FineTuningJobEvent -> FineTuningJobEvent
Ord, (forall x. FineTuningJobEvent -> Rep FineTuningJobEvent x)
-> (forall x. Rep FineTuningJobEvent x -> FineTuningJobEvent)
-> Generic FineTuningJobEvent
forall x. Rep FineTuningJobEvent x -> FineTuningJobEvent
forall x. FineTuningJobEvent -> Rep FineTuningJobEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FineTuningJobEvent -> Rep FineTuningJobEvent x
from :: forall x. FineTuningJobEvent -> Rep FineTuningJobEvent x
$cto :: forall x. Rep FineTuningJobEvent x -> FineTuningJobEvent
to :: forall x. Rep FineTuningJobEvent x -> FineTuningJobEvent
Generic, Typeable FineTuningJobEvent
Typeable FineTuningJobEvent =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> FineTuningJobEvent
 -> c FineTuningJobEvent)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FineTuningJobEvent)
-> (FineTuningJobEvent -> Constr)
-> (FineTuningJobEvent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FineTuningJobEvent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FineTuningJobEvent))
-> ((forall b. Data b => b -> b)
    -> FineTuningJobEvent -> FineTuningJobEvent)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FineTuningJobEvent -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FineTuningJobEvent -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FineTuningJobEvent -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FineTuningJobEvent -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobEvent -> m FineTuningJobEvent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobEvent -> m FineTuningJobEvent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobEvent -> m FineTuningJobEvent)
-> Data FineTuningJobEvent
FineTuningJobEvent -> Constr
FineTuningJobEvent -> DataType
(forall b. Data b => b -> b)
-> FineTuningJobEvent -> FineTuningJobEvent
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FineTuningJobEvent -> u
forall u. (forall d. Data d => d -> u) -> FineTuningJobEvent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobEvent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobEvent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobEvent -> m FineTuningJobEvent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobEvent -> m FineTuningJobEvent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJobEvent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobEvent
-> c FineTuningJobEvent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FineTuningJobEvent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobEvent)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobEvent
-> c FineTuningJobEvent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobEvent
-> c FineTuningJobEvent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJobEvent
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJobEvent
$ctoConstr :: FineTuningJobEvent -> Constr
toConstr :: FineTuningJobEvent -> Constr
$cdataTypeOf :: FineTuningJobEvent -> DataType
dataTypeOf :: FineTuningJobEvent -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FineTuningJobEvent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FineTuningJobEvent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobEvent)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobEvent)
$cgmapT :: (forall b. Data b => b -> b)
-> FineTuningJobEvent -> FineTuningJobEvent
gmapT :: (forall b. Data b => b -> b)
-> FineTuningJobEvent -> FineTuningJobEvent
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobEvent -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobEvent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobEvent -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FineTuningJobEvent -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FineTuningJobEvent -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FineTuningJobEvent -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FineTuningJobEvent -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FineTuningJobEvent -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobEvent -> m FineTuningJobEvent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobEvent -> m FineTuningJobEvent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobEvent -> m FineTuningJobEvent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobEvent -> m FineTuningJobEvent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobEvent -> m FineTuningJobEvent
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobEvent -> m FineTuningJobEvent
Data)

instance FromJSON FineTuningJobEvent where
  parseJSON :: Value -> Parser FineTuningJobEvent
parseJSON = Options -> Value -> Parser FineTuningJobEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"fineTuningJobEvent")
instance ToJSON FineTuningJobEvent where
  toJSON :: FineTuningJobEvent -> Value
toJSON = Options -> FineTuningJobEvent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"fineTuningJobEvent")


-- | The hyperparameters used for the fine-tuning job. See the [fine-tuning guide](/docs/guides/fine-tuning) for more details.
data FineTuningJobHyperparameters = FineTuningJobHyperparameters
  { FineTuningJobHyperparameters -> FineTuningJobHyperparametersNEpochs
fineTuningJobHyperparametersNUnderscoreepochs :: FineTuningJobHyperparametersNEpochs -- ^ 
  } deriving (Int -> FineTuningJobHyperparameters -> ShowS
[FineTuningJobHyperparameters] -> ShowS
FineTuningJobHyperparameters -> String
(Int -> FineTuningJobHyperparameters -> ShowS)
-> (FineTuningJobHyperparameters -> String)
-> ([FineTuningJobHyperparameters] -> ShowS)
-> Show FineTuningJobHyperparameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FineTuningJobHyperparameters -> ShowS
showsPrec :: Int -> FineTuningJobHyperparameters -> ShowS
$cshow :: FineTuningJobHyperparameters -> String
show :: FineTuningJobHyperparameters -> String
$cshowList :: [FineTuningJobHyperparameters] -> ShowS
showList :: [FineTuningJobHyperparameters] -> ShowS
Show, FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
(FineTuningJobHyperparameters
 -> FineTuningJobHyperparameters -> Bool)
-> (FineTuningJobHyperparameters
    -> FineTuningJobHyperparameters -> Bool)
-> Eq FineTuningJobHyperparameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
== :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
$c/= :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
/= :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
Eq, Eq FineTuningJobHyperparameters
Eq FineTuningJobHyperparameters =>
(FineTuningJobHyperparameters
 -> FineTuningJobHyperparameters -> Ordering)
-> (FineTuningJobHyperparameters
    -> FineTuningJobHyperparameters -> Bool)
-> (FineTuningJobHyperparameters
    -> FineTuningJobHyperparameters -> Bool)
-> (FineTuningJobHyperparameters
    -> FineTuningJobHyperparameters -> Bool)
-> (FineTuningJobHyperparameters
    -> FineTuningJobHyperparameters -> Bool)
-> (FineTuningJobHyperparameters
    -> FineTuningJobHyperparameters -> FineTuningJobHyperparameters)
-> (FineTuningJobHyperparameters
    -> FineTuningJobHyperparameters -> FineTuningJobHyperparameters)
-> Ord FineTuningJobHyperparameters
FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Ordering
FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> FineTuningJobHyperparameters
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Ordering
compare :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Ordering
$c< :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
< :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
$c<= :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
<= :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
$c> :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
> :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
$c>= :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
>= :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> Bool
$cmax :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> FineTuningJobHyperparameters
max :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> FineTuningJobHyperparameters
$cmin :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> FineTuningJobHyperparameters
min :: FineTuningJobHyperparameters
-> FineTuningJobHyperparameters -> FineTuningJobHyperparameters
Ord, (forall x.
 FineTuningJobHyperparameters -> Rep FineTuningJobHyperparameters x)
-> (forall x.
    Rep FineTuningJobHyperparameters x -> FineTuningJobHyperparameters)
-> Generic FineTuningJobHyperparameters
forall x.
Rep FineTuningJobHyperparameters x -> FineTuningJobHyperparameters
forall x.
FineTuningJobHyperparameters -> Rep FineTuningJobHyperparameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
FineTuningJobHyperparameters -> Rep FineTuningJobHyperparameters x
from :: forall x.
FineTuningJobHyperparameters -> Rep FineTuningJobHyperparameters x
$cto :: forall x.
Rep FineTuningJobHyperparameters x -> FineTuningJobHyperparameters
to :: forall x.
Rep FineTuningJobHyperparameters x -> FineTuningJobHyperparameters
Generic, Typeable FineTuningJobHyperparameters
Typeable FineTuningJobHyperparameters =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> FineTuningJobHyperparameters
 -> c FineTuningJobHyperparameters)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c FineTuningJobHyperparameters)
-> (FineTuningJobHyperparameters -> Constr)
-> (FineTuningJobHyperparameters -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c FineTuningJobHyperparameters))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FineTuningJobHyperparameters))
-> ((forall b. Data b => b -> b)
    -> FineTuningJobHyperparameters -> FineTuningJobHyperparameters)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> FineTuningJobHyperparameters
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> FineTuningJobHyperparameters
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> FineTuningJobHyperparameters -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> FineTuningJobHyperparameters
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters)
-> Data FineTuningJobHyperparameters
FineTuningJobHyperparameters -> Constr
FineTuningJobHyperparameters -> DataType
(forall b. Data b => b -> b)
-> FineTuningJobHyperparameters -> FineTuningJobHyperparameters
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> FineTuningJobHyperparameters
-> u
forall u.
(forall d. Data d => d -> u) -> FineTuningJobHyperparameters -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparameters
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparameters
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJobHyperparameters
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobHyperparameters
-> c FineTuningJobHyperparameters
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FineTuningJobHyperparameters)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobHyperparameters)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobHyperparameters
-> c FineTuningJobHyperparameters
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobHyperparameters
-> c FineTuningJobHyperparameters
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJobHyperparameters
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FineTuningJobHyperparameters
$ctoConstr :: FineTuningJobHyperparameters -> Constr
toConstr :: FineTuningJobHyperparameters -> Constr
$cdataTypeOf :: FineTuningJobHyperparameters -> DataType
dataTypeOf :: FineTuningJobHyperparameters -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FineTuningJobHyperparameters)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FineTuningJobHyperparameters)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobHyperparameters)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobHyperparameters)
$cgmapT :: (forall b. Data b => b -> b)
-> FineTuningJobHyperparameters -> FineTuningJobHyperparameters
gmapT :: (forall b. Data b => b -> b)
-> FineTuningJobHyperparameters -> FineTuningJobHyperparameters
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparameters
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparameters
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparameters
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparameters
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> FineTuningJobHyperparameters -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> FineTuningJobHyperparameters -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> FineTuningJobHyperparameters
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> FineTuningJobHyperparameters
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparameters -> m FineTuningJobHyperparameters
Data)

instance FromJSON FineTuningJobHyperparameters where
  parseJSON :: Value -> Parser FineTuningJobHyperparameters
parseJSON = Options -> Value -> Parser FineTuningJobHyperparameters
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"fineTuningJobHyperparameters")
instance ToJSON FineTuningJobHyperparameters where
  toJSON :: FineTuningJobHyperparameters -> Value
toJSON = Options -> FineTuningJobHyperparameters -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"fineTuningJobHyperparameters")


-- | The number of epochs to train the model for. An epoch refers to one full cycle through the training dataset. \&quot;auto\&quot; decides the optimal number of epochs based on the size of the dataset. If setting the number manually, we support any number between 1 and 50 epochs.
data FineTuningJobHyperparametersNEpochs = FineTuningJobHyperparametersNEpochs
  { 
  } deriving (Int -> FineTuningJobHyperparametersNEpochs -> ShowS
[FineTuningJobHyperparametersNEpochs] -> ShowS
FineTuningJobHyperparametersNEpochs -> String
(Int -> FineTuningJobHyperparametersNEpochs -> ShowS)
-> (FineTuningJobHyperparametersNEpochs -> String)
-> ([FineTuningJobHyperparametersNEpochs] -> ShowS)
-> Show FineTuningJobHyperparametersNEpochs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FineTuningJobHyperparametersNEpochs -> ShowS
showsPrec :: Int -> FineTuningJobHyperparametersNEpochs -> ShowS
$cshow :: FineTuningJobHyperparametersNEpochs -> String
show :: FineTuningJobHyperparametersNEpochs -> String
$cshowList :: [FineTuningJobHyperparametersNEpochs] -> ShowS
showList :: [FineTuningJobHyperparametersNEpochs] -> ShowS
Show, FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
(FineTuningJobHyperparametersNEpochs
 -> FineTuningJobHyperparametersNEpochs -> Bool)
-> (FineTuningJobHyperparametersNEpochs
    -> FineTuningJobHyperparametersNEpochs -> Bool)
-> Eq FineTuningJobHyperparametersNEpochs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
== :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
$c/= :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
/= :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
Eq, Eq FineTuningJobHyperparametersNEpochs
Eq FineTuningJobHyperparametersNEpochs =>
(FineTuningJobHyperparametersNEpochs
 -> FineTuningJobHyperparametersNEpochs -> Ordering)
-> (FineTuningJobHyperparametersNEpochs
    -> FineTuningJobHyperparametersNEpochs -> Bool)
-> (FineTuningJobHyperparametersNEpochs
    -> FineTuningJobHyperparametersNEpochs -> Bool)
-> (FineTuningJobHyperparametersNEpochs
    -> FineTuningJobHyperparametersNEpochs -> Bool)
-> (FineTuningJobHyperparametersNEpochs
    -> FineTuningJobHyperparametersNEpochs -> Bool)
-> (FineTuningJobHyperparametersNEpochs
    -> FineTuningJobHyperparametersNEpochs
    -> FineTuningJobHyperparametersNEpochs)
-> (FineTuningJobHyperparametersNEpochs
    -> FineTuningJobHyperparametersNEpochs
    -> FineTuningJobHyperparametersNEpochs)
-> Ord FineTuningJobHyperparametersNEpochs
FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Ordering
FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Ordering
compare :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Ordering
$c< :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
< :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
$c<= :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
<= :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
$c> :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
> :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
$c>= :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
>= :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs -> Bool
$cmax :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
max :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
$cmin :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
min :: FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
Ord, (forall x.
 FineTuningJobHyperparametersNEpochs
 -> Rep FineTuningJobHyperparametersNEpochs x)
-> (forall x.
    Rep FineTuningJobHyperparametersNEpochs x
    -> FineTuningJobHyperparametersNEpochs)
-> Generic FineTuningJobHyperparametersNEpochs
forall x.
Rep FineTuningJobHyperparametersNEpochs x
-> FineTuningJobHyperparametersNEpochs
forall x.
FineTuningJobHyperparametersNEpochs
-> Rep FineTuningJobHyperparametersNEpochs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
FineTuningJobHyperparametersNEpochs
-> Rep FineTuningJobHyperparametersNEpochs x
from :: forall x.
FineTuningJobHyperparametersNEpochs
-> Rep FineTuningJobHyperparametersNEpochs x
$cto :: forall x.
Rep FineTuningJobHyperparametersNEpochs x
-> FineTuningJobHyperparametersNEpochs
to :: forall x.
Rep FineTuningJobHyperparametersNEpochs x
-> FineTuningJobHyperparametersNEpochs
Generic, Typeable FineTuningJobHyperparametersNEpochs
Typeable FineTuningJobHyperparametersNEpochs =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> FineTuningJobHyperparametersNEpochs
 -> c FineTuningJobHyperparametersNEpochs)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c FineTuningJobHyperparametersNEpochs)
-> (FineTuningJobHyperparametersNEpochs -> Constr)
-> (FineTuningJobHyperparametersNEpochs -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c FineTuningJobHyperparametersNEpochs))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FineTuningJobHyperparametersNEpochs))
-> ((forall b. Data b => b -> b)
    -> FineTuningJobHyperparametersNEpochs
    -> FineTuningJobHyperparametersNEpochs)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> FineTuningJobHyperparametersNEpochs
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> FineTuningJobHyperparametersNEpochs
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> FineTuningJobHyperparametersNEpochs -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> FineTuningJobHyperparametersNEpochs
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobHyperparametersNEpochs
    -> m FineTuningJobHyperparametersNEpochs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobHyperparametersNEpochs
    -> m FineTuningJobHyperparametersNEpochs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FineTuningJobHyperparametersNEpochs
    -> m FineTuningJobHyperparametersNEpochs)
-> Data FineTuningJobHyperparametersNEpochs
FineTuningJobHyperparametersNEpochs -> Constr
FineTuningJobHyperparametersNEpochs -> DataType
(forall b. Data b => b -> b)
-> FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> FineTuningJobHyperparametersNEpochs
-> u
forall u.
(forall d. Data d => d -> u)
-> FineTuningJobHyperparametersNEpochs -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparametersNEpochs
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparametersNEpochs
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparametersNEpochs
-> m FineTuningJobHyperparametersNEpochs
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparametersNEpochs
-> m FineTuningJobHyperparametersNEpochs
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c FineTuningJobHyperparametersNEpochs
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobHyperparametersNEpochs
-> c FineTuningJobHyperparametersNEpochs
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FineTuningJobHyperparametersNEpochs)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobHyperparametersNEpochs)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobHyperparametersNEpochs
-> c FineTuningJobHyperparametersNEpochs
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FineTuningJobHyperparametersNEpochs
-> c FineTuningJobHyperparametersNEpochs
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c FineTuningJobHyperparametersNEpochs
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c FineTuningJobHyperparametersNEpochs
$ctoConstr :: FineTuningJobHyperparametersNEpochs -> Constr
toConstr :: FineTuningJobHyperparametersNEpochs -> Constr
$cdataTypeOf :: FineTuningJobHyperparametersNEpochs -> DataType
dataTypeOf :: FineTuningJobHyperparametersNEpochs -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FineTuningJobHyperparametersNEpochs)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FineTuningJobHyperparametersNEpochs)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobHyperparametersNEpochs)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FineTuningJobHyperparametersNEpochs)
$cgmapT :: (forall b. Data b => b -> b)
-> FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
gmapT :: (forall b. Data b => b -> b)
-> FineTuningJobHyperparametersNEpochs
-> FineTuningJobHyperparametersNEpochs
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparametersNEpochs
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparametersNEpochs
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparametersNEpochs
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FineTuningJobHyperparametersNEpochs
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> FineTuningJobHyperparametersNEpochs -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> FineTuningJobHyperparametersNEpochs -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> FineTuningJobHyperparametersNEpochs
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> FineTuningJobHyperparametersNEpochs
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparametersNEpochs
-> m FineTuningJobHyperparametersNEpochs
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparametersNEpochs
-> m FineTuningJobHyperparametersNEpochs
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparametersNEpochs
-> m FineTuningJobHyperparametersNEpochs
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparametersNEpochs
-> m FineTuningJobHyperparametersNEpochs
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparametersNEpochs
-> m FineTuningJobHyperparametersNEpochs
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FineTuningJobHyperparametersNEpochs
-> m FineTuningJobHyperparametersNEpochs
Data)

instance FromJSON FineTuningJobHyperparametersNEpochs where
  parseJSON :: Value -> Parser FineTuningJobHyperparametersNEpochs
parseJSON = Options -> Value -> Parser FineTuningJobHyperparametersNEpochs
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"fineTuningJobHyperparametersNEpochs")
instance ToJSON FineTuningJobHyperparametersNEpochs where
  toJSON :: FineTuningJobHyperparametersNEpochs -> Value
toJSON = Options -> FineTuningJobHyperparametersNEpochs -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"fineTuningJobHyperparametersNEpochs")


-- | 
data FunctionObject = FunctionObject
  { FunctionObject -> Maybe Text
functionObjectDescription :: Maybe Text -- ^ A description of what the function does, used by the model to choose when and how to call the function.
  , FunctionObject -> Text
functionObjectName :: Text -- ^ The name of the function to be called. Must be a-z, A-Z, 0-9, or contain underscores and dashes, with a maximum length of 64.
  , FunctionObject -> Maybe (Map String Value)
functionObjectParameters :: Maybe (Map.Map String Value) -- ^ The parameters the functions accepts, described as a JSON Schema object. See the [guide](/docs/guides/text-generation/function-calling) for examples, and the [JSON Schema reference](https://json-schema.org/understanding-json-schema/) for documentation about the format.   Omitting `parameters` defines a function with an empty parameter list.
  } deriving (Int -> FunctionObject -> ShowS
[FunctionObject] -> ShowS
FunctionObject -> String
(Int -> FunctionObject -> ShowS)
-> (FunctionObject -> String)
-> ([FunctionObject] -> ShowS)
-> Show FunctionObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionObject -> ShowS
showsPrec :: Int -> FunctionObject -> ShowS
$cshow :: FunctionObject -> String
show :: FunctionObject -> String
$cshowList :: [FunctionObject] -> ShowS
showList :: [FunctionObject] -> ShowS
Show, FunctionObject -> FunctionObject -> Bool
(FunctionObject -> FunctionObject -> Bool)
-> (FunctionObject -> FunctionObject -> Bool) -> Eq FunctionObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionObject -> FunctionObject -> Bool
== :: FunctionObject -> FunctionObject -> Bool
$c/= :: FunctionObject -> FunctionObject -> Bool
/= :: FunctionObject -> FunctionObject -> Bool
Eq, Eq FunctionObject
Eq FunctionObject =>
(FunctionObject -> FunctionObject -> Ordering)
-> (FunctionObject -> FunctionObject -> Bool)
-> (FunctionObject -> FunctionObject -> Bool)
-> (FunctionObject -> FunctionObject -> Bool)
-> (FunctionObject -> FunctionObject -> Bool)
-> (FunctionObject -> FunctionObject -> FunctionObject)
-> (FunctionObject -> FunctionObject -> FunctionObject)
-> Ord FunctionObject
FunctionObject -> FunctionObject -> Bool
FunctionObject -> FunctionObject -> Ordering
FunctionObject -> FunctionObject -> FunctionObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FunctionObject -> FunctionObject -> Ordering
compare :: FunctionObject -> FunctionObject -> Ordering
$c< :: FunctionObject -> FunctionObject -> Bool
< :: FunctionObject -> FunctionObject -> Bool
$c<= :: FunctionObject -> FunctionObject -> Bool
<= :: FunctionObject -> FunctionObject -> Bool
$c> :: FunctionObject -> FunctionObject -> Bool
> :: FunctionObject -> FunctionObject -> Bool
$c>= :: FunctionObject -> FunctionObject -> Bool
>= :: FunctionObject -> FunctionObject -> Bool
$cmax :: FunctionObject -> FunctionObject -> FunctionObject
max :: FunctionObject -> FunctionObject -> FunctionObject
$cmin :: FunctionObject -> FunctionObject -> FunctionObject
min :: FunctionObject -> FunctionObject -> FunctionObject
Ord, (forall x. FunctionObject -> Rep FunctionObject x)
-> (forall x. Rep FunctionObject x -> FunctionObject)
-> Generic FunctionObject
forall x. Rep FunctionObject x -> FunctionObject
forall x. FunctionObject -> Rep FunctionObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionObject -> Rep FunctionObject x
from :: forall x. FunctionObject -> Rep FunctionObject x
$cto :: forall x. Rep FunctionObject x -> FunctionObject
to :: forall x. Rep FunctionObject x -> FunctionObject
Generic, Typeable FunctionObject
Typeable FunctionObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FunctionObject -> c FunctionObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FunctionObject)
-> (FunctionObject -> Constr)
-> (FunctionObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FunctionObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FunctionObject))
-> ((forall b. Data b => b -> b)
    -> FunctionObject -> FunctionObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionObject -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionObject -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FunctionObject -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FunctionObject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FunctionObject -> m FunctionObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FunctionObject -> m FunctionObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FunctionObject -> m FunctionObject)
-> Data FunctionObject
FunctionObject -> Constr
FunctionObject -> DataType
(forall b. Data b => b -> b) -> FunctionObject -> FunctionObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FunctionObject -> u
forall u. (forall d. Data d => d -> u) -> FunctionObject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionObject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionObject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionObject -> m FunctionObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionObject -> m FunctionObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionObject -> c FunctionObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionObject -> c FunctionObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionObject -> c FunctionObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionObject
$ctoConstr :: FunctionObject -> Constr
toConstr :: FunctionObject -> Constr
$cdataTypeOf :: FunctionObject -> DataType
dataTypeOf :: FunctionObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionObject)
$cgmapT :: (forall b. Data b => b -> b) -> FunctionObject -> FunctionObject
gmapT :: (forall b. Data b => b -> b) -> FunctionObject -> FunctionObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionObject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionObject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionObject -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionObject -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionObject -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionObject -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FunctionObject -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FunctionObject -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionObject -> m FunctionObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionObject -> m FunctionObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionObject -> m FunctionObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionObject -> m FunctionObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionObject -> m FunctionObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionObject -> m FunctionObject
Data)

instance FromJSON FunctionObject where
  parseJSON :: Value -> Parser FunctionObject
parseJSON = Options -> Value -> Parser FunctionObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"functionObject")
instance ToJSON FunctionObject where
  toJSON :: FunctionObject -> Value
toJSON = Options -> FunctionObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"functionObject")


-- | Represents the url or the content of an image generated by the OpenAI API.
data Image = Image
  { Image -> Maybe Text
imageB64Underscorejson :: Maybe Text -- ^ The base64-encoded JSON of the generated image, if `response_format` is `b64_json`.
  , Image -> Maybe Text
imageUrl :: Maybe Text -- ^ The URL of the generated image, if `response_format` is `url` (default).
  , Image -> Maybe Text
imageRevisedUnderscoreprompt :: Maybe Text -- ^ The prompt that was used to generate the image, if there was any revision to the prompt.
  } deriving (Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Image -> ShowS
showsPrec :: Int -> Image -> ShowS
$cshow :: Image -> String
show :: Image -> String
$cshowList :: [Image] -> ShowS
showList :: [Image] -> ShowS
Show, Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
/= :: Image -> Image -> Bool
Eq, Eq Image
Eq Image =>
(Image -> Image -> Ordering)
-> (Image -> Image -> Bool)
-> (Image -> Image -> Bool)
-> (Image -> Image -> Bool)
-> (Image -> Image -> Bool)
-> (Image -> Image -> Image)
-> (Image -> Image -> Image)
-> Ord Image
Image -> Image -> Bool
Image -> Image -> Ordering
Image -> Image -> Image
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Image -> Image -> Ordering
compare :: Image -> Image -> Ordering
$c< :: Image -> Image -> Bool
< :: Image -> Image -> Bool
$c<= :: Image -> Image -> Bool
<= :: Image -> Image -> Bool
$c> :: Image -> Image -> Bool
> :: Image -> Image -> Bool
$c>= :: Image -> Image -> Bool
>= :: Image -> Image -> Bool
$cmax :: Image -> Image -> Image
max :: Image -> Image -> Image
$cmin :: Image -> Image -> Image
min :: Image -> Image -> Image
Ord, (forall x. Image -> Rep Image x)
-> (forall x. Rep Image x -> Image) -> Generic Image
forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Image -> Rep Image x
from :: forall x. Image -> Rep Image x
$cto :: forall x. Rep Image x -> Image
to :: forall x. Rep Image x -> Image
Generic, Typeable Image
Typeable Image =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Image -> c Image)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Image)
-> (Image -> Constr)
-> (Image -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Image))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Image))
-> ((forall b. Data b => b -> b) -> Image -> Image)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r)
-> (forall u. (forall d. Data d => d -> u) -> Image -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Image -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Image -> m Image)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Image -> m Image)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Image -> m Image)
-> Data Image
Image -> Constr
Image -> DataType
(forall b. Data b => b -> b) -> Image -> Image
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Image -> u
forall u. (forall d. Data d => d -> u) -> Image -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Image -> m Image
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Image -> m Image
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Image
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Image -> c Image
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Image)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Image)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Image -> c Image
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Image -> c Image
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Image
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Image
$ctoConstr :: Image -> Constr
toConstr :: Image -> Constr
$cdataTypeOf :: Image -> DataType
dataTypeOf :: Image -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Image)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Image)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Image)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Image)
$cgmapT :: (forall b. Data b => b -> b) -> Image -> Image
gmapT :: (forall b. Data b => b -> b) -> Image -> Image
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Image -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Image -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Image -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Image -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Image -> m Image
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Image -> m Image
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Image -> m Image
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Image -> m Image
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Image -> m Image
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Image -> m Image
Data)

instance FromJSON Image where
  parseJSON :: Value -> Parser Image
parseJSON = Options -> Value -> Parser Image
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"image")
instance ToJSON Image where
  toJSON :: Image -> Value
toJSON = Options -> Image -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"image")


-- | 
data ImagesResponse = ImagesResponse
  { ImagesResponse -> Int
imagesResponseCreated :: Int -- ^ 
  , ImagesResponse -> [Image]
imagesResponseData :: [Image] -- ^ 
  } deriving (Int -> ImagesResponse -> ShowS
[ImagesResponse] -> ShowS
ImagesResponse -> String
(Int -> ImagesResponse -> ShowS)
-> (ImagesResponse -> String)
-> ([ImagesResponse] -> ShowS)
-> Show ImagesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImagesResponse -> ShowS
showsPrec :: Int -> ImagesResponse -> ShowS
$cshow :: ImagesResponse -> String
show :: ImagesResponse -> String
$cshowList :: [ImagesResponse] -> ShowS
showList :: [ImagesResponse] -> ShowS
Show, ImagesResponse -> ImagesResponse -> Bool
(ImagesResponse -> ImagesResponse -> Bool)
-> (ImagesResponse -> ImagesResponse -> Bool) -> Eq ImagesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImagesResponse -> ImagesResponse -> Bool
== :: ImagesResponse -> ImagesResponse -> Bool
$c/= :: ImagesResponse -> ImagesResponse -> Bool
/= :: ImagesResponse -> ImagesResponse -> Bool
Eq, Eq ImagesResponse
Eq ImagesResponse =>
(ImagesResponse -> ImagesResponse -> Ordering)
-> (ImagesResponse -> ImagesResponse -> Bool)
-> (ImagesResponse -> ImagesResponse -> Bool)
-> (ImagesResponse -> ImagesResponse -> Bool)
-> (ImagesResponse -> ImagesResponse -> Bool)
-> (ImagesResponse -> ImagesResponse -> ImagesResponse)
-> (ImagesResponse -> ImagesResponse -> ImagesResponse)
-> Ord ImagesResponse
ImagesResponse -> ImagesResponse -> Bool
ImagesResponse -> ImagesResponse -> Ordering
ImagesResponse -> ImagesResponse -> ImagesResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ImagesResponse -> ImagesResponse -> Ordering
compare :: ImagesResponse -> ImagesResponse -> Ordering
$c< :: ImagesResponse -> ImagesResponse -> Bool
< :: ImagesResponse -> ImagesResponse -> Bool
$c<= :: ImagesResponse -> ImagesResponse -> Bool
<= :: ImagesResponse -> ImagesResponse -> Bool
$c> :: ImagesResponse -> ImagesResponse -> Bool
> :: ImagesResponse -> ImagesResponse -> Bool
$c>= :: ImagesResponse -> ImagesResponse -> Bool
>= :: ImagesResponse -> ImagesResponse -> Bool
$cmax :: ImagesResponse -> ImagesResponse -> ImagesResponse
max :: ImagesResponse -> ImagesResponse -> ImagesResponse
$cmin :: ImagesResponse -> ImagesResponse -> ImagesResponse
min :: ImagesResponse -> ImagesResponse -> ImagesResponse
Ord, (forall x. ImagesResponse -> Rep ImagesResponse x)
-> (forall x. Rep ImagesResponse x -> ImagesResponse)
-> Generic ImagesResponse
forall x. Rep ImagesResponse x -> ImagesResponse
forall x. ImagesResponse -> Rep ImagesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImagesResponse -> Rep ImagesResponse x
from :: forall x. ImagesResponse -> Rep ImagesResponse x
$cto :: forall x. Rep ImagesResponse x -> ImagesResponse
to :: forall x. Rep ImagesResponse x -> ImagesResponse
Generic, Typeable ImagesResponse
Typeable ImagesResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ImagesResponse -> c ImagesResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ImagesResponse)
-> (ImagesResponse -> Constr)
-> (ImagesResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ImagesResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ImagesResponse))
-> ((forall b. Data b => b -> b)
    -> ImagesResponse -> ImagesResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ImagesResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ImagesResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ImagesResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ImagesResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ImagesResponse -> m ImagesResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ImagesResponse -> m ImagesResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ImagesResponse -> m ImagesResponse)
-> Data ImagesResponse
ImagesResponse -> Constr
ImagesResponse -> DataType
(forall b. Data b => b -> b) -> ImagesResponse -> ImagesResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ImagesResponse -> u
forall u. (forall d. Data d => d -> u) -> ImagesResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImagesResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImagesResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ImagesResponse -> m ImagesResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImagesResponse -> m ImagesResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImagesResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImagesResponse -> c ImagesResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImagesResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImagesResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImagesResponse -> c ImagesResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImagesResponse -> c ImagesResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImagesResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImagesResponse
$ctoConstr :: ImagesResponse -> Constr
toConstr :: ImagesResponse -> Constr
$cdataTypeOf :: ImagesResponse -> DataType
dataTypeOf :: ImagesResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImagesResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImagesResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImagesResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImagesResponse)
$cgmapT :: (forall b. Data b => b -> b) -> ImagesResponse -> ImagesResponse
gmapT :: (forall b. Data b => b -> b) -> ImagesResponse -> ImagesResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImagesResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImagesResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImagesResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImagesResponse -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImagesResponse -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ImagesResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ImagesResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ImagesResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ImagesResponse -> m ImagesResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ImagesResponse -> m ImagesResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImagesResponse -> m ImagesResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImagesResponse -> m ImagesResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImagesResponse -> m ImagesResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImagesResponse -> m ImagesResponse
Data)

instance FromJSON ImagesResponse where
  parseJSON :: Value -> Parser ImagesResponse
parseJSON = Options -> Value -> Parser ImagesResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"imagesResponse")
instance ToJSON ImagesResponse where
  toJSON :: ImagesResponse -> Value
toJSON = Options -> ImagesResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"imagesResponse")


-- | 
data ListAssistantFilesResponse = ListAssistantFilesResponse
  { ListAssistantFilesResponse -> Text
listAssistantFilesResponseObject :: Text -- ^ 
  , ListAssistantFilesResponse -> [AssistantFileObject]
listAssistantFilesResponseData :: [AssistantFileObject] -- ^ 
  , ListAssistantFilesResponse -> Text
listAssistantFilesResponseFirstUnderscoreid :: Text -- ^ 
  , ListAssistantFilesResponse -> Text
listAssistantFilesResponseLastUnderscoreid :: Text -- ^ 
  , ListAssistantFilesResponse -> Bool
listAssistantFilesResponseHasUnderscoremore :: Bool -- ^ 
  } deriving (Int -> ListAssistantFilesResponse -> ShowS
[ListAssistantFilesResponse] -> ShowS
ListAssistantFilesResponse -> String
(Int -> ListAssistantFilesResponse -> ShowS)
-> (ListAssistantFilesResponse -> String)
-> ([ListAssistantFilesResponse] -> ShowS)
-> Show ListAssistantFilesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListAssistantFilesResponse -> ShowS
showsPrec :: Int -> ListAssistantFilesResponse -> ShowS
$cshow :: ListAssistantFilesResponse -> String
show :: ListAssistantFilesResponse -> String
$cshowList :: [ListAssistantFilesResponse] -> ShowS
showList :: [ListAssistantFilesResponse] -> ShowS
Show, ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
(ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool)
-> (ListAssistantFilesResponse
    -> ListAssistantFilesResponse -> Bool)
-> Eq ListAssistantFilesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
== :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
$c/= :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
/= :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
Eq, Eq ListAssistantFilesResponse
Eq ListAssistantFilesResponse =>
(ListAssistantFilesResponse
 -> ListAssistantFilesResponse -> Ordering)
-> (ListAssistantFilesResponse
    -> ListAssistantFilesResponse -> Bool)
-> (ListAssistantFilesResponse
    -> ListAssistantFilesResponse -> Bool)
-> (ListAssistantFilesResponse
    -> ListAssistantFilesResponse -> Bool)
-> (ListAssistantFilesResponse
    -> ListAssistantFilesResponse -> Bool)
-> (ListAssistantFilesResponse
    -> ListAssistantFilesResponse -> ListAssistantFilesResponse)
-> (ListAssistantFilesResponse
    -> ListAssistantFilesResponse -> ListAssistantFilesResponse)
-> Ord ListAssistantFilesResponse
ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
ListAssistantFilesResponse
-> ListAssistantFilesResponse -> Ordering
ListAssistantFilesResponse
-> ListAssistantFilesResponse -> ListAssistantFilesResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListAssistantFilesResponse
-> ListAssistantFilesResponse -> Ordering
compare :: ListAssistantFilesResponse
-> ListAssistantFilesResponse -> Ordering
$c< :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
< :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
$c<= :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
<= :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
$c> :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
> :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
$c>= :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
>= :: ListAssistantFilesResponse -> ListAssistantFilesResponse -> Bool
$cmax :: ListAssistantFilesResponse
-> ListAssistantFilesResponse -> ListAssistantFilesResponse
max :: ListAssistantFilesResponse
-> ListAssistantFilesResponse -> ListAssistantFilesResponse
$cmin :: ListAssistantFilesResponse
-> ListAssistantFilesResponse -> ListAssistantFilesResponse
min :: ListAssistantFilesResponse
-> ListAssistantFilesResponse -> ListAssistantFilesResponse
Ord, (forall x.
 ListAssistantFilesResponse -> Rep ListAssistantFilesResponse x)
-> (forall x.
    Rep ListAssistantFilesResponse x -> ListAssistantFilesResponse)
-> Generic ListAssistantFilesResponse
forall x.
Rep ListAssistantFilesResponse x -> ListAssistantFilesResponse
forall x.
ListAssistantFilesResponse -> Rep ListAssistantFilesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ListAssistantFilesResponse -> Rep ListAssistantFilesResponse x
from :: forall x.
ListAssistantFilesResponse -> Rep ListAssistantFilesResponse x
$cto :: forall x.
Rep ListAssistantFilesResponse x -> ListAssistantFilesResponse
to :: forall x.
Rep ListAssistantFilesResponse x -> ListAssistantFilesResponse
Generic, Typeable ListAssistantFilesResponse
Typeable ListAssistantFilesResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ListAssistantFilesResponse
 -> c ListAssistantFilesResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ListAssistantFilesResponse)
-> (ListAssistantFilesResponse -> Constr)
-> (ListAssistantFilesResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ListAssistantFilesResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListAssistantFilesResponse))
-> ((forall b. Data b => b -> b)
    -> ListAssistantFilesResponse -> ListAssistantFilesResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ListAssistantFilesResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ListAssistantFilesResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ListAssistantFilesResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> ListAssistantFilesResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListAssistantFilesResponse -> m ListAssistantFilesResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListAssistantFilesResponse -> m ListAssistantFilesResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListAssistantFilesResponse -> m ListAssistantFilesResponse)
-> Data ListAssistantFilesResponse
ListAssistantFilesResponse -> Constr
ListAssistantFilesResponse -> DataType
(forall b. Data b => b -> b)
-> ListAssistantFilesResponse -> ListAssistantFilesResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> ListAssistantFilesResponse -> u
forall u.
(forall d. Data d => d -> u) -> ListAssistantFilesResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantFilesResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantFilesResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListAssistantFilesResponse -> m ListAssistantFilesResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAssistantFilesResponse -> m ListAssistantFilesResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListAssistantFilesResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListAssistantFilesResponse
-> c ListAssistantFilesResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ListAssistantFilesResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListAssistantFilesResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListAssistantFilesResponse
-> c ListAssistantFilesResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListAssistantFilesResponse
-> c ListAssistantFilesResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListAssistantFilesResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListAssistantFilesResponse
$ctoConstr :: ListAssistantFilesResponse -> Constr
toConstr :: ListAssistantFilesResponse -> Constr
$cdataTypeOf :: ListAssistantFilesResponse -> DataType
dataTypeOf :: ListAssistantFilesResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ListAssistantFilesResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ListAssistantFilesResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListAssistantFilesResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListAssistantFilesResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListAssistantFilesResponse -> ListAssistantFilesResponse
gmapT :: (forall b. Data b => b -> b)
-> ListAssistantFilesResponse -> ListAssistantFilesResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantFilesResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantFilesResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantFilesResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantFilesResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ListAssistantFilesResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ListAssistantFilesResponse -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ListAssistantFilesResponse -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ListAssistantFilesResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListAssistantFilesResponse -> m ListAssistantFilesResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListAssistantFilesResponse -> m ListAssistantFilesResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAssistantFilesResponse -> m ListAssistantFilesResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAssistantFilesResponse -> m ListAssistantFilesResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAssistantFilesResponse -> m ListAssistantFilesResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAssistantFilesResponse -> m ListAssistantFilesResponse
Data)

instance FromJSON ListAssistantFilesResponse where
  parseJSON :: Value -> Parser ListAssistantFilesResponse
parseJSON = Options -> Value -> Parser ListAssistantFilesResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listAssistantFilesResponse")
instance ToJSON ListAssistantFilesResponse where
  toJSON :: ListAssistantFilesResponse -> Value
toJSON = Options -> ListAssistantFilesResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listAssistantFilesResponse")


-- | 
data ListAssistantsResponse = ListAssistantsResponse
  { ListAssistantsResponse -> Text
listAssistantsResponseObject :: Text -- ^ 
  , ListAssistantsResponse -> [AssistantObject]
listAssistantsResponseData :: [AssistantObject] -- ^ 
  , ListAssistantsResponse -> Text
listAssistantsResponseFirstUnderscoreid :: Text -- ^ 
  , ListAssistantsResponse -> Text
listAssistantsResponseLastUnderscoreid :: Text -- ^ 
  , ListAssistantsResponse -> Bool
listAssistantsResponseHasUnderscoremore :: Bool -- ^ 
  } deriving (Int -> ListAssistantsResponse -> ShowS
[ListAssistantsResponse] -> ShowS
ListAssistantsResponse -> String
(Int -> ListAssistantsResponse -> ShowS)
-> (ListAssistantsResponse -> String)
-> ([ListAssistantsResponse] -> ShowS)
-> Show ListAssistantsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListAssistantsResponse -> ShowS
showsPrec :: Int -> ListAssistantsResponse -> ShowS
$cshow :: ListAssistantsResponse -> String
show :: ListAssistantsResponse -> String
$cshowList :: [ListAssistantsResponse] -> ShowS
showList :: [ListAssistantsResponse] -> ShowS
Show, ListAssistantsResponse -> ListAssistantsResponse -> Bool
(ListAssistantsResponse -> ListAssistantsResponse -> Bool)
-> (ListAssistantsResponse -> ListAssistantsResponse -> Bool)
-> Eq ListAssistantsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
== :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
$c/= :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
/= :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
Eq, Eq ListAssistantsResponse
Eq ListAssistantsResponse =>
(ListAssistantsResponse -> ListAssistantsResponse -> Ordering)
-> (ListAssistantsResponse -> ListAssistantsResponse -> Bool)
-> (ListAssistantsResponse -> ListAssistantsResponse -> Bool)
-> (ListAssistantsResponse -> ListAssistantsResponse -> Bool)
-> (ListAssistantsResponse -> ListAssistantsResponse -> Bool)
-> (ListAssistantsResponse
    -> ListAssistantsResponse -> ListAssistantsResponse)
-> (ListAssistantsResponse
    -> ListAssistantsResponse -> ListAssistantsResponse)
-> Ord ListAssistantsResponse
ListAssistantsResponse -> ListAssistantsResponse -> Bool
ListAssistantsResponse -> ListAssistantsResponse -> Ordering
ListAssistantsResponse
-> ListAssistantsResponse -> ListAssistantsResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListAssistantsResponse -> ListAssistantsResponse -> Ordering
compare :: ListAssistantsResponse -> ListAssistantsResponse -> Ordering
$c< :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
< :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
$c<= :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
<= :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
$c> :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
> :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
$c>= :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
>= :: ListAssistantsResponse -> ListAssistantsResponse -> Bool
$cmax :: ListAssistantsResponse
-> ListAssistantsResponse -> ListAssistantsResponse
max :: ListAssistantsResponse
-> ListAssistantsResponse -> ListAssistantsResponse
$cmin :: ListAssistantsResponse
-> ListAssistantsResponse -> ListAssistantsResponse
min :: ListAssistantsResponse
-> ListAssistantsResponse -> ListAssistantsResponse
Ord, (forall x. ListAssistantsResponse -> Rep ListAssistantsResponse x)
-> (forall x.
    Rep ListAssistantsResponse x -> ListAssistantsResponse)
-> Generic ListAssistantsResponse
forall x. Rep ListAssistantsResponse x -> ListAssistantsResponse
forall x. ListAssistantsResponse -> Rep ListAssistantsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListAssistantsResponse -> Rep ListAssistantsResponse x
from :: forall x. ListAssistantsResponse -> Rep ListAssistantsResponse x
$cto :: forall x. Rep ListAssistantsResponse x -> ListAssistantsResponse
to :: forall x. Rep ListAssistantsResponse x -> ListAssistantsResponse
Generic, Typeable ListAssistantsResponse
Typeable ListAssistantsResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ListAssistantsResponse
 -> c ListAssistantsResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ListAssistantsResponse)
-> (ListAssistantsResponse -> Constr)
-> (ListAssistantsResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ListAssistantsResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListAssistantsResponse))
-> ((forall b. Data b => b -> b)
    -> ListAssistantsResponse -> ListAssistantsResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ListAssistantsResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ListAssistantsResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ListAssistantsResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ListAssistantsResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListAssistantsResponse -> m ListAssistantsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListAssistantsResponse -> m ListAssistantsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListAssistantsResponse -> m ListAssistantsResponse)
-> Data ListAssistantsResponse
ListAssistantsResponse -> Constr
ListAssistantsResponse -> DataType
(forall b. Data b => b -> b)
-> ListAssistantsResponse -> ListAssistantsResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ListAssistantsResponse -> u
forall u.
(forall d. Data d => d -> u) -> ListAssistantsResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantsResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantsResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListAssistantsResponse -> m ListAssistantsResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAssistantsResponse -> m ListAssistantsResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListAssistantsResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListAssistantsResponse
-> c ListAssistantsResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListAssistantsResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListAssistantsResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListAssistantsResponse
-> c ListAssistantsResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListAssistantsResponse
-> c ListAssistantsResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListAssistantsResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListAssistantsResponse
$ctoConstr :: ListAssistantsResponse -> Constr
toConstr :: ListAssistantsResponse -> Constr
$cdataTypeOf :: ListAssistantsResponse -> DataType
dataTypeOf :: ListAssistantsResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListAssistantsResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListAssistantsResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListAssistantsResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListAssistantsResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListAssistantsResponse -> ListAssistantsResponse
gmapT :: (forall b. Data b => b -> b)
-> ListAssistantsResponse -> ListAssistantsResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantsResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantsResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantsResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListAssistantsResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ListAssistantsResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ListAssistantsResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListAssistantsResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListAssistantsResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListAssistantsResponse -> m ListAssistantsResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListAssistantsResponse -> m ListAssistantsResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAssistantsResponse -> m ListAssistantsResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAssistantsResponse -> m ListAssistantsResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAssistantsResponse -> m ListAssistantsResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAssistantsResponse -> m ListAssistantsResponse
Data)

instance FromJSON ListAssistantsResponse where
  parseJSON :: Value -> Parser ListAssistantsResponse
parseJSON = Options -> Value -> Parser ListAssistantsResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listAssistantsResponse")
instance ToJSON ListAssistantsResponse where
  toJSON :: ListAssistantsResponse -> Value
toJSON = Options -> ListAssistantsResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listAssistantsResponse")


-- | 
data ListFilesResponse = ListFilesResponse
  { ListFilesResponse -> [OpenAIFile]
listFilesResponseData :: [OpenAIFile] -- ^ 
  , ListFilesResponse -> Text
listFilesResponseObject :: Text -- ^ 
  } deriving (Int -> ListFilesResponse -> ShowS
[ListFilesResponse] -> ShowS
ListFilesResponse -> String
(Int -> ListFilesResponse -> ShowS)
-> (ListFilesResponse -> String)
-> ([ListFilesResponse] -> ShowS)
-> Show ListFilesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListFilesResponse -> ShowS
showsPrec :: Int -> ListFilesResponse -> ShowS
$cshow :: ListFilesResponse -> String
show :: ListFilesResponse -> String
$cshowList :: [ListFilesResponse] -> ShowS
showList :: [ListFilesResponse] -> ShowS
Show, ListFilesResponse -> ListFilesResponse -> Bool
(ListFilesResponse -> ListFilesResponse -> Bool)
-> (ListFilesResponse -> ListFilesResponse -> Bool)
-> Eq ListFilesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListFilesResponse -> ListFilesResponse -> Bool
== :: ListFilesResponse -> ListFilesResponse -> Bool
$c/= :: ListFilesResponse -> ListFilesResponse -> Bool
/= :: ListFilesResponse -> ListFilesResponse -> Bool
Eq, Eq ListFilesResponse
Eq ListFilesResponse =>
(ListFilesResponse -> ListFilesResponse -> Ordering)
-> (ListFilesResponse -> ListFilesResponse -> Bool)
-> (ListFilesResponse -> ListFilesResponse -> Bool)
-> (ListFilesResponse -> ListFilesResponse -> Bool)
-> (ListFilesResponse -> ListFilesResponse -> Bool)
-> (ListFilesResponse -> ListFilesResponse -> ListFilesResponse)
-> (ListFilesResponse -> ListFilesResponse -> ListFilesResponse)
-> Ord ListFilesResponse
ListFilesResponse -> ListFilesResponse -> Bool
ListFilesResponse -> ListFilesResponse -> Ordering
ListFilesResponse -> ListFilesResponse -> ListFilesResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListFilesResponse -> ListFilesResponse -> Ordering
compare :: ListFilesResponse -> ListFilesResponse -> Ordering
$c< :: ListFilesResponse -> ListFilesResponse -> Bool
< :: ListFilesResponse -> ListFilesResponse -> Bool
$c<= :: ListFilesResponse -> ListFilesResponse -> Bool
<= :: ListFilesResponse -> ListFilesResponse -> Bool
$c> :: ListFilesResponse -> ListFilesResponse -> Bool
> :: ListFilesResponse -> ListFilesResponse -> Bool
$c>= :: ListFilesResponse -> ListFilesResponse -> Bool
>= :: ListFilesResponse -> ListFilesResponse -> Bool
$cmax :: ListFilesResponse -> ListFilesResponse -> ListFilesResponse
max :: ListFilesResponse -> ListFilesResponse -> ListFilesResponse
$cmin :: ListFilesResponse -> ListFilesResponse -> ListFilesResponse
min :: ListFilesResponse -> ListFilesResponse -> ListFilesResponse
Ord, (forall x. ListFilesResponse -> Rep ListFilesResponse x)
-> (forall x. Rep ListFilesResponse x -> ListFilesResponse)
-> Generic ListFilesResponse
forall x. Rep ListFilesResponse x -> ListFilesResponse
forall x. ListFilesResponse -> Rep ListFilesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListFilesResponse -> Rep ListFilesResponse x
from :: forall x. ListFilesResponse -> Rep ListFilesResponse x
$cto :: forall x. Rep ListFilesResponse x -> ListFilesResponse
to :: forall x. Rep ListFilesResponse x -> ListFilesResponse
Generic, Typeable ListFilesResponse
Typeable ListFilesResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ListFilesResponse
 -> c ListFilesResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ListFilesResponse)
-> (ListFilesResponse -> Constr)
-> (ListFilesResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ListFilesResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListFilesResponse))
-> ((forall b. Data b => b -> b)
    -> ListFilesResponse -> ListFilesResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ListFilesResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ListFilesResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ListFilesResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ListFilesResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListFilesResponse -> m ListFilesResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListFilesResponse -> m ListFilesResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListFilesResponse -> m ListFilesResponse)
-> Data ListFilesResponse
ListFilesResponse -> Constr
ListFilesResponse -> DataType
(forall b. Data b => b -> b)
-> ListFilesResponse -> ListFilesResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ListFilesResponse -> u
forall u. (forall d. Data d => d -> u) -> ListFilesResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListFilesResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListFilesResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListFilesResponse -> m ListFilesResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListFilesResponse -> m ListFilesResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListFilesResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListFilesResponse -> c ListFilesResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListFilesResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListFilesResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListFilesResponse -> c ListFilesResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListFilesResponse -> c ListFilesResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListFilesResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListFilesResponse
$ctoConstr :: ListFilesResponse -> Constr
toConstr :: ListFilesResponse -> Constr
$cdataTypeOf :: ListFilesResponse -> DataType
dataTypeOf :: ListFilesResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListFilesResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListFilesResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListFilesResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListFilesResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListFilesResponse -> ListFilesResponse
gmapT :: (forall b. Data b => b -> b)
-> ListFilesResponse -> ListFilesResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListFilesResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListFilesResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListFilesResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListFilesResponse -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListFilesResponse -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ListFilesResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListFilesResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListFilesResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListFilesResponse -> m ListFilesResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListFilesResponse -> m ListFilesResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListFilesResponse -> m ListFilesResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListFilesResponse -> m ListFilesResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListFilesResponse -> m ListFilesResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListFilesResponse -> m ListFilesResponse
Data)

instance FromJSON ListFilesResponse where
  parseJSON :: Value -> Parser ListFilesResponse
parseJSON = Options -> Value -> Parser ListFilesResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listFilesResponse")
instance ToJSON ListFilesResponse where
  toJSON :: ListFilesResponse -> Value
toJSON = Options -> ListFilesResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listFilesResponse")


-- | 
data ListFineTuningJobEventsResponse = ListFineTuningJobEventsResponse
  { ListFineTuningJobEventsResponse -> [FineTuningJobEvent]
listFineTuningJobEventsResponseData :: [FineTuningJobEvent] -- ^ 
  , ListFineTuningJobEventsResponse -> Text
listFineTuningJobEventsResponseObject :: Text -- ^ 
  } deriving (Int -> ListFineTuningJobEventsResponse -> ShowS
[ListFineTuningJobEventsResponse] -> ShowS
ListFineTuningJobEventsResponse -> String
(Int -> ListFineTuningJobEventsResponse -> ShowS)
-> (ListFineTuningJobEventsResponse -> String)
-> ([ListFineTuningJobEventsResponse] -> ShowS)
-> Show ListFineTuningJobEventsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListFineTuningJobEventsResponse -> ShowS
showsPrec :: Int -> ListFineTuningJobEventsResponse -> ShowS
$cshow :: ListFineTuningJobEventsResponse -> String
show :: ListFineTuningJobEventsResponse -> String
$cshowList :: [ListFineTuningJobEventsResponse] -> ShowS
showList :: [ListFineTuningJobEventsResponse] -> ShowS
Show, ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
(ListFineTuningJobEventsResponse
 -> ListFineTuningJobEventsResponse -> Bool)
-> (ListFineTuningJobEventsResponse
    -> ListFineTuningJobEventsResponse -> Bool)
-> Eq ListFineTuningJobEventsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
== :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
$c/= :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
/= :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
Eq, Eq ListFineTuningJobEventsResponse
Eq ListFineTuningJobEventsResponse =>
(ListFineTuningJobEventsResponse
 -> ListFineTuningJobEventsResponse -> Ordering)
-> (ListFineTuningJobEventsResponse
    -> ListFineTuningJobEventsResponse -> Bool)
-> (ListFineTuningJobEventsResponse
    -> ListFineTuningJobEventsResponse -> Bool)
-> (ListFineTuningJobEventsResponse
    -> ListFineTuningJobEventsResponse -> Bool)
-> (ListFineTuningJobEventsResponse
    -> ListFineTuningJobEventsResponse -> Bool)
-> (ListFineTuningJobEventsResponse
    -> ListFineTuningJobEventsResponse
    -> ListFineTuningJobEventsResponse)
-> (ListFineTuningJobEventsResponse
    -> ListFineTuningJobEventsResponse
    -> ListFineTuningJobEventsResponse)
-> Ord ListFineTuningJobEventsResponse
ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Ordering
ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Ordering
compare :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Ordering
$c< :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
< :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
$c<= :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
<= :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
$c> :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
> :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
$c>= :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
>= :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse -> Bool
$cmax :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
max :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
$cmin :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
min :: ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
Ord, (forall x.
 ListFineTuningJobEventsResponse
 -> Rep ListFineTuningJobEventsResponse x)
-> (forall x.
    Rep ListFineTuningJobEventsResponse x
    -> ListFineTuningJobEventsResponse)
-> Generic ListFineTuningJobEventsResponse
forall x.
Rep ListFineTuningJobEventsResponse x
-> ListFineTuningJobEventsResponse
forall x.
ListFineTuningJobEventsResponse
-> Rep ListFineTuningJobEventsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ListFineTuningJobEventsResponse
-> Rep ListFineTuningJobEventsResponse x
from :: forall x.
ListFineTuningJobEventsResponse
-> Rep ListFineTuningJobEventsResponse x
$cto :: forall x.
Rep ListFineTuningJobEventsResponse x
-> ListFineTuningJobEventsResponse
to :: forall x.
Rep ListFineTuningJobEventsResponse x
-> ListFineTuningJobEventsResponse
Generic, Typeable ListFineTuningJobEventsResponse
Typeable ListFineTuningJobEventsResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ListFineTuningJobEventsResponse
 -> c ListFineTuningJobEventsResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ListFineTuningJobEventsResponse)
-> (ListFineTuningJobEventsResponse -> Constr)
-> (ListFineTuningJobEventsResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ListFineTuningJobEventsResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListFineTuningJobEventsResponse))
-> ((forall b. Data b => b -> b)
    -> ListFineTuningJobEventsResponse
    -> ListFineTuningJobEventsResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ListFineTuningJobEventsResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ListFineTuningJobEventsResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ListFineTuningJobEventsResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ListFineTuningJobEventsResponse
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListFineTuningJobEventsResponse
    -> m ListFineTuningJobEventsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListFineTuningJobEventsResponse
    -> m ListFineTuningJobEventsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListFineTuningJobEventsResponse
    -> m ListFineTuningJobEventsResponse)
-> Data ListFineTuningJobEventsResponse
ListFineTuningJobEventsResponse -> Constr
ListFineTuningJobEventsResponse -> DataType
(forall b. Data b => b -> b)
-> ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ListFineTuningJobEventsResponse
-> u
forall u.
(forall d. Data d => d -> u)
-> ListFineTuningJobEventsResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListFineTuningJobEventsResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListFineTuningJobEventsResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListFineTuningJobEventsResponse
-> m ListFineTuningJobEventsResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListFineTuningJobEventsResponse
-> m ListFineTuningJobEventsResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ListFineTuningJobEventsResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListFineTuningJobEventsResponse
-> c ListFineTuningJobEventsResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ListFineTuningJobEventsResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListFineTuningJobEventsResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListFineTuningJobEventsResponse
-> c ListFineTuningJobEventsResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListFineTuningJobEventsResponse
-> c ListFineTuningJobEventsResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ListFineTuningJobEventsResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ListFineTuningJobEventsResponse
$ctoConstr :: ListFineTuningJobEventsResponse -> Constr
toConstr :: ListFineTuningJobEventsResponse -> Constr
$cdataTypeOf :: ListFineTuningJobEventsResponse -> DataType
dataTypeOf :: ListFineTuningJobEventsResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ListFineTuningJobEventsResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ListFineTuningJobEventsResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListFineTuningJobEventsResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListFineTuningJobEventsResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
gmapT :: (forall b. Data b => b -> b)
-> ListFineTuningJobEventsResponse
-> ListFineTuningJobEventsResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListFineTuningJobEventsResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListFineTuningJobEventsResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListFineTuningJobEventsResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListFineTuningJobEventsResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ListFineTuningJobEventsResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ListFineTuningJobEventsResponse -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ListFineTuningJobEventsResponse
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ListFineTuningJobEventsResponse
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListFineTuningJobEventsResponse
-> m ListFineTuningJobEventsResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListFineTuningJobEventsResponse
-> m ListFineTuningJobEventsResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListFineTuningJobEventsResponse
-> m ListFineTuningJobEventsResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListFineTuningJobEventsResponse
-> m ListFineTuningJobEventsResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListFineTuningJobEventsResponse
-> m ListFineTuningJobEventsResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListFineTuningJobEventsResponse
-> m ListFineTuningJobEventsResponse
Data)

instance FromJSON ListFineTuningJobEventsResponse where
  parseJSON :: Value -> Parser ListFineTuningJobEventsResponse
parseJSON = Options -> Value -> Parser ListFineTuningJobEventsResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listFineTuningJobEventsResponse")
instance ToJSON ListFineTuningJobEventsResponse where
  toJSON :: ListFineTuningJobEventsResponse -> Value
toJSON = Options -> ListFineTuningJobEventsResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listFineTuningJobEventsResponse")


-- | 
data ListMessageFilesResponse = ListMessageFilesResponse
  { ListMessageFilesResponse -> Text
listMessageFilesResponseObject :: Text -- ^ 
  , ListMessageFilesResponse -> [MessageFileObject]
listMessageFilesResponseData :: [MessageFileObject] -- ^ 
  , ListMessageFilesResponse -> Text
listMessageFilesResponseFirstUnderscoreid :: Text -- ^ 
  , ListMessageFilesResponse -> Text
listMessageFilesResponseLastUnderscoreid :: Text -- ^ 
  , ListMessageFilesResponse -> Bool
listMessageFilesResponseHasUnderscoremore :: Bool -- ^ 
  } deriving (Int -> ListMessageFilesResponse -> ShowS
[ListMessageFilesResponse] -> ShowS
ListMessageFilesResponse -> String
(Int -> ListMessageFilesResponse -> ShowS)
-> (ListMessageFilesResponse -> String)
-> ([ListMessageFilesResponse] -> ShowS)
-> Show ListMessageFilesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListMessageFilesResponse -> ShowS
showsPrec :: Int -> ListMessageFilesResponse -> ShowS
$cshow :: ListMessageFilesResponse -> String
show :: ListMessageFilesResponse -> String
$cshowList :: [ListMessageFilesResponse] -> ShowS
showList :: [ListMessageFilesResponse] -> ShowS
Show, ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
(ListMessageFilesResponse -> ListMessageFilesResponse -> Bool)
-> (ListMessageFilesResponse -> ListMessageFilesResponse -> Bool)
-> Eq ListMessageFilesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
== :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
$c/= :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
/= :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
Eq, Eq ListMessageFilesResponse
Eq ListMessageFilesResponse =>
(ListMessageFilesResponse -> ListMessageFilesResponse -> Ordering)
-> (ListMessageFilesResponse -> ListMessageFilesResponse -> Bool)
-> (ListMessageFilesResponse -> ListMessageFilesResponse -> Bool)
-> (ListMessageFilesResponse -> ListMessageFilesResponse -> Bool)
-> (ListMessageFilesResponse -> ListMessageFilesResponse -> Bool)
-> (ListMessageFilesResponse
    -> ListMessageFilesResponse -> ListMessageFilesResponse)
-> (ListMessageFilesResponse
    -> ListMessageFilesResponse -> ListMessageFilesResponse)
-> Ord ListMessageFilesResponse
ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
ListMessageFilesResponse -> ListMessageFilesResponse -> Ordering
ListMessageFilesResponse
-> ListMessageFilesResponse -> ListMessageFilesResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListMessageFilesResponse -> ListMessageFilesResponse -> Ordering
compare :: ListMessageFilesResponse -> ListMessageFilesResponse -> Ordering
$c< :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
< :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
$c<= :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
<= :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
$c> :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
> :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
$c>= :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
>= :: ListMessageFilesResponse -> ListMessageFilesResponse -> Bool
$cmax :: ListMessageFilesResponse
-> ListMessageFilesResponse -> ListMessageFilesResponse
max :: ListMessageFilesResponse
-> ListMessageFilesResponse -> ListMessageFilesResponse
$cmin :: ListMessageFilesResponse
-> ListMessageFilesResponse -> ListMessageFilesResponse
min :: ListMessageFilesResponse
-> ListMessageFilesResponse -> ListMessageFilesResponse
Ord, (forall x.
 ListMessageFilesResponse -> Rep ListMessageFilesResponse x)
-> (forall x.
    Rep ListMessageFilesResponse x -> ListMessageFilesResponse)
-> Generic ListMessageFilesResponse
forall x.
Rep ListMessageFilesResponse x -> ListMessageFilesResponse
forall x.
ListMessageFilesResponse -> Rep ListMessageFilesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ListMessageFilesResponse -> Rep ListMessageFilesResponse x
from :: forall x.
ListMessageFilesResponse -> Rep ListMessageFilesResponse x
$cto :: forall x.
Rep ListMessageFilesResponse x -> ListMessageFilesResponse
to :: forall x.
Rep ListMessageFilesResponse x -> ListMessageFilesResponse
Generic, Typeable ListMessageFilesResponse
Typeable ListMessageFilesResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ListMessageFilesResponse
 -> c ListMessageFilesResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ListMessageFilesResponse)
-> (ListMessageFilesResponse -> Constr)
-> (ListMessageFilesResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ListMessageFilesResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListMessageFilesResponse))
-> ((forall b. Data b => b -> b)
    -> ListMessageFilesResponse -> ListMessageFilesResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ListMessageFilesResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ListMessageFilesResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ListMessageFilesResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> ListMessageFilesResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListMessageFilesResponse -> m ListMessageFilesResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListMessageFilesResponse -> m ListMessageFilesResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListMessageFilesResponse -> m ListMessageFilesResponse)
-> Data ListMessageFilesResponse
ListMessageFilesResponse -> Constr
ListMessageFilesResponse -> DataType
(forall b. Data b => b -> b)
-> ListMessageFilesResponse -> ListMessageFilesResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> ListMessageFilesResponse -> u
forall u.
(forall d. Data d => d -> u) -> ListMessageFilesResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListMessageFilesResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListMessageFilesResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListMessageFilesResponse -> m ListMessageFilesResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListMessageFilesResponse -> m ListMessageFilesResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListMessageFilesResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListMessageFilesResponse
-> c ListMessageFilesResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListMessageFilesResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListMessageFilesResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListMessageFilesResponse
-> c ListMessageFilesResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListMessageFilesResponse
-> c ListMessageFilesResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListMessageFilesResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListMessageFilesResponse
$ctoConstr :: ListMessageFilesResponse -> Constr
toConstr :: ListMessageFilesResponse -> Constr
$cdataTypeOf :: ListMessageFilesResponse -> DataType
dataTypeOf :: ListMessageFilesResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListMessageFilesResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListMessageFilesResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListMessageFilesResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListMessageFilesResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListMessageFilesResponse -> ListMessageFilesResponse
gmapT :: (forall b. Data b => b -> b)
-> ListMessageFilesResponse -> ListMessageFilesResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListMessageFilesResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListMessageFilesResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListMessageFilesResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListMessageFilesResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ListMessageFilesResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ListMessageFilesResponse -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ListMessageFilesResponse -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ListMessageFilesResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListMessageFilesResponse -> m ListMessageFilesResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListMessageFilesResponse -> m ListMessageFilesResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListMessageFilesResponse -> m ListMessageFilesResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListMessageFilesResponse -> m ListMessageFilesResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListMessageFilesResponse -> m ListMessageFilesResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListMessageFilesResponse -> m ListMessageFilesResponse
Data)

instance FromJSON ListMessageFilesResponse where
  parseJSON :: Value -> Parser ListMessageFilesResponse
parseJSON = Options -> Value -> Parser ListMessageFilesResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listMessageFilesResponse")
instance ToJSON ListMessageFilesResponse where
  toJSON :: ListMessageFilesResponse -> Value
toJSON = Options -> ListMessageFilesResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listMessageFilesResponse")


-- | 
data ListMessagesResponse = ListMessagesResponse
  { ListMessagesResponse -> Text
listMessagesResponseObject :: Text -- ^ 
  , ListMessagesResponse -> [MessageObject]
listMessagesResponseData :: [MessageObject] -- ^ 
  , ListMessagesResponse -> Text
listMessagesResponseFirstUnderscoreid :: Text -- ^ 
  , ListMessagesResponse -> Text
listMessagesResponseLastUnderscoreid :: Text -- ^ 
  , ListMessagesResponse -> Bool
listMessagesResponseHasUnderscoremore :: Bool -- ^ 
  } deriving (Int -> ListMessagesResponse -> ShowS
[ListMessagesResponse] -> ShowS
ListMessagesResponse -> String
(Int -> ListMessagesResponse -> ShowS)
-> (ListMessagesResponse -> String)
-> ([ListMessagesResponse] -> ShowS)
-> Show ListMessagesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListMessagesResponse -> ShowS
showsPrec :: Int -> ListMessagesResponse -> ShowS
$cshow :: ListMessagesResponse -> String
show :: ListMessagesResponse -> String
$cshowList :: [ListMessagesResponse] -> ShowS
showList :: [ListMessagesResponse] -> ShowS
Show, ListMessagesResponse -> ListMessagesResponse -> Bool
(ListMessagesResponse -> ListMessagesResponse -> Bool)
-> (ListMessagesResponse -> ListMessagesResponse -> Bool)
-> Eq ListMessagesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListMessagesResponse -> ListMessagesResponse -> Bool
== :: ListMessagesResponse -> ListMessagesResponse -> Bool
$c/= :: ListMessagesResponse -> ListMessagesResponse -> Bool
/= :: ListMessagesResponse -> ListMessagesResponse -> Bool
Eq, Eq ListMessagesResponse
Eq ListMessagesResponse =>
(ListMessagesResponse -> ListMessagesResponse -> Ordering)
-> (ListMessagesResponse -> ListMessagesResponse -> Bool)
-> (ListMessagesResponse -> ListMessagesResponse -> Bool)
-> (ListMessagesResponse -> ListMessagesResponse -> Bool)
-> (ListMessagesResponse -> ListMessagesResponse -> Bool)
-> (ListMessagesResponse
    -> ListMessagesResponse -> ListMessagesResponse)
-> (ListMessagesResponse
    -> ListMessagesResponse -> ListMessagesResponse)
-> Ord ListMessagesResponse
ListMessagesResponse -> ListMessagesResponse -> Bool
ListMessagesResponse -> ListMessagesResponse -> Ordering
ListMessagesResponse
-> ListMessagesResponse -> ListMessagesResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListMessagesResponse -> ListMessagesResponse -> Ordering
compare :: ListMessagesResponse -> ListMessagesResponse -> Ordering
$c< :: ListMessagesResponse -> ListMessagesResponse -> Bool
< :: ListMessagesResponse -> ListMessagesResponse -> Bool
$c<= :: ListMessagesResponse -> ListMessagesResponse -> Bool
<= :: ListMessagesResponse -> ListMessagesResponse -> Bool
$c> :: ListMessagesResponse -> ListMessagesResponse -> Bool
> :: ListMessagesResponse -> ListMessagesResponse -> Bool
$c>= :: ListMessagesResponse -> ListMessagesResponse -> Bool
>= :: ListMessagesResponse -> ListMessagesResponse -> Bool
$cmax :: ListMessagesResponse
-> ListMessagesResponse -> ListMessagesResponse
max :: ListMessagesResponse
-> ListMessagesResponse -> ListMessagesResponse
$cmin :: ListMessagesResponse
-> ListMessagesResponse -> ListMessagesResponse
min :: ListMessagesResponse
-> ListMessagesResponse -> ListMessagesResponse
Ord, (forall x. ListMessagesResponse -> Rep ListMessagesResponse x)
-> (forall x. Rep ListMessagesResponse x -> ListMessagesResponse)
-> Generic ListMessagesResponse
forall x. Rep ListMessagesResponse x -> ListMessagesResponse
forall x. ListMessagesResponse -> Rep ListMessagesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListMessagesResponse -> Rep ListMessagesResponse x
from :: forall x. ListMessagesResponse -> Rep ListMessagesResponse x
$cto :: forall x. Rep ListMessagesResponse x -> ListMessagesResponse
to :: forall x. Rep ListMessagesResponse x -> ListMessagesResponse
Generic, Typeable ListMessagesResponse
Typeable ListMessagesResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ListMessagesResponse
 -> c ListMessagesResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ListMessagesResponse)
-> (ListMessagesResponse -> Constr)
-> (ListMessagesResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ListMessagesResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListMessagesResponse))
-> ((forall b. Data b => b -> b)
    -> ListMessagesResponse -> ListMessagesResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ListMessagesResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ListMessagesResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ListMessagesResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ListMessagesResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListMessagesResponse -> m ListMessagesResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListMessagesResponse -> m ListMessagesResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListMessagesResponse -> m ListMessagesResponse)
-> Data ListMessagesResponse
ListMessagesResponse -> Constr
ListMessagesResponse -> DataType
(forall b. Data b => b -> b)
-> ListMessagesResponse -> ListMessagesResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ListMessagesResponse -> u
forall u.
(forall d. Data d => d -> u) -> ListMessagesResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListMessagesResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListMessagesResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListMessagesResponse -> m ListMessagesResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListMessagesResponse -> m ListMessagesResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListMessagesResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListMessagesResponse
-> c ListMessagesResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListMessagesResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListMessagesResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListMessagesResponse
-> c ListMessagesResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListMessagesResponse
-> c ListMessagesResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListMessagesResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListMessagesResponse
$ctoConstr :: ListMessagesResponse -> Constr
toConstr :: ListMessagesResponse -> Constr
$cdataTypeOf :: ListMessagesResponse -> DataType
dataTypeOf :: ListMessagesResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListMessagesResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListMessagesResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListMessagesResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListMessagesResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListMessagesResponse -> ListMessagesResponse
gmapT :: (forall b. Data b => b -> b)
-> ListMessagesResponse -> ListMessagesResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListMessagesResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListMessagesResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListMessagesResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListMessagesResponse -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ListMessagesResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ListMessagesResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListMessagesResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListMessagesResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListMessagesResponse -> m ListMessagesResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListMessagesResponse -> m ListMessagesResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListMessagesResponse -> m ListMessagesResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListMessagesResponse -> m ListMessagesResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListMessagesResponse -> m ListMessagesResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListMessagesResponse -> m ListMessagesResponse
Data)

instance FromJSON ListMessagesResponse where
  parseJSON :: Value -> Parser ListMessagesResponse
parseJSON = Options -> Value -> Parser ListMessagesResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listMessagesResponse")
instance ToJSON ListMessagesResponse where
  toJSON :: ListMessagesResponse -> Value
toJSON = Options -> ListMessagesResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listMessagesResponse")


-- | 
data ListModelsResponse = ListModelsResponse
  { ListModelsResponse -> Text
listModelsResponseObject :: Text -- ^ 
  , ListModelsResponse -> [Model]
listModelsResponseData :: [Model] -- ^ 
  } deriving (Int -> ListModelsResponse -> ShowS
[ListModelsResponse] -> ShowS
ListModelsResponse -> String
(Int -> ListModelsResponse -> ShowS)
-> (ListModelsResponse -> String)
-> ([ListModelsResponse] -> ShowS)
-> Show ListModelsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListModelsResponse -> ShowS
showsPrec :: Int -> ListModelsResponse -> ShowS
$cshow :: ListModelsResponse -> String
show :: ListModelsResponse -> String
$cshowList :: [ListModelsResponse] -> ShowS
showList :: [ListModelsResponse] -> ShowS
Show, ListModelsResponse -> ListModelsResponse -> Bool
(ListModelsResponse -> ListModelsResponse -> Bool)
-> (ListModelsResponse -> ListModelsResponse -> Bool)
-> Eq ListModelsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListModelsResponse -> ListModelsResponse -> Bool
== :: ListModelsResponse -> ListModelsResponse -> Bool
$c/= :: ListModelsResponse -> ListModelsResponse -> Bool
/= :: ListModelsResponse -> ListModelsResponse -> Bool
Eq, Eq ListModelsResponse
Eq ListModelsResponse =>
(ListModelsResponse -> ListModelsResponse -> Ordering)
-> (ListModelsResponse -> ListModelsResponse -> Bool)
-> (ListModelsResponse -> ListModelsResponse -> Bool)
-> (ListModelsResponse -> ListModelsResponse -> Bool)
-> (ListModelsResponse -> ListModelsResponse -> Bool)
-> (ListModelsResponse -> ListModelsResponse -> ListModelsResponse)
-> (ListModelsResponse -> ListModelsResponse -> ListModelsResponse)
-> Ord ListModelsResponse
ListModelsResponse -> ListModelsResponse -> Bool
ListModelsResponse -> ListModelsResponse -> Ordering
ListModelsResponse -> ListModelsResponse -> ListModelsResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListModelsResponse -> ListModelsResponse -> Ordering
compare :: ListModelsResponse -> ListModelsResponse -> Ordering
$c< :: ListModelsResponse -> ListModelsResponse -> Bool
< :: ListModelsResponse -> ListModelsResponse -> Bool
$c<= :: ListModelsResponse -> ListModelsResponse -> Bool
<= :: ListModelsResponse -> ListModelsResponse -> Bool
$c> :: ListModelsResponse -> ListModelsResponse -> Bool
> :: ListModelsResponse -> ListModelsResponse -> Bool
$c>= :: ListModelsResponse -> ListModelsResponse -> Bool
>= :: ListModelsResponse -> ListModelsResponse -> Bool
$cmax :: ListModelsResponse -> ListModelsResponse -> ListModelsResponse
max :: ListModelsResponse -> ListModelsResponse -> ListModelsResponse
$cmin :: ListModelsResponse -> ListModelsResponse -> ListModelsResponse
min :: ListModelsResponse -> ListModelsResponse -> ListModelsResponse
Ord, (forall x. ListModelsResponse -> Rep ListModelsResponse x)
-> (forall x. Rep ListModelsResponse x -> ListModelsResponse)
-> Generic ListModelsResponse
forall x. Rep ListModelsResponse x -> ListModelsResponse
forall x. ListModelsResponse -> Rep ListModelsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListModelsResponse -> Rep ListModelsResponse x
from :: forall x. ListModelsResponse -> Rep ListModelsResponse x
$cto :: forall x. Rep ListModelsResponse x -> ListModelsResponse
to :: forall x. Rep ListModelsResponse x -> ListModelsResponse
Generic, Typeable ListModelsResponse
Typeable ListModelsResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ListModelsResponse
 -> c ListModelsResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ListModelsResponse)
-> (ListModelsResponse -> Constr)
-> (ListModelsResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ListModelsResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListModelsResponse))
-> ((forall b. Data b => b -> b)
    -> ListModelsResponse -> ListModelsResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ListModelsResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ListModelsResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ListModelsResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ListModelsResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListModelsResponse -> m ListModelsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListModelsResponse -> m ListModelsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListModelsResponse -> m ListModelsResponse)
-> Data ListModelsResponse
ListModelsResponse -> Constr
ListModelsResponse -> DataType
(forall b. Data b => b -> b)
-> ListModelsResponse -> ListModelsResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ListModelsResponse -> u
forall u. (forall d. Data d => d -> u) -> ListModelsResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListModelsResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListModelsResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListModelsResponse -> m ListModelsResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListModelsResponse -> m ListModelsResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListModelsResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListModelsResponse
-> c ListModelsResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListModelsResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListModelsResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListModelsResponse
-> c ListModelsResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListModelsResponse
-> c ListModelsResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListModelsResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListModelsResponse
$ctoConstr :: ListModelsResponse -> Constr
toConstr :: ListModelsResponse -> Constr
$cdataTypeOf :: ListModelsResponse -> DataType
dataTypeOf :: ListModelsResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListModelsResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListModelsResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListModelsResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListModelsResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListModelsResponse -> ListModelsResponse
gmapT :: (forall b. Data b => b -> b)
-> ListModelsResponse -> ListModelsResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListModelsResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListModelsResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListModelsResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListModelsResponse -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListModelsResponse -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ListModelsResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListModelsResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListModelsResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListModelsResponse -> m ListModelsResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListModelsResponse -> m ListModelsResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListModelsResponse -> m ListModelsResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListModelsResponse -> m ListModelsResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListModelsResponse -> m ListModelsResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListModelsResponse -> m ListModelsResponse
Data)

instance FromJSON ListModelsResponse where
  parseJSON :: Value -> Parser ListModelsResponse
parseJSON = Options -> Value -> Parser ListModelsResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listModelsResponse")
instance ToJSON ListModelsResponse where
  toJSON :: ListModelsResponse -> Value
toJSON = Options -> ListModelsResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listModelsResponse")


-- | 
data ListPaginatedFineTuningJobsResponse = ListPaginatedFineTuningJobsResponse
  { ListPaginatedFineTuningJobsResponse -> [FineTuningJob]
listPaginatedFineTuningJobsResponseData :: [FineTuningJob] -- ^ 
  , ListPaginatedFineTuningJobsResponse -> Bool
listPaginatedFineTuningJobsResponseHasUnderscoremore :: Bool -- ^ 
  , ListPaginatedFineTuningJobsResponse -> Text
listPaginatedFineTuningJobsResponseObject :: Text -- ^ 
  } deriving (Int -> ListPaginatedFineTuningJobsResponse -> ShowS
[ListPaginatedFineTuningJobsResponse] -> ShowS
ListPaginatedFineTuningJobsResponse -> String
(Int -> ListPaginatedFineTuningJobsResponse -> ShowS)
-> (ListPaginatedFineTuningJobsResponse -> String)
-> ([ListPaginatedFineTuningJobsResponse] -> ShowS)
-> Show ListPaginatedFineTuningJobsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListPaginatedFineTuningJobsResponse -> ShowS
showsPrec :: Int -> ListPaginatedFineTuningJobsResponse -> ShowS
$cshow :: ListPaginatedFineTuningJobsResponse -> String
show :: ListPaginatedFineTuningJobsResponse -> String
$cshowList :: [ListPaginatedFineTuningJobsResponse] -> ShowS
showList :: [ListPaginatedFineTuningJobsResponse] -> ShowS
Show, ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
(ListPaginatedFineTuningJobsResponse
 -> ListPaginatedFineTuningJobsResponse -> Bool)
-> (ListPaginatedFineTuningJobsResponse
    -> ListPaginatedFineTuningJobsResponse -> Bool)
-> Eq ListPaginatedFineTuningJobsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
== :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
$c/= :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
/= :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
Eq, Eq ListPaginatedFineTuningJobsResponse
Eq ListPaginatedFineTuningJobsResponse =>
(ListPaginatedFineTuningJobsResponse
 -> ListPaginatedFineTuningJobsResponse -> Ordering)
-> (ListPaginatedFineTuningJobsResponse
    -> ListPaginatedFineTuningJobsResponse -> Bool)
-> (ListPaginatedFineTuningJobsResponse
    -> ListPaginatedFineTuningJobsResponse -> Bool)
-> (ListPaginatedFineTuningJobsResponse
    -> ListPaginatedFineTuningJobsResponse -> Bool)
-> (ListPaginatedFineTuningJobsResponse
    -> ListPaginatedFineTuningJobsResponse -> Bool)
-> (ListPaginatedFineTuningJobsResponse
    -> ListPaginatedFineTuningJobsResponse
    -> ListPaginatedFineTuningJobsResponse)
-> (ListPaginatedFineTuningJobsResponse
    -> ListPaginatedFineTuningJobsResponse
    -> ListPaginatedFineTuningJobsResponse)
-> Ord ListPaginatedFineTuningJobsResponse
ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Ordering
ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Ordering
compare :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Ordering
$c< :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
< :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
$c<= :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
<= :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
$c> :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
> :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
$c>= :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
>= :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse -> Bool
$cmax :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
max :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
$cmin :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
min :: ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
Ord, (forall x.
 ListPaginatedFineTuningJobsResponse
 -> Rep ListPaginatedFineTuningJobsResponse x)
-> (forall x.
    Rep ListPaginatedFineTuningJobsResponse x
    -> ListPaginatedFineTuningJobsResponse)
-> Generic ListPaginatedFineTuningJobsResponse
forall x.
Rep ListPaginatedFineTuningJobsResponse x
-> ListPaginatedFineTuningJobsResponse
forall x.
ListPaginatedFineTuningJobsResponse
-> Rep ListPaginatedFineTuningJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ListPaginatedFineTuningJobsResponse
-> Rep ListPaginatedFineTuningJobsResponse x
from :: forall x.
ListPaginatedFineTuningJobsResponse
-> Rep ListPaginatedFineTuningJobsResponse x
$cto :: forall x.
Rep ListPaginatedFineTuningJobsResponse x
-> ListPaginatedFineTuningJobsResponse
to :: forall x.
Rep ListPaginatedFineTuningJobsResponse x
-> ListPaginatedFineTuningJobsResponse
Generic, Typeable ListPaginatedFineTuningJobsResponse
Typeable ListPaginatedFineTuningJobsResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ListPaginatedFineTuningJobsResponse
 -> c ListPaginatedFineTuningJobsResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ListPaginatedFineTuningJobsResponse)
-> (ListPaginatedFineTuningJobsResponse -> Constr)
-> (ListPaginatedFineTuningJobsResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ListPaginatedFineTuningJobsResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListPaginatedFineTuningJobsResponse))
-> ((forall b. Data b => b -> b)
    -> ListPaginatedFineTuningJobsResponse
    -> ListPaginatedFineTuningJobsResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ListPaginatedFineTuningJobsResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ListPaginatedFineTuningJobsResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ListPaginatedFineTuningJobsResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ListPaginatedFineTuningJobsResponse
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListPaginatedFineTuningJobsResponse
    -> m ListPaginatedFineTuningJobsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListPaginatedFineTuningJobsResponse
    -> m ListPaginatedFineTuningJobsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListPaginatedFineTuningJobsResponse
    -> m ListPaginatedFineTuningJobsResponse)
-> Data ListPaginatedFineTuningJobsResponse
ListPaginatedFineTuningJobsResponse -> Constr
ListPaginatedFineTuningJobsResponse -> DataType
(forall b. Data b => b -> b)
-> ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ListPaginatedFineTuningJobsResponse
-> u
forall u.
(forall d. Data d => d -> u)
-> ListPaginatedFineTuningJobsResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListPaginatedFineTuningJobsResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListPaginatedFineTuningJobsResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListPaginatedFineTuningJobsResponse
-> m ListPaginatedFineTuningJobsResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListPaginatedFineTuningJobsResponse
-> m ListPaginatedFineTuningJobsResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ListPaginatedFineTuningJobsResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListPaginatedFineTuningJobsResponse
-> c ListPaginatedFineTuningJobsResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ListPaginatedFineTuningJobsResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListPaginatedFineTuningJobsResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListPaginatedFineTuningJobsResponse
-> c ListPaginatedFineTuningJobsResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListPaginatedFineTuningJobsResponse
-> c ListPaginatedFineTuningJobsResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ListPaginatedFineTuningJobsResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ListPaginatedFineTuningJobsResponse
$ctoConstr :: ListPaginatedFineTuningJobsResponse -> Constr
toConstr :: ListPaginatedFineTuningJobsResponse -> Constr
$cdataTypeOf :: ListPaginatedFineTuningJobsResponse -> DataType
dataTypeOf :: ListPaginatedFineTuningJobsResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ListPaginatedFineTuningJobsResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ListPaginatedFineTuningJobsResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListPaginatedFineTuningJobsResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListPaginatedFineTuningJobsResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
gmapT :: (forall b. Data b => b -> b)
-> ListPaginatedFineTuningJobsResponse
-> ListPaginatedFineTuningJobsResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListPaginatedFineTuningJobsResponse
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListPaginatedFineTuningJobsResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListPaginatedFineTuningJobsResponse
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ListPaginatedFineTuningJobsResponse
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ListPaginatedFineTuningJobsResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ListPaginatedFineTuningJobsResponse -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ListPaginatedFineTuningJobsResponse
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ListPaginatedFineTuningJobsResponse
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListPaginatedFineTuningJobsResponse
-> m ListPaginatedFineTuningJobsResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListPaginatedFineTuningJobsResponse
-> m ListPaginatedFineTuningJobsResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListPaginatedFineTuningJobsResponse
-> m ListPaginatedFineTuningJobsResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListPaginatedFineTuningJobsResponse
-> m ListPaginatedFineTuningJobsResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListPaginatedFineTuningJobsResponse
-> m ListPaginatedFineTuningJobsResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListPaginatedFineTuningJobsResponse
-> m ListPaginatedFineTuningJobsResponse
Data)

instance FromJSON ListPaginatedFineTuningJobsResponse where
  parseJSON :: Value -> Parser ListPaginatedFineTuningJobsResponse
parseJSON = Options -> Value -> Parser ListPaginatedFineTuningJobsResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listPaginatedFineTuningJobsResponse")
instance ToJSON ListPaginatedFineTuningJobsResponse where
  toJSON :: ListPaginatedFineTuningJobsResponse -> Value
toJSON = Options -> ListPaginatedFineTuningJobsResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listPaginatedFineTuningJobsResponse")


-- | 
data ListRunStepsResponse = ListRunStepsResponse
  { ListRunStepsResponse -> Text
listRunStepsResponseObject :: Text -- ^ 
  , ListRunStepsResponse -> [RunStepObject]
listRunStepsResponseData :: [RunStepObject] -- ^ 
  , ListRunStepsResponse -> Text
listRunStepsResponseFirstUnderscoreid :: Text -- ^ 
  , ListRunStepsResponse -> Text
listRunStepsResponseLastUnderscoreid :: Text -- ^ 
  , ListRunStepsResponse -> Bool
listRunStepsResponseHasUnderscoremore :: Bool -- ^ 
  } deriving (Int -> ListRunStepsResponse -> ShowS
[ListRunStepsResponse] -> ShowS
ListRunStepsResponse -> String
(Int -> ListRunStepsResponse -> ShowS)
-> (ListRunStepsResponse -> String)
-> ([ListRunStepsResponse] -> ShowS)
-> Show ListRunStepsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListRunStepsResponse -> ShowS
showsPrec :: Int -> ListRunStepsResponse -> ShowS
$cshow :: ListRunStepsResponse -> String
show :: ListRunStepsResponse -> String
$cshowList :: [ListRunStepsResponse] -> ShowS
showList :: [ListRunStepsResponse] -> ShowS
Show, ListRunStepsResponse -> ListRunStepsResponse -> Bool
(ListRunStepsResponse -> ListRunStepsResponse -> Bool)
-> (ListRunStepsResponse -> ListRunStepsResponse -> Bool)
-> Eq ListRunStepsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
== :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
$c/= :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
/= :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
Eq, Eq ListRunStepsResponse
Eq ListRunStepsResponse =>
(ListRunStepsResponse -> ListRunStepsResponse -> Ordering)
-> (ListRunStepsResponse -> ListRunStepsResponse -> Bool)
-> (ListRunStepsResponse -> ListRunStepsResponse -> Bool)
-> (ListRunStepsResponse -> ListRunStepsResponse -> Bool)
-> (ListRunStepsResponse -> ListRunStepsResponse -> Bool)
-> (ListRunStepsResponse
    -> ListRunStepsResponse -> ListRunStepsResponse)
-> (ListRunStepsResponse
    -> ListRunStepsResponse -> ListRunStepsResponse)
-> Ord ListRunStepsResponse
ListRunStepsResponse -> ListRunStepsResponse -> Bool
ListRunStepsResponse -> ListRunStepsResponse -> Ordering
ListRunStepsResponse
-> ListRunStepsResponse -> ListRunStepsResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListRunStepsResponse -> ListRunStepsResponse -> Ordering
compare :: ListRunStepsResponse -> ListRunStepsResponse -> Ordering
$c< :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
< :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
$c<= :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
<= :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
$c> :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
> :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
$c>= :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
>= :: ListRunStepsResponse -> ListRunStepsResponse -> Bool
$cmax :: ListRunStepsResponse
-> ListRunStepsResponse -> ListRunStepsResponse
max :: ListRunStepsResponse
-> ListRunStepsResponse -> ListRunStepsResponse
$cmin :: ListRunStepsResponse
-> ListRunStepsResponse -> ListRunStepsResponse
min :: ListRunStepsResponse
-> ListRunStepsResponse -> ListRunStepsResponse
Ord, (forall x. ListRunStepsResponse -> Rep ListRunStepsResponse x)
-> (forall x. Rep ListRunStepsResponse x -> ListRunStepsResponse)
-> Generic ListRunStepsResponse
forall x. Rep ListRunStepsResponse x -> ListRunStepsResponse
forall x. ListRunStepsResponse -> Rep ListRunStepsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListRunStepsResponse -> Rep ListRunStepsResponse x
from :: forall x. ListRunStepsResponse -> Rep ListRunStepsResponse x
$cto :: forall x. Rep ListRunStepsResponse x -> ListRunStepsResponse
to :: forall x. Rep ListRunStepsResponse x -> ListRunStepsResponse
Generic, Typeable ListRunStepsResponse
Typeable ListRunStepsResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ListRunStepsResponse
 -> c ListRunStepsResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ListRunStepsResponse)
-> (ListRunStepsResponse -> Constr)
-> (ListRunStepsResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ListRunStepsResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListRunStepsResponse))
-> ((forall b. Data b => b -> b)
    -> ListRunStepsResponse -> ListRunStepsResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ListRunStepsResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ListRunStepsResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ListRunStepsResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ListRunStepsResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListRunStepsResponse -> m ListRunStepsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListRunStepsResponse -> m ListRunStepsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListRunStepsResponse -> m ListRunStepsResponse)
-> Data ListRunStepsResponse
ListRunStepsResponse -> Constr
ListRunStepsResponse -> DataType
(forall b. Data b => b -> b)
-> ListRunStepsResponse -> ListRunStepsResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ListRunStepsResponse -> u
forall u.
(forall d. Data d => d -> u) -> ListRunStepsResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunStepsResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunStepsResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListRunStepsResponse -> m ListRunStepsResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListRunStepsResponse -> m ListRunStepsResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListRunStepsResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListRunStepsResponse
-> c ListRunStepsResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListRunStepsResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListRunStepsResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListRunStepsResponse
-> c ListRunStepsResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListRunStepsResponse
-> c ListRunStepsResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListRunStepsResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListRunStepsResponse
$ctoConstr :: ListRunStepsResponse -> Constr
toConstr :: ListRunStepsResponse -> Constr
$cdataTypeOf :: ListRunStepsResponse -> DataType
dataTypeOf :: ListRunStepsResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListRunStepsResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListRunStepsResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListRunStepsResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListRunStepsResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListRunStepsResponse -> ListRunStepsResponse
gmapT :: (forall b. Data b => b -> b)
-> ListRunStepsResponse -> ListRunStepsResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunStepsResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunStepsResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunStepsResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunStepsResponse -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ListRunStepsResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ListRunStepsResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListRunStepsResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListRunStepsResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListRunStepsResponse -> m ListRunStepsResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListRunStepsResponse -> m ListRunStepsResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListRunStepsResponse -> m ListRunStepsResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListRunStepsResponse -> m ListRunStepsResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListRunStepsResponse -> m ListRunStepsResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListRunStepsResponse -> m ListRunStepsResponse
Data)

instance FromJSON ListRunStepsResponse where
  parseJSON :: Value -> Parser ListRunStepsResponse
parseJSON = Options -> Value -> Parser ListRunStepsResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listRunStepsResponse")
instance ToJSON ListRunStepsResponse where
  toJSON :: ListRunStepsResponse -> Value
toJSON = Options -> ListRunStepsResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listRunStepsResponse")


-- | 
data ListRunsResponse = ListRunsResponse
  { ListRunsResponse -> Text
listRunsResponseObject :: Text -- ^ 
  , ListRunsResponse -> [RunObject]
listRunsResponseData :: [RunObject] -- ^ 
  , ListRunsResponse -> Text
listRunsResponseFirstUnderscoreid :: Text -- ^ 
  , ListRunsResponse -> Text
listRunsResponseLastUnderscoreid :: Text -- ^ 
  , ListRunsResponse -> Bool
listRunsResponseHasUnderscoremore :: Bool -- ^ 
  } deriving (Int -> ListRunsResponse -> ShowS
[ListRunsResponse] -> ShowS
ListRunsResponse -> String
(Int -> ListRunsResponse -> ShowS)
-> (ListRunsResponse -> String)
-> ([ListRunsResponse] -> ShowS)
-> Show ListRunsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListRunsResponse -> ShowS
showsPrec :: Int -> ListRunsResponse -> ShowS
$cshow :: ListRunsResponse -> String
show :: ListRunsResponse -> String
$cshowList :: [ListRunsResponse] -> ShowS
showList :: [ListRunsResponse] -> ShowS
Show, ListRunsResponse -> ListRunsResponse -> Bool
(ListRunsResponse -> ListRunsResponse -> Bool)
-> (ListRunsResponse -> ListRunsResponse -> Bool)
-> Eq ListRunsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListRunsResponse -> ListRunsResponse -> Bool
== :: ListRunsResponse -> ListRunsResponse -> Bool
$c/= :: ListRunsResponse -> ListRunsResponse -> Bool
/= :: ListRunsResponse -> ListRunsResponse -> Bool
Eq, Eq ListRunsResponse
Eq ListRunsResponse =>
(ListRunsResponse -> ListRunsResponse -> Ordering)
-> (ListRunsResponse -> ListRunsResponse -> Bool)
-> (ListRunsResponse -> ListRunsResponse -> Bool)
-> (ListRunsResponse -> ListRunsResponse -> Bool)
-> (ListRunsResponse -> ListRunsResponse -> Bool)
-> (ListRunsResponse -> ListRunsResponse -> ListRunsResponse)
-> (ListRunsResponse -> ListRunsResponse -> ListRunsResponse)
-> Ord ListRunsResponse
ListRunsResponse -> ListRunsResponse -> Bool
ListRunsResponse -> ListRunsResponse -> Ordering
ListRunsResponse -> ListRunsResponse -> ListRunsResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListRunsResponse -> ListRunsResponse -> Ordering
compare :: ListRunsResponse -> ListRunsResponse -> Ordering
$c< :: ListRunsResponse -> ListRunsResponse -> Bool
< :: ListRunsResponse -> ListRunsResponse -> Bool
$c<= :: ListRunsResponse -> ListRunsResponse -> Bool
<= :: ListRunsResponse -> ListRunsResponse -> Bool
$c> :: ListRunsResponse -> ListRunsResponse -> Bool
> :: ListRunsResponse -> ListRunsResponse -> Bool
$c>= :: ListRunsResponse -> ListRunsResponse -> Bool
>= :: ListRunsResponse -> ListRunsResponse -> Bool
$cmax :: ListRunsResponse -> ListRunsResponse -> ListRunsResponse
max :: ListRunsResponse -> ListRunsResponse -> ListRunsResponse
$cmin :: ListRunsResponse -> ListRunsResponse -> ListRunsResponse
min :: ListRunsResponse -> ListRunsResponse -> ListRunsResponse
Ord, (forall x. ListRunsResponse -> Rep ListRunsResponse x)
-> (forall x. Rep ListRunsResponse x -> ListRunsResponse)
-> Generic ListRunsResponse
forall x. Rep ListRunsResponse x -> ListRunsResponse
forall x. ListRunsResponse -> Rep ListRunsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListRunsResponse -> Rep ListRunsResponse x
from :: forall x. ListRunsResponse -> Rep ListRunsResponse x
$cto :: forall x. Rep ListRunsResponse x -> ListRunsResponse
to :: forall x. Rep ListRunsResponse x -> ListRunsResponse
Generic, Typeable ListRunsResponse
Typeable ListRunsResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ListRunsResponse -> c ListRunsResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ListRunsResponse)
-> (ListRunsResponse -> Constr)
-> (ListRunsResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ListRunsResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListRunsResponse))
-> ((forall b. Data b => b -> b)
    -> ListRunsResponse -> ListRunsResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ListRunsResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ListRunsResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ListRunsResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ListRunsResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListRunsResponse -> m ListRunsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListRunsResponse -> m ListRunsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListRunsResponse -> m ListRunsResponse)
-> Data ListRunsResponse
ListRunsResponse -> Constr
ListRunsResponse -> DataType
(forall b. Data b => b -> b)
-> ListRunsResponse -> ListRunsResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ListRunsResponse -> u
forall u. (forall d. Data d => d -> u) -> ListRunsResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunsResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunsResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListRunsResponse -> m ListRunsResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListRunsResponse -> m ListRunsResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListRunsResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListRunsResponse -> c ListRunsResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListRunsResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListRunsResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListRunsResponse -> c ListRunsResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListRunsResponse -> c ListRunsResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListRunsResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListRunsResponse
$ctoConstr :: ListRunsResponse -> Constr
toConstr :: ListRunsResponse -> Constr
$cdataTypeOf :: ListRunsResponse -> DataType
dataTypeOf :: ListRunsResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListRunsResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListRunsResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListRunsResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListRunsResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListRunsResponse -> ListRunsResponse
gmapT :: (forall b. Data b => b -> b)
-> ListRunsResponse -> ListRunsResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunsResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunsResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunsResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListRunsResponse -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListRunsResponse -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ListRunsResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListRunsResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListRunsResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListRunsResponse -> m ListRunsResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListRunsResponse -> m ListRunsResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListRunsResponse -> m ListRunsResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListRunsResponse -> m ListRunsResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListRunsResponse -> m ListRunsResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListRunsResponse -> m ListRunsResponse
Data)

instance FromJSON ListRunsResponse where
  parseJSON :: Value -> Parser ListRunsResponse
parseJSON = Options -> Value -> Parser ListRunsResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listRunsResponse")
instance ToJSON ListRunsResponse where
  toJSON :: ListRunsResponse -> Value
toJSON = Options -> ListRunsResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listRunsResponse")


-- | 
data ListThreadsResponse = ListThreadsResponse
  { ListThreadsResponse -> Text
listThreadsResponseObject :: Text -- ^ 
  , ListThreadsResponse -> [ThreadObject]
listThreadsResponseData :: [ThreadObject] -- ^ 
  , ListThreadsResponse -> Text
listThreadsResponseFirstUnderscoreid :: Text -- ^ 
  , ListThreadsResponse -> Text
listThreadsResponseLastUnderscoreid :: Text -- ^ 
  , ListThreadsResponse -> Bool
listThreadsResponseHasUnderscoremore :: Bool -- ^ 
  } deriving (Int -> ListThreadsResponse -> ShowS
[ListThreadsResponse] -> ShowS
ListThreadsResponse -> String
(Int -> ListThreadsResponse -> ShowS)
-> (ListThreadsResponse -> String)
-> ([ListThreadsResponse] -> ShowS)
-> Show ListThreadsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListThreadsResponse -> ShowS
showsPrec :: Int -> ListThreadsResponse -> ShowS
$cshow :: ListThreadsResponse -> String
show :: ListThreadsResponse -> String
$cshowList :: [ListThreadsResponse] -> ShowS
showList :: [ListThreadsResponse] -> ShowS
Show, ListThreadsResponse -> ListThreadsResponse -> Bool
(ListThreadsResponse -> ListThreadsResponse -> Bool)
-> (ListThreadsResponse -> ListThreadsResponse -> Bool)
-> Eq ListThreadsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListThreadsResponse -> ListThreadsResponse -> Bool
== :: ListThreadsResponse -> ListThreadsResponse -> Bool
$c/= :: ListThreadsResponse -> ListThreadsResponse -> Bool
/= :: ListThreadsResponse -> ListThreadsResponse -> Bool
Eq, Eq ListThreadsResponse
Eq ListThreadsResponse =>
(ListThreadsResponse -> ListThreadsResponse -> Ordering)
-> (ListThreadsResponse -> ListThreadsResponse -> Bool)
-> (ListThreadsResponse -> ListThreadsResponse -> Bool)
-> (ListThreadsResponse -> ListThreadsResponse -> Bool)
-> (ListThreadsResponse -> ListThreadsResponse -> Bool)
-> (ListThreadsResponse
    -> ListThreadsResponse -> ListThreadsResponse)
-> (ListThreadsResponse
    -> ListThreadsResponse -> ListThreadsResponse)
-> Ord ListThreadsResponse
ListThreadsResponse -> ListThreadsResponse -> Bool
ListThreadsResponse -> ListThreadsResponse -> Ordering
ListThreadsResponse -> ListThreadsResponse -> ListThreadsResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListThreadsResponse -> ListThreadsResponse -> Ordering
compare :: ListThreadsResponse -> ListThreadsResponse -> Ordering
$c< :: ListThreadsResponse -> ListThreadsResponse -> Bool
< :: ListThreadsResponse -> ListThreadsResponse -> Bool
$c<= :: ListThreadsResponse -> ListThreadsResponse -> Bool
<= :: ListThreadsResponse -> ListThreadsResponse -> Bool
$c> :: ListThreadsResponse -> ListThreadsResponse -> Bool
> :: ListThreadsResponse -> ListThreadsResponse -> Bool
$c>= :: ListThreadsResponse -> ListThreadsResponse -> Bool
>= :: ListThreadsResponse -> ListThreadsResponse -> Bool
$cmax :: ListThreadsResponse -> ListThreadsResponse -> ListThreadsResponse
max :: ListThreadsResponse -> ListThreadsResponse -> ListThreadsResponse
$cmin :: ListThreadsResponse -> ListThreadsResponse -> ListThreadsResponse
min :: ListThreadsResponse -> ListThreadsResponse -> ListThreadsResponse
Ord, (forall x. ListThreadsResponse -> Rep ListThreadsResponse x)
-> (forall x. Rep ListThreadsResponse x -> ListThreadsResponse)
-> Generic ListThreadsResponse
forall x. Rep ListThreadsResponse x -> ListThreadsResponse
forall x. ListThreadsResponse -> Rep ListThreadsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListThreadsResponse -> Rep ListThreadsResponse x
from :: forall x. ListThreadsResponse -> Rep ListThreadsResponse x
$cto :: forall x. Rep ListThreadsResponse x -> ListThreadsResponse
to :: forall x. Rep ListThreadsResponse x -> ListThreadsResponse
Generic, Typeable ListThreadsResponse
Typeable ListThreadsResponse =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ListThreadsResponse
 -> c ListThreadsResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ListThreadsResponse)
-> (ListThreadsResponse -> Constr)
-> (ListThreadsResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ListThreadsResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListThreadsResponse))
-> ((forall b. Data b => b -> b)
    -> ListThreadsResponse -> ListThreadsResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ListThreadsResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ListThreadsResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ListThreadsResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ListThreadsResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ListThreadsResponse -> m ListThreadsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListThreadsResponse -> m ListThreadsResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ListThreadsResponse -> m ListThreadsResponse)
-> Data ListThreadsResponse
ListThreadsResponse -> Constr
ListThreadsResponse -> DataType
(forall b. Data b => b -> b)
-> ListThreadsResponse -> ListThreadsResponse
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ListThreadsResponse -> u
forall u.
(forall d. Data d => d -> u) -> ListThreadsResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListThreadsResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListThreadsResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListThreadsResponse -> m ListThreadsResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListThreadsResponse -> m ListThreadsResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListThreadsResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListThreadsResponse
-> c ListThreadsResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListThreadsResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListThreadsResponse)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListThreadsResponse
-> c ListThreadsResponse
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ListThreadsResponse
-> c ListThreadsResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListThreadsResponse
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListThreadsResponse
$ctoConstr :: ListThreadsResponse -> Constr
toConstr :: ListThreadsResponse -> Constr
$cdataTypeOf :: ListThreadsResponse -> DataType
dataTypeOf :: ListThreadsResponse -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListThreadsResponse)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListThreadsResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListThreadsResponse)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListThreadsResponse)
$cgmapT :: (forall b. Data b => b -> b)
-> ListThreadsResponse -> ListThreadsResponse
gmapT :: (forall b. Data b => b -> b)
-> ListThreadsResponse -> ListThreadsResponse
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListThreadsResponse -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListThreadsResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListThreadsResponse -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListThreadsResponse -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ListThreadsResponse -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ListThreadsResponse -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListThreadsResponse -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListThreadsResponse -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListThreadsResponse -> m ListThreadsResponse
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListThreadsResponse -> m ListThreadsResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListThreadsResponse -> m ListThreadsResponse
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListThreadsResponse -> m ListThreadsResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListThreadsResponse -> m ListThreadsResponse
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListThreadsResponse -> m ListThreadsResponse
Data)

instance FromJSON ListThreadsResponse where
  parseJSON :: Value -> Parser ListThreadsResponse
parseJSON = Options -> Value -> Parser ListThreadsResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"listThreadsResponse")
instance ToJSON ListThreadsResponse where
  toJSON :: ListThreadsResponse -> Value
toJSON = Options -> ListThreadsResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"listThreadsResponse")


-- | References an image [File](/docs/api-reference/files) in the content of a message.
data MessageContentImageFileObject = MessageContentImageFileObject
  { MessageContentImageFileObject -> Text
messageContentImageFileObjectType :: Text -- ^ Always `image_file`.
  , MessageContentImageFileObject
-> MessageContentImageFileObjectImageFile
messageContentImageFileObjectImageUnderscorefile :: MessageContentImageFileObjectImageFile -- ^ 
  } deriving (Int -> MessageContentImageFileObject -> ShowS
[MessageContentImageFileObject] -> ShowS
MessageContentImageFileObject -> String
(Int -> MessageContentImageFileObject -> ShowS)
-> (MessageContentImageFileObject -> String)
-> ([MessageContentImageFileObject] -> ShowS)
-> Show MessageContentImageFileObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageContentImageFileObject -> ShowS
showsPrec :: Int -> MessageContentImageFileObject -> ShowS
$cshow :: MessageContentImageFileObject -> String
show :: MessageContentImageFileObject -> String
$cshowList :: [MessageContentImageFileObject] -> ShowS
showList :: [MessageContentImageFileObject] -> ShowS
Show, MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
(MessageContentImageFileObject
 -> MessageContentImageFileObject -> Bool)
-> (MessageContentImageFileObject
    -> MessageContentImageFileObject -> Bool)
-> Eq MessageContentImageFileObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
== :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
$c/= :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
/= :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
Eq, Eq MessageContentImageFileObject
Eq MessageContentImageFileObject =>
(MessageContentImageFileObject
 -> MessageContentImageFileObject -> Ordering)
-> (MessageContentImageFileObject
    -> MessageContentImageFileObject -> Bool)
-> (MessageContentImageFileObject
    -> MessageContentImageFileObject -> Bool)
-> (MessageContentImageFileObject
    -> MessageContentImageFileObject -> Bool)
-> (MessageContentImageFileObject
    -> MessageContentImageFileObject -> Bool)
-> (MessageContentImageFileObject
    -> MessageContentImageFileObject -> MessageContentImageFileObject)
-> (MessageContentImageFileObject
    -> MessageContentImageFileObject -> MessageContentImageFileObject)
-> Ord MessageContentImageFileObject
MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
MessageContentImageFileObject
-> MessageContentImageFileObject -> Ordering
MessageContentImageFileObject
-> MessageContentImageFileObject -> MessageContentImageFileObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Ordering
compare :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Ordering
$c< :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
< :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
$c<= :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
<= :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
$c> :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
> :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
$c>= :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
>= :: MessageContentImageFileObject
-> MessageContentImageFileObject -> Bool
$cmax :: MessageContentImageFileObject
-> MessageContentImageFileObject -> MessageContentImageFileObject
max :: MessageContentImageFileObject
-> MessageContentImageFileObject -> MessageContentImageFileObject
$cmin :: MessageContentImageFileObject
-> MessageContentImageFileObject -> MessageContentImageFileObject
min :: MessageContentImageFileObject
-> MessageContentImageFileObject -> MessageContentImageFileObject
Ord, (forall x.
 MessageContentImageFileObject
 -> Rep MessageContentImageFileObject x)
-> (forall x.
    Rep MessageContentImageFileObject x
    -> MessageContentImageFileObject)
-> Generic MessageContentImageFileObject
forall x.
Rep MessageContentImageFileObject x
-> MessageContentImageFileObject
forall x.
MessageContentImageFileObject
-> Rep MessageContentImageFileObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MessageContentImageFileObject
-> Rep MessageContentImageFileObject x
from :: forall x.
MessageContentImageFileObject
-> Rep MessageContentImageFileObject x
$cto :: forall x.
Rep MessageContentImageFileObject x
-> MessageContentImageFileObject
to :: forall x.
Rep MessageContentImageFileObject x
-> MessageContentImageFileObject
Generic, Typeable MessageContentImageFileObject
Typeable MessageContentImageFileObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageContentImageFileObject
 -> c MessageContentImageFileObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c MessageContentImageFileObject)
-> (MessageContentImageFileObject -> Constr)
-> (MessageContentImageFileObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c MessageContentImageFileObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageContentImageFileObject))
-> ((forall b. Data b => b -> b)
    -> MessageContentImageFileObject -> MessageContentImageFileObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentImageFileObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentImageFileObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> MessageContentImageFileObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> MessageContentImageFileObject
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageContentImageFileObject
    -> m MessageContentImageFileObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentImageFileObject
    -> m MessageContentImageFileObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentImageFileObject
    -> m MessageContentImageFileObject)
-> Data MessageContentImageFileObject
MessageContentImageFileObject -> Constr
MessageContentImageFileObject -> DataType
(forall b. Data b => b -> b)
-> MessageContentImageFileObject -> MessageContentImageFileObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentImageFileObject
-> u
forall u.
(forall d. Data d => d -> u)
-> MessageContentImageFileObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObject -> m MessageContentImageFileObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObject -> m MessageContentImageFileObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentImageFileObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentImageFileObject
-> c MessageContentImageFileObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentImageFileObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentImageFileObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentImageFileObject
-> c MessageContentImageFileObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentImageFileObject
-> c MessageContentImageFileObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentImageFileObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentImageFileObject
$ctoConstr :: MessageContentImageFileObject -> Constr
toConstr :: MessageContentImageFileObject -> Constr
$cdataTypeOf :: MessageContentImageFileObject -> DataType
dataTypeOf :: MessageContentImageFileObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentImageFileObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentImageFileObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentImageFileObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentImageFileObject)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageContentImageFileObject -> MessageContentImageFileObject
gmapT :: (forall b. Data b => b -> b)
-> MessageContentImageFileObject -> MessageContentImageFileObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentImageFileObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentImageFileObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentImageFileObject
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentImageFileObject
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObject -> m MessageContentImageFileObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObject -> m MessageContentImageFileObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObject -> m MessageContentImageFileObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObject -> m MessageContentImageFileObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObject -> m MessageContentImageFileObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObject -> m MessageContentImageFileObject
Data)

instance FromJSON MessageContentImageFileObject where
  parseJSON :: Value -> Parser MessageContentImageFileObject
parseJSON = Options -> Value -> Parser MessageContentImageFileObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageContentImageFileObject")
instance ToJSON MessageContentImageFileObject where
  toJSON :: MessageContentImageFileObject -> Value
toJSON = Options -> MessageContentImageFileObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageContentImageFileObject")


-- | 
data MessageContentImageFileObjectImageFile = MessageContentImageFileObjectImageFile
  { MessageContentImageFileObjectImageFile -> Text
messageContentImageFileObjectImageFileFileUnderscoreid :: Text -- ^ The [File](/docs/api-reference/files) ID of the image in the message content.
  } deriving (Int -> MessageContentImageFileObjectImageFile -> ShowS
[MessageContentImageFileObjectImageFile] -> ShowS
MessageContentImageFileObjectImageFile -> String
(Int -> MessageContentImageFileObjectImageFile -> ShowS)
-> (MessageContentImageFileObjectImageFile -> String)
-> ([MessageContentImageFileObjectImageFile] -> ShowS)
-> Show MessageContentImageFileObjectImageFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageContentImageFileObjectImageFile -> ShowS
showsPrec :: Int -> MessageContentImageFileObjectImageFile -> ShowS
$cshow :: MessageContentImageFileObjectImageFile -> String
show :: MessageContentImageFileObjectImageFile -> String
$cshowList :: [MessageContentImageFileObjectImageFile] -> ShowS
showList :: [MessageContentImageFileObjectImageFile] -> ShowS
Show, MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
(MessageContentImageFileObjectImageFile
 -> MessageContentImageFileObjectImageFile -> Bool)
-> (MessageContentImageFileObjectImageFile
    -> MessageContentImageFileObjectImageFile -> Bool)
-> Eq MessageContentImageFileObjectImageFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
== :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
$c/= :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
/= :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
Eq, Eq MessageContentImageFileObjectImageFile
Eq MessageContentImageFileObjectImageFile =>
(MessageContentImageFileObjectImageFile
 -> MessageContentImageFileObjectImageFile -> Ordering)
-> (MessageContentImageFileObjectImageFile
    -> MessageContentImageFileObjectImageFile -> Bool)
-> (MessageContentImageFileObjectImageFile
    -> MessageContentImageFileObjectImageFile -> Bool)
-> (MessageContentImageFileObjectImageFile
    -> MessageContentImageFileObjectImageFile -> Bool)
-> (MessageContentImageFileObjectImageFile
    -> MessageContentImageFileObjectImageFile -> Bool)
-> (MessageContentImageFileObjectImageFile
    -> MessageContentImageFileObjectImageFile
    -> MessageContentImageFileObjectImageFile)
-> (MessageContentImageFileObjectImageFile
    -> MessageContentImageFileObjectImageFile
    -> MessageContentImageFileObjectImageFile)
-> Ord MessageContentImageFileObjectImageFile
MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Ordering
MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Ordering
compare :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Ordering
$c< :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
< :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
$c<= :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
<= :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
$c> :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
> :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
$c>= :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
>= :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile -> Bool
$cmax :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
max :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
$cmin :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
min :: MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
Ord, (forall x.
 MessageContentImageFileObjectImageFile
 -> Rep MessageContentImageFileObjectImageFile x)
-> (forall x.
    Rep MessageContentImageFileObjectImageFile x
    -> MessageContentImageFileObjectImageFile)
-> Generic MessageContentImageFileObjectImageFile
forall x.
Rep MessageContentImageFileObjectImageFile x
-> MessageContentImageFileObjectImageFile
forall x.
MessageContentImageFileObjectImageFile
-> Rep MessageContentImageFileObjectImageFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MessageContentImageFileObjectImageFile
-> Rep MessageContentImageFileObjectImageFile x
from :: forall x.
MessageContentImageFileObjectImageFile
-> Rep MessageContentImageFileObjectImageFile x
$cto :: forall x.
Rep MessageContentImageFileObjectImageFile x
-> MessageContentImageFileObjectImageFile
to :: forall x.
Rep MessageContentImageFileObjectImageFile x
-> MessageContentImageFileObjectImageFile
Generic, Typeable MessageContentImageFileObjectImageFile
Typeable MessageContentImageFileObjectImageFile =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageContentImageFileObjectImageFile
 -> c MessageContentImageFileObjectImageFile)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c MessageContentImageFileObjectImageFile)
-> (MessageContentImageFileObjectImageFile -> Constr)
-> (MessageContentImageFileObjectImageFile -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c MessageContentImageFileObjectImageFile))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageContentImageFileObjectImageFile))
-> ((forall b. Data b => b -> b)
    -> MessageContentImageFileObjectImageFile
    -> MessageContentImageFileObjectImageFile)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentImageFileObjectImageFile
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentImageFileObjectImageFile
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> MessageContentImageFileObjectImageFile -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> MessageContentImageFileObjectImageFile
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageContentImageFileObjectImageFile
    -> m MessageContentImageFileObjectImageFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentImageFileObjectImageFile
    -> m MessageContentImageFileObjectImageFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentImageFileObjectImageFile
    -> m MessageContentImageFileObjectImageFile)
-> Data MessageContentImageFileObjectImageFile
MessageContentImageFileObjectImageFile -> Constr
MessageContentImageFileObjectImageFile -> DataType
(forall b. Data b => b -> b)
-> MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentImageFileObjectImageFile
-> u
forall u.
(forall d. Data d => d -> u)
-> MessageContentImageFileObjectImageFile -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObjectImageFile
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObjectImageFile
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObjectImageFile
-> m MessageContentImageFileObjectImageFile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObjectImageFile
-> m MessageContentImageFileObjectImageFile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentImageFileObjectImageFile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentImageFileObjectImageFile
-> c MessageContentImageFileObjectImageFile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentImageFileObjectImageFile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentImageFileObjectImageFile)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentImageFileObjectImageFile
-> c MessageContentImageFileObjectImageFile
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentImageFileObjectImageFile
-> c MessageContentImageFileObjectImageFile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentImageFileObjectImageFile
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentImageFileObjectImageFile
$ctoConstr :: MessageContentImageFileObjectImageFile -> Constr
toConstr :: MessageContentImageFileObjectImageFile -> Constr
$cdataTypeOf :: MessageContentImageFileObjectImageFile -> DataType
dataTypeOf :: MessageContentImageFileObjectImageFile -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentImageFileObjectImageFile)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentImageFileObjectImageFile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentImageFileObjectImageFile)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentImageFileObjectImageFile)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
gmapT :: (forall b. Data b => b -> b)
-> MessageContentImageFileObjectImageFile
-> MessageContentImageFileObjectImageFile
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObjectImageFile
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObjectImageFile
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObjectImageFile
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentImageFileObjectImageFile
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentImageFileObjectImageFile -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentImageFileObjectImageFile -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentImageFileObjectImageFile
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentImageFileObjectImageFile
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObjectImageFile
-> m MessageContentImageFileObjectImageFile
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObjectImageFile
-> m MessageContentImageFileObjectImageFile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObjectImageFile
-> m MessageContentImageFileObjectImageFile
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObjectImageFile
-> m MessageContentImageFileObjectImageFile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObjectImageFile
-> m MessageContentImageFileObjectImageFile
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentImageFileObjectImageFile
-> m MessageContentImageFileObjectImageFile
Data)

instance FromJSON MessageContentImageFileObjectImageFile where
  parseJSON :: Value -> Parser MessageContentImageFileObjectImageFile
parseJSON = Options -> Value -> Parser MessageContentImageFileObjectImageFile
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageContentImageFileObjectImageFile")
instance ToJSON MessageContentImageFileObjectImageFile where
  toJSON :: MessageContentImageFileObjectImageFile -> Value
toJSON = Options -> MessageContentImageFileObjectImageFile -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageContentImageFileObjectImageFile")


-- | A citation within the message that points to a specific quote from a specific File associated with the assistant or the message. Generated when the assistant uses the \&quot;retrieval\&quot; tool to search files.
data MessageContentTextAnnotationsFileCitationObject = MessageContentTextAnnotationsFileCitationObject
  { MessageContentTextAnnotationsFileCitationObject -> Text
messageContentTextAnnotationsFileCitationObjectType :: Text -- ^ Always `file_citation`.
  , MessageContentTextAnnotationsFileCitationObject -> Text
messageContentTextAnnotationsFileCitationObjectText :: Text -- ^ The text in the message content that needs to be replaced.
  , MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
messageContentTextAnnotationsFileCitationObjectFileUnderscorecitation :: MessageContentTextAnnotationsFileCitationObjectFileCitation -- ^ 
  , MessageContentTextAnnotationsFileCitationObject -> Int
messageContentTextAnnotationsFileCitationObjectStartUnderscoreindex :: Int -- ^ 
  , MessageContentTextAnnotationsFileCitationObject -> Int
messageContentTextAnnotationsFileCitationObjectEndUnderscoreindex :: Int -- ^ 
  } deriving (Int -> MessageContentTextAnnotationsFileCitationObject -> ShowS
[MessageContentTextAnnotationsFileCitationObject] -> ShowS
MessageContentTextAnnotationsFileCitationObject -> String
(Int -> MessageContentTextAnnotationsFileCitationObject -> ShowS)
-> (MessageContentTextAnnotationsFileCitationObject -> String)
-> ([MessageContentTextAnnotationsFileCitationObject] -> ShowS)
-> Show MessageContentTextAnnotationsFileCitationObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageContentTextAnnotationsFileCitationObject -> ShowS
showsPrec :: Int -> MessageContentTextAnnotationsFileCitationObject -> ShowS
$cshow :: MessageContentTextAnnotationsFileCitationObject -> String
show :: MessageContentTextAnnotationsFileCitationObject -> String
$cshowList :: [MessageContentTextAnnotationsFileCitationObject] -> ShowS
showList :: [MessageContentTextAnnotationsFileCitationObject] -> ShowS
Show, MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
(MessageContentTextAnnotationsFileCitationObject
 -> MessageContentTextAnnotationsFileCitationObject -> Bool)
-> (MessageContentTextAnnotationsFileCitationObject
    -> MessageContentTextAnnotationsFileCitationObject -> Bool)
-> Eq MessageContentTextAnnotationsFileCitationObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
== :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
$c/= :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
/= :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
Eq, Eq MessageContentTextAnnotationsFileCitationObject
Eq MessageContentTextAnnotationsFileCitationObject =>
(MessageContentTextAnnotationsFileCitationObject
 -> MessageContentTextAnnotationsFileCitationObject -> Ordering)
-> (MessageContentTextAnnotationsFileCitationObject
    -> MessageContentTextAnnotationsFileCitationObject -> Bool)
-> (MessageContentTextAnnotationsFileCitationObject
    -> MessageContentTextAnnotationsFileCitationObject -> Bool)
-> (MessageContentTextAnnotationsFileCitationObject
    -> MessageContentTextAnnotationsFileCitationObject -> Bool)
-> (MessageContentTextAnnotationsFileCitationObject
    -> MessageContentTextAnnotationsFileCitationObject -> Bool)
-> (MessageContentTextAnnotationsFileCitationObject
    -> MessageContentTextAnnotationsFileCitationObject
    -> MessageContentTextAnnotationsFileCitationObject)
-> (MessageContentTextAnnotationsFileCitationObject
    -> MessageContentTextAnnotationsFileCitationObject
    -> MessageContentTextAnnotationsFileCitationObject)
-> Ord MessageContentTextAnnotationsFileCitationObject
MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Ordering
MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Ordering
compare :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Ordering
$c< :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
< :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
$c<= :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
<= :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
$c> :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
> :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
$c>= :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
>= :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject -> Bool
$cmax :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
max :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
$cmin :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
min :: MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
Ord, (forall x.
 MessageContentTextAnnotationsFileCitationObject
 -> Rep MessageContentTextAnnotationsFileCitationObject x)
-> (forall x.
    Rep MessageContentTextAnnotationsFileCitationObject x
    -> MessageContentTextAnnotationsFileCitationObject)
-> Generic MessageContentTextAnnotationsFileCitationObject
forall x.
Rep MessageContentTextAnnotationsFileCitationObject x
-> MessageContentTextAnnotationsFileCitationObject
forall x.
MessageContentTextAnnotationsFileCitationObject
-> Rep MessageContentTextAnnotationsFileCitationObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MessageContentTextAnnotationsFileCitationObject
-> Rep MessageContentTextAnnotationsFileCitationObject x
from :: forall x.
MessageContentTextAnnotationsFileCitationObject
-> Rep MessageContentTextAnnotationsFileCitationObject x
$cto :: forall x.
Rep MessageContentTextAnnotationsFileCitationObject x
-> MessageContentTextAnnotationsFileCitationObject
to :: forall x.
Rep MessageContentTextAnnotationsFileCitationObject x
-> MessageContentTextAnnotationsFileCitationObject
Generic, Typeable MessageContentTextAnnotationsFileCitationObject
Typeable MessageContentTextAnnotationsFileCitationObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageContentTextAnnotationsFileCitationObject
 -> c MessageContentTextAnnotationsFileCitationObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c MessageContentTextAnnotationsFileCitationObject)
-> (MessageContentTextAnnotationsFileCitationObject -> Constr)
-> (MessageContentTextAnnotationsFileCitationObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c MessageContentTextAnnotationsFileCitationObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageContentTextAnnotationsFileCitationObject))
-> ((forall b. Data b => b -> b)
    -> MessageContentTextAnnotationsFileCitationObject
    -> MessageContentTextAnnotationsFileCitationObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextAnnotationsFileCitationObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextAnnotationsFileCitationObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> MessageContentTextAnnotationsFileCitationObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> MessageContentTextAnnotationsFileCitationObject
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFileCitationObject
    -> m MessageContentTextAnnotationsFileCitationObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFileCitationObject
    -> m MessageContentTextAnnotationsFileCitationObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFileCitationObject
    -> m MessageContentTextAnnotationsFileCitationObject)
-> Data MessageContentTextAnnotationsFileCitationObject
MessageContentTextAnnotationsFileCitationObject -> Constr
MessageContentTextAnnotationsFileCitationObject -> DataType
(forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObject
-> u
forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObject
-> m MessageContentTextAnnotationsFileCitationObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObject
-> m MessageContentTextAnnotationsFileCitationObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFileCitationObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFileCitationObject
-> c MessageContentTextAnnotationsFileCitationObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextAnnotationsFileCitationObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextAnnotationsFileCitationObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFileCitationObject
-> c MessageContentTextAnnotationsFileCitationObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFileCitationObject
-> c MessageContentTextAnnotationsFileCitationObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFileCitationObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFileCitationObject
$ctoConstr :: MessageContentTextAnnotationsFileCitationObject -> Constr
toConstr :: MessageContentTextAnnotationsFileCitationObject -> Constr
$cdataTypeOf :: MessageContentTextAnnotationsFileCitationObject -> DataType
dataTypeOf :: MessageContentTextAnnotationsFileCitationObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextAnnotationsFileCitationObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextAnnotationsFileCitationObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextAnnotationsFileCitationObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextAnnotationsFileCitationObject)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
gmapT :: (forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFileCitationObject
-> MessageContentTextAnnotationsFileCitationObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObject
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObject
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObject
-> m MessageContentTextAnnotationsFileCitationObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObject
-> m MessageContentTextAnnotationsFileCitationObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObject
-> m MessageContentTextAnnotationsFileCitationObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObject
-> m MessageContentTextAnnotationsFileCitationObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObject
-> m MessageContentTextAnnotationsFileCitationObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObject
-> m MessageContentTextAnnotationsFileCitationObject
Data)

instance FromJSON MessageContentTextAnnotationsFileCitationObject where
  parseJSON :: Value -> Parser MessageContentTextAnnotationsFileCitationObject
parseJSON = Options
-> Value -> Parser MessageContentTextAnnotationsFileCitationObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextAnnotationsFileCitationObject")
instance ToJSON MessageContentTextAnnotationsFileCitationObject where
  toJSON :: MessageContentTextAnnotationsFileCitationObject -> Value
toJSON = Options -> MessageContentTextAnnotationsFileCitationObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextAnnotationsFileCitationObject")


-- | 
data MessageContentTextAnnotationsFileCitationObjectFileCitation = MessageContentTextAnnotationsFileCitationObjectFileCitation
  { MessageContentTextAnnotationsFileCitationObjectFileCitation -> Text
messageContentTextAnnotationsFileCitationObjectFileCitationFileUnderscoreid :: Text -- ^ The ID of the specific File the citation is from.
  , MessageContentTextAnnotationsFileCitationObjectFileCitation -> Text
messageContentTextAnnotationsFileCitationObjectFileCitationQuote :: Text -- ^ The specific quote in the file.
  } deriving (Int
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> ShowS
[MessageContentTextAnnotationsFileCitationObjectFileCitation]
-> ShowS
MessageContentTextAnnotationsFileCitationObjectFileCitation
-> String
(Int
 -> MessageContentTextAnnotationsFileCitationObjectFileCitation
 -> ShowS)
-> (MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> String)
-> ([MessageContentTextAnnotationsFileCitationObjectFileCitation]
    -> ShowS)
-> Show MessageContentTextAnnotationsFileCitationObjectFileCitation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> ShowS
showsPrec :: Int
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> ShowS
$cshow :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> String
show :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> String
$cshowList :: [MessageContentTextAnnotationsFileCitationObjectFileCitation]
-> ShowS
showList :: [MessageContentTextAnnotationsFileCitationObjectFileCitation]
-> ShowS
Show, MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
(MessageContentTextAnnotationsFileCitationObjectFileCitation
 -> MessageContentTextAnnotationsFileCitationObjectFileCitation
 -> Bool)
-> (MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> Bool)
-> Eq MessageContentTextAnnotationsFileCitationObjectFileCitation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
== :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
$c/= :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
/= :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
Eq, Eq MessageContentTextAnnotationsFileCitationObjectFileCitation
Eq MessageContentTextAnnotationsFileCitationObjectFileCitation =>
(MessageContentTextAnnotationsFileCitationObjectFileCitation
 -> MessageContentTextAnnotationsFileCitationObjectFileCitation
 -> Ordering)
-> (MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> Bool)
-> (MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> Bool)
-> (MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> Bool)
-> (MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> Bool)
-> (MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation)
-> (MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation)
-> Ord MessageContentTextAnnotationsFileCitationObjectFileCitation
MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Ordering
MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Ordering
compare :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Ordering
$c< :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
< :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
$c<= :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
<= :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
$c> :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
> :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
$c>= :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
>= :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Bool
$cmax :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
max :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
$cmin :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
min :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
Ord, (forall x.
 MessageContentTextAnnotationsFileCitationObjectFileCitation
 -> Rep
      MessageContentTextAnnotationsFileCitationObjectFileCitation x)
-> (forall x.
    Rep MessageContentTextAnnotationsFileCitationObjectFileCitation x
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation)
-> Generic
     MessageContentTextAnnotationsFileCitationObjectFileCitation
forall x.
Rep MessageContentTextAnnotationsFileCitationObjectFileCitation x
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
forall x.
MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Rep
     MessageContentTextAnnotationsFileCitationObjectFileCitation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Rep
     MessageContentTextAnnotationsFileCitationObjectFileCitation x
from :: forall x.
MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Rep
     MessageContentTextAnnotationsFileCitationObjectFileCitation x
$cto :: forall x.
Rep MessageContentTextAnnotationsFileCitationObjectFileCitation x
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
to :: forall x.
Rep MessageContentTextAnnotationsFileCitationObjectFileCitation x
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
Generic, Typeable
  MessageContentTextAnnotationsFileCitationObjectFileCitation
Typeable
  MessageContentTextAnnotationsFileCitationObjectFileCitation =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageContentTextAnnotationsFileCitationObjectFileCitation
 -> c MessageContentTextAnnotationsFileCitationObjectFileCitation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c MessageContentTextAnnotationsFileCitationObjectFileCitation)
-> (MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> Constr)
-> (MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe
         (c MessageContentTextAnnotationsFileCitationObjectFileCitation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe
         (c MessageContentTextAnnotationsFileCitationObjectFileCitation))
-> ((forall b. Data b => b -> b)
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> m MessageContentTextAnnotationsFileCitationObjectFileCitation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> m MessageContentTextAnnotationsFileCitationObjectFileCitation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFileCitationObjectFileCitation
    -> m MessageContentTextAnnotationsFileCitationObjectFileCitation)
-> Data MessageContentTextAnnotationsFileCitationObjectFileCitation
MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Constr
MessageContentTextAnnotationsFileCitationObjectFileCitation
-> DataType
(forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> u
forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> m MessageContentTextAnnotationsFileCitationObjectFileCitation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> m MessageContentTextAnnotationsFileCitationObjectFileCitation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFileCitationObjectFileCitation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> c MessageContentTextAnnotationsFileCitationObjectFileCitation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c MessageContentTextAnnotationsFileCitationObjectFileCitation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c MessageContentTextAnnotationsFileCitationObjectFileCitation)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> c MessageContentTextAnnotationsFileCitationObjectFileCitation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> c MessageContentTextAnnotationsFileCitationObjectFileCitation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFileCitationObjectFileCitation
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFileCitationObjectFileCitation
$ctoConstr :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Constr
toConstr :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Constr
$cdataTypeOf :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> DataType
dataTypeOf :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c MessageContentTextAnnotationsFileCitationObjectFileCitation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c MessageContentTextAnnotationsFileCitationObjectFileCitation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c MessageContentTextAnnotationsFileCitationObjectFileCitation)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c MessageContentTextAnnotationsFileCitationObjectFileCitation)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
gmapT :: (forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> m MessageContentTextAnnotationsFileCitationObjectFileCitation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> m MessageContentTextAnnotationsFileCitationObjectFileCitation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> m MessageContentTextAnnotationsFileCitationObjectFileCitation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> m MessageContentTextAnnotationsFileCitationObjectFileCitation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> m MessageContentTextAnnotationsFileCitationObjectFileCitation
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> m MessageContentTextAnnotationsFileCitationObjectFileCitation
Data)

instance FromJSON MessageContentTextAnnotationsFileCitationObjectFileCitation where
  parseJSON :: Value
-> Parser
     MessageContentTextAnnotationsFileCitationObjectFileCitation
parseJSON = Options
-> Value
-> Parser
     MessageContentTextAnnotationsFileCitationObjectFileCitation
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextAnnotationsFileCitationObjectFileCitation")
instance ToJSON MessageContentTextAnnotationsFileCitationObjectFileCitation where
  toJSON :: MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Value
toJSON = Options
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
-> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextAnnotationsFileCitationObjectFileCitation")


-- | A URL for the file that&#39;s generated when the assistant used the &#x60;code_interpreter&#x60; tool to generate a file.
data MessageContentTextAnnotationsFilePathObject = MessageContentTextAnnotationsFilePathObject
  { MessageContentTextAnnotationsFilePathObject -> Text
messageContentTextAnnotationsFilePathObjectType :: Text -- ^ Always `file_path`.
  , MessageContentTextAnnotationsFilePathObject -> Text
messageContentTextAnnotationsFilePathObjectText :: Text -- ^ The text in the message content that needs to be replaced.
  , MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObjectFilePath
messageContentTextAnnotationsFilePathObjectFileUnderscorepath :: MessageContentTextAnnotationsFilePathObjectFilePath -- ^ 
  , MessageContentTextAnnotationsFilePathObject -> Int
messageContentTextAnnotationsFilePathObjectStartUnderscoreindex :: Int -- ^ 
  , MessageContentTextAnnotationsFilePathObject -> Int
messageContentTextAnnotationsFilePathObjectEndUnderscoreindex :: Int -- ^ 
  } deriving (Int -> MessageContentTextAnnotationsFilePathObject -> ShowS
[MessageContentTextAnnotationsFilePathObject] -> ShowS
MessageContentTextAnnotationsFilePathObject -> String
(Int -> MessageContentTextAnnotationsFilePathObject -> ShowS)
-> (MessageContentTextAnnotationsFilePathObject -> String)
-> ([MessageContentTextAnnotationsFilePathObject] -> ShowS)
-> Show MessageContentTextAnnotationsFilePathObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageContentTextAnnotationsFilePathObject -> ShowS
showsPrec :: Int -> MessageContentTextAnnotationsFilePathObject -> ShowS
$cshow :: MessageContentTextAnnotationsFilePathObject -> String
show :: MessageContentTextAnnotationsFilePathObject -> String
$cshowList :: [MessageContentTextAnnotationsFilePathObject] -> ShowS
showList :: [MessageContentTextAnnotationsFilePathObject] -> ShowS
Show, MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
(MessageContentTextAnnotationsFilePathObject
 -> MessageContentTextAnnotationsFilePathObject -> Bool)
-> (MessageContentTextAnnotationsFilePathObject
    -> MessageContentTextAnnotationsFilePathObject -> Bool)
-> Eq MessageContentTextAnnotationsFilePathObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
== :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
$c/= :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
/= :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
Eq, Eq MessageContentTextAnnotationsFilePathObject
Eq MessageContentTextAnnotationsFilePathObject =>
(MessageContentTextAnnotationsFilePathObject
 -> MessageContentTextAnnotationsFilePathObject -> Ordering)
-> (MessageContentTextAnnotationsFilePathObject
    -> MessageContentTextAnnotationsFilePathObject -> Bool)
-> (MessageContentTextAnnotationsFilePathObject
    -> MessageContentTextAnnotationsFilePathObject -> Bool)
-> (MessageContentTextAnnotationsFilePathObject
    -> MessageContentTextAnnotationsFilePathObject -> Bool)
-> (MessageContentTextAnnotationsFilePathObject
    -> MessageContentTextAnnotationsFilePathObject -> Bool)
-> (MessageContentTextAnnotationsFilePathObject
    -> MessageContentTextAnnotationsFilePathObject
    -> MessageContentTextAnnotationsFilePathObject)
-> (MessageContentTextAnnotationsFilePathObject
    -> MessageContentTextAnnotationsFilePathObject
    -> MessageContentTextAnnotationsFilePathObject)
-> Ord MessageContentTextAnnotationsFilePathObject
MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Ordering
MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Ordering
compare :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Ordering
$c< :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
< :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
$c<= :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
<= :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
$c> :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
> :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
$c>= :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
>= :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject -> Bool
$cmax :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
max :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
$cmin :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
min :: MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
Ord, (forall x.
 MessageContentTextAnnotationsFilePathObject
 -> Rep MessageContentTextAnnotationsFilePathObject x)
-> (forall x.
    Rep MessageContentTextAnnotationsFilePathObject x
    -> MessageContentTextAnnotationsFilePathObject)
-> Generic MessageContentTextAnnotationsFilePathObject
forall x.
Rep MessageContentTextAnnotationsFilePathObject x
-> MessageContentTextAnnotationsFilePathObject
forall x.
MessageContentTextAnnotationsFilePathObject
-> Rep MessageContentTextAnnotationsFilePathObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MessageContentTextAnnotationsFilePathObject
-> Rep MessageContentTextAnnotationsFilePathObject x
from :: forall x.
MessageContentTextAnnotationsFilePathObject
-> Rep MessageContentTextAnnotationsFilePathObject x
$cto :: forall x.
Rep MessageContentTextAnnotationsFilePathObject x
-> MessageContentTextAnnotationsFilePathObject
to :: forall x.
Rep MessageContentTextAnnotationsFilePathObject x
-> MessageContentTextAnnotationsFilePathObject
Generic, Typeable MessageContentTextAnnotationsFilePathObject
Typeable MessageContentTextAnnotationsFilePathObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageContentTextAnnotationsFilePathObject
 -> c MessageContentTextAnnotationsFilePathObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c MessageContentTextAnnotationsFilePathObject)
-> (MessageContentTextAnnotationsFilePathObject -> Constr)
-> (MessageContentTextAnnotationsFilePathObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c MessageContentTextAnnotationsFilePathObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageContentTextAnnotationsFilePathObject))
-> ((forall b. Data b => b -> b)
    -> MessageContentTextAnnotationsFilePathObject
    -> MessageContentTextAnnotationsFilePathObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextAnnotationsFilePathObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextAnnotationsFilePathObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> MessageContentTextAnnotationsFilePathObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> MessageContentTextAnnotationsFilePathObject
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFilePathObject
    -> m MessageContentTextAnnotationsFilePathObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFilePathObject
    -> m MessageContentTextAnnotationsFilePathObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFilePathObject
    -> m MessageContentTextAnnotationsFilePathObject)
-> Data MessageContentTextAnnotationsFilePathObject
MessageContentTextAnnotationsFilePathObject -> Constr
MessageContentTextAnnotationsFilePathObject -> DataType
(forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObject
-> u
forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObject
-> m MessageContentTextAnnotationsFilePathObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObject
-> m MessageContentTextAnnotationsFilePathObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFilePathObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFilePathObject
-> c MessageContentTextAnnotationsFilePathObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextAnnotationsFilePathObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextAnnotationsFilePathObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFilePathObject
-> c MessageContentTextAnnotationsFilePathObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFilePathObject
-> c MessageContentTextAnnotationsFilePathObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFilePathObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFilePathObject
$ctoConstr :: MessageContentTextAnnotationsFilePathObject -> Constr
toConstr :: MessageContentTextAnnotationsFilePathObject -> Constr
$cdataTypeOf :: MessageContentTextAnnotationsFilePathObject -> DataType
dataTypeOf :: MessageContentTextAnnotationsFilePathObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextAnnotationsFilePathObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextAnnotationsFilePathObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextAnnotationsFilePathObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextAnnotationsFilePathObject)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
gmapT :: (forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFilePathObject
-> MessageContentTextAnnotationsFilePathObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObject
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObject
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObject
-> m MessageContentTextAnnotationsFilePathObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObject
-> m MessageContentTextAnnotationsFilePathObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObject
-> m MessageContentTextAnnotationsFilePathObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObject
-> m MessageContentTextAnnotationsFilePathObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObject
-> m MessageContentTextAnnotationsFilePathObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObject
-> m MessageContentTextAnnotationsFilePathObject
Data)

instance FromJSON MessageContentTextAnnotationsFilePathObject where
  parseJSON :: Value -> Parser MessageContentTextAnnotationsFilePathObject
parseJSON = Options
-> Value -> Parser MessageContentTextAnnotationsFilePathObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextAnnotationsFilePathObject")
instance ToJSON MessageContentTextAnnotationsFilePathObject where
  toJSON :: MessageContentTextAnnotationsFilePathObject -> Value
toJSON = Options -> MessageContentTextAnnotationsFilePathObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextAnnotationsFilePathObject")


-- | 
data MessageContentTextAnnotationsFilePathObjectFilePath = MessageContentTextAnnotationsFilePathObjectFilePath
  { MessageContentTextAnnotationsFilePathObjectFilePath -> Text
messageContentTextAnnotationsFilePathObjectFilePathFileUnderscoreid :: Text -- ^ The ID of the file that was generated.
  } deriving (Int -> MessageContentTextAnnotationsFilePathObjectFilePath -> ShowS
[MessageContentTextAnnotationsFilePathObjectFilePath] -> ShowS
MessageContentTextAnnotationsFilePathObjectFilePath -> String
(Int
 -> MessageContentTextAnnotationsFilePathObjectFilePath -> ShowS)
-> (MessageContentTextAnnotationsFilePathObjectFilePath -> String)
-> ([MessageContentTextAnnotationsFilePathObjectFilePath] -> ShowS)
-> Show MessageContentTextAnnotationsFilePathObjectFilePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageContentTextAnnotationsFilePathObjectFilePath -> ShowS
showsPrec :: Int -> MessageContentTextAnnotationsFilePathObjectFilePath -> ShowS
$cshow :: MessageContentTextAnnotationsFilePathObjectFilePath -> String
show :: MessageContentTextAnnotationsFilePathObjectFilePath -> String
$cshowList :: [MessageContentTextAnnotationsFilePathObjectFilePath] -> ShowS
showList :: [MessageContentTextAnnotationsFilePathObjectFilePath] -> ShowS
Show, MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
(MessageContentTextAnnotationsFilePathObjectFilePath
 -> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool)
-> (MessageContentTextAnnotationsFilePathObjectFilePath
    -> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool)
-> Eq MessageContentTextAnnotationsFilePathObjectFilePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
== :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
$c/= :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
/= :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
Eq, Eq MessageContentTextAnnotationsFilePathObjectFilePath
Eq MessageContentTextAnnotationsFilePathObjectFilePath =>
(MessageContentTextAnnotationsFilePathObjectFilePath
 -> MessageContentTextAnnotationsFilePathObjectFilePath -> Ordering)
-> (MessageContentTextAnnotationsFilePathObjectFilePath
    -> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool)
-> (MessageContentTextAnnotationsFilePathObjectFilePath
    -> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool)
-> (MessageContentTextAnnotationsFilePathObjectFilePath
    -> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool)
-> (MessageContentTextAnnotationsFilePathObjectFilePath
    -> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool)
-> (MessageContentTextAnnotationsFilePathObjectFilePath
    -> MessageContentTextAnnotationsFilePathObjectFilePath
    -> MessageContentTextAnnotationsFilePathObjectFilePath)
-> (MessageContentTextAnnotationsFilePathObjectFilePath
    -> MessageContentTextAnnotationsFilePathObjectFilePath
    -> MessageContentTextAnnotationsFilePathObjectFilePath)
-> Ord MessageContentTextAnnotationsFilePathObjectFilePath
MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Ordering
MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Ordering
compare :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Ordering
$c< :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
< :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
$c<= :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
<= :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
$c> :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
> :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
$c>= :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
>= :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Bool
$cmax :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
max :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
$cmin :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
min :: MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
Ord, (forall x.
 MessageContentTextAnnotationsFilePathObjectFilePath
 -> Rep MessageContentTextAnnotationsFilePathObjectFilePath x)
-> (forall x.
    Rep MessageContentTextAnnotationsFilePathObjectFilePath x
    -> MessageContentTextAnnotationsFilePathObjectFilePath)
-> Generic MessageContentTextAnnotationsFilePathObjectFilePath
forall x.
Rep MessageContentTextAnnotationsFilePathObjectFilePath x
-> MessageContentTextAnnotationsFilePathObjectFilePath
forall x.
MessageContentTextAnnotationsFilePathObjectFilePath
-> Rep MessageContentTextAnnotationsFilePathObjectFilePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MessageContentTextAnnotationsFilePathObjectFilePath
-> Rep MessageContentTextAnnotationsFilePathObjectFilePath x
from :: forall x.
MessageContentTextAnnotationsFilePathObjectFilePath
-> Rep MessageContentTextAnnotationsFilePathObjectFilePath x
$cto :: forall x.
Rep MessageContentTextAnnotationsFilePathObjectFilePath x
-> MessageContentTextAnnotationsFilePathObjectFilePath
to :: forall x.
Rep MessageContentTextAnnotationsFilePathObjectFilePath x
-> MessageContentTextAnnotationsFilePathObjectFilePath
Generic, Typeable MessageContentTextAnnotationsFilePathObjectFilePath
Typeable MessageContentTextAnnotationsFilePathObjectFilePath =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageContentTextAnnotationsFilePathObjectFilePath
 -> c MessageContentTextAnnotationsFilePathObjectFilePath)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c MessageContentTextAnnotationsFilePathObjectFilePath)
-> (MessageContentTextAnnotationsFilePathObjectFilePath -> Constr)
-> (MessageContentTextAnnotationsFilePathObjectFilePath
    -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c MessageContentTextAnnotationsFilePathObjectFilePath))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageContentTextAnnotationsFilePathObjectFilePath))
-> ((forall b. Data b => b -> b)
    -> MessageContentTextAnnotationsFilePathObjectFilePath
    -> MessageContentTextAnnotationsFilePathObjectFilePath)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextAnnotationsFilePathObjectFilePath
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextAnnotationsFilePathObjectFilePath
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> MessageContentTextAnnotationsFilePathObjectFilePath -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> MessageContentTextAnnotationsFilePathObjectFilePath
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFilePathObjectFilePath
    -> m MessageContentTextAnnotationsFilePathObjectFilePath)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFilePathObjectFilePath
    -> m MessageContentTextAnnotationsFilePathObjectFilePath)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextAnnotationsFilePathObjectFilePath
    -> m MessageContentTextAnnotationsFilePathObjectFilePath)
-> Data MessageContentTextAnnotationsFilePathObjectFilePath
MessageContentTextAnnotationsFilePathObjectFilePath -> Constr
MessageContentTextAnnotationsFilePathObjectFilePath -> DataType
(forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> u
forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObjectFilePath -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> m MessageContentTextAnnotationsFilePathObjectFilePath
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> m MessageContentTextAnnotationsFilePathObjectFilePath
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFilePathObjectFilePath
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> c MessageContentTextAnnotationsFilePathObjectFilePath
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextAnnotationsFilePathObjectFilePath)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextAnnotationsFilePathObjectFilePath)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> c MessageContentTextAnnotationsFilePathObjectFilePath
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> c MessageContentTextAnnotationsFilePathObjectFilePath
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFilePathObjectFilePath
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextAnnotationsFilePathObjectFilePath
$ctoConstr :: MessageContentTextAnnotationsFilePathObjectFilePath -> Constr
toConstr :: MessageContentTextAnnotationsFilePathObjectFilePath -> Constr
$cdataTypeOf :: MessageContentTextAnnotationsFilePathObjectFilePath -> DataType
dataTypeOf :: MessageContentTextAnnotationsFilePathObjectFilePath -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextAnnotationsFilePathObjectFilePath)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextAnnotationsFilePathObjectFilePath)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextAnnotationsFilePathObjectFilePath)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextAnnotationsFilePathObjectFilePath)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
gmapT :: (forall b. Data b => b -> b)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> MessageContentTextAnnotationsFilePathObjectFilePath
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObjectFilePath -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObjectFilePath -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> m MessageContentTextAnnotationsFilePathObjectFilePath
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> m MessageContentTextAnnotationsFilePathObjectFilePath
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> m MessageContentTextAnnotationsFilePathObjectFilePath
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> m MessageContentTextAnnotationsFilePathObjectFilePath
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> m MessageContentTextAnnotationsFilePathObjectFilePath
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextAnnotationsFilePathObjectFilePath
-> m MessageContentTextAnnotationsFilePathObjectFilePath
Data)

instance FromJSON MessageContentTextAnnotationsFilePathObjectFilePath where
  parseJSON :: Value -> Parser MessageContentTextAnnotationsFilePathObjectFilePath
parseJSON = Options
-> Value
-> Parser MessageContentTextAnnotationsFilePathObjectFilePath
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextAnnotationsFilePathObjectFilePath")
instance ToJSON MessageContentTextAnnotationsFilePathObjectFilePath where
  toJSON :: MessageContentTextAnnotationsFilePathObjectFilePath -> Value
toJSON = Options
-> MessageContentTextAnnotationsFilePathObjectFilePath -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextAnnotationsFilePathObjectFilePath")


-- | The text content that is part of a message.
data MessageContentTextObject = MessageContentTextObject
  { MessageContentTextObject -> Text
messageContentTextObjectType :: Text -- ^ Always `text`.
  , MessageContentTextObject -> MessageContentTextObjectText
messageContentTextObjectText :: MessageContentTextObjectText -- ^ 
  } deriving (Int -> MessageContentTextObject -> ShowS
[MessageContentTextObject] -> ShowS
MessageContentTextObject -> String
(Int -> MessageContentTextObject -> ShowS)
-> (MessageContentTextObject -> String)
-> ([MessageContentTextObject] -> ShowS)
-> Show MessageContentTextObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageContentTextObject -> ShowS
showsPrec :: Int -> MessageContentTextObject -> ShowS
$cshow :: MessageContentTextObject -> String
show :: MessageContentTextObject -> String
$cshowList :: [MessageContentTextObject] -> ShowS
showList :: [MessageContentTextObject] -> ShowS
Show, MessageContentTextObject -> MessageContentTextObject -> Bool
(MessageContentTextObject -> MessageContentTextObject -> Bool)
-> (MessageContentTextObject -> MessageContentTextObject -> Bool)
-> Eq MessageContentTextObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageContentTextObject -> MessageContentTextObject -> Bool
== :: MessageContentTextObject -> MessageContentTextObject -> Bool
$c/= :: MessageContentTextObject -> MessageContentTextObject -> Bool
/= :: MessageContentTextObject -> MessageContentTextObject -> Bool
Eq, Eq MessageContentTextObject
Eq MessageContentTextObject =>
(MessageContentTextObject -> MessageContentTextObject -> Ordering)
-> (MessageContentTextObject -> MessageContentTextObject -> Bool)
-> (MessageContentTextObject -> MessageContentTextObject -> Bool)
-> (MessageContentTextObject -> MessageContentTextObject -> Bool)
-> (MessageContentTextObject -> MessageContentTextObject -> Bool)
-> (MessageContentTextObject
    -> MessageContentTextObject -> MessageContentTextObject)
-> (MessageContentTextObject
    -> MessageContentTextObject -> MessageContentTextObject)
-> Ord MessageContentTextObject
MessageContentTextObject -> MessageContentTextObject -> Bool
MessageContentTextObject -> MessageContentTextObject -> Ordering
MessageContentTextObject
-> MessageContentTextObject -> MessageContentTextObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageContentTextObject -> MessageContentTextObject -> Ordering
compare :: MessageContentTextObject -> MessageContentTextObject -> Ordering
$c< :: MessageContentTextObject -> MessageContentTextObject -> Bool
< :: MessageContentTextObject -> MessageContentTextObject -> Bool
$c<= :: MessageContentTextObject -> MessageContentTextObject -> Bool
<= :: MessageContentTextObject -> MessageContentTextObject -> Bool
$c> :: MessageContentTextObject -> MessageContentTextObject -> Bool
> :: MessageContentTextObject -> MessageContentTextObject -> Bool
$c>= :: MessageContentTextObject -> MessageContentTextObject -> Bool
>= :: MessageContentTextObject -> MessageContentTextObject -> Bool
$cmax :: MessageContentTextObject
-> MessageContentTextObject -> MessageContentTextObject
max :: MessageContentTextObject
-> MessageContentTextObject -> MessageContentTextObject
$cmin :: MessageContentTextObject
-> MessageContentTextObject -> MessageContentTextObject
min :: MessageContentTextObject
-> MessageContentTextObject -> MessageContentTextObject
Ord, (forall x.
 MessageContentTextObject -> Rep MessageContentTextObject x)
-> (forall x.
    Rep MessageContentTextObject x -> MessageContentTextObject)
-> Generic MessageContentTextObject
forall x.
Rep MessageContentTextObject x -> MessageContentTextObject
forall x.
MessageContentTextObject -> Rep MessageContentTextObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MessageContentTextObject -> Rep MessageContentTextObject x
from :: forall x.
MessageContentTextObject -> Rep MessageContentTextObject x
$cto :: forall x.
Rep MessageContentTextObject x -> MessageContentTextObject
to :: forall x.
Rep MessageContentTextObject x -> MessageContentTextObject
Generic, Typeable MessageContentTextObject
Typeable MessageContentTextObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageContentTextObject
 -> c MessageContentTextObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MessageContentTextObject)
-> (MessageContentTextObject -> Constr)
-> (MessageContentTextObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c MessageContentTextObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageContentTextObject))
-> ((forall b. Data b => b -> b)
    -> MessageContentTextObject -> MessageContentTextObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> MessageContentTextObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> MessageContentTextObject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextObject -> m MessageContentTextObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextObject -> m MessageContentTextObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextObject -> m MessageContentTextObject)
-> Data MessageContentTextObject
MessageContentTextObject -> Constr
MessageContentTextObject -> DataType
(forall b. Data b => b -> b)
-> MessageContentTextObject -> MessageContentTextObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> MessageContentTextObject -> u
forall u.
(forall d. Data d => d -> u) -> MessageContentTextObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObject -> m MessageContentTextObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObject -> m MessageContentTextObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageContentTextObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextObject
-> c MessageContentTextObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageContentTextObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextObject
-> c MessageContentTextObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextObject
-> c MessageContentTextObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageContentTextObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageContentTextObject
$ctoConstr :: MessageContentTextObject -> Constr
toConstr :: MessageContentTextObject -> Constr
$cdataTypeOf :: MessageContentTextObject -> DataType
dataTypeOf :: MessageContentTextObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageContentTextObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageContentTextObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextObject)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageContentTextObject -> MessageContentTextObject
gmapT :: (forall b. Data b => b -> b)
-> MessageContentTextObject -> MessageContentTextObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MessageContentTextObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> MessageContentTextObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> MessageContentTextObject -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> MessageContentTextObject -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObject -> m MessageContentTextObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObject -> m MessageContentTextObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObject -> m MessageContentTextObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObject -> m MessageContentTextObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObject -> m MessageContentTextObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObject -> m MessageContentTextObject
Data)

instance FromJSON MessageContentTextObject where
  parseJSON :: Value -> Parser MessageContentTextObject
parseJSON = Options -> Value -> Parser MessageContentTextObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextObject")
instance ToJSON MessageContentTextObject where
  toJSON :: MessageContentTextObject -> Value
toJSON = Options -> MessageContentTextObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextObject")


-- | 
data MessageContentTextObjectText = MessageContentTextObjectText
  { MessageContentTextObjectText -> Text
messageContentTextObjectTextValue :: Text -- ^ The data that makes up the text.
  , MessageContentTextObjectText
-> [MessageContentTextObjectTextAnnotationsInner]
messageContentTextObjectTextAnnotations :: [MessageContentTextObjectTextAnnotationsInner] -- ^ 
  } deriving (Int -> MessageContentTextObjectText -> ShowS
[MessageContentTextObjectText] -> ShowS
MessageContentTextObjectText -> String
(Int -> MessageContentTextObjectText -> ShowS)
-> (MessageContentTextObjectText -> String)
-> ([MessageContentTextObjectText] -> ShowS)
-> Show MessageContentTextObjectText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageContentTextObjectText -> ShowS
showsPrec :: Int -> MessageContentTextObjectText -> ShowS
$cshow :: MessageContentTextObjectText -> String
show :: MessageContentTextObjectText -> String
$cshowList :: [MessageContentTextObjectText] -> ShowS
showList :: [MessageContentTextObjectText] -> ShowS
Show, MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
(MessageContentTextObjectText
 -> MessageContentTextObjectText -> Bool)
-> (MessageContentTextObjectText
    -> MessageContentTextObjectText -> Bool)
-> Eq MessageContentTextObjectText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
== :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
$c/= :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
/= :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
Eq, Eq MessageContentTextObjectText
Eq MessageContentTextObjectText =>
(MessageContentTextObjectText
 -> MessageContentTextObjectText -> Ordering)
-> (MessageContentTextObjectText
    -> MessageContentTextObjectText -> Bool)
-> (MessageContentTextObjectText
    -> MessageContentTextObjectText -> Bool)
-> (MessageContentTextObjectText
    -> MessageContentTextObjectText -> Bool)
-> (MessageContentTextObjectText
    -> MessageContentTextObjectText -> Bool)
-> (MessageContentTextObjectText
    -> MessageContentTextObjectText -> MessageContentTextObjectText)
-> (MessageContentTextObjectText
    -> MessageContentTextObjectText -> MessageContentTextObjectText)
-> Ord MessageContentTextObjectText
MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
MessageContentTextObjectText
-> MessageContentTextObjectText -> Ordering
MessageContentTextObjectText
-> MessageContentTextObjectText -> MessageContentTextObjectText
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Ordering
compare :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Ordering
$c< :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
< :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
$c<= :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
<= :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
$c> :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
> :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
$c>= :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
>= :: MessageContentTextObjectText
-> MessageContentTextObjectText -> Bool
$cmax :: MessageContentTextObjectText
-> MessageContentTextObjectText -> MessageContentTextObjectText
max :: MessageContentTextObjectText
-> MessageContentTextObjectText -> MessageContentTextObjectText
$cmin :: MessageContentTextObjectText
-> MessageContentTextObjectText -> MessageContentTextObjectText
min :: MessageContentTextObjectText
-> MessageContentTextObjectText -> MessageContentTextObjectText
Ord, (forall x.
 MessageContentTextObjectText -> Rep MessageContentTextObjectText x)
-> (forall x.
    Rep MessageContentTextObjectText x -> MessageContentTextObjectText)
-> Generic MessageContentTextObjectText
forall x.
Rep MessageContentTextObjectText x -> MessageContentTextObjectText
forall x.
MessageContentTextObjectText -> Rep MessageContentTextObjectText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MessageContentTextObjectText -> Rep MessageContentTextObjectText x
from :: forall x.
MessageContentTextObjectText -> Rep MessageContentTextObjectText x
$cto :: forall x.
Rep MessageContentTextObjectText x -> MessageContentTextObjectText
to :: forall x.
Rep MessageContentTextObjectText x -> MessageContentTextObjectText
Generic, Typeable MessageContentTextObjectText
Typeable MessageContentTextObjectText =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageContentTextObjectText
 -> c MessageContentTextObjectText)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c MessageContentTextObjectText)
-> (MessageContentTextObjectText -> Constr)
-> (MessageContentTextObjectText -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c MessageContentTextObjectText))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageContentTextObjectText))
-> ((forall b. Data b => b -> b)
    -> MessageContentTextObjectText -> MessageContentTextObjectText)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextObjectText
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextObjectText
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> MessageContentTextObjectText -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> MessageContentTextObjectText
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextObjectText -> m MessageContentTextObjectText)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextObjectText -> m MessageContentTextObjectText)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextObjectText -> m MessageContentTextObjectText)
-> Data MessageContentTextObjectText
MessageContentTextObjectText -> Constr
MessageContentTextObjectText -> DataType
(forall b. Data b => b -> b)
-> MessageContentTextObjectText -> MessageContentTextObjectText
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextObjectText
-> u
forall u.
(forall d. Data d => d -> u) -> MessageContentTextObjectText -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectText
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectText
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectText -> m MessageContentTextObjectText
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectText -> m MessageContentTextObjectText
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageContentTextObjectText
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextObjectText
-> c MessageContentTextObjectText
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextObjectText)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextObjectText)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextObjectText
-> c MessageContentTextObjectText
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextObjectText
-> c MessageContentTextObjectText
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageContentTextObjectText
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageContentTextObjectText
$ctoConstr :: MessageContentTextObjectText -> Constr
toConstr :: MessageContentTextObjectText -> Constr
$cdataTypeOf :: MessageContentTextObjectText -> DataType
dataTypeOf :: MessageContentTextObjectText -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextObjectText)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextObjectText)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextObjectText)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextObjectText)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageContentTextObjectText -> MessageContentTextObjectText
gmapT :: (forall b. Data b => b -> b)
-> MessageContentTextObjectText -> MessageContentTextObjectText
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectText
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectText
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectText
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectText
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MessageContentTextObjectText -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> MessageContentTextObjectText -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextObjectText
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextObjectText
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectText -> m MessageContentTextObjectText
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectText -> m MessageContentTextObjectText
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectText -> m MessageContentTextObjectText
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectText -> m MessageContentTextObjectText
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectText -> m MessageContentTextObjectText
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectText -> m MessageContentTextObjectText
Data)

instance FromJSON MessageContentTextObjectText where
  parseJSON :: Value -> Parser MessageContentTextObjectText
parseJSON = Options -> Value -> Parser MessageContentTextObjectText
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextObjectText")
instance ToJSON MessageContentTextObjectText where
  toJSON :: MessageContentTextObjectText -> Value
toJSON = Options -> MessageContentTextObjectText -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextObjectText")


-- | 
data MessageContentTextObjectTextAnnotationsInner = MessageContentTextObjectTextAnnotationsInner
  { MessageContentTextObjectTextAnnotationsInner -> Text
messageContentTextObjectTextAnnotationsInnerType :: Text -- ^ Always `file_path`.
  , MessageContentTextObjectTextAnnotationsInner -> Text
messageContentTextObjectTextAnnotationsInnerText :: Text -- ^ The text in the message content that needs to be replaced.
  , MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextAnnotationsFileCitationObjectFileCitation
messageContentTextObjectTextAnnotationsInnerFileUnderscorecitation :: MessageContentTextAnnotationsFileCitationObjectFileCitation -- ^ 
  , MessageContentTextObjectTextAnnotationsInner -> Int
messageContentTextObjectTextAnnotationsInnerStartUnderscoreindex :: Int -- ^ 
  , MessageContentTextObjectTextAnnotationsInner -> Int
messageContentTextObjectTextAnnotationsInnerEndUnderscoreindex :: Int -- ^ 
  , MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextAnnotationsFilePathObjectFilePath
messageContentTextObjectTextAnnotationsInnerFileUnderscorepath :: MessageContentTextAnnotationsFilePathObjectFilePath -- ^ 
  } deriving (Int -> MessageContentTextObjectTextAnnotationsInner -> ShowS
[MessageContentTextObjectTextAnnotationsInner] -> ShowS
MessageContentTextObjectTextAnnotationsInner -> String
(Int -> MessageContentTextObjectTextAnnotationsInner -> ShowS)
-> (MessageContentTextObjectTextAnnotationsInner -> String)
-> ([MessageContentTextObjectTextAnnotationsInner] -> ShowS)
-> Show MessageContentTextObjectTextAnnotationsInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageContentTextObjectTextAnnotationsInner -> ShowS
showsPrec :: Int -> MessageContentTextObjectTextAnnotationsInner -> ShowS
$cshow :: MessageContentTextObjectTextAnnotationsInner -> String
show :: MessageContentTextObjectTextAnnotationsInner -> String
$cshowList :: [MessageContentTextObjectTextAnnotationsInner] -> ShowS
showList :: [MessageContentTextObjectTextAnnotationsInner] -> ShowS
Show, MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
(MessageContentTextObjectTextAnnotationsInner
 -> MessageContentTextObjectTextAnnotationsInner -> Bool)
-> (MessageContentTextObjectTextAnnotationsInner
    -> MessageContentTextObjectTextAnnotationsInner -> Bool)
-> Eq MessageContentTextObjectTextAnnotationsInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
== :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
$c/= :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
/= :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
Eq, Eq MessageContentTextObjectTextAnnotationsInner
Eq MessageContentTextObjectTextAnnotationsInner =>
(MessageContentTextObjectTextAnnotationsInner
 -> MessageContentTextObjectTextAnnotationsInner -> Ordering)
-> (MessageContentTextObjectTextAnnotationsInner
    -> MessageContentTextObjectTextAnnotationsInner -> Bool)
-> (MessageContentTextObjectTextAnnotationsInner
    -> MessageContentTextObjectTextAnnotationsInner -> Bool)
-> (MessageContentTextObjectTextAnnotationsInner
    -> MessageContentTextObjectTextAnnotationsInner -> Bool)
-> (MessageContentTextObjectTextAnnotationsInner
    -> MessageContentTextObjectTextAnnotationsInner -> Bool)
-> (MessageContentTextObjectTextAnnotationsInner
    -> MessageContentTextObjectTextAnnotationsInner
    -> MessageContentTextObjectTextAnnotationsInner)
-> (MessageContentTextObjectTextAnnotationsInner
    -> MessageContentTextObjectTextAnnotationsInner
    -> MessageContentTextObjectTextAnnotationsInner)
-> Ord MessageContentTextObjectTextAnnotationsInner
MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Ordering
MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Ordering
compare :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Ordering
$c< :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
< :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
$c<= :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
<= :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
$c> :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
> :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
$c>= :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
>= :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner -> Bool
$cmax :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
max :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
$cmin :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
min :: MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
Ord, (forall x.
 MessageContentTextObjectTextAnnotationsInner
 -> Rep MessageContentTextObjectTextAnnotationsInner x)
-> (forall x.
    Rep MessageContentTextObjectTextAnnotationsInner x
    -> MessageContentTextObjectTextAnnotationsInner)
-> Generic MessageContentTextObjectTextAnnotationsInner
forall x.
Rep MessageContentTextObjectTextAnnotationsInner x
-> MessageContentTextObjectTextAnnotationsInner
forall x.
MessageContentTextObjectTextAnnotationsInner
-> Rep MessageContentTextObjectTextAnnotationsInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MessageContentTextObjectTextAnnotationsInner
-> Rep MessageContentTextObjectTextAnnotationsInner x
from :: forall x.
MessageContentTextObjectTextAnnotationsInner
-> Rep MessageContentTextObjectTextAnnotationsInner x
$cto :: forall x.
Rep MessageContentTextObjectTextAnnotationsInner x
-> MessageContentTextObjectTextAnnotationsInner
to :: forall x.
Rep MessageContentTextObjectTextAnnotationsInner x
-> MessageContentTextObjectTextAnnotationsInner
Generic, Typeable MessageContentTextObjectTextAnnotationsInner
Typeable MessageContentTextObjectTextAnnotationsInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageContentTextObjectTextAnnotationsInner
 -> c MessageContentTextObjectTextAnnotationsInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c MessageContentTextObjectTextAnnotationsInner)
-> (MessageContentTextObjectTextAnnotationsInner -> Constr)
-> (MessageContentTextObjectTextAnnotationsInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c MessageContentTextObjectTextAnnotationsInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageContentTextObjectTextAnnotationsInner))
-> ((forall b. Data b => b -> b)
    -> MessageContentTextObjectTextAnnotationsInner
    -> MessageContentTextObjectTextAnnotationsInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextObjectTextAnnotationsInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageContentTextObjectTextAnnotationsInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> MessageContentTextObjectTextAnnotationsInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> MessageContentTextObjectTextAnnotationsInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextObjectTextAnnotationsInner
    -> m MessageContentTextObjectTextAnnotationsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextObjectTextAnnotationsInner
    -> m MessageContentTextObjectTextAnnotationsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageContentTextObjectTextAnnotationsInner
    -> m MessageContentTextObjectTextAnnotationsInner)
-> Data MessageContentTextObjectTextAnnotationsInner
MessageContentTextObjectTextAnnotationsInner -> Constr
MessageContentTextObjectTextAnnotationsInner -> DataType
(forall b. Data b => b -> b)
-> MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextObjectTextAnnotationsInner
-> u
forall u.
(forall d. Data d => d -> u)
-> MessageContentTextObjectTextAnnotationsInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectTextAnnotationsInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectTextAnnotationsInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectTextAnnotationsInner
-> m MessageContentTextObjectTextAnnotationsInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectTextAnnotationsInner
-> m MessageContentTextObjectTextAnnotationsInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextObjectTextAnnotationsInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextObjectTextAnnotationsInner
-> c MessageContentTextObjectTextAnnotationsInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextObjectTextAnnotationsInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextObjectTextAnnotationsInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextObjectTextAnnotationsInner
-> c MessageContentTextObjectTextAnnotationsInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageContentTextObjectTextAnnotationsInner
-> c MessageContentTextObjectTextAnnotationsInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextObjectTextAnnotationsInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c MessageContentTextObjectTextAnnotationsInner
$ctoConstr :: MessageContentTextObjectTextAnnotationsInner -> Constr
toConstr :: MessageContentTextObjectTextAnnotationsInner -> Constr
$cdataTypeOf :: MessageContentTextObjectTextAnnotationsInner -> DataType
dataTypeOf :: MessageContentTextObjectTextAnnotationsInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextObjectTextAnnotationsInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageContentTextObjectTextAnnotationsInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextObjectTextAnnotationsInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageContentTextObjectTextAnnotationsInner)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
gmapT :: (forall b. Data b => b -> b)
-> MessageContentTextObjectTextAnnotationsInner
-> MessageContentTextObjectTextAnnotationsInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectTextAnnotationsInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectTextAnnotationsInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectTextAnnotationsInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageContentTextObjectTextAnnotationsInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentTextObjectTextAnnotationsInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> MessageContentTextObjectTextAnnotationsInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextObjectTextAnnotationsInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> MessageContentTextObjectTextAnnotationsInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectTextAnnotationsInner
-> m MessageContentTextObjectTextAnnotationsInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectTextAnnotationsInner
-> m MessageContentTextObjectTextAnnotationsInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectTextAnnotationsInner
-> m MessageContentTextObjectTextAnnotationsInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectTextAnnotationsInner
-> m MessageContentTextObjectTextAnnotationsInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectTextAnnotationsInner
-> m MessageContentTextObjectTextAnnotationsInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageContentTextObjectTextAnnotationsInner
-> m MessageContentTextObjectTextAnnotationsInner
Data)

instance FromJSON MessageContentTextObjectTextAnnotationsInner where
  parseJSON :: Value -> Parser MessageContentTextObjectTextAnnotationsInner
parseJSON = Options
-> Value -> Parser MessageContentTextObjectTextAnnotationsInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextObjectTextAnnotationsInner")
instance ToJSON MessageContentTextObjectTextAnnotationsInner where
  toJSON :: MessageContentTextObjectTextAnnotationsInner -> Value
toJSON = Options -> MessageContentTextObjectTextAnnotationsInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageContentTextObjectTextAnnotationsInner")


-- | A list of files attached to a &#x60;message&#x60;.
data MessageFileObject = MessageFileObject
  { MessageFileObject -> Text
messageFileObjectId :: Text -- ^ The identifier, which can be referenced in API endpoints.
  , MessageFileObject -> Text
messageFileObjectObject :: Text -- ^ The object type, which is always `thread.message.file`.
  , MessageFileObject -> Int
messageFileObjectCreatedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the message file was created.
  , MessageFileObject -> Text
messageFileObjectMessageUnderscoreid :: Text -- ^ The ID of the [message](/docs/api-reference/messages) that the [File](/docs/api-reference/files) is attached to.
  } deriving (Int -> MessageFileObject -> ShowS
[MessageFileObject] -> ShowS
MessageFileObject -> String
(Int -> MessageFileObject -> ShowS)
-> (MessageFileObject -> String)
-> ([MessageFileObject] -> ShowS)
-> Show MessageFileObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageFileObject -> ShowS
showsPrec :: Int -> MessageFileObject -> ShowS
$cshow :: MessageFileObject -> String
show :: MessageFileObject -> String
$cshowList :: [MessageFileObject] -> ShowS
showList :: [MessageFileObject] -> ShowS
Show, MessageFileObject -> MessageFileObject -> Bool
(MessageFileObject -> MessageFileObject -> Bool)
-> (MessageFileObject -> MessageFileObject -> Bool)
-> Eq MessageFileObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageFileObject -> MessageFileObject -> Bool
== :: MessageFileObject -> MessageFileObject -> Bool
$c/= :: MessageFileObject -> MessageFileObject -> Bool
/= :: MessageFileObject -> MessageFileObject -> Bool
Eq, Eq MessageFileObject
Eq MessageFileObject =>
(MessageFileObject -> MessageFileObject -> Ordering)
-> (MessageFileObject -> MessageFileObject -> Bool)
-> (MessageFileObject -> MessageFileObject -> Bool)
-> (MessageFileObject -> MessageFileObject -> Bool)
-> (MessageFileObject -> MessageFileObject -> Bool)
-> (MessageFileObject -> MessageFileObject -> MessageFileObject)
-> (MessageFileObject -> MessageFileObject -> MessageFileObject)
-> Ord MessageFileObject
MessageFileObject -> MessageFileObject -> Bool
MessageFileObject -> MessageFileObject -> Ordering
MessageFileObject -> MessageFileObject -> MessageFileObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageFileObject -> MessageFileObject -> Ordering
compare :: MessageFileObject -> MessageFileObject -> Ordering
$c< :: MessageFileObject -> MessageFileObject -> Bool
< :: MessageFileObject -> MessageFileObject -> Bool
$c<= :: MessageFileObject -> MessageFileObject -> Bool
<= :: MessageFileObject -> MessageFileObject -> Bool
$c> :: MessageFileObject -> MessageFileObject -> Bool
> :: MessageFileObject -> MessageFileObject -> Bool
$c>= :: MessageFileObject -> MessageFileObject -> Bool
>= :: MessageFileObject -> MessageFileObject -> Bool
$cmax :: MessageFileObject -> MessageFileObject -> MessageFileObject
max :: MessageFileObject -> MessageFileObject -> MessageFileObject
$cmin :: MessageFileObject -> MessageFileObject -> MessageFileObject
min :: MessageFileObject -> MessageFileObject -> MessageFileObject
Ord, (forall x. MessageFileObject -> Rep MessageFileObject x)
-> (forall x. Rep MessageFileObject x -> MessageFileObject)
-> Generic MessageFileObject
forall x. Rep MessageFileObject x -> MessageFileObject
forall x. MessageFileObject -> Rep MessageFileObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageFileObject -> Rep MessageFileObject x
from :: forall x. MessageFileObject -> Rep MessageFileObject x
$cto :: forall x. Rep MessageFileObject x -> MessageFileObject
to :: forall x. Rep MessageFileObject x -> MessageFileObject
Generic, Typeable MessageFileObject
Typeable MessageFileObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageFileObject
 -> c MessageFileObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MessageFileObject)
-> (MessageFileObject -> Constr)
-> (MessageFileObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MessageFileObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageFileObject))
-> ((forall b. Data b => b -> b)
    -> MessageFileObject -> MessageFileObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MessageFileObject -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MessageFileObject -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> MessageFileObject -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MessageFileObject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageFileObject -> m MessageFileObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageFileObject -> m MessageFileObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageFileObject -> m MessageFileObject)
-> Data MessageFileObject
MessageFileObject -> Constr
MessageFileObject -> DataType
(forall b. Data b => b -> b)
-> MessageFileObject -> MessageFileObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> MessageFileObject -> u
forall u. (forall d. Data d => d -> u) -> MessageFileObject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MessageFileObject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MessageFileObject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageFileObject -> m MessageFileObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageFileObject -> m MessageFileObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageFileObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MessageFileObject -> c MessageFileObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageFileObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageFileObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MessageFileObject -> c MessageFileObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MessageFileObject -> c MessageFileObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageFileObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageFileObject
$ctoConstr :: MessageFileObject -> Constr
toConstr :: MessageFileObject -> Constr
$cdataTypeOf :: MessageFileObject -> DataType
dataTypeOf :: MessageFileObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageFileObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageFileObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageFileObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageFileObject)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageFileObject -> MessageFileObject
gmapT :: (forall b. Data b => b -> b)
-> MessageFileObject -> MessageFileObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MessageFileObject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MessageFileObject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MessageFileObject -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MessageFileObject -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MessageFileObject -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> MessageFileObject -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MessageFileObject -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MessageFileObject -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageFileObject -> m MessageFileObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageFileObject -> m MessageFileObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageFileObject -> m MessageFileObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageFileObject -> m MessageFileObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageFileObject -> m MessageFileObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageFileObject -> m MessageFileObject
Data)

instance FromJSON MessageFileObject where
  parseJSON :: Value -> Parser MessageFileObject
parseJSON = Options -> Value -> Parser MessageFileObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageFileObject")
instance ToJSON MessageFileObject where
  toJSON :: MessageFileObject -> Value
toJSON = Options -> MessageFileObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageFileObject")


-- | Represents a message within a [thread](/docs/api-reference/threads).
data MessageObject = MessageObject
  { MessageObject -> Text
messageObjectId :: Text -- ^ The identifier, which can be referenced in API endpoints.
  , MessageObject -> Text
messageObjectObject :: Text -- ^ The object type, which is always `thread.message`.
  , MessageObject -> Int
messageObjectCreatedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the message was created.
  , MessageObject -> Text
messageObjectThreadUnderscoreid :: Text -- ^ The [thread](/docs/api-reference/threads) ID that this message belongs to.
  , MessageObject -> Text
messageObjectRole :: Text -- ^ The entity that produced the message. One of `user` or `assistant`.
  , MessageObject -> [MessageObjectContentInner]
messageObjectContent :: [MessageObjectContentInner] -- ^ The content of the message in array of text and/or images.
  , MessageObject -> Text
messageObjectAssistantUnderscoreid :: Text -- ^ If applicable, the ID of the [assistant](/docs/api-reference/assistants) that authored this message.
  , MessageObject -> Text
messageObjectRunUnderscoreid :: Text -- ^ If applicable, the ID of the [run](/docs/api-reference/runs) associated with the authoring of this message.
  , MessageObject -> [Text]
messageObjectFileUnderscoreids :: [Text] -- ^ A list of [file](/docs/api-reference/files) IDs that the assistant should use. Useful for tools like retrieval and code_interpreter that can access files. A maximum of 10 files can be attached to a message.
  , MessageObject -> Value
messageObjectMetadata :: Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> MessageObject -> ShowS
[MessageObject] -> ShowS
MessageObject -> String
(Int -> MessageObject -> ShowS)
-> (MessageObject -> String)
-> ([MessageObject] -> ShowS)
-> Show MessageObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageObject -> ShowS
showsPrec :: Int -> MessageObject -> ShowS
$cshow :: MessageObject -> String
show :: MessageObject -> String
$cshowList :: [MessageObject] -> ShowS
showList :: [MessageObject] -> ShowS
Show, MessageObject -> MessageObject -> Bool
(MessageObject -> MessageObject -> Bool)
-> (MessageObject -> MessageObject -> Bool) -> Eq MessageObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageObject -> MessageObject -> Bool
== :: MessageObject -> MessageObject -> Bool
$c/= :: MessageObject -> MessageObject -> Bool
/= :: MessageObject -> MessageObject -> Bool
Eq, Eq MessageObject
Eq MessageObject =>
(MessageObject -> MessageObject -> Ordering)
-> (MessageObject -> MessageObject -> Bool)
-> (MessageObject -> MessageObject -> Bool)
-> (MessageObject -> MessageObject -> Bool)
-> (MessageObject -> MessageObject -> Bool)
-> (MessageObject -> MessageObject -> MessageObject)
-> (MessageObject -> MessageObject -> MessageObject)
-> Ord MessageObject
MessageObject -> MessageObject -> Bool
MessageObject -> MessageObject -> Ordering
MessageObject -> MessageObject -> MessageObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageObject -> MessageObject -> Ordering
compare :: MessageObject -> MessageObject -> Ordering
$c< :: MessageObject -> MessageObject -> Bool
< :: MessageObject -> MessageObject -> Bool
$c<= :: MessageObject -> MessageObject -> Bool
<= :: MessageObject -> MessageObject -> Bool
$c> :: MessageObject -> MessageObject -> Bool
> :: MessageObject -> MessageObject -> Bool
$c>= :: MessageObject -> MessageObject -> Bool
>= :: MessageObject -> MessageObject -> Bool
$cmax :: MessageObject -> MessageObject -> MessageObject
max :: MessageObject -> MessageObject -> MessageObject
$cmin :: MessageObject -> MessageObject -> MessageObject
min :: MessageObject -> MessageObject -> MessageObject
Ord, (forall x. MessageObject -> Rep MessageObject x)
-> (forall x. Rep MessageObject x -> MessageObject)
-> Generic MessageObject
forall x. Rep MessageObject x -> MessageObject
forall x. MessageObject -> Rep MessageObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageObject -> Rep MessageObject x
from :: forall x. MessageObject -> Rep MessageObject x
$cto :: forall x. Rep MessageObject x -> MessageObject
to :: forall x. Rep MessageObject x -> MessageObject
Generic, Typeable MessageObject
Typeable MessageObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> MessageObject -> c MessageObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MessageObject)
-> (MessageObject -> Constr)
-> (MessageObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MessageObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageObject))
-> ((forall b. Data b => b -> b) -> MessageObject -> MessageObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MessageObject -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MessageObject -> r)
-> (forall u. (forall d. Data d => d -> u) -> MessageObject -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MessageObject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MessageObject -> m MessageObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MessageObject -> m MessageObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MessageObject -> m MessageObject)
-> Data MessageObject
MessageObject -> Constr
MessageObject -> DataType
(forall b. Data b => b -> b) -> MessageObject -> MessageObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MessageObject -> u
forall u. (forall d. Data d => d -> u) -> MessageObject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MessageObject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MessageObject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MessageObject -> m MessageObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MessageObject -> m MessageObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MessageObject -> c MessageObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MessageObject -> c MessageObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MessageObject -> c MessageObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageObject
$ctoConstr :: MessageObject -> Constr
toConstr :: MessageObject -> Constr
$cdataTypeOf :: MessageObject -> DataType
dataTypeOf :: MessageObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageObject)
$cgmapT :: (forall b. Data b => b -> b) -> MessageObject -> MessageObject
gmapT :: (forall b. Data b => b -> b) -> MessageObject -> MessageObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MessageObject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MessageObject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MessageObject -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MessageObject -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MessageObject -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> MessageObject -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MessageObject -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MessageObject -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MessageObject -> m MessageObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MessageObject -> m MessageObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MessageObject -> m MessageObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MessageObject -> m MessageObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MessageObject -> m MessageObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MessageObject -> m MessageObject
Data)

instance FromJSON MessageObject where
  parseJSON :: Value -> Parser MessageObject
parseJSON = Options -> Value -> Parser MessageObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageObject")
instance ToJSON MessageObject where
  toJSON :: MessageObject -> Value
toJSON = Options -> MessageObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageObject")


-- | 
data MessageObjectContentInner = MessageObjectContentInner
  { MessageObjectContentInner -> Text
messageObjectContentInnerType :: Text -- ^ Always `text`.
  , MessageObjectContentInner -> MessageContentImageFileObjectImageFile
messageObjectContentInnerImageUnderscorefile :: MessageContentImageFileObjectImageFile -- ^ 
  , MessageObjectContentInner -> MessageContentTextObjectText
messageObjectContentInnerText :: MessageContentTextObjectText -- ^ 
  } deriving (Int -> MessageObjectContentInner -> ShowS
[MessageObjectContentInner] -> ShowS
MessageObjectContentInner -> String
(Int -> MessageObjectContentInner -> ShowS)
-> (MessageObjectContentInner -> String)
-> ([MessageObjectContentInner] -> ShowS)
-> Show MessageObjectContentInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageObjectContentInner -> ShowS
showsPrec :: Int -> MessageObjectContentInner -> ShowS
$cshow :: MessageObjectContentInner -> String
show :: MessageObjectContentInner -> String
$cshowList :: [MessageObjectContentInner] -> ShowS
showList :: [MessageObjectContentInner] -> ShowS
Show, MessageObjectContentInner -> MessageObjectContentInner -> Bool
(MessageObjectContentInner -> MessageObjectContentInner -> Bool)
-> (MessageObjectContentInner -> MessageObjectContentInner -> Bool)
-> Eq MessageObjectContentInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
== :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
$c/= :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
/= :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
Eq, Eq MessageObjectContentInner
Eq MessageObjectContentInner =>
(MessageObjectContentInner
 -> MessageObjectContentInner -> Ordering)
-> (MessageObjectContentInner -> MessageObjectContentInner -> Bool)
-> (MessageObjectContentInner -> MessageObjectContentInner -> Bool)
-> (MessageObjectContentInner -> MessageObjectContentInner -> Bool)
-> (MessageObjectContentInner -> MessageObjectContentInner -> Bool)
-> (MessageObjectContentInner
    -> MessageObjectContentInner -> MessageObjectContentInner)
-> (MessageObjectContentInner
    -> MessageObjectContentInner -> MessageObjectContentInner)
-> Ord MessageObjectContentInner
MessageObjectContentInner -> MessageObjectContentInner -> Bool
MessageObjectContentInner -> MessageObjectContentInner -> Ordering
MessageObjectContentInner
-> MessageObjectContentInner -> MessageObjectContentInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageObjectContentInner -> MessageObjectContentInner -> Ordering
compare :: MessageObjectContentInner -> MessageObjectContentInner -> Ordering
$c< :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
< :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
$c<= :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
<= :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
$c> :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
> :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
$c>= :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
>= :: MessageObjectContentInner -> MessageObjectContentInner -> Bool
$cmax :: MessageObjectContentInner
-> MessageObjectContentInner -> MessageObjectContentInner
max :: MessageObjectContentInner
-> MessageObjectContentInner -> MessageObjectContentInner
$cmin :: MessageObjectContentInner
-> MessageObjectContentInner -> MessageObjectContentInner
min :: MessageObjectContentInner
-> MessageObjectContentInner -> MessageObjectContentInner
Ord, (forall x.
 MessageObjectContentInner -> Rep MessageObjectContentInner x)
-> (forall x.
    Rep MessageObjectContentInner x -> MessageObjectContentInner)
-> Generic MessageObjectContentInner
forall x.
Rep MessageObjectContentInner x -> MessageObjectContentInner
forall x.
MessageObjectContentInner -> Rep MessageObjectContentInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MessageObjectContentInner -> Rep MessageObjectContentInner x
from :: forall x.
MessageObjectContentInner -> Rep MessageObjectContentInner x
$cto :: forall x.
Rep MessageObjectContentInner x -> MessageObjectContentInner
to :: forall x.
Rep MessageObjectContentInner x -> MessageObjectContentInner
Generic, Typeable MessageObjectContentInner
Typeable MessageObjectContentInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> MessageObjectContentInner
 -> c MessageObjectContentInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MessageObjectContentInner)
-> (MessageObjectContentInner -> Constr)
-> (MessageObjectContentInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c MessageObjectContentInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageObjectContentInner))
-> ((forall b. Data b => b -> b)
    -> MessageObjectContentInner -> MessageObjectContentInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageObjectContentInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> MessageObjectContentInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> MessageObjectContentInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> MessageObjectContentInner -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MessageObjectContentInner -> m MessageObjectContentInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageObjectContentInner -> m MessageObjectContentInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MessageObjectContentInner -> m MessageObjectContentInner)
-> Data MessageObjectContentInner
MessageObjectContentInner -> Constr
MessageObjectContentInner -> DataType
(forall b. Data b => b -> b)
-> MessageObjectContentInner -> MessageObjectContentInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> MessageObjectContentInner -> u
forall u.
(forall d. Data d => d -> u) -> MessageObjectContentInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageObjectContentInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageObjectContentInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageObjectContentInner -> m MessageObjectContentInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageObjectContentInner -> m MessageObjectContentInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageObjectContentInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageObjectContentInner
-> c MessageObjectContentInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageObjectContentInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageObjectContentInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageObjectContentInner
-> c MessageObjectContentInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MessageObjectContentInner
-> c MessageObjectContentInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageObjectContentInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageObjectContentInner
$ctoConstr :: MessageObjectContentInner -> Constr
toConstr :: MessageObjectContentInner -> Constr
$cdataTypeOf :: MessageObjectContentInner -> DataType
dataTypeOf :: MessageObjectContentInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageObjectContentInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c MessageObjectContentInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageObjectContentInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageObjectContentInner)
$cgmapT :: (forall b. Data b => b -> b)
-> MessageObjectContentInner -> MessageObjectContentInner
gmapT :: (forall b. Data b => b -> b)
-> MessageObjectContentInner -> MessageObjectContentInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageObjectContentInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageObjectContentInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageObjectContentInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> MessageObjectContentInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MessageObjectContentInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> MessageObjectContentInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> MessageObjectContentInner -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> MessageObjectContentInner -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageObjectContentInner -> m MessageObjectContentInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MessageObjectContentInner -> m MessageObjectContentInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageObjectContentInner -> m MessageObjectContentInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageObjectContentInner -> m MessageObjectContentInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageObjectContentInner -> m MessageObjectContentInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MessageObjectContentInner -> m MessageObjectContentInner
Data)

instance FromJSON MessageObjectContentInner where
  parseJSON :: Value -> Parser MessageObjectContentInner
parseJSON = Options -> Value -> Parser MessageObjectContentInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"messageObjectContentInner")
instance ToJSON MessageObjectContentInner where
  toJSON :: MessageObjectContentInner -> Value
toJSON = Options -> MessageObjectContentInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"messageObjectContentInner")


-- | Describes an OpenAI model offering that can be used with the API.
data Model = Model
  { Model -> Text
modelId :: Text -- ^ The model identifier, which can be referenced in the API endpoints.
  , Model -> Int
modelCreated :: Int -- ^ The Unix timestamp (in seconds) when the model was created.
  , Model -> Text
modelObject :: Text -- ^ The object type, which is always \"model\".
  , Model -> Text
modelOwnedUnderscoreby :: Text -- ^ The organization that owns the model.
  } deriving (Int -> Model -> ShowS
[Model] -> ShowS
Model -> String
(Int -> Model -> ShowS)
-> (Model -> String) -> ([Model] -> ShowS) -> Show Model
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Model -> ShowS
showsPrec :: Int -> Model -> ShowS
$cshow :: Model -> String
show :: Model -> String
$cshowList :: [Model] -> ShowS
showList :: [Model] -> ShowS
Show, Model -> Model -> Bool
(Model -> Model -> Bool) -> (Model -> Model -> Bool) -> Eq Model
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Model -> Model -> Bool
== :: Model -> Model -> Bool
$c/= :: Model -> Model -> Bool
/= :: Model -> Model -> Bool
Eq, Eq Model
Eq Model =>
(Model -> Model -> Ordering)
-> (Model -> Model -> Bool)
-> (Model -> Model -> Bool)
-> (Model -> Model -> Bool)
-> (Model -> Model -> Bool)
-> (Model -> Model -> Model)
-> (Model -> Model -> Model)
-> Ord Model
Model -> Model -> Bool
Model -> Model -> Ordering
Model -> Model -> Model
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Model -> Model -> Ordering
compare :: Model -> Model -> Ordering
$c< :: Model -> Model -> Bool
< :: Model -> Model -> Bool
$c<= :: Model -> Model -> Bool
<= :: Model -> Model -> Bool
$c> :: Model -> Model -> Bool
> :: Model -> Model -> Bool
$c>= :: Model -> Model -> Bool
>= :: Model -> Model -> Bool
$cmax :: Model -> Model -> Model
max :: Model -> Model -> Model
$cmin :: Model -> Model -> Model
min :: Model -> Model -> Model
Ord, (forall x. Model -> Rep Model x)
-> (forall x. Rep Model x -> Model) -> Generic Model
forall x. Rep Model x -> Model
forall x. Model -> Rep Model x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Model -> Rep Model x
from :: forall x. Model -> Rep Model x
$cto :: forall x. Rep Model x -> Model
to :: forall x. Rep Model x -> Model
Generic, Typeable Model
Typeable Model =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Model -> c Model)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Model)
-> (Model -> Constr)
-> (Model -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Model))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Model))
-> ((forall b. Data b => b -> b) -> Model -> Model)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Model -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Model -> r)
-> (forall u. (forall d. Data d => d -> u) -> Model -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Model -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Model -> m Model)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Model -> m Model)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Model -> m Model)
-> Data Model
Model -> Constr
Model -> DataType
(forall b. Data b => b -> b) -> Model -> Model
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Model -> u
forall u. (forall d. Data d => d -> u) -> Model -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Model -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Model -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Model -> m Model
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Model -> m Model
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Model
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Model -> c Model
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Model)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Model)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Model -> c Model
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Model -> c Model
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Model
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Model
$ctoConstr :: Model -> Constr
toConstr :: Model -> Constr
$cdataTypeOf :: Model -> DataType
dataTypeOf :: Model -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Model)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Model)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Model)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Model)
$cgmapT :: (forall b. Data b => b -> b) -> Model -> Model
gmapT :: (forall b. Data b => b -> b) -> Model -> Model
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Model -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Model -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Model -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Model -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Model -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Model -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Model -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Model -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Model -> m Model
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Model -> m Model
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Model -> m Model
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Model -> m Model
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Model -> m Model
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Model -> m Model
Data)

instance FromJSON Model where
  parseJSON :: Value -> Parser Model
parseJSON = Options -> Value -> Parser Model
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"model")
instance ToJSON Model where
  toJSON :: Model -> Value
toJSON = Options -> Model -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"model")


-- | 
data ModifyAssistantRequest = ModifyAssistantRequest
  { ModifyAssistantRequest -> Maybe CreateAssistantRequestModel
modifyAssistantRequestModel :: Maybe CreateAssistantRequestModel -- ^ 
  , ModifyAssistantRequest -> Maybe Text
modifyAssistantRequestName :: Maybe Text -- ^ The name of the assistant. The maximum length is 256 characters. 
  , ModifyAssistantRequest -> Maybe Text
modifyAssistantRequestDescription :: Maybe Text -- ^ The description of the assistant. The maximum length is 512 characters. 
  , ModifyAssistantRequest -> Maybe Text
modifyAssistantRequestInstructions :: Maybe Text -- ^ The system instructions that the assistant uses. The maximum length is 32768 characters. 
  , ModifyAssistantRequest -> Maybe [AssistantObjectToolsInner]
modifyAssistantRequestTools :: Maybe [AssistantObjectToolsInner] -- ^ A list of tool enabled on the assistant. There can be a maximum of 128 tools per assistant. Tools can be of types `code_interpreter`, `retrieval`, or `function`. 
  , ModifyAssistantRequest -> Maybe [Text]
modifyAssistantRequestFileUnderscoreids :: Maybe [Text] -- ^ A list of [File](/docs/api-reference/files) IDs attached to this assistant. There can be a maximum of 20 files attached to the assistant. Files are ordered by their creation date in ascending order. If a file was previously attached to the list but does not show up in the list, it will be deleted from the assistant. 
  , ModifyAssistantRequest -> Maybe Value
modifyAssistantRequestMetadata :: Maybe Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> ModifyAssistantRequest -> ShowS
[ModifyAssistantRequest] -> ShowS
ModifyAssistantRequest -> String
(Int -> ModifyAssistantRequest -> ShowS)
-> (ModifyAssistantRequest -> String)
-> ([ModifyAssistantRequest] -> ShowS)
-> Show ModifyAssistantRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModifyAssistantRequest -> ShowS
showsPrec :: Int -> ModifyAssistantRequest -> ShowS
$cshow :: ModifyAssistantRequest -> String
show :: ModifyAssistantRequest -> String
$cshowList :: [ModifyAssistantRequest] -> ShowS
showList :: [ModifyAssistantRequest] -> ShowS
Show, ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
(ModifyAssistantRequest -> ModifyAssistantRequest -> Bool)
-> (ModifyAssistantRequest -> ModifyAssistantRequest -> Bool)
-> Eq ModifyAssistantRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
== :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
$c/= :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
/= :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
Eq, Eq ModifyAssistantRequest
Eq ModifyAssistantRequest =>
(ModifyAssistantRequest -> ModifyAssistantRequest -> Ordering)
-> (ModifyAssistantRequest -> ModifyAssistantRequest -> Bool)
-> (ModifyAssistantRequest -> ModifyAssistantRequest -> Bool)
-> (ModifyAssistantRequest -> ModifyAssistantRequest -> Bool)
-> (ModifyAssistantRequest -> ModifyAssistantRequest -> Bool)
-> (ModifyAssistantRequest
    -> ModifyAssistantRequest -> ModifyAssistantRequest)
-> (ModifyAssistantRequest
    -> ModifyAssistantRequest -> ModifyAssistantRequest)
-> Ord ModifyAssistantRequest
ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
ModifyAssistantRequest -> ModifyAssistantRequest -> Ordering
ModifyAssistantRequest
-> ModifyAssistantRequest -> ModifyAssistantRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModifyAssistantRequest -> ModifyAssistantRequest -> Ordering
compare :: ModifyAssistantRequest -> ModifyAssistantRequest -> Ordering
$c< :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
< :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
$c<= :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
<= :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
$c> :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
> :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
$c>= :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
>= :: ModifyAssistantRequest -> ModifyAssistantRequest -> Bool
$cmax :: ModifyAssistantRequest
-> ModifyAssistantRequest -> ModifyAssistantRequest
max :: ModifyAssistantRequest
-> ModifyAssistantRequest -> ModifyAssistantRequest
$cmin :: ModifyAssistantRequest
-> ModifyAssistantRequest -> ModifyAssistantRequest
min :: ModifyAssistantRequest
-> ModifyAssistantRequest -> ModifyAssistantRequest
Ord, (forall x. ModifyAssistantRequest -> Rep ModifyAssistantRequest x)
-> (forall x.
    Rep ModifyAssistantRequest x -> ModifyAssistantRequest)
-> Generic ModifyAssistantRequest
forall x. Rep ModifyAssistantRequest x -> ModifyAssistantRequest
forall x. ModifyAssistantRequest -> Rep ModifyAssistantRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModifyAssistantRequest -> Rep ModifyAssistantRequest x
from :: forall x. ModifyAssistantRequest -> Rep ModifyAssistantRequest x
$cto :: forall x. Rep ModifyAssistantRequest x -> ModifyAssistantRequest
to :: forall x. Rep ModifyAssistantRequest x -> ModifyAssistantRequest
Generic, Typeable ModifyAssistantRequest
Typeable ModifyAssistantRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ModifyAssistantRequest
 -> c ModifyAssistantRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ModifyAssistantRequest)
-> (ModifyAssistantRequest -> Constr)
-> (ModifyAssistantRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ModifyAssistantRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ModifyAssistantRequest))
-> ((forall b. Data b => b -> b)
    -> ModifyAssistantRequest -> ModifyAssistantRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ModifyAssistantRequest
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ModifyAssistantRequest
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ModifyAssistantRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ModifyAssistantRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ModifyAssistantRequest -> m ModifyAssistantRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ModifyAssistantRequest -> m ModifyAssistantRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ModifyAssistantRequest -> m ModifyAssistantRequest)
-> Data ModifyAssistantRequest
ModifyAssistantRequest -> Constr
ModifyAssistantRequest -> DataType
(forall b. Data b => b -> b)
-> ModifyAssistantRequest -> ModifyAssistantRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ModifyAssistantRequest -> u
forall u.
(forall d. Data d => d -> u) -> ModifyAssistantRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModifyAssistantRequest
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModifyAssistantRequest
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyAssistantRequest -> m ModifyAssistantRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyAssistantRequest -> m ModifyAssistantRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyAssistantRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModifyAssistantRequest
-> c ModifyAssistantRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyAssistantRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyAssistantRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModifyAssistantRequest
-> c ModifyAssistantRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModifyAssistantRequest
-> c ModifyAssistantRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyAssistantRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyAssistantRequest
$ctoConstr :: ModifyAssistantRequest -> Constr
toConstr :: ModifyAssistantRequest -> Constr
$cdataTypeOf :: ModifyAssistantRequest -> DataType
dataTypeOf :: ModifyAssistantRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyAssistantRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyAssistantRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyAssistantRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyAssistantRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> ModifyAssistantRequest -> ModifyAssistantRequest
gmapT :: (forall b. Data b => b -> b)
-> ModifyAssistantRequest -> ModifyAssistantRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModifyAssistantRequest
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModifyAssistantRequest
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModifyAssistantRequest
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModifyAssistantRequest
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ModifyAssistantRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ModifyAssistantRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModifyAssistantRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModifyAssistantRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyAssistantRequest -> m ModifyAssistantRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyAssistantRequest -> m ModifyAssistantRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyAssistantRequest -> m ModifyAssistantRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyAssistantRequest -> m ModifyAssistantRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyAssistantRequest -> m ModifyAssistantRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyAssistantRequest -> m ModifyAssistantRequest
Data)

instance FromJSON ModifyAssistantRequest where
  parseJSON :: Value -> Parser ModifyAssistantRequest
parseJSON = Options -> Value -> Parser ModifyAssistantRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"modifyAssistantRequest")
instance ToJSON ModifyAssistantRequest where
  toJSON :: ModifyAssistantRequest -> Value
toJSON = Options -> ModifyAssistantRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"modifyAssistantRequest")


-- | 
data ModifyMessageRequest = ModifyMessageRequest
  { ModifyMessageRequest -> Maybe Value
modifyMessageRequestMetadata :: Maybe Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> ModifyMessageRequest -> ShowS
[ModifyMessageRequest] -> ShowS
ModifyMessageRequest -> String
(Int -> ModifyMessageRequest -> ShowS)
-> (ModifyMessageRequest -> String)
-> ([ModifyMessageRequest] -> ShowS)
-> Show ModifyMessageRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModifyMessageRequest -> ShowS
showsPrec :: Int -> ModifyMessageRequest -> ShowS
$cshow :: ModifyMessageRequest -> String
show :: ModifyMessageRequest -> String
$cshowList :: [ModifyMessageRequest] -> ShowS
showList :: [ModifyMessageRequest] -> ShowS
Show, ModifyMessageRequest -> ModifyMessageRequest -> Bool
(ModifyMessageRequest -> ModifyMessageRequest -> Bool)
-> (ModifyMessageRequest -> ModifyMessageRequest -> Bool)
-> Eq ModifyMessageRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
== :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
$c/= :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
/= :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
Eq, Eq ModifyMessageRequest
Eq ModifyMessageRequest =>
(ModifyMessageRequest -> ModifyMessageRequest -> Ordering)
-> (ModifyMessageRequest -> ModifyMessageRequest -> Bool)
-> (ModifyMessageRequest -> ModifyMessageRequest -> Bool)
-> (ModifyMessageRequest -> ModifyMessageRequest -> Bool)
-> (ModifyMessageRequest -> ModifyMessageRequest -> Bool)
-> (ModifyMessageRequest
    -> ModifyMessageRequest -> ModifyMessageRequest)
-> (ModifyMessageRequest
    -> ModifyMessageRequest -> ModifyMessageRequest)
-> Ord ModifyMessageRequest
ModifyMessageRequest -> ModifyMessageRequest -> Bool
ModifyMessageRequest -> ModifyMessageRequest -> Ordering
ModifyMessageRequest
-> ModifyMessageRequest -> ModifyMessageRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModifyMessageRequest -> ModifyMessageRequest -> Ordering
compare :: ModifyMessageRequest -> ModifyMessageRequest -> Ordering
$c< :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
< :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
$c<= :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
<= :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
$c> :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
> :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
$c>= :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
>= :: ModifyMessageRequest -> ModifyMessageRequest -> Bool
$cmax :: ModifyMessageRequest
-> ModifyMessageRequest -> ModifyMessageRequest
max :: ModifyMessageRequest
-> ModifyMessageRequest -> ModifyMessageRequest
$cmin :: ModifyMessageRequest
-> ModifyMessageRequest -> ModifyMessageRequest
min :: ModifyMessageRequest
-> ModifyMessageRequest -> ModifyMessageRequest
Ord, (forall x. ModifyMessageRequest -> Rep ModifyMessageRequest x)
-> (forall x. Rep ModifyMessageRequest x -> ModifyMessageRequest)
-> Generic ModifyMessageRequest
forall x. Rep ModifyMessageRequest x -> ModifyMessageRequest
forall x. ModifyMessageRequest -> Rep ModifyMessageRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModifyMessageRequest -> Rep ModifyMessageRequest x
from :: forall x. ModifyMessageRequest -> Rep ModifyMessageRequest x
$cto :: forall x. Rep ModifyMessageRequest x -> ModifyMessageRequest
to :: forall x. Rep ModifyMessageRequest x -> ModifyMessageRequest
Generic, Typeable ModifyMessageRequest
Typeable ModifyMessageRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ModifyMessageRequest
 -> c ModifyMessageRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ModifyMessageRequest)
-> (ModifyMessageRequest -> Constr)
-> (ModifyMessageRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ModifyMessageRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ModifyMessageRequest))
-> ((forall b. Data b => b -> b)
    -> ModifyMessageRequest -> ModifyMessageRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ModifyMessageRequest -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ModifyMessageRequest -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ModifyMessageRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ModifyMessageRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ModifyMessageRequest -> m ModifyMessageRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ModifyMessageRequest -> m ModifyMessageRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ModifyMessageRequest -> m ModifyMessageRequest)
-> Data ModifyMessageRequest
ModifyMessageRequest -> Constr
ModifyMessageRequest -> DataType
(forall b. Data b => b -> b)
-> ModifyMessageRequest -> ModifyMessageRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ModifyMessageRequest -> u
forall u.
(forall d. Data d => d -> u) -> ModifyMessageRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyMessageRequest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyMessageRequest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyMessageRequest -> m ModifyMessageRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyMessageRequest -> m ModifyMessageRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyMessageRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModifyMessageRequest
-> c ModifyMessageRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyMessageRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyMessageRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModifyMessageRequest
-> c ModifyMessageRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModifyMessageRequest
-> c ModifyMessageRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyMessageRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyMessageRequest
$ctoConstr :: ModifyMessageRequest -> Constr
toConstr :: ModifyMessageRequest -> Constr
$cdataTypeOf :: ModifyMessageRequest -> DataType
dataTypeOf :: ModifyMessageRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyMessageRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyMessageRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyMessageRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyMessageRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> ModifyMessageRequest -> ModifyMessageRequest
gmapT :: (forall b. Data b => b -> b)
-> ModifyMessageRequest -> ModifyMessageRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyMessageRequest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyMessageRequest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyMessageRequest -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyMessageRequest -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ModifyMessageRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ModifyMessageRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModifyMessageRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModifyMessageRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyMessageRequest -> m ModifyMessageRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyMessageRequest -> m ModifyMessageRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyMessageRequest -> m ModifyMessageRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyMessageRequest -> m ModifyMessageRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyMessageRequest -> m ModifyMessageRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyMessageRequest -> m ModifyMessageRequest
Data)

instance FromJSON ModifyMessageRequest where
  parseJSON :: Value -> Parser ModifyMessageRequest
parseJSON = Options -> Value -> Parser ModifyMessageRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"modifyMessageRequest")
instance ToJSON ModifyMessageRequest where
  toJSON :: ModifyMessageRequest -> Value
toJSON = Options -> ModifyMessageRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"modifyMessageRequest")


-- | 
data ModifyRunRequest = ModifyRunRequest
  { ModifyRunRequest -> Maybe Value
modifyRunRequestMetadata :: Maybe Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> ModifyRunRequest -> ShowS
[ModifyRunRequest] -> ShowS
ModifyRunRequest -> String
(Int -> ModifyRunRequest -> ShowS)
-> (ModifyRunRequest -> String)
-> ([ModifyRunRequest] -> ShowS)
-> Show ModifyRunRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModifyRunRequest -> ShowS
showsPrec :: Int -> ModifyRunRequest -> ShowS
$cshow :: ModifyRunRequest -> String
show :: ModifyRunRequest -> String
$cshowList :: [ModifyRunRequest] -> ShowS
showList :: [ModifyRunRequest] -> ShowS
Show, ModifyRunRequest -> ModifyRunRequest -> Bool
(ModifyRunRequest -> ModifyRunRequest -> Bool)
-> (ModifyRunRequest -> ModifyRunRequest -> Bool)
-> Eq ModifyRunRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModifyRunRequest -> ModifyRunRequest -> Bool
== :: ModifyRunRequest -> ModifyRunRequest -> Bool
$c/= :: ModifyRunRequest -> ModifyRunRequest -> Bool
/= :: ModifyRunRequest -> ModifyRunRequest -> Bool
Eq, Eq ModifyRunRequest
Eq ModifyRunRequest =>
(ModifyRunRequest -> ModifyRunRequest -> Ordering)
-> (ModifyRunRequest -> ModifyRunRequest -> Bool)
-> (ModifyRunRequest -> ModifyRunRequest -> Bool)
-> (ModifyRunRequest -> ModifyRunRequest -> Bool)
-> (ModifyRunRequest -> ModifyRunRequest -> Bool)
-> (ModifyRunRequest -> ModifyRunRequest -> ModifyRunRequest)
-> (ModifyRunRequest -> ModifyRunRequest -> ModifyRunRequest)
-> Ord ModifyRunRequest
ModifyRunRequest -> ModifyRunRequest -> Bool
ModifyRunRequest -> ModifyRunRequest -> Ordering
ModifyRunRequest -> ModifyRunRequest -> ModifyRunRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModifyRunRequest -> ModifyRunRequest -> Ordering
compare :: ModifyRunRequest -> ModifyRunRequest -> Ordering
$c< :: ModifyRunRequest -> ModifyRunRequest -> Bool
< :: ModifyRunRequest -> ModifyRunRequest -> Bool
$c<= :: ModifyRunRequest -> ModifyRunRequest -> Bool
<= :: ModifyRunRequest -> ModifyRunRequest -> Bool
$c> :: ModifyRunRequest -> ModifyRunRequest -> Bool
> :: ModifyRunRequest -> ModifyRunRequest -> Bool
$c>= :: ModifyRunRequest -> ModifyRunRequest -> Bool
>= :: ModifyRunRequest -> ModifyRunRequest -> Bool
$cmax :: ModifyRunRequest -> ModifyRunRequest -> ModifyRunRequest
max :: ModifyRunRequest -> ModifyRunRequest -> ModifyRunRequest
$cmin :: ModifyRunRequest -> ModifyRunRequest -> ModifyRunRequest
min :: ModifyRunRequest -> ModifyRunRequest -> ModifyRunRequest
Ord, (forall x. ModifyRunRequest -> Rep ModifyRunRequest x)
-> (forall x. Rep ModifyRunRequest x -> ModifyRunRequest)
-> Generic ModifyRunRequest
forall x. Rep ModifyRunRequest x -> ModifyRunRequest
forall x. ModifyRunRequest -> Rep ModifyRunRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModifyRunRequest -> Rep ModifyRunRequest x
from :: forall x. ModifyRunRequest -> Rep ModifyRunRequest x
$cto :: forall x. Rep ModifyRunRequest x -> ModifyRunRequest
to :: forall x. Rep ModifyRunRequest x -> ModifyRunRequest
Generic, Typeable ModifyRunRequest
Typeable ModifyRunRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ModifyRunRequest -> c ModifyRunRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ModifyRunRequest)
-> (ModifyRunRequest -> Constr)
-> (ModifyRunRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ModifyRunRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ModifyRunRequest))
-> ((forall b. Data b => b -> b)
    -> ModifyRunRequest -> ModifyRunRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ModifyRunRequest -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ModifyRunRequest -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ModifyRunRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ModifyRunRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ModifyRunRequest -> m ModifyRunRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ModifyRunRequest -> m ModifyRunRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ModifyRunRequest -> m ModifyRunRequest)
-> Data ModifyRunRequest
ModifyRunRequest -> Constr
ModifyRunRequest -> DataType
(forall b. Data b => b -> b)
-> ModifyRunRequest -> ModifyRunRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ModifyRunRequest -> u
forall u. (forall d. Data d => d -> u) -> ModifyRunRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyRunRequest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyRunRequest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyRunRequest -> m ModifyRunRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyRunRequest -> m ModifyRunRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyRunRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModifyRunRequest -> c ModifyRunRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyRunRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyRunRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModifyRunRequest -> c ModifyRunRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModifyRunRequest -> c ModifyRunRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyRunRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyRunRequest
$ctoConstr :: ModifyRunRequest -> Constr
toConstr :: ModifyRunRequest -> Constr
$cdataTypeOf :: ModifyRunRequest -> DataType
dataTypeOf :: ModifyRunRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyRunRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyRunRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyRunRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyRunRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> ModifyRunRequest -> ModifyRunRequest
gmapT :: (forall b. Data b => b -> b)
-> ModifyRunRequest -> ModifyRunRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyRunRequest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyRunRequest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyRunRequest -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyRunRequest -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ModifyRunRequest -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ModifyRunRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModifyRunRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModifyRunRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyRunRequest -> m ModifyRunRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyRunRequest -> m ModifyRunRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyRunRequest -> m ModifyRunRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyRunRequest -> m ModifyRunRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyRunRequest -> m ModifyRunRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyRunRequest -> m ModifyRunRequest
Data)

instance FromJSON ModifyRunRequest where
  parseJSON :: Value -> Parser ModifyRunRequest
parseJSON = Options -> Value -> Parser ModifyRunRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"modifyRunRequest")
instance ToJSON ModifyRunRequest where
  toJSON :: ModifyRunRequest -> Value
toJSON = Options -> ModifyRunRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"modifyRunRequest")


-- | 
data ModifyThreadRequest = ModifyThreadRequest
  { ModifyThreadRequest -> Maybe Value
modifyThreadRequestMetadata :: Maybe Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> ModifyThreadRequest -> ShowS
[ModifyThreadRequest] -> ShowS
ModifyThreadRequest -> String
(Int -> ModifyThreadRequest -> ShowS)
-> (ModifyThreadRequest -> String)
-> ([ModifyThreadRequest] -> ShowS)
-> Show ModifyThreadRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModifyThreadRequest -> ShowS
showsPrec :: Int -> ModifyThreadRequest -> ShowS
$cshow :: ModifyThreadRequest -> String
show :: ModifyThreadRequest -> String
$cshowList :: [ModifyThreadRequest] -> ShowS
showList :: [ModifyThreadRequest] -> ShowS
Show, ModifyThreadRequest -> ModifyThreadRequest -> Bool
(ModifyThreadRequest -> ModifyThreadRequest -> Bool)
-> (ModifyThreadRequest -> ModifyThreadRequest -> Bool)
-> Eq ModifyThreadRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
== :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
$c/= :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
/= :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
Eq, Eq ModifyThreadRequest
Eq ModifyThreadRequest =>
(ModifyThreadRequest -> ModifyThreadRequest -> Ordering)
-> (ModifyThreadRequest -> ModifyThreadRequest -> Bool)
-> (ModifyThreadRequest -> ModifyThreadRequest -> Bool)
-> (ModifyThreadRequest -> ModifyThreadRequest -> Bool)
-> (ModifyThreadRequest -> ModifyThreadRequest -> Bool)
-> (ModifyThreadRequest
    -> ModifyThreadRequest -> ModifyThreadRequest)
-> (ModifyThreadRequest
    -> ModifyThreadRequest -> ModifyThreadRequest)
-> Ord ModifyThreadRequest
ModifyThreadRequest -> ModifyThreadRequest -> Bool
ModifyThreadRequest -> ModifyThreadRequest -> Ordering
ModifyThreadRequest -> ModifyThreadRequest -> ModifyThreadRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModifyThreadRequest -> ModifyThreadRequest -> Ordering
compare :: ModifyThreadRequest -> ModifyThreadRequest -> Ordering
$c< :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
< :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
$c<= :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
<= :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
$c> :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
> :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
$c>= :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
>= :: ModifyThreadRequest -> ModifyThreadRequest -> Bool
$cmax :: ModifyThreadRequest -> ModifyThreadRequest -> ModifyThreadRequest
max :: ModifyThreadRequest -> ModifyThreadRequest -> ModifyThreadRequest
$cmin :: ModifyThreadRequest -> ModifyThreadRequest -> ModifyThreadRequest
min :: ModifyThreadRequest -> ModifyThreadRequest -> ModifyThreadRequest
Ord, (forall x. ModifyThreadRequest -> Rep ModifyThreadRequest x)
-> (forall x. Rep ModifyThreadRequest x -> ModifyThreadRequest)
-> Generic ModifyThreadRequest
forall x. Rep ModifyThreadRequest x -> ModifyThreadRequest
forall x. ModifyThreadRequest -> Rep ModifyThreadRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModifyThreadRequest -> Rep ModifyThreadRequest x
from :: forall x. ModifyThreadRequest -> Rep ModifyThreadRequest x
$cto :: forall x. Rep ModifyThreadRequest x -> ModifyThreadRequest
to :: forall x. Rep ModifyThreadRequest x -> ModifyThreadRequest
Generic, Typeable ModifyThreadRequest
Typeable ModifyThreadRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ModifyThreadRequest
 -> c ModifyThreadRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ModifyThreadRequest)
-> (ModifyThreadRequest -> Constr)
-> (ModifyThreadRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ModifyThreadRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ModifyThreadRequest))
-> ((forall b. Data b => b -> b)
    -> ModifyThreadRequest -> ModifyThreadRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ModifyThreadRequest -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ModifyThreadRequest -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ModifyThreadRequest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ModifyThreadRequest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ModifyThreadRequest -> m ModifyThreadRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ModifyThreadRequest -> m ModifyThreadRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ModifyThreadRequest -> m ModifyThreadRequest)
-> Data ModifyThreadRequest
ModifyThreadRequest -> Constr
ModifyThreadRequest -> DataType
(forall b. Data b => b -> b)
-> ModifyThreadRequest -> ModifyThreadRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ModifyThreadRequest -> u
forall u.
(forall d. Data d => d -> u) -> ModifyThreadRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyThreadRequest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyThreadRequest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyThreadRequest -> m ModifyThreadRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyThreadRequest -> m ModifyThreadRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyThreadRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModifyThreadRequest
-> c ModifyThreadRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyThreadRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyThreadRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModifyThreadRequest
-> c ModifyThreadRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModifyThreadRequest
-> c ModifyThreadRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyThreadRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModifyThreadRequest
$ctoConstr :: ModifyThreadRequest -> Constr
toConstr :: ModifyThreadRequest -> Constr
$cdataTypeOf :: ModifyThreadRequest -> DataType
dataTypeOf :: ModifyThreadRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyThreadRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModifyThreadRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyThreadRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModifyThreadRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> ModifyThreadRequest -> ModifyThreadRequest
gmapT :: (forall b. Data b => b -> b)
-> ModifyThreadRequest -> ModifyThreadRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyThreadRequest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyThreadRequest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyThreadRequest -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModifyThreadRequest -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ModifyThreadRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ModifyThreadRequest -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModifyThreadRequest -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModifyThreadRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyThreadRequest -> m ModifyThreadRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModifyThreadRequest -> m ModifyThreadRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyThreadRequest -> m ModifyThreadRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyThreadRequest -> m ModifyThreadRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyThreadRequest -> m ModifyThreadRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModifyThreadRequest -> m ModifyThreadRequest
Data)

instance FromJSON ModifyThreadRequest where
  parseJSON :: Value -> Parser ModifyThreadRequest
parseJSON = Options -> Value -> Parser ModifyThreadRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"modifyThreadRequest")
instance ToJSON ModifyThreadRequest where
  toJSON :: ModifyThreadRequest -> Value
toJSON = Options -> ModifyThreadRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"modifyThreadRequest")


-- | The &#x60;File&#x60; object represents a document that has been uploaded to OpenAI.
data OpenAIFile = OpenAIFile
  { OpenAIFile -> Text
openAIFileId :: Text -- ^ The file identifier, which can be referenced in the API endpoints.
  , OpenAIFile -> Int
openAIFileBytes :: Int -- ^ The size of the file, in bytes.
  , OpenAIFile -> Int
openAIFileCreatedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the file was created.
  , OpenAIFile -> Text
openAIFileFilename :: Text -- ^ The name of the file.
  , OpenAIFile -> Text
openAIFileObject :: Text -- ^ The object type, which is always `file`.
  , OpenAIFile -> Text
openAIFilePurpose :: Text -- ^ The intended purpose of the file. Supported values are `fine-tune`, `fine-tune-results`, `assistants`, and `assistants_output`.
  , OpenAIFile -> Text
openAIFileStatus :: Text -- ^ Deprecated. The current status of the file, which can be either `uploaded`, `processed`, or `error`.
  , OpenAIFile -> Maybe Text
openAIFileStatusUnderscoredetails :: Maybe Text -- ^ Deprecated. For details on why a fine-tuning training file failed validation, see the `error` field on `fine_tuning.job`.
  } deriving (Int -> OpenAIFile -> ShowS
[OpenAIFile] -> ShowS
OpenAIFile -> String
(Int -> OpenAIFile -> ShowS)
-> (OpenAIFile -> String)
-> ([OpenAIFile] -> ShowS)
-> Show OpenAIFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenAIFile -> ShowS
showsPrec :: Int -> OpenAIFile -> ShowS
$cshow :: OpenAIFile -> String
show :: OpenAIFile -> String
$cshowList :: [OpenAIFile] -> ShowS
showList :: [OpenAIFile] -> ShowS
Show, OpenAIFile -> OpenAIFile -> Bool
(OpenAIFile -> OpenAIFile -> Bool)
-> (OpenAIFile -> OpenAIFile -> Bool) -> Eq OpenAIFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenAIFile -> OpenAIFile -> Bool
== :: OpenAIFile -> OpenAIFile -> Bool
$c/= :: OpenAIFile -> OpenAIFile -> Bool
/= :: OpenAIFile -> OpenAIFile -> Bool
Eq, Eq OpenAIFile
Eq OpenAIFile =>
(OpenAIFile -> OpenAIFile -> Ordering)
-> (OpenAIFile -> OpenAIFile -> Bool)
-> (OpenAIFile -> OpenAIFile -> Bool)
-> (OpenAIFile -> OpenAIFile -> Bool)
-> (OpenAIFile -> OpenAIFile -> Bool)
-> (OpenAIFile -> OpenAIFile -> OpenAIFile)
-> (OpenAIFile -> OpenAIFile -> OpenAIFile)
-> Ord OpenAIFile
OpenAIFile -> OpenAIFile -> Bool
OpenAIFile -> OpenAIFile -> Ordering
OpenAIFile -> OpenAIFile -> OpenAIFile
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OpenAIFile -> OpenAIFile -> Ordering
compare :: OpenAIFile -> OpenAIFile -> Ordering
$c< :: OpenAIFile -> OpenAIFile -> Bool
< :: OpenAIFile -> OpenAIFile -> Bool
$c<= :: OpenAIFile -> OpenAIFile -> Bool
<= :: OpenAIFile -> OpenAIFile -> Bool
$c> :: OpenAIFile -> OpenAIFile -> Bool
> :: OpenAIFile -> OpenAIFile -> Bool
$c>= :: OpenAIFile -> OpenAIFile -> Bool
>= :: OpenAIFile -> OpenAIFile -> Bool
$cmax :: OpenAIFile -> OpenAIFile -> OpenAIFile
max :: OpenAIFile -> OpenAIFile -> OpenAIFile
$cmin :: OpenAIFile -> OpenAIFile -> OpenAIFile
min :: OpenAIFile -> OpenAIFile -> OpenAIFile
Ord, (forall x. OpenAIFile -> Rep OpenAIFile x)
-> (forall x. Rep OpenAIFile x -> OpenAIFile) -> Generic OpenAIFile
forall x. Rep OpenAIFile x -> OpenAIFile
forall x. OpenAIFile -> Rep OpenAIFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OpenAIFile -> Rep OpenAIFile x
from :: forall x. OpenAIFile -> Rep OpenAIFile x
$cto :: forall x. Rep OpenAIFile x -> OpenAIFile
to :: forall x. Rep OpenAIFile x -> OpenAIFile
Generic, Typeable OpenAIFile
Typeable OpenAIFile =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> OpenAIFile -> c OpenAIFile)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OpenAIFile)
-> (OpenAIFile -> Constr)
-> (OpenAIFile -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OpenAIFile))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OpenAIFile))
-> ((forall b. Data b => b -> b) -> OpenAIFile -> OpenAIFile)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OpenAIFile -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OpenAIFile -> r)
-> (forall u. (forall d. Data d => d -> u) -> OpenAIFile -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OpenAIFile -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile)
-> Data OpenAIFile
OpenAIFile -> Constr
OpenAIFile -> DataType
(forall b. Data b => b -> b) -> OpenAIFile -> OpenAIFile
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OpenAIFile -> u
forall u. (forall d. Data d => d -> u) -> OpenAIFile -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenAIFile -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenAIFile -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenAIFile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenAIFile -> c OpenAIFile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenAIFile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenAIFile)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenAIFile -> c OpenAIFile
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenAIFile -> c OpenAIFile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenAIFile
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenAIFile
$ctoConstr :: OpenAIFile -> Constr
toConstr :: OpenAIFile -> Constr
$cdataTypeOf :: OpenAIFile -> DataType
dataTypeOf :: OpenAIFile -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenAIFile)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenAIFile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenAIFile)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenAIFile)
$cgmapT :: (forall b. Data b => b -> b) -> OpenAIFile -> OpenAIFile
gmapT :: (forall b. Data b => b -> b) -> OpenAIFile -> OpenAIFile
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenAIFile -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenAIFile -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenAIFile -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenAIFile -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OpenAIFile -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OpenAIFile -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenAIFile -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenAIFile -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenAIFile -> m OpenAIFile
Data)

instance FromJSON OpenAIFile where
  parseJSON :: Value -> Parser OpenAIFile
parseJSON = Options -> Value -> Parser OpenAIFile
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"openAIFile")
instance ToJSON OpenAIFile where
  toJSON :: OpenAIFile -> Value
toJSON = Options -> OpenAIFile -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"openAIFile")


-- | Usage statistics related to the run. This value will be &#x60;null&#x60; if the run is not in a terminal state (i.e. &#x60;in_progress&#x60;, &#x60;queued&#x60;, etc.).
data RunCompletionUsage = RunCompletionUsage
  { RunCompletionUsage -> Int
runCompletionUsageCompletionUnderscoretokens :: Int -- ^ Number of completion tokens used over the course of the run.
  , RunCompletionUsage -> Int
runCompletionUsagePromptUnderscoretokens :: Int -- ^ Number of prompt tokens used over the course of the run.
  , RunCompletionUsage -> Int
runCompletionUsageTotalUnderscoretokens :: Int -- ^ Total number of tokens used (prompt + completion).
  } deriving (Int -> RunCompletionUsage -> ShowS
[RunCompletionUsage] -> ShowS
RunCompletionUsage -> String
(Int -> RunCompletionUsage -> ShowS)
-> (RunCompletionUsage -> String)
-> ([RunCompletionUsage] -> ShowS)
-> Show RunCompletionUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunCompletionUsage -> ShowS
showsPrec :: Int -> RunCompletionUsage -> ShowS
$cshow :: RunCompletionUsage -> String
show :: RunCompletionUsage -> String
$cshowList :: [RunCompletionUsage] -> ShowS
showList :: [RunCompletionUsage] -> ShowS
Show, RunCompletionUsage -> RunCompletionUsage -> Bool
(RunCompletionUsage -> RunCompletionUsage -> Bool)
-> (RunCompletionUsage -> RunCompletionUsage -> Bool)
-> Eq RunCompletionUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunCompletionUsage -> RunCompletionUsage -> Bool
== :: RunCompletionUsage -> RunCompletionUsage -> Bool
$c/= :: RunCompletionUsage -> RunCompletionUsage -> Bool
/= :: RunCompletionUsage -> RunCompletionUsage -> Bool
Eq, Eq RunCompletionUsage
Eq RunCompletionUsage =>
(RunCompletionUsage -> RunCompletionUsage -> Ordering)
-> (RunCompletionUsage -> RunCompletionUsage -> Bool)
-> (RunCompletionUsage -> RunCompletionUsage -> Bool)
-> (RunCompletionUsage -> RunCompletionUsage -> Bool)
-> (RunCompletionUsage -> RunCompletionUsage -> Bool)
-> (RunCompletionUsage -> RunCompletionUsage -> RunCompletionUsage)
-> (RunCompletionUsage -> RunCompletionUsage -> RunCompletionUsage)
-> Ord RunCompletionUsage
RunCompletionUsage -> RunCompletionUsage -> Bool
RunCompletionUsage -> RunCompletionUsage -> Ordering
RunCompletionUsage -> RunCompletionUsage -> RunCompletionUsage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunCompletionUsage -> RunCompletionUsage -> Ordering
compare :: RunCompletionUsage -> RunCompletionUsage -> Ordering
$c< :: RunCompletionUsage -> RunCompletionUsage -> Bool
< :: RunCompletionUsage -> RunCompletionUsage -> Bool
$c<= :: RunCompletionUsage -> RunCompletionUsage -> Bool
<= :: RunCompletionUsage -> RunCompletionUsage -> Bool
$c> :: RunCompletionUsage -> RunCompletionUsage -> Bool
> :: RunCompletionUsage -> RunCompletionUsage -> Bool
$c>= :: RunCompletionUsage -> RunCompletionUsage -> Bool
>= :: RunCompletionUsage -> RunCompletionUsage -> Bool
$cmax :: RunCompletionUsage -> RunCompletionUsage -> RunCompletionUsage
max :: RunCompletionUsage -> RunCompletionUsage -> RunCompletionUsage
$cmin :: RunCompletionUsage -> RunCompletionUsage -> RunCompletionUsage
min :: RunCompletionUsage -> RunCompletionUsage -> RunCompletionUsage
Ord, (forall x. RunCompletionUsage -> Rep RunCompletionUsage x)
-> (forall x. Rep RunCompletionUsage x -> RunCompletionUsage)
-> Generic RunCompletionUsage
forall x. Rep RunCompletionUsage x -> RunCompletionUsage
forall x. RunCompletionUsage -> Rep RunCompletionUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunCompletionUsage -> Rep RunCompletionUsage x
from :: forall x. RunCompletionUsage -> Rep RunCompletionUsage x
$cto :: forall x. Rep RunCompletionUsage x -> RunCompletionUsage
to :: forall x. Rep RunCompletionUsage x -> RunCompletionUsage
Generic, Typeable RunCompletionUsage
Typeable RunCompletionUsage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunCompletionUsage
 -> c RunCompletionUsage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RunCompletionUsage)
-> (RunCompletionUsage -> Constr)
-> (RunCompletionUsage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RunCompletionUsage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunCompletionUsage))
-> ((forall b. Data b => b -> b)
    -> RunCompletionUsage -> RunCompletionUsage)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RunCompletionUsage -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RunCompletionUsage -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RunCompletionUsage -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RunCompletionUsage -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunCompletionUsage -> m RunCompletionUsage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunCompletionUsage -> m RunCompletionUsage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunCompletionUsage -> m RunCompletionUsage)
-> Data RunCompletionUsage
RunCompletionUsage -> Constr
RunCompletionUsage -> DataType
(forall b. Data b => b -> b)
-> RunCompletionUsage -> RunCompletionUsage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RunCompletionUsage -> u
forall u. (forall d. Data d => d -> u) -> RunCompletionUsage -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunCompletionUsage -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunCompletionUsage -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunCompletionUsage -> m RunCompletionUsage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunCompletionUsage -> m RunCompletionUsage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunCompletionUsage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunCompletionUsage
-> c RunCompletionUsage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunCompletionUsage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunCompletionUsage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunCompletionUsage
-> c RunCompletionUsage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunCompletionUsage
-> c RunCompletionUsage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunCompletionUsage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunCompletionUsage
$ctoConstr :: RunCompletionUsage -> Constr
toConstr :: RunCompletionUsage -> Constr
$cdataTypeOf :: RunCompletionUsage -> DataType
dataTypeOf :: RunCompletionUsage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunCompletionUsage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunCompletionUsage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunCompletionUsage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunCompletionUsage)
$cgmapT :: (forall b. Data b => b -> b)
-> RunCompletionUsage -> RunCompletionUsage
gmapT :: (forall b. Data b => b -> b)
-> RunCompletionUsage -> RunCompletionUsage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunCompletionUsage -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunCompletionUsage -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunCompletionUsage -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunCompletionUsage -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RunCompletionUsage -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RunCompletionUsage -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunCompletionUsage -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunCompletionUsage -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunCompletionUsage -> m RunCompletionUsage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunCompletionUsage -> m RunCompletionUsage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunCompletionUsage -> m RunCompletionUsage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunCompletionUsage -> m RunCompletionUsage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunCompletionUsage -> m RunCompletionUsage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunCompletionUsage -> m RunCompletionUsage
Data)

instance FromJSON RunCompletionUsage where
  parseJSON :: Value -> Parser RunCompletionUsage
parseJSON = Options -> Value -> Parser RunCompletionUsage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runCompletionUsage")
instance ToJSON RunCompletionUsage where
  toJSON :: RunCompletionUsage -> Value
toJSON = Options -> RunCompletionUsage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runCompletionUsage")


-- | Represents an execution run on a [thread](/docs/api-reference/threads).
data RunObject = RunObject
  { RunObject -> Text
runObjectId :: Text -- ^ The identifier, which can be referenced in API endpoints.
  , RunObject -> Text
runObjectObject :: Text -- ^ The object type, which is always `thread.run`.
  , RunObject -> Int
runObjectCreatedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run was created.
  , RunObject -> Text
runObjectThreadUnderscoreid :: Text -- ^ The ID of the [thread](/docs/api-reference/threads) that was executed on as a part of this run.
  , RunObject -> Text
runObjectAssistantUnderscoreid :: Text -- ^ The ID of the [assistant](/docs/api-reference/assistants) used for execution of this run.
  , RunObject -> Text
runObjectStatus :: Text -- ^ The status of the run, which can be either `queued`, `in_progress`, `requires_action`, `cancelling`, `cancelled`, `failed`, `completed`, or `expired`.
  , RunObject -> RunObjectRequiredAction
runObjectRequiredUnderscoreaction :: RunObjectRequiredAction -- ^ 
  , RunObject -> RunObjectLastError
runObjectLastUnderscoreerror :: RunObjectLastError -- ^ 
  , RunObject -> Int
runObjectExpiresUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run will expire.
  , RunObject -> Int
runObjectStartedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run was started.
  , RunObject -> Int
runObjectCancelledUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run was cancelled.
  , RunObject -> Int
runObjectFailedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run failed.
  , RunObject -> Int
runObjectCompletedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run was completed.
  , RunObject -> Text
runObjectModel :: Text -- ^ The model that the [assistant](/docs/api-reference/assistants) used for this run.
  , RunObject -> Text
runObjectInstructions :: Text -- ^ The instructions that the [assistant](/docs/api-reference/assistants) used for this run.
  , RunObject -> [AssistantObjectToolsInner]
runObjectTools :: [AssistantObjectToolsInner] -- ^ The list of tools that the [assistant](/docs/api-reference/assistants) used for this run.
  , RunObject -> [Text]
runObjectFileUnderscoreids :: [Text] -- ^ The list of [File](/docs/api-reference/files) IDs the [assistant](/docs/api-reference/assistants) used for this run.
  , RunObject -> Value
runObjectMetadata :: Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  , RunObject -> RunCompletionUsage
runObjectUsage :: RunCompletionUsage -- ^ 
  } deriving (Int -> RunObject -> ShowS
[RunObject] -> ShowS
RunObject -> String
(Int -> RunObject -> ShowS)
-> (RunObject -> String)
-> ([RunObject] -> ShowS)
-> Show RunObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunObject -> ShowS
showsPrec :: Int -> RunObject -> ShowS
$cshow :: RunObject -> String
show :: RunObject -> String
$cshowList :: [RunObject] -> ShowS
showList :: [RunObject] -> ShowS
Show, RunObject -> RunObject -> Bool
(RunObject -> RunObject -> Bool)
-> (RunObject -> RunObject -> Bool) -> Eq RunObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunObject -> RunObject -> Bool
== :: RunObject -> RunObject -> Bool
$c/= :: RunObject -> RunObject -> Bool
/= :: RunObject -> RunObject -> Bool
Eq, Eq RunObject
Eq RunObject =>
(RunObject -> RunObject -> Ordering)
-> (RunObject -> RunObject -> Bool)
-> (RunObject -> RunObject -> Bool)
-> (RunObject -> RunObject -> Bool)
-> (RunObject -> RunObject -> Bool)
-> (RunObject -> RunObject -> RunObject)
-> (RunObject -> RunObject -> RunObject)
-> Ord RunObject
RunObject -> RunObject -> Bool
RunObject -> RunObject -> Ordering
RunObject -> RunObject -> RunObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunObject -> RunObject -> Ordering
compare :: RunObject -> RunObject -> Ordering
$c< :: RunObject -> RunObject -> Bool
< :: RunObject -> RunObject -> Bool
$c<= :: RunObject -> RunObject -> Bool
<= :: RunObject -> RunObject -> Bool
$c> :: RunObject -> RunObject -> Bool
> :: RunObject -> RunObject -> Bool
$c>= :: RunObject -> RunObject -> Bool
>= :: RunObject -> RunObject -> Bool
$cmax :: RunObject -> RunObject -> RunObject
max :: RunObject -> RunObject -> RunObject
$cmin :: RunObject -> RunObject -> RunObject
min :: RunObject -> RunObject -> RunObject
Ord, (forall x. RunObject -> Rep RunObject x)
-> (forall x. Rep RunObject x -> RunObject) -> Generic RunObject
forall x. Rep RunObject x -> RunObject
forall x. RunObject -> Rep RunObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunObject -> Rep RunObject x
from :: forall x. RunObject -> Rep RunObject x
$cto :: forall x. Rep RunObject x -> RunObject
to :: forall x. Rep RunObject x -> RunObject
Generic, Typeable RunObject
Typeable RunObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RunObject -> c RunObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RunObject)
-> (RunObject -> Constr)
-> (RunObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RunObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RunObject))
-> ((forall b. Data b => b -> b) -> RunObject -> RunObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RunObject -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RunObject -> r)
-> (forall u. (forall d. Data d => d -> u) -> RunObject -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RunObject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RunObject -> m RunObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RunObject -> m RunObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RunObject -> m RunObject)
-> Data RunObject
RunObject -> Constr
RunObject -> DataType
(forall b. Data b => b -> b) -> RunObject -> RunObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RunObject -> u
forall u. (forall d. Data d => d -> u) -> RunObject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunObject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunObject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RunObject -> m RunObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RunObject -> m RunObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RunObject -> c RunObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RunObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RunObject -> c RunObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RunObject -> c RunObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunObject
$ctoConstr :: RunObject -> Constr
toConstr :: RunObject -> Constr
$cdataTypeOf :: RunObject -> DataType
dataTypeOf :: RunObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RunObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RunObject)
$cgmapT :: (forall b. Data b => b -> b) -> RunObject -> RunObject
gmapT :: (forall b. Data b => b -> b) -> RunObject -> RunObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunObject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunObject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunObject -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunObject -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RunObject -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RunObject -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RunObject -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RunObject -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RunObject -> m RunObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RunObject -> m RunObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RunObject -> m RunObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RunObject -> m RunObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RunObject -> m RunObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RunObject -> m RunObject
Data)

instance FromJSON RunObject where
  parseJSON :: Value -> Parser RunObject
parseJSON = Options -> Value -> Parser RunObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runObject")
instance ToJSON RunObject where
  toJSON :: RunObject -> Value
toJSON = Options -> RunObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runObject")


-- | The last error associated with this run. Will be &#x60;null&#x60; if there are no errors.
data RunObjectLastError = RunObjectLastError
  { RunObjectLastError -> Text
runObjectLastErrorCode :: Text -- ^ One of `server_error`, `rate_limit_exceeded`, or `invalid_prompt`.
  , RunObjectLastError -> Text
runObjectLastErrorMessage :: Text -- ^ A human-readable description of the error.
  } deriving (Int -> RunObjectLastError -> ShowS
[RunObjectLastError] -> ShowS
RunObjectLastError -> String
(Int -> RunObjectLastError -> ShowS)
-> (RunObjectLastError -> String)
-> ([RunObjectLastError] -> ShowS)
-> Show RunObjectLastError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunObjectLastError -> ShowS
showsPrec :: Int -> RunObjectLastError -> ShowS
$cshow :: RunObjectLastError -> String
show :: RunObjectLastError -> String
$cshowList :: [RunObjectLastError] -> ShowS
showList :: [RunObjectLastError] -> ShowS
Show, RunObjectLastError -> RunObjectLastError -> Bool
(RunObjectLastError -> RunObjectLastError -> Bool)
-> (RunObjectLastError -> RunObjectLastError -> Bool)
-> Eq RunObjectLastError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunObjectLastError -> RunObjectLastError -> Bool
== :: RunObjectLastError -> RunObjectLastError -> Bool
$c/= :: RunObjectLastError -> RunObjectLastError -> Bool
/= :: RunObjectLastError -> RunObjectLastError -> Bool
Eq, Eq RunObjectLastError
Eq RunObjectLastError =>
(RunObjectLastError -> RunObjectLastError -> Ordering)
-> (RunObjectLastError -> RunObjectLastError -> Bool)
-> (RunObjectLastError -> RunObjectLastError -> Bool)
-> (RunObjectLastError -> RunObjectLastError -> Bool)
-> (RunObjectLastError -> RunObjectLastError -> Bool)
-> (RunObjectLastError -> RunObjectLastError -> RunObjectLastError)
-> (RunObjectLastError -> RunObjectLastError -> RunObjectLastError)
-> Ord RunObjectLastError
RunObjectLastError -> RunObjectLastError -> Bool
RunObjectLastError -> RunObjectLastError -> Ordering
RunObjectLastError -> RunObjectLastError -> RunObjectLastError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunObjectLastError -> RunObjectLastError -> Ordering
compare :: RunObjectLastError -> RunObjectLastError -> Ordering
$c< :: RunObjectLastError -> RunObjectLastError -> Bool
< :: RunObjectLastError -> RunObjectLastError -> Bool
$c<= :: RunObjectLastError -> RunObjectLastError -> Bool
<= :: RunObjectLastError -> RunObjectLastError -> Bool
$c> :: RunObjectLastError -> RunObjectLastError -> Bool
> :: RunObjectLastError -> RunObjectLastError -> Bool
$c>= :: RunObjectLastError -> RunObjectLastError -> Bool
>= :: RunObjectLastError -> RunObjectLastError -> Bool
$cmax :: RunObjectLastError -> RunObjectLastError -> RunObjectLastError
max :: RunObjectLastError -> RunObjectLastError -> RunObjectLastError
$cmin :: RunObjectLastError -> RunObjectLastError -> RunObjectLastError
min :: RunObjectLastError -> RunObjectLastError -> RunObjectLastError
Ord, (forall x. RunObjectLastError -> Rep RunObjectLastError x)
-> (forall x. Rep RunObjectLastError x -> RunObjectLastError)
-> Generic RunObjectLastError
forall x. Rep RunObjectLastError x -> RunObjectLastError
forall x. RunObjectLastError -> Rep RunObjectLastError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunObjectLastError -> Rep RunObjectLastError x
from :: forall x. RunObjectLastError -> Rep RunObjectLastError x
$cto :: forall x. Rep RunObjectLastError x -> RunObjectLastError
to :: forall x. Rep RunObjectLastError x -> RunObjectLastError
Generic, Typeable RunObjectLastError
Typeable RunObjectLastError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunObjectLastError
 -> c RunObjectLastError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RunObjectLastError)
-> (RunObjectLastError -> Constr)
-> (RunObjectLastError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RunObjectLastError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunObjectLastError))
-> ((forall b. Data b => b -> b)
    -> RunObjectLastError -> RunObjectLastError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RunObjectLastError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RunObjectLastError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RunObjectLastError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RunObjectLastError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunObjectLastError -> m RunObjectLastError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunObjectLastError -> m RunObjectLastError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunObjectLastError -> m RunObjectLastError)
-> Data RunObjectLastError
RunObjectLastError -> Constr
RunObjectLastError -> DataType
(forall b. Data b => b -> b)
-> RunObjectLastError -> RunObjectLastError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RunObjectLastError -> u
forall u. (forall d. Data d => d -> u) -> RunObjectLastError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunObjectLastError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunObjectLastError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunObjectLastError -> m RunObjectLastError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectLastError -> m RunObjectLastError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunObjectLastError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunObjectLastError
-> c RunObjectLastError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunObjectLastError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunObjectLastError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunObjectLastError
-> c RunObjectLastError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunObjectLastError
-> c RunObjectLastError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunObjectLastError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunObjectLastError
$ctoConstr :: RunObjectLastError -> Constr
toConstr :: RunObjectLastError -> Constr
$cdataTypeOf :: RunObjectLastError -> DataType
dataTypeOf :: RunObjectLastError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunObjectLastError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunObjectLastError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunObjectLastError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunObjectLastError)
$cgmapT :: (forall b. Data b => b -> b)
-> RunObjectLastError -> RunObjectLastError
gmapT :: (forall b. Data b => b -> b)
-> RunObjectLastError -> RunObjectLastError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunObjectLastError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunObjectLastError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunObjectLastError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunObjectLastError -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RunObjectLastError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RunObjectLastError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunObjectLastError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunObjectLastError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunObjectLastError -> m RunObjectLastError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunObjectLastError -> m RunObjectLastError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectLastError -> m RunObjectLastError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectLastError -> m RunObjectLastError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectLastError -> m RunObjectLastError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectLastError -> m RunObjectLastError
Data)

instance FromJSON RunObjectLastError where
  parseJSON :: Value -> Parser RunObjectLastError
parseJSON = Options -> Value -> Parser RunObjectLastError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runObjectLastError")
instance ToJSON RunObjectLastError where
  toJSON :: RunObjectLastError -> Value
toJSON = Options -> RunObjectLastError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runObjectLastError")


-- | Details on the action required to continue the run. Will be &#x60;null&#x60; if no action is required.
data RunObjectRequiredAction = RunObjectRequiredAction
  { RunObjectRequiredAction -> Text
runObjectRequiredActionType :: Text -- ^ For now, this is always `submit_tool_outputs`.
  , RunObjectRequiredAction -> RunObjectRequiredActionSubmitToolOutputs
runObjectRequiredActionSubmitUnderscoretoolUnderscoreoutputs :: RunObjectRequiredActionSubmitToolOutputs -- ^ 
  } deriving (Int -> RunObjectRequiredAction -> ShowS
[RunObjectRequiredAction] -> ShowS
RunObjectRequiredAction -> String
(Int -> RunObjectRequiredAction -> ShowS)
-> (RunObjectRequiredAction -> String)
-> ([RunObjectRequiredAction] -> ShowS)
-> Show RunObjectRequiredAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunObjectRequiredAction -> ShowS
showsPrec :: Int -> RunObjectRequiredAction -> ShowS
$cshow :: RunObjectRequiredAction -> String
show :: RunObjectRequiredAction -> String
$cshowList :: [RunObjectRequiredAction] -> ShowS
showList :: [RunObjectRequiredAction] -> ShowS
Show, RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
(RunObjectRequiredAction -> RunObjectRequiredAction -> Bool)
-> (RunObjectRequiredAction -> RunObjectRequiredAction -> Bool)
-> Eq RunObjectRequiredAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
== :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
$c/= :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
/= :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
Eq, Eq RunObjectRequiredAction
Eq RunObjectRequiredAction =>
(RunObjectRequiredAction -> RunObjectRequiredAction -> Ordering)
-> (RunObjectRequiredAction -> RunObjectRequiredAction -> Bool)
-> (RunObjectRequiredAction -> RunObjectRequiredAction -> Bool)
-> (RunObjectRequiredAction -> RunObjectRequiredAction -> Bool)
-> (RunObjectRequiredAction -> RunObjectRequiredAction -> Bool)
-> (RunObjectRequiredAction
    -> RunObjectRequiredAction -> RunObjectRequiredAction)
-> (RunObjectRequiredAction
    -> RunObjectRequiredAction -> RunObjectRequiredAction)
-> Ord RunObjectRequiredAction
RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
RunObjectRequiredAction -> RunObjectRequiredAction -> Ordering
RunObjectRequiredAction
-> RunObjectRequiredAction -> RunObjectRequiredAction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunObjectRequiredAction -> RunObjectRequiredAction -> Ordering
compare :: RunObjectRequiredAction -> RunObjectRequiredAction -> Ordering
$c< :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
< :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
$c<= :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
<= :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
$c> :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
> :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
$c>= :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
>= :: RunObjectRequiredAction -> RunObjectRequiredAction -> Bool
$cmax :: RunObjectRequiredAction
-> RunObjectRequiredAction -> RunObjectRequiredAction
max :: RunObjectRequiredAction
-> RunObjectRequiredAction -> RunObjectRequiredAction
$cmin :: RunObjectRequiredAction
-> RunObjectRequiredAction -> RunObjectRequiredAction
min :: RunObjectRequiredAction
-> RunObjectRequiredAction -> RunObjectRequiredAction
Ord, (forall x.
 RunObjectRequiredAction -> Rep RunObjectRequiredAction x)
-> (forall x.
    Rep RunObjectRequiredAction x -> RunObjectRequiredAction)
-> Generic RunObjectRequiredAction
forall x. Rep RunObjectRequiredAction x -> RunObjectRequiredAction
forall x. RunObjectRequiredAction -> Rep RunObjectRequiredAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunObjectRequiredAction -> Rep RunObjectRequiredAction x
from :: forall x. RunObjectRequiredAction -> Rep RunObjectRequiredAction x
$cto :: forall x. Rep RunObjectRequiredAction x -> RunObjectRequiredAction
to :: forall x. Rep RunObjectRequiredAction x -> RunObjectRequiredAction
Generic, Typeable RunObjectRequiredAction
Typeable RunObjectRequiredAction =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunObjectRequiredAction
 -> c RunObjectRequiredAction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RunObjectRequiredAction)
-> (RunObjectRequiredAction -> Constr)
-> (RunObjectRequiredAction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RunObjectRequiredAction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunObjectRequiredAction))
-> ((forall b. Data b => b -> b)
    -> RunObjectRequiredAction -> RunObjectRequiredAction)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunObjectRequiredAction
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunObjectRequiredAction
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RunObjectRequiredAction -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> RunObjectRequiredAction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunObjectRequiredAction -> m RunObjectRequiredAction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunObjectRequiredAction -> m RunObjectRequiredAction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunObjectRequiredAction -> m RunObjectRequiredAction)
-> Data RunObjectRequiredAction
RunObjectRequiredAction -> Constr
RunObjectRequiredAction -> DataType
(forall b. Data b => b -> b)
-> RunObjectRequiredAction -> RunObjectRequiredAction
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RunObjectRequiredAction -> u
forall u.
(forall d. Data d => d -> u) -> RunObjectRequiredAction -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredAction
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredAction
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredAction -> m RunObjectRequiredAction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredAction -> m RunObjectRequiredAction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunObjectRequiredAction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunObjectRequiredAction
-> c RunObjectRequiredAction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunObjectRequiredAction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunObjectRequiredAction)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunObjectRequiredAction
-> c RunObjectRequiredAction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunObjectRequiredAction
-> c RunObjectRequiredAction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunObjectRequiredAction
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunObjectRequiredAction
$ctoConstr :: RunObjectRequiredAction -> Constr
toConstr :: RunObjectRequiredAction -> Constr
$cdataTypeOf :: RunObjectRequiredAction -> DataType
dataTypeOf :: RunObjectRequiredAction -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunObjectRequiredAction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunObjectRequiredAction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunObjectRequiredAction)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunObjectRequiredAction)
$cgmapT :: (forall b. Data b => b -> b)
-> RunObjectRequiredAction -> RunObjectRequiredAction
gmapT :: (forall b. Data b => b -> b)
-> RunObjectRequiredAction -> RunObjectRequiredAction
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredAction
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredAction
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredAction
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredAction
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RunObjectRequiredAction -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> RunObjectRequiredAction -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunObjectRequiredAction -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunObjectRequiredAction -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredAction -> m RunObjectRequiredAction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredAction -> m RunObjectRequiredAction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredAction -> m RunObjectRequiredAction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredAction -> m RunObjectRequiredAction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredAction -> m RunObjectRequiredAction
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredAction -> m RunObjectRequiredAction
Data)

instance FromJSON RunObjectRequiredAction where
  parseJSON :: Value -> Parser RunObjectRequiredAction
parseJSON = Options -> Value -> Parser RunObjectRequiredAction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runObjectRequiredAction")
instance ToJSON RunObjectRequiredAction where
  toJSON :: RunObjectRequiredAction -> Value
toJSON = Options -> RunObjectRequiredAction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runObjectRequiredAction")


-- | Details on the tool outputs needed for this run to continue.
data RunObjectRequiredActionSubmitToolOutputs = RunObjectRequiredActionSubmitToolOutputs
  { RunObjectRequiredActionSubmitToolOutputs -> [RunToolCallObject]
runObjectRequiredActionSubmitToolOutputsToolUnderscorecalls :: [RunToolCallObject] -- ^ A list of the relevant tool calls.
  } deriving (Int -> RunObjectRequiredActionSubmitToolOutputs -> ShowS
[RunObjectRequiredActionSubmitToolOutputs] -> ShowS
RunObjectRequiredActionSubmitToolOutputs -> String
(Int -> RunObjectRequiredActionSubmitToolOutputs -> ShowS)
-> (RunObjectRequiredActionSubmitToolOutputs -> String)
-> ([RunObjectRequiredActionSubmitToolOutputs] -> ShowS)
-> Show RunObjectRequiredActionSubmitToolOutputs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunObjectRequiredActionSubmitToolOutputs -> ShowS
showsPrec :: Int -> RunObjectRequiredActionSubmitToolOutputs -> ShowS
$cshow :: RunObjectRequiredActionSubmitToolOutputs -> String
show :: RunObjectRequiredActionSubmitToolOutputs -> String
$cshowList :: [RunObjectRequiredActionSubmitToolOutputs] -> ShowS
showList :: [RunObjectRequiredActionSubmitToolOutputs] -> ShowS
Show, RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
(RunObjectRequiredActionSubmitToolOutputs
 -> RunObjectRequiredActionSubmitToolOutputs -> Bool)
-> (RunObjectRequiredActionSubmitToolOutputs
    -> RunObjectRequiredActionSubmitToolOutputs -> Bool)
-> Eq RunObjectRequiredActionSubmitToolOutputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
== :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
$c/= :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
/= :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
Eq, Eq RunObjectRequiredActionSubmitToolOutputs
Eq RunObjectRequiredActionSubmitToolOutputs =>
(RunObjectRequiredActionSubmitToolOutputs
 -> RunObjectRequiredActionSubmitToolOutputs -> Ordering)
-> (RunObjectRequiredActionSubmitToolOutputs
    -> RunObjectRequiredActionSubmitToolOutputs -> Bool)
-> (RunObjectRequiredActionSubmitToolOutputs
    -> RunObjectRequiredActionSubmitToolOutputs -> Bool)
-> (RunObjectRequiredActionSubmitToolOutputs
    -> RunObjectRequiredActionSubmitToolOutputs -> Bool)
-> (RunObjectRequiredActionSubmitToolOutputs
    -> RunObjectRequiredActionSubmitToolOutputs -> Bool)
-> (RunObjectRequiredActionSubmitToolOutputs
    -> RunObjectRequiredActionSubmitToolOutputs
    -> RunObjectRequiredActionSubmitToolOutputs)
-> (RunObjectRequiredActionSubmitToolOutputs
    -> RunObjectRequiredActionSubmitToolOutputs
    -> RunObjectRequiredActionSubmitToolOutputs)
-> Ord RunObjectRequiredActionSubmitToolOutputs
RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Ordering
RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Ordering
compare :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Ordering
$c< :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
< :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
$c<= :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
<= :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
$c> :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
> :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
$c>= :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
>= :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs -> Bool
$cmax :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
max :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
$cmin :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
min :: RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
Ord, (forall x.
 RunObjectRequiredActionSubmitToolOutputs
 -> Rep RunObjectRequiredActionSubmitToolOutputs x)
-> (forall x.
    Rep RunObjectRequiredActionSubmitToolOutputs x
    -> RunObjectRequiredActionSubmitToolOutputs)
-> Generic RunObjectRequiredActionSubmitToolOutputs
forall x.
Rep RunObjectRequiredActionSubmitToolOutputs x
-> RunObjectRequiredActionSubmitToolOutputs
forall x.
RunObjectRequiredActionSubmitToolOutputs
-> Rep RunObjectRequiredActionSubmitToolOutputs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunObjectRequiredActionSubmitToolOutputs
-> Rep RunObjectRequiredActionSubmitToolOutputs x
from :: forall x.
RunObjectRequiredActionSubmitToolOutputs
-> Rep RunObjectRequiredActionSubmitToolOutputs x
$cto :: forall x.
Rep RunObjectRequiredActionSubmitToolOutputs x
-> RunObjectRequiredActionSubmitToolOutputs
to :: forall x.
Rep RunObjectRequiredActionSubmitToolOutputs x
-> RunObjectRequiredActionSubmitToolOutputs
Generic, Typeable RunObjectRequiredActionSubmitToolOutputs
Typeable RunObjectRequiredActionSubmitToolOutputs =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunObjectRequiredActionSubmitToolOutputs
 -> c RunObjectRequiredActionSubmitToolOutputs)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunObjectRequiredActionSubmitToolOutputs)
-> (RunObjectRequiredActionSubmitToolOutputs -> Constr)
-> (RunObjectRequiredActionSubmitToolOutputs -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunObjectRequiredActionSubmitToolOutputs))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunObjectRequiredActionSubmitToolOutputs))
-> ((forall b. Data b => b -> b)
    -> RunObjectRequiredActionSubmitToolOutputs
    -> RunObjectRequiredActionSubmitToolOutputs)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunObjectRequiredActionSubmitToolOutputs
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunObjectRequiredActionSubmitToolOutputs
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunObjectRequiredActionSubmitToolOutputs -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunObjectRequiredActionSubmitToolOutputs
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunObjectRequiredActionSubmitToolOutputs
    -> m RunObjectRequiredActionSubmitToolOutputs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunObjectRequiredActionSubmitToolOutputs
    -> m RunObjectRequiredActionSubmitToolOutputs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunObjectRequiredActionSubmitToolOutputs
    -> m RunObjectRequiredActionSubmitToolOutputs)
-> Data RunObjectRequiredActionSubmitToolOutputs
RunObjectRequiredActionSubmitToolOutputs -> Constr
RunObjectRequiredActionSubmitToolOutputs -> DataType
(forall b. Data b => b -> b)
-> RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunObjectRequiredActionSubmitToolOutputs
-> u
forall u.
(forall d. Data d => d -> u)
-> RunObjectRequiredActionSubmitToolOutputs -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredActionSubmitToolOutputs
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredActionSubmitToolOutputs
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredActionSubmitToolOutputs
-> m RunObjectRequiredActionSubmitToolOutputs
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredActionSubmitToolOutputs
-> m RunObjectRequiredActionSubmitToolOutputs
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunObjectRequiredActionSubmitToolOutputs
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunObjectRequiredActionSubmitToolOutputs
-> c RunObjectRequiredActionSubmitToolOutputs
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunObjectRequiredActionSubmitToolOutputs)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunObjectRequiredActionSubmitToolOutputs)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunObjectRequiredActionSubmitToolOutputs
-> c RunObjectRequiredActionSubmitToolOutputs
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunObjectRequiredActionSubmitToolOutputs
-> c RunObjectRequiredActionSubmitToolOutputs
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunObjectRequiredActionSubmitToolOutputs
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunObjectRequiredActionSubmitToolOutputs
$ctoConstr :: RunObjectRequiredActionSubmitToolOutputs -> Constr
toConstr :: RunObjectRequiredActionSubmitToolOutputs -> Constr
$cdataTypeOf :: RunObjectRequiredActionSubmitToolOutputs -> DataType
dataTypeOf :: RunObjectRequiredActionSubmitToolOutputs -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunObjectRequiredActionSubmitToolOutputs)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunObjectRequiredActionSubmitToolOutputs)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunObjectRequiredActionSubmitToolOutputs)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunObjectRequiredActionSubmitToolOutputs)
$cgmapT :: (forall b. Data b => b -> b)
-> RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
gmapT :: (forall b. Data b => b -> b)
-> RunObjectRequiredActionSubmitToolOutputs
-> RunObjectRequiredActionSubmitToolOutputs
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredActionSubmitToolOutputs
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredActionSubmitToolOutputs
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredActionSubmitToolOutputs
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunObjectRequiredActionSubmitToolOutputs
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunObjectRequiredActionSubmitToolOutputs -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunObjectRequiredActionSubmitToolOutputs -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunObjectRequiredActionSubmitToolOutputs
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunObjectRequiredActionSubmitToolOutputs
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredActionSubmitToolOutputs
-> m RunObjectRequiredActionSubmitToolOutputs
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredActionSubmitToolOutputs
-> m RunObjectRequiredActionSubmitToolOutputs
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredActionSubmitToolOutputs
-> m RunObjectRequiredActionSubmitToolOutputs
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredActionSubmitToolOutputs
-> m RunObjectRequiredActionSubmitToolOutputs
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredActionSubmitToolOutputs
-> m RunObjectRequiredActionSubmitToolOutputs
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunObjectRequiredActionSubmitToolOutputs
-> m RunObjectRequiredActionSubmitToolOutputs
Data)

instance FromJSON RunObjectRequiredActionSubmitToolOutputs where
  parseJSON :: Value -> Parser RunObjectRequiredActionSubmitToolOutputs
parseJSON = Options -> Value -> Parser RunObjectRequiredActionSubmitToolOutputs
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runObjectRequiredActionSubmitToolOutputs")
instance ToJSON RunObjectRequiredActionSubmitToolOutputs where
  toJSON :: RunObjectRequiredActionSubmitToolOutputs -> Value
toJSON = Options -> RunObjectRequiredActionSubmitToolOutputs -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runObjectRequiredActionSubmitToolOutputs")


-- | Usage statistics related to the run step. This value will be &#x60;null&#x60; while the run step&#39;s status is &#x60;in_progress&#x60;.
data RunStepCompletionUsage = RunStepCompletionUsage
  { RunStepCompletionUsage -> Int
runStepCompletionUsageCompletionUnderscoretokens :: Int -- ^ Number of completion tokens used over the course of the run step.
  , RunStepCompletionUsage -> Int
runStepCompletionUsagePromptUnderscoretokens :: Int -- ^ Number of prompt tokens used over the course of the run step.
  , RunStepCompletionUsage -> Int
runStepCompletionUsageTotalUnderscoretokens :: Int -- ^ Total number of tokens used (prompt + completion).
  } deriving (Int -> RunStepCompletionUsage -> ShowS
[RunStepCompletionUsage] -> ShowS
RunStepCompletionUsage -> String
(Int -> RunStepCompletionUsage -> ShowS)
-> (RunStepCompletionUsage -> String)
-> ([RunStepCompletionUsage] -> ShowS)
-> Show RunStepCompletionUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepCompletionUsage -> ShowS
showsPrec :: Int -> RunStepCompletionUsage -> ShowS
$cshow :: RunStepCompletionUsage -> String
show :: RunStepCompletionUsage -> String
$cshowList :: [RunStepCompletionUsage] -> ShowS
showList :: [RunStepCompletionUsage] -> ShowS
Show, RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
(RunStepCompletionUsage -> RunStepCompletionUsage -> Bool)
-> (RunStepCompletionUsage -> RunStepCompletionUsage -> Bool)
-> Eq RunStepCompletionUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
== :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
$c/= :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
/= :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
Eq, Eq RunStepCompletionUsage
Eq RunStepCompletionUsage =>
(RunStepCompletionUsage -> RunStepCompletionUsage -> Ordering)
-> (RunStepCompletionUsage -> RunStepCompletionUsage -> Bool)
-> (RunStepCompletionUsage -> RunStepCompletionUsage -> Bool)
-> (RunStepCompletionUsage -> RunStepCompletionUsage -> Bool)
-> (RunStepCompletionUsage -> RunStepCompletionUsage -> Bool)
-> (RunStepCompletionUsage
    -> RunStepCompletionUsage -> RunStepCompletionUsage)
-> (RunStepCompletionUsage
    -> RunStepCompletionUsage -> RunStepCompletionUsage)
-> Ord RunStepCompletionUsage
RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
RunStepCompletionUsage -> RunStepCompletionUsage -> Ordering
RunStepCompletionUsage
-> RunStepCompletionUsage -> RunStepCompletionUsage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepCompletionUsage -> RunStepCompletionUsage -> Ordering
compare :: RunStepCompletionUsage -> RunStepCompletionUsage -> Ordering
$c< :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
< :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
$c<= :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
<= :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
$c> :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
> :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
$c>= :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
>= :: RunStepCompletionUsage -> RunStepCompletionUsage -> Bool
$cmax :: RunStepCompletionUsage
-> RunStepCompletionUsage -> RunStepCompletionUsage
max :: RunStepCompletionUsage
-> RunStepCompletionUsage -> RunStepCompletionUsage
$cmin :: RunStepCompletionUsage
-> RunStepCompletionUsage -> RunStepCompletionUsage
min :: RunStepCompletionUsage
-> RunStepCompletionUsage -> RunStepCompletionUsage
Ord, (forall x. RunStepCompletionUsage -> Rep RunStepCompletionUsage x)
-> (forall x.
    Rep RunStepCompletionUsage x -> RunStepCompletionUsage)
-> Generic RunStepCompletionUsage
forall x. Rep RunStepCompletionUsage x -> RunStepCompletionUsage
forall x. RunStepCompletionUsage -> Rep RunStepCompletionUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunStepCompletionUsage -> Rep RunStepCompletionUsage x
from :: forall x. RunStepCompletionUsage -> Rep RunStepCompletionUsage x
$cto :: forall x. Rep RunStepCompletionUsage x -> RunStepCompletionUsage
to :: forall x. Rep RunStepCompletionUsage x -> RunStepCompletionUsage
Generic, Typeable RunStepCompletionUsage
Typeable RunStepCompletionUsage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepCompletionUsage
 -> c RunStepCompletionUsage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RunStepCompletionUsage)
-> (RunStepCompletionUsage -> Constr)
-> (RunStepCompletionUsage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RunStepCompletionUsage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepCompletionUsage))
-> ((forall b. Data b => b -> b)
    -> RunStepCompletionUsage -> RunStepCompletionUsage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepCompletionUsage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepCompletionUsage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RunStepCompletionUsage -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RunStepCompletionUsage -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepCompletionUsage -> m RunStepCompletionUsage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepCompletionUsage -> m RunStepCompletionUsage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepCompletionUsage -> m RunStepCompletionUsage)
-> Data RunStepCompletionUsage
RunStepCompletionUsage -> Constr
RunStepCompletionUsage -> DataType
(forall b. Data b => b -> b)
-> RunStepCompletionUsage -> RunStepCompletionUsage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RunStepCompletionUsage -> u
forall u.
(forall d. Data d => d -> u) -> RunStepCompletionUsage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepCompletionUsage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepCompletionUsage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepCompletionUsage -> m RunStepCompletionUsage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepCompletionUsage -> m RunStepCompletionUsage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepCompletionUsage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepCompletionUsage
-> c RunStepCompletionUsage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepCompletionUsage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepCompletionUsage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepCompletionUsage
-> c RunStepCompletionUsage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepCompletionUsage
-> c RunStepCompletionUsage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepCompletionUsage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepCompletionUsage
$ctoConstr :: RunStepCompletionUsage -> Constr
toConstr :: RunStepCompletionUsage -> Constr
$cdataTypeOf :: RunStepCompletionUsage -> DataType
dataTypeOf :: RunStepCompletionUsage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepCompletionUsage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepCompletionUsage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepCompletionUsage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepCompletionUsage)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepCompletionUsage -> RunStepCompletionUsage
gmapT :: (forall b. Data b => b -> b)
-> RunStepCompletionUsage -> RunStepCompletionUsage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepCompletionUsage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepCompletionUsage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepCompletionUsage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepCompletionUsage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RunStepCompletionUsage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> RunStepCompletionUsage -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunStepCompletionUsage -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunStepCompletionUsage -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepCompletionUsage -> m RunStepCompletionUsage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepCompletionUsage -> m RunStepCompletionUsage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepCompletionUsage -> m RunStepCompletionUsage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepCompletionUsage -> m RunStepCompletionUsage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepCompletionUsage -> m RunStepCompletionUsage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepCompletionUsage -> m RunStepCompletionUsage
Data)

instance FromJSON RunStepCompletionUsage where
  parseJSON :: Value -> Parser RunStepCompletionUsage
parseJSON = Options -> Value -> Parser RunStepCompletionUsage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepCompletionUsage")
instance ToJSON RunStepCompletionUsage where
  toJSON :: RunStepCompletionUsage -> Value
toJSON = Options -> RunStepCompletionUsage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepCompletionUsage")


-- | Details of the message creation by the run step.
data RunStepDetailsMessageCreationObject = RunStepDetailsMessageCreationObject
  { RunStepDetailsMessageCreationObject -> Text
runStepDetailsMessageCreationObjectType :: Text -- ^ Always `message_creation`.
  , RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObjectMessageCreation
runStepDetailsMessageCreationObjectMessageUnderscorecreation :: RunStepDetailsMessageCreationObjectMessageCreation -- ^ 
  } deriving (Int -> RunStepDetailsMessageCreationObject -> ShowS
[RunStepDetailsMessageCreationObject] -> ShowS
RunStepDetailsMessageCreationObject -> String
(Int -> RunStepDetailsMessageCreationObject -> ShowS)
-> (RunStepDetailsMessageCreationObject -> String)
-> ([RunStepDetailsMessageCreationObject] -> ShowS)
-> Show RunStepDetailsMessageCreationObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsMessageCreationObject -> ShowS
showsPrec :: Int -> RunStepDetailsMessageCreationObject -> ShowS
$cshow :: RunStepDetailsMessageCreationObject -> String
show :: RunStepDetailsMessageCreationObject -> String
$cshowList :: [RunStepDetailsMessageCreationObject] -> ShowS
showList :: [RunStepDetailsMessageCreationObject] -> ShowS
Show, RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
(RunStepDetailsMessageCreationObject
 -> RunStepDetailsMessageCreationObject -> Bool)
-> (RunStepDetailsMessageCreationObject
    -> RunStepDetailsMessageCreationObject -> Bool)
-> Eq RunStepDetailsMessageCreationObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
== :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
$c/= :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
/= :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
Eq, Eq RunStepDetailsMessageCreationObject
Eq RunStepDetailsMessageCreationObject =>
(RunStepDetailsMessageCreationObject
 -> RunStepDetailsMessageCreationObject -> Ordering)
-> (RunStepDetailsMessageCreationObject
    -> RunStepDetailsMessageCreationObject -> Bool)
-> (RunStepDetailsMessageCreationObject
    -> RunStepDetailsMessageCreationObject -> Bool)
-> (RunStepDetailsMessageCreationObject
    -> RunStepDetailsMessageCreationObject -> Bool)
-> (RunStepDetailsMessageCreationObject
    -> RunStepDetailsMessageCreationObject -> Bool)
-> (RunStepDetailsMessageCreationObject
    -> RunStepDetailsMessageCreationObject
    -> RunStepDetailsMessageCreationObject)
-> (RunStepDetailsMessageCreationObject
    -> RunStepDetailsMessageCreationObject
    -> RunStepDetailsMessageCreationObject)
-> Ord RunStepDetailsMessageCreationObject
RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Ordering
RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Ordering
compare :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Ordering
$c< :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
< :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
$c<= :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
<= :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
$c> :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
> :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
$c>= :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
>= :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject -> Bool
$cmax :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
max :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
$cmin :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
min :: RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
Ord, (forall x.
 RunStepDetailsMessageCreationObject
 -> Rep RunStepDetailsMessageCreationObject x)
-> (forall x.
    Rep RunStepDetailsMessageCreationObject x
    -> RunStepDetailsMessageCreationObject)
-> Generic RunStepDetailsMessageCreationObject
forall x.
Rep RunStepDetailsMessageCreationObject x
-> RunStepDetailsMessageCreationObject
forall x.
RunStepDetailsMessageCreationObject
-> Rep RunStepDetailsMessageCreationObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsMessageCreationObject
-> Rep RunStepDetailsMessageCreationObject x
from :: forall x.
RunStepDetailsMessageCreationObject
-> Rep RunStepDetailsMessageCreationObject x
$cto :: forall x.
Rep RunStepDetailsMessageCreationObject x
-> RunStepDetailsMessageCreationObject
to :: forall x.
Rep RunStepDetailsMessageCreationObject x
-> RunStepDetailsMessageCreationObject
Generic, Typeable RunStepDetailsMessageCreationObject
Typeable RunStepDetailsMessageCreationObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsMessageCreationObject
 -> c RunStepDetailsMessageCreationObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsMessageCreationObject)
-> (RunStepDetailsMessageCreationObject -> Constr)
-> (RunStepDetailsMessageCreationObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsMessageCreationObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsMessageCreationObject))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsMessageCreationObject
    -> RunStepDetailsMessageCreationObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsMessageCreationObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsMessageCreationObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsMessageCreationObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsMessageCreationObject
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsMessageCreationObject
    -> m RunStepDetailsMessageCreationObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsMessageCreationObject
    -> m RunStepDetailsMessageCreationObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsMessageCreationObject
    -> m RunStepDetailsMessageCreationObject)
-> Data RunStepDetailsMessageCreationObject
RunStepDetailsMessageCreationObject -> Constr
RunStepDetailsMessageCreationObject -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObject
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObject
-> m RunStepDetailsMessageCreationObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObject
-> m RunStepDetailsMessageCreationObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsMessageCreationObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsMessageCreationObject
-> c RunStepDetailsMessageCreationObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsMessageCreationObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsMessageCreationObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsMessageCreationObject
-> c RunStepDetailsMessageCreationObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsMessageCreationObject
-> c RunStepDetailsMessageCreationObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsMessageCreationObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsMessageCreationObject
$ctoConstr :: RunStepDetailsMessageCreationObject -> Constr
toConstr :: RunStepDetailsMessageCreationObject -> Constr
$cdataTypeOf :: RunStepDetailsMessageCreationObject -> DataType
dataTypeOf :: RunStepDetailsMessageCreationObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsMessageCreationObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsMessageCreationObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsMessageCreationObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsMessageCreationObject)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsMessageCreationObject
-> RunStepDetailsMessageCreationObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObject
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObject
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObject
-> m RunStepDetailsMessageCreationObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObject
-> m RunStepDetailsMessageCreationObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObject
-> m RunStepDetailsMessageCreationObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObject
-> m RunStepDetailsMessageCreationObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObject
-> m RunStepDetailsMessageCreationObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObject
-> m RunStepDetailsMessageCreationObject
Data)

instance FromJSON RunStepDetailsMessageCreationObject where
  parseJSON :: Value -> Parser RunStepDetailsMessageCreationObject
parseJSON = Options -> Value -> Parser RunStepDetailsMessageCreationObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsMessageCreationObject")
instance ToJSON RunStepDetailsMessageCreationObject where
  toJSON :: RunStepDetailsMessageCreationObject -> Value
toJSON = Options -> RunStepDetailsMessageCreationObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsMessageCreationObject")


-- | 
data RunStepDetailsMessageCreationObjectMessageCreation = RunStepDetailsMessageCreationObjectMessageCreation
  { RunStepDetailsMessageCreationObjectMessageCreation -> Text
runStepDetailsMessageCreationObjectMessageCreationMessageUnderscoreid :: Text -- ^ The ID of the message that was created by this run step.
  } deriving (Int -> RunStepDetailsMessageCreationObjectMessageCreation -> ShowS
[RunStepDetailsMessageCreationObjectMessageCreation] -> ShowS
RunStepDetailsMessageCreationObjectMessageCreation -> String
(Int
 -> RunStepDetailsMessageCreationObjectMessageCreation -> ShowS)
-> (RunStepDetailsMessageCreationObjectMessageCreation -> String)
-> ([RunStepDetailsMessageCreationObjectMessageCreation] -> ShowS)
-> Show RunStepDetailsMessageCreationObjectMessageCreation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsMessageCreationObjectMessageCreation -> ShowS
showsPrec :: Int -> RunStepDetailsMessageCreationObjectMessageCreation -> ShowS
$cshow :: RunStepDetailsMessageCreationObjectMessageCreation -> String
show :: RunStepDetailsMessageCreationObjectMessageCreation -> String
$cshowList :: [RunStepDetailsMessageCreationObjectMessageCreation] -> ShowS
showList :: [RunStepDetailsMessageCreationObjectMessageCreation] -> ShowS
Show, RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
(RunStepDetailsMessageCreationObjectMessageCreation
 -> RunStepDetailsMessageCreationObjectMessageCreation -> Bool)
-> (RunStepDetailsMessageCreationObjectMessageCreation
    -> RunStepDetailsMessageCreationObjectMessageCreation -> Bool)
-> Eq RunStepDetailsMessageCreationObjectMessageCreation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
== :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
$c/= :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
/= :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
Eq, Eq RunStepDetailsMessageCreationObjectMessageCreation
Eq RunStepDetailsMessageCreationObjectMessageCreation =>
(RunStepDetailsMessageCreationObjectMessageCreation
 -> RunStepDetailsMessageCreationObjectMessageCreation -> Ordering)
-> (RunStepDetailsMessageCreationObjectMessageCreation
    -> RunStepDetailsMessageCreationObjectMessageCreation -> Bool)
-> (RunStepDetailsMessageCreationObjectMessageCreation
    -> RunStepDetailsMessageCreationObjectMessageCreation -> Bool)
-> (RunStepDetailsMessageCreationObjectMessageCreation
    -> RunStepDetailsMessageCreationObjectMessageCreation -> Bool)
-> (RunStepDetailsMessageCreationObjectMessageCreation
    -> RunStepDetailsMessageCreationObjectMessageCreation -> Bool)
-> (RunStepDetailsMessageCreationObjectMessageCreation
    -> RunStepDetailsMessageCreationObjectMessageCreation
    -> RunStepDetailsMessageCreationObjectMessageCreation)
-> (RunStepDetailsMessageCreationObjectMessageCreation
    -> RunStepDetailsMessageCreationObjectMessageCreation
    -> RunStepDetailsMessageCreationObjectMessageCreation)
-> Ord RunStepDetailsMessageCreationObjectMessageCreation
RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Ordering
RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Ordering
compare :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Ordering
$c< :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
< :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
$c<= :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
<= :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
$c> :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
> :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
$c>= :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
>= :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation -> Bool
$cmax :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
max :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
$cmin :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
min :: RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
Ord, (forall x.
 RunStepDetailsMessageCreationObjectMessageCreation
 -> Rep RunStepDetailsMessageCreationObjectMessageCreation x)
-> (forall x.
    Rep RunStepDetailsMessageCreationObjectMessageCreation x
    -> RunStepDetailsMessageCreationObjectMessageCreation)
-> Generic RunStepDetailsMessageCreationObjectMessageCreation
forall x.
Rep RunStepDetailsMessageCreationObjectMessageCreation x
-> RunStepDetailsMessageCreationObjectMessageCreation
forall x.
RunStepDetailsMessageCreationObjectMessageCreation
-> Rep RunStepDetailsMessageCreationObjectMessageCreation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsMessageCreationObjectMessageCreation
-> Rep RunStepDetailsMessageCreationObjectMessageCreation x
from :: forall x.
RunStepDetailsMessageCreationObjectMessageCreation
-> Rep RunStepDetailsMessageCreationObjectMessageCreation x
$cto :: forall x.
Rep RunStepDetailsMessageCreationObjectMessageCreation x
-> RunStepDetailsMessageCreationObjectMessageCreation
to :: forall x.
Rep RunStepDetailsMessageCreationObjectMessageCreation x
-> RunStepDetailsMessageCreationObjectMessageCreation
Generic, Typeable RunStepDetailsMessageCreationObjectMessageCreation
Typeable RunStepDetailsMessageCreationObjectMessageCreation =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsMessageCreationObjectMessageCreation
 -> c RunStepDetailsMessageCreationObjectMessageCreation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsMessageCreationObjectMessageCreation)
-> (RunStepDetailsMessageCreationObjectMessageCreation -> Constr)
-> (RunStepDetailsMessageCreationObjectMessageCreation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsMessageCreationObjectMessageCreation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsMessageCreationObjectMessageCreation))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsMessageCreationObjectMessageCreation
    -> RunStepDetailsMessageCreationObjectMessageCreation)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsMessageCreationObjectMessageCreation
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsMessageCreationObjectMessageCreation
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsMessageCreationObjectMessageCreation -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsMessageCreationObjectMessageCreation
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsMessageCreationObjectMessageCreation
    -> m RunStepDetailsMessageCreationObjectMessageCreation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsMessageCreationObjectMessageCreation
    -> m RunStepDetailsMessageCreationObjectMessageCreation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsMessageCreationObjectMessageCreation
    -> m RunStepDetailsMessageCreationObjectMessageCreation)
-> Data RunStepDetailsMessageCreationObjectMessageCreation
RunStepDetailsMessageCreationObjectMessageCreation -> Constr
RunStepDetailsMessageCreationObjectMessageCreation -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObjectMessageCreation -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObjectMessageCreation
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObjectMessageCreation
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> m RunStepDetailsMessageCreationObjectMessageCreation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> m RunStepDetailsMessageCreationObjectMessageCreation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsMessageCreationObjectMessageCreation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> c RunStepDetailsMessageCreationObjectMessageCreation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsMessageCreationObjectMessageCreation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsMessageCreationObjectMessageCreation)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> c RunStepDetailsMessageCreationObjectMessageCreation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> c RunStepDetailsMessageCreationObjectMessageCreation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsMessageCreationObjectMessageCreation
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsMessageCreationObjectMessageCreation
$ctoConstr :: RunStepDetailsMessageCreationObjectMessageCreation -> Constr
toConstr :: RunStepDetailsMessageCreationObjectMessageCreation -> Constr
$cdataTypeOf :: RunStepDetailsMessageCreationObjectMessageCreation -> DataType
dataTypeOf :: RunStepDetailsMessageCreationObjectMessageCreation -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsMessageCreationObjectMessageCreation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsMessageCreationObjectMessageCreation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsMessageCreationObjectMessageCreation)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsMessageCreationObjectMessageCreation)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> RunStepDetailsMessageCreationObjectMessageCreation
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObjectMessageCreation
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObjectMessageCreation
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObjectMessageCreation
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsMessageCreationObjectMessageCreation
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObjectMessageCreation -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObjectMessageCreation -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> m RunStepDetailsMessageCreationObjectMessageCreation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> m RunStepDetailsMessageCreationObjectMessageCreation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> m RunStepDetailsMessageCreationObjectMessageCreation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> m RunStepDetailsMessageCreationObjectMessageCreation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> m RunStepDetailsMessageCreationObjectMessageCreation
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsMessageCreationObjectMessageCreation
-> m RunStepDetailsMessageCreationObjectMessageCreation
Data)

instance FromJSON RunStepDetailsMessageCreationObjectMessageCreation where
  parseJSON :: Value -> Parser RunStepDetailsMessageCreationObjectMessageCreation
parseJSON = Options
-> Value
-> Parser RunStepDetailsMessageCreationObjectMessageCreation
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsMessageCreationObjectMessageCreation")
instance ToJSON RunStepDetailsMessageCreationObjectMessageCreation where
  toJSON :: RunStepDetailsMessageCreationObjectMessageCreation -> Value
toJSON = Options
-> RunStepDetailsMessageCreationObjectMessageCreation -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsMessageCreationObjectMessageCreation")


-- | Details of the Code Interpreter tool call the run step was involved in.
data RunStepDetailsToolCallsCodeObject = RunStepDetailsToolCallsCodeObject
  { RunStepDetailsToolCallsCodeObject -> Text
runStepDetailsToolCallsCodeObjectId :: Text -- ^ The ID of the tool call.
  , RunStepDetailsToolCallsCodeObject -> Text
runStepDetailsToolCallsCodeObjectType :: Text -- ^ The type of tool call. This is always going to be `code_interpreter` for this type of tool call.
  , RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
runStepDetailsToolCallsCodeObjectCodeUnderscoreinterpreter :: RunStepDetailsToolCallsCodeObjectCodeInterpreter -- ^ 
  } deriving (Int -> RunStepDetailsToolCallsCodeObject -> ShowS
[RunStepDetailsToolCallsCodeObject] -> ShowS
RunStepDetailsToolCallsCodeObject -> String
(Int -> RunStepDetailsToolCallsCodeObject -> ShowS)
-> (RunStepDetailsToolCallsCodeObject -> String)
-> ([RunStepDetailsToolCallsCodeObject] -> ShowS)
-> Show RunStepDetailsToolCallsCodeObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsToolCallsCodeObject -> ShowS
showsPrec :: Int -> RunStepDetailsToolCallsCodeObject -> ShowS
$cshow :: RunStepDetailsToolCallsCodeObject -> String
show :: RunStepDetailsToolCallsCodeObject -> String
$cshowList :: [RunStepDetailsToolCallsCodeObject] -> ShowS
showList :: [RunStepDetailsToolCallsCodeObject] -> ShowS
Show, RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
(RunStepDetailsToolCallsCodeObject
 -> RunStepDetailsToolCallsCodeObject -> Bool)
-> (RunStepDetailsToolCallsCodeObject
    -> RunStepDetailsToolCallsCodeObject -> Bool)
-> Eq RunStepDetailsToolCallsCodeObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
== :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
$c/= :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
/= :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
Eq, Eq RunStepDetailsToolCallsCodeObject
Eq RunStepDetailsToolCallsCodeObject =>
(RunStepDetailsToolCallsCodeObject
 -> RunStepDetailsToolCallsCodeObject -> Ordering)
-> (RunStepDetailsToolCallsCodeObject
    -> RunStepDetailsToolCallsCodeObject -> Bool)
-> (RunStepDetailsToolCallsCodeObject
    -> RunStepDetailsToolCallsCodeObject -> Bool)
-> (RunStepDetailsToolCallsCodeObject
    -> RunStepDetailsToolCallsCodeObject -> Bool)
-> (RunStepDetailsToolCallsCodeObject
    -> RunStepDetailsToolCallsCodeObject -> Bool)
-> (RunStepDetailsToolCallsCodeObject
    -> RunStepDetailsToolCallsCodeObject
    -> RunStepDetailsToolCallsCodeObject)
-> (RunStepDetailsToolCallsCodeObject
    -> RunStepDetailsToolCallsCodeObject
    -> RunStepDetailsToolCallsCodeObject)
-> Ord RunStepDetailsToolCallsCodeObject
RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Ordering
RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Ordering
compare :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Ordering
$c< :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
< :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
$c<= :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
<= :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
$c> :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
> :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
$c>= :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
>= :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject -> Bool
$cmax :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
max :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
$cmin :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
min :: RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
Ord, (forall x.
 RunStepDetailsToolCallsCodeObject
 -> Rep RunStepDetailsToolCallsCodeObject x)
-> (forall x.
    Rep RunStepDetailsToolCallsCodeObject x
    -> RunStepDetailsToolCallsCodeObject)
-> Generic RunStepDetailsToolCallsCodeObject
forall x.
Rep RunStepDetailsToolCallsCodeObject x
-> RunStepDetailsToolCallsCodeObject
forall x.
RunStepDetailsToolCallsCodeObject
-> Rep RunStepDetailsToolCallsCodeObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsCodeObject
-> Rep RunStepDetailsToolCallsCodeObject x
from :: forall x.
RunStepDetailsToolCallsCodeObject
-> Rep RunStepDetailsToolCallsCodeObject x
$cto :: forall x.
Rep RunStepDetailsToolCallsCodeObject x
-> RunStepDetailsToolCallsCodeObject
to :: forall x.
Rep RunStepDetailsToolCallsCodeObject x
-> RunStepDetailsToolCallsCodeObject
Generic, Typeable RunStepDetailsToolCallsCodeObject
Typeable RunStepDetailsToolCallsCodeObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsCodeObject
 -> c RunStepDetailsToolCallsCodeObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsCodeObject)
-> (RunStepDetailsToolCallsCodeObject -> Constr)
-> (RunStepDetailsToolCallsCodeObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsToolCallsCodeObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsToolCallsCodeObject))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsCodeObject
    -> RunStepDetailsToolCallsCodeObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeObject
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeObject
    -> m RunStepDetailsToolCallsCodeObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeObject
    -> m RunStepDetailsToolCallsCodeObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeObject
    -> m RunStepDetailsToolCallsCodeObject)
-> Data RunStepDetailsToolCallsCodeObject
RunStepDetailsToolCallsCodeObject -> Constr
RunStepDetailsToolCallsCodeObject -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObject
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObject
-> m RunStepDetailsToolCallsCodeObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObject
-> m RunStepDetailsToolCallsCodeObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeObject
-> c RunStepDetailsToolCallsCodeObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeObject
-> c RunStepDetailsToolCallsCodeObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeObject
-> c RunStepDetailsToolCallsCodeObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeObject
$ctoConstr :: RunStepDetailsToolCallsCodeObject -> Constr
toConstr :: RunStepDetailsToolCallsCodeObject -> Constr
$cdataTypeOf :: RunStepDetailsToolCallsCodeObject -> DataType
dataTypeOf :: RunStepDetailsToolCallsCodeObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeObject)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeObject
-> RunStepDetailsToolCallsCodeObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObject
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObject
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObject
-> m RunStepDetailsToolCallsCodeObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObject
-> m RunStepDetailsToolCallsCodeObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObject
-> m RunStepDetailsToolCallsCodeObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObject
-> m RunStepDetailsToolCallsCodeObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObject
-> m RunStepDetailsToolCallsCodeObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObject
-> m RunStepDetailsToolCallsCodeObject
Data)

instance FromJSON RunStepDetailsToolCallsCodeObject where
  parseJSON :: Value -> Parser RunStepDetailsToolCallsCodeObject
parseJSON = Options -> Value -> Parser RunStepDetailsToolCallsCodeObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeObject")
instance ToJSON RunStepDetailsToolCallsCodeObject where
  toJSON :: RunStepDetailsToolCallsCodeObject -> Value
toJSON = Options -> RunStepDetailsToolCallsCodeObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeObject")


-- | The Code Interpreter tool call definition.
data RunStepDetailsToolCallsCodeObjectCodeInterpreter = RunStepDetailsToolCallsCodeObjectCodeInterpreter
  { RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Text
runStepDetailsToolCallsCodeObjectCodeInterpreterInput :: Text -- ^ The input to the Code Interpreter tool call.
  , RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> [RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner]
runStepDetailsToolCallsCodeObjectCodeInterpreterOutputs :: [RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner] -- ^ The outputs from the Code Interpreter tool call. Code Interpreter can output one or more items, including text (`logs`) or images (`image`). Each of these are represented by a different object type.
  } deriving (Int -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> ShowS
[RunStepDetailsToolCallsCodeObjectCodeInterpreter] -> ShowS
RunStepDetailsToolCallsCodeObjectCodeInterpreter -> String
(Int -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> ShowS)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreter -> String)
-> ([RunStepDetailsToolCallsCodeObjectCodeInterpreter] -> ShowS)
-> Show RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> ShowS
showsPrec :: Int -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> ShowS
$cshow :: RunStepDetailsToolCallsCodeObjectCodeInterpreter -> String
show :: RunStepDetailsToolCallsCodeObjectCodeInterpreter -> String
$cshowList :: [RunStepDetailsToolCallsCodeObjectCodeInterpreter] -> ShowS
showList :: [RunStepDetailsToolCallsCodeObjectCodeInterpreter] -> ShowS
Show, RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
(RunStepDetailsToolCallsCodeObjectCodeInterpreter
 -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool)
-> Eq RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
== :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
$c/= :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
/= :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
Eq, Eq RunStepDetailsToolCallsCodeObjectCodeInterpreter
Eq RunStepDetailsToolCallsCodeObjectCodeInterpreter =>
(RunStepDetailsToolCallsCodeObjectCodeInterpreter
 -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Ordering)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter)
-> Ord RunStepDetailsToolCallsCodeObjectCodeInterpreter
RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Ordering
RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Ordering
compare :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Ordering
$c< :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
< :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
$c<= :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
<= :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
$c> :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
> :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
$c>= :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
>= :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Bool
$cmax :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
max :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
$cmin :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
min :: RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
Ord, (forall x.
 RunStepDetailsToolCallsCodeObjectCodeInterpreter
 -> Rep RunStepDetailsToolCallsCodeObjectCodeInterpreter x)
-> (forall x.
    Rep RunStepDetailsToolCallsCodeObjectCodeInterpreter x
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter)
-> Generic RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall x.
Rep RunStepDetailsToolCallsCodeObjectCodeInterpreter x
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall x.
RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> Rep RunStepDetailsToolCallsCodeObjectCodeInterpreter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> Rep RunStepDetailsToolCallsCodeObjectCodeInterpreter x
from :: forall x.
RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> Rep RunStepDetailsToolCallsCodeObjectCodeInterpreter x
$cto :: forall x.
Rep RunStepDetailsToolCallsCodeObjectCodeInterpreter x
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
to :: forall x.
Rep RunStepDetailsToolCallsCodeObjectCodeInterpreter x
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
Generic, Typeable RunStepDetailsToolCallsCodeObjectCodeInterpreter
Typeable RunStepDetailsToolCallsCodeObjectCodeInterpreter =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsCodeObjectCodeInterpreter
 -> c RunStepDetailsToolCallsCodeObjectCodeInterpreter)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsCodeObjectCodeInterpreter)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Constr)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreter -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsToolCallsCodeObjectCodeInterpreter))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsToolCallsCodeObjectCodeInterpreter))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> m RunStepDetailsToolCallsCodeObjectCodeInterpreter)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> m RunStepDetailsToolCallsCodeObjectCodeInterpreter)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreter
    -> m RunStepDetailsToolCallsCodeObjectCodeInterpreter)
-> Data RunStepDetailsToolCallsCodeObjectCodeInterpreter
RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Constr
RunStepDetailsToolCallsCodeObjectCodeInterpreter -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeObjectCodeInterpreter)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeObjectCodeInterpreter)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreter
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreter
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreter
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreter
$ctoConstr :: RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Constr
toConstr :: RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Constr
$cdataTypeOf :: RunStepDetailsToolCallsCodeObjectCodeInterpreter -> DataType
dataTypeOf :: RunStepDetailsToolCallsCodeObjectCodeInterpreter -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeObjectCodeInterpreter)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeObjectCodeInterpreter)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeObjectCodeInterpreter)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeObjectCodeInterpreter)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreter
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreter
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreter
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreter
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreter
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreter
Data)

instance FromJSON RunStepDetailsToolCallsCodeObjectCodeInterpreter where
  parseJSON :: Value -> Parser RunStepDetailsToolCallsCodeObjectCodeInterpreter
parseJSON = Options
-> Value -> Parser RunStepDetailsToolCallsCodeObjectCodeInterpreter
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeObjectCodeInterpreter")
instance ToJSON RunStepDetailsToolCallsCodeObjectCodeInterpreter where
  toJSON :: RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Value
toJSON = Options
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeObjectCodeInterpreter")


-- | 
data RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner = RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
  { RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Text
runStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInnerType :: Text -- ^ Always `image`.
  , RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Text
runStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInnerLogs :: Text -- ^ The text output from the Code Interpreter tool call.
  , RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
runStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInnerImage :: RunStepDetailsToolCallsCodeOutputImageObjectImage -- ^ 
  } deriving (Int
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> ShowS
[RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner]
-> ShowS
RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> String
(Int
 -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
 -> ShowS)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> String)
-> ([RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner]
    -> ShowS)
-> Show
     RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> ShowS
showsPrec :: Int
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> ShowS
$cshow :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> String
show :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> String
$cshowList :: [RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner]
-> ShowS
showList :: [RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner]
-> ShowS
Show, RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
(RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
 -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
 -> Bool)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> Bool)
-> Eq RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
== :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
$c/= :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
/= :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
Eq, Eq RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
Eq RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner =>
(RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
 -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
 -> Ordering)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> Bool)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> Bool)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> Bool)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> Bool)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
-> Ord RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Ordering
RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Ordering
compare :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Ordering
$c< :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
< :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
$c<= :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
<= :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
$c> :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
> :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
$c>= :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
>= :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Bool
$cmax :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
max :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
$cmin :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
min :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
Ord, (forall x.
 RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
 -> Rep
      RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner x)
-> (forall x.
    Rep RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner x
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
-> Generic
     RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall x.
Rep RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner x
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall x.
RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Rep
     RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Rep
     RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner x
from :: forall x.
RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Rep
     RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner x
$cto :: forall x.
Rep RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner x
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
to :: forall x.
Rep RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner x
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
Generic, Typeable
  RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
Typeable
  RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
 -> c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> Constr)
-> (RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe
         (c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe
         (c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
    -> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
-> Data
     RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Constr
RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
$ctoConstr :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Constr
toConstr :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Constr
$cdataTypeOf :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> DataType
dataTypeOf :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> m RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
Data)

instance FromJSON RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner where
  parseJSON :: Value
-> Parser
     RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
parseJSON = Options
-> Value
-> Parser
     RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner")
instance ToJSON RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner where
  toJSON :: RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Value
toJSON = Options
-> RunStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner
-> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeObjectCodeInterpreterOutputsInner")


-- | 
data RunStepDetailsToolCallsCodeOutputImageObject = RunStepDetailsToolCallsCodeOutputImageObject
  { RunStepDetailsToolCallsCodeOutputImageObject -> Text
runStepDetailsToolCallsCodeOutputImageObjectType :: Text -- ^ Always `image`.
  , RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
runStepDetailsToolCallsCodeOutputImageObjectImage :: RunStepDetailsToolCallsCodeOutputImageObjectImage -- ^ 
  } deriving (Int -> RunStepDetailsToolCallsCodeOutputImageObject -> ShowS
[RunStepDetailsToolCallsCodeOutputImageObject] -> ShowS
RunStepDetailsToolCallsCodeOutputImageObject -> String
(Int -> RunStepDetailsToolCallsCodeOutputImageObject -> ShowS)
-> (RunStepDetailsToolCallsCodeOutputImageObject -> String)
-> ([RunStepDetailsToolCallsCodeOutputImageObject] -> ShowS)
-> Show RunStepDetailsToolCallsCodeOutputImageObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsToolCallsCodeOutputImageObject -> ShowS
showsPrec :: Int -> RunStepDetailsToolCallsCodeOutputImageObject -> ShowS
$cshow :: RunStepDetailsToolCallsCodeOutputImageObject -> String
show :: RunStepDetailsToolCallsCodeOutputImageObject -> String
$cshowList :: [RunStepDetailsToolCallsCodeOutputImageObject] -> ShowS
showList :: [RunStepDetailsToolCallsCodeOutputImageObject] -> ShowS
Show, RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
(RunStepDetailsToolCallsCodeOutputImageObject
 -> RunStepDetailsToolCallsCodeOutputImageObject -> Bool)
-> (RunStepDetailsToolCallsCodeOutputImageObject
    -> RunStepDetailsToolCallsCodeOutputImageObject -> Bool)
-> Eq RunStepDetailsToolCallsCodeOutputImageObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
== :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
$c/= :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
/= :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
Eq, Eq RunStepDetailsToolCallsCodeOutputImageObject
Eq RunStepDetailsToolCallsCodeOutputImageObject =>
(RunStepDetailsToolCallsCodeOutputImageObject
 -> RunStepDetailsToolCallsCodeOutputImageObject -> Ordering)
-> (RunStepDetailsToolCallsCodeOutputImageObject
    -> RunStepDetailsToolCallsCodeOutputImageObject -> Bool)
-> (RunStepDetailsToolCallsCodeOutputImageObject
    -> RunStepDetailsToolCallsCodeOutputImageObject -> Bool)
-> (RunStepDetailsToolCallsCodeOutputImageObject
    -> RunStepDetailsToolCallsCodeOutputImageObject -> Bool)
-> (RunStepDetailsToolCallsCodeOutputImageObject
    -> RunStepDetailsToolCallsCodeOutputImageObject -> Bool)
-> (RunStepDetailsToolCallsCodeOutputImageObject
    -> RunStepDetailsToolCallsCodeOutputImageObject
    -> RunStepDetailsToolCallsCodeOutputImageObject)
-> (RunStepDetailsToolCallsCodeOutputImageObject
    -> RunStepDetailsToolCallsCodeOutputImageObject
    -> RunStepDetailsToolCallsCodeOutputImageObject)
-> Ord RunStepDetailsToolCallsCodeOutputImageObject
RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Ordering
RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Ordering
compare :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Ordering
$c< :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
< :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
$c<= :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
<= :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
$c> :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
> :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
$c>= :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
>= :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject -> Bool
$cmax :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
max :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
$cmin :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
min :: RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
Ord, (forall x.
 RunStepDetailsToolCallsCodeOutputImageObject
 -> Rep RunStepDetailsToolCallsCodeOutputImageObject x)
-> (forall x.
    Rep RunStepDetailsToolCallsCodeOutputImageObject x
    -> RunStepDetailsToolCallsCodeOutputImageObject)
-> Generic RunStepDetailsToolCallsCodeOutputImageObject
forall x.
Rep RunStepDetailsToolCallsCodeOutputImageObject x
-> RunStepDetailsToolCallsCodeOutputImageObject
forall x.
RunStepDetailsToolCallsCodeOutputImageObject
-> Rep RunStepDetailsToolCallsCodeOutputImageObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsCodeOutputImageObject
-> Rep RunStepDetailsToolCallsCodeOutputImageObject x
from :: forall x.
RunStepDetailsToolCallsCodeOutputImageObject
-> Rep RunStepDetailsToolCallsCodeOutputImageObject x
$cto :: forall x.
Rep RunStepDetailsToolCallsCodeOutputImageObject x
-> RunStepDetailsToolCallsCodeOutputImageObject
to :: forall x.
Rep RunStepDetailsToolCallsCodeOutputImageObject x
-> RunStepDetailsToolCallsCodeOutputImageObject
Generic, Typeable RunStepDetailsToolCallsCodeOutputImageObject
Typeable RunStepDetailsToolCallsCodeOutputImageObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsCodeOutputImageObject
 -> c RunStepDetailsToolCallsCodeOutputImageObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsCodeOutputImageObject)
-> (RunStepDetailsToolCallsCodeOutputImageObject -> Constr)
-> (RunStepDetailsToolCallsCodeOutputImageObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsToolCallsCodeOutputImageObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsToolCallsCodeOutputImageObject))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsCodeOutputImageObject
    -> RunStepDetailsToolCallsCodeOutputImageObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeOutputImageObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeOutputImageObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeOutputImageObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeOutputImageObject
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeOutputImageObject
    -> m RunStepDetailsToolCallsCodeOutputImageObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeOutputImageObject
    -> m RunStepDetailsToolCallsCodeOutputImageObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeOutputImageObject
    -> m RunStepDetailsToolCallsCodeOutputImageObject)
-> Data RunStepDetailsToolCallsCodeOutputImageObject
RunStepDetailsToolCallsCodeOutputImageObject -> Constr
RunStepDetailsToolCallsCodeOutputImageObject -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> m RunStepDetailsToolCallsCodeOutputImageObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> m RunStepDetailsToolCallsCodeOutputImageObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeOutputImageObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> c RunStepDetailsToolCallsCodeOutputImageObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> c RunStepDetailsToolCallsCodeOutputImageObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> c RunStepDetailsToolCallsCodeOutputImageObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeOutputImageObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeOutputImageObject
$ctoConstr :: RunStepDetailsToolCallsCodeOutputImageObject -> Constr
toConstr :: RunStepDetailsToolCallsCodeOutputImageObject -> Constr
$cdataTypeOf :: RunStepDetailsToolCallsCodeOutputImageObject -> DataType
dataTypeOf :: RunStepDetailsToolCallsCodeOutputImageObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObject)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> RunStepDetailsToolCallsCodeOutputImageObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> m RunStepDetailsToolCallsCodeOutputImageObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> m RunStepDetailsToolCallsCodeOutputImageObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> m RunStepDetailsToolCallsCodeOutputImageObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> m RunStepDetailsToolCallsCodeOutputImageObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> m RunStepDetailsToolCallsCodeOutputImageObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObject
-> m RunStepDetailsToolCallsCodeOutputImageObject
Data)

instance FromJSON RunStepDetailsToolCallsCodeOutputImageObject where
  parseJSON :: Value -> Parser RunStepDetailsToolCallsCodeOutputImageObject
parseJSON = Options
-> Value -> Parser RunStepDetailsToolCallsCodeOutputImageObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeOutputImageObject")
instance ToJSON RunStepDetailsToolCallsCodeOutputImageObject where
  toJSON :: RunStepDetailsToolCallsCodeOutputImageObject -> Value
toJSON = Options -> RunStepDetailsToolCallsCodeOutputImageObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeOutputImageObject")


-- | 
data RunStepDetailsToolCallsCodeOutputImageObjectImage = RunStepDetailsToolCallsCodeOutputImageObjectImage
  { RunStepDetailsToolCallsCodeOutputImageObjectImage -> Text
runStepDetailsToolCallsCodeOutputImageObjectImageFileUnderscoreid :: Text -- ^ The [file](/docs/api-reference/files) ID of the image.
  } deriving (Int -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> ShowS
[RunStepDetailsToolCallsCodeOutputImageObjectImage] -> ShowS
RunStepDetailsToolCallsCodeOutputImageObjectImage -> String
(Int -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> ShowS)
-> (RunStepDetailsToolCallsCodeOutputImageObjectImage -> String)
-> ([RunStepDetailsToolCallsCodeOutputImageObjectImage] -> ShowS)
-> Show RunStepDetailsToolCallsCodeOutputImageObjectImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> ShowS
showsPrec :: Int -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> ShowS
$cshow :: RunStepDetailsToolCallsCodeOutputImageObjectImage -> String
show :: RunStepDetailsToolCallsCodeOutputImageObjectImage -> String
$cshowList :: [RunStepDetailsToolCallsCodeOutputImageObjectImage] -> ShowS
showList :: [RunStepDetailsToolCallsCodeOutputImageObjectImage] -> ShowS
Show, RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
(RunStepDetailsToolCallsCodeOutputImageObjectImage
 -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool)
-> (RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool)
-> Eq RunStepDetailsToolCallsCodeOutputImageObjectImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
== :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
$c/= :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
/= :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
Eq, Eq RunStepDetailsToolCallsCodeOutputImageObjectImage
Eq RunStepDetailsToolCallsCodeOutputImageObjectImage =>
(RunStepDetailsToolCallsCodeOutputImageObjectImage
 -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Ordering)
-> (RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool)
-> (RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool)
-> (RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool)
-> (RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool)
-> (RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage)
-> (RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage)
-> Ord RunStepDetailsToolCallsCodeOutputImageObjectImage
RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Ordering
RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Ordering
compare :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Ordering
$c< :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
< :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
$c<= :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
<= :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
$c> :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
> :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
$c>= :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
>= :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Bool
$cmax :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
max :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
$cmin :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
min :: RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
Ord, (forall x.
 RunStepDetailsToolCallsCodeOutputImageObjectImage
 -> Rep RunStepDetailsToolCallsCodeOutputImageObjectImage x)
-> (forall x.
    Rep RunStepDetailsToolCallsCodeOutputImageObjectImage x
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage)
-> Generic RunStepDetailsToolCallsCodeOutputImageObjectImage
forall x.
Rep RunStepDetailsToolCallsCodeOutputImageObjectImage x
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
forall x.
RunStepDetailsToolCallsCodeOutputImageObjectImage
-> Rep RunStepDetailsToolCallsCodeOutputImageObjectImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsCodeOutputImageObjectImage
-> Rep RunStepDetailsToolCallsCodeOutputImageObjectImage x
from :: forall x.
RunStepDetailsToolCallsCodeOutputImageObjectImage
-> Rep RunStepDetailsToolCallsCodeOutputImageObjectImage x
$cto :: forall x.
Rep RunStepDetailsToolCallsCodeOutputImageObjectImage x
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
to :: forall x.
Rep RunStepDetailsToolCallsCodeOutputImageObjectImage x
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
Generic, Typeable RunStepDetailsToolCallsCodeOutputImageObjectImage
Typeable RunStepDetailsToolCallsCodeOutputImageObjectImage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsCodeOutputImageObjectImage
 -> c RunStepDetailsToolCallsCodeOutputImageObjectImage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsCodeOutputImageObjectImage)
-> (RunStepDetailsToolCallsCodeOutputImageObjectImage -> Constr)
-> (RunStepDetailsToolCallsCodeOutputImageObjectImage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsToolCallsCodeOutputImageObjectImage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsToolCallsCodeOutputImageObjectImage))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> m RunStepDetailsToolCallsCodeOutputImageObjectImage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> m RunStepDetailsToolCallsCodeOutputImageObjectImage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeOutputImageObjectImage
    -> m RunStepDetailsToolCallsCodeOutputImageObjectImage)
-> Data RunStepDetailsToolCallsCodeOutputImageObjectImage
RunStepDetailsToolCallsCodeOutputImageObjectImage -> Constr
RunStepDetailsToolCallsCodeOutputImageObjectImage -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> m RunStepDetailsToolCallsCodeOutputImageObjectImage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> m RunStepDetailsToolCallsCodeOutputImageObjectImage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeOutputImageObjectImage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> c RunStepDetailsToolCallsCodeOutputImageObjectImage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObjectImage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObjectImage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> c RunStepDetailsToolCallsCodeOutputImageObjectImage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> c RunStepDetailsToolCallsCodeOutputImageObjectImage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeOutputImageObjectImage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeOutputImageObjectImage
$ctoConstr :: RunStepDetailsToolCallsCodeOutputImageObjectImage -> Constr
toConstr :: RunStepDetailsToolCallsCodeOutputImageObjectImage -> Constr
$cdataTypeOf :: RunStepDetailsToolCallsCodeOutputImageObjectImage -> DataType
dataTypeOf :: RunStepDetailsToolCallsCodeOutputImageObjectImage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObjectImage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObjectImage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObjectImage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeOutputImageObjectImage)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> m RunStepDetailsToolCallsCodeOutputImageObjectImage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> m RunStepDetailsToolCallsCodeOutputImageObjectImage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> m RunStepDetailsToolCallsCodeOutputImageObjectImage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> m RunStepDetailsToolCallsCodeOutputImageObjectImage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> m RunStepDetailsToolCallsCodeOutputImageObjectImage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputImageObjectImage
-> m RunStepDetailsToolCallsCodeOutputImageObjectImage
Data)

instance FromJSON RunStepDetailsToolCallsCodeOutputImageObjectImage where
  parseJSON :: Value -> Parser RunStepDetailsToolCallsCodeOutputImageObjectImage
parseJSON = Options
-> Value
-> Parser RunStepDetailsToolCallsCodeOutputImageObjectImage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeOutputImageObjectImage")
instance ToJSON RunStepDetailsToolCallsCodeOutputImageObjectImage where
  toJSON :: RunStepDetailsToolCallsCodeOutputImageObjectImage -> Value
toJSON = Options
-> RunStepDetailsToolCallsCodeOutputImageObjectImage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeOutputImageObjectImage")


-- | Text output from the Code Interpreter tool call as part of a run step.
data RunStepDetailsToolCallsCodeOutputLogsObject = RunStepDetailsToolCallsCodeOutputLogsObject
  { RunStepDetailsToolCallsCodeOutputLogsObject -> Text
runStepDetailsToolCallsCodeOutputLogsObjectType :: Text -- ^ Always `logs`.
  , RunStepDetailsToolCallsCodeOutputLogsObject -> Text
runStepDetailsToolCallsCodeOutputLogsObjectLogs :: Text -- ^ The text output from the Code Interpreter tool call.
  } deriving (Int -> RunStepDetailsToolCallsCodeOutputLogsObject -> ShowS
[RunStepDetailsToolCallsCodeOutputLogsObject] -> ShowS
RunStepDetailsToolCallsCodeOutputLogsObject -> String
(Int -> RunStepDetailsToolCallsCodeOutputLogsObject -> ShowS)
-> (RunStepDetailsToolCallsCodeOutputLogsObject -> String)
-> ([RunStepDetailsToolCallsCodeOutputLogsObject] -> ShowS)
-> Show RunStepDetailsToolCallsCodeOutputLogsObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsToolCallsCodeOutputLogsObject -> ShowS
showsPrec :: Int -> RunStepDetailsToolCallsCodeOutputLogsObject -> ShowS
$cshow :: RunStepDetailsToolCallsCodeOutputLogsObject -> String
show :: RunStepDetailsToolCallsCodeOutputLogsObject -> String
$cshowList :: [RunStepDetailsToolCallsCodeOutputLogsObject] -> ShowS
showList :: [RunStepDetailsToolCallsCodeOutputLogsObject] -> ShowS
Show, RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
(RunStepDetailsToolCallsCodeOutputLogsObject
 -> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool)
-> (RunStepDetailsToolCallsCodeOutputLogsObject
    -> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool)
-> Eq RunStepDetailsToolCallsCodeOutputLogsObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
== :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
$c/= :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
/= :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
Eq, Eq RunStepDetailsToolCallsCodeOutputLogsObject
Eq RunStepDetailsToolCallsCodeOutputLogsObject =>
(RunStepDetailsToolCallsCodeOutputLogsObject
 -> RunStepDetailsToolCallsCodeOutputLogsObject -> Ordering)
-> (RunStepDetailsToolCallsCodeOutputLogsObject
    -> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool)
-> (RunStepDetailsToolCallsCodeOutputLogsObject
    -> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool)
-> (RunStepDetailsToolCallsCodeOutputLogsObject
    -> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool)
-> (RunStepDetailsToolCallsCodeOutputLogsObject
    -> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool)
-> (RunStepDetailsToolCallsCodeOutputLogsObject
    -> RunStepDetailsToolCallsCodeOutputLogsObject
    -> RunStepDetailsToolCallsCodeOutputLogsObject)
-> (RunStepDetailsToolCallsCodeOutputLogsObject
    -> RunStepDetailsToolCallsCodeOutputLogsObject
    -> RunStepDetailsToolCallsCodeOutputLogsObject)
-> Ord RunStepDetailsToolCallsCodeOutputLogsObject
RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Ordering
RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Ordering
compare :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Ordering
$c< :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
< :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
$c<= :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
<= :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
$c> :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
> :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
$c>= :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
>= :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject -> Bool
$cmax :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
max :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
$cmin :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
min :: RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
Ord, (forall x.
 RunStepDetailsToolCallsCodeOutputLogsObject
 -> Rep RunStepDetailsToolCallsCodeOutputLogsObject x)
-> (forall x.
    Rep RunStepDetailsToolCallsCodeOutputLogsObject x
    -> RunStepDetailsToolCallsCodeOutputLogsObject)
-> Generic RunStepDetailsToolCallsCodeOutputLogsObject
forall x.
Rep RunStepDetailsToolCallsCodeOutputLogsObject x
-> RunStepDetailsToolCallsCodeOutputLogsObject
forall x.
RunStepDetailsToolCallsCodeOutputLogsObject
-> Rep RunStepDetailsToolCallsCodeOutputLogsObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsCodeOutputLogsObject
-> Rep RunStepDetailsToolCallsCodeOutputLogsObject x
from :: forall x.
RunStepDetailsToolCallsCodeOutputLogsObject
-> Rep RunStepDetailsToolCallsCodeOutputLogsObject x
$cto :: forall x.
Rep RunStepDetailsToolCallsCodeOutputLogsObject x
-> RunStepDetailsToolCallsCodeOutputLogsObject
to :: forall x.
Rep RunStepDetailsToolCallsCodeOutputLogsObject x
-> RunStepDetailsToolCallsCodeOutputLogsObject
Generic, Typeable RunStepDetailsToolCallsCodeOutputLogsObject
Typeable RunStepDetailsToolCallsCodeOutputLogsObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsCodeOutputLogsObject
 -> c RunStepDetailsToolCallsCodeOutputLogsObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsCodeOutputLogsObject)
-> (RunStepDetailsToolCallsCodeOutputLogsObject -> Constr)
-> (RunStepDetailsToolCallsCodeOutputLogsObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsToolCallsCodeOutputLogsObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsToolCallsCodeOutputLogsObject))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsCodeOutputLogsObject
    -> RunStepDetailsToolCallsCodeOutputLogsObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeOutputLogsObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsCodeOutputLogsObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeOutputLogsObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsCodeOutputLogsObject
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeOutputLogsObject
    -> m RunStepDetailsToolCallsCodeOutputLogsObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeOutputLogsObject
    -> m RunStepDetailsToolCallsCodeOutputLogsObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsCodeOutputLogsObject
    -> m RunStepDetailsToolCallsCodeOutputLogsObject)
-> Data RunStepDetailsToolCallsCodeOutputLogsObject
RunStepDetailsToolCallsCodeOutputLogsObject -> Constr
RunStepDetailsToolCallsCodeOutputLogsObject -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputLogsObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> m RunStepDetailsToolCallsCodeOutputLogsObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> m RunStepDetailsToolCallsCodeOutputLogsObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeOutputLogsObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> c RunStepDetailsToolCallsCodeOutputLogsObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeOutputLogsObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeOutputLogsObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> c RunStepDetailsToolCallsCodeOutputLogsObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> c RunStepDetailsToolCallsCodeOutputLogsObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeOutputLogsObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsCodeOutputLogsObject
$ctoConstr :: RunStepDetailsToolCallsCodeOutputLogsObject -> Constr
toConstr :: RunStepDetailsToolCallsCodeOutputLogsObject -> Constr
$cdataTypeOf :: RunStepDetailsToolCallsCodeOutputLogsObject -> DataType
dataTypeOf :: RunStepDetailsToolCallsCodeOutputLogsObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeOutputLogsObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsCodeOutputLogsObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeOutputLogsObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsCodeOutputLogsObject)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> RunStepDetailsToolCallsCodeOutputLogsObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputLogsObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputLogsObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> m RunStepDetailsToolCallsCodeOutputLogsObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> m RunStepDetailsToolCallsCodeOutputLogsObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> m RunStepDetailsToolCallsCodeOutputLogsObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> m RunStepDetailsToolCallsCodeOutputLogsObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> m RunStepDetailsToolCallsCodeOutputLogsObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsCodeOutputLogsObject
-> m RunStepDetailsToolCallsCodeOutputLogsObject
Data)

instance FromJSON RunStepDetailsToolCallsCodeOutputLogsObject where
  parseJSON :: Value -> Parser RunStepDetailsToolCallsCodeOutputLogsObject
parseJSON = Options
-> Value -> Parser RunStepDetailsToolCallsCodeOutputLogsObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeOutputLogsObject")
instance ToJSON RunStepDetailsToolCallsCodeOutputLogsObject where
  toJSON :: RunStepDetailsToolCallsCodeOutputLogsObject -> Value
toJSON = Options -> RunStepDetailsToolCallsCodeOutputLogsObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsCodeOutputLogsObject")


-- | 
data RunStepDetailsToolCallsFunctionObject = RunStepDetailsToolCallsFunctionObject
  { RunStepDetailsToolCallsFunctionObject -> Text
runStepDetailsToolCallsFunctionObjectId :: Text -- ^ The ID of the tool call object.
  , RunStepDetailsToolCallsFunctionObject -> Text
runStepDetailsToolCallsFunctionObjectType :: Text -- ^ The type of tool call. This is always going to be `function` for this type of tool call.
  , RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObjectFunction
runStepDetailsToolCallsFunctionObjectFunction :: RunStepDetailsToolCallsFunctionObjectFunction -- ^ 
  } deriving (Int -> RunStepDetailsToolCallsFunctionObject -> ShowS
[RunStepDetailsToolCallsFunctionObject] -> ShowS
RunStepDetailsToolCallsFunctionObject -> String
(Int -> RunStepDetailsToolCallsFunctionObject -> ShowS)
-> (RunStepDetailsToolCallsFunctionObject -> String)
-> ([RunStepDetailsToolCallsFunctionObject] -> ShowS)
-> Show RunStepDetailsToolCallsFunctionObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsToolCallsFunctionObject -> ShowS
showsPrec :: Int -> RunStepDetailsToolCallsFunctionObject -> ShowS
$cshow :: RunStepDetailsToolCallsFunctionObject -> String
show :: RunStepDetailsToolCallsFunctionObject -> String
$cshowList :: [RunStepDetailsToolCallsFunctionObject] -> ShowS
showList :: [RunStepDetailsToolCallsFunctionObject] -> ShowS
Show, RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
(RunStepDetailsToolCallsFunctionObject
 -> RunStepDetailsToolCallsFunctionObject -> Bool)
-> (RunStepDetailsToolCallsFunctionObject
    -> RunStepDetailsToolCallsFunctionObject -> Bool)
-> Eq RunStepDetailsToolCallsFunctionObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
== :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
$c/= :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
/= :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
Eq, Eq RunStepDetailsToolCallsFunctionObject
Eq RunStepDetailsToolCallsFunctionObject =>
(RunStepDetailsToolCallsFunctionObject
 -> RunStepDetailsToolCallsFunctionObject -> Ordering)
-> (RunStepDetailsToolCallsFunctionObject
    -> RunStepDetailsToolCallsFunctionObject -> Bool)
-> (RunStepDetailsToolCallsFunctionObject
    -> RunStepDetailsToolCallsFunctionObject -> Bool)
-> (RunStepDetailsToolCallsFunctionObject
    -> RunStepDetailsToolCallsFunctionObject -> Bool)
-> (RunStepDetailsToolCallsFunctionObject
    -> RunStepDetailsToolCallsFunctionObject -> Bool)
-> (RunStepDetailsToolCallsFunctionObject
    -> RunStepDetailsToolCallsFunctionObject
    -> RunStepDetailsToolCallsFunctionObject)
-> (RunStepDetailsToolCallsFunctionObject
    -> RunStepDetailsToolCallsFunctionObject
    -> RunStepDetailsToolCallsFunctionObject)
-> Ord RunStepDetailsToolCallsFunctionObject
RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Ordering
RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Ordering
compare :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Ordering
$c< :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
< :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
$c<= :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
<= :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
$c> :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
> :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
$c>= :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
>= :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject -> Bool
$cmax :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
max :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
$cmin :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
min :: RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
Ord, (forall x.
 RunStepDetailsToolCallsFunctionObject
 -> Rep RunStepDetailsToolCallsFunctionObject x)
-> (forall x.
    Rep RunStepDetailsToolCallsFunctionObject x
    -> RunStepDetailsToolCallsFunctionObject)
-> Generic RunStepDetailsToolCallsFunctionObject
forall x.
Rep RunStepDetailsToolCallsFunctionObject x
-> RunStepDetailsToolCallsFunctionObject
forall x.
RunStepDetailsToolCallsFunctionObject
-> Rep RunStepDetailsToolCallsFunctionObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsFunctionObject
-> Rep RunStepDetailsToolCallsFunctionObject x
from :: forall x.
RunStepDetailsToolCallsFunctionObject
-> Rep RunStepDetailsToolCallsFunctionObject x
$cto :: forall x.
Rep RunStepDetailsToolCallsFunctionObject x
-> RunStepDetailsToolCallsFunctionObject
to :: forall x.
Rep RunStepDetailsToolCallsFunctionObject x
-> RunStepDetailsToolCallsFunctionObject
Generic, Typeable RunStepDetailsToolCallsFunctionObject
Typeable RunStepDetailsToolCallsFunctionObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsFunctionObject
 -> c RunStepDetailsToolCallsFunctionObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsFunctionObject)
-> (RunStepDetailsToolCallsFunctionObject -> Constr)
-> (RunStepDetailsToolCallsFunctionObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsToolCallsFunctionObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsToolCallsFunctionObject))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsFunctionObject
    -> RunStepDetailsToolCallsFunctionObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsFunctionObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsFunctionObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsFunctionObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsFunctionObject
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsFunctionObject
    -> m RunStepDetailsToolCallsFunctionObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsFunctionObject
    -> m RunStepDetailsToolCallsFunctionObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsFunctionObject
    -> m RunStepDetailsToolCallsFunctionObject)
-> Data RunStepDetailsToolCallsFunctionObject
RunStepDetailsToolCallsFunctionObject -> Constr
RunStepDetailsToolCallsFunctionObject -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObject
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObject
-> m RunStepDetailsToolCallsFunctionObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObject
-> m RunStepDetailsToolCallsFunctionObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsFunctionObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsFunctionObject
-> c RunStepDetailsToolCallsFunctionObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsFunctionObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsFunctionObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsFunctionObject
-> c RunStepDetailsToolCallsFunctionObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsFunctionObject
-> c RunStepDetailsToolCallsFunctionObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsFunctionObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsFunctionObject
$ctoConstr :: RunStepDetailsToolCallsFunctionObject -> Constr
toConstr :: RunStepDetailsToolCallsFunctionObject -> Constr
$cdataTypeOf :: RunStepDetailsToolCallsFunctionObject -> DataType
dataTypeOf :: RunStepDetailsToolCallsFunctionObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsFunctionObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsFunctionObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsFunctionObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsFunctionObject)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsFunctionObject
-> RunStepDetailsToolCallsFunctionObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObject
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObject
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObject
-> m RunStepDetailsToolCallsFunctionObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObject
-> m RunStepDetailsToolCallsFunctionObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObject
-> m RunStepDetailsToolCallsFunctionObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObject
-> m RunStepDetailsToolCallsFunctionObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObject
-> m RunStepDetailsToolCallsFunctionObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObject
-> m RunStepDetailsToolCallsFunctionObject
Data)

instance FromJSON RunStepDetailsToolCallsFunctionObject where
  parseJSON :: Value -> Parser RunStepDetailsToolCallsFunctionObject
parseJSON = Options -> Value -> Parser RunStepDetailsToolCallsFunctionObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsFunctionObject")
instance ToJSON RunStepDetailsToolCallsFunctionObject where
  toJSON :: RunStepDetailsToolCallsFunctionObject -> Value
toJSON = Options -> RunStepDetailsToolCallsFunctionObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsFunctionObject")


-- | The definition of the function that was called.
data RunStepDetailsToolCallsFunctionObjectFunction = RunStepDetailsToolCallsFunctionObjectFunction
  { RunStepDetailsToolCallsFunctionObjectFunction -> Text
runStepDetailsToolCallsFunctionObjectFunctionName :: Text -- ^ The name of the function.
  , RunStepDetailsToolCallsFunctionObjectFunction -> Text
runStepDetailsToolCallsFunctionObjectFunctionArguments :: Text -- ^ The arguments passed to the function.
  , RunStepDetailsToolCallsFunctionObjectFunction -> Text
runStepDetailsToolCallsFunctionObjectFunctionOutput :: Text -- ^ The output of the function. This will be `null` if the outputs have not been [submitted](/docs/api-reference/runs/submitToolOutputs) yet.
  } deriving (Int -> RunStepDetailsToolCallsFunctionObjectFunction -> ShowS
[RunStepDetailsToolCallsFunctionObjectFunction] -> ShowS
RunStepDetailsToolCallsFunctionObjectFunction -> String
(Int -> RunStepDetailsToolCallsFunctionObjectFunction -> ShowS)
-> (RunStepDetailsToolCallsFunctionObjectFunction -> String)
-> ([RunStepDetailsToolCallsFunctionObjectFunction] -> ShowS)
-> Show RunStepDetailsToolCallsFunctionObjectFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsToolCallsFunctionObjectFunction -> ShowS
showsPrec :: Int -> RunStepDetailsToolCallsFunctionObjectFunction -> ShowS
$cshow :: RunStepDetailsToolCallsFunctionObjectFunction -> String
show :: RunStepDetailsToolCallsFunctionObjectFunction -> String
$cshowList :: [RunStepDetailsToolCallsFunctionObjectFunction] -> ShowS
showList :: [RunStepDetailsToolCallsFunctionObjectFunction] -> ShowS
Show, RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
(RunStepDetailsToolCallsFunctionObjectFunction
 -> RunStepDetailsToolCallsFunctionObjectFunction -> Bool)
-> (RunStepDetailsToolCallsFunctionObjectFunction
    -> RunStepDetailsToolCallsFunctionObjectFunction -> Bool)
-> Eq RunStepDetailsToolCallsFunctionObjectFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
== :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
$c/= :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
/= :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
Eq, Eq RunStepDetailsToolCallsFunctionObjectFunction
Eq RunStepDetailsToolCallsFunctionObjectFunction =>
(RunStepDetailsToolCallsFunctionObjectFunction
 -> RunStepDetailsToolCallsFunctionObjectFunction -> Ordering)
-> (RunStepDetailsToolCallsFunctionObjectFunction
    -> RunStepDetailsToolCallsFunctionObjectFunction -> Bool)
-> (RunStepDetailsToolCallsFunctionObjectFunction
    -> RunStepDetailsToolCallsFunctionObjectFunction -> Bool)
-> (RunStepDetailsToolCallsFunctionObjectFunction
    -> RunStepDetailsToolCallsFunctionObjectFunction -> Bool)
-> (RunStepDetailsToolCallsFunctionObjectFunction
    -> RunStepDetailsToolCallsFunctionObjectFunction -> Bool)
-> (RunStepDetailsToolCallsFunctionObjectFunction
    -> RunStepDetailsToolCallsFunctionObjectFunction
    -> RunStepDetailsToolCallsFunctionObjectFunction)
-> (RunStepDetailsToolCallsFunctionObjectFunction
    -> RunStepDetailsToolCallsFunctionObjectFunction
    -> RunStepDetailsToolCallsFunctionObjectFunction)
-> Ord RunStepDetailsToolCallsFunctionObjectFunction
RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Ordering
RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Ordering
compare :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Ordering
$c< :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
< :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
$c<= :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
<= :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
$c> :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
> :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
$c>= :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
>= :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction -> Bool
$cmax :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
max :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
$cmin :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
min :: RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
Ord, (forall x.
 RunStepDetailsToolCallsFunctionObjectFunction
 -> Rep RunStepDetailsToolCallsFunctionObjectFunction x)
-> (forall x.
    Rep RunStepDetailsToolCallsFunctionObjectFunction x
    -> RunStepDetailsToolCallsFunctionObjectFunction)
-> Generic RunStepDetailsToolCallsFunctionObjectFunction
forall x.
Rep RunStepDetailsToolCallsFunctionObjectFunction x
-> RunStepDetailsToolCallsFunctionObjectFunction
forall x.
RunStepDetailsToolCallsFunctionObjectFunction
-> Rep RunStepDetailsToolCallsFunctionObjectFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsFunctionObjectFunction
-> Rep RunStepDetailsToolCallsFunctionObjectFunction x
from :: forall x.
RunStepDetailsToolCallsFunctionObjectFunction
-> Rep RunStepDetailsToolCallsFunctionObjectFunction x
$cto :: forall x.
Rep RunStepDetailsToolCallsFunctionObjectFunction x
-> RunStepDetailsToolCallsFunctionObjectFunction
to :: forall x.
Rep RunStepDetailsToolCallsFunctionObjectFunction x
-> RunStepDetailsToolCallsFunctionObjectFunction
Generic, Typeable RunStepDetailsToolCallsFunctionObjectFunction
Typeable RunStepDetailsToolCallsFunctionObjectFunction =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsFunctionObjectFunction
 -> c RunStepDetailsToolCallsFunctionObjectFunction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsFunctionObjectFunction)
-> (RunStepDetailsToolCallsFunctionObjectFunction -> Constr)
-> (RunStepDetailsToolCallsFunctionObjectFunction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsToolCallsFunctionObjectFunction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsToolCallsFunctionObjectFunction))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsFunctionObjectFunction
    -> RunStepDetailsToolCallsFunctionObjectFunction)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsFunctionObjectFunction
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsFunctionObjectFunction
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsFunctionObjectFunction -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsFunctionObjectFunction
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsFunctionObjectFunction
    -> m RunStepDetailsToolCallsFunctionObjectFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsFunctionObjectFunction
    -> m RunStepDetailsToolCallsFunctionObjectFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsFunctionObjectFunction
    -> m RunStepDetailsToolCallsFunctionObjectFunction)
-> Data RunStepDetailsToolCallsFunctionObjectFunction
RunStepDetailsToolCallsFunctionObjectFunction -> Constr
RunStepDetailsToolCallsFunctionObjectFunction -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObjectFunction -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObjectFunction
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObjectFunction
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> m RunStepDetailsToolCallsFunctionObjectFunction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> m RunStepDetailsToolCallsFunctionObjectFunction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsFunctionObjectFunction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> c RunStepDetailsToolCallsFunctionObjectFunction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsFunctionObjectFunction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsFunctionObjectFunction)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> c RunStepDetailsToolCallsFunctionObjectFunction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> c RunStepDetailsToolCallsFunctionObjectFunction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsFunctionObjectFunction
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsFunctionObjectFunction
$ctoConstr :: RunStepDetailsToolCallsFunctionObjectFunction -> Constr
toConstr :: RunStepDetailsToolCallsFunctionObjectFunction -> Constr
$cdataTypeOf :: RunStepDetailsToolCallsFunctionObjectFunction -> DataType
dataTypeOf :: RunStepDetailsToolCallsFunctionObjectFunction -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsFunctionObjectFunction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsFunctionObjectFunction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsFunctionObjectFunction)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsFunctionObjectFunction)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> RunStepDetailsToolCallsFunctionObjectFunction
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObjectFunction
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObjectFunction
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObjectFunction
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsFunctionObjectFunction
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObjectFunction -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObjectFunction -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> m RunStepDetailsToolCallsFunctionObjectFunction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> m RunStepDetailsToolCallsFunctionObjectFunction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> m RunStepDetailsToolCallsFunctionObjectFunction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> m RunStepDetailsToolCallsFunctionObjectFunction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> m RunStepDetailsToolCallsFunctionObjectFunction
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsFunctionObjectFunction
-> m RunStepDetailsToolCallsFunctionObjectFunction
Data)

instance FromJSON RunStepDetailsToolCallsFunctionObjectFunction where
  parseJSON :: Value -> Parser RunStepDetailsToolCallsFunctionObjectFunction
parseJSON = Options
-> Value -> Parser RunStepDetailsToolCallsFunctionObjectFunction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsFunctionObjectFunction")
instance ToJSON RunStepDetailsToolCallsFunctionObjectFunction where
  toJSON :: RunStepDetailsToolCallsFunctionObjectFunction -> Value
toJSON = Options -> RunStepDetailsToolCallsFunctionObjectFunction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsFunctionObjectFunction")


-- | Details of the tool call.
data RunStepDetailsToolCallsObject = RunStepDetailsToolCallsObject
  { RunStepDetailsToolCallsObject -> Text
runStepDetailsToolCallsObjectType :: Text -- ^ Always `tool_calls`.
  , RunStepDetailsToolCallsObject
-> [RunStepDetailsToolCallsObjectToolCallsInner]
runStepDetailsToolCallsObjectToolUnderscorecalls :: [RunStepDetailsToolCallsObjectToolCallsInner] -- ^ An array of tool calls the run step was involved in. These can be associated with one of three types of tools: `code_interpreter`, `retrieval`, or `function`. 
  } deriving (Int -> RunStepDetailsToolCallsObject -> ShowS
[RunStepDetailsToolCallsObject] -> ShowS
RunStepDetailsToolCallsObject -> String
(Int -> RunStepDetailsToolCallsObject -> ShowS)
-> (RunStepDetailsToolCallsObject -> String)
-> ([RunStepDetailsToolCallsObject] -> ShowS)
-> Show RunStepDetailsToolCallsObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsToolCallsObject -> ShowS
showsPrec :: Int -> RunStepDetailsToolCallsObject -> ShowS
$cshow :: RunStepDetailsToolCallsObject -> String
show :: RunStepDetailsToolCallsObject -> String
$cshowList :: [RunStepDetailsToolCallsObject] -> ShowS
showList :: [RunStepDetailsToolCallsObject] -> ShowS
Show, RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
(RunStepDetailsToolCallsObject
 -> RunStepDetailsToolCallsObject -> Bool)
-> (RunStepDetailsToolCallsObject
    -> RunStepDetailsToolCallsObject -> Bool)
-> Eq RunStepDetailsToolCallsObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
== :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
$c/= :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
/= :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
Eq, Eq RunStepDetailsToolCallsObject
Eq RunStepDetailsToolCallsObject =>
(RunStepDetailsToolCallsObject
 -> RunStepDetailsToolCallsObject -> Ordering)
-> (RunStepDetailsToolCallsObject
    -> RunStepDetailsToolCallsObject -> Bool)
-> (RunStepDetailsToolCallsObject
    -> RunStepDetailsToolCallsObject -> Bool)
-> (RunStepDetailsToolCallsObject
    -> RunStepDetailsToolCallsObject -> Bool)
-> (RunStepDetailsToolCallsObject
    -> RunStepDetailsToolCallsObject -> Bool)
-> (RunStepDetailsToolCallsObject
    -> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject)
-> (RunStepDetailsToolCallsObject
    -> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject)
-> Ord RunStepDetailsToolCallsObject
RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Ordering
RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Ordering
compare :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Ordering
$c< :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
< :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
$c<= :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
<= :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
$c> :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
> :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
$c>= :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
>= :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> Bool
$cmax :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject
max :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject
$cmin :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject
min :: RunStepDetailsToolCallsObject
-> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject
Ord, (forall x.
 RunStepDetailsToolCallsObject
 -> Rep RunStepDetailsToolCallsObject x)
-> (forall x.
    Rep RunStepDetailsToolCallsObject x
    -> RunStepDetailsToolCallsObject)
-> Generic RunStepDetailsToolCallsObject
forall x.
Rep RunStepDetailsToolCallsObject x
-> RunStepDetailsToolCallsObject
forall x.
RunStepDetailsToolCallsObject
-> Rep RunStepDetailsToolCallsObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsObject
-> Rep RunStepDetailsToolCallsObject x
from :: forall x.
RunStepDetailsToolCallsObject
-> Rep RunStepDetailsToolCallsObject x
$cto :: forall x.
Rep RunStepDetailsToolCallsObject x
-> RunStepDetailsToolCallsObject
to :: forall x.
Rep RunStepDetailsToolCallsObject x
-> RunStepDetailsToolCallsObject
Generic, Typeable RunStepDetailsToolCallsObject
Typeable RunStepDetailsToolCallsObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsObject
 -> c RunStepDetailsToolCallsObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsObject)
-> (RunStepDetailsToolCallsObject -> Constr)
-> (RunStepDetailsToolCallsObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsToolCallsObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsToolCallsObject))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsObject
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsObject
    -> m RunStepDetailsToolCallsObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsObject
    -> m RunStepDetailsToolCallsObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsObject
    -> m RunStepDetailsToolCallsObject)
-> Data RunStepDetailsToolCallsObject
RunStepDetailsToolCallsObject -> Constr
RunStepDetailsToolCallsObject -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObject
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObject -> m RunStepDetailsToolCallsObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObject -> m RunStepDetailsToolCallsObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsObject
-> c RunStepDetailsToolCallsObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsObject
-> c RunStepDetailsToolCallsObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsObject
-> c RunStepDetailsToolCallsObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsObject
$ctoConstr :: RunStepDetailsToolCallsObject -> Constr
toConstr :: RunStepDetailsToolCallsObject -> Constr
$cdataTypeOf :: RunStepDetailsToolCallsObject -> DataType
dataTypeOf :: RunStepDetailsToolCallsObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsObject)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsObject -> RunStepDetailsToolCallsObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObject
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObject
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObject -> m RunStepDetailsToolCallsObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObject -> m RunStepDetailsToolCallsObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObject -> m RunStepDetailsToolCallsObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObject -> m RunStepDetailsToolCallsObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObject -> m RunStepDetailsToolCallsObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObject -> m RunStepDetailsToolCallsObject
Data)

instance FromJSON RunStepDetailsToolCallsObject where
  parseJSON :: Value -> Parser RunStepDetailsToolCallsObject
parseJSON = Options -> Value -> Parser RunStepDetailsToolCallsObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsObject")
instance ToJSON RunStepDetailsToolCallsObject where
  toJSON :: RunStepDetailsToolCallsObject -> Value
toJSON = Options -> RunStepDetailsToolCallsObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsObject")


-- | 
data RunStepDetailsToolCallsObjectToolCallsInner = RunStepDetailsToolCallsObjectToolCallsInner
  { RunStepDetailsToolCallsObjectToolCallsInner -> Text
runStepDetailsToolCallsObjectToolCallsInnerId :: Text -- ^ The ID of the tool call object.
  , RunStepDetailsToolCallsObjectToolCallsInner -> Text
runStepDetailsToolCallsObjectToolCallsInnerType :: Text -- ^ The type of tool call. This is always going to be `function` for this type of tool call.
  , RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsCodeObjectCodeInterpreter
runStepDetailsToolCallsObjectToolCallsInnerCodeUnderscoreinterpreter :: RunStepDetailsToolCallsCodeObjectCodeInterpreter -- ^ 
  , RunStepDetailsToolCallsObjectToolCallsInner -> Value
runStepDetailsToolCallsObjectToolCallsInnerRetrieval :: Value -- ^ For now, this is always going to be an empty object.
  , RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsFunctionObjectFunction
runStepDetailsToolCallsObjectToolCallsInnerFunction :: RunStepDetailsToolCallsFunctionObjectFunction -- ^ 
  } deriving (Int -> RunStepDetailsToolCallsObjectToolCallsInner -> ShowS
[RunStepDetailsToolCallsObjectToolCallsInner] -> ShowS
RunStepDetailsToolCallsObjectToolCallsInner -> String
(Int -> RunStepDetailsToolCallsObjectToolCallsInner -> ShowS)
-> (RunStepDetailsToolCallsObjectToolCallsInner -> String)
-> ([RunStepDetailsToolCallsObjectToolCallsInner] -> ShowS)
-> Show RunStepDetailsToolCallsObjectToolCallsInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsToolCallsObjectToolCallsInner -> ShowS
showsPrec :: Int -> RunStepDetailsToolCallsObjectToolCallsInner -> ShowS
$cshow :: RunStepDetailsToolCallsObjectToolCallsInner -> String
show :: RunStepDetailsToolCallsObjectToolCallsInner -> String
$cshowList :: [RunStepDetailsToolCallsObjectToolCallsInner] -> ShowS
showList :: [RunStepDetailsToolCallsObjectToolCallsInner] -> ShowS
Show, RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
(RunStepDetailsToolCallsObjectToolCallsInner
 -> RunStepDetailsToolCallsObjectToolCallsInner -> Bool)
-> (RunStepDetailsToolCallsObjectToolCallsInner
    -> RunStepDetailsToolCallsObjectToolCallsInner -> Bool)
-> Eq RunStepDetailsToolCallsObjectToolCallsInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
== :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
$c/= :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
/= :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
Eq, Eq RunStepDetailsToolCallsObjectToolCallsInner
Eq RunStepDetailsToolCallsObjectToolCallsInner =>
(RunStepDetailsToolCallsObjectToolCallsInner
 -> RunStepDetailsToolCallsObjectToolCallsInner -> Ordering)
-> (RunStepDetailsToolCallsObjectToolCallsInner
    -> RunStepDetailsToolCallsObjectToolCallsInner -> Bool)
-> (RunStepDetailsToolCallsObjectToolCallsInner
    -> RunStepDetailsToolCallsObjectToolCallsInner -> Bool)
-> (RunStepDetailsToolCallsObjectToolCallsInner
    -> RunStepDetailsToolCallsObjectToolCallsInner -> Bool)
-> (RunStepDetailsToolCallsObjectToolCallsInner
    -> RunStepDetailsToolCallsObjectToolCallsInner -> Bool)
-> (RunStepDetailsToolCallsObjectToolCallsInner
    -> RunStepDetailsToolCallsObjectToolCallsInner
    -> RunStepDetailsToolCallsObjectToolCallsInner)
-> (RunStepDetailsToolCallsObjectToolCallsInner
    -> RunStepDetailsToolCallsObjectToolCallsInner
    -> RunStepDetailsToolCallsObjectToolCallsInner)
-> Ord RunStepDetailsToolCallsObjectToolCallsInner
RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Ordering
RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Ordering
compare :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Ordering
$c< :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
< :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
$c<= :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
<= :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
$c> :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
> :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
$c>= :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
>= :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner -> Bool
$cmax :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
max :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
$cmin :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
min :: RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
Ord, (forall x.
 RunStepDetailsToolCallsObjectToolCallsInner
 -> Rep RunStepDetailsToolCallsObjectToolCallsInner x)
-> (forall x.
    Rep RunStepDetailsToolCallsObjectToolCallsInner x
    -> RunStepDetailsToolCallsObjectToolCallsInner)
-> Generic RunStepDetailsToolCallsObjectToolCallsInner
forall x.
Rep RunStepDetailsToolCallsObjectToolCallsInner x
-> RunStepDetailsToolCallsObjectToolCallsInner
forall x.
RunStepDetailsToolCallsObjectToolCallsInner
-> Rep RunStepDetailsToolCallsObjectToolCallsInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsObjectToolCallsInner
-> Rep RunStepDetailsToolCallsObjectToolCallsInner x
from :: forall x.
RunStepDetailsToolCallsObjectToolCallsInner
-> Rep RunStepDetailsToolCallsObjectToolCallsInner x
$cto :: forall x.
Rep RunStepDetailsToolCallsObjectToolCallsInner x
-> RunStepDetailsToolCallsObjectToolCallsInner
to :: forall x.
Rep RunStepDetailsToolCallsObjectToolCallsInner x
-> RunStepDetailsToolCallsObjectToolCallsInner
Generic, Typeable RunStepDetailsToolCallsObjectToolCallsInner
Typeable RunStepDetailsToolCallsObjectToolCallsInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsObjectToolCallsInner
 -> c RunStepDetailsToolCallsObjectToolCallsInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsObjectToolCallsInner)
-> (RunStepDetailsToolCallsObjectToolCallsInner -> Constr)
-> (RunStepDetailsToolCallsObjectToolCallsInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsToolCallsObjectToolCallsInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsToolCallsObjectToolCallsInner))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsObjectToolCallsInner
    -> RunStepDetailsToolCallsObjectToolCallsInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsObjectToolCallsInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsObjectToolCallsInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsObjectToolCallsInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsObjectToolCallsInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsObjectToolCallsInner
    -> m RunStepDetailsToolCallsObjectToolCallsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsObjectToolCallsInner
    -> m RunStepDetailsToolCallsObjectToolCallsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsObjectToolCallsInner
    -> m RunStepDetailsToolCallsObjectToolCallsInner)
-> Data RunStepDetailsToolCallsObjectToolCallsInner
RunStepDetailsToolCallsObjectToolCallsInner -> Constr
RunStepDetailsToolCallsObjectToolCallsInner -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObjectToolCallsInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObjectToolCallsInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObjectToolCallsInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> m RunStepDetailsToolCallsObjectToolCallsInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> m RunStepDetailsToolCallsObjectToolCallsInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsObjectToolCallsInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> c RunStepDetailsToolCallsObjectToolCallsInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsObjectToolCallsInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsObjectToolCallsInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> c RunStepDetailsToolCallsObjectToolCallsInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> c RunStepDetailsToolCallsObjectToolCallsInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsObjectToolCallsInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsObjectToolCallsInner
$ctoConstr :: RunStepDetailsToolCallsObjectToolCallsInner -> Constr
toConstr :: RunStepDetailsToolCallsObjectToolCallsInner -> Constr
$cdataTypeOf :: RunStepDetailsToolCallsObjectToolCallsInner -> DataType
dataTypeOf :: RunStepDetailsToolCallsObjectToolCallsInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsObjectToolCallsInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsObjectToolCallsInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsObjectToolCallsInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsObjectToolCallsInner)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> RunStepDetailsToolCallsObjectToolCallsInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObjectToolCallsInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObjectToolCallsInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObjectToolCallsInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsObjectToolCallsInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObjectToolCallsInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObjectToolCallsInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> m RunStepDetailsToolCallsObjectToolCallsInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> m RunStepDetailsToolCallsObjectToolCallsInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> m RunStepDetailsToolCallsObjectToolCallsInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> m RunStepDetailsToolCallsObjectToolCallsInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> m RunStepDetailsToolCallsObjectToolCallsInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsObjectToolCallsInner
-> m RunStepDetailsToolCallsObjectToolCallsInner
Data)

instance FromJSON RunStepDetailsToolCallsObjectToolCallsInner where
  parseJSON :: Value -> Parser RunStepDetailsToolCallsObjectToolCallsInner
parseJSON = Options
-> Value -> Parser RunStepDetailsToolCallsObjectToolCallsInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsObjectToolCallsInner")
instance ToJSON RunStepDetailsToolCallsObjectToolCallsInner where
  toJSON :: RunStepDetailsToolCallsObjectToolCallsInner -> Value
toJSON = Options -> RunStepDetailsToolCallsObjectToolCallsInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsObjectToolCallsInner")


-- | 
data RunStepDetailsToolCallsRetrievalObject = RunStepDetailsToolCallsRetrievalObject
  { RunStepDetailsToolCallsRetrievalObject -> Text
runStepDetailsToolCallsRetrievalObjectId :: Text -- ^ The ID of the tool call object.
  , RunStepDetailsToolCallsRetrievalObject -> Text
runStepDetailsToolCallsRetrievalObjectType :: Text -- ^ The type of tool call. This is always going to be `retrieval` for this type of tool call.
  , RunStepDetailsToolCallsRetrievalObject -> Value
runStepDetailsToolCallsRetrievalObjectRetrieval :: Value -- ^ For now, this is always going to be an empty object.
  } deriving (Int -> RunStepDetailsToolCallsRetrievalObject -> ShowS
[RunStepDetailsToolCallsRetrievalObject] -> ShowS
RunStepDetailsToolCallsRetrievalObject -> String
(Int -> RunStepDetailsToolCallsRetrievalObject -> ShowS)
-> (RunStepDetailsToolCallsRetrievalObject -> String)
-> ([RunStepDetailsToolCallsRetrievalObject] -> ShowS)
-> Show RunStepDetailsToolCallsRetrievalObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepDetailsToolCallsRetrievalObject -> ShowS
showsPrec :: Int -> RunStepDetailsToolCallsRetrievalObject -> ShowS
$cshow :: RunStepDetailsToolCallsRetrievalObject -> String
show :: RunStepDetailsToolCallsRetrievalObject -> String
$cshowList :: [RunStepDetailsToolCallsRetrievalObject] -> ShowS
showList :: [RunStepDetailsToolCallsRetrievalObject] -> ShowS
Show, RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
(RunStepDetailsToolCallsRetrievalObject
 -> RunStepDetailsToolCallsRetrievalObject -> Bool)
-> (RunStepDetailsToolCallsRetrievalObject
    -> RunStepDetailsToolCallsRetrievalObject -> Bool)
-> Eq RunStepDetailsToolCallsRetrievalObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
== :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
$c/= :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
/= :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
Eq, Eq RunStepDetailsToolCallsRetrievalObject
Eq RunStepDetailsToolCallsRetrievalObject =>
(RunStepDetailsToolCallsRetrievalObject
 -> RunStepDetailsToolCallsRetrievalObject -> Ordering)
-> (RunStepDetailsToolCallsRetrievalObject
    -> RunStepDetailsToolCallsRetrievalObject -> Bool)
-> (RunStepDetailsToolCallsRetrievalObject
    -> RunStepDetailsToolCallsRetrievalObject -> Bool)
-> (RunStepDetailsToolCallsRetrievalObject
    -> RunStepDetailsToolCallsRetrievalObject -> Bool)
-> (RunStepDetailsToolCallsRetrievalObject
    -> RunStepDetailsToolCallsRetrievalObject -> Bool)
-> (RunStepDetailsToolCallsRetrievalObject
    -> RunStepDetailsToolCallsRetrievalObject
    -> RunStepDetailsToolCallsRetrievalObject)
-> (RunStepDetailsToolCallsRetrievalObject
    -> RunStepDetailsToolCallsRetrievalObject
    -> RunStepDetailsToolCallsRetrievalObject)
-> Ord RunStepDetailsToolCallsRetrievalObject
RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Ordering
RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Ordering
compare :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Ordering
$c< :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
< :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
$c<= :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
<= :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
$c> :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
> :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
$c>= :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
>= :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject -> Bool
$cmax :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
max :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
$cmin :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
min :: RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
Ord, (forall x.
 RunStepDetailsToolCallsRetrievalObject
 -> Rep RunStepDetailsToolCallsRetrievalObject x)
-> (forall x.
    Rep RunStepDetailsToolCallsRetrievalObject x
    -> RunStepDetailsToolCallsRetrievalObject)
-> Generic RunStepDetailsToolCallsRetrievalObject
forall x.
Rep RunStepDetailsToolCallsRetrievalObject x
-> RunStepDetailsToolCallsRetrievalObject
forall x.
RunStepDetailsToolCallsRetrievalObject
-> Rep RunStepDetailsToolCallsRetrievalObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepDetailsToolCallsRetrievalObject
-> Rep RunStepDetailsToolCallsRetrievalObject x
from :: forall x.
RunStepDetailsToolCallsRetrievalObject
-> Rep RunStepDetailsToolCallsRetrievalObject x
$cto :: forall x.
Rep RunStepDetailsToolCallsRetrievalObject x
-> RunStepDetailsToolCallsRetrievalObject
to :: forall x.
Rep RunStepDetailsToolCallsRetrievalObject x
-> RunStepDetailsToolCallsRetrievalObject
Generic, Typeable RunStepDetailsToolCallsRetrievalObject
Typeable RunStepDetailsToolCallsRetrievalObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepDetailsToolCallsRetrievalObject
 -> c RunStepDetailsToolCallsRetrievalObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RunStepDetailsToolCallsRetrievalObject)
-> (RunStepDetailsToolCallsRetrievalObject -> Constr)
-> (RunStepDetailsToolCallsRetrievalObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepDetailsToolCallsRetrievalObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepDetailsToolCallsRetrievalObject))
-> ((forall b. Data b => b -> b)
    -> RunStepDetailsToolCallsRetrievalObject
    -> RunStepDetailsToolCallsRetrievalObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsRetrievalObject
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepDetailsToolCallsRetrievalObject
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsRetrievalObject -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RunStepDetailsToolCallsRetrievalObject
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsRetrievalObject
    -> m RunStepDetailsToolCallsRetrievalObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsRetrievalObject
    -> m RunStepDetailsToolCallsRetrievalObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepDetailsToolCallsRetrievalObject
    -> m RunStepDetailsToolCallsRetrievalObject)
-> Data RunStepDetailsToolCallsRetrievalObject
RunStepDetailsToolCallsRetrievalObject -> Constr
RunStepDetailsToolCallsRetrievalObject -> DataType
(forall b. Data b => b -> b)
-> RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsRetrievalObject
-> u
forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsRetrievalObject -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsRetrievalObject
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsRetrievalObject
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsRetrievalObject
-> m RunStepDetailsToolCallsRetrievalObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsRetrievalObject
-> m RunStepDetailsToolCallsRetrievalObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsRetrievalObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsRetrievalObject
-> c RunStepDetailsToolCallsRetrievalObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsRetrievalObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsRetrievalObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsRetrievalObject
-> c RunStepDetailsToolCallsRetrievalObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepDetailsToolCallsRetrievalObject
-> c RunStepDetailsToolCallsRetrievalObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsRetrievalObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c RunStepDetailsToolCallsRetrievalObject
$ctoConstr :: RunStepDetailsToolCallsRetrievalObject -> Constr
toConstr :: RunStepDetailsToolCallsRetrievalObject -> Constr
$cdataTypeOf :: RunStepDetailsToolCallsRetrievalObject -> DataType
dataTypeOf :: RunStepDetailsToolCallsRetrievalObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsRetrievalObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunStepDetailsToolCallsRetrievalObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsRetrievalObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepDetailsToolCallsRetrievalObject)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
gmapT :: (forall b. Data b => b -> b)
-> RunStepDetailsToolCallsRetrievalObject
-> RunStepDetailsToolCallsRetrievalObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsRetrievalObject
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsRetrievalObject
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsRetrievalObject
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepDetailsToolCallsRetrievalObject
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsRetrievalObject -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> RunStepDetailsToolCallsRetrievalObject -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsRetrievalObject
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RunStepDetailsToolCallsRetrievalObject
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsRetrievalObject
-> m RunStepDetailsToolCallsRetrievalObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsRetrievalObject
-> m RunStepDetailsToolCallsRetrievalObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsRetrievalObject
-> m RunStepDetailsToolCallsRetrievalObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsRetrievalObject
-> m RunStepDetailsToolCallsRetrievalObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsRetrievalObject
-> m RunStepDetailsToolCallsRetrievalObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepDetailsToolCallsRetrievalObject
-> m RunStepDetailsToolCallsRetrievalObject
Data)

instance FromJSON RunStepDetailsToolCallsRetrievalObject where
  parseJSON :: Value -> Parser RunStepDetailsToolCallsRetrievalObject
parseJSON = Options -> Value -> Parser RunStepDetailsToolCallsRetrievalObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsRetrievalObject")
instance ToJSON RunStepDetailsToolCallsRetrievalObject where
  toJSON :: RunStepDetailsToolCallsRetrievalObject -> Value
toJSON = Options -> RunStepDetailsToolCallsRetrievalObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepDetailsToolCallsRetrievalObject")


-- | Represents a step in execution of a run. 
data RunStepObject = RunStepObject
  { RunStepObject -> Text
runStepObjectId :: Text -- ^ The identifier of the run step, which can be referenced in API endpoints.
  , RunStepObject -> Text
runStepObjectObject :: Text -- ^ The object type, which is always `thread.run.step`.
  , RunStepObject -> Int
runStepObjectCreatedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run step was created.
  , RunStepObject -> Text
runStepObjectAssistantUnderscoreid :: Text -- ^ The ID of the [assistant](/docs/api-reference/assistants) associated with the run step.
  , RunStepObject -> Text
runStepObjectThreadUnderscoreid :: Text -- ^ The ID of the [thread](/docs/api-reference/threads) that was run.
  , RunStepObject -> Text
runStepObjectRunUnderscoreid :: Text -- ^ The ID of the [run](/docs/api-reference/runs) that this run step is a part of.
  , RunStepObject -> Text
runStepObjectType :: Text -- ^ The type of run step, which can be either `message_creation` or `tool_calls`.
  , RunStepObject -> Text
runStepObjectStatus :: Text -- ^ The status of the run step, which can be either `in_progress`, `cancelled`, `failed`, `completed`, or `expired`.
  , RunStepObject -> RunStepObjectStepDetails
runStepObjectStepUnderscoredetails :: RunStepObjectStepDetails -- ^ 
  , RunStepObject -> RunStepObjectLastError
runStepObjectLastUnderscoreerror :: RunStepObjectLastError -- ^ 
  , RunStepObject -> Int
runStepObjectExpiredUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run step expired. A step is considered expired if the parent run is expired.
  , RunStepObject -> Int
runStepObjectCancelledUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run step was cancelled.
  , RunStepObject -> Int
runStepObjectFailedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run step failed.
  , RunStepObject -> Int
runStepObjectCompletedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the run step completed.
  , RunStepObject -> Value
runStepObjectMetadata :: Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  , RunStepObject -> RunStepCompletionUsage
runStepObjectUsage :: RunStepCompletionUsage -- ^ 
  } deriving (Int -> RunStepObject -> ShowS
[RunStepObject] -> ShowS
RunStepObject -> String
(Int -> RunStepObject -> ShowS)
-> (RunStepObject -> String)
-> ([RunStepObject] -> ShowS)
-> Show RunStepObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepObject -> ShowS
showsPrec :: Int -> RunStepObject -> ShowS
$cshow :: RunStepObject -> String
show :: RunStepObject -> String
$cshowList :: [RunStepObject] -> ShowS
showList :: [RunStepObject] -> ShowS
Show, RunStepObject -> RunStepObject -> Bool
(RunStepObject -> RunStepObject -> Bool)
-> (RunStepObject -> RunStepObject -> Bool) -> Eq RunStepObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepObject -> RunStepObject -> Bool
== :: RunStepObject -> RunStepObject -> Bool
$c/= :: RunStepObject -> RunStepObject -> Bool
/= :: RunStepObject -> RunStepObject -> Bool
Eq, Eq RunStepObject
Eq RunStepObject =>
(RunStepObject -> RunStepObject -> Ordering)
-> (RunStepObject -> RunStepObject -> Bool)
-> (RunStepObject -> RunStepObject -> Bool)
-> (RunStepObject -> RunStepObject -> Bool)
-> (RunStepObject -> RunStepObject -> Bool)
-> (RunStepObject -> RunStepObject -> RunStepObject)
-> (RunStepObject -> RunStepObject -> RunStepObject)
-> Ord RunStepObject
RunStepObject -> RunStepObject -> Bool
RunStepObject -> RunStepObject -> Ordering
RunStepObject -> RunStepObject -> RunStepObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepObject -> RunStepObject -> Ordering
compare :: RunStepObject -> RunStepObject -> Ordering
$c< :: RunStepObject -> RunStepObject -> Bool
< :: RunStepObject -> RunStepObject -> Bool
$c<= :: RunStepObject -> RunStepObject -> Bool
<= :: RunStepObject -> RunStepObject -> Bool
$c> :: RunStepObject -> RunStepObject -> Bool
> :: RunStepObject -> RunStepObject -> Bool
$c>= :: RunStepObject -> RunStepObject -> Bool
>= :: RunStepObject -> RunStepObject -> Bool
$cmax :: RunStepObject -> RunStepObject -> RunStepObject
max :: RunStepObject -> RunStepObject -> RunStepObject
$cmin :: RunStepObject -> RunStepObject -> RunStepObject
min :: RunStepObject -> RunStepObject -> RunStepObject
Ord, (forall x. RunStepObject -> Rep RunStepObject x)
-> (forall x. Rep RunStepObject x -> RunStepObject)
-> Generic RunStepObject
forall x. Rep RunStepObject x -> RunStepObject
forall x. RunStepObject -> Rep RunStepObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunStepObject -> Rep RunStepObject x
from :: forall x. RunStepObject -> Rep RunStepObject x
$cto :: forall x. Rep RunStepObject x -> RunStepObject
to :: forall x. Rep RunStepObject x -> RunStepObject
Generic, Typeable RunStepObject
Typeable RunStepObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RunStepObject -> c RunStepObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RunStepObject)
-> (RunStepObject -> Constr)
-> (RunStepObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RunStepObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepObject))
-> ((forall b. Data b => b -> b) -> RunStepObject -> RunStepObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RunStepObject -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RunStepObject -> r)
-> (forall u. (forall d. Data d => d -> u) -> RunStepObject -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RunStepObject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject)
-> Data RunStepObject
RunStepObject -> Constr
RunStepObject -> DataType
(forall b. Data b => b -> b) -> RunStepObject -> RunStepObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RunStepObject -> u
forall u. (forall d. Data d => d -> u) -> RunStepObject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunStepObject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunStepObject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RunStepObject -> c RunStepObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RunStepObject -> c RunStepObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RunStepObject -> c RunStepObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepObject
$ctoConstr :: RunStepObject -> Constr
toConstr :: RunStepObject -> Constr
$cdataTypeOf :: RunStepObject -> DataType
dataTypeOf :: RunStepObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepObject)
$cgmapT :: (forall b. Data b => b -> b) -> RunStepObject -> RunStepObject
gmapT :: (forall b. Data b => b -> b) -> RunStepObject -> RunStepObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunStepObject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunStepObject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunStepObject -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunStepObject -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RunStepObject -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RunStepObject -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RunStepObject -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RunStepObject -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RunStepObject -> m RunStepObject
Data)

instance FromJSON RunStepObject where
  parseJSON :: Value -> Parser RunStepObject
parseJSON = Options -> Value -> Parser RunStepObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepObject")
instance ToJSON RunStepObject where
  toJSON :: RunStepObject -> Value
toJSON = Options -> RunStepObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepObject")


-- | The last error associated with this run step. Will be &#x60;null&#x60; if there are no errors.
data RunStepObjectLastError = RunStepObjectLastError
  { RunStepObjectLastError -> Text
runStepObjectLastErrorCode :: Text -- ^ One of `server_error` or `rate_limit_exceeded`.
  , RunStepObjectLastError -> Text
runStepObjectLastErrorMessage :: Text -- ^ A human-readable description of the error.
  } deriving (Int -> RunStepObjectLastError -> ShowS
[RunStepObjectLastError] -> ShowS
RunStepObjectLastError -> String
(Int -> RunStepObjectLastError -> ShowS)
-> (RunStepObjectLastError -> String)
-> ([RunStepObjectLastError] -> ShowS)
-> Show RunStepObjectLastError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepObjectLastError -> ShowS
showsPrec :: Int -> RunStepObjectLastError -> ShowS
$cshow :: RunStepObjectLastError -> String
show :: RunStepObjectLastError -> String
$cshowList :: [RunStepObjectLastError] -> ShowS
showList :: [RunStepObjectLastError] -> ShowS
Show, RunStepObjectLastError -> RunStepObjectLastError -> Bool
(RunStepObjectLastError -> RunStepObjectLastError -> Bool)
-> (RunStepObjectLastError -> RunStepObjectLastError -> Bool)
-> Eq RunStepObjectLastError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
== :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
$c/= :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
/= :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
Eq, Eq RunStepObjectLastError
Eq RunStepObjectLastError =>
(RunStepObjectLastError -> RunStepObjectLastError -> Ordering)
-> (RunStepObjectLastError -> RunStepObjectLastError -> Bool)
-> (RunStepObjectLastError -> RunStepObjectLastError -> Bool)
-> (RunStepObjectLastError -> RunStepObjectLastError -> Bool)
-> (RunStepObjectLastError -> RunStepObjectLastError -> Bool)
-> (RunStepObjectLastError
    -> RunStepObjectLastError -> RunStepObjectLastError)
-> (RunStepObjectLastError
    -> RunStepObjectLastError -> RunStepObjectLastError)
-> Ord RunStepObjectLastError
RunStepObjectLastError -> RunStepObjectLastError -> Bool
RunStepObjectLastError -> RunStepObjectLastError -> Ordering
RunStepObjectLastError
-> RunStepObjectLastError -> RunStepObjectLastError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepObjectLastError -> RunStepObjectLastError -> Ordering
compare :: RunStepObjectLastError -> RunStepObjectLastError -> Ordering
$c< :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
< :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
$c<= :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
<= :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
$c> :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
> :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
$c>= :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
>= :: RunStepObjectLastError -> RunStepObjectLastError -> Bool
$cmax :: RunStepObjectLastError
-> RunStepObjectLastError -> RunStepObjectLastError
max :: RunStepObjectLastError
-> RunStepObjectLastError -> RunStepObjectLastError
$cmin :: RunStepObjectLastError
-> RunStepObjectLastError -> RunStepObjectLastError
min :: RunStepObjectLastError
-> RunStepObjectLastError -> RunStepObjectLastError
Ord, (forall x. RunStepObjectLastError -> Rep RunStepObjectLastError x)
-> (forall x.
    Rep RunStepObjectLastError x -> RunStepObjectLastError)
-> Generic RunStepObjectLastError
forall x. Rep RunStepObjectLastError x -> RunStepObjectLastError
forall x. RunStepObjectLastError -> Rep RunStepObjectLastError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunStepObjectLastError -> Rep RunStepObjectLastError x
from :: forall x. RunStepObjectLastError -> Rep RunStepObjectLastError x
$cto :: forall x. Rep RunStepObjectLastError x -> RunStepObjectLastError
to :: forall x. Rep RunStepObjectLastError x -> RunStepObjectLastError
Generic, Typeable RunStepObjectLastError
Typeable RunStepObjectLastError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepObjectLastError
 -> c RunStepObjectLastError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RunStepObjectLastError)
-> (RunStepObjectLastError -> Constr)
-> (RunStepObjectLastError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RunStepObjectLastError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepObjectLastError))
-> ((forall b. Data b => b -> b)
    -> RunStepObjectLastError -> RunStepObjectLastError)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepObjectLastError
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepObjectLastError
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RunStepObjectLastError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RunStepObjectLastError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepObjectLastError -> m RunStepObjectLastError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepObjectLastError -> m RunStepObjectLastError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepObjectLastError -> m RunStepObjectLastError)
-> Data RunStepObjectLastError
RunStepObjectLastError -> Constr
RunStepObjectLastError -> DataType
(forall b. Data b => b -> b)
-> RunStepObjectLastError -> RunStepObjectLastError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RunStepObjectLastError -> u
forall u.
(forall d. Data d => d -> u) -> RunStepObjectLastError -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectLastError
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectLastError
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepObjectLastError -> m RunStepObjectLastError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepObjectLastError -> m RunStepObjectLastError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepObjectLastError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepObjectLastError
-> c RunStepObjectLastError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepObjectLastError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepObjectLastError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepObjectLastError
-> c RunStepObjectLastError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepObjectLastError
-> c RunStepObjectLastError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepObjectLastError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepObjectLastError
$ctoConstr :: RunStepObjectLastError -> Constr
toConstr :: RunStepObjectLastError -> Constr
$cdataTypeOf :: RunStepObjectLastError -> DataType
dataTypeOf :: RunStepObjectLastError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepObjectLastError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepObjectLastError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepObjectLastError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepObjectLastError)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepObjectLastError -> RunStepObjectLastError
gmapT :: (forall b. Data b => b -> b)
-> RunStepObjectLastError -> RunStepObjectLastError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectLastError
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectLastError
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectLastError
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectLastError
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RunStepObjectLastError -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> RunStepObjectLastError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunStepObjectLastError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunStepObjectLastError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepObjectLastError -> m RunStepObjectLastError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepObjectLastError -> m RunStepObjectLastError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepObjectLastError -> m RunStepObjectLastError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepObjectLastError -> m RunStepObjectLastError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepObjectLastError -> m RunStepObjectLastError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepObjectLastError -> m RunStepObjectLastError
Data)

instance FromJSON RunStepObjectLastError where
  parseJSON :: Value -> Parser RunStepObjectLastError
parseJSON = Options -> Value -> Parser RunStepObjectLastError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepObjectLastError")
instance ToJSON RunStepObjectLastError where
  toJSON :: RunStepObjectLastError -> Value
toJSON = Options -> RunStepObjectLastError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepObjectLastError")


-- | The details of the run step.
data RunStepObjectStepDetails = RunStepObjectStepDetails
  { RunStepObjectStepDetails -> Text
runStepObjectStepDetailsType :: Text -- ^ Always `tool_calls`.
  , RunStepObjectStepDetails
-> RunStepDetailsMessageCreationObjectMessageCreation
runStepObjectStepDetailsMessageUnderscorecreation :: RunStepDetailsMessageCreationObjectMessageCreation -- ^ 
  , RunStepObjectStepDetails
-> [RunStepDetailsToolCallsObjectToolCallsInner]
runStepObjectStepDetailsToolUnderscorecalls :: [RunStepDetailsToolCallsObjectToolCallsInner] -- ^ An array of tool calls the run step was involved in. These can be associated with one of three types of tools: `code_interpreter`, `retrieval`, or `function`. 
  } deriving (Int -> RunStepObjectStepDetails -> ShowS
[RunStepObjectStepDetails] -> ShowS
RunStepObjectStepDetails -> String
(Int -> RunStepObjectStepDetails -> ShowS)
-> (RunStepObjectStepDetails -> String)
-> ([RunStepObjectStepDetails] -> ShowS)
-> Show RunStepObjectStepDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStepObjectStepDetails -> ShowS
showsPrec :: Int -> RunStepObjectStepDetails -> ShowS
$cshow :: RunStepObjectStepDetails -> String
show :: RunStepObjectStepDetails -> String
$cshowList :: [RunStepObjectStepDetails] -> ShowS
showList :: [RunStepObjectStepDetails] -> ShowS
Show, RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
(RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool)
-> (RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool)
-> Eq RunStepObjectStepDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
== :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
$c/= :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
/= :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
Eq, Eq RunStepObjectStepDetails
Eq RunStepObjectStepDetails =>
(RunStepObjectStepDetails -> RunStepObjectStepDetails -> Ordering)
-> (RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool)
-> (RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool)
-> (RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool)
-> (RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool)
-> (RunStepObjectStepDetails
    -> RunStepObjectStepDetails -> RunStepObjectStepDetails)
-> (RunStepObjectStepDetails
    -> RunStepObjectStepDetails -> RunStepObjectStepDetails)
-> Ord RunStepObjectStepDetails
RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
RunStepObjectStepDetails -> RunStepObjectStepDetails -> Ordering
RunStepObjectStepDetails
-> RunStepObjectStepDetails -> RunStepObjectStepDetails
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Ordering
compare :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Ordering
$c< :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
< :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
$c<= :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
<= :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
$c> :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
> :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
$c>= :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
>= :: RunStepObjectStepDetails -> RunStepObjectStepDetails -> Bool
$cmax :: RunStepObjectStepDetails
-> RunStepObjectStepDetails -> RunStepObjectStepDetails
max :: RunStepObjectStepDetails
-> RunStepObjectStepDetails -> RunStepObjectStepDetails
$cmin :: RunStepObjectStepDetails
-> RunStepObjectStepDetails -> RunStepObjectStepDetails
min :: RunStepObjectStepDetails
-> RunStepObjectStepDetails -> RunStepObjectStepDetails
Ord, (forall x.
 RunStepObjectStepDetails -> Rep RunStepObjectStepDetails x)
-> (forall x.
    Rep RunStepObjectStepDetails x -> RunStepObjectStepDetails)
-> Generic RunStepObjectStepDetails
forall x.
Rep RunStepObjectStepDetails x -> RunStepObjectStepDetails
forall x.
RunStepObjectStepDetails -> Rep RunStepObjectStepDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunStepObjectStepDetails -> Rep RunStepObjectStepDetails x
from :: forall x.
RunStepObjectStepDetails -> Rep RunStepObjectStepDetails x
$cto :: forall x.
Rep RunStepObjectStepDetails x -> RunStepObjectStepDetails
to :: forall x.
Rep RunStepObjectStepDetails x -> RunStepObjectStepDetails
Generic, Typeable RunStepObjectStepDetails
Typeable RunStepObjectStepDetails =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunStepObjectStepDetails
 -> c RunStepObjectStepDetails)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RunStepObjectStepDetails)
-> (RunStepObjectStepDetails -> Constr)
-> (RunStepObjectStepDetails -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunStepObjectStepDetails))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunStepObjectStepDetails))
-> ((forall b. Data b => b -> b)
    -> RunStepObjectStepDetails -> RunStepObjectStepDetails)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepObjectStepDetails
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunStepObjectStepDetails
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RunStepObjectStepDetails -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> RunStepObjectStepDetails -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunStepObjectStepDetails -> m RunStepObjectStepDetails)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepObjectStepDetails -> m RunStepObjectStepDetails)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunStepObjectStepDetails -> m RunStepObjectStepDetails)
-> Data RunStepObjectStepDetails
RunStepObjectStepDetails -> Constr
RunStepObjectStepDetails -> DataType
(forall b. Data b => b -> b)
-> RunStepObjectStepDetails -> RunStepObjectStepDetails
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> RunStepObjectStepDetails -> u
forall u.
(forall d. Data d => d -> u) -> RunStepObjectStepDetails -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectStepDetails
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectStepDetails
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepObjectStepDetails -> m RunStepObjectStepDetails
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepObjectStepDetails -> m RunStepObjectStepDetails
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepObjectStepDetails
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepObjectStepDetails
-> c RunStepObjectStepDetails
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepObjectStepDetails)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepObjectStepDetails)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepObjectStepDetails
-> c RunStepObjectStepDetails
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunStepObjectStepDetails
-> c RunStepObjectStepDetails
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepObjectStepDetails
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunStepObjectStepDetails
$ctoConstr :: RunStepObjectStepDetails -> Constr
toConstr :: RunStepObjectStepDetails -> Constr
$cdataTypeOf :: RunStepObjectStepDetails -> DataType
dataTypeOf :: RunStepObjectStepDetails -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepObjectStepDetails)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunStepObjectStepDetails)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepObjectStepDetails)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunStepObjectStepDetails)
$cgmapT :: (forall b. Data b => b -> b)
-> RunStepObjectStepDetails -> RunStepObjectStepDetails
gmapT :: (forall b. Data b => b -> b)
-> RunStepObjectStepDetails -> RunStepObjectStepDetails
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectStepDetails
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectStepDetails
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectStepDetails
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunStepObjectStepDetails
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RunStepObjectStepDetails -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> RunStepObjectStepDetails -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RunStepObjectStepDetails -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RunStepObjectStepDetails -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepObjectStepDetails -> m RunStepObjectStepDetails
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunStepObjectStepDetails -> m RunStepObjectStepDetails
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepObjectStepDetails -> m RunStepObjectStepDetails
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepObjectStepDetails -> m RunStepObjectStepDetails
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepObjectStepDetails -> m RunStepObjectStepDetails
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunStepObjectStepDetails -> m RunStepObjectStepDetails
Data)

instance FromJSON RunStepObjectStepDetails where
  parseJSON :: Value -> Parser RunStepObjectStepDetails
parseJSON = Options -> Value -> Parser RunStepObjectStepDetails
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runStepObjectStepDetails")
instance ToJSON RunStepObjectStepDetails where
  toJSON :: RunStepObjectStepDetails -> Value
toJSON = Options -> RunStepObjectStepDetails -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runStepObjectStepDetails")


-- | Tool call objects
data RunToolCallObject = RunToolCallObject
  { RunToolCallObject -> Text
runToolCallObjectId :: Text -- ^ The ID of the tool call. This ID must be referenced when you submit the tool outputs in using the [Submit tool outputs to run](/docs/api-reference/runs/submitToolOutputs) endpoint.
  , RunToolCallObject -> Text
runToolCallObjectType :: Text -- ^ The type of tool call the output is required for. For now, this is always `function`.
  , RunToolCallObject -> RunToolCallObjectFunction
runToolCallObjectFunction :: RunToolCallObjectFunction -- ^ 
  } deriving (Int -> RunToolCallObject -> ShowS
[RunToolCallObject] -> ShowS
RunToolCallObject -> String
(Int -> RunToolCallObject -> ShowS)
-> (RunToolCallObject -> String)
-> ([RunToolCallObject] -> ShowS)
-> Show RunToolCallObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunToolCallObject -> ShowS
showsPrec :: Int -> RunToolCallObject -> ShowS
$cshow :: RunToolCallObject -> String
show :: RunToolCallObject -> String
$cshowList :: [RunToolCallObject] -> ShowS
showList :: [RunToolCallObject] -> ShowS
Show, RunToolCallObject -> RunToolCallObject -> Bool
(RunToolCallObject -> RunToolCallObject -> Bool)
-> (RunToolCallObject -> RunToolCallObject -> Bool)
-> Eq RunToolCallObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunToolCallObject -> RunToolCallObject -> Bool
== :: RunToolCallObject -> RunToolCallObject -> Bool
$c/= :: RunToolCallObject -> RunToolCallObject -> Bool
/= :: RunToolCallObject -> RunToolCallObject -> Bool
Eq, Eq RunToolCallObject
Eq RunToolCallObject =>
(RunToolCallObject -> RunToolCallObject -> Ordering)
-> (RunToolCallObject -> RunToolCallObject -> Bool)
-> (RunToolCallObject -> RunToolCallObject -> Bool)
-> (RunToolCallObject -> RunToolCallObject -> Bool)
-> (RunToolCallObject -> RunToolCallObject -> Bool)
-> (RunToolCallObject -> RunToolCallObject -> RunToolCallObject)
-> (RunToolCallObject -> RunToolCallObject -> RunToolCallObject)
-> Ord RunToolCallObject
RunToolCallObject -> RunToolCallObject -> Bool
RunToolCallObject -> RunToolCallObject -> Ordering
RunToolCallObject -> RunToolCallObject -> RunToolCallObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunToolCallObject -> RunToolCallObject -> Ordering
compare :: RunToolCallObject -> RunToolCallObject -> Ordering
$c< :: RunToolCallObject -> RunToolCallObject -> Bool
< :: RunToolCallObject -> RunToolCallObject -> Bool
$c<= :: RunToolCallObject -> RunToolCallObject -> Bool
<= :: RunToolCallObject -> RunToolCallObject -> Bool
$c> :: RunToolCallObject -> RunToolCallObject -> Bool
> :: RunToolCallObject -> RunToolCallObject -> Bool
$c>= :: RunToolCallObject -> RunToolCallObject -> Bool
>= :: RunToolCallObject -> RunToolCallObject -> Bool
$cmax :: RunToolCallObject -> RunToolCallObject -> RunToolCallObject
max :: RunToolCallObject -> RunToolCallObject -> RunToolCallObject
$cmin :: RunToolCallObject -> RunToolCallObject -> RunToolCallObject
min :: RunToolCallObject -> RunToolCallObject -> RunToolCallObject
Ord, (forall x. RunToolCallObject -> Rep RunToolCallObject x)
-> (forall x. Rep RunToolCallObject x -> RunToolCallObject)
-> Generic RunToolCallObject
forall x. Rep RunToolCallObject x -> RunToolCallObject
forall x. RunToolCallObject -> Rep RunToolCallObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunToolCallObject -> Rep RunToolCallObject x
from :: forall x. RunToolCallObject -> Rep RunToolCallObject x
$cto :: forall x. Rep RunToolCallObject x -> RunToolCallObject
to :: forall x. Rep RunToolCallObject x -> RunToolCallObject
Generic, Typeable RunToolCallObject
Typeable RunToolCallObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunToolCallObject
 -> c RunToolCallObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RunToolCallObject)
-> (RunToolCallObject -> Constr)
-> (RunToolCallObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RunToolCallObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunToolCallObject))
-> ((forall b. Data b => b -> b)
    -> RunToolCallObject -> RunToolCallObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RunToolCallObject -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RunToolCallObject -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RunToolCallObject -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RunToolCallObject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunToolCallObject -> m RunToolCallObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunToolCallObject -> m RunToolCallObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunToolCallObject -> m RunToolCallObject)
-> Data RunToolCallObject
RunToolCallObject -> Constr
RunToolCallObject -> DataType
(forall b. Data b => b -> b)
-> RunToolCallObject -> RunToolCallObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RunToolCallObject -> u
forall u. (forall d. Data d => d -> u) -> RunToolCallObject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunToolCallObject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunToolCallObject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunToolCallObject -> m RunToolCallObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunToolCallObject -> m RunToolCallObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunToolCallObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RunToolCallObject -> c RunToolCallObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunToolCallObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunToolCallObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RunToolCallObject -> c RunToolCallObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RunToolCallObject -> c RunToolCallObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunToolCallObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunToolCallObject
$ctoConstr :: RunToolCallObject -> Constr
toConstr :: RunToolCallObject -> Constr
$cdataTypeOf :: RunToolCallObject -> DataType
dataTypeOf :: RunToolCallObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunToolCallObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RunToolCallObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunToolCallObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunToolCallObject)
$cgmapT :: (forall b. Data b => b -> b)
-> RunToolCallObject -> RunToolCallObject
gmapT :: (forall b. Data b => b -> b)
-> RunToolCallObject -> RunToolCallObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunToolCallObject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RunToolCallObject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunToolCallObject -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RunToolCallObject -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RunToolCallObject -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RunToolCallObject -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunToolCallObject -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RunToolCallObject -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunToolCallObject -> m RunToolCallObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunToolCallObject -> m RunToolCallObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunToolCallObject -> m RunToolCallObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunToolCallObject -> m RunToolCallObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunToolCallObject -> m RunToolCallObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunToolCallObject -> m RunToolCallObject
Data)

instance FromJSON RunToolCallObject where
  parseJSON :: Value -> Parser RunToolCallObject
parseJSON = Options -> Value -> Parser RunToolCallObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runToolCallObject")
instance ToJSON RunToolCallObject where
  toJSON :: RunToolCallObject -> Value
toJSON = Options -> RunToolCallObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runToolCallObject")


-- | The function definition.
data RunToolCallObjectFunction = RunToolCallObjectFunction
  { RunToolCallObjectFunction -> Text
runToolCallObjectFunctionName :: Text -- ^ The name of the function.
  , RunToolCallObjectFunction -> Text
runToolCallObjectFunctionArguments :: Text -- ^ The arguments that the model expects you to pass to the function.
  } deriving (Int -> RunToolCallObjectFunction -> ShowS
[RunToolCallObjectFunction] -> ShowS
RunToolCallObjectFunction -> String
(Int -> RunToolCallObjectFunction -> ShowS)
-> (RunToolCallObjectFunction -> String)
-> ([RunToolCallObjectFunction] -> ShowS)
-> Show RunToolCallObjectFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunToolCallObjectFunction -> ShowS
showsPrec :: Int -> RunToolCallObjectFunction -> ShowS
$cshow :: RunToolCallObjectFunction -> String
show :: RunToolCallObjectFunction -> String
$cshowList :: [RunToolCallObjectFunction] -> ShowS
showList :: [RunToolCallObjectFunction] -> ShowS
Show, RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
(RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool)
-> (RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool)
-> Eq RunToolCallObjectFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
== :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
$c/= :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
/= :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
Eq, Eq RunToolCallObjectFunction
Eq RunToolCallObjectFunction =>
(RunToolCallObjectFunction
 -> RunToolCallObjectFunction -> Ordering)
-> (RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool)
-> (RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool)
-> (RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool)
-> (RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool)
-> (RunToolCallObjectFunction
    -> RunToolCallObjectFunction -> RunToolCallObjectFunction)
-> (RunToolCallObjectFunction
    -> RunToolCallObjectFunction -> RunToolCallObjectFunction)
-> Ord RunToolCallObjectFunction
RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
RunToolCallObjectFunction -> RunToolCallObjectFunction -> Ordering
RunToolCallObjectFunction
-> RunToolCallObjectFunction -> RunToolCallObjectFunction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Ordering
compare :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Ordering
$c< :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
< :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
$c<= :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
<= :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
$c> :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
> :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
$c>= :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
>= :: RunToolCallObjectFunction -> RunToolCallObjectFunction -> Bool
$cmax :: RunToolCallObjectFunction
-> RunToolCallObjectFunction -> RunToolCallObjectFunction
max :: RunToolCallObjectFunction
-> RunToolCallObjectFunction -> RunToolCallObjectFunction
$cmin :: RunToolCallObjectFunction
-> RunToolCallObjectFunction -> RunToolCallObjectFunction
min :: RunToolCallObjectFunction
-> RunToolCallObjectFunction -> RunToolCallObjectFunction
Ord, (forall x.
 RunToolCallObjectFunction -> Rep RunToolCallObjectFunction x)
-> (forall x.
    Rep RunToolCallObjectFunction x -> RunToolCallObjectFunction)
-> Generic RunToolCallObjectFunction
forall x.
Rep RunToolCallObjectFunction x -> RunToolCallObjectFunction
forall x.
RunToolCallObjectFunction -> Rep RunToolCallObjectFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunToolCallObjectFunction -> Rep RunToolCallObjectFunction x
from :: forall x.
RunToolCallObjectFunction -> Rep RunToolCallObjectFunction x
$cto :: forall x.
Rep RunToolCallObjectFunction x -> RunToolCallObjectFunction
to :: forall x.
Rep RunToolCallObjectFunction x -> RunToolCallObjectFunction
Generic, Typeable RunToolCallObjectFunction
Typeable RunToolCallObjectFunction =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> RunToolCallObjectFunction
 -> c RunToolCallObjectFunction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RunToolCallObjectFunction)
-> (RunToolCallObjectFunction -> Constr)
-> (RunToolCallObjectFunction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RunToolCallObjectFunction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RunToolCallObjectFunction))
-> ((forall b. Data b => b -> b)
    -> RunToolCallObjectFunction -> RunToolCallObjectFunction)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunToolCallObjectFunction
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RunToolCallObjectFunction
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RunToolCallObjectFunction -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> RunToolCallObjectFunction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RunToolCallObjectFunction -> m RunToolCallObjectFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunToolCallObjectFunction -> m RunToolCallObjectFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RunToolCallObjectFunction -> m RunToolCallObjectFunction)
-> Data RunToolCallObjectFunction
RunToolCallObjectFunction -> Constr
RunToolCallObjectFunction -> DataType
(forall b. Data b => b -> b)
-> RunToolCallObjectFunction -> RunToolCallObjectFunction
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> RunToolCallObjectFunction -> u
forall u.
(forall d. Data d => d -> u) -> RunToolCallObjectFunction -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunToolCallObjectFunction
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunToolCallObjectFunction
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunToolCallObjectFunction -> m RunToolCallObjectFunction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunToolCallObjectFunction -> m RunToolCallObjectFunction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunToolCallObjectFunction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunToolCallObjectFunction
-> c RunToolCallObjectFunction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunToolCallObjectFunction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunToolCallObjectFunction)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunToolCallObjectFunction
-> c RunToolCallObjectFunction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RunToolCallObjectFunction
-> c RunToolCallObjectFunction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunToolCallObjectFunction
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RunToolCallObjectFunction
$ctoConstr :: RunToolCallObjectFunction -> Constr
toConstr :: RunToolCallObjectFunction -> Constr
$cdataTypeOf :: RunToolCallObjectFunction -> DataType
dataTypeOf :: RunToolCallObjectFunction -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunToolCallObjectFunction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RunToolCallObjectFunction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunToolCallObjectFunction)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RunToolCallObjectFunction)
$cgmapT :: (forall b. Data b => b -> b)
-> RunToolCallObjectFunction -> RunToolCallObjectFunction
gmapT :: (forall b. Data b => b -> b)
-> RunToolCallObjectFunction -> RunToolCallObjectFunction
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunToolCallObjectFunction
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunToolCallObjectFunction
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunToolCallObjectFunction
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RunToolCallObjectFunction
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RunToolCallObjectFunction -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> RunToolCallObjectFunction -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RunToolCallObjectFunction -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RunToolCallObjectFunction -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunToolCallObjectFunction -> m RunToolCallObjectFunction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RunToolCallObjectFunction -> m RunToolCallObjectFunction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunToolCallObjectFunction -> m RunToolCallObjectFunction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunToolCallObjectFunction -> m RunToolCallObjectFunction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunToolCallObjectFunction -> m RunToolCallObjectFunction
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RunToolCallObjectFunction -> m RunToolCallObjectFunction
Data)

instance FromJSON RunToolCallObjectFunction where
  parseJSON :: Value -> Parser RunToolCallObjectFunction
parseJSON = Options -> Value -> Parser RunToolCallObjectFunction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"runToolCallObjectFunction")
instance ToJSON RunToolCallObjectFunction where
  toJSON :: RunToolCallObjectFunction -> Value
toJSON = Options -> RunToolCallObjectFunction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"runToolCallObjectFunction")


-- | 
data SubmitToolOutputsRunRequest = SubmitToolOutputsRunRequest
  { SubmitToolOutputsRunRequest
-> [SubmitToolOutputsRunRequestToolOutputsInner]
submitToolOutputsRunRequestToolUnderscoreoutputs :: [SubmitToolOutputsRunRequestToolOutputsInner] -- ^ A list of tools for which the outputs are being submitted.
  } deriving (Int -> SubmitToolOutputsRunRequest -> ShowS
[SubmitToolOutputsRunRequest] -> ShowS
SubmitToolOutputsRunRequest -> String
(Int -> SubmitToolOutputsRunRequest -> ShowS)
-> (SubmitToolOutputsRunRequest -> String)
-> ([SubmitToolOutputsRunRequest] -> ShowS)
-> Show SubmitToolOutputsRunRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubmitToolOutputsRunRequest -> ShowS
showsPrec :: Int -> SubmitToolOutputsRunRequest -> ShowS
$cshow :: SubmitToolOutputsRunRequest -> String
show :: SubmitToolOutputsRunRequest -> String
$cshowList :: [SubmitToolOutputsRunRequest] -> ShowS
showList :: [SubmitToolOutputsRunRequest] -> ShowS
Show, SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
(SubmitToolOutputsRunRequest
 -> SubmitToolOutputsRunRequest -> Bool)
-> (SubmitToolOutputsRunRequest
    -> SubmitToolOutputsRunRequest -> Bool)
-> Eq SubmitToolOutputsRunRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
== :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
$c/= :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
/= :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
Eq, Eq SubmitToolOutputsRunRequest
Eq SubmitToolOutputsRunRequest =>
(SubmitToolOutputsRunRequest
 -> SubmitToolOutputsRunRequest -> Ordering)
-> (SubmitToolOutputsRunRequest
    -> SubmitToolOutputsRunRequest -> Bool)
-> (SubmitToolOutputsRunRequest
    -> SubmitToolOutputsRunRequest -> Bool)
-> (SubmitToolOutputsRunRequest
    -> SubmitToolOutputsRunRequest -> Bool)
-> (SubmitToolOutputsRunRequest
    -> SubmitToolOutputsRunRequest -> Bool)
-> (SubmitToolOutputsRunRequest
    -> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest)
-> (SubmitToolOutputsRunRequest
    -> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest)
-> Ord SubmitToolOutputsRunRequest
SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
SubmitToolOutputsRunRequest
-> SubmitToolOutputsRunRequest -> Ordering
SubmitToolOutputsRunRequest
-> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SubmitToolOutputsRunRequest
-> SubmitToolOutputsRunRequest -> Ordering
compare :: SubmitToolOutputsRunRequest
-> SubmitToolOutputsRunRequest -> Ordering
$c< :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
< :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
$c<= :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
<= :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
$c> :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
> :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
$c>= :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
>= :: SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest -> Bool
$cmax :: SubmitToolOutputsRunRequest
-> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest
max :: SubmitToolOutputsRunRequest
-> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest
$cmin :: SubmitToolOutputsRunRequest
-> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest
min :: SubmitToolOutputsRunRequest
-> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest
Ord, (forall x.
 SubmitToolOutputsRunRequest -> Rep SubmitToolOutputsRunRequest x)
-> (forall x.
    Rep SubmitToolOutputsRunRequest x -> SubmitToolOutputsRunRequest)
-> Generic SubmitToolOutputsRunRequest
forall x.
Rep SubmitToolOutputsRunRequest x -> SubmitToolOutputsRunRequest
forall x.
SubmitToolOutputsRunRequest -> Rep SubmitToolOutputsRunRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SubmitToolOutputsRunRequest -> Rep SubmitToolOutputsRunRequest x
from :: forall x.
SubmitToolOutputsRunRequest -> Rep SubmitToolOutputsRunRequest x
$cto :: forall x.
Rep SubmitToolOutputsRunRequest x -> SubmitToolOutputsRunRequest
to :: forall x.
Rep SubmitToolOutputsRunRequest x -> SubmitToolOutputsRunRequest
Generic, Typeable SubmitToolOutputsRunRequest
Typeable SubmitToolOutputsRunRequest =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> SubmitToolOutputsRunRequest
 -> c SubmitToolOutputsRunRequest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SubmitToolOutputsRunRequest)
-> (SubmitToolOutputsRunRequest -> Constr)
-> (SubmitToolOutputsRunRequest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SubmitToolOutputsRunRequest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SubmitToolOutputsRunRequest))
-> ((forall b. Data b => b -> b)
    -> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SubmitToolOutputsRunRequest
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SubmitToolOutputsRunRequest
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SubmitToolOutputsRunRequest -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SubmitToolOutputsRunRequest
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest)
-> Data SubmitToolOutputsRunRequest
SubmitToolOutputsRunRequest -> Constr
SubmitToolOutputsRunRequest -> DataType
(forall b. Data b => b -> b)
-> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> SubmitToolOutputsRunRequest -> u
forall u.
(forall d. Data d => d -> u) -> SubmitToolOutputsRunRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequest
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequest
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubmitToolOutputsRunRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubmitToolOutputsRunRequest
-> c SubmitToolOutputsRunRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SubmitToolOutputsRunRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubmitToolOutputsRunRequest)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubmitToolOutputsRunRequest
-> c SubmitToolOutputsRunRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubmitToolOutputsRunRequest
-> c SubmitToolOutputsRunRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubmitToolOutputsRunRequest
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubmitToolOutputsRunRequest
$ctoConstr :: SubmitToolOutputsRunRequest -> Constr
toConstr :: SubmitToolOutputsRunRequest -> Constr
$cdataTypeOf :: SubmitToolOutputsRunRequest -> DataType
dataTypeOf :: SubmitToolOutputsRunRequest -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SubmitToolOutputsRunRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SubmitToolOutputsRunRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubmitToolOutputsRunRequest)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubmitToolOutputsRunRequest)
$cgmapT :: (forall b. Data b => b -> b)
-> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest
gmapT :: (forall b. Data b => b -> b)
-> SubmitToolOutputsRunRequest -> SubmitToolOutputsRunRequest
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequest
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequest
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequest
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequest
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SubmitToolOutputsRunRequest -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> SubmitToolOutputsRunRequest -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> SubmitToolOutputsRunRequest -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> SubmitToolOutputsRunRequest -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequest -> m SubmitToolOutputsRunRequest
Data)

instance FromJSON SubmitToolOutputsRunRequest where
  parseJSON :: Value -> Parser SubmitToolOutputsRunRequest
parseJSON = Options -> Value -> Parser SubmitToolOutputsRunRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"submitToolOutputsRunRequest")
instance ToJSON SubmitToolOutputsRunRequest where
  toJSON :: SubmitToolOutputsRunRequest -> Value
toJSON = Options -> SubmitToolOutputsRunRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"submitToolOutputsRunRequest")


-- | 
data SubmitToolOutputsRunRequestToolOutputsInner = SubmitToolOutputsRunRequestToolOutputsInner
  { SubmitToolOutputsRunRequestToolOutputsInner -> Maybe Text
submitToolOutputsRunRequestToolOutputsInnerToolUnderscorecallUnderscoreid :: Maybe Text -- ^ The ID of the tool call in the `required_action` object within the run object the output is being submitted for.
  , SubmitToolOutputsRunRequestToolOutputsInner -> Maybe Text
submitToolOutputsRunRequestToolOutputsInnerOutput :: Maybe Text -- ^ The output of the tool call to be submitted to continue the run.
  } deriving (Int -> SubmitToolOutputsRunRequestToolOutputsInner -> ShowS
[SubmitToolOutputsRunRequestToolOutputsInner] -> ShowS
SubmitToolOutputsRunRequestToolOutputsInner -> String
(Int -> SubmitToolOutputsRunRequestToolOutputsInner -> ShowS)
-> (SubmitToolOutputsRunRequestToolOutputsInner -> String)
-> ([SubmitToolOutputsRunRequestToolOutputsInner] -> ShowS)
-> Show SubmitToolOutputsRunRequestToolOutputsInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubmitToolOutputsRunRequestToolOutputsInner -> ShowS
showsPrec :: Int -> SubmitToolOutputsRunRequestToolOutputsInner -> ShowS
$cshow :: SubmitToolOutputsRunRequestToolOutputsInner -> String
show :: SubmitToolOutputsRunRequestToolOutputsInner -> String
$cshowList :: [SubmitToolOutputsRunRequestToolOutputsInner] -> ShowS
showList :: [SubmitToolOutputsRunRequestToolOutputsInner] -> ShowS
Show, SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
(SubmitToolOutputsRunRequestToolOutputsInner
 -> SubmitToolOutputsRunRequestToolOutputsInner -> Bool)
-> (SubmitToolOutputsRunRequestToolOutputsInner
    -> SubmitToolOutputsRunRequestToolOutputsInner -> Bool)
-> Eq SubmitToolOutputsRunRequestToolOutputsInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
== :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
$c/= :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
/= :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
Eq, Eq SubmitToolOutputsRunRequestToolOutputsInner
Eq SubmitToolOutputsRunRequestToolOutputsInner =>
(SubmitToolOutputsRunRequestToolOutputsInner
 -> SubmitToolOutputsRunRequestToolOutputsInner -> Ordering)
-> (SubmitToolOutputsRunRequestToolOutputsInner
    -> SubmitToolOutputsRunRequestToolOutputsInner -> Bool)
-> (SubmitToolOutputsRunRequestToolOutputsInner
    -> SubmitToolOutputsRunRequestToolOutputsInner -> Bool)
-> (SubmitToolOutputsRunRequestToolOutputsInner
    -> SubmitToolOutputsRunRequestToolOutputsInner -> Bool)
-> (SubmitToolOutputsRunRequestToolOutputsInner
    -> SubmitToolOutputsRunRequestToolOutputsInner -> Bool)
-> (SubmitToolOutputsRunRequestToolOutputsInner
    -> SubmitToolOutputsRunRequestToolOutputsInner
    -> SubmitToolOutputsRunRequestToolOutputsInner)
-> (SubmitToolOutputsRunRequestToolOutputsInner
    -> SubmitToolOutputsRunRequestToolOutputsInner
    -> SubmitToolOutputsRunRequestToolOutputsInner)
-> Ord SubmitToolOutputsRunRequestToolOutputsInner
SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Ordering
SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Ordering
compare :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Ordering
$c< :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
< :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
$c<= :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
<= :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
$c> :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
> :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
$c>= :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
>= :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner -> Bool
$cmax :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
max :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
$cmin :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
min :: SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
Ord, (forall x.
 SubmitToolOutputsRunRequestToolOutputsInner
 -> Rep SubmitToolOutputsRunRequestToolOutputsInner x)
-> (forall x.
    Rep SubmitToolOutputsRunRequestToolOutputsInner x
    -> SubmitToolOutputsRunRequestToolOutputsInner)
-> Generic SubmitToolOutputsRunRequestToolOutputsInner
forall x.
Rep SubmitToolOutputsRunRequestToolOutputsInner x
-> SubmitToolOutputsRunRequestToolOutputsInner
forall x.
SubmitToolOutputsRunRequestToolOutputsInner
-> Rep SubmitToolOutputsRunRequestToolOutputsInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SubmitToolOutputsRunRequestToolOutputsInner
-> Rep SubmitToolOutputsRunRequestToolOutputsInner x
from :: forall x.
SubmitToolOutputsRunRequestToolOutputsInner
-> Rep SubmitToolOutputsRunRequestToolOutputsInner x
$cto :: forall x.
Rep SubmitToolOutputsRunRequestToolOutputsInner x
-> SubmitToolOutputsRunRequestToolOutputsInner
to :: forall x.
Rep SubmitToolOutputsRunRequestToolOutputsInner x
-> SubmitToolOutputsRunRequestToolOutputsInner
Generic, Typeable SubmitToolOutputsRunRequestToolOutputsInner
Typeable SubmitToolOutputsRunRequestToolOutputsInner =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> SubmitToolOutputsRunRequestToolOutputsInner
 -> c SubmitToolOutputsRunRequestToolOutputsInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c SubmitToolOutputsRunRequestToolOutputsInner)
-> (SubmitToolOutputsRunRequestToolOutputsInner -> Constr)
-> (SubmitToolOutputsRunRequestToolOutputsInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SubmitToolOutputsRunRequestToolOutputsInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SubmitToolOutputsRunRequestToolOutputsInner))
-> ((forall b. Data b => b -> b)
    -> SubmitToolOutputsRunRequestToolOutputsInner
    -> SubmitToolOutputsRunRequestToolOutputsInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SubmitToolOutputsRunRequestToolOutputsInner
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SubmitToolOutputsRunRequestToolOutputsInner
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> SubmitToolOutputsRunRequestToolOutputsInner -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SubmitToolOutputsRunRequestToolOutputsInner
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SubmitToolOutputsRunRequestToolOutputsInner
    -> m SubmitToolOutputsRunRequestToolOutputsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SubmitToolOutputsRunRequestToolOutputsInner
    -> m SubmitToolOutputsRunRequestToolOutputsInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SubmitToolOutputsRunRequestToolOutputsInner
    -> m SubmitToolOutputsRunRequestToolOutputsInner)
-> Data SubmitToolOutputsRunRequestToolOutputsInner
SubmitToolOutputsRunRequestToolOutputsInner -> Constr
SubmitToolOutputsRunRequestToolOutputsInner -> DataType
(forall b. Data b => b -> b)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> u
forall u.
(forall d. Data d => d -> u)
-> SubmitToolOutputsRunRequestToolOutputsInner -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequestToolOutputsInner
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequestToolOutputsInner
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> m SubmitToolOutputsRunRequestToolOutputsInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> m SubmitToolOutputsRunRequestToolOutputsInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SubmitToolOutputsRunRequestToolOutputsInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> c SubmitToolOutputsRunRequestToolOutputsInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SubmitToolOutputsRunRequestToolOutputsInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubmitToolOutputsRunRequestToolOutputsInner)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> c SubmitToolOutputsRunRequestToolOutputsInner
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> c SubmitToolOutputsRunRequestToolOutputsInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SubmitToolOutputsRunRequestToolOutputsInner
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SubmitToolOutputsRunRequestToolOutputsInner
$ctoConstr :: SubmitToolOutputsRunRequestToolOutputsInner -> Constr
toConstr :: SubmitToolOutputsRunRequestToolOutputsInner -> Constr
$cdataTypeOf :: SubmitToolOutputsRunRequestToolOutputsInner -> DataType
dataTypeOf :: SubmitToolOutputsRunRequestToolOutputsInner -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SubmitToolOutputsRunRequestToolOutputsInner)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SubmitToolOutputsRunRequestToolOutputsInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubmitToolOutputsRunRequestToolOutputsInner)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubmitToolOutputsRunRequestToolOutputsInner)
$cgmapT :: (forall b. Data b => b -> b)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
gmapT :: (forall b. Data b => b -> b)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> SubmitToolOutputsRunRequestToolOutputsInner
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequestToolOutputsInner
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequestToolOutputsInner
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequestToolOutputsInner
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitToolOutputsRunRequestToolOutputsInner
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> SubmitToolOutputsRunRequestToolOutputsInner -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> SubmitToolOutputsRunRequestToolOutputsInner -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> m SubmitToolOutputsRunRequestToolOutputsInner
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> m SubmitToolOutputsRunRequestToolOutputsInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> m SubmitToolOutputsRunRequestToolOutputsInner
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> m SubmitToolOutputsRunRequestToolOutputsInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> m SubmitToolOutputsRunRequestToolOutputsInner
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitToolOutputsRunRequestToolOutputsInner
-> m SubmitToolOutputsRunRequestToolOutputsInner
Data)

instance FromJSON SubmitToolOutputsRunRequestToolOutputsInner where
  parseJSON :: Value -> Parser SubmitToolOutputsRunRequestToolOutputsInner
parseJSON = Options
-> Value -> Parser SubmitToolOutputsRunRequestToolOutputsInner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"submitToolOutputsRunRequestToolOutputsInner")
instance ToJSON SubmitToolOutputsRunRequestToolOutputsInner where
  toJSON :: SubmitToolOutputsRunRequestToolOutputsInner -> Value
toJSON = Options -> SubmitToolOutputsRunRequestToolOutputsInner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"submitToolOutputsRunRequestToolOutputsInner")


-- | Represents a thread that contains [messages](/docs/api-reference/messages).
data ThreadObject = ThreadObject
  { ThreadObject -> Text
threadObjectId :: Text -- ^ The identifier, which can be referenced in API endpoints.
  , ThreadObject -> Text
threadObjectObject :: Text -- ^ The object type, which is always `thread`.
  , ThreadObject -> Int
threadObjectCreatedUnderscoreat :: Int -- ^ The Unix timestamp (in seconds) for when the thread was created.
  , ThreadObject -> Value
threadObjectMetadata :: Value -- ^ Set of 16 key-value pairs that can be attached to an object. This can be useful for storing additional information about the object in a structured format. Keys can be a maximum of 64 characters long and values can be a maxium of 512 characters long. 
  } deriving (Int -> ThreadObject -> ShowS
[ThreadObject] -> ShowS
ThreadObject -> String
(Int -> ThreadObject -> ShowS)
-> (ThreadObject -> String)
-> ([ThreadObject] -> ShowS)
-> Show ThreadObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ThreadObject -> ShowS
showsPrec :: Int -> ThreadObject -> ShowS
$cshow :: ThreadObject -> String
show :: ThreadObject -> String
$cshowList :: [ThreadObject] -> ShowS
showList :: [ThreadObject] -> ShowS
Show, ThreadObject -> ThreadObject -> Bool
(ThreadObject -> ThreadObject -> Bool)
-> (ThreadObject -> ThreadObject -> Bool) -> Eq ThreadObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ThreadObject -> ThreadObject -> Bool
== :: ThreadObject -> ThreadObject -> Bool
$c/= :: ThreadObject -> ThreadObject -> Bool
/= :: ThreadObject -> ThreadObject -> Bool
Eq, Eq ThreadObject
Eq ThreadObject =>
(ThreadObject -> ThreadObject -> Ordering)
-> (ThreadObject -> ThreadObject -> Bool)
-> (ThreadObject -> ThreadObject -> Bool)
-> (ThreadObject -> ThreadObject -> Bool)
-> (ThreadObject -> ThreadObject -> Bool)
-> (ThreadObject -> ThreadObject -> ThreadObject)
-> (ThreadObject -> ThreadObject -> ThreadObject)
-> Ord ThreadObject
ThreadObject -> ThreadObject -> Bool
ThreadObject -> ThreadObject -> Ordering
ThreadObject -> ThreadObject -> ThreadObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ThreadObject -> ThreadObject -> Ordering
compare :: ThreadObject -> ThreadObject -> Ordering
$c< :: ThreadObject -> ThreadObject -> Bool
< :: ThreadObject -> ThreadObject -> Bool
$c<= :: ThreadObject -> ThreadObject -> Bool
<= :: ThreadObject -> ThreadObject -> Bool
$c> :: ThreadObject -> ThreadObject -> Bool
> :: ThreadObject -> ThreadObject -> Bool
$c>= :: ThreadObject -> ThreadObject -> Bool
>= :: ThreadObject -> ThreadObject -> Bool
$cmax :: ThreadObject -> ThreadObject -> ThreadObject
max :: ThreadObject -> ThreadObject -> ThreadObject
$cmin :: ThreadObject -> ThreadObject -> ThreadObject
min :: ThreadObject -> ThreadObject -> ThreadObject
Ord, (forall x. ThreadObject -> Rep ThreadObject x)
-> (forall x. Rep ThreadObject x -> ThreadObject)
-> Generic ThreadObject
forall x. Rep ThreadObject x -> ThreadObject
forall x. ThreadObject -> Rep ThreadObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ThreadObject -> Rep ThreadObject x
from :: forall x. ThreadObject -> Rep ThreadObject x
$cto :: forall x. Rep ThreadObject x -> ThreadObject
to :: forall x. Rep ThreadObject x -> ThreadObject
Generic, Typeable ThreadObject
Typeable ThreadObject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ThreadObject -> c ThreadObject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ThreadObject)
-> (ThreadObject -> Constr)
-> (ThreadObject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ThreadObject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ThreadObject))
-> ((forall b. Data b => b -> b) -> ThreadObject -> ThreadObject)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ThreadObject -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ThreadObject -> r)
-> (forall u. (forall d. Data d => d -> u) -> ThreadObject -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ThreadObject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject)
-> Data ThreadObject
ThreadObject -> Constr
ThreadObject -> DataType
(forall b. Data b => b -> b) -> ThreadObject -> ThreadObject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ThreadObject -> u
forall u. (forall d. Data d => d -> u) -> ThreadObject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ThreadObject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ThreadObject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ThreadObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ThreadObject -> c ThreadObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ThreadObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ThreadObject)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ThreadObject -> c ThreadObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ThreadObject -> c ThreadObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ThreadObject
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ThreadObject
$ctoConstr :: ThreadObject -> Constr
toConstr :: ThreadObject -> Constr
$cdataTypeOf :: ThreadObject -> DataType
dataTypeOf :: ThreadObject -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ThreadObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ThreadObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ThreadObject)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ThreadObject)
$cgmapT :: (forall b. Data b => b -> b) -> ThreadObject -> ThreadObject
gmapT :: (forall b. Data b => b -> b) -> ThreadObject -> ThreadObject
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ThreadObject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ThreadObject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ThreadObject -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ThreadObject -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ThreadObject -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ThreadObject -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ThreadObject -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ThreadObject -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ThreadObject -> m ThreadObject
Data)

instance FromJSON ThreadObject where
  parseJSON :: Value -> Parser ThreadObject
parseJSON = Options -> Value -> Parser ThreadObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"threadObject")
instance ToJSON ThreadObject where
  toJSON :: ThreadObject -> Value
toJSON = Options -> ThreadObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"threadObject")


-- | 
data TranscriptionSegment = TranscriptionSegment
  { TranscriptionSegment -> Int
transcriptionSegmentId :: Int -- ^ Unique identifier of the segment.
  , TranscriptionSegment -> Int
transcriptionSegmentSeek :: Int -- ^ Seek offset of the segment.
  , TranscriptionSegment -> Float
transcriptionSegmentStart :: Float -- ^ Start time of the segment in seconds.
  , TranscriptionSegment -> Float
transcriptionSegmentEnd :: Float -- ^ End time of the segment in seconds.
  , TranscriptionSegment -> Text
transcriptionSegmentText :: Text -- ^ Text content of the segment.
  , TranscriptionSegment -> [Int]
transcriptionSegmentTokens :: [Int] -- ^ Array of token IDs for the text content.
  , TranscriptionSegment -> Float
transcriptionSegmentTemperature :: Float -- ^ Temperature parameter used for generating the segment.
  , TranscriptionSegment -> Float
transcriptionSegmentAvgUnderscorelogprob :: Float -- ^ Average logprob of the segment. If the value is lower than -1, consider the logprobs failed.
  , TranscriptionSegment -> Float
transcriptionSegmentCompressionUnderscoreratio :: Float -- ^ Compression ratio of the segment. If the value is greater than 2.4, consider the compression failed.
  , TranscriptionSegment -> Float
transcriptionSegmentNoUnderscorespeechUnderscoreprob :: Float -- ^ Probability of no speech in the segment. If the value is higher than 1.0 and the `avg_logprob` is below -1, consider this segment silent.
  } deriving (Int -> TranscriptionSegment -> ShowS
[TranscriptionSegment] -> ShowS
TranscriptionSegment -> String
(Int -> TranscriptionSegment -> ShowS)
-> (TranscriptionSegment -> String)
-> ([TranscriptionSegment] -> ShowS)
-> Show TranscriptionSegment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TranscriptionSegment -> ShowS
showsPrec :: Int -> TranscriptionSegment -> ShowS
$cshow :: TranscriptionSegment -> String
show :: TranscriptionSegment -> String
$cshowList :: [TranscriptionSegment] -> ShowS
showList :: [TranscriptionSegment] -> ShowS
Show, TranscriptionSegment -> TranscriptionSegment -> Bool
(TranscriptionSegment -> TranscriptionSegment -> Bool)
-> (TranscriptionSegment -> TranscriptionSegment -> Bool)
-> Eq TranscriptionSegment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TranscriptionSegment -> TranscriptionSegment -> Bool
== :: TranscriptionSegment -> TranscriptionSegment -> Bool
$c/= :: TranscriptionSegment -> TranscriptionSegment -> Bool
/= :: TranscriptionSegment -> TranscriptionSegment -> Bool
Eq, Eq TranscriptionSegment
Eq TranscriptionSegment =>
(TranscriptionSegment -> TranscriptionSegment -> Ordering)
-> (TranscriptionSegment -> TranscriptionSegment -> Bool)
-> (TranscriptionSegment -> TranscriptionSegment -> Bool)
-> (TranscriptionSegment -> TranscriptionSegment -> Bool)
-> (TranscriptionSegment -> TranscriptionSegment -> Bool)
-> (TranscriptionSegment
    -> TranscriptionSegment -> TranscriptionSegment)
-> (TranscriptionSegment
    -> TranscriptionSegment -> TranscriptionSegment)
-> Ord TranscriptionSegment
TranscriptionSegment -> TranscriptionSegment -> Bool
TranscriptionSegment -> TranscriptionSegment -> Ordering
TranscriptionSegment
-> TranscriptionSegment -> TranscriptionSegment
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TranscriptionSegment -> TranscriptionSegment -> Ordering
compare :: TranscriptionSegment -> TranscriptionSegment -> Ordering
$c< :: TranscriptionSegment -> TranscriptionSegment -> Bool
< :: TranscriptionSegment -> TranscriptionSegment -> Bool
$c<= :: TranscriptionSegment -> TranscriptionSegment -> Bool
<= :: TranscriptionSegment -> TranscriptionSegment -> Bool
$c> :: TranscriptionSegment -> TranscriptionSegment -> Bool
> :: TranscriptionSegment -> TranscriptionSegment -> Bool
$c>= :: TranscriptionSegment -> TranscriptionSegment -> Bool
>= :: TranscriptionSegment -> TranscriptionSegment -> Bool
$cmax :: TranscriptionSegment
-> TranscriptionSegment -> TranscriptionSegment
max :: TranscriptionSegment
-> TranscriptionSegment -> TranscriptionSegment
$cmin :: TranscriptionSegment
-> TranscriptionSegment -> TranscriptionSegment
min :: TranscriptionSegment
-> TranscriptionSegment -> TranscriptionSegment
Ord, (forall x. TranscriptionSegment -> Rep TranscriptionSegment x)
-> (forall x. Rep TranscriptionSegment x -> TranscriptionSegment)
-> Generic TranscriptionSegment
forall x. Rep TranscriptionSegment x -> TranscriptionSegment
forall x. TranscriptionSegment -> Rep TranscriptionSegment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TranscriptionSegment -> Rep TranscriptionSegment x
from :: forall x. TranscriptionSegment -> Rep TranscriptionSegment x
$cto :: forall x. Rep TranscriptionSegment x -> TranscriptionSegment
to :: forall x. Rep TranscriptionSegment x -> TranscriptionSegment
Generic, Typeable TranscriptionSegment
Typeable TranscriptionSegment =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> TranscriptionSegment
 -> c TranscriptionSegment)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TranscriptionSegment)
-> (TranscriptionSegment -> Constr)
-> (TranscriptionSegment -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TranscriptionSegment))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TranscriptionSegment))
-> ((forall b. Data b => b -> b)
    -> TranscriptionSegment -> TranscriptionSegment)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TranscriptionSegment -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TranscriptionSegment -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TranscriptionSegment -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TranscriptionSegment -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TranscriptionSegment -> m TranscriptionSegment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TranscriptionSegment -> m TranscriptionSegment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TranscriptionSegment -> m TranscriptionSegment)
-> Data TranscriptionSegment
TranscriptionSegment -> Constr
TranscriptionSegment -> DataType
(forall b. Data b => b -> b)
-> TranscriptionSegment -> TranscriptionSegment
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TranscriptionSegment -> u
forall u.
(forall d. Data d => d -> u) -> TranscriptionSegment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionSegment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionSegment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TranscriptionSegment -> m TranscriptionSegment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TranscriptionSegment -> m TranscriptionSegment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TranscriptionSegment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TranscriptionSegment
-> c TranscriptionSegment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TranscriptionSegment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TranscriptionSegment)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TranscriptionSegment
-> c TranscriptionSegment
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TranscriptionSegment
-> c TranscriptionSegment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TranscriptionSegment
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TranscriptionSegment
$ctoConstr :: TranscriptionSegment -> Constr
toConstr :: TranscriptionSegment -> Constr
$cdataTypeOf :: TranscriptionSegment -> DataType
dataTypeOf :: TranscriptionSegment -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TranscriptionSegment)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TranscriptionSegment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TranscriptionSegment)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TranscriptionSegment)
$cgmapT :: (forall b. Data b => b -> b)
-> TranscriptionSegment -> TranscriptionSegment
gmapT :: (forall b. Data b => b -> b)
-> TranscriptionSegment -> TranscriptionSegment
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionSegment -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionSegment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionSegment -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionSegment -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> TranscriptionSegment -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> TranscriptionSegment -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TranscriptionSegment -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TranscriptionSegment -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TranscriptionSegment -> m TranscriptionSegment
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TranscriptionSegment -> m TranscriptionSegment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TranscriptionSegment -> m TranscriptionSegment
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TranscriptionSegment -> m TranscriptionSegment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TranscriptionSegment -> m TranscriptionSegment
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TranscriptionSegment -> m TranscriptionSegment
Data)

instance FromJSON TranscriptionSegment where
  parseJSON :: Value -> Parser TranscriptionSegment
parseJSON = Options -> Value -> Parser TranscriptionSegment
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"transcriptionSegment")
instance ToJSON TranscriptionSegment where
  toJSON :: TranscriptionSegment -> Value
toJSON = Options -> TranscriptionSegment -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"transcriptionSegment")


-- | 
data TranscriptionWord = TranscriptionWord
  { TranscriptionWord -> Text
transcriptionWordWord :: Text -- ^ The text content of the word.
  , TranscriptionWord -> Float
transcriptionWordStart :: Float -- ^ Start time of the word in seconds.
  , TranscriptionWord -> Float
transcriptionWordEnd :: Float -- ^ End time of the word in seconds.
  } deriving (Int -> TranscriptionWord -> ShowS
[TranscriptionWord] -> ShowS
TranscriptionWord -> String
(Int -> TranscriptionWord -> ShowS)
-> (TranscriptionWord -> String)
-> ([TranscriptionWord] -> ShowS)
-> Show TranscriptionWord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TranscriptionWord -> ShowS
showsPrec :: Int -> TranscriptionWord -> ShowS
$cshow :: TranscriptionWord -> String
show :: TranscriptionWord -> String
$cshowList :: [TranscriptionWord] -> ShowS
showList :: [TranscriptionWord] -> ShowS
Show, TranscriptionWord -> TranscriptionWord -> Bool
(TranscriptionWord -> TranscriptionWord -> Bool)
-> (TranscriptionWord -> TranscriptionWord -> Bool)
-> Eq TranscriptionWord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TranscriptionWord -> TranscriptionWord -> Bool
== :: TranscriptionWord -> TranscriptionWord -> Bool
$c/= :: TranscriptionWord -> TranscriptionWord -> Bool
/= :: TranscriptionWord -> TranscriptionWord -> Bool
Eq, Eq TranscriptionWord
Eq TranscriptionWord =>
(TranscriptionWord -> TranscriptionWord -> Ordering)
-> (TranscriptionWord -> TranscriptionWord -> Bool)
-> (TranscriptionWord -> TranscriptionWord -> Bool)
-> (TranscriptionWord -> TranscriptionWord -> Bool)
-> (TranscriptionWord -> TranscriptionWord -> Bool)
-> (TranscriptionWord -> TranscriptionWord -> TranscriptionWord)
-> (TranscriptionWord -> TranscriptionWord -> TranscriptionWord)
-> Ord TranscriptionWord
TranscriptionWord -> TranscriptionWord -> Bool
TranscriptionWord -> TranscriptionWord -> Ordering
TranscriptionWord -> TranscriptionWord -> TranscriptionWord
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TranscriptionWord -> TranscriptionWord -> Ordering
compare :: TranscriptionWord -> TranscriptionWord -> Ordering
$c< :: TranscriptionWord -> TranscriptionWord -> Bool
< :: TranscriptionWord -> TranscriptionWord -> Bool
$c<= :: TranscriptionWord -> TranscriptionWord -> Bool
<= :: TranscriptionWord -> TranscriptionWord -> Bool
$c> :: TranscriptionWord -> TranscriptionWord -> Bool
> :: TranscriptionWord -> TranscriptionWord -> Bool
$c>= :: TranscriptionWord -> TranscriptionWord -> Bool
>= :: TranscriptionWord -> TranscriptionWord -> Bool
$cmax :: TranscriptionWord -> TranscriptionWord -> TranscriptionWord
max :: TranscriptionWord -> TranscriptionWord -> TranscriptionWord
$cmin :: TranscriptionWord -> TranscriptionWord -> TranscriptionWord
min :: TranscriptionWord -> TranscriptionWord -> TranscriptionWord
Ord, (forall x. TranscriptionWord -> Rep TranscriptionWord x)
-> (forall x. Rep TranscriptionWord x -> TranscriptionWord)
-> Generic TranscriptionWord
forall x. Rep TranscriptionWord x -> TranscriptionWord
forall x. TranscriptionWord -> Rep TranscriptionWord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TranscriptionWord -> Rep TranscriptionWord x
from :: forall x. TranscriptionWord -> Rep TranscriptionWord x
$cto :: forall x. Rep TranscriptionWord x -> TranscriptionWord
to :: forall x. Rep TranscriptionWord x -> TranscriptionWord
Generic, Typeable TranscriptionWord
Typeable TranscriptionWord =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> TranscriptionWord
 -> c TranscriptionWord)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TranscriptionWord)
-> (TranscriptionWord -> Constr)
-> (TranscriptionWord -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TranscriptionWord))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TranscriptionWord))
-> ((forall b. Data b => b -> b)
    -> TranscriptionWord -> TranscriptionWord)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TranscriptionWord -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TranscriptionWord -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TranscriptionWord -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TranscriptionWord -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TranscriptionWord -> m TranscriptionWord)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TranscriptionWord -> m TranscriptionWord)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TranscriptionWord -> m TranscriptionWord)
-> Data TranscriptionWord
TranscriptionWord -> Constr
TranscriptionWord -> DataType
(forall b. Data b => b -> b)
-> TranscriptionWord -> TranscriptionWord
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TranscriptionWord -> u
forall u. (forall d. Data d => d -> u) -> TranscriptionWord -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionWord -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionWord -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TranscriptionWord -> m TranscriptionWord
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TranscriptionWord -> m TranscriptionWord
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TranscriptionWord
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TranscriptionWord -> c TranscriptionWord
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TranscriptionWord)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TranscriptionWord)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TranscriptionWord -> c TranscriptionWord
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TranscriptionWord -> c TranscriptionWord
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TranscriptionWord
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TranscriptionWord
$ctoConstr :: TranscriptionWord -> Constr
toConstr :: TranscriptionWord -> Constr
$cdataTypeOf :: TranscriptionWord -> DataType
dataTypeOf :: TranscriptionWord -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TranscriptionWord)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TranscriptionWord)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TranscriptionWord)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TranscriptionWord)
$cgmapT :: (forall b. Data b => b -> b)
-> TranscriptionWord -> TranscriptionWord
gmapT :: (forall b. Data b => b -> b)
-> TranscriptionWord -> TranscriptionWord
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionWord -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionWord -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionWord -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TranscriptionWord -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TranscriptionWord -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TranscriptionWord -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TranscriptionWord -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TranscriptionWord -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TranscriptionWord -> m TranscriptionWord
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TranscriptionWord -> m TranscriptionWord
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TranscriptionWord -> m TranscriptionWord
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TranscriptionWord -> m TranscriptionWord
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TranscriptionWord -> m TranscriptionWord
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TranscriptionWord -> m TranscriptionWord
Data)

instance FromJSON TranscriptionWord where
  parseJSON :: Value -> Parser TranscriptionWord
parseJSON = Options -> Value -> Parser TranscriptionWord
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
removeFieldLabelPrefix String
"transcriptionWord")
instance ToJSON TranscriptionWord where
  toJSON :: TranscriptionWord -> Value
toJSON = Options -> TranscriptionWord -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
removeFieldLabelPrefix String
"transcriptionWord")


uncapitalize :: String -> String
uncapitalize :: ShowS
uncapitalize (Char
first:String
rest) = Char -> Char
Char.toLower Char
first Char -> ShowS
forall a. a -> [a] -> [a]
: String
rest
uncapitalize [] = []

-- | Remove a field label prefix during JSON parsing.
--   Also perform any replacements for special characters.
removeFieldLabelPrefix :: String -> Options
removeFieldLabelPrefix :: String -> Options
removeFieldLabelPrefix String
prefix =
  Options
defaultOptions
    { omitNothingFields  = True
    , fieldLabelModifier = uncapitalize . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars
    }
  where
    replaceSpecialChars :: ShowS
replaceSpecialChars String
field = (String -> ShowS -> String) -> String -> [ShowS] -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> ShowS -> String
forall a b. a -> (a -> b) -> b
(&) String
field (((String, String) -> ShowS) -> [(String, String)] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> ShowS
mkCharReplacement [(String, String)]
specialChars)
    specialChars :: [(String, String)]
specialChars =
      [ (String
"$", String
"Dollar")
      , (String
"^", String
"Caret")
      , (String
"|", String
"Pipe")
      , (String
"=", String
"Equal")
      , (String
"*", String
"Star")
      , (String
"-", String
"Dash")
      , (String
"&", String
"Ampersand")
      , (String
"%", String
"Percent")
      , (String
"#", String
"Hash")
      , (String
"@", String
"At")
      , (String
"!", String
"Exclamation")
      , (String
"+", String
"Plus")
      , (String
":", String
"Colon")
      , (String
";", String
"Semicolon")
      , (String
">", String
"GreaterThan")
      , (String
"<", String
"LessThan")
      , (String
".", String
"Period")
      , (String
"_", String
"Underscore")
      , (String
"?", String
"Question_Mark")
      , (String
",", String
"Comma")
      , (String
"'", String
"Quote")
      , (String
"/", String
"Slash")
      , (String
"(", String
"Left_Parenthesis")
      , (String
")", String
"Right_Parenthesis")
      , (String
"{", String
"Left_Curly_Bracket")
      , (String
"}", String
"Right_Curly_Bracket")
      , (String
"[", String
"Left_Square_Bracket")
      , (String
"]", String
"Right_Square_Bracket")
      , (String
"~", String
"Tilde")
      , (String
"`", String
"Backtick")
      , (String
"<=", String
"Less_Than_Or_Equal_To")
      , (String
">=", String
"Greater_Than_Or_Equal_To")
      , (String
"!=", String
"Not_Equal")
      , (String
"<>", String
"Not_Equal")
      , (String
"~=", String
"Tilde_Equal")
      , (String
"\\", String
"Back_Slash")
      , (String
"\"", String
"Double_Quote")
      ]
    mkCharReplacement :: (String, String) -> ShowS
mkCharReplacement (String
replaceStr, String
searchStr) = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replacer (String -> Text
T.pack String
searchStr) (String -> Text
T.pack String
replaceStr) (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    replacer :: Text -> Text -> Text -> Text
replacer = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace