{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

module OpenAI.Resources
  ( -- * Core Types
    TimeStamp (..),
    OpenAIList (..),

    -- * Engine
    EngineId (..),
    Engine (..),

    -- * Text completion
    TextCompletionId (..),
    TextCompletionChoice (..),
    TextCompletion (..),
    TextCompletionCreate (..),
    defaultTextCompletionCreate,

    -- * Embeddings
    EmbeddingCreate (..),
    Embedding (..),

    -- * Fine tuning
    FineTuneId (..),
    FineTuneCreate (..),
    defaultFineTuneCreate,
    FineTune (..),
    FineTuneEvent (..),

    -- * Searching
    SearchResult (..),
    SearchResultCreate (..),

    -- * File API
    FileCreate (..),
    FileId (..),
    File (..),
    FileHunk (..),
    SearchHunk (..),
    ClassificationHunk (..),
    FineTuneHunk (..),
    FileDeleteConfirmation (..),

    -- * Answers API
    AnswerReq (..),
    AnswerResp (..),
  )
where

import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import Data.Time
import Data.Time.Clock.POSIX
import qualified Data.Vector as V
import OpenAI.Internal.Aeson
import Servant.API
import Servant.Multipart.API

-- | A 'UTCTime' wrapper that has unix timestamp JSON representation
newtype TimeStamp = TimeStamp {TimeStamp -> UTCTime
unTimeStamp :: UTCTime}
  deriving (Int -> TimeStamp -> ShowS
[TimeStamp] -> ShowS
TimeStamp -> String
(Int -> TimeStamp -> ShowS)
-> (TimeStamp -> String)
-> ([TimeStamp] -> ShowS)
-> Show TimeStamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeStamp] -> ShowS
$cshowList :: [TimeStamp] -> ShowS
show :: TimeStamp -> String
$cshow :: TimeStamp -> String
showsPrec :: Int -> TimeStamp -> ShowS
$cshowsPrec :: Int -> TimeStamp -> ShowS
Show, TimeStamp -> TimeStamp -> Bool
(TimeStamp -> TimeStamp -> Bool)
-> (TimeStamp -> TimeStamp -> Bool) -> Eq TimeStamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeStamp -> TimeStamp -> Bool
$c/= :: TimeStamp -> TimeStamp -> Bool
== :: TimeStamp -> TimeStamp -> Bool
$c== :: TimeStamp -> TimeStamp -> Bool
Eq)

instance A.ToJSON TimeStamp where
  toJSON :: TimeStamp -> Value
toJSON = Scientific -> Value
A.Number (Scientific -> Value)
-> (TimeStamp -> Scientific) -> TimeStamp -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational (Rational -> Scientific)
-> (TimeStamp -> Rational) -> TimeStamp -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational (POSIXTime -> Rational)
-> (TimeStamp -> POSIXTime) -> TimeStamp -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime)
-> (TimeStamp -> UTCTime) -> TimeStamp -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeStamp -> UTCTime
unTimeStamp

instance A.FromJSON TimeStamp where
  parseJSON :: Value -> Parser TimeStamp
parseJSON =
    String
-> (Scientific -> Parser TimeStamp) -> Value -> Parser TimeStamp
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
A.withScientific String
"unix timestamp" ((Scientific -> Parser TimeStamp) -> Value -> Parser TimeStamp)
-> (Scientific -> Parser TimeStamp) -> Value -> Parser TimeStamp
forall a b. (a -> b) -> a -> b
$ \Scientific
sci ->
      TimeStamp -> Parser TimeStamp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeStamp -> Parser TimeStamp) -> TimeStamp -> Parser TimeStamp
forall a b. (a -> b) -> a -> b
$ UTCTime -> TimeStamp
TimeStamp (UTCTime -> TimeStamp) -> UTCTime -> TimeStamp
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> POSIXTime) -> Rational -> POSIXTime
forall a b. (a -> b) -> a -> b
$ Scientific -> Rational
forall a. Real a => a -> Rational
toRational Scientific
sci)

instance ToHttpApiData TimeStamp where
  toUrlPiece :: TimeStamp -> Text
toUrlPiece TimeStamp
x =
    let unix :: Int
        unix :: Int
unix = POSIXTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int) -> (TimeStamp -> POSIXTime) -> TimeStamp -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime)
-> (TimeStamp -> UTCTime) -> TimeStamp -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeStamp -> UTCTime
unTimeStamp (TimeStamp -> Int) -> TimeStamp -> Int
forall a b. (a -> b) -> a -> b
$ TimeStamp
x
     in String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
unix)

-- | A 'V.Vector' wrapper.
newtype OpenAIList a = OpenAIList
  { OpenAIList a -> Vector a
olData :: V.Vector a
  }
  deriving (Int -> OpenAIList a -> ShowS
[OpenAIList a] -> ShowS
OpenAIList a -> String
(Int -> OpenAIList a -> ShowS)
-> (OpenAIList a -> String)
-> ([OpenAIList a] -> ShowS)
-> Show (OpenAIList a)
forall a. Show a => Int -> OpenAIList a -> ShowS
forall a. Show a => [OpenAIList a] -> ShowS
forall a. Show a => OpenAIList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenAIList a] -> ShowS
$cshowList :: forall a. Show a => [OpenAIList a] -> ShowS
show :: OpenAIList a -> String
$cshow :: forall a. Show a => OpenAIList a -> String
showsPrec :: Int -> OpenAIList a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OpenAIList a -> ShowS
Show, OpenAIList a -> OpenAIList a -> Bool
(OpenAIList a -> OpenAIList a -> Bool)
-> (OpenAIList a -> OpenAIList a -> Bool) -> Eq (OpenAIList a)
forall a. Eq a => OpenAIList a -> OpenAIList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenAIList a -> OpenAIList a -> Bool
$c/= :: forall a. Eq a => OpenAIList a -> OpenAIList a -> Bool
== :: OpenAIList a -> OpenAIList a -> Bool
$c== :: forall a. Eq a => OpenAIList a -> OpenAIList a -> Bool
Eq, a -> OpenAIList b -> OpenAIList a
(a -> b) -> OpenAIList a -> OpenAIList b
(forall a b. (a -> b) -> OpenAIList a -> OpenAIList b)
-> (forall a b. a -> OpenAIList b -> OpenAIList a)
-> Functor OpenAIList
forall a b. a -> OpenAIList b -> OpenAIList a
forall a b. (a -> b) -> OpenAIList a -> OpenAIList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OpenAIList b -> OpenAIList a
$c<$ :: forall a b. a -> OpenAIList b -> OpenAIList a
fmap :: (a -> b) -> OpenAIList a -> OpenAIList b
$cfmap :: forall a b. (a -> b) -> OpenAIList a -> OpenAIList b
Functor)

instance Semigroup (OpenAIList a) where
  <> :: OpenAIList a -> OpenAIList a -> OpenAIList a
(<>) OpenAIList a
a OpenAIList a
b = Vector a -> OpenAIList a
forall a. Vector a -> OpenAIList a
OpenAIList (OpenAIList a -> Vector a
forall a. OpenAIList a -> Vector a
olData OpenAIList a
a Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> OpenAIList a -> Vector a
forall a. OpenAIList a -> Vector a
olData OpenAIList a
b)

instance Monoid (OpenAIList a) where
  mempty :: OpenAIList a
mempty = Vector a -> OpenAIList a
forall a. Vector a -> OpenAIList a
OpenAIList Vector a
forall a. Monoid a => a
mempty

instance Applicative OpenAIList where
  pure :: a -> OpenAIList a
pure = Vector a -> OpenAIList a
forall a. Vector a -> OpenAIList a
OpenAIList (Vector a -> OpenAIList a) -> (a -> Vector a) -> a -> OpenAIList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  <*> :: OpenAIList (a -> b) -> OpenAIList a -> OpenAIList b
(<*>) OpenAIList (a -> b)
go OpenAIList a
x = Vector b -> OpenAIList b
forall a. Vector a -> OpenAIList a
OpenAIList (OpenAIList (a -> b) -> Vector (a -> b)
forall a. OpenAIList a -> Vector a
olData OpenAIList (a -> b)
go Vector (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenAIList a -> Vector a
forall a. OpenAIList a -> Vector a
olData OpenAIList a
x)

newtype EngineId = EngineId {EngineId -> Text
unEngineId :: T.Text}
  deriving (Int -> EngineId -> ShowS
[EngineId] -> ShowS
EngineId -> String
(Int -> EngineId -> ShowS)
-> (EngineId -> String) -> ([EngineId] -> ShowS) -> Show EngineId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EngineId] -> ShowS
$cshowList :: [EngineId] -> ShowS
show :: EngineId -> String
$cshow :: EngineId -> String
showsPrec :: Int -> EngineId -> ShowS
$cshowsPrec :: Int -> EngineId -> ShowS
Show, EngineId -> EngineId -> Bool
(EngineId -> EngineId -> Bool)
-> (EngineId -> EngineId -> Bool) -> Eq EngineId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EngineId -> EngineId -> Bool
$c/= :: EngineId -> EngineId -> Bool
== :: EngineId -> EngineId -> Bool
$c== :: EngineId -> EngineId -> Bool
Eq, [EngineId] -> Encoding
[EngineId] -> Value
EngineId -> Encoding
EngineId -> Value
(EngineId -> Value)
-> (EngineId -> Encoding)
-> ([EngineId] -> Value)
-> ([EngineId] -> Encoding)
-> ToJSON EngineId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EngineId] -> Encoding
$ctoEncodingList :: [EngineId] -> Encoding
toJSONList :: [EngineId] -> Value
$ctoJSONList :: [EngineId] -> Value
toEncoding :: EngineId -> Encoding
$ctoEncoding :: EngineId -> Encoding
toJSON :: EngineId -> Value
$ctoJSON :: EngineId -> Value
ToJSON, Value -> Parser [EngineId]
Value -> Parser EngineId
(Value -> Parser EngineId)
-> (Value -> Parser [EngineId]) -> FromJSON EngineId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EngineId]
$cparseJSONList :: Value -> Parser [EngineId]
parseJSON :: Value -> Parser EngineId
$cparseJSON :: Value -> Parser EngineId
FromJSON, EngineId -> ByteString
EngineId -> Builder
EngineId -> Text
(EngineId -> Text)
-> (EngineId -> Builder)
-> (EngineId -> ByteString)
-> (EngineId -> Text)
-> ToHttpApiData EngineId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: EngineId -> Text
$ctoQueryParam :: EngineId -> Text
toHeader :: EngineId -> ByteString
$ctoHeader :: EngineId -> ByteString
toEncodedUrlPiece :: EngineId -> Builder
$ctoEncodedUrlPiece :: EngineId -> Builder
toUrlPiece :: EngineId -> Text
$ctoUrlPiece :: EngineId -> Text
ToHttpApiData)

data Engine = Engine
  { Engine -> EngineId
eId :: EngineId,
    Engine -> Text
eOwner :: T.Text,
    Engine -> Bool
eReady :: Bool
  }
  deriving (Int -> Engine -> ShowS
[Engine] -> ShowS
Engine -> String
(Int -> Engine -> ShowS)
-> (Engine -> String) -> ([Engine] -> ShowS) -> Show Engine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Engine] -> ShowS
$cshowList :: [Engine] -> ShowS
show :: Engine -> String
$cshow :: Engine -> String
showsPrec :: Int -> Engine -> ShowS
$cshowsPrec :: Int -> Engine -> ShowS
Show, Engine -> Engine -> Bool
(Engine -> Engine -> Bool)
-> (Engine -> Engine -> Bool) -> Eq Engine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Engine -> Engine -> Bool
$c/= :: Engine -> Engine -> Bool
== :: Engine -> Engine -> Bool
$c== :: Engine -> Engine -> Bool
Eq)

newtype TextCompletionId = TextCompletionId {TextCompletionId -> Text
unTextCompletionId :: T.Text}
  deriving (Int -> TextCompletionId -> ShowS
[TextCompletionId] -> ShowS
TextCompletionId -> String
(Int -> TextCompletionId -> ShowS)
-> (TextCompletionId -> String)
-> ([TextCompletionId] -> ShowS)
-> Show TextCompletionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextCompletionId] -> ShowS
$cshowList :: [TextCompletionId] -> ShowS
show :: TextCompletionId -> String
$cshow :: TextCompletionId -> String
showsPrec :: Int -> TextCompletionId -> ShowS
$cshowsPrec :: Int -> TextCompletionId -> ShowS
Show, TextCompletionId -> TextCompletionId -> Bool
(TextCompletionId -> TextCompletionId -> Bool)
-> (TextCompletionId -> TextCompletionId -> Bool)
-> Eq TextCompletionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextCompletionId -> TextCompletionId -> Bool
$c/= :: TextCompletionId -> TextCompletionId -> Bool
== :: TextCompletionId -> TextCompletionId -> Bool
$c== :: TextCompletionId -> TextCompletionId -> Bool
Eq, [TextCompletionId] -> Encoding
[TextCompletionId] -> Value
TextCompletionId -> Encoding
TextCompletionId -> Value
(TextCompletionId -> Value)
-> (TextCompletionId -> Encoding)
-> ([TextCompletionId] -> Value)
-> ([TextCompletionId] -> Encoding)
-> ToJSON TextCompletionId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TextCompletionId] -> Encoding
$ctoEncodingList :: [TextCompletionId] -> Encoding
toJSONList :: [TextCompletionId] -> Value
$ctoJSONList :: [TextCompletionId] -> Value
toEncoding :: TextCompletionId -> Encoding
$ctoEncoding :: TextCompletionId -> Encoding
toJSON :: TextCompletionId -> Value
$ctoJSON :: TextCompletionId -> Value
ToJSON, Value -> Parser [TextCompletionId]
Value -> Parser TextCompletionId
(Value -> Parser TextCompletionId)
-> (Value -> Parser [TextCompletionId])
-> FromJSON TextCompletionId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TextCompletionId]
$cparseJSONList :: Value -> Parser [TextCompletionId]
parseJSON :: Value -> Parser TextCompletionId
$cparseJSON :: Value -> Parser TextCompletionId
FromJSON, TextCompletionId -> ByteString
TextCompletionId -> Builder
TextCompletionId -> Text
(TextCompletionId -> Text)
-> (TextCompletionId -> Builder)
-> (TextCompletionId -> ByteString)
-> (TextCompletionId -> Text)
-> ToHttpApiData TextCompletionId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: TextCompletionId -> Text
$ctoQueryParam :: TextCompletionId -> Text
toHeader :: TextCompletionId -> ByteString
$ctoHeader :: TextCompletionId -> ByteString
toEncodedUrlPiece :: TextCompletionId -> Builder
$ctoEncodedUrlPiece :: TextCompletionId -> Builder
toUrlPiece :: TextCompletionId -> Text
$ctoUrlPiece :: TextCompletionId -> Text
ToHttpApiData)

data TextCompletionChoice = TextCompletionChoice
  { TextCompletionChoice -> Text
tccText :: T.Text,
    TextCompletionChoice -> Int
tccIndex :: Int,
    TextCompletionChoice -> Maybe Int
tccLogProps :: Maybe Int,
    TextCompletionChoice -> Text
tccFinishReason :: T.Text
  }
  deriving (Int -> TextCompletionChoice -> ShowS
[TextCompletionChoice] -> ShowS
TextCompletionChoice -> String
(Int -> TextCompletionChoice -> ShowS)
-> (TextCompletionChoice -> String)
-> ([TextCompletionChoice] -> ShowS)
-> Show TextCompletionChoice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextCompletionChoice] -> ShowS
$cshowList :: [TextCompletionChoice] -> ShowS
show :: TextCompletionChoice -> String
$cshow :: TextCompletionChoice -> String
showsPrec :: Int -> TextCompletionChoice -> ShowS
$cshowsPrec :: Int -> TextCompletionChoice -> ShowS
Show, TextCompletionChoice -> TextCompletionChoice -> Bool
(TextCompletionChoice -> TextCompletionChoice -> Bool)
-> (TextCompletionChoice -> TextCompletionChoice -> Bool)
-> Eq TextCompletionChoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextCompletionChoice -> TextCompletionChoice -> Bool
$c/= :: TextCompletionChoice -> TextCompletionChoice -> Bool
== :: TextCompletionChoice -> TextCompletionChoice -> Bool
$c== :: TextCompletionChoice -> TextCompletionChoice -> Bool
Eq)

data TextCompletion = TextCompletion
  { TextCompletion -> TextCompletionId
tcId :: TextCompletionId,
    TextCompletion -> TimeStamp
tcCreated :: TimeStamp,
    TextCompletion -> Text
tcModel :: T.Text,
    TextCompletion -> Vector TextCompletionChoice
tcChoices :: V.Vector TextCompletionChoice
  }
  deriving (Int -> TextCompletion -> ShowS
[TextCompletion] -> ShowS
TextCompletion -> String
(Int -> TextCompletion -> ShowS)
-> (TextCompletion -> String)
-> ([TextCompletion] -> ShowS)
-> Show TextCompletion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextCompletion] -> ShowS
$cshowList :: [TextCompletion] -> ShowS
show :: TextCompletion -> String
$cshow :: TextCompletion -> String
showsPrec :: Int -> TextCompletion -> ShowS
$cshowsPrec :: Int -> TextCompletion -> ShowS
Show, TextCompletion -> TextCompletion -> Bool
(TextCompletion -> TextCompletion -> Bool)
-> (TextCompletion -> TextCompletion -> Bool) -> Eq TextCompletion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextCompletion -> TextCompletion -> Bool
$c/= :: TextCompletion -> TextCompletion -> Bool
== :: TextCompletion -> TextCompletion -> Bool
$c== :: TextCompletion -> TextCompletion -> Bool
Eq)

data TextCompletionCreate = TextCompletionCreate
  { TextCompletionCreate -> Text
tccrPrompt :: T.Text, -- TODO: support lists of strings
    TextCompletionCreate -> Maybe Int
tccrMaxTokens :: Maybe Int,
    TextCompletionCreate -> Maybe Double
tccrTemperature :: Maybe Double,
    TextCompletionCreate -> Maybe Double
tccrTopP :: Maybe Double,
    TextCompletionCreate -> Maybe Int
tccrN :: Maybe Int,
    TextCompletionCreate -> Maybe Int
tccrLogprobs :: Maybe Int,
    TextCompletionCreate -> Maybe Bool
tccrEcho :: Maybe Bool,
    TextCompletionCreate -> Maybe (Vector Text)
tccrStop :: Maybe (V.Vector T.Text),
    TextCompletionCreate -> Maybe Double
tccrPresencePenalty :: Maybe Double,
    TextCompletionCreate -> Maybe Double
tccrFrequencyPenalty :: Maybe Double,
    TextCompletionCreate -> Maybe Int
tccrBestOf :: Maybe Int
  }
  deriving (Int -> TextCompletionCreate -> ShowS
[TextCompletionCreate] -> ShowS
TextCompletionCreate -> String
(Int -> TextCompletionCreate -> ShowS)
-> (TextCompletionCreate -> String)
-> ([TextCompletionCreate] -> ShowS)
-> Show TextCompletionCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextCompletionCreate] -> ShowS
$cshowList :: [TextCompletionCreate] -> ShowS
show :: TextCompletionCreate -> String
$cshow :: TextCompletionCreate -> String
showsPrec :: Int -> TextCompletionCreate -> ShowS
$cshowsPrec :: Int -> TextCompletionCreate -> ShowS
Show, TextCompletionCreate -> TextCompletionCreate -> Bool
(TextCompletionCreate -> TextCompletionCreate -> Bool)
-> (TextCompletionCreate -> TextCompletionCreate -> Bool)
-> Eq TextCompletionCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextCompletionCreate -> TextCompletionCreate -> Bool
$c/= :: TextCompletionCreate -> TextCompletionCreate -> Bool
== :: TextCompletionCreate -> TextCompletionCreate -> Bool
$c== :: TextCompletionCreate -> TextCompletionCreate -> Bool
Eq)

-- | Applies API defaults, only passing a prompt.
defaultTextCompletionCreate :: T.Text -> TextCompletionCreate
defaultTextCompletionCreate :: Text -> TextCompletionCreate
defaultTextCompletionCreate Text
prompt =
  TextCompletionCreate :: Text
-> Maybe Int
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe (Vector Text)
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> TextCompletionCreate
TextCompletionCreate
    { tccrPrompt :: Text
tccrPrompt = Text
prompt,
      tccrMaxTokens :: Maybe Int
tccrMaxTokens = Maybe Int
forall a. Maybe a
Nothing,
      tccrTemperature :: Maybe Double
tccrTemperature = Maybe Double
forall a. Maybe a
Nothing,
      tccrTopP :: Maybe Double
tccrTopP = Maybe Double
forall a. Maybe a
Nothing,
      tccrN :: Maybe Int
tccrN = Maybe Int
forall a. Maybe a
Nothing,
      tccrLogprobs :: Maybe Int
tccrLogprobs = Maybe Int
forall a. Maybe a
Nothing,
      tccrEcho :: Maybe Bool
tccrEcho = Maybe Bool
forall a. Maybe a
Nothing,
      tccrStop :: Maybe (Vector Text)
tccrStop = Maybe (Vector Text)
forall a. Maybe a
Nothing,
      tccrPresencePenalty :: Maybe Double
tccrPresencePenalty = Maybe Double
forall a. Maybe a
Nothing,
      tccrFrequencyPenalty :: Maybe Double
tccrFrequencyPenalty = Maybe Double
forall a. Maybe a
Nothing,
      tccrBestOf :: Maybe Int
tccrBestOf = Maybe Int
forall a. Maybe a
Nothing
    }

data EmbeddingCreate = EmbeddingCreate
  {EmbeddingCreate -> Text
ecInput :: T.Text}
  deriving (Int -> EmbeddingCreate -> ShowS
[EmbeddingCreate] -> ShowS
EmbeddingCreate -> String
(Int -> EmbeddingCreate -> ShowS)
-> (EmbeddingCreate -> String)
-> ([EmbeddingCreate] -> ShowS)
-> Show EmbeddingCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmbeddingCreate] -> ShowS
$cshowList :: [EmbeddingCreate] -> ShowS
show :: EmbeddingCreate -> String
$cshow :: EmbeddingCreate -> String
showsPrec :: Int -> EmbeddingCreate -> ShowS
$cshowsPrec :: Int -> EmbeddingCreate -> ShowS
Show, EmbeddingCreate -> EmbeddingCreate -> Bool
(EmbeddingCreate -> EmbeddingCreate -> Bool)
-> (EmbeddingCreate -> EmbeddingCreate -> Bool)
-> Eq EmbeddingCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbeddingCreate -> EmbeddingCreate -> Bool
$c/= :: EmbeddingCreate -> EmbeddingCreate -> Bool
== :: EmbeddingCreate -> EmbeddingCreate -> Bool
$c== :: EmbeddingCreate -> EmbeddingCreate -> Bool
Eq)

data Embedding = Embedding
  {Embedding -> Vector Double
eEmbedding :: V.Vector Double, Embedding -> Int
eIndex :: Int}
  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
showList :: [Embedding] -> ShowS
$cshowList :: [Embedding] -> ShowS
show :: Embedding -> String
$cshow :: Embedding -> String
showsPrec :: Int -> Embedding -> ShowS
$cshowsPrec :: Int -> Embedding -> ShowS
Show, Embedding -> Embedding -> Bool
(Embedding -> Embedding -> Bool)
-> (Embedding -> Embedding -> Bool) -> Eq Embedding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Embedding -> Embedding -> Bool
$c/= :: Embedding -> Embedding -> Bool
== :: Embedding -> Embedding -> Bool
$c== :: Embedding -> Embedding -> Bool
Eq)

newtype FineTuneId = FineTuneId {FineTuneId -> Text
unFineTuneId :: T.Text}
  deriving (Int -> FineTuneId -> ShowS
[FineTuneId] -> ShowS
FineTuneId -> String
(Int -> FineTuneId -> ShowS)
-> (FineTuneId -> String)
-> ([FineTuneId] -> ShowS)
-> Show FineTuneId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FineTuneId] -> ShowS
$cshowList :: [FineTuneId] -> ShowS
show :: FineTuneId -> String
$cshow :: FineTuneId -> String
showsPrec :: Int -> FineTuneId -> ShowS
$cshowsPrec :: Int -> FineTuneId -> ShowS
Show, FineTuneId -> FineTuneId -> Bool
(FineTuneId -> FineTuneId -> Bool)
-> (FineTuneId -> FineTuneId -> Bool) -> Eq FineTuneId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FineTuneId -> FineTuneId -> Bool
$c/= :: FineTuneId -> FineTuneId -> Bool
== :: FineTuneId -> FineTuneId -> Bool
$c== :: FineTuneId -> FineTuneId -> Bool
Eq, [FineTuneId] -> Encoding
[FineTuneId] -> Value
FineTuneId -> Encoding
FineTuneId -> Value
(FineTuneId -> Value)
-> (FineTuneId -> Encoding)
-> ([FineTuneId] -> Value)
-> ([FineTuneId] -> Encoding)
-> ToJSON FineTuneId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FineTuneId] -> Encoding
$ctoEncodingList :: [FineTuneId] -> Encoding
toJSONList :: [FineTuneId] -> Value
$ctoJSONList :: [FineTuneId] -> Value
toEncoding :: FineTuneId -> Encoding
$ctoEncoding :: FineTuneId -> Encoding
toJSON :: FineTuneId -> Value
$ctoJSON :: FineTuneId -> Value
ToJSON, Value -> Parser [FineTuneId]
Value -> Parser FineTuneId
(Value -> Parser FineTuneId)
-> (Value -> Parser [FineTuneId]) -> FromJSON FineTuneId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FineTuneId]
$cparseJSONList :: Value -> Parser [FineTuneId]
parseJSON :: Value -> Parser FineTuneId
$cparseJSON :: Value -> Parser FineTuneId
FromJSON, FineTuneId -> ByteString
FineTuneId -> Builder
FineTuneId -> Text
(FineTuneId -> Text)
-> (FineTuneId -> Builder)
-> (FineTuneId -> ByteString)
-> (FineTuneId -> Text)
-> ToHttpApiData FineTuneId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: FineTuneId -> Text
$ctoQueryParam :: FineTuneId -> Text
toHeader :: FineTuneId -> ByteString
$ctoHeader :: FineTuneId -> ByteString
toEncodedUrlPiece :: FineTuneId -> Builder
$ctoEncodedUrlPiece :: FineTuneId -> Builder
toUrlPiece :: FineTuneId -> Text
$ctoUrlPiece :: FineTuneId -> Text
ToHttpApiData)

data FineTuneCreate = FineTuneCreate
  { FineTuneCreate -> FileId
ftcTrainingFile :: FileId,
    FineTuneCreate -> Maybe FileId
ftcValidationFile :: Maybe FileId,
    FineTuneCreate -> Maybe Text
ftcModel :: Maybe T.Text,
    FineTuneCreate -> Maybe Int
ftcBatchSize :: Maybe Int,
    FineTuneCreate -> Maybe Text
ftcNEpochs :: Maybe T.Text,
    FineTuneCreate -> Maybe Double
ftcLearningRateMultiplier :: Maybe Double,
    FineTuneCreate -> Maybe Double
ftcPromptLossWeight :: Maybe Double,
    FineTuneCreate -> Maybe Bool
ftcComputeClassificationMetrics :: Maybe Bool,
    FineTuneCreate -> Maybe Int
ftcClassificationNClasses :: Maybe Int,
    FineTuneCreate -> Maybe Text
ftcClassificationPositiveClass :: Maybe T.Text
  }
  deriving (Int -> FineTuneCreate -> ShowS
[FineTuneCreate] -> ShowS
FineTuneCreate -> String
(Int -> FineTuneCreate -> ShowS)
-> (FineTuneCreate -> String)
-> ([FineTuneCreate] -> ShowS)
-> Show FineTuneCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FineTuneCreate] -> ShowS
$cshowList :: [FineTuneCreate] -> ShowS
show :: FineTuneCreate -> String
$cshow :: FineTuneCreate -> String
showsPrec :: Int -> FineTuneCreate -> ShowS
$cshowsPrec :: Int -> FineTuneCreate -> ShowS
Show, FineTuneCreate -> FineTuneCreate -> Bool
(FineTuneCreate -> FineTuneCreate -> Bool)
-> (FineTuneCreate -> FineTuneCreate -> Bool) -> Eq FineTuneCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FineTuneCreate -> FineTuneCreate -> Bool
$c/= :: FineTuneCreate -> FineTuneCreate -> Bool
== :: FineTuneCreate -> FineTuneCreate -> Bool
$c== :: FineTuneCreate -> FineTuneCreate -> Bool
Eq)

defaultFineTuneCreate :: FileId -> FineTuneCreate
defaultFineTuneCreate :: FileId -> FineTuneCreate
defaultFineTuneCreate FileId
file =
  FineTuneCreate :: FileId
-> Maybe FileId
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Double
-> Maybe Double
-> Maybe Bool
-> Maybe Int
-> Maybe Text
-> FineTuneCreate
FineTuneCreate
    { ftcTrainingFile :: FileId
ftcTrainingFile = FileId
file,
      ftcValidationFile :: Maybe FileId
ftcValidationFile = Maybe FileId
forall a. Maybe a
Nothing,
      ftcModel :: Maybe Text
ftcModel = Maybe Text
forall a. Maybe a
Nothing,
      ftcBatchSize :: Maybe Int
ftcBatchSize = Maybe Int
forall a. Maybe a
Nothing,
      ftcNEpochs :: Maybe Text
ftcNEpochs = Maybe Text
forall a. Maybe a
Nothing,
      ftcLearningRateMultiplier :: Maybe Double
ftcLearningRateMultiplier = Maybe Double
forall a. Maybe a
Nothing,
      ftcPromptLossWeight :: Maybe Double
ftcPromptLossWeight = Maybe Double
forall a. Maybe a
Nothing,
      ftcComputeClassificationMetrics :: Maybe Bool
ftcComputeClassificationMetrics = Maybe Bool
forall a. Maybe a
Nothing,
      ftcClassificationNClasses :: Maybe Int
ftcClassificationNClasses = Maybe Int
forall a. Maybe a
Nothing,
      ftcClassificationPositiveClass :: Maybe Text
ftcClassificationPositiveClass = Maybe Text
forall a. Maybe a
Nothing
    }

data FineTuneEvent = FineTuneEvent
  { FineTuneEvent -> Int
fteCreatedAt :: Int,
    FineTuneEvent -> Text
fteLevel :: T.Text,
    FineTuneEvent -> Text
fteMessage :: T.Text
  }
  deriving (Int -> FineTuneEvent -> ShowS
[FineTuneEvent] -> ShowS
FineTuneEvent -> String
(Int -> FineTuneEvent -> ShowS)
-> (FineTuneEvent -> String)
-> ([FineTuneEvent] -> ShowS)
-> Show FineTuneEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FineTuneEvent] -> ShowS
$cshowList :: [FineTuneEvent] -> ShowS
show :: FineTuneEvent -> String
$cshow :: FineTuneEvent -> String
showsPrec :: Int -> FineTuneEvent -> ShowS
$cshowsPrec :: Int -> FineTuneEvent -> ShowS
Show, FineTuneEvent -> FineTuneEvent -> Bool
(FineTuneEvent -> FineTuneEvent -> Bool)
-> (FineTuneEvent -> FineTuneEvent -> Bool) -> Eq FineTuneEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FineTuneEvent -> FineTuneEvent -> Bool
$c/= :: FineTuneEvent -> FineTuneEvent -> Bool
== :: FineTuneEvent -> FineTuneEvent -> Bool
$c== :: FineTuneEvent -> FineTuneEvent -> Bool
Eq)

data FineTune = FineTune
  { FineTune -> FineTuneId
ftId :: FineTuneId,
    FineTune -> Text
ftModel :: T.Text,
    FineTune -> Int
ftCreatedAt :: Int,
    FineTune -> Vector FineTuneEvent
ftEvents :: V.Vector FineTuneEvent,
    FineTune -> Maybe Text
ftTunedModel :: Maybe T.Text,
    FineTune -> Text
ftStatus :: T.Text
  }
  deriving (Int -> FineTune -> ShowS
[FineTune] -> ShowS
FineTune -> String
(Int -> FineTune -> ShowS)
-> (FineTune -> String) -> ([FineTune] -> ShowS) -> Show FineTune
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FineTune] -> ShowS
$cshowList :: [FineTune] -> ShowS
show :: FineTune -> String
$cshow :: FineTune -> String
showsPrec :: Int -> FineTune -> ShowS
$cshowsPrec :: Int -> FineTune -> ShowS
Show, FineTune -> FineTune -> Bool
(FineTune -> FineTune -> Bool)
-> (FineTune -> FineTune -> Bool) -> Eq FineTune
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FineTune -> FineTune -> Bool
$c/= :: FineTune -> FineTune -> Bool
== :: FineTune -> FineTune -> Bool
$c== :: FineTune -> FineTune -> Bool
Eq)

data SearchResult = SearchResult
  { SearchResult -> Int
srDocument :: Int,
    SearchResult -> Double
srScore :: Double,
    SearchResult -> Maybe Text
srMetadata :: Maybe T.Text
  }
  deriving (Int -> SearchResult -> ShowS
[SearchResult] -> ShowS
SearchResult -> String
(Int -> SearchResult -> ShowS)
-> (SearchResult -> String)
-> ([SearchResult] -> ShowS)
-> Show SearchResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchResult] -> ShowS
$cshowList :: [SearchResult] -> ShowS
show :: SearchResult -> String
$cshow :: SearchResult -> String
showsPrec :: Int -> SearchResult -> ShowS
$cshowsPrec :: Int -> SearchResult -> ShowS
Show, SearchResult -> SearchResult -> Bool
(SearchResult -> SearchResult -> Bool)
-> (SearchResult -> SearchResult -> Bool) -> Eq SearchResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchResult -> SearchResult -> Bool
$c/= :: SearchResult -> SearchResult -> Bool
== :: SearchResult -> SearchResult -> Bool
$c== :: SearchResult -> SearchResult -> Bool
Eq)

data SearchResultCreate = SearchResultCreate
  { SearchResultCreate -> Maybe FileId
sccrFile :: Maybe FileId,
    SearchResultCreate -> Maybe (Vector Text)
sccrDocuments :: Maybe (V.Vector T.Text),
    SearchResultCreate -> Text
sccrQuery :: T.Text,
    SearchResultCreate -> Bool
sccrReturnMetadata :: Bool
  }
  deriving (Int -> SearchResultCreate -> ShowS
[SearchResultCreate] -> ShowS
SearchResultCreate -> String
(Int -> SearchResultCreate -> ShowS)
-> (SearchResultCreate -> String)
-> ([SearchResultCreate] -> ShowS)
-> Show SearchResultCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchResultCreate] -> ShowS
$cshowList :: [SearchResultCreate] -> ShowS
show :: SearchResultCreate -> String
$cshow :: SearchResultCreate -> String
showsPrec :: Int -> SearchResultCreate -> ShowS
$cshowsPrec :: Int -> SearchResultCreate -> ShowS
Show, SearchResultCreate -> SearchResultCreate -> Bool
(SearchResultCreate -> SearchResultCreate -> Bool)
-> (SearchResultCreate -> SearchResultCreate -> Bool)
-> Eq SearchResultCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchResultCreate -> SearchResultCreate -> Bool
$c/= :: SearchResultCreate -> SearchResultCreate -> Bool
== :: SearchResultCreate -> SearchResultCreate -> Bool
$c== :: SearchResultCreate -> SearchResultCreate -> Bool
Eq)

data SearchHunk = SearchHunk
  { SearchHunk -> Text
shText :: T.Text,
    SearchHunk -> Maybe Text
shMetadata :: Maybe T.Text
  }
  deriving (Int -> SearchHunk -> ShowS
[SearchHunk] -> ShowS
SearchHunk -> String
(Int -> SearchHunk -> ShowS)
-> (SearchHunk -> String)
-> ([SearchHunk] -> ShowS)
-> Show SearchHunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchHunk] -> ShowS
$cshowList :: [SearchHunk] -> ShowS
show :: SearchHunk -> String
$cshow :: SearchHunk -> String
showsPrec :: Int -> SearchHunk -> ShowS
$cshowsPrec :: Int -> SearchHunk -> ShowS
Show, SearchHunk -> SearchHunk -> Bool
(SearchHunk -> SearchHunk -> Bool)
-> (SearchHunk -> SearchHunk -> Bool) -> Eq SearchHunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchHunk -> SearchHunk -> Bool
$c/= :: SearchHunk -> SearchHunk -> Bool
== :: SearchHunk -> SearchHunk -> Bool
$c== :: SearchHunk -> SearchHunk -> Bool
Eq)

data ClassificationHunk = ClassificationHunk
  { ClassificationHunk -> Text
chText :: T.Text,
    ClassificationHunk -> Text
chLabel :: T.Text
  }
  deriving (Int -> ClassificationHunk -> ShowS
[ClassificationHunk] -> ShowS
ClassificationHunk -> String
(Int -> ClassificationHunk -> ShowS)
-> (ClassificationHunk -> String)
-> ([ClassificationHunk] -> ShowS)
-> Show ClassificationHunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClassificationHunk] -> ShowS
$cshowList :: [ClassificationHunk] -> ShowS
show :: ClassificationHunk -> String
$cshow :: ClassificationHunk -> String
showsPrec :: Int -> ClassificationHunk -> ShowS
$cshowsPrec :: Int -> ClassificationHunk -> ShowS
Show, ClassificationHunk -> ClassificationHunk -> Bool
(ClassificationHunk -> ClassificationHunk -> Bool)
-> (ClassificationHunk -> ClassificationHunk -> Bool)
-> Eq ClassificationHunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassificationHunk -> ClassificationHunk -> Bool
$c/= :: ClassificationHunk -> ClassificationHunk -> Bool
== :: ClassificationHunk -> ClassificationHunk -> Bool
$c== :: ClassificationHunk -> ClassificationHunk -> Bool
Eq)

data FineTuneHunk = FineTuneHunk
  { FineTuneHunk -> Text
fthPrompt :: T.Text,
    FineTuneHunk -> Text
fthCompletion :: T.Text
  }
  deriving (Int -> FineTuneHunk -> ShowS
[FineTuneHunk] -> ShowS
FineTuneHunk -> String
(Int -> FineTuneHunk -> ShowS)
-> (FineTuneHunk -> String)
-> ([FineTuneHunk] -> ShowS)
-> Show FineTuneHunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FineTuneHunk] -> ShowS
$cshowList :: [FineTuneHunk] -> ShowS
show :: FineTuneHunk -> String
$cshow :: FineTuneHunk -> String
showsPrec :: Int -> FineTuneHunk -> ShowS
$cshowsPrec :: Int -> FineTuneHunk -> ShowS
Show, FineTuneHunk -> FineTuneHunk -> Bool
(FineTuneHunk -> FineTuneHunk -> Bool)
-> (FineTuneHunk -> FineTuneHunk -> Bool) -> Eq FineTuneHunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FineTuneHunk -> FineTuneHunk -> Bool
$c/= :: FineTuneHunk -> FineTuneHunk -> Bool
== :: FineTuneHunk -> FineTuneHunk -> Bool
$c== :: FineTuneHunk -> FineTuneHunk -> Bool
Eq)

data FileHunk
  = FhSearch SearchHunk
  | FhClassifications ClassificationHunk
  | FhFineTune FineTuneHunk
  deriving (Int -> FileHunk -> ShowS
[FileHunk] -> ShowS
FileHunk -> String
(Int -> FileHunk -> ShowS)
-> (FileHunk -> String) -> ([FileHunk] -> ShowS) -> Show FileHunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileHunk] -> ShowS
$cshowList :: [FileHunk] -> ShowS
show :: FileHunk -> String
$cshow :: FileHunk -> String
showsPrec :: Int -> FileHunk -> ShowS
$cshowsPrec :: Int -> FileHunk -> ShowS
Show, FileHunk -> FileHunk -> Bool
(FileHunk -> FileHunk -> Bool)
-> (FileHunk -> FileHunk -> Bool) -> Eq FileHunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileHunk -> FileHunk -> Bool
$c/= :: FileHunk -> FileHunk -> Bool
== :: FileHunk -> FileHunk -> Bool
$c== :: FileHunk -> FileHunk -> Bool
Eq)

data FileCreate = FileCreate
  { FileCreate -> Text
fcPurpose :: T.Text,
    FileCreate -> [FileHunk]
fcDocuments :: [FileHunk]
  }
  deriving (Int -> FileCreate -> ShowS
[FileCreate] -> ShowS
FileCreate -> String
(Int -> FileCreate -> ShowS)
-> (FileCreate -> String)
-> ([FileCreate] -> ShowS)
-> Show FileCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileCreate] -> ShowS
$cshowList :: [FileCreate] -> ShowS
show :: FileCreate -> String
$cshow :: FileCreate -> String
showsPrec :: Int -> FileCreate -> ShowS
$cshowsPrec :: Int -> FileCreate -> ShowS
Show, FileCreate -> FileCreate -> Bool
(FileCreate -> FileCreate -> Bool)
-> (FileCreate -> FileCreate -> Bool) -> Eq FileCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileCreate -> FileCreate -> Bool
$c/= :: FileCreate -> FileCreate -> Bool
== :: FileCreate -> FileCreate -> Bool
$c== :: FileCreate -> FileCreate -> Bool
Eq)

newtype FileId = FileId {FileId -> Text
unFileId :: T.Text}
  deriving (Int -> FileId -> ShowS
[FileId] -> ShowS
FileId -> String
(Int -> FileId -> ShowS)
-> (FileId -> String) -> ([FileId] -> ShowS) -> Show FileId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileId] -> ShowS
$cshowList :: [FileId] -> ShowS
show :: FileId -> String
$cshow :: FileId -> String
showsPrec :: Int -> FileId -> ShowS
$cshowsPrec :: Int -> FileId -> ShowS
Show, FileId -> FileId -> Bool
(FileId -> FileId -> Bool)
-> (FileId -> FileId -> Bool) -> Eq FileId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileId -> FileId -> Bool
$c/= :: FileId -> FileId -> Bool
== :: FileId -> FileId -> Bool
$c== :: FileId -> FileId -> Bool
Eq, [FileId] -> Encoding
[FileId] -> Value
FileId -> Encoding
FileId -> Value
(FileId -> Value)
-> (FileId -> Encoding)
-> ([FileId] -> Value)
-> ([FileId] -> Encoding)
-> ToJSON FileId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FileId] -> Encoding
$ctoEncodingList :: [FileId] -> Encoding
toJSONList :: [FileId] -> Value
$ctoJSONList :: [FileId] -> Value
toEncoding :: FileId -> Encoding
$ctoEncoding :: FileId -> Encoding
toJSON :: FileId -> Value
$ctoJSON :: FileId -> Value
ToJSON, Value -> Parser [FileId]
Value -> Parser FileId
(Value -> Parser FileId)
-> (Value -> Parser [FileId]) -> FromJSON FileId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileId]
$cparseJSONList :: Value -> Parser [FileId]
parseJSON :: Value -> Parser FileId
$cparseJSON :: Value -> Parser FileId
FromJSON, FileId -> ByteString
FileId -> Builder
FileId -> Text
(FileId -> Text)
-> (FileId -> Builder)
-> (FileId -> ByteString)
-> (FileId -> Text)
-> ToHttpApiData FileId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: FileId -> Text
$ctoQueryParam :: FileId -> Text
toHeader :: FileId -> ByteString
$ctoHeader :: FileId -> ByteString
toEncodedUrlPiece :: FileId -> Builder
$ctoEncodedUrlPiece :: FileId -> Builder
toUrlPiece :: FileId -> Text
$ctoUrlPiece :: FileId -> Text
ToHttpApiData)

data File = File
  { File -> FileId
fId :: FileId,
    File -> TimeStamp
fCreatedAt :: TimeStamp,
    File -> Text
fStatus :: T.Text,
    File -> Text
fPurpose :: T.Text
  }
  deriving (Int -> File -> ShowS
[File] -> ShowS
File -> String
(Int -> File -> ShowS)
-> (File -> String) -> ([File] -> ShowS) -> Show File
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> String
$cshow :: File -> String
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
Show, File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: File -> File -> Bool
Eq)

data FileDeleteConfirmation = FileDeleteConfirmation
  { FileDeleteConfirmation -> FileId
fdcId :: FileId
  }
  deriving (Int -> FileDeleteConfirmation -> ShowS
[FileDeleteConfirmation] -> ShowS
FileDeleteConfirmation -> String
(Int -> FileDeleteConfirmation -> ShowS)
-> (FileDeleteConfirmation -> String)
-> ([FileDeleteConfirmation] -> ShowS)
-> Show FileDeleteConfirmation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileDeleteConfirmation] -> ShowS
$cshowList :: [FileDeleteConfirmation] -> ShowS
show :: FileDeleteConfirmation -> String
$cshow :: FileDeleteConfirmation -> String
showsPrec :: Int -> FileDeleteConfirmation -> ShowS
$cshowsPrec :: Int -> FileDeleteConfirmation -> ShowS
Show, FileDeleteConfirmation -> FileDeleteConfirmation -> Bool
(FileDeleteConfirmation -> FileDeleteConfirmation -> Bool)
-> (FileDeleteConfirmation -> FileDeleteConfirmation -> Bool)
-> Eq FileDeleteConfirmation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileDeleteConfirmation -> FileDeleteConfirmation -> Bool
$c/= :: FileDeleteConfirmation -> FileDeleteConfirmation -> Bool
== :: FileDeleteConfirmation -> FileDeleteConfirmation -> Bool
$c== :: FileDeleteConfirmation -> FileDeleteConfirmation -> Bool
Eq)

data AnswerReq = AnswerReq
  { AnswerReq -> Maybe FileId
arFile :: Maybe FileId,
    AnswerReq -> Maybe (Vector Text)
arDocuments :: Maybe (V.Vector T.Text),
    AnswerReq -> Text
arQuestion :: T.Text,
    AnswerReq -> EngineId
arSearchModel :: EngineId,
    AnswerReq -> EngineId
arModel :: EngineId,
    AnswerReq -> Text
arExamplesContext :: T.Text,
    AnswerReq -> [[Text]]
arExamples :: [[T.Text]],
    AnswerReq -> Bool
arReturnMetadata :: Bool
  }
  deriving (Int -> AnswerReq -> ShowS
[AnswerReq] -> ShowS
AnswerReq -> String
(Int -> AnswerReq -> ShowS)
-> (AnswerReq -> String)
-> ([AnswerReq] -> ShowS)
-> Show AnswerReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnswerReq] -> ShowS
$cshowList :: [AnswerReq] -> ShowS
show :: AnswerReq -> String
$cshow :: AnswerReq -> String
showsPrec :: Int -> AnswerReq -> ShowS
$cshowsPrec :: Int -> AnswerReq -> ShowS
Show, AnswerReq -> AnswerReq -> Bool
(AnswerReq -> AnswerReq -> Bool)
-> (AnswerReq -> AnswerReq -> Bool) -> Eq AnswerReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnswerReq -> AnswerReq -> Bool
$c/= :: AnswerReq -> AnswerReq -> Bool
== :: AnswerReq -> AnswerReq -> Bool
$c== :: AnswerReq -> AnswerReq -> Bool
Eq)

data AnswerResp = AnswerResp
  { AnswerResp -> [Text]
arsAnswers :: [T.Text]
  }
  deriving (Int -> AnswerResp -> ShowS
[AnswerResp] -> ShowS
AnswerResp -> String
(Int -> AnswerResp -> ShowS)
-> (AnswerResp -> String)
-> ([AnswerResp] -> ShowS)
-> Show AnswerResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnswerResp] -> ShowS
$cshowList :: [AnswerResp] -> ShowS
show :: AnswerResp -> String
$cshow :: AnswerResp -> String
showsPrec :: Int -> AnswerResp -> ShowS
$cshowsPrec :: Int -> AnswerResp -> ShowS
Show, AnswerResp -> AnswerResp -> Bool
(AnswerResp -> AnswerResp -> Bool)
-> (AnswerResp -> AnswerResp -> Bool) -> Eq AnswerResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnswerResp -> AnswerResp -> Bool
$c/= :: AnswerResp -> AnswerResp -> Bool
== :: AnswerResp -> AnswerResp -> Bool
$c== :: AnswerResp -> AnswerResp -> Bool
Eq)

$(deriveJSON (jsonOpts 2) ''OpenAIList)
$(deriveJSON (jsonOpts 1) ''Engine)
$(deriveJSON (jsonOpts 3) ''TextCompletionChoice)
$(deriveJSON (jsonOpts 2) ''TextCompletion)
$(deriveJSON (jsonOpts 4) ''TextCompletionCreate)
$(deriveJSON (jsonOpts 2) ''SearchResult)
$(deriveJSON (jsonOpts 4) ''SearchResultCreate)
$(deriveJSON (jsonOpts 1) ''File)
$(deriveJSON (jsonOpts 3) ''FileDeleteConfirmation)
$(deriveJSON (jsonOpts 2) ''AnswerReq)
$(deriveJSON (jsonOpts 3) ''AnswerResp)
$(deriveJSON (jsonOpts 2) ''EmbeddingCreate)
$(deriveJSON (jsonOpts 1) ''Embedding)
$(deriveJSON (jsonOpts 3) ''FineTuneCreate)
$(deriveJSON (jsonOpts 3) ''FineTuneEvent)
$(deriveJSON (jsonOpts 2) ''FineTune)
$(deriveJSON (jsonOpts 2) ''SearchHunk)
$(deriveJSON (jsonOpts 2) ''ClassificationHunk)
$(deriveJSON (jsonOpts 3) ''FineTuneHunk)

packDocuments :: [FileHunk] -> BSL.ByteString
packDocuments :: [FileHunk] -> ByteString
packDocuments [FileHunk]
docs =
  ByteString -> [ByteString] -> ByteString
BSL.intercalate ByteString
"\n" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
    (FileHunk -> ByteString) -> [FileHunk] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map
      ( \FileHunk
t -> Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$
          case FileHunk
t of
            FhSearch SearchHunk
x -> SearchHunk -> Value
forall a. ToJSON a => a -> Value
A.toJSON SearchHunk
x
            FhClassifications ClassificationHunk
x -> ClassificationHunk -> Value
forall a. ToJSON a => a -> Value
A.toJSON ClassificationHunk
x
            FhFineTune FineTuneHunk
x -> FineTuneHunk -> Value
forall a. ToJSON a => a -> Value
A.toJSON FineTuneHunk
x
      )
      [FileHunk]
docs

instance ToMultipart Mem FileCreate where
  toMultipart :: FileCreate -> MultipartData Mem
toMultipart FileCreate
rfc =
    [Input] -> [FileData Mem] -> MultipartData Mem
forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData
      [ Text -> Text -> Input
Input Text
"purpose" (FileCreate -> Text
fcPurpose FileCreate
rfc)
      ]
      [ Text -> Text -> Text -> MultipartResult Mem -> FileData Mem
forall tag.
Text -> Text -> Text -> MultipartResult tag -> FileData tag
FileData Text
"file" Text
"data.jsonl" Text
"application/json" ([FileHunk] -> ByteString
packDocuments ([FileHunk] -> ByteString) -> [FileHunk] -> ByteString
forall a b. (a -> b) -> a -> b
$ FileCreate -> [FileHunk]
fcDocuments FileCreate
rfc)
      ]