-- | @\/v1\/embeddings@
module OpenAI.V1.Embeddings
    ( -- * Main types
      CreateEmbeddings(..)
    , _CreateEmbeddings
    , EmbeddingObject(..)
      -- * Other types
    , EncodingFormat(..)
      -- * Servant
    , API
    ) where

import OpenAI.Prelude
import OpenAI.V1.ListOf
import OpenAI.V1.Models (Model)

-- | The format to return the embeddings in
data EncodingFormat = Float | Base64
    deriving stock ((forall x. EncodingFormat -> Rep EncodingFormat x)
-> (forall x. Rep EncodingFormat x -> EncodingFormat)
-> Generic EncodingFormat
forall x. Rep EncodingFormat x -> EncodingFormat
forall x. EncodingFormat -> Rep EncodingFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EncodingFormat -> Rep EncodingFormat x
from :: forall x. EncodingFormat -> Rep EncodingFormat x
$cto :: forall x. Rep EncodingFormat x -> EncodingFormat
to :: forall x. Rep EncodingFormat x -> EncodingFormat
Generic, Int -> EncodingFormat -> ShowS
[EncodingFormat] -> ShowS
EncodingFormat -> String
(Int -> EncodingFormat -> ShowS)
-> (EncodingFormat -> String)
-> ([EncodingFormat] -> ShowS)
-> Show EncodingFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncodingFormat -> ShowS
showsPrec :: Int -> EncodingFormat -> ShowS
$cshow :: EncodingFormat -> String
show :: EncodingFormat -> String
$cshowList :: [EncodingFormat] -> ShowS
showList :: [EncodingFormat] -> ShowS
Show)

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

-- | Request body for @\/v1\/embeddings@
data CreateEmbeddings = CreateEmbeddings
    { CreateEmbeddings -> Text
input :: Text
    , CreateEmbeddings -> Model
model :: Model
    , CreateEmbeddings -> Maybe EncodingFormat
encoding_format :: Maybe EncodingFormat
    , CreateEmbeddings -> Maybe Natural
dimensions :: Maybe Natural
    , CreateEmbeddings -> Maybe Text
user :: Maybe Text
    } deriving stock ((forall x. CreateEmbeddings -> Rep CreateEmbeddings x)
-> (forall x. Rep CreateEmbeddings x -> CreateEmbeddings)
-> Generic CreateEmbeddings
forall x. Rep CreateEmbeddings x -> CreateEmbeddings
forall x. CreateEmbeddings -> Rep CreateEmbeddings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateEmbeddings -> Rep CreateEmbeddings x
from :: forall x. CreateEmbeddings -> Rep CreateEmbeddings x
$cto :: forall x. Rep CreateEmbeddings x -> CreateEmbeddings
to :: forall x. Rep CreateEmbeddings x -> CreateEmbeddings
Generic, Int -> CreateEmbeddings -> ShowS
[CreateEmbeddings] -> ShowS
CreateEmbeddings -> String
(Int -> CreateEmbeddings -> ShowS)
-> (CreateEmbeddings -> String)
-> ([CreateEmbeddings] -> ShowS)
-> Show CreateEmbeddings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateEmbeddings -> ShowS
showsPrec :: Int -> CreateEmbeddings -> ShowS
$cshow :: CreateEmbeddings -> String
show :: CreateEmbeddings -> String
$cshowList :: [CreateEmbeddings] -> ShowS
showList :: [CreateEmbeddings] -> ShowS
Show)
      deriving anyclass ([CreateEmbeddings] -> Value
[CreateEmbeddings] -> Encoding
CreateEmbeddings -> Bool
CreateEmbeddings -> Value
CreateEmbeddings -> Encoding
(CreateEmbeddings -> Value)
-> (CreateEmbeddings -> Encoding)
-> ([CreateEmbeddings] -> Value)
-> ([CreateEmbeddings] -> Encoding)
-> (CreateEmbeddings -> Bool)
-> ToJSON CreateEmbeddings
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CreateEmbeddings -> Value
toJSON :: CreateEmbeddings -> Value
$ctoEncoding :: CreateEmbeddings -> Encoding
toEncoding :: CreateEmbeddings -> Encoding
$ctoJSONList :: [CreateEmbeddings] -> Value
toJSONList :: [CreateEmbeddings] -> Value
$ctoEncodingList :: [CreateEmbeddings] -> Encoding
toEncodingList :: [CreateEmbeddings] -> Encoding
$comitField :: CreateEmbeddings -> Bool
omitField :: CreateEmbeddings -> Bool
ToJSON)

-- | Default `CreateEmbeddings`
_CreateEmbeddings :: CreateEmbeddings
_CreateEmbeddings :: CreateEmbeddings
_CreateEmbeddings = CreateEmbeddings
    { $sel:encoding_format:CreateEmbeddings :: Maybe EncodingFormat
encoding_format = Maybe EncodingFormat
forall a. Maybe a
Nothing
    , $sel:dimensions:CreateEmbeddings :: Maybe Natural
dimensions = Maybe Natural
forall a. Maybe a
Nothing
    , $sel:user:CreateEmbeddings :: Maybe Text
user = Maybe Text
forall a. Maybe a
Nothing
    }

-- | The embedding object
data EmbeddingObject = EmbbeddingObject
    { EmbeddingObject -> Natural
index :: Natural
    , EmbeddingObject -> Vector Double
embedding :: Vector Double
    , EmbeddingObject -> Text
object :: Text
    } deriving stock ((forall x. EmbeddingObject -> Rep EmbeddingObject x)
-> (forall x. Rep EmbeddingObject x -> EmbeddingObject)
-> Generic EmbeddingObject
forall x. Rep EmbeddingObject x -> EmbeddingObject
forall x. EmbeddingObject -> Rep EmbeddingObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EmbeddingObject -> Rep EmbeddingObject x
from :: forall x. EmbeddingObject -> Rep EmbeddingObject x
$cto :: forall x. Rep EmbeddingObject x -> EmbeddingObject
to :: forall x. Rep EmbeddingObject x -> EmbeddingObject
Generic, Int -> EmbeddingObject -> ShowS
[EmbeddingObject] -> ShowS
EmbeddingObject -> String
(Int -> EmbeddingObject -> ShowS)
-> (EmbeddingObject -> String)
-> ([EmbeddingObject] -> ShowS)
-> Show EmbeddingObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EmbeddingObject -> ShowS
showsPrec :: Int -> EmbeddingObject -> ShowS
$cshow :: EmbeddingObject -> String
show :: EmbeddingObject -> String
$cshowList :: [EmbeddingObject] -> ShowS
showList :: [EmbeddingObject] -> ShowS
Show)
      deriving anyclass (Maybe EmbeddingObject
Value -> Parser [EmbeddingObject]
Value -> Parser EmbeddingObject
(Value -> Parser EmbeddingObject)
-> (Value -> Parser [EmbeddingObject])
-> Maybe EmbeddingObject
-> FromJSON EmbeddingObject
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser EmbeddingObject
parseJSON :: Value -> Parser EmbeddingObject
$cparseJSONList :: Value -> Parser [EmbeddingObject]
parseJSONList :: Value -> Parser [EmbeddingObject]
$comittedField :: Maybe EmbeddingObject
omittedField :: Maybe EmbeddingObject
FromJSON)

-- | Servant API
type API =
        "embeddings"
    :>  ReqBody '[JSON] CreateEmbeddings
    :>  Post '[JSON] (ListOf EmbeddingObject)