{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Swaps.Variance
  ( module Data.FpML.V53.Swaps.Variance
  , module Data.FpML.V53.Eqd
  ) where
 
import Text.XML.HaXml.Schema.Schema (SchemaType(..),SimpleType(..),Extension(..),Restricts(..))
import Text.XML.HaXml.Schema.Schema as Schema
import Text.XML.HaXml.OneOfN
import qualified Text.XML.HaXml.Schema.PrimitiveTypes as Xsd
import Data.FpML.V53.Eqd
 
-- Some hs-boot imports are required, for fwd-declaring types.
 
-- | Calculation of a Variance Amount.
data VarianceAmount = VarianceAmount
        { varianAmount_calculationDates :: Maybe AdjustableRelativeOrPeriodicDates
          -- ^ Specifies the date on which a calculation or an observation 
          --   will be performed for the purpose of calculating the 
          --   amount.
        , varianAmount_observationStartDate :: Maybe AdjustableOrRelativeDate
          -- ^ The start of the period over which observations are made 
          --   which are used in the calculation Used when the observation 
          --   start date differs from the trade date such as for forward 
          --   starting swaps.
        , varianAmount_optionsExchangeDividends :: Maybe Xsd.Boolean
          -- ^ If present and true, then options exchange dividends are 
          --   applicable.
        , varianAmount_additionalDividends :: Maybe Xsd.Boolean
          -- ^ If present and true, then additional dividends are 
          --   applicable.
        , varianAmount_allDividends :: Maybe Xsd.Boolean
          -- ^ Represents the European Master Confirmation value of 'All 
          --   Dividends' which, when applicable, signifies that, for a 
          --   given Ex-Date, the daily observed Share Price for that day 
          --   is adjusted (reduced) by the cash dividend and/or the cash 
          --   value of any non cash dividend per Share (including 
          --   Extraordinary Dividends) declared by the Issuer.
        , varianAmount_variance :: Maybe Variance
          -- ^ Specifies Variance.
        }
        deriving (Eq,Show)
instance SchemaType VarianceAmount where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return VarianceAmount
            `apply` optional (parseSchemaType "calculationDates")
            `apply` optional (parseSchemaType "observationStartDate")
            `apply` optional (parseSchemaType "optionsExchangeDividends")
            `apply` optional (parseSchemaType "additionalDividends")
            `apply` optional (parseSchemaType "allDividends")
            `apply` optional (parseSchemaType "variance")
    schemaTypeToXML s x@VarianceAmount{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "calculationDates") $ varianAmount_calculationDates x
            , maybe [] (schemaTypeToXML "observationStartDate") $ varianAmount_observationStartDate x
            , maybe [] (schemaTypeToXML "optionsExchangeDividends") $ varianAmount_optionsExchangeDividends x
            , maybe [] (schemaTypeToXML "additionalDividends") $ varianAmount_additionalDividends x
            , maybe [] (schemaTypeToXML "allDividends") $ varianAmount_allDividends x
            , maybe [] (schemaTypeToXML "variance") $ varianAmount_variance x
            ]
instance Extension VarianceAmount CalculatedAmount where
    supertype v = CalculatedAmount_VarianceAmount v
 
-- | A type describing return which is driven by a Variance 
--   Calculation.
data VarianceLeg = VarianceLeg
        { varianceLeg_ID :: Maybe Xsd.ID
        , varianceLeg_legIdentifier :: [LegIdentifier]
          -- ^ Version aware identification of this leg.
        , varianceLeg_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , varianceLeg_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , varianceLeg_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , varianceLeg_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , varianceLeg_effectiveDate :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the effective date of this leg of the swap. When 
          --   defined in relation to a date specified somewhere else in 
          --   the document (through the relativeDate component), this 
          --   element will typically point to the effective date of the 
          --   other leg of the swap.
        , varianceLeg_terminationDate :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the termination date of this leg of the swap. 
          --   When defined in relation to a date specified somewhere else 
          --   in the document (through the relativeDate component), this 
          --   element will typically point to the termination date of the 
          --   other leg of the swap.
        , varianceLeg_underlyer :: Maybe Underlyer
          -- ^ Specifies the underlyer of the leg.
        , varianceLeg_settlementType :: Maybe SettlementTypeEnum
        , varianceLeg_settlementDate :: Maybe AdjustableOrRelativeDate
        , varianceLeg_choice10 :: (Maybe (OneOf2 Money Currency))
          -- ^ Choice between:
          --   
          --   (1) Settlement Amount
          --   
          --   (2) Settlement Currency for use where the Settlement Amount 
          --   cannot be known in advance
        , varianceLeg_fxFeature :: Maybe FxFeature
          -- ^ Quanto, Composite, or Cross Currency FX features.
        , varianceLeg_valuation :: Maybe EquityValuation
          -- ^ Valuation of the underlyer.
        , varianceLeg_amount :: Maybe VarianceAmount
          -- ^ Specifies, in relation to each Equity Payment Date, the 
          --   amount to which the Equity Payment Date relates. Unless 
          --   otherwise specified, this term has the meaning defined in 
          --   the ISDA 2002 Equity Derivatives Definitions.
        }
        deriving (Eq,Show)
instance SchemaType VarianceLeg where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (VarianceLeg a0)
            `apply` many (parseSchemaType "legIdentifier")
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (parseSchemaType "effectiveDate")
            `apply` optional (parseSchemaType "terminationDate")
            `apply` optional (parseSchemaType "underlyer")
            `apply` optional (parseSchemaType "settlementType")
            `apply` optional (parseSchemaType "settlementDate")
            `apply` optional (oneOf' [ ("Money", fmap OneOf2 (parseSchemaType "settlementAmount"))
                                     , ("Currency", fmap TwoOf2 (parseSchemaType "settlementCurrency"))
                                     ])
            `apply` optional (parseSchemaType "fxFeature")
            `apply` optional (parseSchemaType "valuation")
            `apply` optional (parseSchemaType "amount")
    schemaTypeToXML s x@VarianceLeg{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ varianceLeg_ID x
                       ]
            [ concatMap (schemaTypeToXML "legIdentifier") $ varianceLeg_legIdentifier x
            , maybe [] (schemaTypeToXML "payerPartyReference") $ varianceLeg_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ varianceLeg_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ varianceLeg_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ varianceLeg_receiverAccountReference x
            , maybe [] (schemaTypeToXML "effectiveDate") $ varianceLeg_effectiveDate x
            , maybe [] (schemaTypeToXML "terminationDate") $ varianceLeg_terminationDate x
            , maybe [] (schemaTypeToXML "underlyer") $ varianceLeg_underlyer x
            , maybe [] (schemaTypeToXML "settlementType") $ varianceLeg_settlementType x
            , maybe [] (schemaTypeToXML "settlementDate") $ varianceLeg_settlementDate x
            , maybe [] (foldOneOf2  (schemaTypeToXML "settlementAmount")
                                    (schemaTypeToXML "settlementCurrency")
                                   ) $ varianceLeg_choice10 x
            , maybe [] (schemaTypeToXML "fxFeature") $ varianceLeg_fxFeature x
            , maybe [] (schemaTypeToXML "valuation") $ varianceLeg_valuation x
            , maybe [] (schemaTypeToXML "amount") $ varianceLeg_amount x
            ]
instance Extension VarianceLeg DirectionalLegUnderlyerValuation where
    supertype v = DirectionalLegUnderlyerValuation_VarianceLeg v
instance Extension VarianceLeg DirectionalLegUnderlyer where
    supertype = (supertype :: DirectionalLegUnderlyerValuation -> DirectionalLegUnderlyer)
              . (supertype :: VarianceLeg -> DirectionalLegUnderlyerValuation)
              
instance Extension VarianceLeg DirectionalLeg where
    supertype = (supertype :: DirectionalLegUnderlyer -> DirectionalLeg)
              . (supertype :: DirectionalLegUnderlyerValuation -> DirectionalLegUnderlyer)
              . (supertype :: VarianceLeg -> DirectionalLegUnderlyerValuation)
              
instance Extension VarianceLeg Leg where
    supertype = (supertype :: DirectionalLeg -> Leg)
              . (supertype :: DirectionalLegUnderlyer -> DirectionalLeg)
              . (supertype :: DirectionalLegUnderlyerValuation -> DirectionalLegUnderlyer)
              . (supertype :: VarianceLeg -> DirectionalLegUnderlyerValuation)
              
 
data VarianceOptionTransactionSupplement = VarianceOptionTransactionSupplement
        { vots_ID :: Maybe Xsd.ID
        , vots_primaryAssetClass :: Maybe AssetClass
          -- ^ A classification of the most important risk class of the 
          --   trade. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , vots_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , vots_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , vots_productId :: [ProductId]
          -- ^ A product reference identifier. The product ID is an 
          --   identifier that describes the key economic characteristics 
          --   of the trade type, with the exception of concepts such as 
          --   size (notional, quantity, number of units) and price (fixed 
          --   rate, strike, etc.) that are negotiated for each 
          --   transaction. It can be used to hold identifiers such as the 
          --   "UPI" (universal product identifier) required by certain 
          --   regulatory reporting rules. It can also be used to hold 
          --   identifiers of benchmark products or product temnplates 
          --   used by certain trading systems or facilities. FpML does 
          --   not define the domain values associated with this element. 
          --   Note that the domain values for this element are not 
          --   strictly an enumerated list.
        , vots_buyerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that buys this instrument, ie. 
          --   pays for this instrument and receives the rights defined by 
          --   it. See 2000 ISDA definitions Article 11.1 (b). In the case 
          --   of FRAs this the fixed rate payer.
        , vots_buyerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that buys this instrument.
        , vots_sellerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that sells ("writes") this 
          --   instrument, i.e. that grants the rights defined by this 
          --   instrument and in return receives a payment for it. See 
          --   2000 ISDA definitions Article 11.1 (a). In the case of FRAs 
          --   this is the floating rate payer.
        , vots_sellerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that sells this instrument.
        , vots_optionType :: OptionTypeEnum
          -- ^ The type of option transaction. From a usage standpoint, 
          --   put/call is the default option type, while payer/receiver 
          --   indicator is used for options index credit default swaps, 
          --   consistently with the industry practice. Straddle is used 
          --   for the case of straddle strategy, that combine a call and 
          --   a put with the same strike.
        , vots_equityPremium :: Maybe EquityPremium
          -- ^ The variance option premium payable by the buyer to the 
          --   seller.
        , vots_equityExercise :: Maybe EquityExerciseValuationSettlement
          -- ^ The parameters for defining how the equity option can be 
          --   exercised, how it is valued and how it is settled.
        , vots_exchangeLookAlike :: Maybe Xsd.Boolean
          -- ^ For a share option transaction, a flag used to indicate 
          --   whether the transaction is to be treated as an 'exchange 
          --   look-alike'. This designation has significance for how 
          --   share adjustments (arising from corporate actions) will be 
          --   determined for the transaction. For an 'exchange 
          --   look-alike' transaction the relevant share adjustments will 
          --   follow that for a corresponding designated contract listed 
          --   on the related exchange (referred to as Options Exchange 
          --   Adjustment (ISDA defined term), otherwise the share 
          --   adjustments will be determined by the calculation agent 
          --   (referred to as Calculation Agent Adjustment (ISDA defined 
          --   term)).
        , vots_methodOfAdjustment :: Maybe MethodOfAdjustmentEnum
          -- ^ Defines how adjustments will be made to the contract should 
          --   one or more of the extraordinary events occur.
        , vots_choice13 :: (Maybe (OneOf2 PositiveDecimal PositiveDecimal))
          -- ^ Choice between:
          --   
          --   (1) The number of shares per option comprised in the option 
          --   transaction supplement.
          --   
          --   (2) Specifies the contract multiplier that can be 
          --   associated with an index option.
        , vots_varianceSwapTransactionSupplement :: VarianceSwapTransactionSupplement
          -- ^ The variance swap details.
        }
        deriving (Eq,Show)
instance SchemaType VarianceOptionTransactionSupplement where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (VarianceOptionTransactionSupplement a0)
            `apply` optional (parseSchemaType "primaryAssetClass")
            `apply` many (parseSchemaType "secondaryAssetClass")
            `apply` many (parseSchemaType "productType")
            `apply` many (parseSchemaType "productId")
            `apply` optional (parseSchemaType "buyerPartyReference")
            `apply` optional (parseSchemaType "buyerAccountReference")
            `apply` optional (parseSchemaType "sellerPartyReference")
            `apply` optional (parseSchemaType "sellerAccountReference")
            `apply` parseSchemaType "optionType"
            `apply` optional (parseSchemaType "equityPremium")
            `apply` optional (parseSchemaType "equityExercise")
            `apply` optional (parseSchemaType "exchangeLookAlike")
            `apply` optional (parseSchemaType "methodOfAdjustment")
            `apply` optional (oneOf' [ ("PositiveDecimal", fmap OneOf2 (parseSchemaType "optionEntitlement"))
                                     , ("PositiveDecimal", fmap TwoOf2 (parseSchemaType "multiplier"))
                                     ])
            `apply` parseSchemaType "varianceSwapTransactionSupplement"
    schemaTypeToXML s x@VarianceOptionTransactionSupplement{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ vots_ID x
                       ]
            [ maybe [] (schemaTypeToXML "primaryAssetClass") $ vots_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ vots_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ vots_productType x
            , concatMap (schemaTypeToXML "productId") $ vots_productId x
            , maybe [] (schemaTypeToXML "buyerPartyReference") $ vots_buyerPartyReference x
            , maybe [] (schemaTypeToXML "buyerAccountReference") $ vots_buyerAccountReference x
            , maybe [] (schemaTypeToXML "sellerPartyReference") $ vots_sellerPartyReference x
            , maybe [] (schemaTypeToXML "sellerAccountReference") $ vots_sellerAccountReference x
            , schemaTypeToXML "optionType" $ vots_optionType x
            , maybe [] (schemaTypeToXML "equityPremium") $ vots_equityPremium x
            , maybe [] (schemaTypeToXML "equityExercise") $ vots_equityExercise x
            , maybe [] (schemaTypeToXML "exchangeLookAlike") $ vots_exchangeLookAlike x
            , maybe [] (schemaTypeToXML "methodOfAdjustment") $ vots_methodOfAdjustment x
            , maybe [] (foldOneOf2  (schemaTypeToXML "optionEntitlement")
                                    (schemaTypeToXML "multiplier")
                                   ) $ vots_choice13 x
            , schemaTypeToXML "varianceSwapTransactionSupplement" $ vots_varianceSwapTransactionSupplement x
            ]
instance Extension VarianceOptionTransactionSupplement OptionBase where
    supertype v = OptionBase_VarianceOptionTransactionSupplement v
instance Extension VarianceOptionTransactionSupplement Option where
    supertype = (supertype :: OptionBase -> Option)
              . (supertype :: VarianceOptionTransactionSupplement -> OptionBase)
              
instance Extension VarianceOptionTransactionSupplement Product where
    supertype = (supertype :: Option -> Product)
              . (supertype :: OptionBase -> Option)
              . (supertype :: VarianceOptionTransactionSupplement -> OptionBase)
              
 
-- | A Variance Swap.
data VarianceSwap = VarianceSwap
        { varianceSwap_ID :: Maybe Xsd.ID
        , varianceSwap_primaryAssetClass :: Maybe AssetClass
          -- ^ A classification of the most important risk class of the 
          --   trade. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , varianceSwap_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , varianceSwap_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , varianceSwap_productId :: [ProductId]
          -- ^ A product reference identifier. The product ID is an 
          --   identifier that describes the key economic characteristics 
          --   of the trade type, with the exception of concepts such as 
          --   size (notional, quantity, number of units) and price (fixed 
          --   rate, strike, etc.) that are negotiated for each 
          --   transaction. It can be used to hold identifiers such as the 
          --   "UPI" (universal product identifier) required by certain 
          --   regulatory reporting rules. It can also be used to hold 
          --   identifiers of benchmark products or product temnplates 
          --   used by certain trading systems or facilities. FpML does 
          --   not define the domain values associated with this element. 
          --   Note that the domain values for this element are not 
          --   strictly an enumerated list.
        , varianceSwap_additionalPayment :: [ClassifiedPayment]
          -- ^ Specifies additional payment(s) between the principal 
          --   parties to the netted swap.
        , varianceSwap_extraordinaryEvents :: Maybe ExtraordinaryEvents
          -- ^ Where the underlying is shares, specifies events affecting 
          --   the issuer of those shares that may require the terms of 
          --   the transaction to be adjusted.
        , varianceSwap_varianceLeg :: [VarianceLeg]
          -- ^ Variance Leg.
        }
        deriving (Eq,Show)
instance SchemaType VarianceSwap where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (VarianceSwap a0)
            `apply` optional (parseSchemaType "primaryAssetClass")
            `apply` many (parseSchemaType "secondaryAssetClass")
            `apply` many (parseSchemaType "productType")
            `apply` many (parseSchemaType "productId")
            `apply` many (parseSchemaType "additionalPayment")
            `apply` optional (parseSchemaType "extraordinaryEvents")
            `apply` many (parseSchemaType "varianceLeg")
    schemaTypeToXML s x@VarianceSwap{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ varianceSwap_ID x
                       ]
            [ maybe [] (schemaTypeToXML "primaryAssetClass") $ varianceSwap_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ varianceSwap_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ varianceSwap_productType x
            , concatMap (schemaTypeToXML "productId") $ varianceSwap_productId x
            , concatMap (schemaTypeToXML "additionalPayment") $ varianceSwap_additionalPayment x
            , maybe [] (schemaTypeToXML "extraordinaryEvents") $ varianceSwap_extraordinaryEvents x
            , concatMap (schemaTypeToXML "varianceLeg") $ varianceSwap_varianceLeg x
            ]
instance Extension VarianceSwap NettedSwapBase where
    supertype v = NettedSwapBase_VarianceSwap v
instance Extension VarianceSwap Product where
    supertype = (supertype :: NettedSwapBase -> Product)
              . (supertype :: VarianceSwap -> NettedSwapBase)
              
 
-- | A Variance Swap Transaction Supplement.
data VarianceSwapTransactionSupplement = VarianceSwapTransactionSupplement
        { varianSwapTransSuppl_ID :: Maybe Xsd.ID
        , varianSwapTransSuppl_primaryAssetClass :: Maybe AssetClass
          -- ^ A classification of the most important risk class of the 
          --   trade. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , varianSwapTransSuppl_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , varianSwapTransSuppl_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , varianSwapTransSuppl_productId :: [ProductId]
          -- ^ A product reference identifier. The product ID is an 
          --   identifier that describes the key economic characteristics 
          --   of the trade type, with the exception of concepts such as 
          --   size (notional, quantity, number of units) and price (fixed 
          --   rate, strike, etc.) that are negotiated for each 
          --   transaction. It can be used to hold identifiers such as the 
          --   "UPI" (universal product identifier) required by certain 
          --   regulatory reporting rules. It can also be used to hold 
          --   identifiers of benchmark products or product temnplates 
          --   used by certain trading systems or facilities. FpML does 
          --   not define the domain values associated with this element. 
          --   Note that the domain values for this element are not 
          --   strictly an enumerated list.
        , varianSwapTransSuppl_varianceLeg :: [VarianceLeg]
          -- ^ Variance Leg.
        , varianSwapTransSuppl_choice5 :: (Maybe (OneOf2 Xsd.Boolean Xsd.Boolean))
          -- ^ Choice between:
          --   
          --   (1) For an index option transaction, a flag to indicate 
          --   whether a relevant Multiple Exchange Index Annex is 
          --   applicable to the transaction. This annex defines 
          --   additional provisions which are applicable where an 
          --   index is comprised of component securities that are 
          --   traded on multiple exchanges.
          --   
          --   (2) For an index option transaction, a flag to indicate 
          --   whether a relevant Component Security Index Annex is 
          --   applicable to the transaction.
        , varianSwapTransSuppl_localJurisdiction :: Maybe CountryCode
          -- ^ Local Jurisdiction is a term used in the AEJ Master 
          --   Confirmation, which is used to determine local taxes, which 
          --   shall mean taxes, duties, and similar charges imposed by 
          --   the taxing authority of the Local Jurisdiction If this 
          --   element is not present Local Jurisdiction is Not 
          --   Applicable.
        , varianSwapTransSuppl_relevantJurisdiction :: Maybe CountryCode
          -- ^ Relevent Jurisdiction is a term used in the AEJ Master 
          --   Confirmation, which is used to determine local taxes, which 
          --   shall mean taxes, duties and similar charges that would be 
          --   imposed by the taxing authority of the Country of Underlyer 
          --   on a Hypothetical Broker Dealer assuming the Applicable 
          --   Hedge Positions are held by its office in the Relevant 
          --   Jurisdiction. If this element is not present Relevant 
          --   Jurisdiction is Not Applicable.
        }
        deriving (Eq,Show)
instance SchemaType VarianceSwapTransactionSupplement where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (VarianceSwapTransactionSupplement a0)
            `apply` optional (parseSchemaType "primaryAssetClass")
            `apply` many (parseSchemaType "secondaryAssetClass")
            `apply` many (parseSchemaType "productType")
            `apply` many (parseSchemaType "productId")
            `apply` many (parseSchemaType "varianceLeg")
            `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf2 (parseSchemaType "multipleExchangeIndexAnnexFallback"))
                                     , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "componentSecurityIndexAnnexFallback"))
                                     ])
            `apply` optional (parseSchemaType "localJurisdiction")
            `apply` optional (parseSchemaType "relevantJurisdiction")
    schemaTypeToXML s x@VarianceSwapTransactionSupplement{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ varianSwapTransSuppl_ID x
                       ]
            [ maybe [] (schemaTypeToXML "primaryAssetClass") $ varianSwapTransSuppl_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ varianSwapTransSuppl_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ varianSwapTransSuppl_productType x
            , concatMap (schemaTypeToXML "productId") $ varianSwapTransSuppl_productId x
            , concatMap (schemaTypeToXML "varianceLeg") $ varianSwapTransSuppl_varianceLeg x
            , maybe [] (foldOneOf2  (schemaTypeToXML "multipleExchangeIndexAnnexFallback")
                                    (schemaTypeToXML "componentSecurityIndexAnnexFallback")
                                   ) $ varianSwapTransSuppl_choice5 x
            , maybe [] (schemaTypeToXML "localJurisdiction") $ varianSwapTransSuppl_localJurisdiction x
            , maybe [] (schemaTypeToXML "relevantJurisdiction") $ varianSwapTransSuppl_relevantJurisdiction x
            ]
instance Extension VarianceSwapTransactionSupplement Product where
    supertype v = Product_VarianceSwapTransactionSupplement v
 
-- | Specifies the structure of a variance option.
elementVarianceOptionTransactionSupplement :: XMLParser VarianceOptionTransactionSupplement
elementVarianceOptionTransactionSupplement = parseSchemaType "varianceOptionTransactionSupplement"
elementToXMLVarianceOptionTransactionSupplement :: VarianceOptionTransactionSupplement -> [Content ()]
elementToXMLVarianceOptionTransactionSupplement = schemaTypeToXML "varianceOptionTransactionSupplement"
 
-- | Specifies the structure of a variance swap.
elementVarianceSwap :: XMLParser VarianceSwap
elementVarianceSwap = parseSchemaType "varianceSwap"
elementToXMLVarianceSwap :: VarianceSwap -> [Content ()]
elementToXMLVarianceSwap = schemaTypeToXML "varianceSwap"
 
-- | Specifies the structure of a variance swap transaction 
--   supplement.
elementVarianceSwapTransactionSupplement :: XMLParser VarianceSwapTransactionSupplement
elementVarianceSwapTransactionSupplement = parseSchemaType "varianceSwapTransactionSupplement"
elementToXMLVarianceSwapTransactionSupplement :: VarianceSwapTransactionSupplement -> [Content ()]
elementToXMLVarianceSwapTransactionSupplement = schemaTypeToXML "varianceSwapTransactionSupplement"