-- | The `ToolResources` type
module OpenAI.V1.ToolResources
    ( -- * Main types
      ToolResources(..)

      -- * Other types
    , CodeInterpreterResources(..)
    , Static(..)
    , VectorStore(..)
    , FileSearchResources(..)
    ) where

import OpenAI.Prelude
import OpenAI.V1.AutoOr
import OpenAI.V1.ChunkingStrategy
import OpenAI.V1.Files (FileID)

-- | Resources for the code search tool
data CodeInterpreterResources = CodeInterpreterResources
    { CodeInterpreterResources -> Maybe (Vector FileID)
file_ids :: Maybe (Vector FileID)
    } deriving stock ((forall x.
 CodeInterpreterResources -> Rep CodeInterpreterResources x)
-> (forall x.
    Rep CodeInterpreterResources x -> CodeInterpreterResources)
-> Generic CodeInterpreterResources
forall x.
Rep CodeInterpreterResources x -> CodeInterpreterResources
forall x.
CodeInterpreterResources -> Rep CodeInterpreterResources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CodeInterpreterResources -> Rep CodeInterpreterResources x
from :: forall x.
CodeInterpreterResources -> Rep CodeInterpreterResources x
$cto :: forall x.
Rep CodeInterpreterResources x -> CodeInterpreterResources
to :: forall x.
Rep CodeInterpreterResources x -> CodeInterpreterResources
Generic, Int -> CodeInterpreterResources -> ShowS
[CodeInterpreterResources] -> ShowS
CodeInterpreterResources -> String
(Int -> CodeInterpreterResources -> ShowS)
-> (CodeInterpreterResources -> String)
-> ([CodeInterpreterResources] -> ShowS)
-> Show CodeInterpreterResources
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeInterpreterResources -> ShowS
showsPrec :: Int -> CodeInterpreterResources -> ShowS
$cshow :: CodeInterpreterResources -> String
show :: CodeInterpreterResources -> String
$cshowList :: [CodeInterpreterResources] -> ShowS
showList :: [CodeInterpreterResources] -> ShowS
Show)
      deriving anyclass (Maybe CodeInterpreterResources
Value -> Parser [CodeInterpreterResources]
Value -> Parser CodeInterpreterResources
(Value -> Parser CodeInterpreterResources)
-> (Value -> Parser [CodeInterpreterResources])
-> Maybe CodeInterpreterResources
-> FromJSON CodeInterpreterResources
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CodeInterpreterResources
parseJSON :: Value -> Parser CodeInterpreterResources
$cparseJSONList :: Value -> Parser [CodeInterpreterResources]
parseJSONList :: Value -> Parser [CodeInterpreterResources]
$comittedField :: Maybe CodeInterpreterResources
omittedField :: Maybe CodeInterpreterResources
FromJSON, [CodeInterpreterResources] -> Value
[CodeInterpreterResources] -> Encoding
CodeInterpreterResources -> Bool
CodeInterpreterResources -> Value
CodeInterpreterResources -> Encoding
(CodeInterpreterResources -> Value)
-> (CodeInterpreterResources -> Encoding)
-> ([CodeInterpreterResources] -> Value)
-> ([CodeInterpreterResources] -> Encoding)
-> (CodeInterpreterResources -> Bool)
-> ToJSON CodeInterpreterResources
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CodeInterpreterResources -> Value
toJSON :: CodeInterpreterResources -> Value
$ctoEncoding :: CodeInterpreterResources -> Encoding
toEncoding :: CodeInterpreterResources -> Encoding
$ctoJSONList :: [CodeInterpreterResources] -> Value
toJSONList :: [CodeInterpreterResources] -> Value
$ctoEncodingList :: [CodeInterpreterResources] -> Encoding
toEncodingList :: [CodeInterpreterResources] -> Encoding
$comitField :: CodeInterpreterResources -> Bool
omitField :: CodeInterpreterResources -> Bool
ToJSON)

-- | A helper to create a vector store with file_ids and attach it to this
-- assistant
data VectorStore = VectorStore
    { VectorStore -> Maybe (Vector FileID)
file_ids :: Maybe (Vector FileID)
    , VectorStore -> Maybe (AutoOr ChunkingStrategy)
chunking_strategy :: Maybe (AutoOr ChunkingStrategy)
    } deriving stock ((forall x. VectorStore -> Rep VectorStore x)
-> (forall x. Rep VectorStore x -> VectorStore)
-> Generic VectorStore
forall x. Rep VectorStore x -> VectorStore
forall x. VectorStore -> Rep VectorStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VectorStore -> Rep VectorStore x
from :: forall x. VectorStore -> Rep VectorStore x
$cto :: forall x. Rep VectorStore x -> VectorStore
to :: forall x. Rep VectorStore x -> VectorStore
Generic, Int -> VectorStore -> ShowS
[VectorStore] -> ShowS
VectorStore -> String
(Int -> VectorStore -> ShowS)
-> (VectorStore -> String)
-> ([VectorStore] -> ShowS)
-> Show VectorStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VectorStore -> ShowS
showsPrec :: Int -> VectorStore -> ShowS
$cshow :: VectorStore -> String
show :: VectorStore -> String
$cshowList :: [VectorStore] -> ShowS
showList :: [VectorStore] -> ShowS
Show)
      deriving anyclass (Maybe VectorStore
Value -> Parser [VectorStore]
Value -> Parser VectorStore
(Value -> Parser VectorStore)
-> (Value -> Parser [VectorStore])
-> Maybe VectorStore
-> FromJSON VectorStore
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser VectorStore
parseJSON :: Value -> Parser VectorStore
$cparseJSONList :: Value -> Parser [VectorStore]
parseJSONList :: Value -> Parser [VectorStore]
$comittedField :: Maybe VectorStore
omittedField :: Maybe VectorStore
FromJSON, [VectorStore] -> Value
[VectorStore] -> Encoding
VectorStore -> Bool
VectorStore -> Value
VectorStore -> Encoding
(VectorStore -> Value)
-> (VectorStore -> Encoding)
-> ([VectorStore] -> Value)
-> ([VectorStore] -> Encoding)
-> (VectorStore -> Bool)
-> ToJSON VectorStore
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: VectorStore -> Value
toJSON :: VectorStore -> Value
$ctoEncoding :: VectorStore -> Encoding
toEncoding :: VectorStore -> Encoding
$ctoJSONList :: [VectorStore] -> Value
toJSONList :: [VectorStore] -> Value
$ctoEncodingList :: [VectorStore] -> Encoding
toEncodingList :: [VectorStore] -> Encoding
$comitField :: VectorStore -> Bool
omitField :: VectorStore -> Bool
ToJSON)

-- | Resources for the file search tool
data FileSearchResources = FileSearchResources
    { FileSearchResources -> Maybe (Vector FileID)
vector_store_ids :: Maybe (Vector FileID)
    , FileSearchResources -> Maybe (Vector VectorStore)
vector_stores :: Maybe (Vector VectorStore)
    } deriving stock ((forall x. FileSearchResources -> Rep FileSearchResources x)
-> (forall x. Rep FileSearchResources x -> FileSearchResources)
-> Generic FileSearchResources
forall x. Rep FileSearchResources x -> FileSearchResources
forall x. FileSearchResources -> Rep FileSearchResources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FileSearchResources -> Rep FileSearchResources x
from :: forall x. FileSearchResources -> Rep FileSearchResources x
$cto :: forall x. Rep FileSearchResources x -> FileSearchResources
to :: forall x. Rep FileSearchResources x -> FileSearchResources
Generic, Int -> FileSearchResources -> ShowS
[FileSearchResources] -> ShowS
FileSearchResources -> String
(Int -> FileSearchResources -> ShowS)
-> (FileSearchResources -> String)
-> ([FileSearchResources] -> ShowS)
-> Show FileSearchResources
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileSearchResources -> ShowS
showsPrec :: Int -> FileSearchResources -> ShowS
$cshow :: FileSearchResources -> String
show :: FileSearchResources -> String
$cshowList :: [FileSearchResources] -> ShowS
showList :: [FileSearchResources] -> ShowS
Show)
      deriving anyclass (Maybe FileSearchResources
Value -> Parser [FileSearchResources]
Value -> Parser FileSearchResources
(Value -> Parser FileSearchResources)
-> (Value -> Parser [FileSearchResources])
-> Maybe FileSearchResources
-> FromJSON FileSearchResources
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser FileSearchResources
parseJSON :: Value -> Parser FileSearchResources
$cparseJSONList :: Value -> Parser [FileSearchResources]
parseJSONList :: Value -> Parser [FileSearchResources]
$comittedField :: Maybe FileSearchResources
omittedField :: Maybe FileSearchResources
FromJSON, [FileSearchResources] -> Value
[FileSearchResources] -> Encoding
FileSearchResources -> Bool
FileSearchResources -> Value
FileSearchResources -> Encoding
(FileSearchResources -> Value)
-> (FileSearchResources -> Encoding)
-> ([FileSearchResources] -> Value)
-> ([FileSearchResources] -> Encoding)
-> (FileSearchResources -> Bool)
-> ToJSON FileSearchResources
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: FileSearchResources -> Value
toJSON :: FileSearchResources -> Value
$ctoEncoding :: FileSearchResources -> Encoding
toEncoding :: FileSearchResources -> Encoding
$ctoJSONList :: [FileSearchResources] -> Value
toJSONList :: [FileSearchResources] -> Value
$ctoEncodingList :: [FileSearchResources] -> Encoding
toEncodingList :: [FileSearchResources] -> Encoding
$comitField :: FileSearchResources -> Bool
omitField :: FileSearchResources -> Bool
ToJSON)

-- | A set of resources that are used by the assistant's tools
data ToolResources = ToolResources
    { ToolResources -> Maybe CodeInterpreterResources
code_interpreter :: Maybe CodeInterpreterResources
    , ToolResources -> Maybe FileSearchResources
file_search :: Maybe FileSearchResources
    } deriving stock ((forall x. ToolResources -> Rep ToolResources x)
-> (forall x. Rep ToolResources x -> ToolResources)
-> Generic ToolResources
forall x. Rep ToolResources x -> ToolResources
forall x. ToolResources -> Rep ToolResources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ToolResources -> Rep ToolResources x
from :: forall x. ToolResources -> Rep ToolResources x
$cto :: forall x. Rep ToolResources x -> ToolResources
to :: forall x. Rep ToolResources x -> ToolResources
Generic, Int -> ToolResources -> ShowS
[ToolResources] -> ShowS
ToolResources -> String
(Int -> ToolResources -> ShowS)
-> (ToolResources -> String)
-> ([ToolResources] -> ShowS)
-> Show ToolResources
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolResources -> ShowS
showsPrec :: Int -> ToolResources -> ShowS
$cshow :: ToolResources -> String
show :: ToolResources -> String
$cshowList :: [ToolResources] -> ShowS
showList :: [ToolResources] -> ShowS
Show)
      deriving anyclass (Maybe ToolResources
Value -> Parser [ToolResources]
Value -> Parser ToolResources
(Value -> Parser ToolResources)
-> (Value -> Parser [ToolResources])
-> Maybe ToolResources
-> FromJSON ToolResources
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ToolResources
parseJSON :: Value -> Parser ToolResources
$cparseJSONList :: Value -> Parser [ToolResources]
parseJSONList :: Value -> Parser [ToolResources]
$comittedField :: Maybe ToolResources
omittedField :: Maybe ToolResources
FromJSON, [ToolResources] -> Value
[ToolResources] -> Encoding
ToolResources -> Bool
ToolResources -> Value
ToolResources -> Encoding
(ToolResources -> Value)
-> (ToolResources -> Encoding)
-> ([ToolResources] -> Value)
-> ([ToolResources] -> Encoding)
-> (ToolResources -> Bool)
-> ToJSON ToolResources
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ToolResources -> Value
toJSON :: ToolResources -> Value
$ctoEncoding :: ToolResources -> Encoding
toEncoding :: ToolResources -> Encoding
$ctoJSONList :: [ToolResources] -> Value
toJSONList :: [ToolResources] -> Value
$ctoEncodingList :: [ToolResources] -> Encoding
toEncodingList :: [ToolResources] -> Encoding
$comitField :: ToolResources -> Bool
omitField :: ToolResources -> Bool
ToJSON)