-- | @\/v1\/images\/variations@
module OpenAI.V1.Images.Variations
    ( -- * Main types
      CreateImageVariation(..)
    , _CreateImageVariation
      -- * Servant
    , API
    ) where

import OpenAI.Prelude
import OpenAI.V1.Images.Image
import OpenAI.V1.Images.ResponseFormat
import OpenAI.V1.ListOf
import OpenAI.V1.Models (Model(..))

import qualified Data.Text as Text

-- | Request body for @\/v1\/images\/variations@
data CreateImageVariation = CreateImageVariation
    { CreateImageVariation -> FilePath
image :: FilePath
    , CreateImageVariation -> Maybe Model
model :: Maybe Model
    , CreateImageVariation -> Maybe Natural
n :: Maybe Natural
    , CreateImageVariation -> Maybe ResponseFormat
response_format :: Maybe ResponseFormat
    , CreateImageVariation -> Maybe Text
size :: Maybe Text
    , CreateImageVariation -> Maybe Text
user :: Maybe Text
    } deriving stock ((forall x. CreateImageVariation -> Rep CreateImageVariation x)
-> (forall x. Rep CreateImageVariation x -> CreateImageVariation)
-> Generic CreateImageVariation
forall x. Rep CreateImageVariation x -> CreateImageVariation
forall x. CreateImageVariation -> Rep CreateImageVariation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateImageVariation -> Rep CreateImageVariation x
from :: forall x. CreateImageVariation -> Rep CreateImageVariation x
$cto :: forall x. Rep CreateImageVariation x -> CreateImageVariation
to :: forall x. Rep CreateImageVariation x -> CreateImageVariation
Generic, Int -> CreateImageVariation -> ShowS
[CreateImageVariation] -> ShowS
CreateImageVariation -> FilePath
(Int -> CreateImageVariation -> ShowS)
-> (CreateImageVariation -> FilePath)
-> ([CreateImageVariation] -> ShowS)
-> Show CreateImageVariation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateImageVariation -> ShowS
showsPrec :: Int -> CreateImageVariation -> ShowS
$cshow :: CreateImageVariation -> FilePath
show :: CreateImageVariation -> FilePath
$cshowList :: [CreateImageVariation] -> ShowS
showList :: [CreateImageVariation] -> ShowS
Show)

-- | Default `CreateImageVariation`
_CreateImageVariation :: CreateImageVariation
_CreateImageVariation :: CreateImageVariation
_CreateImageVariation = CreateImageVariation
    { $sel:model:CreateImageVariation :: Maybe Model
model = Maybe Model
forall a. Maybe a
Nothing
    , $sel:n:CreateImageVariation :: Maybe Natural
n = Maybe Natural
forall a. Maybe a
Nothing
    , $sel:response_format:CreateImageVariation :: Maybe ResponseFormat
response_format = Maybe ResponseFormat
forall a. Maybe a
Nothing
    , $sel:size:CreateImageVariation :: Maybe Text
size = Maybe Text
forall a. Maybe a
Nothing
    , $sel:user:CreateImageVariation :: Maybe Text
user = Maybe Text
forall a. Maybe a
Nothing
    }

instance ToMultipart Tmp CreateImageVariation where
    toMultipart :: CreateImageVariation -> MultipartData Tmp
toMultipart CreateImageVariation{FilePath
Maybe Natural
Maybe Text
Maybe ResponseFormat
Maybe Model
$sel:image:CreateImageVariation :: CreateImageVariation -> FilePath
$sel:model:CreateImageVariation :: CreateImageVariation -> Maybe Model
$sel:n:CreateImageVariation :: CreateImageVariation -> Maybe Natural
$sel:response_format:CreateImageVariation :: CreateImageVariation -> Maybe ResponseFormat
$sel:size:CreateImageVariation :: CreateImageVariation -> Maybe Text
$sel:user:CreateImageVariation :: CreateImageVariation -> Maybe Text
image :: FilePath
model :: Maybe Model
n :: Maybe Natural
response_format :: Maybe ResponseFormat
size :: Maybe Text
user :: Maybe Text
..} = MultipartData{[Input]
[FileData Tmp]
inputs :: [Input]
files :: [FileData Tmp]
inputs :: [Input]
files :: [FileData Tmp]
..}
      where
        inputs :: [Input]
inputs =
                (Model -> [Input]) -> Maybe Model -> [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
"model" (Text -> [Input]) -> (Model -> Text) -> Model -> [Input]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model -> Text
text) Maybe Model
model
            [Input] -> [Input] -> [Input]
forall a. Semigroup a => a -> a -> a
<>  (Natural -> [Input]) -> Maybe Natural -> [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
"n" (Text -> [Input]) -> (Natural -> Text) -> Natural -> [Input]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Text
forall number. Integral number => number -> Text
renderIntegral) Maybe Natural
n
            [Input] -> [Input] -> [Input]
forall a. Semigroup a => a -> a -> a
<>  (ResponseFormat -> [Input]) -> Maybe ResponseFormat -> [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
"response_format" (Text -> [Input])
-> (ResponseFormat -> Text) -> ResponseFormat -> [Input]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResponseFormat -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece) Maybe ResponseFormat
response_format
            [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
"size") Maybe Text
size
            [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
"user") Maybe Text
user

        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
"image"
            fdFileName :: Text
fdFileName = FilePath -> Text
Text.pack FilePath
image
            fdFileCType :: Text
fdFileCType = Text
"image/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
getExtension FilePath
image
            fdPayload :: FilePath
fdPayload = FilePath
image

-- | Servant API
type API =
        "variations"
    :>  MultipartForm Tmp CreateImageVariation
    :>  Post '[JSON] (ListOf ImageObject)