{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module OpenAI.Resources
  ( -- * Core Types
    TimeStamp(..), OpenAIList(..)
    -- * Engine
  , EngineId(..), Engine(..)
    -- * Text completion
  , TextCompletionId(..), TextCompletionChoice(..), TextCompletion(..), TextCompletionCreate(..)
  , defaultTextCompletionCreate
    -- * Searching
  , SearchResult(..), SearchResultCreate(..)
    -- * File API
  , FileCreate(..), FileId(..), File(..), FileHunk(..)
  , FileDeleteConfirmation(..)
    -- * Answers API
  , AnswerReq(..), AnswerResp(..)
  )
where

import OpenAI.Internal.Aeson

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

-- | 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 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 FileHunk
  = FileHunk
  { FileHunk -> Text
fhContent :: T.Text
  , FileHunk -> Maybe Text
fhMetadata :: Maybe T.Text
  } 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)

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
$ [Pair] -> Value
A.object [Text
"text" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= FileHunk -> Text
fhContent FileHunk
t, Text
"metadata" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= FileHunk -> Maybe Text
fhMetadata FileHunk
t]) [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)
    ]

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
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 2) ''TextCompletion)
$(deriveJSON (jsonOpts 3) ''TextCompletionChoice)
$(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)