-- | The response format
module OpenAI.V1.Images.ResponseFormat
    ( -- * Types
      ResponseFormat(..)
    ) where

import OpenAI.Prelude

-- | The format in which the generated images are returned
data ResponseFormat = URL | B64_JSON
    deriving stock ((forall x. ResponseFormat -> Rep ResponseFormat x)
-> (forall x. Rep ResponseFormat x -> ResponseFormat)
-> Generic ResponseFormat
forall x. Rep ResponseFormat x -> ResponseFormat
forall x. ResponseFormat -> Rep ResponseFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResponseFormat -> Rep ResponseFormat x
from :: forall x. ResponseFormat -> Rep ResponseFormat x
$cto :: forall x. Rep ResponseFormat x -> ResponseFormat
to :: forall x. Rep ResponseFormat x -> ResponseFormat
Generic, Int -> ResponseFormat -> ShowS
[ResponseFormat] -> ShowS
ResponseFormat -> String
(Int -> ResponseFormat -> ShowS)
-> (ResponseFormat -> String)
-> ([ResponseFormat] -> ShowS)
-> Show ResponseFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseFormat -> ShowS
showsPrec :: Int -> ResponseFormat -> ShowS
$cshow :: ResponseFormat -> String
show :: ResponseFormat -> String
$cshowList :: [ResponseFormat] -> ShowS
showList :: [ResponseFormat] -> ShowS
Show)

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

instance ToHttpApiData ResponseFormat where
    toUrlPiece :: ResponseFormat -> Text
toUrlPiece ResponseFormat
URL = Text
"url"
    toUrlPiece ResponseFormat
B64_JSON = Text
"b64_json"