-- | @\/v1\/batches@
module OpenAI.V1.Batches
    ( -- * Main types
      BatchID(..)
    , CreateBatch(..)
    , _CreateBatch
    , BatchObject(..)
      -- * Other types
    , Status(..)
    , Counts(..)
      -- * Servant
    , API
    ) where

import OpenAI.Prelude
import OpenAI.V1.Error
import OpenAI.V1.Files (FileID)
import OpenAI.V1.ListOf

-- | Batch ID
newtype BatchID = BatchID{ BatchID -> Text
text :: Text }
    deriving newtype (Maybe BatchID
Value -> Parser [BatchID]
Value -> Parser BatchID
(Value -> Parser BatchID)
-> (Value -> Parser [BatchID]) -> Maybe BatchID -> FromJSON BatchID
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser BatchID
parseJSON :: Value -> Parser BatchID
$cparseJSONList :: Value -> Parser [BatchID]
parseJSONList :: Value -> Parser [BatchID]
$comittedField :: Maybe BatchID
omittedField :: Maybe BatchID
FromJSON, String -> BatchID
(String -> BatchID) -> IsString BatchID
forall a. (String -> a) -> IsString a
$cfromString :: String -> BatchID
fromString :: String -> BatchID
IsString, Int -> BatchID -> ShowS
[BatchID] -> ShowS
BatchID -> String
(Int -> BatchID -> ShowS)
-> (BatchID -> String) -> ([BatchID] -> ShowS) -> Show BatchID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BatchID -> ShowS
showsPrec :: Int -> BatchID -> ShowS
$cshow :: BatchID -> String
show :: BatchID -> String
$cshowList :: [BatchID] -> ShowS
showList :: [BatchID] -> ShowS
Show, BatchID -> Text
BatchID -> ByteString
BatchID -> Builder
(BatchID -> Text)
-> (BatchID -> Builder)
-> (BatchID -> ByteString)
-> (BatchID -> Text)
-> (BatchID -> Builder)
-> ToHttpApiData BatchID
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: BatchID -> Text
toUrlPiece :: BatchID -> Text
$ctoEncodedUrlPiece :: BatchID -> Builder
toEncodedUrlPiece :: BatchID -> Builder
$ctoHeader :: BatchID -> ByteString
toHeader :: BatchID -> ByteString
$ctoQueryParam :: BatchID -> Text
toQueryParam :: BatchID -> Text
$ctoEncodedQueryParam :: BatchID -> Builder
toEncodedQueryParam :: BatchID -> Builder
ToHttpApiData, [BatchID] -> Value
[BatchID] -> Encoding
BatchID -> Bool
BatchID -> Value
BatchID -> Encoding
(BatchID -> Value)
-> (BatchID -> Encoding)
-> ([BatchID] -> Value)
-> ([BatchID] -> Encoding)
-> (BatchID -> Bool)
-> ToJSON BatchID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: BatchID -> Value
toJSON :: BatchID -> Value
$ctoEncoding :: BatchID -> Encoding
toEncoding :: BatchID -> Encoding
$ctoJSONList :: [BatchID] -> Value
toJSONList :: [BatchID] -> Value
$ctoEncodingList :: [BatchID] -> Encoding
toEncodingList :: [BatchID] -> Encoding
$comitField :: BatchID -> Bool
omitField :: BatchID -> Bool
ToJSON)

-- | Request body for @\/v1\/batches@
data CreateBatch = CreateBatch
    { CreateBatch -> FileID
input_file_id :: FileID
    , CreateBatch -> Text
endpoint :: Text
    , CreateBatch -> Text
completion_window :: Text
    , CreateBatch -> Maybe (Map Text Text)
metadata :: Maybe (Map Text Text)
    } deriving stock ((forall x. CreateBatch -> Rep CreateBatch x)
-> (forall x. Rep CreateBatch x -> CreateBatch)
-> Generic CreateBatch
forall x. Rep CreateBatch x -> CreateBatch
forall x. CreateBatch -> Rep CreateBatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateBatch -> Rep CreateBatch x
from :: forall x. CreateBatch -> Rep CreateBatch x
$cto :: forall x. Rep CreateBatch x -> CreateBatch
to :: forall x. Rep CreateBatch x -> CreateBatch
Generic, Int -> CreateBatch -> ShowS
[CreateBatch] -> ShowS
CreateBatch -> String
(Int -> CreateBatch -> ShowS)
-> (CreateBatch -> String)
-> ([CreateBatch] -> ShowS)
-> Show CreateBatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateBatch -> ShowS
showsPrec :: Int -> CreateBatch -> ShowS
$cshow :: CreateBatch -> String
show :: CreateBatch -> String
$cshowList :: [CreateBatch] -> ShowS
showList :: [CreateBatch] -> ShowS
Show)
      deriving anyclass ([CreateBatch] -> Value
[CreateBatch] -> Encoding
CreateBatch -> Bool
CreateBatch -> Value
CreateBatch -> Encoding
(CreateBatch -> Value)
-> (CreateBatch -> Encoding)
-> ([CreateBatch] -> Value)
-> ([CreateBatch] -> Encoding)
-> (CreateBatch -> Bool)
-> ToJSON CreateBatch
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CreateBatch -> Value
toJSON :: CreateBatch -> Value
$ctoEncoding :: CreateBatch -> Encoding
toEncoding :: CreateBatch -> Encoding
$ctoJSONList :: [CreateBatch] -> Value
toJSONList :: [CreateBatch] -> Value
$ctoEncodingList :: [CreateBatch] -> Encoding
toEncodingList :: [CreateBatch] -> Encoding
$comitField :: CreateBatch -> Bool
omitField :: CreateBatch -> Bool
ToJSON)

-- | Default `CreateBatch`
_CreateBatch :: CreateBatch
_CreateBatch :: CreateBatch
_CreateBatch = CreateBatch
    { $sel:metadata:CreateBatch :: Maybe (Map Text Text)
metadata = Maybe (Map Text Text)
forall a. Maybe a
Nothing
    }

-- | The current status of the batch.
data Status
    = Validating
    | Failed
    | In_Progress
    | Finalizing
    | Completed
    | Expired
    | Cancelling
    | Cancelled
    deriving stock ((forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status -> Rep Status x
from :: forall x. Status -> Rep Status x
$cto :: forall x. Rep Status x -> Status
to :: forall x. Rep Status x -> Status
Generic, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

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

-- | The request counts for different statuses within the batch.
data Counts = Counts
    { Counts -> Natural
total :: Natural
    , Counts -> Natural
completed :: Natural
    , Counts -> Natural
failed :: Natural
    } deriving stock ((forall x. Counts -> Rep Counts x)
-> (forall x. Rep Counts x -> Counts) -> Generic Counts
forall x. Rep Counts x -> Counts
forall x. Counts -> Rep Counts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Counts -> Rep Counts x
from :: forall x. Counts -> Rep Counts x
$cto :: forall x. Rep Counts x -> Counts
to :: forall x. Rep Counts x -> Counts
Generic, Int -> Counts -> ShowS
[Counts] -> ShowS
Counts -> String
(Int -> Counts -> ShowS)
-> (Counts -> String) -> ([Counts] -> ShowS) -> Show Counts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Counts -> ShowS
showsPrec :: Int -> Counts -> ShowS
$cshow :: Counts -> String
show :: Counts -> String
$cshowList :: [Counts] -> ShowS
showList :: [Counts] -> ShowS
Show)
      deriving anyclass (Maybe Counts
Value -> Parser [Counts]
Value -> Parser Counts
(Value -> Parser Counts)
-> (Value -> Parser [Counts]) -> Maybe Counts -> FromJSON Counts
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Counts
parseJSON :: Value -> Parser Counts
$cparseJSONList :: Value -> Parser [Counts]
parseJSONList :: Value -> Parser [Counts]
$comittedField :: Maybe Counts
omittedField :: Maybe Counts
FromJSON)

-- | The batch object
data BatchObject = BatchObject
    { BatchObject -> BatchID
id :: BatchID
    , BatchObject -> Text
object :: Text
    , BatchObject -> Text
endpoint :: Text
    , BatchObject -> Maybe (ListOf Error)
errors :: Maybe (ListOf Error)
    , BatchObject -> FileID
input_file_id :: FileID
    , BatchObject -> Text
completion_window :: Text
    , BatchObject -> Status
status :: Status
    , BatchObject -> Maybe FileID
output_file_id :: Maybe FileID
    , BatchObject -> Maybe FileID
error_file_id :: Maybe FileID
    , BatchObject -> POSIXTime
created_at :: POSIXTime
    , BatchObject -> Maybe POSIXTime
in_progress_at :: Maybe POSIXTime
    , BatchObject -> Maybe POSIXTime
expires_at :: Maybe POSIXTime
    , BatchObject -> Maybe POSIXTime
finalizing_at :: Maybe POSIXTime
    , BatchObject -> Maybe POSIXTime
completed_at :: Maybe POSIXTime
    , BatchObject -> Maybe POSIXTime
failed_at :: Maybe POSIXTime
    , BatchObject -> Maybe POSIXTime
expired_at :: Maybe POSIXTime
    , BatchObject -> Maybe POSIXTime
cancelling_at :: Maybe POSIXTime
    , BatchObject -> Maybe POSIXTime
cancelled_at :: Maybe POSIXTime
    , BatchObject -> Maybe Counts
request_counts :: Maybe Counts
    , BatchObject -> Maybe (Map Text Text)
metadata :: Maybe (Map Text Text)
    } deriving stock ((forall x. BatchObject -> Rep BatchObject x)
-> (forall x. Rep BatchObject x -> BatchObject)
-> Generic BatchObject
forall x. Rep BatchObject x -> BatchObject
forall x. BatchObject -> Rep BatchObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BatchObject -> Rep BatchObject x
from :: forall x. BatchObject -> Rep BatchObject x
$cto :: forall x. Rep BatchObject x -> BatchObject
to :: forall x. Rep BatchObject x -> BatchObject
Generic, Int -> BatchObject -> ShowS
[BatchObject] -> ShowS
BatchObject -> String
(Int -> BatchObject -> ShowS)
-> (BatchObject -> String)
-> ([BatchObject] -> ShowS)
-> Show BatchObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BatchObject -> ShowS
showsPrec :: Int -> BatchObject -> ShowS
$cshow :: BatchObject -> String
show :: BatchObject -> String
$cshowList :: [BatchObject] -> ShowS
showList :: [BatchObject] -> ShowS
Show)

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

-- | Servant API
type API =
        "batches"
    :>  (         ReqBody '[JSON] CreateBatch
              :>  Post '[JSON] BatchObject
        :<|>      Capture "batch_id" BatchID
              :>  Get '[JSON] BatchObject
        :<|>      Capture "batch_id" BatchID
              :>  "cancel"
              :>  Post '[JSON] BatchObject
        :<|>      QueryParam "after" Text
              :>  QueryParam "limit" Natural
              :>  Get '[JSON] (ListOf BatchObject)
        )