{-# 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 types generated from the schema CustomerTax
module StripeAPI.Types.CustomerTax where

import qualified Control.Monad.Fail
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.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 GHC.Base
import qualified GHC.Classes
import qualified GHC.Int
import qualified GHC.Show
import qualified GHC.Types
import qualified StripeAPI.Common
import StripeAPI.TypeAlias
import {-# SOURCE #-} StripeAPI.Types.CustomerTaxLocation
import qualified Prelude as GHC.Integer.Type
import qualified Prelude as GHC.Maybe

-- | Defines the object schema located at @components.schemas.customer_tax@ in the specification.
data CustomerTax = CustomerTax
  { -- | automatic_tax: Surfaces if automatic tax computation is possible given the current customer location information.
    CustomerTax -> CustomerTaxAutomaticTax'
customerTaxAutomaticTax :: CustomerTaxAutomaticTax',
    -- | ip_address: A recent IP address of the customer used for tax reporting and tax location inference.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    CustomerTax -> Maybe Text
customerTaxIpAddress :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | location: The customer\'s location as identified by Stripe Tax.
    CustomerTax -> Maybe CustomerTaxLocation'
customerTaxLocation :: (GHC.Maybe.Maybe CustomerTaxLocation')
  }
  deriving
    ( Int -> CustomerTax -> ShowS
[CustomerTax] -> ShowS
CustomerTax -> String
(Int -> CustomerTax -> ShowS)
-> (CustomerTax -> String)
-> ([CustomerTax] -> ShowS)
-> Show CustomerTax
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomerTax] -> ShowS
$cshowList :: [CustomerTax] -> ShowS
show :: CustomerTax -> String
$cshow :: CustomerTax -> String
showsPrec :: Int -> CustomerTax -> ShowS
$cshowsPrec :: Int -> CustomerTax -> ShowS
GHC.Show.Show,
      CustomerTax -> CustomerTax -> Bool
(CustomerTax -> CustomerTax -> Bool)
-> (CustomerTax -> CustomerTax -> Bool) -> Eq CustomerTax
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomerTax -> CustomerTax -> Bool
$c/= :: CustomerTax -> CustomerTax -> Bool
== :: CustomerTax -> CustomerTax -> Bool
$c== :: CustomerTax -> CustomerTax -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON CustomerTax where
  toJSON :: CustomerTax -> Value
toJSON CustomerTax
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"automatic_tax" Text -> CustomerTaxAutomaticTax' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTax -> CustomerTaxAutomaticTax'
customerTaxAutomaticTax CustomerTax
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"ip_address" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTax -> Maybe Text
customerTaxIpAddress CustomerTax
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"location" Text -> Maybe CustomerTaxLocation' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTax -> Maybe CustomerTaxLocation'
customerTaxLocation CustomerTax
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: CustomerTax -> Encoding
toEncoding CustomerTax
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"automatic_tax" Text -> CustomerTaxAutomaticTax' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTax -> CustomerTaxAutomaticTax'
customerTaxAutomaticTax CustomerTax
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"ip_address" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTax -> Maybe Text
customerTaxIpAddress CustomerTax
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"location" Text -> Maybe CustomerTaxLocation' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTax -> Maybe CustomerTaxLocation'
customerTaxLocation CustomerTax
obj)))

instance Data.Aeson.Types.FromJSON.FromJSON CustomerTax where
  parseJSON :: Value -> Parser CustomerTax
parseJSON = String
-> (Object -> Parser CustomerTax) -> Value -> Parser CustomerTax
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"CustomerTax" (\Object
obj -> (((CustomerTaxAutomaticTax'
 -> Maybe Text -> Maybe CustomerTaxLocation' -> CustomerTax)
-> Parser
     (CustomerTaxAutomaticTax'
      -> Maybe Text -> Maybe CustomerTaxLocation' -> CustomerTax)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure CustomerTaxAutomaticTax'
-> Maybe Text -> Maybe CustomerTaxLocation' -> CustomerTax
CustomerTax Parser
  (CustomerTaxAutomaticTax'
   -> Maybe Text -> Maybe CustomerTaxLocation' -> CustomerTax)
-> Parser CustomerTaxAutomaticTax'
-> Parser (Maybe Text -> Maybe CustomerTaxLocation' -> CustomerTax)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser CustomerTaxAutomaticTax'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"automatic_tax")) Parser (Maybe Text -> Maybe CustomerTaxLocation' -> CustomerTax)
-> Parser (Maybe Text)
-> Parser (Maybe CustomerTaxLocation' -> CustomerTax)
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
"ip_address")) Parser (Maybe CustomerTaxLocation' -> CustomerTax)
-> Parser (Maybe CustomerTaxLocation') -> Parser CustomerTax
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe CustomerTaxLocation')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"location"))

-- | Create a new 'CustomerTax' with all required fields.
mkCustomerTax ::
  -- | 'customerTaxAutomaticTax'
  CustomerTaxAutomaticTax' ->
  CustomerTax
mkCustomerTax :: CustomerTaxAutomaticTax' -> CustomerTax
mkCustomerTax CustomerTaxAutomaticTax'
customerTaxAutomaticTax =
  CustomerTax :: CustomerTaxAutomaticTax'
-> Maybe Text -> Maybe CustomerTaxLocation' -> CustomerTax
CustomerTax
    { customerTaxAutomaticTax :: CustomerTaxAutomaticTax'
customerTaxAutomaticTax = CustomerTaxAutomaticTax'
customerTaxAutomaticTax,
      customerTaxIpAddress :: Maybe Text
customerTaxIpAddress = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      customerTaxLocation :: Maybe CustomerTaxLocation'
customerTaxLocation = Maybe CustomerTaxLocation'
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the enum schema located at @components.schemas.customer_tax.properties.automatic_tax@ in the specification.
--
-- Surfaces if automatic tax computation is possible given the current customer location information.
data CustomerTaxAutomaticTax'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    CustomerTaxAutomaticTax'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    CustomerTaxAutomaticTax'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"failed"@
    CustomerTaxAutomaticTax'EnumFailed
  | -- | Represents the JSON value @"not_collecting"@
    CustomerTaxAutomaticTax'EnumNotCollecting
  | -- | Represents the JSON value @"supported"@
    CustomerTaxAutomaticTax'EnumSupported
  | -- | Represents the JSON value @"unrecognized_location"@
    CustomerTaxAutomaticTax'EnumUnrecognizedLocation
  deriving (Int -> CustomerTaxAutomaticTax' -> ShowS
[CustomerTaxAutomaticTax'] -> ShowS
CustomerTaxAutomaticTax' -> String
(Int -> CustomerTaxAutomaticTax' -> ShowS)
-> (CustomerTaxAutomaticTax' -> String)
-> ([CustomerTaxAutomaticTax'] -> ShowS)
-> Show CustomerTaxAutomaticTax'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomerTaxAutomaticTax'] -> ShowS
$cshowList :: [CustomerTaxAutomaticTax'] -> ShowS
show :: CustomerTaxAutomaticTax' -> String
$cshow :: CustomerTaxAutomaticTax' -> String
showsPrec :: Int -> CustomerTaxAutomaticTax' -> ShowS
$cshowsPrec :: Int -> CustomerTaxAutomaticTax' -> ShowS
GHC.Show.Show, CustomerTaxAutomaticTax' -> CustomerTaxAutomaticTax' -> Bool
(CustomerTaxAutomaticTax' -> CustomerTaxAutomaticTax' -> Bool)
-> (CustomerTaxAutomaticTax' -> CustomerTaxAutomaticTax' -> Bool)
-> Eq CustomerTaxAutomaticTax'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomerTaxAutomaticTax' -> CustomerTaxAutomaticTax' -> Bool
$c/= :: CustomerTaxAutomaticTax' -> CustomerTaxAutomaticTax' -> Bool
== :: CustomerTaxAutomaticTax' -> CustomerTaxAutomaticTax' -> Bool
$c== :: CustomerTaxAutomaticTax' -> CustomerTaxAutomaticTax' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON CustomerTaxAutomaticTax' where
  toJSON :: CustomerTaxAutomaticTax' -> Value
toJSON (CustomerTaxAutomaticTax'Other Value
val) = Value
val
  toJSON (CustomerTaxAutomaticTax'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (CustomerTaxAutomaticTax'
CustomerTaxAutomaticTax'EnumFailed) = Value
"failed"
  toJSON (CustomerTaxAutomaticTax'
CustomerTaxAutomaticTax'EnumNotCollecting) = Value
"not_collecting"
  toJSON (CustomerTaxAutomaticTax'
CustomerTaxAutomaticTax'EnumSupported) = Value
"supported"
  toJSON (CustomerTaxAutomaticTax'
CustomerTaxAutomaticTax'EnumUnrecognizedLocation) = Value
"unrecognized_location"

instance Data.Aeson.Types.FromJSON.FromJSON CustomerTaxAutomaticTax' where
  parseJSON :: Value -> Parser CustomerTaxAutomaticTax'
parseJSON Value
val =
    CustomerTaxAutomaticTax' -> Parser CustomerTaxAutomaticTax'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
      ( if
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"failed" -> CustomerTaxAutomaticTax'
CustomerTaxAutomaticTax'EnumFailed
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"not_collecting" -> CustomerTaxAutomaticTax'
CustomerTaxAutomaticTax'EnumNotCollecting
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"supported" -> CustomerTaxAutomaticTax'
CustomerTaxAutomaticTax'EnumSupported
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"unrecognized_location" -> CustomerTaxAutomaticTax'
CustomerTaxAutomaticTax'EnumUnrecognizedLocation
            | Bool
GHC.Base.otherwise -> Value -> CustomerTaxAutomaticTax'
CustomerTaxAutomaticTax'Other Value
val
      )

-- | Defines the object schema located at @components.schemas.customer_tax.properties.location.anyOf@ in the specification.
--
-- The customer\\\'s location as identified by Stripe Tax.
data CustomerTaxLocation' = CustomerTaxLocation'
  { -- | country: The customer\'s country as identified by Stripe Tax.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    CustomerTaxLocation' -> Maybe Text
customerTaxLocation'Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | source: The data source used to infer the customer\'s location.
    CustomerTaxLocation' -> Maybe CustomerTaxLocation'Source'
customerTaxLocation'Source :: (GHC.Maybe.Maybe CustomerTaxLocation'Source'),
    -- | state: The customer\'s state, county, province, or region as identified by Stripe Tax.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    CustomerTaxLocation' -> Maybe Text
customerTaxLocation'State :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> CustomerTaxLocation' -> ShowS
[CustomerTaxLocation'] -> ShowS
CustomerTaxLocation' -> String
(Int -> CustomerTaxLocation' -> ShowS)
-> (CustomerTaxLocation' -> String)
-> ([CustomerTaxLocation'] -> ShowS)
-> Show CustomerTaxLocation'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomerTaxLocation'] -> ShowS
$cshowList :: [CustomerTaxLocation'] -> ShowS
show :: CustomerTaxLocation' -> String
$cshow :: CustomerTaxLocation' -> String
showsPrec :: Int -> CustomerTaxLocation' -> ShowS
$cshowsPrec :: Int -> CustomerTaxLocation' -> ShowS
GHC.Show.Show,
      CustomerTaxLocation' -> CustomerTaxLocation' -> Bool
(CustomerTaxLocation' -> CustomerTaxLocation' -> Bool)
-> (CustomerTaxLocation' -> CustomerTaxLocation' -> Bool)
-> Eq CustomerTaxLocation'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomerTaxLocation' -> CustomerTaxLocation' -> Bool
$c/= :: CustomerTaxLocation' -> CustomerTaxLocation' -> Bool
== :: CustomerTaxLocation' -> CustomerTaxLocation' -> Bool
$c== :: CustomerTaxLocation' -> CustomerTaxLocation' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON CustomerTaxLocation' where
  toJSON :: CustomerTaxLocation' -> Value
toJSON CustomerTaxLocation'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTaxLocation' -> Maybe Text
customerTaxLocation'Country CustomerTaxLocation'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"source" Text -> Maybe CustomerTaxLocation'Source' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTaxLocation' -> Maybe CustomerTaxLocation'Source'
customerTaxLocation'Source CustomerTaxLocation'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTaxLocation' -> Maybe Text
customerTaxLocation'State CustomerTaxLocation'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: CustomerTaxLocation' -> Encoding
toEncoding CustomerTaxLocation'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTaxLocation' -> Maybe Text
customerTaxLocation'Country CustomerTaxLocation'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"source" Text -> Maybe CustomerTaxLocation'Source' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTaxLocation' -> Maybe CustomerTaxLocation'Source'
customerTaxLocation'Source CustomerTaxLocation'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= CustomerTaxLocation' -> Maybe Text
customerTaxLocation'State CustomerTaxLocation'
obj)))

instance Data.Aeson.Types.FromJSON.FromJSON CustomerTaxLocation' where
  parseJSON :: Value -> Parser CustomerTaxLocation'
parseJSON = String
-> (Object -> Parser CustomerTaxLocation')
-> Value
-> Parser CustomerTaxLocation'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"CustomerTaxLocation'" (\Object
obj -> (((Maybe Text
 -> Maybe CustomerTaxLocation'Source'
 -> Maybe Text
 -> CustomerTaxLocation')
-> Parser
     (Maybe Text
      -> Maybe CustomerTaxLocation'Source'
      -> Maybe Text
      -> CustomerTaxLocation')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe CustomerTaxLocation'Source'
-> Maybe Text
-> CustomerTaxLocation'
CustomerTaxLocation' Parser
  (Maybe Text
   -> Maybe CustomerTaxLocation'Source'
   -> Maybe Text
   -> CustomerTaxLocation')
-> Parser (Maybe Text)
-> Parser
     (Maybe CustomerTaxLocation'Source'
      -> Maybe Text -> CustomerTaxLocation')
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
"country")) Parser
  (Maybe CustomerTaxLocation'Source'
   -> Maybe Text -> CustomerTaxLocation')
-> Parser (Maybe CustomerTaxLocation'Source')
-> Parser (Maybe Text -> CustomerTaxLocation')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe CustomerTaxLocation'Source')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"source")) Parser (Maybe Text -> CustomerTaxLocation')
-> Parser (Maybe Text) -> Parser CustomerTaxLocation'
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
"state"))

-- | Create a new 'CustomerTaxLocation'' with all required fields.
mkCustomerTaxLocation' :: CustomerTaxLocation'
mkCustomerTaxLocation' :: CustomerTaxLocation'
mkCustomerTaxLocation' =
  CustomerTaxLocation' :: Maybe Text
-> Maybe CustomerTaxLocation'Source'
-> Maybe Text
-> CustomerTaxLocation'
CustomerTaxLocation'
    { customerTaxLocation'Country :: Maybe Text
customerTaxLocation'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      customerTaxLocation'Source :: Maybe CustomerTaxLocation'Source'
customerTaxLocation'Source = Maybe CustomerTaxLocation'Source'
forall a. Maybe a
GHC.Maybe.Nothing,
      customerTaxLocation'State :: Maybe Text
customerTaxLocation'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the enum schema located at @components.schemas.customer_tax.properties.location.anyOf.properties.source@ in the specification.
--
-- The data source used to infer the customer\'s location.
data CustomerTaxLocation'Source'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    CustomerTaxLocation'Source'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    CustomerTaxLocation'Source'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"billing_address"@
    CustomerTaxLocation'Source'EnumBillingAddress
  | -- | Represents the JSON value @"ip_address"@
    CustomerTaxLocation'Source'EnumIpAddress
  | -- | Represents the JSON value @"payment_method"@
    CustomerTaxLocation'Source'EnumPaymentMethod
  | -- | Represents the JSON value @"shipping_destination"@
    CustomerTaxLocation'Source'EnumShippingDestination
  deriving (Int -> CustomerTaxLocation'Source' -> ShowS
[CustomerTaxLocation'Source'] -> ShowS
CustomerTaxLocation'Source' -> String
(Int -> CustomerTaxLocation'Source' -> ShowS)
-> (CustomerTaxLocation'Source' -> String)
-> ([CustomerTaxLocation'Source'] -> ShowS)
-> Show CustomerTaxLocation'Source'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomerTaxLocation'Source'] -> ShowS
$cshowList :: [CustomerTaxLocation'Source'] -> ShowS
show :: CustomerTaxLocation'Source' -> String
$cshow :: CustomerTaxLocation'Source' -> String
showsPrec :: Int -> CustomerTaxLocation'Source' -> ShowS
$cshowsPrec :: Int -> CustomerTaxLocation'Source' -> ShowS
GHC.Show.Show, CustomerTaxLocation'Source' -> CustomerTaxLocation'Source' -> Bool
(CustomerTaxLocation'Source'
 -> CustomerTaxLocation'Source' -> Bool)
-> (CustomerTaxLocation'Source'
    -> CustomerTaxLocation'Source' -> Bool)
-> Eq CustomerTaxLocation'Source'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomerTaxLocation'Source' -> CustomerTaxLocation'Source' -> Bool
$c/= :: CustomerTaxLocation'Source' -> CustomerTaxLocation'Source' -> Bool
== :: CustomerTaxLocation'Source' -> CustomerTaxLocation'Source' -> Bool
$c== :: CustomerTaxLocation'Source' -> CustomerTaxLocation'Source' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON CustomerTaxLocation'Source' where
  toJSON :: CustomerTaxLocation'Source' -> Value
toJSON (CustomerTaxLocation'Source'Other Value
val) = Value
val
  toJSON (CustomerTaxLocation'Source'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (CustomerTaxLocation'Source'
CustomerTaxLocation'Source'EnumBillingAddress) = Value
"billing_address"
  toJSON (CustomerTaxLocation'Source'
CustomerTaxLocation'Source'EnumIpAddress) = Value
"ip_address"
  toJSON (CustomerTaxLocation'Source'
CustomerTaxLocation'Source'EnumPaymentMethod) = Value
"payment_method"
  toJSON (CustomerTaxLocation'Source'
CustomerTaxLocation'Source'EnumShippingDestination) = Value
"shipping_destination"

instance Data.Aeson.Types.FromJSON.FromJSON CustomerTaxLocation'Source' where
  parseJSON :: Value -> Parser CustomerTaxLocation'Source'
parseJSON Value
val =
    CustomerTaxLocation'Source' -> Parser CustomerTaxLocation'Source'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
      ( if
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"billing_address" -> CustomerTaxLocation'Source'
CustomerTaxLocation'Source'EnumBillingAddress
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ip_address" -> CustomerTaxLocation'Source'
CustomerTaxLocation'Source'EnumIpAddress
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"payment_method" -> CustomerTaxLocation'Source'
CustomerTaxLocation'Source'EnumPaymentMethod
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"shipping_destination" -> CustomerTaxLocation'Source'
CustomerTaxLocation'Source'EnumShippingDestination
            | Bool
GHC.Base.otherwise -> Value -> CustomerTaxLocation'Source'
CustomerTaxLocation'Source'Other Value
val
      )