-- | @\/v1\/images\/generations@
module OpenAI.V1.Images.Generations
    ( -- * Main types
      CreateImage(..)
    , _CreateImage
      -- * Other types
    , Quality(..)
    , Style(..)
      -- * 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)

-- | The quality of the image that will be generated
data Quality = Standard | HD
    deriving stock ((forall x. Quality -> Rep Quality x)
-> (forall x. Rep Quality x -> Quality) -> Generic Quality
forall x. Rep Quality x -> Quality
forall x. Quality -> Rep Quality x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Quality -> Rep Quality x
from :: forall x. Quality -> Rep Quality x
$cto :: forall x. Rep Quality x -> Quality
to :: forall x. Rep Quality x -> Quality
Generic, Int -> Quality -> ShowS
[Quality] -> ShowS
Quality -> String
(Int -> Quality -> ShowS)
-> (Quality -> String) -> ([Quality] -> ShowS) -> Show Quality
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Quality -> ShowS
showsPrec :: Int -> Quality -> ShowS
$cshow :: Quality -> String
show :: Quality -> String
$cshowList :: [Quality] -> ShowS
showList :: [Quality] -> ShowS
Show)

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

-- | The style of the generated images
data Style = Vivid | Natural
    deriving stock ((forall x. Style -> Rep Style x)
-> (forall x. Rep Style x -> Style) -> Generic Style
forall x. Rep Style x -> Style
forall x. Style -> Rep Style x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Style -> Rep Style x
from :: forall x. Style -> Rep Style x
$cto :: forall x. Rep Style x -> Style
to :: forall x. Rep Style x -> Style
Generic, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> String
show :: Style -> String
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
Show)

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

-- | Requesty body for @\/v1/images/generations@
data CreateImage = CreateImage
    { CreateImage -> Text
prompt :: Text
    , CreateImage -> Maybe Model
model :: Maybe Model
    , CreateImage -> Maybe Natural
n :: Maybe Natural
    , CreateImage -> Maybe Quality
quality :: Maybe Quality
    , CreateImage -> Maybe ResponseFormat
response_format :: Maybe ResponseFormat
    , CreateImage -> Maybe Text
size :: Maybe Text
    , CreateImage -> Maybe Style
style :: Maybe Style
    , CreateImage -> Maybe Text
user :: Maybe Text
    } deriving stock ((forall x. CreateImage -> Rep CreateImage x)
-> (forall x. Rep CreateImage x -> CreateImage)
-> Generic CreateImage
forall x. Rep CreateImage x -> CreateImage
forall x. CreateImage -> Rep CreateImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateImage -> Rep CreateImage x
from :: forall x. CreateImage -> Rep CreateImage x
$cto :: forall x. Rep CreateImage x -> CreateImage
to :: forall x. Rep CreateImage x -> CreateImage
Generic, Int -> CreateImage -> ShowS
[CreateImage] -> ShowS
CreateImage -> String
(Int -> CreateImage -> ShowS)
-> (CreateImage -> String)
-> ([CreateImage] -> ShowS)
-> Show CreateImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateImage -> ShowS
showsPrec :: Int -> CreateImage -> ShowS
$cshow :: CreateImage -> String
show :: CreateImage -> String
$cshowList :: [CreateImage] -> ShowS
showList :: [CreateImage] -> ShowS
Show)

-- | Default `CreateImage`
_CreateImage :: CreateImage
_CreateImage :: CreateImage
_CreateImage = CreateImage
    { $sel:model:CreateImage :: Maybe Model
model = Maybe Model
forall a. Maybe a
Nothing
    , $sel:n:CreateImage :: Maybe Natural
n = Maybe Natural
forall a. Maybe a
Nothing
    , $sel:quality:CreateImage :: Maybe Quality
quality = Maybe Quality
forall a. Maybe a
Nothing
    , $sel:response_format:CreateImage :: Maybe ResponseFormat
response_format = Maybe ResponseFormat
forall a. Maybe a
Nothing
    , $sel:size:CreateImage :: Maybe Text
size = Maybe Text
forall a. Maybe a
Nothing
    , $sel:style:CreateImage :: Maybe Style
style = Maybe Style
forall a. Maybe a
Nothing
    , $sel:user:CreateImage :: Maybe Text
user = Maybe Text
forall a. Maybe a
Nothing
    }

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

-- | Servant API
type API =
        "generations"
    :>  ReqBody '[JSON] CreateImage
    :>  Post '[JSON] (ListOf ImageObject)