-- | Embed
module Pinecone.Embed
    ( -- * Main types
      GenerateVectors(..)
    , _GenerateVectors
    , Embeddings(..)

      -- * Other types
    , Input(..)
    , VectorType(..)
    , Embedding(..)
    , Usage(..)

      -- * Servant
    , API
    ) where

import Pinecone.Metadata (Scalar)
import Pinecone.Prelude

-- | Generate embeddings for inputs
data GenerateVectors = GenerateVectors
    { GenerateVectors -> Text
model :: Text
    , GenerateVectors -> Vector Text
inputs :: Vector Text
    , GenerateVectors -> Map Text Scalar
parameters :: Map Text Scalar
    } deriving stock (GenerateVectors -> GenerateVectors -> Bool
(GenerateVectors -> GenerateVectors -> Bool)
-> (GenerateVectors -> GenerateVectors -> Bool)
-> Eq GenerateVectors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenerateVectors -> GenerateVectors -> Bool
== :: GenerateVectors -> GenerateVectors -> Bool
$c/= :: GenerateVectors -> GenerateVectors -> Bool
/= :: GenerateVectors -> GenerateVectors -> Bool
Eq, (forall x. GenerateVectors -> Rep GenerateVectors x)
-> (forall x. Rep GenerateVectors x -> GenerateVectors)
-> Generic GenerateVectors
forall x. Rep GenerateVectors x -> GenerateVectors
forall x. GenerateVectors -> Rep GenerateVectors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenerateVectors -> Rep GenerateVectors x
from :: forall x. GenerateVectors -> Rep GenerateVectors x
$cto :: forall x. Rep GenerateVectors x -> GenerateVectors
to :: forall x. Rep GenerateVectors x -> GenerateVectors
Generic, Int -> GenerateVectors -> ShowS
[GenerateVectors] -> ShowS
GenerateVectors -> String
(Int -> GenerateVectors -> ShowS)
-> (GenerateVectors -> String)
-> ([GenerateVectors] -> ShowS)
-> Show GenerateVectors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenerateVectors -> ShowS
showsPrec :: Int -> GenerateVectors -> ShowS
$cshow :: GenerateVectors -> String
show :: GenerateVectors -> String
$cshowList :: [GenerateVectors] -> ShowS
showList :: [GenerateVectors] -> ShowS
Show)

instance FromJSON GenerateVectors where
    parseJSON :: Value -> Parser GenerateVectors
parseJSON Value
value = do
        GenerateVectors_{Map Text Scalar
Text
Vector Input
model :: Text
inputs :: Vector Input
parameters :: Map Text Scalar
$sel:model:GenerateVectors_ :: GenerateVectors_ -> Text
$sel:inputs:GenerateVectors_ :: GenerateVectors_ -> Vector Input
$sel:parameters:GenerateVectors_ :: GenerateVectors_ -> Map Text Scalar
..} <- Value -> Parser GenerateVectors_
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value

        GenerateVectors -> Parser GenerateVectors
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return GenerateVectors{ $sel:inputs:GenerateVectors :: Vector Text
inputs = (Input -> Text) -> Vector Input -> Vector Text
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Input -> Text
text Vector Input
inputs, Map Text Scalar
Text
$sel:model:GenerateVectors :: Text
$sel:parameters:GenerateVectors :: Map Text Scalar
model :: Text
parameters :: Map Text Scalar
..}

instance ToJSON GenerateVectors where
    toJSON :: GenerateVectors -> Value
toJSON GenerateVectors{Map Text Scalar
Text
Vector Text
$sel:model:GenerateVectors :: GenerateVectors -> Text
$sel:inputs:GenerateVectors :: GenerateVectors -> Vector Text
$sel:parameters:GenerateVectors :: GenerateVectors -> Map Text Scalar
model :: Text
inputs :: Vector Text
parameters :: Map Text Scalar
..} =
        GenerateVectors_ -> Value
forall a. ToJSON a => a -> Value
toJSON GenerateVectors_{ $sel:inputs:GenerateVectors_ :: Vector Input
inputs = (Text -> Input) -> Vector Text -> Vector Input
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Input
Input Vector Text
inputs, Map Text Scalar
Text
$sel:model:GenerateVectors_ :: Text
$sel:parameters:GenerateVectors_ :: Map Text Scalar
model :: Text
parameters :: Map Text Scalar
..}

data GenerateVectors_ = GenerateVectors_
    { GenerateVectors_ -> Text
model :: Text
    , GenerateVectors_ -> Vector Input
inputs :: Vector Input
    , GenerateVectors_ -> Map Text Scalar
parameters :: Map Text Scalar
    } deriving stock (GenerateVectors_ -> GenerateVectors_ -> Bool
(GenerateVectors_ -> GenerateVectors_ -> Bool)
-> (GenerateVectors_ -> GenerateVectors_ -> Bool)
-> Eq GenerateVectors_
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenerateVectors_ -> GenerateVectors_ -> Bool
== :: GenerateVectors_ -> GenerateVectors_ -> Bool
$c/= :: GenerateVectors_ -> GenerateVectors_ -> Bool
/= :: GenerateVectors_ -> GenerateVectors_ -> Bool
Eq, (forall x. GenerateVectors_ -> Rep GenerateVectors_ x)
-> (forall x. Rep GenerateVectors_ x -> GenerateVectors_)
-> Generic GenerateVectors_
forall x. Rep GenerateVectors_ x -> GenerateVectors_
forall x. GenerateVectors_ -> Rep GenerateVectors_ x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenerateVectors_ -> Rep GenerateVectors_ x
from :: forall x. GenerateVectors_ -> Rep GenerateVectors_ x
$cto :: forall x. Rep GenerateVectors_ x -> GenerateVectors_
to :: forall x. Rep GenerateVectors_ x -> GenerateVectors_
Generic, Int -> GenerateVectors_ -> ShowS
[GenerateVectors_] -> ShowS
GenerateVectors_ -> String
(Int -> GenerateVectors_ -> ShowS)
-> (GenerateVectors_ -> String)
-> ([GenerateVectors_] -> ShowS)
-> Show GenerateVectors_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenerateVectors_ -> ShowS
showsPrec :: Int -> GenerateVectors_ -> ShowS
$cshow :: GenerateVectors_ -> String
show :: GenerateVectors_ -> String
$cshowList :: [GenerateVectors_] -> ShowS
showList :: [GenerateVectors_] -> ShowS
Show)
      deriving anyclass (Maybe GenerateVectors_
Value -> Parser [GenerateVectors_]
Value -> Parser GenerateVectors_
(Value -> Parser GenerateVectors_)
-> (Value -> Parser [GenerateVectors_])
-> Maybe GenerateVectors_
-> FromJSON GenerateVectors_
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GenerateVectors_
parseJSON :: Value -> Parser GenerateVectors_
$cparseJSONList :: Value -> Parser [GenerateVectors_]
parseJSONList :: Value -> Parser [GenerateVectors_]
$comittedField :: Maybe GenerateVectors_
omittedField :: Maybe GenerateVectors_
FromJSON, [GenerateVectors_] -> Value
[GenerateVectors_] -> Encoding
GenerateVectors_ -> Bool
GenerateVectors_ -> Value
GenerateVectors_ -> Encoding
(GenerateVectors_ -> Value)
-> (GenerateVectors_ -> Encoding)
-> ([GenerateVectors_] -> Value)
-> ([GenerateVectors_] -> Encoding)
-> (GenerateVectors_ -> Bool)
-> ToJSON GenerateVectors_
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GenerateVectors_ -> Value
toJSON :: GenerateVectors_ -> Value
$ctoEncoding :: GenerateVectors_ -> Encoding
toEncoding :: GenerateVectors_ -> Encoding
$ctoJSONList :: [GenerateVectors_] -> Value
toJSONList :: [GenerateVectors_] -> Value
$ctoEncodingList :: [GenerateVectors_] -> Encoding
toEncodingList :: [GenerateVectors_] -> Encoding
$comitField :: GenerateVectors_ -> Bool
omitField :: GenerateVectors_ -> Bool
ToJSON)

-- | Default `GenerateVectors`
_GenerateVectors :: GenerateVectors
_GenerateVectors :: GenerateVectors
_GenerateVectors = GenerateVectors{ }

-- | Embeddings generated for the input.
data Embeddings = Embeddings
    { Embeddings -> Text
model :: Text
    , Embeddings -> VectorType
vector_type :: VectorType
    , Embeddings -> Vector Embedding
data_ :: Vector Embedding
    , Embeddings -> Usage
usage :: Usage
    } deriving stock (Embeddings -> Embeddings -> Bool
(Embeddings -> Embeddings -> Bool)
-> (Embeddings -> Embeddings -> Bool) -> Eq Embeddings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Embeddings -> Embeddings -> Bool
== :: Embeddings -> Embeddings -> Bool
$c/= :: Embeddings -> Embeddings -> Bool
/= :: Embeddings -> Embeddings -> Bool
Eq, (forall x. Embeddings -> Rep Embeddings x)
-> (forall x. Rep Embeddings x -> Embeddings) -> Generic Embeddings
forall x. Rep Embeddings x -> Embeddings
forall x. Embeddings -> Rep Embeddings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Embeddings -> Rep Embeddings x
from :: forall x. Embeddings -> Rep Embeddings x
$cto :: forall x. Rep Embeddings x -> Embeddings
to :: forall x. Rep Embeddings x -> Embeddings
Generic, Int -> Embeddings -> ShowS
[Embeddings] -> ShowS
Embeddings -> String
(Int -> Embeddings -> ShowS)
-> (Embeddings -> String)
-> ([Embeddings] -> ShowS)
-> Show Embeddings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Embeddings -> ShowS
showsPrec :: Int -> Embeddings -> ShowS
$cshow :: Embeddings -> String
show :: Embeddings -> String
$cshowList :: [Embeddings] -> ShowS
showList :: [Embeddings] -> ShowS
Show)

instance FromJSON Embeddings where
    parseJSON :: Value -> Parser Embeddings
parseJSON = Options -> Value -> Parser Embeddings
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

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

-- | An embedding generated for an input
data Embedding
    = EmbeddingDense
        { Embedding -> Vector Double
values :: Vector Double
        }
    | EmbeddingSparse
        { Embedding -> Vector Double
sparse_values :: Vector Double
        , Embedding -> Vector Natural
sparse_indices :: Vector Natural
        , Embedding -> Vector Text
sparse_tokens :: Vector Text
        }
    deriving stock (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, (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, 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)

embeddingOptions :: Options
embeddingOptions :: Options
embeddingOptions = Options
aesonOptions
    { sumEncoding =
        TaggedObject{ tagFieldName = "vector_type", contentsFieldName = "" }

    , constructorTagModifier = stripPrefix "Embedding"

    , tagSingleConstructors = True
    }

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 Options
embeddingOptions

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

-- | Input to generate embedding for
data Input = Input
    { Input -> Text
text :: Text
    } deriving stock (Input -> Input -> Bool
(Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
/= :: Input -> Input -> Bool
Eq, (forall x. Input -> Rep Input x)
-> (forall x. Rep Input x -> Input) -> Generic Input
forall x. Rep Input x -> Input
forall x. Input -> Rep Input x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Input -> Rep Input x
from :: forall x. Input -> Rep Input x
$cto :: forall x. Rep Input x -> Input
to :: forall x. Rep Input x -> Input
Generic, Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Input -> ShowS
showsPrec :: Int -> Input -> ShowS
$cshow :: Input -> String
show :: Input -> String
$cshowList :: [Input] -> ShowS
showList :: [Input] -> ShowS
Show)
      deriving anyclass (Maybe Input
Value -> Parser [Input]
Value -> Parser Input
(Value -> Parser Input)
-> (Value -> Parser [Input]) -> Maybe Input -> FromJSON Input
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Input
parseJSON :: Value -> Parser Input
$cparseJSONList :: Value -> Parser [Input]
parseJSONList :: Value -> Parser [Input]
$comittedField :: Maybe Input
omittedField :: Maybe Input
FromJSON, [Input] -> Value
[Input] -> Encoding
Input -> Bool
Input -> Value
Input -> Encoding
(Input -> Value)
-> (Input -> Encoding)
-> ([Input] -> Value)
-> ([Input] -> Encoding)
-> (Input -> Bool)
-> ToJSON Input
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Input -> Value
toJSON :: Input -> Value
$ctoEncoding :: Input -> Encoding
toEncoding :: Input -> Encoding
$ctoJSONList :: [Input] -> Value
toJSONList :: [Input] -> Value
$ctoEncodingList :: [Input] -> Encoding
toEncodingList :: [Input] -> Encoding
$comitField :: Input -> Bool
omitField :: Input -> Bool
ToJSON)

-- | The index vector type
data VectorType = Dense | Sparse
    deriving stock (VectorType -> VectorType -> Bool
(VectorType -> VectorType -> Bool)
-> (VectorType -> VectorType -> Bool) -> Eq VectorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VectorType -> VectorType -> Bool
== :: VectorType -> VectorType -> Bool
$c/= :: VectorType -> VectorType -> Bool
/= :: VectorType -> VectorType -> Bool
Eq, (forall x. VectorType -> Rep VectorType x)
-> (forall x. Rep VectorType x -> VectorType) -> Generic VectorType
forall x. Rep VectorType x -> VectorType
forall x. VectorType -> Rep VectorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VectorType -> Rep VectorType x
from :: forall x. VectorType -> Rep VectorType x
$cto :: forall x. Rep VectorType x -> VectorType
to :: forall x. Rep VectorType x -> VectorType
Generic, Int -> VectorType -> ShowS
[VectorType] -> ShowS
VectorType -> String
(Int -> VectorType -> ShowS)
-> (VectorType -> String)
-> ([VectorType] -> ShowS)
-> Show VectorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VectorType -> ShowS
showsPrec :: Int -> VectorType -> ShowS
$cshow :: VectorType -> String
show :: VectorType -> String
$cshowList :: [VectorType] -> ShowS
showList :: [VectorType] -> ShowS
Show)

instance FromJSON VectorType where
    parseJSON :: Value -> Parser VectorType
parseJSON = Options -> Value -> Parser VectorType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

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

-- | Usage statistics for the model inference.
data Usage = Usage
    { Usage -> Natural
total_tokens :: Natural
    } deriving stock (Usage -> Usage -> Bool
(Usage -> Usage -> Bool) -> (Usage -> Usage -> Bool) -> Eq Usage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Usage -> Usage -> Bool
== :: Usage -> Usage -> Bool
$c/= :: Usage -> Usage -> Bool
/= :: Usage -> Usage -> Bool
Eq, (forall x. Usage -> Rep Usage x)
-> (forall x. Rep Usage x -> Usage) -> Generic Usage
forall x. Rep Usage x -> Usage
forall x. Usage -> Rep Usage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Usage -> Rep Usage x
from :: forall x. Usage -> Rep Usage x
$cto :: forall x. Rep Usage x -> Usage
to :: forall x. Rep Usage x -> Usage
Generic, Int -> Usage -> ShowS
[Usage] -> ShowS
Usage -> String
(Int -> Usage -> ShowS)
-> (Usage -> String) -> ([Usage] -> ShowS) -> Show Usage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Usage -> ShowS
showsPrec :: Int -> Usage -> ShowS
$cshow :: Usage -> String
show :: Usage -> String
$cshowList :: [Usage] -> ShowS
showList :: [Usage] -> ShowS
Show)
      deriving anyclass (Maybe Usage
Value -> Parser [Usage]
Value -> Parser Usage
(Value -> Parser Usage)
-> (Value -> Parser [Usage]) -> Maybe Usage -> FromJSON Usage
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Usage
parseJSON :: Value -> Parser Usage
$cparseJSONList :: Value -> Parser [Usage]
parseJSONList :: Value -> Parser [Usage]
$comittedField :: Maybe Usage
omittedField :: Maybe Usage
FromJSON, [Usage] -> Value
[Usage] -> Encoding
Usage -> Bool
Usage -> Value
Usage -> Encoding
(Usage -> Value)
-> (Usage -> Encoding)
-> ([Usage] -> Value)
-> ([Usage] -> Encoding)
-> (Usage -> Bool)
-> ToJSON Usage
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Usage -> Value
toJSON :: Usage -> Value
$ctoEncoding :: Usage -> Encoding
toEncoding :: Usage -> Encoding
$ctoJSONList :: [Usage] -> Value
toJSONList :: [Usage] -> Value
$ctoEncodingList :: [Usage] -> Encoding
toEncodingList :: [Usage] -> Encoding
$comitField :: Usage -> Bool
omitField :: Usage -> Bool
ToJSON)

-- | Servant API
type API =
        "embed"
    :>  ReqBody '[JSON] GenerateVectors
    :>  Post '[JSON] Embeddings