{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator.
{-# LANGUAGE OverloadedStrings #-}

-- | Contains the different functions to run the operation postProductsId
module StripeAPI.Operations.PostProductsId where

import qualified Control.Monad.Fail
import qualified Control.Monad.Trans.Reader
import qualified Data.Aeson
import qualified Data.Aeson as Data.Aeson.Encoding.Internal
import qualified Data.Aeson as Data.Aeson.Types
import qualified Data.Aeson as Data.Aeson.Types.FromJSON
import qualified Data.Aeson as Data.Aeson.Types.Internal
import qualified Data.Aeson as Data.Aeson.Types.ToJSON
import qualified Data.ByteString.Char8
import qualified Data.ByteString.Char8 as Data.ByteString.Internal
import qualified Data.Either
import qualified Data.Functor
import qualified Data.Scientific
import qualified Data.Text
import qualified Data.Text.Internal
import qualified Data.Time.Calendar as Data.Time.Calendar.Days
import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime
import qualified Data.Vector
import qualified GHC.Base
import qualified GHC.Classes
import qualified GHC.Int
import qualified GHC.Show
import qualified GHC.Types
import qualified Network.HTTP.Client
import qualified Network.HTTP.Client as Network.HTTP.Client.Request
import qualified Network.HTTP.Client as Network.HTTP.Client.Types
import qualified Network.HTTP.Simple
import qualified Network.HTTP.Types
import qualified Network.HTTP.Types as Network.HTTP.Types.Status
import qualified Network.HTTP.Types as Network.HTTP.Types.URI
import qualified StripeAPI.Common
import StripeAPI.Types
import qualified Prelude as GHC.Integer.Type
import qualified Prelude as GHC.Maybe

-- | > POST /v1/products/{id}
--
-- \<p>Updates the specific product by setting the values of the parameters passed. Any parameters not provided will be left unchanged.\<\/p>
postProductsId ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | id | Constraints: Maximum length of 5000
  Data.Text.Internal.Text ->
  -- | The request body to send
  GHC.Maybe.Maybe PostProductsIdRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response PostProductsIdResponse)
postProductsId :: Text
-> Maybe PostProductsIdRequestBody
-> StripeT m (Response PostProductsIdResponse)
postProductsId
  Text
id
  Maybe PostProductsIdRequestBody
body =
    (Response ByteString -> Response PostProductsIdResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response PostProductsIdResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
      ( \Response ByteString
response_0 ->
          (ByteString -> PostProductsIdResponse)
-> Response ByteString -> Response PostProductsIdResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
            ( (String -> PostProductsIdResponse)
-> (PostProductsIdResponse -> PostProductsIdResponse)
-> Either String PostProductsIdResponse
-> PostProductsIdResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostProductsIdResponse
PostProductsIdResponseError PostProductsIdResponse -> PostProductsIdResponse
forall a. a -> a
GHC.Base.id
                (Either String PostProductsIdResponse -> PostProductsIdResponse)
-> (ByteString -> Either String PostProductsIdResponse)
-> ByteString
-> PostProductsIdResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. ( \Response ByteString
response ByteString
body ->
                               if
                                   | (\Status
status_1 -> Status -> Int
Network.HTTP.Types.Status.statusCode Status
status_1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Int
200) (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
                                     Product -> PostProductsIdResponse
PostProductsIdResponse200
                                       (Product -> PostProductsIdResponse)
-> Either String Product -> Either String PostProductsIdResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Product
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                            Data.Either.Either
                                                              GHC.Base.String
                                                              Product
                                                        )
                                   | Bool -> Status -> Bool
forall a b. a -> b -> a
GHC.Base.const Bool
GHC.Types.True (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
                                     Error -> PostProductsIdResponse
PostProductsIdResponseDefault
                                       (Error -> PostProductsIdResponse)
-> Either String Error -> Either String PostProductsIdResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Error
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                            Data.Either.Either
                                                              GHC.Base.String
                                                              Error
                                                        )
                                   | Bool
GHC.Base.otherwise -> String -> Either String PostProductsIdResponse
forall a b. a -> Either a b
Data.Either.Left String
"Missing default response type"
                           )
                  Response ByteString
response_0
            )
            Response ByteString
response_0
      )
      (Text
-> Text
-> [QueryParameter]
-> Maybe PostProductsIdRequestBody
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
StripeAPI.Common.doBodyCallWithConfigurationM (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.pack String
"POST") (String -> Text
Data.Text.pack (String
"/v1/products/" String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ (ByteString -> String
Data.ByteString.Char8.unpack (Bool -> ByteString -> ByteString
Network.HTTP.Types.URI.urlEncode Bool
GHC.Types.True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ (String -> ByteString
Data.ByteString.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ Text -> String
forall a. StringifyModel a => a -> String
StripeAPI.Common.stringifyModel Text
id)) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ String
""))) [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostProductsIdRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/products\/{id}.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostProductsIdRequestBody = PostProductsIdRequestBody
  { -- | active: Whether the product is available for purchase.
    PostProductsIdRequestBody -> Maybe Bool
postProductsIdRequestBodyActive :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | description: The product\'s description, meant to be displayable to the customer. Use this field to optionally store a long form explanation of the product being sold for your own rendering purposes.
    --
    -- Constraints:
    --
    -- * Maximum length of 40000
    PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyDescription :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostProductsIdRequestBody -> Maybe [Text]
postProductsIdRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | images: A list of up to 8 URLs of images for this product, meant to be displayable to the customer.
    PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyImages'Variants
postProductsIdRequestBodyImages :: (GHC.Maybe.Maybe PostProductsIdRequestBodyImages'Variants),
    -- | metadata: Set of [key-value pairs](https:\/\/stripe.com\/docs\/api\/metadata) that you can attach to an object. This can be useful for storing additional information about the object in a structured format. Individual keys can be unset by posting an empty value to them. All keys can be unset by posting an empty value to \`metadata\`.
    PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyMetadata'Variants
postProductsIdRequestBodyMetadata :: (GHC.Maybe.Maybe PostProductsIdRequestBodyMetadata'Variants),
    -- | name: The product\'s name, meant to be displayable to the customer. Whenever this product is sold via a subscription, name will show up on associated invoice line item descriptions.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | package_dimensions: The dimensions of this product for shipping purposes.
    PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
postProductsIdRequestBodyPackageDimensions :: (GHC.Maybe.Maybe PostProductsIdRequestBodyPackageDimensions'Variants),
    -- | shippable: Whether this product is shipped (i.e., physical goods).
    PostProductsIdRequestBody -> Maybe Bool
postProductsIdRequestBodyShippable :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | statement_descriptor: An arbitrary string to be displayed on your customer\'s credit card or bank statement. While most banks display this information consistently, some may display it incorrectly or not at all.
    --
    -- This may be up to 22 characters. The statement description may not include \`\<\`, \`>\`, \`\\\`, \`\"\`, \`\'\` characters, and will appear on your customer\'s statement in capital letters. Non-ASCII characters are automatically stripped.
    --  It must contain at least one letter. May only be set if \`type=service\`.
    --
    -- Constraints:
    --
    -- * Maximum length of 22
    PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyStatementDescriptor :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | tax_code: A [tax code](https:\/\/stripe.com\/docs\/tax\/tax-codes) ID.
    PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyTaxCode'Variants
postProductsIdRequestBodyTaxCode :: (GHC.Maybe.Maybe PostProductsIdRequestBodyTaxCode'Variants),
    -- | unit_label: A label that represents units of this product in Stripe and on customers’ receipts and invoices. When set, this will be included in associated invoice line item descriptions. May only be set if \`type=service\`.
    --
    -- Constraints:
    --
    -- * Maximum length of 12
    PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyUnitLabel :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | url: A URL of a publicly-accessible webpage for this product.
    PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyUrl :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> PostProductsIdRequestBody -> String -> String
[PostProductsIdRequestBody] -> String -> String
PostProductsIdRequestBody -> String
(Int -> PostProductsIdRequestBody -> String -> String)
-> (PostProductsIdRequestBody -> String)
-> ([PostProductsIdRequestBody] -> String -> String)
-> Show PostProductsIdRequestBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostProductsIdRequestBody] -> String -> String
$cshowList :: [PostProductsIdRequestBody] -> String -> String
show :: PostProductsIdRequestBody -> String
$cshow :: PostProductsIdRequestBody -> String
showsPrec :: Int -> PostProductsIdRequestBody -> String -> String
$cshowsPrec :: Int -> PostProductsIdRequestBody -> String -> String
GHC.Show.Show,
      PostProductsIdRequestBody -> PostProductsIdRequestBody -> Bool
(PostProductsIdRequestBody -> PostProductsIdRequestBody -> Bool)
-> (PostProductsIdRequestBody -> PostProductsIdRequestBody -> Bool)
-> Eq PostProductsIdRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostProductsIdRequestBody -> PostProductsIdRequestBody -> Bool
$c/= :: PostProductsIdRequestBody -> PostProductsIdRequestBody -> Bool
== :: PostProductsIdRequestBody -> PostProductsIdRequestBody -> Bool
$c== :: PostProductsIdRequestBody -> PostProductsIdRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostProductsIdRequestBody where
  toJSON :: PostProductsIdRequestBody -> Value
toJSON PostProductsIdRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"active" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Bool
postProductsIdRequestBodyActive PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"description" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyDescription PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"expand" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe [Text]
postProductsIdRequestBodyExpand PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"images" Text -> Maybe PostProductsIdRequestBodyImages'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyImages'Variants
postProductsIdRequestBodyImages PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text -> Maybe PostProductsIdRequestBodyMetadata'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyMetadata'Variants
postProductsIdRequestBodyMetadata PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyName PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"package_dimensions" Text
-> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
postProductsIdRequestBodyPackageDimensions PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"shippable" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Bool
postProductsIdRequestBodyShippable PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"statement_descriptor" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyStatementDescriptor PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tax_code" Text -> Maybe PostProductsIdRequestBodyTaxCode'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyTaxCode'Variants
postProductsIdRequestBodyTaxCode PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"unit_label" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyUnitLabel PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"url" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyUrl PostProductsIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostProductsIdRequestBody -> Encoding
toEncoding PostProductsIdRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"active" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Bool
postProductsIdRequestBodyActive PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"description" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyDescription PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"expand" Text -> Maybe [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe [Text]
postProductsIdRequestBodyExpand PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"images" Text -> Maybe PostProductsIdRequestBodyImages'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyImages'Variants
postProductsIdRequestBodyImages PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text -> Maybe PostProductsIdRequestBodyMetadata'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyMetadata'Variants
postProductsIdRequestBodyMetadata PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyName PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"package_dimensions" Text
-> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
postProductsIdRequestBodyPackageDimensions PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"shippable" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Bool
postProductsIdRequestBodyShippable PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"statement_descriptor" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyStatementDescriptor PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tax_code" Text -> Maybe PostProductsIdRequestBodyTaxCode'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody
-> Maybe PostProductsIdRequestBodyTaxCode'Variants
postProductsIdRequestBodyTaxCode PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"unit_label" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyUnitLabel PostProductsIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"url" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBody -> Maybe Text
postProductsIdRequestBodyUrl PostProductsIdRequestBody
obj))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostProductsIdRequestBody where
  parseJSON :: Value -> Parser PostProductsIdRequestBody
parseJSON = String
-> (Object -> Parser PostProductsIdRequestBody)
-> Value
-> Parser PostProductsIdRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostProductsIdRequestBody" (\Object
obj -> ((((((((((((Maybe Bool
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe PostProductsIdRequestBodyImages'Variants
 -> Maybe PostProductsIdRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
 -> Maybe Bool
 -> Maybe Text
 -> Maybe PostProductsIdRequestBodyTaxCode'Variants
 -> Maybe Text
 -> Maybe Text
 -> PostProductsIdRequestBody)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostProductsIdRequestBodyImages'Variants
      -> Maybe PostProductsIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
      -> Maybe Bool
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyTaxCode'Variants
      -> Maybe Text
      -> Maybe Text
      -> PostProductsIdRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Bool
-> Maybe Text
-> Maybe [Text]
-> Maybe PostProductsIdRequestBodyImages'Variants
-> Maybe PostProductsIdRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
-> Maybe Bool
-> Maybe Text
-> Maybe PostProductsIdRequestBodyTaxCode'Variants
-> Maybe Text
-> Maybe Text
-> PostProductsIdRequestBody
PostProductsIdRequestBody Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostProductsIdRequestBodyImages'Variants
   -> Maybe PostProductsIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
   -> Maybe Bool
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyTaxCode'Variants
   -> Maybe Text
   -> Maybe Text
   -> PostProductsIdRequestBody)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe PostProductsIdRequestBodyImages'Variants
      -> Maybe PostProductsIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
      -> Maybe Bool
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyTaxCode'Variants
      -> Maybe Text
      -> Maybe Text
      -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"active")) Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe PostProductsIdRequestBodyImages'Variants
   -> Maybe PostProductsIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
   -> Maybe Bool
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyTaxCode'Variants
   -> Maybe Text
   -> Maybe Text
   -> PostProductsIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe PostProductsIdRequestBodyImages'Variants
      -> Maybe PostProductsIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
      -> Maybe Bool
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyTaxCode'Variants
      -> Maybe Text
      -> Maybe Text
      -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"description")) Parser
  (Maybe [Text]
   -> Maybe PostProductsIdRequestBodyImages'Variants
   -> Maybe PostProductsIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
   -> Maybe Bool
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyTaxCode'Variants
   -> Maybe Text
   -> Maybe Text
   -> PostProductsIdRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe PostProductsIdRequestBodyImages'Variants
      -> Maybe PostProductsIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
      -> Maybe Bool
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyTaxCode'Variants
      -> Maybe Text
      -> Maybe Text
      -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"expand")) Parser
  (Maybe PostProductsIdRequestBodyImages'Variants
   -> Maybe PostProductsIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
   -> Maybe Bool
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyTaxCode'Variants
   -> Maybe Text
   -> Maybe Text
   -> PostProductsIdRequestBody)
-> Parser (Maybe PostProductsIdRequestBodyImages'Variants)
-> Parser
     (Maybe PostProductsIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
      -> Maybe Bool
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyTaxCode'Variants
      -> Maybe Text
      -> Maybe Text
      -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostProductsIdRequestBodyImages'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"images")) Parser
  (Maybe PostProductsIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
   -> Maybe Bool
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyTaxCode'Variants
   -> Maybe Text
   -> Maybe Text
   -> PostProductsIdRequestBody)
-> Parser (Maybe PostProductsIdRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
      -> Maybe Bool
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyTaxCode'Variants
      -> Maybe Text
      -> Maybe Text
      -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostProductsIdRequestBodyMetadata'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"metadata")) Parser
  (Maybe Text
   -> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
   -> Maybe Bool
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyTaxCode'Variants
   -> Maybe Text
   -> Maybe Text
   -> PostProductsIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostProductsIdRequestBodyPackageDimensions'Variants
      -> Maybe Bool
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyTaxCode'Variants
      -> Maybe Text
      -> Maybe Text
      -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"name")) Parser
  (Maybe PostProductsIdRequestBodyPackageDimensions'Variants
   -> Maybe Bool
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyTaxCode'Variants
   -> Maybe Text
   -> Maybe Text
   -> PostProductsIdRequestBody)
-> Parser
     (Maybe PostProductsIdRequestBodyPackageDimensions'Variants)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe PostProductsIdRequestBodyTaxCode'Variants
      -> Maybe Text
      -> Maybe Text
      -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostProductsIdRequestBodyPackageDimensions'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"package_dimensions")) Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe PostProductsIdRequestBodyTaxCode'Variants
   -> Maybe Text
   -> Maybe Text
   -> PostProductsIdRequestBody)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe PostProductsIdRequestBodyTaxCode'Variants
      -> Maybe Text
      -> Maybe Text
      -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"shippable")) Parser
  (Maybe Text
   -> Maybe PostProductsIdRequestBodyTaxCode'Variants
   -> Maybe Text
   -> Maybe Text
   -> PostProductsIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostProductsIdRequestBodyTaxCode'Variants
      -> Maybe Text -> Maybe Text -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"statement_descriptor")) Parser
  (Maybe PostProductsIdRequestBodyTaxCode'Variants
   -> Maybe Text -> Maybe Text -> PostProductsIdRequestBody)
-> Parser (Maybe PostProductsIdRequestBodyTaxCode'Variants)
-> Parser (Maybe Text -> Maybe Text -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostProductsIdRequestBodyTaxCode'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tax_code")) Parser (Maybe Text -> Maybe Text -> PostProductsIdRequestBody)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> PostProductsIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"unit_label")) Parser (Maybe Text -> PostProductsIdRequestBody)
-> Parser (Maybe Text) -> Parser PostProductsIdRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"url"))

-- | Create a new 'PostProductsIdRequestBody' with all required fields.
mkPostProductsIdRequestBody :: PostProductsIdRequestBody
mkPostProductsIdRequestBody :: PostProductsIdRequestBody
mkPostProductsIdRequestBody =
  PostProductsIdRequestBody :: Maybe Bool
-> Maybe Text
-> Maybe [Text]
-> Maybe PostProductsIdRequestBodyImages'Variants
-> Maybe PostProductsIdRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe PostProductsIdRequestBodyPackageDimensions'Variants
-> Maybe Bool
-> Maybe Text
-> Maybe PostProductsIdRequestBodyTaxCode'Variants
-> Maybe Text
-> Maybe Text
-> PostProductsIdRequestBody
PostProductsIdRequestBody
    { postProductsIdRequestBodyActive :: Maybe Bool
postProductsIdRequestBodyActive = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyDescription :: Maybe Text
postProductsIdRequestBodyDescription = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyExpand :: Maybe [Text]
postProductsIdRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyImages :: Maybe PostProductsIdRequestBodyImages'Variants
postProductsIdRequestBodyImages = Maybe PostProductsIdRequestBodyImages'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyMetadata :: Maybe PostProductsIdRequestBodyMetadata'Variants
postProductsIdRequestBodyMetadata = Maybe PostProductsIdRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyName :: Maybe Text
postProductsIdRequestBodyName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyPackageDimensions :: Maybe PostProductsIdRequestBodyPackageDimensions'Variants
postProductsIdRequestBodyPackageDimensions = Maybe PostProductsIdRequestBodyPackageDimensions'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyShippable :: Maybe Bool
postProductsIdRequestBodyShippable = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyStatementDescriptor :: Maybe Text
postProductsIdRequestBodyStatementDescriptor = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyTaxCode :: Maybe PostProductsIdRequestBodyTaxCode'Variants
postProductsIdRequestBodyTaxCode = Maybe PostProductsIdRequestBodyTaxCode'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyUnitLabel :: Maybe Text
postProductsIdRequestBodyUnitLabel = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postProductsIdRequestBodyUrl :: Maybe Text
postProductsIdRequestBodyUrl = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/products\/{id}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.images.anyOf@ in the specification.
--
-- A list of up to 8 URLs of images for this product, meant to be displayable to the customer.
data PostProductsIdRequestBodyImages'Variants
  = -- | Represents the JSON value @""@
    PostProductsIdRequestBodyImages'EmptyString
  | PostProductsIdRequestBodyImages'ListTText ([Data.Text.Internal.Text])
  deriving (Int -> PostProductsIdRequestBodyImages'Variants -> String -> String
[PostProductsIdRequestBodyImages'Variants] -> String -> String
PostProductsIdRequestBodyImages'Variants -> String
(Int
 -> PostProductsIdRequestBodyImages'Variants -> String -> String)
-> (PostProductsIdRequestBodyImages'Variants -> String)
-> ([PostProductsIdRequestBodyImages'Variants] -> String -> String)
-> Show PostProductsIdRequestBodyImages'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostProductsIdRequestBodyImages'Variants] -> String -> String
$cshowList :: [PostProductsIdRequestBodyImages'Variants] -> String -> String
show :: PostProductsIdRequestBodyImages'Variants -> String
$cshow :: PostProductsIdRequestBodyImages'Variants -> String
showsPrec :: Int -> PostProductsIdRequestBodyImages'Variants -> String -> String
$cshowsPrec :: Int -> PostProductsIdRequestBodyImages'Variants -> String -> String
GHC.Show.Show, PostProductsIdRequestBodyImages'Variants
-> PostProductsIdRequestBodyImages'Variants -> Bool
(PostProductsIdRequestBodyImages'Variants
 -> PostProductsIdRequestBodyImages'Variants -> Bool)
-> (PostProductsIdRequestBodyImages'Variants
    -> PostProductsIdRequestBodyImages'Variants -> Bool)
-> Eq PostProductsIdRequestBodyImages'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostProductsIdRequestBodyImages'Variants
-> PostProductsIdRequestBodyImages'Variants -> Bool
$c/= :: PostProductsIdRequestBodyImages'Variants
-> PostProductsIdRequestBodyImages'Variants -> Bool
== :: PostProductsIdRequestBodyImages'Variants
-> PostProductsIdRequestBodyImages'Variants -> Bool
$c== :: PostProductsIdRequestBodyImages'Variants
-> PostProductsIdRequestBodyImages'Variants -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostProductsIdRequestBodyImages'Variants where
  toJSON :: PostProductsIdRequestBodyImages'Variants -> Value
toJSON (PostProductsIdRequestBodyImages'ListTText [Text]
a) = [Text] -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON [Text]
a
  toJSON (PostProductsIdRequestBodyImages'Variants
PostProductsIdRequestBodyImages'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostProductsIdRequestBodyImages'Variants where
  parseJSON :: Value -> Parser PostProductsIdRequestBodyImages'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostProductsIdRequestBodyImages'Variants
-> Parser PostProductsIdRequestBodyImages'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostProductsIdRequestBodyImages'Variants
PostProductsIdRequestBodyImages'EmptyString
        | Bool
GHC.Base.otherwise -> case ([Text] -> PostProductsIdRequestBodyImages'Variants
PostProductsIdRequestBodyImages'ListTText ([Text] -> PostProductsIdRequestBodyImages'Variants)
-> Result [Text] -> Result PostProductsIdRequestBodyImages'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result [Text]
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostProductsIdRequestBodyImages'Variants
-> Result PostProductsIdRequestBodyImages'Variants
-> Result PostProductsIdRequestBodyImages'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostProductsIdRequestBodyImages'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostProductsIdRequestBodyImages'Variants
a -> PostProductsIdRequestBodyImages'Variants
-> Parser PostProductsIdRequestBodyImages'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostProductsIdRequestBodyImages'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostProductsIdRequestBodyImages'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the oneOf schema located at @paths.\/v1\/products\/{id}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.metadata.anyOf@ in the specification.
--
-- Set of [key-value pairs](https:\/\/stripe.com\/docs\/api\/metadata) that you can attach to an object. This can be useful for storing additional information about the object in a structured format. Individual keys can be unset by posting an empty value to them. All keys can be unset by posting an empty value to \`metadata\`.
data PostProductsIdRequestBodyMetadata'Variants
  = -- | Represents the JSON value @""@
    PostProductsIdRequestBodyMetadata'EmptyString
  | PostProductsIdRequestBodyMetadata'Object Data.Aeson.Types.Internal.Object
  deriving (Int
-> PostProductsIdRequestBodyMetadata'Variants -> String -> String
[PostProductsIdRequestBodyMetadata'Variants] -> String -> String
PostProductsIdRequestBodyMetadata'Variants -> String
(Int
 -> PostProductsIdRequestBodyMetadata'Variants -> String -> String)
-> (PostProductsIdRequestBodyMetadata'Variants -> String)
-> ([PostProductsIdRequestBodyMetadata'Variants]
    -> String -> String)
-> Show PostProductsIdRequestBodyMetadata'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostProductsIdRequestBodyMetadata'Variants] -> String -> String
$cshowList :: [PostProductsIdRequestBodyMetadata'Variants] -> String -> String
show :: PostProductsIdRequestBodyMetadata'Variants -> String
$cshow :: PostProductsIdRequestBodyMetadata'Variants -> String
showsPrec :: Int
-> PostProductsIdRequestBodyMetadata'Variants -> String -> String
$cshowsPrec :: Int
-> PostProductsIdRequestBodyMetadata'Variants -> String -> String
GHC.Show.Show, PostProductsIdRequestBodyMetadata'Variants
-> PostProductsIdRequestBodyMetadata'Variants -> Bool
(PostProductsIdRequestBodyMetadata'Variants
 -> PostProductsIdRequestBodyMetadata'Variants -> Bool)
-> (PostProductsIdRequestBodyMetadata'Variants
    -> PostProductsIdRequestBodyMetadata'Variants -> Bool)
-> Eq PostProductsIdRequestBodyMetadata'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostProductsIdRequestBodyMetadata'Variants
-> PostProductsIdRequestBodyMetadata'Variants -> Bool
$c/= :: PostProductsIdRequestBodyMetadata'Variants
-> PostProductsIdRequestBodyMetadata'Variants -> Bool
== :: PostProductsIdRequestBodyMetadata'Variants
-> PostProductsIdRequestBodyMetadata'Variants -> Bool
$c== :: PostProductsIdRequestBodyMetadata'Variants
-> PostProductsIdRequestBodyMetadata'Variants -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostProductsIdRequestBodyMetadata'Variants where
  toJSON :: PostProductsIdRequestBodyMetadata'Variants -> Value
toJSON (PostProductsIdRequestBodyMetadata'Object Object
a) = Object -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Object
a
  toJSON (PostProductsIdRequestBodyMetadata'Variants
PostProductsIdRequestBodyMetadata'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostProductsIdRequestBodyMetadata'Variants where
  parseJSON :: Value -> Parser PostProductsIdRequestBodyMetadata'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostProductsIdRequestBodyMetadata'Variants
-> Parser PostProductsIdRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostProductsIdRequestBodyMetadata'Variants
PostProductsIdRequestBodyMetadata'EmptyString
        | Bool
GHC.Base.otherwise -> case (Object -> PostProductsIdRequestBodyMetadata'Variants
PostProductsIdRequestBodyMetadata'Object (Object -> PostProductsIdRequestBodyMetadata'Variants)
-> Result Object
-> Result PostProductsIdRequestBodyMetadata'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result Object
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostProductsIdRequestBodyMetadata'Variants
-> Result PostProductsIdRequestBodyMetadata'Variants
-> Result PostProductsIdRequestBodyMetadata'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostProductsIdRequestBodyMetadata'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostProductsIdRequestBodyMetadata'Variants
a -> PostProductsIdRequestBodyMetadata'Variants
-> Parser PostProductsIdRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostProductsIdRequestBodyMetadata'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostProductsIdRequestBodyMetadata'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/products\/{id}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.package_dimensions.anyOf@ in the specification.
data PostProductsIdRequestBodyPackageDimensions'OneOf1 = PostProductsIdRequestBodyPackageDimensions'OneOf1
  { -- | height
    PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Height :: GHC.Types.Double,
    -- | length
    PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Length :: GHC.Types.Double,
    -- | weight
    PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Weight :: GHC.Types.Double,
    -- | width
    PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Width :: GHC.Types.Double
  }
  deriving
    ( Int
-> PostProductsIdRequestBodyPackageDimensions'OneOf1
-> String
-> String
[PostProductsIdRequestBodyPackageDimensions'OneOf1]
-> String -> String
PostProductsIdRequestBodyPackageDimensions'OneOf1 -> String
(Int
 -> PostProductsIdRequestBodyPackageDimensions'OneOf1
 -> String
 -> String)
-> (PostProductsIdRequestBodyPackageDimensions'OneOf1 -> String)
-> ([PostProductsIdRequestBodyPackageDimensions'OneOf1]
    -> String -> String)
-> Show PostProductsIdRequestBodyPackageDimensions'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostProductsIdRequestBodyPackageDimensions'OneOf1]
-> String -> String
$cshowList :: [PostProductsIdRequestBodyPackageDimensions'OneOf1]
-> String -> String
show :: PostProductsIdRequestBodyPackageDimensions'OneOf1 -> String
$cshow :: PostProductsIdRequestBodyPackageDimensions'OneOf1 -> String
showsPrec :: Int
-> PostProductsIdRequestBodyPackageDimensions'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostProductsIdRequestBodyPackageDimensions'OneOf1
-> String
-> String
GHC.Show.Show,
      PostProductsIdRequestBodyPackageDimensions'OneOf1
-> PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Bool
(PostProductsIdRequestBodyPackageDimensions'OneOf1
 -> PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Bool)
-> (PostProductsIdRequestBodyPackageDimensions'OneOf1
    -> PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Bool)
-> Eq PostProductsIdRequestBodyPackageDimensions'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostProductsIdRequestBodyPackageDimensions'OneOf1
-> PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Bool
$c/= :: PostProductsIdRequestBodyPackageDimensions'OneOf1
-> PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Bool
== :: PostProductsIdRequestBodyPackageDimensions'OneOf1
-> PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Bool
$c== :: PostProductsIdRequestBodyPackageDimensions'OneOf1
-> PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostProductsIdRequestBodyPackageDimensions'OneOf1 where
  toJSON :: PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Value
toJSON PostProductsIdRequestBodyPackageDimensions'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"height" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Height PostProductsIdRequestBodyPackageDimensions'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"length" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Length PostProductsIdRequestBodyPackageDimensions'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"weight" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Weight PostProductsIdRequestBodyPackageDimensions'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"width" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Width PostProductsIdRequestBodyPackageDimensions'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Encoding
toEncoding PostProductsIdRequestBodyPackageDimensions'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"height" Text -> Double -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Height PostProductsIdRequestBodyPackageDimensions'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"length" Text -> Double -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Length PostProductsIdRequestBodyPackageDimensions'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"weight" Text -> Double -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Weight PostProductsIdRequestBodyPackageDimensions'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"width" Text -> Double -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Double
postProductsIdRequestBodyPackageDimensions'OneOf1Width PostProductsIdRequestBodyPackageDimensions'OneOf1
obj))))

instance Data.Aeson.Types.FromJSON.FromJSON PostProductsIdRequestBodyPackageDimensions'OneOf1 where
  parseJSON :: Value -> Parser PostProductsIdRequestBodyPackageDimensions'OneOf1
parseJSON = String
-> (Object
    -> Parser PostProductsIdRequestBodyPackageDimensions'OneOf1)
-> Value
-> Parser PostProductsIdRequestBodyPackageDimensions'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostProductsIdRequestBodyPackageDimensions'OneOf1" (\Object
obj -> ((((Double
 -> Double
 -> Double
 -> Double
 -> PostProductsIdRequestBodyPackageDimensions'OneOf1)
-> Parser
     (Double
      -> Double
      -> Double
      -> Double
      -> PostProductsIdRequestBodyPackageDimensions'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Double
-> Double
-> Double
-> Double
-> PostProductsIdRequestBodyPackageDimensions'OneOf1
PostProductsIdRequestBodyPackageDimensions'OneOf1 Parser
  (Double
   -> Double
   -> Double
   -> Double
   -> PostProductsIdRequestBodyPackageDimensions'OneOf1)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Double
      -> PostProductsIdRequestBodyPackageDimensions'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"height")) Parser
  (Double
   -> Double
   -> Double
   -> PostProductsIdRequestBodyPackageDimensions'OneOf1)
-> Parser Double
-> Parser
     (Double
      -> Double -> PostProductsIdRequestBodyPackageDimensions'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"length")) Parser
  (Double
   -> Double -> PostProductsIdRequestBodyPackageDimensions'OneOf1)
-> Parser Double
-> Parser
     (Double -> PostProductsIdRequestBodyPackageDimensions'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"weight")) Parser
  (Double -> PostProductsIdRequestBodyPackageDimensions'OneOf1)
-> Parser Double
-> Parser PostProductsIdRequestBodyPackageDimensions'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"width"))

-- | Create a new 'PostProductsIdRequestBodyPackageDimensions'OneOf1' with all required fields.
mkPostProductsIdRequestBodyPackageDimensions'OneOf1 ::
  -- | 'postProductsIdRequestBodyPackageDimensions'OneOf1Height'
  GHC.Types.Double ->
  -- | 'postProductsIdRequestBodyPackageDimensions'OneOf1Length'
  GHC.Types.Double ->
  -- | 'postProductsIdRequestBodyPackageDimensions'OneOf1Weight'
  GHC.Types.Double ->
  -- | 'postProductsIdRequestBodyPackageDimensions'OneOf1Width'
  GHC.Types.Double ->
  PostProductsIdRequestBodyPackageDimensions'OneOf1
mkPostProductsIdRequestBodyPackageDimensions'OneOf1 :: Double
-> Double
-> Double
-> Double
-> PostProductsIdRequestBodyPackageDimensions'OneOf1
mkPostProductsIdRequestBodyPackageDimensions'OneOf1 Double
postProductsIdRequestBodyPackageDimensions'OneOf1Height Double
postProductsIdRequestBodyPackageDimensions'OneOf1Length Double
postProductsIdRequestBodyPackageDimensions'OneOf1Weight Double
postProductsIdRequestBodyPackageDimensions'OneOf1Width =
  PostProductsIdRequestBodyPackageDimensions'OneOf1 :: Double
-> Double
-> Double
-> Double
-> PostProductsIdRequestBodyPackageDimensions'OneOf1
PostProductsIdRequestBodyPackageDimensions'OneOf1
    { postProductsIdRequestBodyPackageDimensions'OneOf1Height :: Double
postProductsIdRequestBodyPackageDimensions'OneOf1Height = Double
postProductsIdRequestBodyPackageDimensions'OneOf1Height,
      postProductsIdRequestBodyPackageDimensions'OneOf1Length :: Double
postProductsIdRequestBodyPackageDimensions'OneOf1Length = Double
postProductsIdRequestBodyPackageDimensions'OneOf1Length,
      postProductsIdRequestBodyPackageDimensions'OneOf1Weight :: Double
postProductsIdRequestBodyPackageDimensions'OneOf1Weight = Double
postProductsIdRequestBodyPackageDimensions'OneOf1Weight,
      postProductsIdRequestBodyPackageDimensions'OneOf1Width :: Double
postProductsIdRequestBodyPackageDimensions'OneOf1Width = Double
postProductsIdRequestBodyPackageDimensions'OneOf1Width
    }

-- | Defines the oneOf schema located at @paths.\/v1\/products\/{id}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.package_dimensions.anyOf@ in the specification.
--
-- The dimensions of this product for shipping purposes.
data PostProductsIdRequestBodyPackageDimensions'Variants
  = -- | Represents the JSON value @""@
    PostProductsIdRequestBodyPackageDimensions'EmptyString
  | PostProductsIdRequestBodyPackageDimensions'PostProductsIdRequestBodyPackageDimensions'OneOf1 PostProductsIdRequestBodyPackageDimensions'OneOf1
  deriving (Int
-> PostProductsIdRequestBodyPackageDimensions'Variants
-> String
-> String
[PostProductsIdRequestBodyPackageDimensions'Variants]
-> String -> String
PostProductsIdRequestBodyPackageDimensions'Variants -> String
(Int
 -> PostProductsIdRequestBodyPackageDimensions'Variants
 -> String
 -> String)
-> (PostProductsIdRequestBodyPackageDimensions'Variants -> String)
-> ([PostProductsIdRequestBodyPackageDimensions'Variants]
    -> String -> String)
-> Show PostProductsIdRequestBodyPackageDimensions'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostProductsIdRequestBodyPackageDimensions'Variants]
-> String -> String
$cshowList :: [PostProductsIdRequestBodyPackageDimensions'Variants]
-> String -> String
show :: PostProductsIdRequestBodyPackageDimensions'Variants -> String
$cshow :: PostProductsIdRequestBodyPackageDimensions'Variants -> String
showsPrec :: Int
-> PostProductsIdRequestBodyPackageDimensions'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostProductsIdRequestBodyPackageDimensions'Variants
-> String
-> String
GHC.Show.Show, PostProductsIdRequestBodyPackageDimensions'Variants
-> PostProductsIdRequestBodyPackageDimensions'Variants -> Bool
(PostProductsIdRequestBodyPackageDimensions'Variants
 -> PostProductsIdRequestBodyPackageDimensions'Variants -> Bool)
-> (PostProductsIdRequestBodyPackageDimensions'Variants
    -> PostProductsIdRequestBodyPackageDimensions'Variants -> Bool)
-> Eq PostProductsIdRequestBodyPackageDimensions'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostProductsIdRequestBodyPackageDimensions'Variants
-> PostProductsIdRequestBodyPackageDimensions'Variants -> Bool
$c/= :: PostProductsIdRequestBodyPackageDimensions'Variants
-> PostProductsIdRequestBodyPackageDimensions'Variants -> Bool
== :: PostProductsIdRequestBodyPackageDimensions'Variants
-> PostProductsIdRequestBodyPackageDimensions'Variants -> Bool
$c== :: PostProductsIdRequestBodyPackageDimensions'Variants
-> PostProductsIdRequestBodyPackageDimensions'Variants -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostProductsIdRequestBodyPackageDimensions'Variants where
  toJSON :: PostProductsIdRequestBodyPackageDimensions'Variants -> Value
toJSON (PostProductsIdRequestBodyPackageDimensions'PostProductsIdRequestBodyPackageDimensions'OneOf1 PostProductsIdRequestBodyPackageDimensions'OneOf1
a) = PostProductsIdRequestBodyPackageDimensions'OneOf1 -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostProductsIdRequestBodyPackageDimensions'OneOf1
a
  toJSON (PostProductsIdRequestBodyPackageDimensions'Variants
PostProductsIdRequestBodyPackageDimensions'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostProductsIdRequestBodyPackageDimensions'Variants where
  parseJSON :: Value -> Parser PostProductsIdRequestBodyPackageDimensions'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostProductsIdRequestBodyPackageDimensions'Variants
-> Parser PostProductsIdRequestBodyPackageDimensions'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostProductsIdRequestBodyPackageDimensions'Variants
PostProductsIdRequestBodyPackageDimensions'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostProductsIdRequestBodyPackageDimensions'OneOf1
-> PostProductsIdRequestBodyPackageDimensions'Variants
PostProductsIdRequestBodyPackageDimensions'PostProductsIdRequestBodyPackageDimensions'OneOf1 (PostProductsIdRequestBodyPackageDimensions'OneOf1
 -> PostProductsIdRequestBodyPackageDimensions'Variants)
-> Result PostProductsIdRequestBodyPackageDimensions'OneOf1
-> Result PostProductsIdRequestBodyPackageDimensions'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result PostProductsIdRequestBodyPackageDimensions'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostProductsIdRequestBodyPackageDimensions'Variants
-> Result PostProductsIdRequestBodyPackageDimensions'Variants
-> Result PostProductsIdRequestBodyPackageDimensions'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result PostProductsIdRequestBodyPackageDimensions'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostProductsIdRequestBodyPackageDimensions'Variants
a -> PostProductsIdRequestBodyPackageDimensions'Variants
-> Parser PostProductsIdRequestBodyPackageDimensions'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostProductsIdRequestBodyPackageDimensions'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser PostProductsIdRequestBodyPackageDimensions'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the oneOf schema located at @paths.\/v1\/products\/{id}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.tax_code.anyOf@ in the specification.
--
-- A [tax code](https:\/\/stripe.com\/docs\/tax\/tax-codes) ID.
data PostProductsIdRequestBodyTaxCode'Variants
  = -- | Represents the JSON value @""@
    PostProductsIdRequestBodyTaxCode'EmptyString
  | PostProductsIdRequestBodyTaxCode'Text Data.Text.Internal.Text
  deriving (Int
-> PostProductsIdRequestBodyTaxCode'Variants -> String -> String
[PostProductsIdRequestBodyTaxCode'Variants] -> String -> String
PostProductsIdRequestBodyTaxCode'Variants -> String
(Int
 -> PostProductsIdRequestBodyTaxCode'Variants -> String -> String)
-> (PostProductsIdRequestBodyTaxCode'Variants -> String)
-> ([PostProductsIdRequestBodyTaxCode'Variants]
    -> String -> String)
-> Show PostProductsIdRequestBodyTaxCode'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostProductsIdRequestBodyTaxCode'Variants] -> String -> String
$cshowList :: [PostProductsIdRequestBodyTaxCode'Variants] -> String -> String
show :: PostProductsIdRequestBodyTaxCode'Variants -> String
$cshow :: PostProductsIdRequestBodyTaxCode'Variants -> String
showsPrec :: Int
-> PostProductsIdRequestBodyTaxCode'Variants -> String -> String
$cshowsPrec :: Int
-> PostProductsIdRequestBodyTaxCode'Variants -> String -> String
GHC.Show.Show, PostProductsIdRequestBodyTaxCode'Variants
-> PostProductsIdRequestBodyTaxCode'Variants -> Bool
(PostProductsIdRequestBodyTaxCode'Variants
 -> PostProductsIdRequestBodyTaxCode'Variants -> Bool)
-> (PostProductsIdRequestBodyTaxCode'Variants
    -> PostProductsIdRequestBodyTaxCode'Variants -> Bool)
-> Eq PostProductsIdRequestBodyTaxCode'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostProductsIdRequestBodyTaxCode'Variants
-> PostProductsIdRequestBodyTaxCode'Variants -> Bool
$c/= :: PostProductsIdRequestBodyTaxCode'Variants
-> PostProductsIdRequestBodyTaxCode'Variants -> Bool
== :: PostProductsIdRequestBodyTaxCode'Variants
-> PostProductsIdRequestBodyTaxCode'Variants -> Bool
$c== :: PostProductsIdRequestBodyTaxCode'Variants
-> PostProductsIdRequestBodyTaxCode'Variants -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostProductsIdRequestBodyTaxCode'Variants where
  toJSON :: PostProductsIdRequestBodyTaxCode'Variants -> Value
toJSON (PostProductsIdRequestBodyTaxCode'Text Text
a) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
a
  toJSON (PostProductsIdRequestBodyTaxCode'Variants
PostProductsIdRequestBodyTaxCode'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostProductsIdRequestBodyTaxCode'Variants where
  parseJSON :: Value -> Parser PostProductsIdRequestBodyTaxCode'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostProductsIdRequestBodyTaxCode'Variants
-> Parser PostProductsIdRequestBodyTaxCode'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostProductsIdRequestBodyTaxCode'Variants
PostProductsIdRequestBodyTaxCode'EmptyString
        | Bool
GHC.Base.otherwise -> case (Text -> PostProductsIdRequestBodyTaxCode'Variants
PostProductsIdRequestBodyTaxCode'Text (Text -> PostProductsIdRequestBodyTaxCode'Variants)
-> Result Text -> Result PostProductsIdRequestBodyTaxCode'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result Text
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostProductsIdRequestBodyTaxCode'Variants
-> Result PostProductsIdRequestBodyTaxCode'Variants
-> Result PostProductsIdRequestBodyTaxCode'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostProductsIdRequestBodyTaxCode'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostProductsIdRequestBodyTaxCode'Variants
a -> PostProductsIdRequestBodyTaxCode'Variants
-> Parser PostProductsIdRequestBodyTaxCode'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostProductsIdRequestBodyTaxCode'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostProductsIdRequestBodyTaxCode'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Represents a response of the operation 'postProductsId'.
--
-- The response constructor is chosen by the status code of the response. If no case matches (no specific case for the response code, no range case, no default case), 'PostProductsIdResponseError' is used.
data PostProductsIdResponse
  = -- | Means either no matching case available or a parse error
    PostProductsIdResponseError GHC.Base.String
  | -- | Successful response.
    PostProductsIdResponse200 Product
  | -- | Error response.
    PostProductsIdResponseDefault Error
  deriving (Int -> PostProductsIdResponse -> String -> String
[PostProductsIdResponse] -> String -> String
PostProductsIdResponse -> String
(Int -> PostProductsIdResponse -> String -> String)
-> (PostProductsIdResponse -> String)
-> ([PostProductsIdResponse] -> String -> String)
-> Show PostProductsIdResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostProductsIdResponse] -> String -> String
$cshowList :: [PostProductsIdResponse] -> String -> String
show :: PostProductsIdResponse -> String
$cshow :: PostProductsIdResponse -> String
showsPrec :: Int -> PostProductsIdResponse -> String -> String
$cshowsPrec :: Int -> PostProductsIdResponse -> String -> String
GHC.Show.Show, PostProductsIdResponse -> PostProductsIdResponse -> Bool
(PostProductsIdResponse -> PostProductsIdResponse -> Bool)
-> (PostProductsIdResponse -> PostProductsIdResponse -> Bool)
-> Eq PostProductsIdResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostProductsIdResponse -> PostProductsIdResponse -> Bool
$c/= :: PostProductsIdResponse -> PostProductsIdResponse -> Bool
== :: PostProductsIdResponse -> PostProductsIdResponse -> Bool
$c== :: PostProductsIdResponse -> PostProductsIdResponse -> Bool
GHC.Classes.Eq)