-- | @\/v1\/audio\/translations@
--
-- To simplify things, this only supports the @verbose_json@ response format
module OpenAI.V1.Audio.Translations
    ( -- * Main types
      CreateTranslation(..)
    , _CreateTranslation
    , TranslationObject(..)
      -- * Servant
    , API
    ) where

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

import qualified Data.Text as Text

-- | Request body for @\/v1\/audio\/translations@
data CreateTranslation = CreateTranslation
    { CreateTranslation -> FilePath
file :: FilePath
    , CreateTranslation -> Model
model :: Model
    , CreateTranslation -> Maybe Text
prompt :: Maybe Text
    , CreateTranslation -> Maybe Double
temperature :: Maybe Double
    } deriving stock ((forall x. CreateTranslation -> Rep CreateTranslation x)
-> (forall x. Rep CreateTranslation x -> CreateTranslation)
-> Generic CreateTranslation
forall x. Rep CreateTranslation x -> CreateTranslation
forall x. CreateTranslation -> Rep CreateTranslation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateTranslation -> Rep CreateTranslation x
from :: forall x. CreateTranslation -> Rep CreateTranslation x
$cto :: forall x. Rep CreateTranslation x -> CreateTranslation
to :: forall x. Rep CreateTranslation x -> CreateTranslation
Generic, Int -> CreateTranslation -> ShowS
[CreateTranslation] -> ShowS
CreateTranslation -> FilePath
(Int -> CreateTranslation -> ShowS)
-> (CreateTranslation -> FilePath)
-> ([CreateTranslation] -> ShowS)
-> Show CreateTranslation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTranslation -> ShowS
showsPrec :: Int -> CreateTranslation -> ShowS
$cshow :: CreateTranslation -> FilePath
show :: CreateTranslation -> FilePath
$cshowList :: [CreateTranslation] -> ShowS
showList :: [CreateTranslation] -> ShowS
Show)

instance ToMultipart Tmp CreateTranslation where
    toMultipart :: CreateTranslation -> MultipartData Tmp
toMultipart CreateTranslation{ $sel:model:CreateTranslation :: CreateTranslation -> Model
model = Model Text
model, FilePath
Maybe Double
Maybe Text
$sel:file:CreateTranslation :: CreateTranslation -> FilePath
$sel:prompt:CreateTranslation :: CreateTranslation -> Maybe Text
$sel:temperature:CreateTranslation :: CreateTranslation -> Maybe Double
file :: FilePath
prompt :: Maybe Text
temperature :: Maybe Double
..} = MultipartData{[Input]
[FileData Tmp]
inputs :: [Input]
files :: [FileData Tmp]
inputs :: [Input]
files :: [FileData Tmp]
..}
      where
        inputs :: [Input]
inputs =
                Text -> Text -> [Input]
input Text
"model" Text
model
            [Input] -> [Input] -> [Input]
forall a. Semigroup a => a -> a -> a
<>  (Text -> [Input]) -> Maybe Text -> [Input]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text -> [Input]
input Text
"prompt") Maybe Text
prompt
            [Input] -> [Input] -> [Input]
forall a. Semigroup a => a -> a -> a
<>  Text -> Text -> [Input]
input Text
"response_format" Text
"verbose_json"
            [Input] -> [Input] -> [Input]
forall a. Semigroup a => a -> a -> a
<>  (Double -> [Input]) -> Maybe Double -> [Input]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text -> [Input]
input Text
"temperature" (Text -> [Input]) -> (Double -> Text) -> Double -> [Input]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall number. RealFloat number => number -> Text
renderRealFloat) Maybe Double
temperature

        files :: [FileData Tmp]
files = [ FileData{FilePath
Text
MultipartResult Tmp
fdInputName :: Text
fdFileName :: Text
fdFileCType :: Text
fdPayload :: FilePath
fdInputName :: Text
fdFileName :: Text
fdFileCType :: Text
fdPayload :: MultipartResult Tmp
..} ]
          where
            fdInputName :: Text
fdInputName = Text
"file"
            fdFileName :: Text
fdFileName = FilePath -> Text
Text.pack FilePath
file
            fdFileCType :: Text
fdFileCType = Text
"audio/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
getExtension FilePath
file
            fdPayload :: FilePath
fdPayload = FilePath
file

-- | Default `CreateTranslation`
_CreateTranslation :: CreateTranslation
_CreateTranslation :: CreateTranslation
_CreateTranslation = CreateTranslation
    { $sel:prompt:CreateTranslation :: Maybe Text
prompt = Maybe Text
forall a. Maybe a
Nothing
    , $sel:temperature:CreateTranslation :: Maybe Double
temperature = Maybe Double
forall a. Maybe a
Nothing
    }

-- | Represents a transcription response returned by model, based on the
-- provided input.
data TranslationObject = TranslationObject
    { TranslationObject -> Text
text :: Text
    } deriving stock ((forall x. TranslationObject -> Rep TranslationObject x)
-> (forall x. Rep TranslationObject x -> TranslationObject)
-> Generic TranslationObject
forall x. Rep TranslationObject x -> TranslationObject
forall x. TranslationObject -> Rep TranslationObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TranslationObject -> Rep TranslationObject x
from :: forall x. TranslationObject -> Rep TranslationObject x
$cto :: forall x. Rep TranslationObject x -> TranslationObject
to :: forall x. Rep TranslationObject x -> TranslationObject
Generic, Int -> TranslationObject -> ShowS
[TranslationObject] -> ShowS
TranslationObject -> FilePath
(Int -> TranslationObject -> ShowS)
-> (TranslationObject -> FilePath)
-> ([TranslationObject] -> ShowS)
-> Show TranslationObject
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TranslationObject -> ShowS
showsPrec :: Int -> TranslationObject -> ShowS
$cshow :: TranslationObject -> FilePath
show :: TranslationObject -> FilePath
$cshowList :: [TranslationObject] -> ShowS
showList :: [TranslationObject] -> ShowS
Show)
      deriving anyclass (Maybe TranslationObject
Value -> Parser [TranslationObject]
Value -> Parser TranslationObject
(Value -> Parser TranslationObject)
-> (Value -> Parser [TranslationObject])
-> Maybe TranslationObject
-> FromJSON TranslationObject
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TranslationObject
parseJSON :: Value -> Parser TranslationObject
$cparseJSONList :: Value -> Parser [TranslationObject]
parseJSONList :: Value -> Parser [TranslationObject]
$comittedField :: Maybe TranslationObject
omittedField :: Maybe TranslationObject
FromJSON)

-- | Servant API
type API =
        "translations"
    :>  MultipartForm Tmp CreateTranslation
    :>  Post '[JSON] TranslationObject