{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Shared.EQ
  ( module Data.FpML.V53.Shared.EQ
  , module Data.FpML.V53.Shared.Option
  ) 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.Shared.Option
 
-- Some hs-boot imports are required, for fwd-declaring types.
import {-# SOURCE #-} Data.FpML.V53.Swaps.Correlation ( CorrelationAmount )
import {-# SOURCE #-} Data.FpML.V53.Swaps.Variance ( VarianceAmount )
import {-# SOURCE #-} Data.FpML.V53.Swaps.Dividend ( FixedPaymentLeg )
import {-# SOURCE #-} Data.FpML.V53.Swaps.Dividend ( DividendLeg )
import {-# SOURCE #-} Data.FpML.V53.Swaps.Correlation ( CorrelationLeg )
import {-# SOURCE #-} Data.FpML.V53.Swaps.Variance ( VarianceLeg )
import {-# SOURCE #-} Data.FpML.V53.Swaps.Dividend ( DividendPeriodPayment )
import {-# SOURCE #-} Data.FpML.V53.Swaps.Correlation ( CorrelationSwap )
import {-# SOURCE #-} Data.FpML.V53.Swaps.Variance ( VarianceSwap )
import {-# SOURCE #-} Data.FpML.V53.Swaps.Return ( EquitySwapTransactionSupplement )
 
-- | A type for defining ISDA 2002 Equity Derivative Additional 
--   Disruption Events.
data AdditionalDisruptionEvents = AdditionalDisruptionEvents
        { addDisrupEvents_changeInLaw :: Maybe Xsd.Boolean
          -- ^ If true, then change in law is applicable.
        , addDisrupEvents_failureToDeliver :: Maybe Xsd.Boolean
          -- ^ Where the underlying is shares and the transaction is 
          --   physically settled, then, if true, a failure to deliver the 
          --   shares on the settlement date will not be an event of 
          --   default for the purposes of the master agreement.
        , addDisrupEvents_insolvencyFiling :: Maybe Xsd.Boolean
          -- ^ If true, then insolvency filing is applicable.
        , addDisrupEvents_hedgingDisruption :: Maybe Xsd.Boolean
          -- ^ If true, then hedging disruption is applicable.
        , addDisrupEvents_lossOfStockBorrow :: Maybe Xsd.Boolean
          -- ^ If true, then loss of stock borrow is applicable.
        , addDisrupEvents_maximumStockLoanRate :: Maybe RestrictedPercentage
          -- ^ Specifies the maximum stock loan rate for Loss of Stock 
          --   Borrow.
        , addDisrupEvents_increasedCostOfStockBorrow :: Maybe Xsd.Boolean
          -- ^ If true, then increased cost of stock borrow is applicable.
        , addDisrupEvents_initialStockLoanRate :: Maybe RestrictedPercentage
          -- ^ Specifies the initial stock loan rate for Increased Cost of 
          --   Stock Borrow.
        , addDisrupEvents_increasedCostOfHedging :: Maybe Xsd.Boolean
          -- ^ If true, then increased cost of hedging is applicable.
        , addDisrupEvents_determiningPartyReference :: Maybe PartyReference
          -- ^ A reference to the party which determines additional 
          --   disruption events.
        , addDisrupEvents_foreignOwnershipEvent :: Maybe Xsd.Boolean
          -- ^ If true, then foreign ownership event is applicable.
        }
        deriving (Eq,Show)
instance SchemaType AdditionalDisruptionEvents where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return AdditionalDisruptionEvents
            `apply` optional (parseSchemaType "changeInLaw")
            `apply` optional (parseSchemaType "failureToDeliver")
            `apply` optional (parseSchemaType "insolvencyFiling")
            `apply` optional (parseSchemaType "hedgingDisruption")
            `apply` optional (parseSchemaType "lossOfStockBorrow")
            `apply` optional (parseSchemaType "maximumStockLoanRate")
            `apply` optional (parseSchemaType "increasedCostOfStockBorrow")
            `apply` optional (parseSchemaType "initialStockLoanRate")
            `apply` optional (parseSchemaType "increasedCostOfHedging")
            `apply` optional (parseSchemaType "determiningPartyReference")
            `apply` optional (parseSchemaType "foreignOwnershipEvent")
    schemaTypeToXML s x@AdditionalDisruptionEvents{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "changeInLaw") $ addDisrupEvents_changeInLaw x
            , maybe [] (schemaTypeToXML "failureToDeliver") $ addDisrupEvents_failureToDeliver x
            , maybe [] (schemaTypeToXML "insolvencyFiling") $ addDisrupEvents_insolvencyFiling x
            , maybe [] (schemaTypeToXML "hedgingDisruption") $ addDisrupEvents_hedgingDisruption x
            , maybe [] (schemaTypeToXML "lossOfStockBorrow") $ addDisrupEvents_lossOfStockBorrow x
            , maybe [] (schemaTypeToXML "maximumStockLoanRate") $ addDisrupEvents_maximumStockLoanRate x
            , maybe [] (schemaTypeToXML "increasedCostOfStockBorrow") $ addDisrupEvents_increasedCostOfStockBorrow x
            , maybe [] (schemaTypeToXML "initialStockLoanRate") $ addDisrupEvents_initialStockLoanRate x
            , maybe [] (schemaTypeToXML "increasedCostOfHedging") $ addDisrupEvents_increasedCostOfHedging x
            , maybe [] (schemaTypeToXML "determiningPartyReference") $ addDisrupEvents_determiningPartyReference x
            , maybe [] (schemaTypeToXML "foreignOwnershipEvent") $ addDisrupEvents_foreignOwnershipEvent x
            ]
 
-- | Specifies the amount of the fee along with, when 
--   applicable, the formula that supports its determination.
data AdditionalPaymentAmount = AdditionalPaymentAmount
        { addPaymentAmount_paymentAmount :: Maybe NonNegativeMoney
          -- ^ The currency amount of the payment.
        , addPaymentAmount_formula :: Maybe Formula
          -- ^ Specifies a formula, with its description and components.
        }
        deriving (Eq,Show)
instance SchemaType AdditionalPaymentAmount where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return AdditionalPaymentAmount
            `apply` optional (parseSchemaType "paymentAmount")
            `apply` optional (parseSchemaType "formula")
    schemaTypeToXML s x@AdditionalPaymentAmount{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "paymentAmount") $ addPaymentAmount_paymentAmount x
            , maybe [] (schemaTypeToXML "formula") $ addPaymentAmount_formula x
            ]
 
-- | A type describing a date defined as subject to adjustment 
--   or defined in reference to another date through one or 
--   several date offsets.
data AdjustableDateOrRelativeDateSequence = AdjustableDateOrRelativeDateSequence
        { adords_ID :: Maybe Xsd.ID
        , adords_choice0 :: (Maybe (OneOf2 AdjustableDate RelativeDateSequence))
          -- ^ Choice between:
          --   
          --   (1) A date that shall be subject to adjustment if it would 
          --   otherwise fall on a day that is not a business day in 
          --   the specified business centers, together with the 
          --   convention for adjusting the date.
          --   
          --   (2) A date specified in relation to some other date defined 
          --   in the document (the anchor date), where there is the 
          --   opportunity to specify a combination of offset rules. 
          --   This component will typically be used for defining the 
          --   valuation date in relation to the payment date, as both 
          --   the currency and the exchange holiday calendars need to 
          --   be considered.
        }
        deriving (Eq,Show)
instance SchemaType AdjustableDateOrRelativeDateSequence where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (AdjustableDateOrRelativeDateSequence a0)
            `apply` optional (oneOf' [ ("AdjustableDate", fmap OneOf2 (parseSchemaType "adjustableDate"))
                                     , ("RelativeDateSequence", fmap TwoOf2 (parseSchemaType "relativeDateSequence"))
                                     ])
    schemaTypeToXML s x@AdjustableDateOrRelativeDateSequence{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ adords_ID x
                       ]
            [ maybe [] (foldOneOf2  (schemaTypeToXML "adjustableDate")
                                    (schemaTypeToXML "relativeDateSequence")
                                   ) $ adords_choice0 x
            ]
 
-- | A type describing correlation bounds, which form a cap and 
--   a floor on the realized correlation.
data BoundedCorrelation = BoundedCorrelation
        { boundedCorrel_minimumBoundaryPercent :: Maybe Xsd.Decimal
          -- ^ Minimum Boundary as a percentage of the Strike Price.
        , boundedCorrel_maximumBoundaryPercent :: Maybe Xsd.Decimal
          -- ^ Maximum Boundary as a percentage of the Strike Price.
        }
        deriving (Eq,Show)
instance SchemaType BoundedCorrelation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return BoundedCorrelation
            `apply` optional (parseSchemaType "minimumBoundaryPercent")
            `apply` optional (parseSchemaType "maximumBoundaryPercent")
    schemaTypeToXML s x@BoundedCorrelation{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "minimumBoundaryPercent") $ boundedCorrel_minimumBoundaryPercent x
            , maybe [] (schemaTypeToXML "maximumBoundaryPercent") $ boundedCorrel_maximumBoundaryPercent x
            ]
 
-- | A type describing variance bounds, which are used to 
--   exclude money price values outside of the specified range 
--   In a Up Conditional Swap Underlyer price must be equal to 
--   or higher than Lower Barrier In a Down Conditional Swap 
--   Underlyer price must be equal to or lower than Upper 
--   Barrier In a Corridor Conditional Swap Underlyer price must 
--   be equal to or higher than Lower Barrier and must be equal 
--   to or lower than Upper Barrier.
data BoundedVariance = BoundedVariance
        { boundedVarian_realisedVarianceMethod :: Maybe RealisedVarianceMethodEnum
          -- ^ The contract specifies whether which price must satisfy the 
          --   boundary condition.
        , boundedVarian_daysInRangeAdjustment :: Maybe Xsd.Boolean
          -- ^ The contract specifies whether the notional should be 
          --   scaled by the Number of Days in Range divided by the 
          --   Expected N. The number of Days in Ranges refers to the 
          --   number of returns that contribute to the realized 
          --   volatility.
        , boundedVarian_upperBarrier :: Maybe NonNegativeDecimal
          -- ^ All observations above this price level will be excluded 
          --   from the variance calculation.
        , boundedVarian_lowerBarrier :: Maybe NonNegativeDecimal
          -- ^ All observations below this price level will be excluded 
          --   from the variance calculation.
        }
        deriving (Eq,Show)
instance SchemaType BoundedVariance where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return BoundedVariance
            `apply` optional (parseSchemaType "realisedVarianceMethod")
            `apply` optional (parseSchemaType "daysInRangeAdjustment")
            `apply` optional (parseSchemaType "upperBarrier")
            `apply` optional (parseSchemaType "lowerBarrier")
    schemaTypeToXML s x@BoundedVariance{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "realisedVarianceMethod") $ boundedVarian_realisedVarianceMethod x
            , maybe [] (schemaTypeToXML "daysInRangeAdjustment") $ boundedVarian_daysInRangeAdjustment x
            , maybe [] (schemaTypeToXML "upperBarrier") $ boundedVarian_upperBarrier x
            , maybe [] (schemaTypeToXML "lowerBarrier") $ boundedVarian_lowerBarrier x
            ]
 
-- | An abstract base class for all calculated money amounts, 
--   which are in the currency of the cash multiplier of the 
--   calculation.
data CalculatedAmount
        = CalculatedAmount_CorrelationAmount CorrelationAmount
        | CalculatedAmount_VarianceAmount VarianceAmount
        
        deriving (Eq,Show)
instance SchemaType CalculatedAmount where
    parseSchemaType s = do
        (fmap CalculatedAmount_CorrelationAmount $ parseSchemaType s)
        `onFail`
        (fmap CalculatedAmount_VarianceAmount $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of CalculatedAmount,\n\
\  namely one of:\n\
\CorrelationAmount,VarianceAmount"
    schemaTypeToXML _s (CalculatedAmount_CorrelationAmount x) = schemaTypeToXML "correlationAmount" x
    schemaTypeToXML _s (CalculatedAmount_VarianceAmount x) = schemaTypeToXML "varianceAmount" x
 
-- | Abstract base class for all calculation from observed 
--   values.
data CalculationFromObservation
        = CalculationFromObservation_Variance Variance
        | CalculationFromObservation_Correlation Correlation
        
        deriving (Eq,Show)
instance SchemaType CalculationFromObservation where
    parseSchemaType s = do
        (fmap CalculationFromObservation_Variance $ parseSchemaType s)
        `onFail`
        (fmap CalculationFromObservation_Correlation $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of CalculationFromObservation,\n\
\  namely one of:\n\
\Variance,Correlation"
    schemaTypeToXML _s (CalculationFromObservation_Variance x) = schemaTypeToXML "variance" x
    schemaTypeToXML _s (CalculationFromObservation_Correlation x) = schemaTypeToXML "correlation" x
 
-- | Specifies the compounding method and the compounding rate.
data Compounding = Compounding
        { compounding_method :: Maybe CompoundingMethodEnum
          -- ^ If more that one calculation period contributes to a single 
          --   payment amount this element specifies whether compounding 
          --   is applicable, and if so, what compounding method is to be 
          --   used. This element must only be included when more that one 
          --   calculation period contributes to a single payment amount.
        , compounding_rate :: Maybe CompoundingRate
          -- ^ Defines a compounding rate. The compounding interest can 
          --   either point back to the interest calculation node on the 
          --   Interest Leg, or be defined specifically.
        , compounding_spread :: Maybe Xsd.Decimal
          -- ^ Defines the spread to be used for compounding. This field 
          --   should be used in scenarios where the interest payment is 
          --   based on a compounding formula that uses a compounding 
          --   spread in addition to the regular spread.
        , compounding_dates :: Maybe AdjustableRelativeOrPeriodicDates2
          -- ^ Defines the compounding dates.
        }
        deriving (Eq,Show)
instance SchemaType Compounding where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Compounding
            `apply` optional (parseSchemaType "compoundingMethod")
            `apply` optional (parseSchemaType "compoundingRate")
            `apply` optional (parseSchemaType "compoundingSpread")
            `apply` optional (parseSchemaType "compoundingDates")
    schemaTypeToXML s x@Compounding{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "compoundingMethod") $ compounding_method x
            , maybe [] (schemaTypeToXML "compoundingRate") $ compounding_rate x
            , maybe [] (schemaTypeToXML "compoundingSpread") $ compounding_spread x
            , maybe [] (schemaTypeToXML "compoundingDates") $ compounding_dates x
            ]
 
-- | A type defining a compounding rate. The compounding 
--   interest can either point back to the floating rate 
--   calculation of interest calculation node on the Interest 
--   Leg, or be defined specifically.
data CompoundingRate = CompoundingRate
        { compoRate_choice0 :: (Maybe (OneOf2 FloatingRateCalculationReference InterestAccrualsMethod))
          -- ^ Choice between:
          --   
          --   (1) Reference to the floating rate calculation of interest 
          --   calculation node on the Interest Leg.
          --   
          --   (2) Defines a specific rate.
        }
        deriving (Eq,Show)
instance SchemaType CompoundingRate where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return CompoundingRate
            `apply` optional (oneOf' [ ("FloatingRateCalculationReference", fmap OneOf2 (parseSchemaType "interestLegRate"))
                                     , ("InterestAccrualsMethod", fmap TwoOf2 (parseSchemaType "specificRate"))
                                     ])
    schemaTypeToXML s x@CompoundingRate{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "interestLegRate")
                                    (schemaTypeToXML "specificRate")
                                   ) $ compoRate_choice0 x
            ]
 
-- | A type describing the correlation amount of a correlation 
--   swap.
data Correlation = Correlation
        { correlation_choice0 :: (Maybe (OneOf3 Xsd.Decimal Xsd.Boolean Xsd.Boolean))
          -- ^ Choice between:
          --   
          --   (1) Contract will strike off this initial level.
          --   
          --   (2) If true this contract will strike off the closing level 
          --   of the default exchange traded contract.
          --   
          --   (3) If true this contract will strike off the expiring 
          --   level of the default exchange traded contract.
        , correlation_expectedN :: Maybe Xsd.PositiveInteger
          -- ^ Expected number of trading days.
        , correlation_notionalAmount :: Maybe NonNegativeMoney
          -- ^ Notional amount, which is a cash multiplier.
        , correlation_strikePrice :: Maybe CorrelationValue
          -- ^ Correlation Strike Price.
        , correlation_boundedCorrelation :: Maybe BoundedCorrelation
          -- ^ Bounded Correlation.
        , correlation_numberOfDataSeries :: Maybe Xsd.PositiveInteger
          -- ^ Number of data series, normal market practice is that 
          --   correlation data sets are drawn from geographic market 
          --   areas, such as America, Europe and Asia Pacific, each of 
          --   these geographic areas will have its own data series to 
          --   avoid contagion.
        }
        deriving (Eq,Show)
instance SchemaType Correlation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Correlation
            `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf3 (parseSchemaType "initialLevel"))
                                     , ("Xsd.Boolean", fmap TwoOf3 (parseSchemaType "closingLevel"))
                                     , ("Xsd.Boolean", fmap ThreeOf3 (parseSchemaType "expiringLevel"))
                                     ])
            `apply` optional (parseSchemaType "expectedN")
            `apply` optional (parseSchemaType "notionalAmount")
            `apply` optional (parseSchemaType "correlationStrikePrice")
            `apply` optional (parseSchemaType "boundedCorrelation")
            `apply` optional (parseSchemaType "numberOfDataSeries")
    schemaTypeToXML s x@Correlation{} =
        toXMLElement s []
            [ maybe [] (foldOneOf3  (schemaTypeToXML "initialLevel")
                                    (schemaTypeToXML "closingLevel")
                                    (schemaTypeToXML "expiringLevel")
                                   ) $ correlation_choice0 x
            , maybe [] (schemaTypeToXML "expectedN") $ correlation_expectedN x
            , maybe [] (schemaTypeToXML "notionalAmount") $ correlation_notionalAmount x
            , maybe [] (schemaTypeToXML "correlationStrikePrice") $ correlation_strikePrice x
            , maybe [] (schemaTypeToXML "boundedCorrelation") $ correlation_boundedCorrelation x
            , maybe [] (schemaTypeToXML "numberOfDataSeries") $ correlation_numberOfDataSeries x
            ]
instance Extension Correlation CalculationFromObservation where
    supertype v = CalculationFromObservation_Correlation v
 
-- | An abstract base class for all directional leg types with 
--   effective date, termination date, where a payer makes a 
--   stream of payments of greater than zero value to a 
--   receiver.
data DirectionalLeg
        = DirectionalLeg_ReturnSwapLegUnderlyer ReturnSwapLegUnderlyer
        | DirectionalLeg_InterestLeg InterestLeg
        | DirectionalLeg_DirectionalLegUnderlyer DirectionalLegUnderlyer
        | DirectionalLeg_FixedPaymentLeg FixedPaymentLeg
        
        deriving (Eq,Show)
instance SchemaType DirectionalLeg where
    parseSchemaType s = do
        (fmap DirectionalLeg_ReturnSwapLegUnderlyer $ parseSchemaType s)
        `onFail`
        (fmap DirectionalLeg_InterestLeg $ parseSchemaType s)
        `onFail`
        (fmap DirectionalLeg_DirectionalLegUnderlyer $ parseSchemaType s)
        `onFail`
        (fmap DirectionalLeg_FixedPaymentLeg $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of DirectionalLeg,\n\
\  namely one of:\n\
\ReturnSwapLegUnderlyer,InterestLeg,DirectionalLegUnderlyer,FixedPaymentLeg"
    schemaTypeToXML _s (DirectionalLeg_ReturnSwapLegUnderlyer x) = schemaTypeToXML "returnSwapLegUnderlyer" x
    schemaTypeToXML _s (DirectionalLeg_InterestLeg x) = schemaTypeToXML "interestLeg" x
    schemaTypeToXML _s (DirectionalLeg_DirectionalLegUnderlyer x) = schemaTypeToXML "directionalLegUnderlyer" x
    schemaTypeToXML _s (DirectionalLeg_FixedPaymentLeg x) = schemaTypeToXML "fixedPaymentLeg" x
instance Extension DirectionalLeg Leg where
    supertype v = Leg_DirectionalLeg v
 
-- | An abstract base class for all directional leg types with 
--   effective date, termination date, and underlyer where a 
--   payer makes a stream of payments of greater than zero value 
--   to a receiver.
data DirectionalLegUnderlyer
        = DirectionalLegUnderlyer_DirectionalLegUnderlyerValuation DirectionalLegUnderlyerValuation
        | DirectionalLegUnderlyer_DividendLeg DividendLeg
        
        deriving (Eq,Show)
instance SchemaType DirectionalLegUnderlyer where
    parseSchemaType s = do
        (fmap DirectionalLegUnderlyer_DirectionalLegUnderlyerValuation $ parseSchemaType s)
        `onFail`
        (fmap DirectionalLegUnderlyer_DividendLeg $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of DirectionalLegUnderlyer,\n\
\  namely one of:\n\
\DirectionalLegUnderlyerValuation,DividendLeg"
    schemaTypeToXML _s (DirectionalLegUnderlyer_DirectionalLegUnderlyerValuation x) = schemaTypeToXML "directionalLegUnderlyerValuation" x
    schemaTypeToXML _s (DirectionalLegUnderlyer_DividendLeg x) = schemaTypeToXML "dividendLeg" x
instance Extension DirectionalLegUnderlyer DirectionalLeg where
    supertype v = DirectionalLeg_DirectionalLegUnderlyer v
 
-- | An abstract base class for all directional leg types with 
--   effective date, termination date, and underlyer, where a 
--   payer makes a stream of payments of greater than zero value 
--   to a receiver.
data DirectionalLegUnderlyerValuation
        = DirectionalLegUnderlyerValuation_CorrelationLeg CorrelationLeg
        | DirectionalLegUnderlyerValuation_VarianceLeg VarianceLeg
        
        deriving (Eq,Show)
instance SchemaType DirectionalLegUnderlyerValuation where
    parseSchemaType s = do
        (fmap DirectionalLegUnderlyerValuation_CorrelationLeg $ parseSchemaType s)
        `onFail`
        (fmap DirectionalLegUnderlyerValuation_VarianceLeg $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of DirectionalLegUnderlyerValuation,\n\
\  namely one of:\n\
\CorrelationLeg,VarianceLeg"
    schemaTypeToXML _s (DirectionalLegUnderlyerValuation_CorrelationLeg x) = schemaTypeToXML "correlationLeg" x
    schemaTypeToXML _s (DirectionalLegUnderlyerValuation_VarianceLeg x) = schemaTypeToXML "varianceLeg" x
instance Extension DirectionalLegUnderlyerValuation DirectionalLegUnderlyer where
    supertype v = DirectionalLegUnderlyer_DirectionalLegUnderlyerValuation v
 
-- | Container for Dividend Adjustment Periods, which are used 
--   to calculate the Deviation between Expected Dividend and 
--   Actual Dividend in that Period.
data DividendAdjustment = DividendAdjustment
        { dividAdjust_dividendPeriod :: [DividendPeriodDividend]
          -- ^ A single Dividend Adjustment Period.
        }
        deriving (Eq,Show)
instance SchemaType DividendAdjustment where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return DividendAdjustment
            `apply` many (parseSchemaType "dividendPeriod")
    schemaTypeToXML s x@DividendAdjustment{} =
        toXMLElement s []
            [ concatMap (schemaTypeToXML "dividendPeriod") $ dividAdjust_dividendPeriod x
            ]
 
-- | A type describing the conditions governing the payment of 
--   dividends to the receiver of the equity return. With the 
--   exception of the dividend payout ratio, which is defined 
--   for each of the underlying components.
data DividendConditions = DividendConditions
        { dividCondit_dividendReinvestment :: Maybe Xsd.Boolean
          -- ^ Boolean element that defines whether the dividend will be 
          --   reinvested or not.
        , dividCondit_dividendEntitlement :: Maybe DividendEntitlementEnum
          -- ^ Defines the date on which the receiver on the equity return 
          --   is entitled to the dividend.
        , dividCondit_dividendAmount :: Maybe DividendAmountTypeEnum
        , dividCondit_dividendPaymentDate :: Maybe DividendPaymentDate
          -- ^ Specifies when the dividend will be paid to the receiver of 
          --   the equity return. Has the meaning as defined in the ISDA 
          --   2002 Equity Derivatives Definitions. Is not applicable in 
          --   the case of a dividend reinvestment election.
        , dividCondit_choice4 :: (Maybe (OneOf2 ((Maybe (DateReference)),(Maybe (DateReference))) DividendPeriodEnum))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * Dividend period has the meaning as defined in the 
          --   ISDA 2002 Equity Derivatives Definitions. This 
          --   element specifies the date on which the dividend 
          --   period will commence.
          --   
          --     * Dividend period has the meaning as defined in the 
          --   ISDA 2002 Equity Derivatives Definitions. This 
          --   element specifies the date on which the dividend 
          --   period will end. It includes a boolean attribute 
          --   for defining whether this end date is included or 
          --   excluded from the dividend period.
          --   
          --   (2) Defines the First Period or the Second Period, as 
          --   defined in the 2002 ISDA Equity Derivatives 
          --   Definitions.
        , dividCondit_extraOrdinaryDividends :: Maybe PartyReference
          -- ^ Reference to the party which determines if dividends are 
          --   extraordinary in relation to normal levels.
        , dividCondit_excessDividendAmount :: Maybe DividendAmountTypeEnum
          -- ^ Determination of Gross Cash Dividend per Share.
        , dividCondit_choice7 :: (Maybe (OneOf3 IdentifiedCurrency DeterminationMethod IdentifiedCurrencyReference))
          -- ^ Choice between:
          --   
          --   (1) The currency in which an amount is denominated.
          --   
          --   (2) Specifies the method according to which an amount or a 
          --   date is determined.
          --   
          --   (3) Reference to a currency defined elsewhere in the 
          --   document
        , dividCondit_dividendFxTriggerDate :: Maybe DividendPaymentDate
          -- ^ Specifies the date on which the FX rate will be considered 
          --   in the case of a Composite FX swap.
        , dividCondit_interestAccrualsMethod :: Maybe InterestAccrualsCompoundingMethod
        , dividCondit_numberOfIndexUnits :: Maybe NonNegativeDecimal
          -- ^ Defines the Number Of Index Units applicable to a Dividend.
        , dividCondit_declaredCashDividendPercentage :: Maybe NonNegativeDecimal
          -- ^ Declared Cash Dividend Percentage.
        , dividCondit_declaredCashEquivalentDividendPercentage :: Maybe NonNegativeDecimal
          -- ^ Declared Cash Equivalent Dividend Percentage.
        , dividCondit_nonCashDividendTreatment :: Maybe NonCashDividendTreatmentEnum
          -- ^ Defines treatment of Non-Cash Dividends.
        , dividCondit_dividendComposition :: Maybe DividendCompositionEnum
          -- ^ Defines how the composition of Dividends is to be 
          --   determined.
        , dividCondit_specialDividends :: Maybe Xsd.Boolean
          -- ^ Specifies the method according to which special dividends 
          --   are determined.
        }
        deriving (Eq,Show)
instance SchemaType DividendConditions where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return DividendConditions
            `apply` optional (parseSchemaType "dividendReinvestment")
            `apply` optional (parseSchemaType "dividendEntitlement")
            `apply` optional (parseSchemaType "dividendAmount")
            `apply` optional (parseSchemaType "dividendPaymentDate")
            `apply` optional (oneOf' [ ("Maybe DateReference Maybe DateReference", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "dividendPeriodEffectiveDate")
                                                                                                           `apply` optional (parseSchemaType "dividendPeriodEndDate")))
                                     , ("DividendPeriodEnum", fmap TwoOf2 (parseSchemaType "dividendPeriod"))
                                     ])
            `apply` optional (parseSchemaType "extraOrdinaryDividends")
            `apply` optional (parseSchemaType "excessDividendAmount")
            `apply` optional (oneOf' [ ("IdentifiedCurrency", fmap OneOf3 (parseSchemaType "currency"))
                                     , ("DeterminationMethod", fmap TwoOf3 (parseSchemaType "determinationMethod"))
                                     , ("IdentifiedCurrencyReference", fmap ThreeOf3 (parseSchemaType "currencyReference"))
                                     ])
            `apply` optional (parseSchemaType "dividendFxTriggerDate")
            `apply` optional (parseSchemaType "interestAccrualsMethod")
            `apply` optional (parseSchemaType "numberOfIndexUnits")
            `apply` optional (parseSchemaType "declaredCashDividendPercentage")
            `apply` optional (parseSchemaType "declaredCashEquivalentDividendPercentage")
            `apply` optional (parseSchemaType "nonCashDividendTreatment")
            `apply` optional (parseSchemaType "dividendComposition")
            `apply` optional (parseSchemaType "specialDividends")
    schemaTypeToXML s x@DividendConditions{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "dividendReinvestment") $ dividCondit_dividendReinvestment x
            , maybe [] (schemaTypeToXML "dividendEntitlement") $ dividCondit_dividendEntitlement x
            , maybe [] (schemaTypeToXML "dividendAmount") $ dividCondit_dividendAmount x
            , maybe [] (schemaTypeToXML "dividendPaymentDate") $ dividCondit_dividendPaymentDate x
            , maybe [] (foldOneOf2  (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "dividendPeriodEffectiveDate") a
                                                       , maybe [] (schemaTypeToXML "dividendPeriodEndDate") b
                                                       ])
                                    (schemaTypeToXML "dividendPeriod")
                                   ) $ dividCondit_choice4 x
            , maybe [] (schemaTypeToXML "extraOrdinaryDividends") $ dividCondit_extraOrdinaryDividends x
            , maybe [] (schemaTypeToXML "excessDividendAmount") $ dividCondit_excessDividendAmount x
            , maybe [] (foldOneOf3  (schemaTypeToXML "currency")
                                    (schemaTypeToXML "determinationMethod")
                                    (schemaTypeToXML "currencyReference")
                                   ) $ dividCondit_choice7 x
            , maybe [] (schemaTypeToXML "dividendFxTriggerDate") $ dividCondit_dividendFxTriggerDate x
            , maybe [] (schemaTypeToXML "interestAccrualsMethod") $ dividCondit_interestAccrualsMethod x
            , maybe [] (schemaTypeToXML "numberOfIndexUnits") $ dividCondit_numberOfIndexUnits x
            , maybe [] (schemaTypeToXML "declaredCashDividendPercentage") $ dividCondit_declaredCashDividendPercentage x
            , maybe [] (schemaTypeToXML "declaredCashEquivalentDividendPercentage") $ dividCondit_declaredCashEquivalentDividendPercentage x
            , maybe [] (schemaTypeToXML "nonCashDividendTreatment") $ dividCondit_nonCashDividendTreatment x
            , maybe [] (schemaTypeToXML "dividendComposition") $ dividCondit_dividendComposition x
            , maybe [] (schemaTypeToXML "specialDividends") $ dividCondit_specialDividends x
            ]
 
-- | A type describing the date on which the dividend will be 
--   paid/received. This type is also used to specify the date 
--   on which the FX rate will be determined, when applicable.
data DividendPaymentDate = DividendPaymentDate
        { dividPaymentDate_choice0 :: (Maybe (OneOf2 ((Maybe (DividendDateReferenceEnum)),(Maybe (Offset))) AdjustableDate))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * Specification of the dividend date using an 
          --   enumeration, with values such as the pay date, the 
          --   ex date or the record date.
          --   
          --     * Only to be used when SharePayment has been 
          --   specified in the dividendDateReference element. The 
          --   number of Currency Business Days following the day 
          --   on which the Issuer of the Shares pays the relevant 
          --   dividend to holders of record of the Shares.
          --   
          --   (2) A date that shall be subject to adjustment if it would 
          --   otherwise fall on a day that is not a business day in 
          --   the specified business centers, together with the 
          --   convention for adjusting the date.
        }
        deriving (Eq,Show)
instance SchemaType DividendPaymentDate where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return DividendPaymentDate
            `apply` optional (oneOf' [ ("Maybe DividendDateReferenceEnum Maybe Offset", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "dividendDateReference")
                                                                                                                `apply` optional (parseSchemaType "paymentDateOffset")))
                                     , ("AdjustableDate", fmap TwoOf2 (parseSchemaType "adjustableDate"))
                                     ])
    schemaTypeToXML s x@DividendPaymentDate{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "dividendDateReference") a
                                                       , maybe [] (schemaTypeToXML "paymentDateOffset") b
                                                       ])
                                    (schemaTypeToXML "adjustableDate")
                                   ) $ dividPaymentDate_choice0 x
            ]
 
-- | Abstract base class of all time bounded dividend period 
--   types.
data DividendPeriod
        = DividendPeriod_DividendPeriodDividend DividendPeriodDividend
        | DividendPeriod_DividendPeriodPayment DividendPeriodPayment
        
        deriving (Eq,Show)
instance SchemaType DividendPeriod where
    parseSchemaType s = do
        (fmap DividendPeriod_DividendPeriodDividend $ parseSchemaType s)
        `onFail`
        (fmap DividendPeriod_DividendPeriodPayment $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of DividendPeriod,\n\
\  namely one of:\n\
\DividendPeriodDividend,DividendPeriodPayment"
    schemaTypeToXML _s (DividendPeriod_DividendPeriodDividend x) = schemaTypeToXML "dividendPeriodDividend" x
    schemaTypeToXML _s (DividendPeriod_DividendPeriodPayment x) = schemaTypeToXML "dividendPeriodPayment" x
 
-- | A time bounded dividend period, with an expected dividend 
--   for each period.
data DividendPeriodDividend = DividendPeriodDividend
        { dividPeriodDivid_ID :: Maybe Xsd.ID
        , dividPeriodDivid_unadjustedStartDate :: Maybe IdentifiedDate
          -- ^ Unadjusted inclusive dividend period start date.
        , dividPeriodDivid_unadjustedEndDate :: Maybe IdentifiedDate
          -- ^ Unadjusted inclusive dividend period end date.
        , dividPeriodDivid_dateAdjustments :: Maybe BusinessDayAdjustments
          -- ^ Date adjustments for all unadjusted dates in this dividend 
          --   period.
        , dividPeriodDivid_underlyerReference :: Maybe AssetReference
          -- ^ Reference to the underlyer which is paying dividends. This 
          --   should be used in all cases, and must be used where there 
          --   are multiple underlying assets, to avoid any ambiguity 
          --   about which asset the dividend period relates to.
        , dividPeriodDivid_dividend :: Maybe NonNegativeMoney
          -- ^ Expected dividend in this period.
        , dividPeriodDivid_multiplier :: Maybe PositiveDecimal
          -- ^ Multiplier is a percentage value which is used to produce 
          --   Deviation by multiplying the difference between Expected 
          --   Dividend and Actual Dividend Deviation = Multiplier * 
          --   (Expected Dividend — Actual Dividend).
        }
        deriving (Eq,Show)
instance SchemaType DividendPeriodDividend where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (DividendPeriodDividend a0)
            `apply` optional (parseSchemaType "unadjustedStartDate")
            `apply` optional (parseSchemaType "unadjustedEndDate")
            `apply` optional (parseSchemaType "dateAdjustments")
            `apply` optional (parseSchemaType "underlyerReference")
            `apply` optional (parseSchemaType "dividend")
            `apply` optional (parseSchemaType "multiplier")
    schemaTypeToXML s x@DividendPeriodDividend{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ dividPeriodDivid_ID x
                       ]
            [ maybe [] (schemaTypeToXML "unadjustedStartDate") $ dividPeriodDivid_unadjustedStartDate x
            , maybe [] (schemaTypeToXML "unadjustedEndDate") $ dividPeriodDivid_unadjustedEndDate x
            , maybe [] (schemaTypeToXML "dateAdjustments") $ dividPeriodDivid_dateAdjustments x
            , maybe [] (schemaTypeToXML "underlyerReference") $ dividPeriodDivid_underlyerReference x
            , maybe [] (schemaTypeToXML "dividend") $ dividPeriodDivid_dividend x
            , maybe [] (schemaTypeToXML "multiplier") $ dividPeriodDivid_multiplier x
            ]
instance Extension DividendPeriodDividend DividendPeriod where
    supertype v = DividendPeriod_DividendPeriodDividend v
 
-- | A type for defining the merger events and their treatment.
data EquityCorporateEvents = EquityCorporateEvents
        { equityCorporEvents_shareForShare :: Maybe ShareExtraordinaryEventEnum
          -- ^ The consideration paid for the original shares following 
          --   the Merger Event consists wholly of new shares.
        , equityCorporEvents_shareForOther :: Maybe ShareExtraordinaryEventEnum
          -- ^ The consideration paid for the original shares following 
          --   the Merger Event consists wholly of cash/securities other 
          --   than new shares.
        , equityCorporEvents_shareForCombined :: Maybe ShareExtraordinaryEventEnum
          -- ^ The consideration paid for the original shares following 
          --   the Merger Event consists of both cash/securities and new 
          --   shares.
        }
        deriving (Eq,Show)
instance SchemaType EquityCorporateEvents where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return EquityCorporateEvents
            `apply` optional (parseSchemaType "shareForShare")
            `apply` optional (parseSchemaType "shareForOther")
            `apply` optional (parseSchemaType "shareForCombined")
    schemaTypeToXML s x@EquityCorporateEvents{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "shareForShare") $ equityCorporEvents_shareForShare x
            , maybe [] (schemaTypeToXML "shareForOther") $ equityCorporEvents_shareForOther x
            , maybe [] (schemaTypeToXML "shareForCombined") $ equityCorporEvents_shareForCombined x
            ]
 
-- | A type used to describe the amount paid for an equity 
--   option.
data EquityPremium = EquityPremium
        { equityPremium_ID :: Maybe Xsd.ID
        , equityPremium_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , equityPremium_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , equityPremium_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , equityPremium_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , equityPremium_premiumType :: Maybe PremiumTypeEnum
          -- ^ Forward start Premium type
        , equityPremium_paymentAmount :: Maybe NonNegativeMoney
          -- ^ The currency amount of the payment.
        , equityPremium_paymentDate :: Maybe AdjustableDate
          -- ^ The payment date. This date is subject to adjustment in 
          --   accordance with any applicable business day convention.
        , equityPremium_swapPremium :: Maybe Xsd.Boolean
          -- ^ Specifies whether or not the premium is to be paid in the 
          --   style of payments under an interest rate swap contract.
        , equityPremium_pricePerOption :: Maybe NonNegativeMoney
          -- ^ The amount of premium to be paid expressed as a function of 
          --   the number of options.
        , equityPremium_percentageOfNotional :: Maybe NonNegativeDecimal
          -- ^ The amount of premium to be paid expressed as a percentage 
          --   of the notional value of the transaction. A percentage of 
          --   5% would be expressed as 0.05.
        }
        deriving (Eq,Show)
instance SchemaType EquityPremium where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (EquityPremium a0)
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (parseSchemaType "premiumType")
            `apply` optional (parseSchemaType "paymentAmount")
            `apply` optional (parseSchemaType "paymentDate")
            `apply` optional (parseSchemaType "swapPremium")
            `apply` optional (parseSchemaType "pricePerOption")
            `apply` optional (parseSchemaType "percentageOfNotional")
    schemaTypeToXML s x@EquityPremium{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ equityPremium_ID x
                       ]
            [ maybe [] (schemaTypeToXML "payerPartyReference") $ equityPremium_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ equityPremium_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ equityPremium_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ equityPremium_receiverAccountReference x
            , maybe [] (schemaTypeToXML "premiumType") $ equityPremium_premiumType x
            , maybe [] (schemaTypeToXML "paymentAmount") $ equityPremium_paymentAmount x
            , maybe [] (schemaTypeToXML "paymentDate") $ equityPremium_paymentDate x
            , maybe [] (schemaTypeToXML "swapPremium") $ equityPremium_swapPremium x
            , maybe [] (schemaTypeToXML "pricePerOption") $ equityPremium_pricePerOption x
            , maybe [] (schemaTypeToXML "percentageOfNotional") $ equityPremium_percentageOfNotional x
            ]
instance Extension EquityPremium PaymentBase where
    supertype v = PaymentBase_EquityPremium v
 
-- | A type for defining the strike price for an equity option. 
--   The strike price is either: (i) in respect of an index 
--   option transaction, the level of the relevant index 
--   specified or otherwise determined in the transaction; or 
--   (ii) in respect of a share option transaction, the price 
--   per share specified or otherwise determined in the 
--   transaction. This can be expressed either as a percentage 
--   of notional amount or as an absolute value.
data EquityStrike = EquityStrike
        { equityStrike_choice0 :: (Maybe (OneOf2 Xsd.Decimal ((Maybe (Xsd.Decimal)),(Maybe (AdjustableOrRelativeDate)))))
          -- ^ Choice between:
          --   
          --   (1) The price or level at which the option has been struck.
          --   
          --   (2) Sequence of:
          --   
          --     * The price or level expressed as a percentage of the 
          --   forward starting spot price.
          --   
          --     * The date on which the strike is determined, where 
          --   this is not the effective date of a forward 
          --   starting option.
        , equityStrike_currency :: Maybe Currency
          -- ^ The currency in which an amount is denominated.
        }
        deriving (Eq,Show)
instance SchemaType EquityStrike where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return EquityStrike
            `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "strikePrice"))
                                     , ("Maybe Xsd.Decimal Maybe AdjustableOrRelativeDate", fmap TwoOf2 (return (,) `apply` optional (parseSchemaType "strikePercentage")
                                                                                                                    `apply` optional (parseSchemaType "strikeDeterminationDate")))
                                     ])
            `apply` optional (parseSchemaType "currency")
    schemaTypeToXML s x@EquityStrike{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "strikePrice")
                                    (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "strikePercentage") a
                                                       , maybe [] (schemaTypeToXML "strikeDeterminationDate") b
                                                       ])
                                   ) $ equityStrike_choice0 x
            , maybe [] (schemaTypeToXML "currency") $ equityStrike_currency x
            ]
 
-- | A type for defining how and when an equity option is to be 
--   valued.
data EquityValuation = EquityValuation
        { equityVal_ID :: Maybe Xsd.ID
        , equityVal_choice0 :: (Maybe (OneOf2 AdjustableDateOrRelativeDateSequence AdjustableRelativeOrPeriodicDates))
          -- ^ Choice between:
          --   
          --   (1) The term "Valuation Date" is assumed to have the 
          --   meaning as defined in the ISDA 2002 Equity Derivatives 
          --   Definitions.
          --   
          --   (2) Specifies the interim equity valuation dates of a swap.
        , equityVal_valuationTimeType :: Maybe TimeTypeEnum
          -- ^ The time of day at which the calculation agent values the 
          --   underlying, for example the official closing time of the 
          --   exchange.
        , equityVal_valuationTime :: Maybe BusinessCenterTime
          -- ^ The specific time of day at which the calculation agent 
          --   values the underlying.
        , equityVal_futuresPriceValuation :: Maybe Xsd.Boolean
          -- ^ The official settlement price as announced by the related 
          --   exchange is applicable, in accordance with the ISDA 2002 
          --   definitions.
        , equityVal_optionsPriceValuation :: Maybe Xsd.Boolean
          -- ^ The official settlement price as announced by the related 
          --   exchange is applicable, in accordance with the ISDA 2002 
          --   definitions.
        , equityVal_numberOfValuationDates :: Maybe Xsd.NonNegativeInteger
          -- ^ The number of valuation dates between valuation start date 
          --   and valuation end date.
        , equityVal_dividendValuationDates :: Maybe AdjustableRelativeOrPeriodicDates
          -- ^ Specifies the dividend valuation dates of the swap.
        , equityVal_fPVFinalPriceElectionFallback :: Maybe FPVFinalPriceElectionFallbackEnum
          -- ^ Specifies the fallback provisions for Hedging Party in the 
          --   determination of the Final Price.
        }
        deriving (Eq,Show)
instance SchemaType EquityValuation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (EquityValuation a0)
            `apply` optional (oneOf' [ ("AdjustableDateOrRelativeDateSequence", fmap OneOf2 (parseSchemaType "valuationDate"))
                                     , ("AdjustableRelativeOrPeriodicDates", fmap TwoOf2 (parseSchemaType "valuationDates"))
                                     ])
            `apply` optional (parseSchemaType "valuationTimeType")
            `apply` optional (parseSchemaType "valuationTime")
            `apply` optional (parseSchemaType "futuresPriceValuation")
            `apply` optional (parseSchemaType "optionsPriceValuation")
            `apply` optional (parseSchemaType "numberOfValuationDates")
            `apply` optional (parseSchemaType "dividendValuationDates")
            `apply` optional (parseSchemaType "fPVFinalPriceElectionFallback")
    schemaTypeToXML s x@EquityValuation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ equityVal_ID x
                       ]
            [ maybe [] (foldOneOf2  (schemaTypeToXML "valuationDate")
                                    (schemaTypeToXML "valuationDates")
                                   ) $ equityVal_choice0 x
            , maybe [] (schemaTypeToXML "valuationTimeType") $ equityVal_valuationTimeType x
            , maybe [] (schemaTypeToXML "valuationTime") $ equityVal_valuationTime x
            , maybe [] (schemaTypeToXML "futuresPriceValuation") $ equityVal_futuresPriceValuation x
            , maybe [] (schemaTypeToXML "optionsPriceValuation") $ equityVal_optionsPriceValuation x
            , maybe [] (schemaTypeToXML "numberOfValuationDates") $ equityVal_numberOfValuationDates x
            , maybe [] (schemaTypeToXML "dividendValuationDates") $ equityVal_dividendValuationDates x
            , maybe [] (schemaTypeToXML "fPVFinalPriceElectionFallback") $ equityVal_fPVFinalPriceElectionFallback x
            ]
 
-- | Where the underlying is shares, defines market events 
--   affecting the issuer of those shares that may require the 
--   terms of the transaction to be adjusted.
data ExtraordinaryEvents = ExtraordinaryEvents
        { extraEvents_mergerEvents :: Maybe EquityCorporateEvents
          -- ^ Occurs when the underlying ceases to exist following a 
          --   merger between the Issuer and another company.
        , extraEvents_tenderOffer :: Maybe Xsd.Boolean
          -- ^ If present and true, then tender offer is applicable.
        , extraEvents_tenderOfferEvents :: Maybe EquityCorporateEvents
          -- ^ ISDA 2002 Equity Tender Offer Events.
        , extraEvents_compositionOfCombinedConsideration :: Maybe Xsd.Boolean
          -- ^ If present and true, then composition of combined 
          --   consideration is applicable.
        , extraEvents_indexAdjustmentEvents :: Maybe IndexAdjustmentEvents
          -- ^ ISDA 2002 Equity Index Adjustment Events.
        , extraEvents_choice5 :: (Maybe (OneOf2 AdditionalDisruptionEvents Xsd.Boolean))
          -- ^ Choice between:
          --   
          --   (1) ISDA 2002 Equity Additional Disruption Events.
          --   
          --   (2) If true, failure to deliver is applicable.
        , extraEvents_representations :: Maybe Representations
          -- ^ ISDA 2002 Equity Derivative Representations.
        , extraEvents_nationalisationOrInsolvency :: Maybe NationalisationOrInsolvencyOrDelistingEventEnum
          -- ^ The terms "Nationalisation" and "Insolvency" have the 
          --   meaning as defined in the ISDA 2002 Equity Derivatives 
          --   Definitions.
        , extraEvents_delisting :: Maybe NationalisationOrInsolvencyOrDelistingEventEnum
          -- ^ The term "Delisting" has the meaning defined in the ISDA 
          --   2002 Equity Derivatives Definitions.
        , extraEvents_relatedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a related exchange. If 
          --   the element is not present then the exchange shall be the 
          --   primary exchange on which listed futures and options on the 
          --   underlying are listed. The term "Exchange" is assumed to 
          --   have the meaning as defined in the ISDA 2002 Equity 
          --   Derivatives Definitions.
        , extraEvents_optionsExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for an exchange on which the 
          --   reference option contract is listed. This is to address the 
          --   case where the reference exchange for the future is 
          --   different than the one for the option. The options Exchange 
          --   is referenced on share options when Merger Elections are 
          --   selected as Options Exchange Adjustment.
        , extraEvents_specifiedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a specified exchange. If 
          --   the element is not present then the exchange shall be 
          --   default terms as defined in the MCA; unless otherwise 
          --   specified in the Transaction Supplement.
        }
        deriving (Eq,Show)
instance SchemaType ExtraordinaryEvents where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ExtraordinaryEvents
            `apply` optional (parseSchemaType "mergerEvents")
            `apply` optional (parseSchemaType "tenderOffer")
            `apply` optional (parseSchemaType "tenderOfferEvents")
            `apply` optional (parseSchemaType "compositionOfCombinedConsideration")
            `apply` optional (parseSchemaType "indexAdjustmentEvents")
            `apply` optional (oneOf' [ ("AdditionalDisruptionEvents", fmap OneOf2 (parseSchemaType "additionalDisruptionEvents"))
                                     , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "failureToDeliver"))
                                     ])
            `apply` optional (parseSchemaType "representations")
            `apply` optional (parseSchemaType "nationalisationOrInsolvency")
            `apply` optional (parseSchemaType "delisting")
            `apply` many (parseSchemaType "relatedExchangeId")
            `apply` many (parseSchemaType "optionsExchangeId")
            `apply` many (parseSchemaType "specifiedExchangeId")
    schemaTypeToXML s x@ExtraordinaryEvents{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "mergerEvents") $ extraEvents_mergerEvents x
            , maybe [] (schemaTypeToXML "tenderOffer") $ extraEvents_tenderOffer x
            , maybe [] (schemaTypeToXML "tenderOfferEvents") $ extraEvents_tenderOfferEvents x
            , maybe [] (schemaTypeToXML "compositionOfCombinedConsideration") $ extraEvents_compositionOfCombinedConsideration x
            , maybe [] (schemaTypeToXML "indexAdjustmentEvents") $ extraEvents_indexAdjustmentEvents x
            , maybe [] (foldOneOf2  (schemaTypeToXML "additionalDisruptionEvents")
                                    (schemaTypeToXML "failureToDeliver")
                                   ) $ extraEvents_choice5 x
            , maybe [] (schemaTypeToXML "representations") $ extraEvents_representations x
            , maybe [] (schemaTypeToXML "nationalisationOrInsolvency") $ extraEvents_nationalisationOrInsolvency x
            , maybe [] (schemaTypeToXML "delisting") $ extraEvents_delisting x
            , concatMap (schemaTypeToXML "relatedExchangeId") $ extraEvents_relatedExchangeId x
            , concatMap (schemaTypeToXML "optionsExchangeId") $ extraEvents_optionsExchangeId x
            , concatMap (schemaTypeToXML "specifiedExchangeId") $ extraEvents_specifiedExchangeId x
            ]
 
-- | Reference to a floating rate calculation of interest 
--   calculation component.
data FloatingRateCalculationReference = FloatingRateCalculationReference
        { floatRateCalcRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType FloatingRateCalculationReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (FloatingRateCalculationReference a0)
    schemaTypeToXML s x@FloatingRateCalculationReference{} =
        toXMLElement s [ toXMLAttribute "href" $ floatRateCalcRef_href x
                       ]
            []
instance Extension FloatingRateCalculationReference Reference where
    supertype v = Reference_FloatingRateCalculationReference v
 
-- | Defines the specification of the consequences of Index 
--   Events as defined by the 2002 ISDA Equity Derivatives 
--   Definitions.
data IndexAdjustmentEvents = IndexAdjustmentEvents
        { indexAdjustEvents_indexModification :: Maybe IndexEventConsequenceEnum
          -- ^ Consequence of index modification.
        , indexAdjustEvents_indexCancellation :: Maybe IndexEventConsequenceEnum
          -- ^ Consequence of index cancellation.
        , indexAdjustEvents_indexDisruption :: Maybe IndexEventConsequenceEnum
          -- ^ Consequence of index disruption.
        }
        deriving (Eq,Show)
instance SchemaType IndexAdjustmentEvents where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return IndexAdjustmentEvents
            `apply` optional (parseSchemaType "indexModification")
            `apply` optional (parseSchemaType "indexCancellation")
            `apply` optional (parseSchemaType "indexDisruption")
    schemaTypeToXML s x@IndexAdjustmentEvents{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "indexModification") $ indexAdjustEvents_indexModification x
            , maybe [] (schemaTypeToXML "indexCancellation") $ indexAdjustEvents_indexCancellation x
            , maybe [] (schemaTypeToXML "indexDisruption") $ indexAdjustEvents_indexDisruption x
            ]
 
-- | Specifies the calculation method of the interest rate leg 
--   of the return swap. Includes the floating or fixed rate 
--   calculation definitions, along with the determination of 
--   the day count fraction.
data InterestCalculation = InterestCalculation
        { interCalc_ID :: Maybe Xsd.ID
        , interCalc_choice0 :: OneOf2 FloatingRateCalculation Xsd.Decimal
          -- ^ Choice between:
          --   
          --   (1) The floating rate calculation definitions
          --   
          --   (2) The calculation period fixed rate. A per annum rate, 
          --   expressed as a decimal. A fixed rate of 5% would be 
          --   represented as 0.05.
        , interCalc_dayCountFraction :: Maybe DayCountFraction
          -- ^ The day count fraction.
        , interCalc_compounding :: Maybe Compounding
          -- ^ Defines compounding rates on the Interest Leg.
        , interCalc_interpolationMethod :: Maybe InterpolationMethod
          -- ^ Specifies the type of interpolation used.
        , interCalc_interpolationPeriod :: Maybe InterpolationPeriodEnum
          -- ^ Defines applicable periods for interpolation.
        }
        deriving (Eq,Show)
instance SchemaType InterestCalculation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (InterestCalculation a0)
            `apply` oneOf' [ ("FloatingRateCalculation", fmap OneOf2 (parseSchemaType "floatingRateCalculation"))
                           , ("Xsd.Decimal", fmap TwoOf2 (parseSchemaType "fixedRate"))
                           ]
            `apply` optional (parseSchemaType "dayCountFraction")
            `apply` optional (parseSchemaType "compounding")
            `apply` optional (parseSchemaType "interpolationMethod")
            `apply` optional (parseSchemaType "interpolationPeriod")
    schemaTypeToXML s x@InterestCalculation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ interCalc_ID x
                       ]
            [ foldOneOf2  (schemaTypeToXML "floatingRateCalculation")
                          (schemaTypeToXML "fixedRate")
                          $ interCalc_choice0 x
            , maybe [] (schemaTypeToXML "dayCountFraction") $ interCalc_dayCountFraction x
            , maybe [] (schemaTypeToXML "compounding") $ interCalc_compounding x
            , maybe [] (schemaTypeToXML "interpolationMethod") $ interCalc_interpolationMethod x
            , maybe [] (schemaTypeToXML "interpolationPeriod") $ interCalc_interpolationPeriod x
            ]
instance Extension InterestCalculation InterestAccrualsMethod where
    supertype (InterestCalculation a0 e0 e1 e2 e3 e4) =
               InterestAccrualsMethod e0
 
-- | A type describing the fixed income leg of the equity swap.
data InterestLeg = InterestLeg
        { interestLeg_ID :: Maybe Xsd.ID
        , interestLeg_legIdentifier :: [LegIdentifier]
          -- ^ Version aware identification of this leg.
        , interestLeg_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , interestLeg_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , interestLeg_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , interestLeg_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , interestLeg_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.
        , interestLeg_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.
        , interestLeg_calculationPeriodDates :: Maybe InterestLegCalculationPeriodDates
          -- ^ Component that holds the various dates used to specify the 
          --   interest leg of the equity swap. It is used to define the 
          --   InterestPeriodDates identifyer.
        , interestLeg_notional :: Maybe ReturnSwapNotional
          -- ^ Specifies the notional of a return type swap. When used in 
          --   the equity leg, the definition will typically combine the 
          --   actual amount (using the notional component defined by the 
          --   FpML industry group) and the determination method. When 
          --   used in the interest leg, the definition will typically 
          --   point to the definition of the equity leg.
        , interestLeg_interestAmount :: Maybe LegAmount
          -- ^ Specifies, in relation to each Interest Payment Date, the 
          --   amount to which the Interest Payment Date relates. Unless 
          --   otherwise specified, this term has the meaning defined in 
          --   the ISDA 2000 ISDA Definitions.
        , interestLeg_interestCalculation :: InterestCalculation
          -- ^ Specifies the calculation method of the interest rate leg 
          --   of the equity swap. Includes the floating or fixed rate 
          --   calculation definitions, along with the determination of 
          --   the day count fraction.
        , interestLeg_stubCalculationPeriod :: Maybe StubCalculationPeriod
          -- ^ Specifies the stub calculation period.
        }
        deriving (Eq,Show)
instance SchemaType InterestLeg where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (InterestLeg 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 "interestLegCalculationPeriodDates")
            `apply` optional (parseSchemaType "notional")
            `apply` optional (parseSchemaType "interestAmount")
            `apply` parseSchemaType "interestCalculation"
            `apply` optional (parseSchemaType "stubCalculationPeriod")
    schemaTypeToXML s x@InterestLeg{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ interestLeg_ID x
                       ]
            [ concatMap (schemaTypeToXML "legIdentifier") $ interestLeg_legIdentifier x
            , maybe [] (schemaTypeToXML "payerPartyReference") $ interestLeg_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ interestLeg_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ interestLeg_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ interestLeg_receiverAccountReference x
            , maybe [] (schemaTypeToXML "effectiveDate") $ interestLeg_effectiveDate x
            , maybe [] (schemaTypeToXML "terminationDate") $ interestLeg_terminationDate x
            , maybe [] (schemaTypeToXML "interestLegCalculationPeriodDates") $ interestLeg_calculationPeriodDates x
            , maybe [] (schemaTypeToXML "notional") $ interestLeg_notional x
            , maybe [] (schemaTypeToXML "interestAmount") $ interestLeg_interestAmount x
            , schemaTypeToXML "interestCalculation" $ interestLeg_interestCalculation x
            , maybe [] (schemaTypeToXML "stubCalculationPeriod") $ interestLeg_stubCalculationPeriod x
            ]
instance Extension InterestLeg DirectionalLeg where
    supertype v = DirectionalLeg_InterestLeg v
instance Extension InterestLeg Leg where
    supertype = (supertype :: DirectionalLeg -> Leg)
              . (supertype :: InterestLeg -> DirectionalLeg)
              
 
-- | Component that holds the various dates used to specify the 
--   interest leg of the return swap. It is used to define the 
--   InterestPeriodDates identifyer.
data InterestLegCalculationPeriodDates = InterestLegCalculationPeriodDates
        { interLegCalcPeriodDates_ID :: Xsd.ID
        , interLegCalcPeriodDates_effectiveDate :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the effective date of the return swap. This 
          --   global element is valid within the return swaps namespace. 
          --   Within the FpML namespace, another effectiveDate global 
          --   element has been defined, that is different in the sense 
          --   that it does not propose the choice of refering to another 
          --   date in the document.
        , interLegCalcPeriodDates_terminationDate :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the termination date of the return swap. This 
          --   global element is valid within the return swaps namespace. 
          --   Within the FpML namespace, another terminationDate global 
          --   element has been defined, that is different in the sense 
          --   that it does not propose the choice of refering to another 
          --   date in the document.
        , interLegCalcPeriodDates_interestLegResetDates :: Maybe InterestLegResetDates
          -- ^ Specifies the reset dates of the interest leg of the swap.
        , interLegCalcPeriodDates_interestLegPaymentDates :: Maybe AdjustableRelativeOrPeriodicDates2
          -- ^ Specifies the payment dates of the interest leg of the 
          --   swap. When defined in relation to a date specified 
          --   somewhere else in the document (through the relativeDates 
          --   component), this element will typically point to the 
          --   payment dates of the equity leg of the swap.
        }
        deriving (Eq,Show)
instance SchemaType InterestLegCalculationPeriodDates where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "id" e pos
        commit $ interior e $ return (InterestLegCalculationPeriodDates a0)
            `apply` optional (parseSchemaType "effectiveDate")
            `apply` optional (parseSchemaType "terminationDate")
            `apply` optional (parseSchemaType "interestLegResetDates")
            `apply` optional (parseSchemaType "interestLegPaymentDates")
    schemaTypeToXML s x@InterestLegCalculationPeriodDates{} =
        toXMLElement s [ toXMLAttribute "id" $ interLegCalcPeriodDates_ID x
                       ]
            [ maybe [] (schemaTypeToXML "effectiveDate") $ interLegCalcPeriodDates_effectiveDate x
            , maybe [] (schemaTypeToXML "terminationDate") $ interLegCalcPeriodDates_terminationDate x
            , maybe [] (schemaTypeToXML "interestLegResetDates") $ interLegCalcPeriodDates_interestLegResetDates x
            , maybe [] (schemaTypeToXML "interestLegPaymentDates") $ interLegCalcPeriodDates_interestLegPaymentDates x
            ]
 
-- | Reference to the calculation period dates of the interest 
--   leg.
data InterestLegCalculationPeriodDatesReference = InterestLegCalculationPeriodDatesReference
        { ilcpdr_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType InterestLegCalculationPeriodDatesReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (InterestLegCalculationPeriodDatesReference a0)
    schemaTypeToXML s x@InterestLegCalculationPeriodDatesReference{} =
        toXMLElement s [ toXMLAttribute "href" $ ilcpdr_href x
                       ]
            []
instance Extension InterestLegCalculationPeriodDatesReference Reference where
    supertype v = Reference_InterestLegCalculationPeriodDatesReference v
 
data InterestLegResetDates = InterestLegResetDates
        { interLegResetDates_calculationPeriodDatesReference :: Maybe InterestLegCalculationPeriodDatesReference
          -- ^ A pointer style reference to the associated calculation 
          --   period dates component defined elsewhere in the document.
        , interLegResetDates_choice1 :: (Maybe (OneOf2 ResetRelativeToEnum ResetFrequency))
          -- ^ Choice between:
          --   
          --   (1) Specifies whether the reset dates are determined with 
          --   respect to each adjusted calculation period start date 
          --   or adjusted calculation period end date. If the reset 
          --   frequency is specified as daily this element must not 
          --   be included.
          --   
          --   (2) The frequency at which reset dates occur. In the case 
          --   of a weekly reset frequency, also specifies the day of 
          --   the week that the reset occurs. If the reset frequency 
          --   is greater than the calculation period frequency then 
          --   this implies that more than one reset date is 
          --   established for each calculation period and some form 
          --   of rate averaging is applicable.
        , interLegResetDates_initialFixingDate :: Maybe RelativeDateOffset
          -- ^ Initial fixing date expressed as an offset to another date 
          --   defined elsewhere in the document.
        , interLegResetDates_fixingDates :: Maybe AdjustableDatesOrRelativeDateOffset
          -- ^ Specifies the fixing date relative to the reset date in 
          --   terms of a business days offset, or by providing a series 
          --   of adjustable dates.
        }
        deriving (Eq,Show)
instance SchemaType InterestLegResetDates where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return InterestLegResetDates
            `apply` optional (parseSchemaType "calculationPeriodDatesReference")
            `apply` optional (oneOf' [ ("ResetRelativeToEnum", fmap OneOf2 (parseSchemaType "resetRelativeTo"))
                                     , ("ResetFrequency", fmap TwoOf2 (parseSchemaType "resetFrequency"))
                                     ])
            `apply` optional (parseSchemaType "initialFixingDate")
            `apply` optional (parseSchemaType "fixingDates")
    schemaTypeToXML s x@InterestLegResetDates{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "calculationPeriodDatesReference") $ interLegResetDates_calculationPeriodDatesReference x
            , maybe [] (foldOneOf2  (schemaTypeToXML "resetRelativeTo")
                                    (schemaTypeToXML "resetFrequency")
                                   ) $ interLegResetDates_choice1 x
            , maybe [] (schemaTypeToXML "initialFixingDate") $ interLegResetDates_initialFixingDate x
            , maybe [] (schemaTypeToXML "fixingDates") $ interLegResetDates_fixingDates x
            ]
 
-- | A type describing the amount that will paid or received on 
--   each of the payment dates. This type is used to define both 
--   the Equity Amount and the Interest Amount.
data LegAmount = LegAmount
        { legAmount_choice0 :: (Maybe (OneOf3 IdentifiedCurrency DeterminationMethod IdentifiedCurrencyReference))
          -- ^ Choice between:
          --   
          --   (1) The currency in which an amount is denominated.
          --   
          --   (2) Specifies the method according to which an amount or a 
          --   date is determined.
          --   
          --   (3) Reference to a currency defined elsewhere in the 
          --   document
        , legAmount_choice1 :: (Maybe (OneOf3 ReferenceAmount Formula Xsd.Base64Binary))
          -- ^ Choice between:
          --   
          --   (1) Specifies the reference Amount when this term either 
          --   corresponds to the standard ISDA Definition (either the 
          --   2002 Equity Definition for the Equity Amount, or the 
          --   2000 Definition for the Interest Amount), or points to 
          --   a term defined elsewhere in the swap document.
          --   
          --   (2) Specifies a formula, with its description and 
          --   components.
          --   
          --   (3) Description of the leg amount when represented through 
          --   an encoded image.
        , legAmount_calculationDates :: Maybe AdjustableRelativeOrPeriodicDates
          -- ^ Specifies the date on which a calculation or an observation 
          --   will be performed for the purpose of defining the Equity 
          --   Amount, and in accordance to the definition terms of this 
          --   latter.
        }
        deriving (Eq,Show)
instance SchemaType LegAmount where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return LegAmount
            `apply` optional (oneOf' [ ("IdentifiedCurrency", fmap OneOf3 (parseSchemaType "currency"))
                                     , ("DeterminationMethod", fmap TwoOf3 (parseSchemaType "determinationMethod"))
                                     , ("IdentifiedCurrencyReference", fmap ThreeOf3 (parseSchemaType "currencyReference"))
                                     ])
            `apply` optional (oneOf' [ ("ReferenceAmount", fmap OneOf3 (parseSchemaType "referenceAmount"))
                                     , ("Formula", fmap TwoOf3 (parseSchemaType "formula"))
                                     , ("Xsd.Base64Binary", fmap ThreeOf3 (parseSchemaType "encodedDescription"))
                                     ])
            `apply` optional (parseSchemaType "calculationDates")
    schemaTypeToXML s x@LegAmount{} =
        toXMLElement s []
            [ maybe [] (foldOneOf3  (schemaTypeToXML "currency")
                                    (schemaTypeToXML "determinationMethod")
                                    (schemaTypeToXML "currencyReference")
                                   ) $ legAmount_choice0 x
            , maybe [] (foldOneOf3  (schemaTypeToXML "referenceAmount")
                                    (schemaTypeToXML "formula")
                                    (schemaTypeToXML "encodedDescription")
                                   ) $ legAmount_choice1 x
            , maybe [] (schemaTypeToXML "calculationDates") $ legAmount_calculationDates x
            ]
 
-- | Leg identity.
data LegId = LegId Token60 LegIdAttributes deriving (Eq,Show)
data LegIdAttributes = LegIdAttributes
    { legIdAttrib_legIdScheme :: Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType LegId where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- getAttribute "legIdScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ LegId v (LegIdAttributes a0)
    schemaTypeToXML s (LegId bt at) =
        addXMLAttributes [ toXMLAttribute "legIdScheme" $ legIdAttrib_legIdScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension LegId Token60 where
    supertype (LegId s _) = s
 
-- | Version aware identification of a leg.
data LegIdentifier = LegIdentifier
        { legIdent_legId :: Maybe LegId
          -- ^ Identity of this leg.
        , legIdent_version :: Maybe Xsd.NonNegativeInteger
          -- ^ The version number
        , legIdent_effectiveDate :: Maybe IdentifiedDate
          -- ^ Optionally it is possible to specify a version effective 
          --   date when a versionId is supplied.
        }
        deriving (Eq,Show)
instance SchemaType LegIdentifier where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return LegIdentifier
            `apply` optional (parseSchemaType "legId")
            `apply` optional (parseSchemaType "version")
            `apply` optional (parseSchemaType "effectiveDate")
    schemaTypeToXML s x@LegIdentifier{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "legId") $ legIdent_legId x
            , maybe [] (schemaTypeToXML "version") $ legIdent_version x
            , maybe [] (schemaTypeToXML "effectiveDate") $ legIdent_effectiveDate x
            ]
 
-- | A type to hold early exercise provisions.
data MakeWholeProvisions = MakeWholeProvisions
        { makeWholeProvis_makeWholeDate :: Maybe Xsd.Date
          -- ^ Date through which option can not be exercised without 
          --   penalty.
        , makeWholeProvis_recallSpread :: Maybe Xsd.Decimal
          -- ^ Spread used if exercised before make whole date. Early 
          --   termination penalty. Expressed in bp, e.g. 25 bp.
        }
        deriving (Eq,Show)
instance SchemaType MakeWholeProvisions where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return MakeWholeProvisions
            `apply` optional (parseSchemaType "makeWholeDate")
            `apply` optional (parseSchemaType "recallSpread")
    schemaTypeToXML s x@MakeWholeProvisions{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "makeWholeDate") $ makeWholeProvis_makeWholeDate x
            , maybe [] (schemaTypeToXML "recallSpread") $ makeWholeProvis_recallSpread x
            ]
 
-- | An abstract base class for all swap types which have a 
--   single netted leg, such as Variance Swaps, and Correlation 
--   Swaps.
data NettedSwapBase
        = NettedSwapBase_CorrelationSwap CorrelationSwap
        | NettedSwapBase_VarianceSwap VarianceSwap
        
        deriving (Eq,Show)
instance SchemaType NettedSwapBase where
    parseSchemaType s = do
        (fmap NettedSwapBase_CorrelationSwap $ parseSchemaType s)
        `onFail`
        (fmap NettedSwapBase_VarianceSwap $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of NettedSwapBase,\n\
\  namely one of:\n\
\CorrelationSwap,VarianceSwap"
    schemaTypeToXML _s (NettedSwapBase_CorrelationSwap x) = schemaTypeToXML "correlationSwap" x
    schemaTypeToXML _s (NettedSwapBase_VarianceSwap x) = schemaTypeToXML "varianceSwap" x
instance Extension NettedSwapBase Product where
    supertype v = Product_NettedSwapBase v
 
-- | A type for defining option features.
data OptionFeatures = OptionFeatures
        { optionFeatur_asian :: Maybe Asian
          -- ^ An option where and average price is taken on valuation.
        , optionFeatur_barrier :: Maybe Barrier
          -- ^ An option with a barrier feature.
        , optionFeatur_knock :: Maybe Knock
          -- ^ A knock feature.
        , optionFeatur_passThrough :: Maybe PassThrough
          -- ^ Pass through payments from the underlyer, such as 
          --   dividends.
        , optionFeatur_dividendAdjustment :: Maybe DividendAdjustment
          -- ^ Dividend adjustment of the contract is driven by the 
          --   difference between the Expected Dividend, and the Actual 
          --   Dividend, which is multiplied by an agreed Factor to 
          --   produce a Deviation, which is used as the basis for 
          --   adjusting the contract. The parties acknowledge that in 
          --   determining the Call Strike Price of the Transaction the 
          --   parties have assumed that the Dividend scheduled to be paid 
          --   by the Issuer to holders of record of the Shares, in the 
          --   period set out in Column headed Relevant Period will equal 
          --   per Share the amount stated in respect of such Relevant 
          --   Period.
        }
        deriving (Eq,Show)
instance SchemaType OptionFeatures where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return OptionFeatures
            `apply` optional (parseSchemaType "asian")
            `apply` optional (parseSchemaType "barrier")
            `apply` optional (parseSchemaType "knock")
            `apply` optional (parseSchemaType "passThrough")
            `apply` optional (parseSchemaType "dividendAdjustment")
    schemaTypeToXML s x@OptionFeatures{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "asian") $ optionFeatur_asian x
            , maybe [] (schemaTypeToXML "barrier") $ optionFeatur_barrier x
            , maybe [] (schemaTypeToXML "knock") $ optionFeatur_knock x
            , maybe [] (schemaTypeToXML "passThrough") $ optionFeatur_passThrough x
            , maybe [] (schemaTypeToXML "dividendAdjustment") $ optionFeatur_dividendAdjustment x
            ]
 
-- | Specifies the principal exchange amount, either by 
--   explicitly defining it, or by point to an amount defined 
--   somewhere else in the swap document.
data PrincipalExchangeAmount = PrincipalExchangeAmount
        { princExchAmount_choice0 :: (Maybe (OneOf3 AmountReference DeterminationMethod NonNegativeMoney))
          -- ^ Choice between:
          --   
          --   (1) Reference to an amount defined elsewhere in the 
          --   document.
          --   
          --   (2) Specifies the method according to which an amount or a 
          --   date is determined.
          --   
          --   (3) Principal exchange amount when explictly stated.
        }
        deriving (Eq,Show)
instance SchemaType PrincipalExchangeAmount where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PrincipalExchangeAmount
            `apply` optional (oneOf' [ ("AmountReference", fmap OneOf3 (parseSchemaType "amountRelativeTo"))
                                     , ("DeterminationMethod", fmap TwoOf3 (parseSchemaType "determinationMethod"))
                                     , ("NonNegativeMoney", fmap ThreeOf3 (parseSchemaType "principalAmount"))
                                     ])
    schemaTypeToXML s x@PrincipalExchangeAmount{} =
        toXMLElement s []
            [ maybe [] (foldOneOf3  (schemaTypeToXML "amountRelativeTo")
                                    (schemaTypeToXML "determinationMethod")
                                    (schemaTypeToXML "principalAmount")
                                   ) $ princExchAmount_choice0 x
            ]
 
-- | Specifies each of the characteristics of the principal 
--   exchange cashflows, in terms of paying/receiving 
--   counterparties, amounts and dates.
data PrincipalExchangeDescriptions = PrincipalExchangeDescriptions
        { princExchDescr_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , princExchDescr_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , princExchDescr_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , princExchDescr_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , princExchDescr_principalExchangeAmount :: Maybe PrincipalExchangeAmount
          -- ^ Specifies the principal echange amount, either by 
          --   explicitly defining it, or by point to an amount defined 
          --   somewhere else in the swap document.
        , princExchDescr_principalExchangeDate :: Maybe AdjustableOrRelativeDate
          -- ^ Date on which each of the principal exchanges will take 
          --   place. This date is either explictly stated, or is defined 
          --   by reference to another date in the swap document. In this 
          --   latter case, it will typically refer to one other date of 
          --   the equity leg: either the effective date (initial 
          --   exchange), or the last payment date (final exchange).
        }
        deriving (Eq,Show)
instance SchemaType PrincipalExchangeDescriptions where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PrincipalExchangeDescriptions
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (parseSchemaType "principalExchangeAmount")
            `apply` optional (parseSchemaType "principalExchangeDate")
    schemaTypeToXML s x@PrincipalExchangeDescriptions{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "payerPartyReference") $ princExchDescr_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ princExchDescr_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ princExchDescr_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ princExchDescr_receiverAccountReference x
            , maybe [] (schemaTypeToXML "principalExchangeAmount") $ princExchDescr_principalExchangeAmount x
            , maybe [] (schemaTypeToXML "principalExchangeDate") $ princExchDescr_principalExchangeDate x
            ]
 
-- | A type describing the principal exchange features of the 
--   return swap.
data PrincipalExchangeFeatures = PrincipalExchangeFeatures
        { princExchFeatur_principalExchanges :: Maybe PrincipalExchanges
          -- ^ The true/false flags indicating whether initial, 
          --   intermediate or final exchanges of principal should occur.
        , princExchFeatur_principalExchangeDescriptions :: [PrincipalExchangeDescriptions]
          -- ^ Specifies each of the characteristics of the principal 
          --   exchange cashflows, in terms of paying/receiving 
          --   counterparties, amounts and dates.
        }
        deriving (Eq,Show)
instance SchemaType PrincipalExchangeFeatures where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PrincipalExchangeFeatures
            `apply` optional (parseSchemaType "principalExchanges")
            `apply` many (parseSchemaType "principalExchangeDescriptions")
    schemaTypeToXML s x@PrincipalExchangeFeatures{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "principalExchanges") $ princExchFeatur_principalExchanges x
            , concatMap (schemaTypeToXML "principalExchangeDescriptions") $ princExchFeatur_principalExchangeDescriptions x
            ]
 
-- | A type for defining ISDA 2002 Equity Derivative 
--   Representations.
data Representations = Representations
        { repres_nonReliance :: Maybe Xsd.Boolean
          -- ^ If true, then non reliance is applicable.
        , repres_agreementsRegardingHedging :: Maybe Xsd.Boolean
          -- ^ If true, then agreements regarding hedging are applicable.
        , repres_indexDisclaimer :: Maybe Xsd.Boolean
          -- ^ If present and true, then index disclaimer is applicable.
        , repres_additionalAcknowledgements :: Maybe Xsd.Boolean
          -- ^ If true, then additional acknowledgements are applicable.
        }
        deriving (Eq,Show)
instance SchemaType Representations where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Representations
            `apply` optional (parseSchemaType "nonReliance")
            `apply` optional (parseSchemaType "agreementsRegardingHedging")
            `apply` optional (parseSchemaType "indexDisclaimer")
            `apply` optional (parseSchemaType "additionalAcknowledgements")
    schemaTypeToXML s x@Representations{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "nonReliance") $ repres_nonReliance x
            , maybe [] (schemaTypeToXML "agreementsRegardingHedging") $ repres_agreementsRegardingHedging x
            , maybe [] (schemaTypeToXML "indexDisclaimer") $ repres_indexDisclaimer x
            , maybe [] (schemaTypeToXML "additionalAcknowledgements") $ repres_additionalAcknowledgements x
            ]
 
-- | A type describing the dividend return conditions applicable 
--   to the swap.
data Return = Return
        { return_type :: ReturnTypeEnum
          -- ^ Defines the type of return associated with the return swap.
        , return_dividendConditions :: Maybe DividendConditions
          -- ^ Specifies the conditions governing the payment of the 
          --   dividends to the receiver of the equity return. With the 
          --   exception of the dividend payout ratio, which is defined 
          --   for each of the underlying components.
        }
        deriving (Eq,Show)
instance SchemaType Return where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Return
            `apply` parseSchemaType "returnType"
            `apply` optional (parseSchemaType "dividendConditions")
    schemaTypeToXML s x@Return{} =
        toXMLElement s []
            [ schemaTypeToXML "returnType" $ return_type x
            , maybe [] (schemaTypeToXML "dividendConditions") $ return_dividendConditions x
            ]
 
-- | A type describing the return leg of a return type swap.
data ReturnLeg = ReturnLeg
        { returnLeg_ID :: Maybe Xsd.ID
        , returnLeg_legIdentifier :: [LegIdentifier]
          -- ^ Version aware identification of this leg.
        , returnLeg_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , returnLeg_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , returnLeg_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , returnLeg_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , returnLeg_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.
        , returnLeg_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.
        , returnLeg_strikeDate :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the strike date of this leg of the swap, used for 
          --   forward starting swaps. When defined in relation to a date 
          --   specified somewhere else in the document (through the 
          --   relativeDate component), this element will typically by 
          --   relative to the trade date of the swap.
        , returnLeg_underlyer :: Underlyer
          -- ^ Specifies the underlying component of the leg, which can be 
          --   either one or many and consists in either equity, index or 
          --   convertible bond component, or a combination of these.
        , returnLeg_rateOfReturn :: ReturnLegValuation
          -- ^ Specifies the terms of the initial price of the return type 
          --   swap and of the subsequent valuations of the underlyer.
        , returnLeg_notional :: Maybe ReturnSwapNotional
          -- ^ Specifies the notional of a return type swap. When used in 
          --   the equity leg, the definition will typically combine the 
          --   actual amount (using the notional component defined by the 
          --   FpML industry group) and the determination method. When 
          --   used in the interest leg, the definition will typically 
          --   point to the definition of the equity leg.
        , returnLeg_amount :: ReturnSwapAmount
          -- ^ Specifies, in relation to each Payment Date, the amount to 
          --   which the Payment Date relates. For return swaps this 
          --   element is equivalent to the Equity Amount term as defined 
          --   in the ISDA 2002 Equity Derivatives Definitions.
        , returnLeg_return :: Maybe Return
          -- ^ Specifies the conditions under which dividend affecting the 
          --   underlyer will be paid to the receiver of the amounts.
        , returnLeg_notionalAdjustments :: Maybe NotionalAdjustmentEnum
          -- ^ Specifies the conditions that govern the adjustment to the 
          --   number of units of the return swap.
        , returnLeg_fxFeature :: Maybe FxFeature
          -- ^ A quanto or composite FX feature.
        , returnLeg_averagingDates :: Maybe AveragingPeriod
          -- ^ Averaging Dates used in the swap.
        }
        deriving (Eq,Show)
instance SchemaType ReturnLeg where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ReturnLeg 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 "strikeDate")
            `apply` parseSchemaType "underlyer"
            `apply` parseSchemaType "rateOfReturn"
            `apply` optional (parseSchemaType "notional")
            `apply` parseSchemaType "amount"
            `apply` optional (parseSchemaType "return")
            `apply` optional (parseSchemaType "notionalAdjustments")
            `apply` optional (parseSchemaType "fxFeature")
            `apply` optional (parseSchemaType "averagingDates")
    schemaTypeToXML s x@ReturnLeg{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ returnLeg_ID x
                       ]
            [ concatMap (schemaTypeToXML "legIdentifier") $ returnLeg_legIdentifier x
            , maybe [] (schemaTypeToXML "payerPartyReference") $ returnLeg_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ returnLeg_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ returnLeg_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ returnLeg_receiverAccountReference x
            , maybe [] (schemaTypeToXML "effectiveDate") $ returnLeg_effectiveDate x
            , maybe [] (schemaTypeToXML "terminationDate") $ returnLeg_terminationDate x
            , maybe [] (schemaTypeToXML "strikeDate") $ returnLeg_strikeDate x
            , schemaTypeToXML "underlyer" $ returnLeg_underlyer x
            , schemaTypeToXML "rateOfReturn" $ returnLeg_rateOfReturn x
            , maybe [] (schemaTypeToXML "notional") $ returnLeg_notional x
            , schemaTypeToXML "amount" $ returnLeg_amount x
            , maybe [] (schemaTypeToXML "return") $ returnLeg_return x
            , maybe [] (schemaTypeToXML "notionalAdjustments") $ returnLeg_notionalAdjustments x
            , maybe [] (schemaTypeToXML "fxFeature") $ returnLeg_fxFeature x
            , maybe [] (schemaTypeToXML "averagingDates") $ returnLeg_averagingDates x
            ]
instance Extension ReturnLeg ReturnSwapLegUnderlyer where
    supertype v = ReturnSwapLegUnderlyer_ReturnLeg v
instance Extension ReturnLeg DirectionalLeg where
    supertype = (supertype :: ReturnSwapLegUnderlyer -> DirectionalLeg)
              . (supertype :: ReturnLeg -> ReturnSwapLegUnderlyer)
              
instance Extension ReturnLeg Leg where
    supertype = (supertype :: DirectionalLeg -> Leg)
              . (supertype :: ReturnSwapLegUnderlyer -> DirectionalLeg)
              . (supertype :: ReturnLeg -> ReturnSwapLegUnderlyer)
              
 
-- | A type describing the initial and final valuation of the 
--   underlyer.
data ReturnLegValuation = ReturnLegValuation
        { returnLegVal_initialPrice :: Maybe ReturnLegValuationPrice
          -- ^ Specifies the initial reference price of the underlyer. 
          --   This price can be expressed either as an actual 
          --   amount/currency, as a determination method, or by reference 
          --   to another value specified in the swap document.
        , returnLegVal_notionalReset :: Maybe Xsd.Boolean
          -- ^ For return swaps, this element is equivalent to the term 
          --   "Equity Notional Reset" as defined in the ISDA 2002 Equity 
          --   Derivatives Definitions. The reference to the ISDA 
          --   definition is either "Applicable" or 'Inapplicable".
        , returnLegVal_valuationPriceInterim :: Maybe ReturnLegValuationPrice
          -- ^ Specifies the final valuation price of the underlyer. This 
          --   price can be expressed either as an actual amount/currency, 
          --   as a determination method, or by reference to another value 
          --   specified in the swap document.
        , returnLegVal_valuationPriceFinal :: Maybe ReturnLegValuationPrice
          -- ^ Specifies the final valuation price of the underlyer. This 
          --   price can be expressed either as an actual amount/currency, 
          --   as a determination method, or by reference to another value 
          --   specified in the swap document.
        , returnLegVal_paymentDates :: Maybe ReturnSwapPaymentDates
          -- ^ Specifies the payment dates of the swap.
        , returnLegVal_exchangeTradedContractNearest :: Maybe ExchangeTradedContract
          -- ^ References a Contract on the Exchange.
        }
        deriving (Eq,Show)
instance SchemaType ReturnLegValuation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReturnLegValuation
            `apply` optional (parseSchemaType "initialPrice")
            `apply` optional (parseSchemaType "notionalReset")
            `apply` optional (parseSchemaType "valuationPriceInterim")
            `apply` optional (parseSchemaType "valuationPriceFinal")
            `apply` optional (parseSchemaType "paymentDates")
            `apply` optional (parseSchemaType "exchangeTradedContractNearest")
    schemaTypeToXML s x@ReturnLegValuation{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "initialPrice") $ returnLegVal_initialPrice x
            , maybe [] (schemaTypeToXML "notionalReset") $ returnLegVal_notionalReset x
            , maybe [] (schemaTypeToXML "valuationPriceInterim") $ returnLegVal_valuationPriceInterim x
            , maybe [] (schemaTypeToXML "valuationPriceFinal") $ returnLegVal_valuationPriceFinal x
            , maybe [] (schemaTypeToXML "paymentDates") $ returnLegVal_paymentDates x
            , maybe [] (schemaTypeToXML "exchangeTradedContractNearest") $ returnLegVal_exchangeTradedContractNearest x
            ]
 
data ReturnLegValuationPrice = ReturnLegValuationPrice
        { returnLegValPrice_commission :: Maybe Commission
          -- ^ This optional component specifies the commission to be 
          --   charged for executing the hedge transactions.
        , returnLegValPrice_choice1 :: OneOf3 (DeterminationMethod,(Maybe (ActualPrice)),(Maybe (ActualPrice)),(Maybe (Xsd.Decimal)),(Maybe (FxConversion))) AmountReference ((Maybe (ActualPrice)),(Maybe (ActualPrice)),(Maybe (Xsd.Decimal)),(Maybe (FxConversion)))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * Specifies the method according to which an amount 
          --   or a date is determined.
          --   
          --     * Specifies the price of the underlyer, before 
          --   commissions.
          --   
          --     * Specifies the price of the underlyer, net of 
          --   commissions.
          --   
          --     * Specifies the accrued interest that are part of the 
          --   dirty price in the case of a fixed income security 
          --   or a convertible bond. Expressed in percentage of 
          --   the notional.
          --   
          --     * Specifies the currency conversion rate that applies 
          --   to an amount. This rate can either be defined 
          --   elsewhere in the document (case of a quanto swap), 
          --   or explicitly described through this component.
          --   
          --   (2) The href attribute value will be a pointer style 
          --   reference to the element or component elsewhere in the 
          --   document where the anchor amount is defined.
          --   
          --   (3) Sequence of:
          --   
          --     * Specifies the price of the underlyer, before 
          --   commissions.
          --   
          --     * Specifies the price of the underlyer, net of 
          --   commissions.
          --   
          --     * Specifies the accrued interest that are part of the 
          --   dirty price in the case of a fixed income security 
          --   or a convertible bond. Expressed in percentage of 
          --   the notional.
          --   
          --     * Specifies the currency conversion rate that applies 
          --   to an amount. This rate can either be defined 
          --   elsewhere in the document (case of a quanto swap), 
          --   or explicitly described through this component.
        , returnLegValPrice_cleanNetPrice :: Maybe Xsd.Decimal
          -- ^ The net price excluding accrued interest. The "Dirty Price" 
          --   for bonds is put in the "netPrice" element, which includes 
          --   accrued interest. Thus netPrice - cleanNetPrice = 
          --   accruedInterest. The currency and price expression for this 
          --   field are the same as those for the (dirty) netPrice.
        , returnLegValPrice_quotationCharacteristics :: Maybe QuotationCharacteristics
          -- ^ Allows information about how the price was quoted to be 
          --   provided.
        , returnLegValPrice_valuationRules :: Maybe EquityValuation
          -- ^ Specifies valuation.
        }
        deriving (Eq,Show)
instance SchemaType ReturnLegValuationPrice where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReturnLegValuationPrice
            `apply` optional (parseSchemaType "commission")
            `apply` oneOf' [ ("DeterminationMethod Maybe ActualPrice Maybe ActualPrice Maybe Xsd.Decimal Maybe FxConversion", fmap OneOf3 (return (,,,,) `apply` parseSchemaType "determinationMethod"
                                                                                                                                                         `apply` optional (parseSchemaType "grossPrice")
                                                                                                                                                         `apply` optional (parseSchemaType "netPrice")
                                                                                                                                                         `apply` optional (parseSchemaType "accruedInterestPrice")
                                                                                                                                                         `apply` optional (parseSchemaType "fxConversion")))
                           , ("AmountReference", fmap TwoOf3 (parseSchemaType "amountRelativeTo"))
                           , ("Maybe ActualPrice Maybe ActualPrice Maybe Xsd.Decimal Maybe FxConversion", fmap ThreeOf3 (return (,,,) `apply` optional (parseSchemaType "grossPrice")
                                                                                                                                      `apply` optional (parseSchemaType "netPrice")
                                                                                                                                      `apply` optional (parseSchemaType "accruedInterestPrice")
                                                                                                                                      `apply` optional (parseSchemaType "fxConversion")))
                           ]
            `apply` optional (parseSchemaType "cleanNetPrice")
            `apply` optional (parseSchemaType "quotationCharacteristics")
            `apply` optional (parseSchemaType "valuationRules")
    schemaTypeToXML s x@ReturnLegValuationPrice{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "commission") $ returnLegValPrice_commission x
            , foldOneOf3  (\ (a,b,c,d,e) -> concat [ schemaTypeToXML "determinationMethod" a
                                                   , maybe [] (schemaTypeToXML "grossPrice") b
                                                   , maybe [] (schemaTypeToXML "netPrice") c
                                                   , maybe [] (schemaTypeToXML "accruedInterestPrice") d
                                                   , maybe [] (schemaTypeToXML "fxConversion") e
                                                   ])
                          (schemaTypeToXML "amountRelativeTo")
                          (\ (a,b,c,d) -> concat [ maybe [] (schemaTypeToXML "grossPrice") a
                                                 , maybe [] (schemaTypeToXML "netPrice") b
                                                 , maybe [] (schemaTypeToXML "accruedInterestPrice") c
                                                 , maybe [] (schemaTypeToXML "fxConversion") d
                                                 ])
                          $ returnLegValPrice_choice1 x
            , maybe [] (schemaTypeToXML "cleanNetPrice") $ returnLegValPrice_cleanNetPrice x
            , maybe [] (schemaTypeToXML "quotationCharacteristics") $ returnLegValPrice_quotationCharacteristics x
            , maybe [] (schemaTypeToXML "valuationRules") $ returnLegValPrice_valuationRules x
            ]
instance Extension ReturnLegValuationPrice Price where
    supertype (ReturnLegValuationPrice e0 e1 e2 e3 e4) =
               Price e0 e1 e2 e3
 
-- | A type describing return swaps including return swaps (long 
--   form), total return swaps, and variance swaps.
data ReturnSwap = ReturnSwap
        { returnSwap_ID :: Maybe Xsd.ID
        , returnSwap_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.
        , returnSwap_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , returnSwap_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , returnSwap_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.
        , returnSwap_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.
        , returnSwap_buyerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that buys this instrument.
        , returnSwap_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.
        , returnSwap_sellerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that sells this instrument.
        , returnSwap_leg :: [DirectionalLeg]
          -- ^ An placeholder for the actual Return Swap Leg definition.
        , returnSwap_principalExchangeFeatures :: Maybe PrincipalExchangeFeatures
          -- ^ This is used to document a Fully Funded Return Swap.
        , returnSwap_additionalPayment :: [ReturnSwapAdditionalPayment]
          -- ^ Specifies additional payment(s) between the principal 
          --   parties to the trade.
        , returnSwap_earlyTermination :: [ReturnSwapEarlyTermination]
          -- ^ Specifies, for one or for both the parties to the trade, 
          --   the date from which it can early terminate it.
        , returnSwap_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.
        }
        deriving (Eq,Show)
instance SchemaType ReturnSwap where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ReturnSwap 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` between (Occurs (Just 0) (Just 2))
                            (elementReturnSwapLeg)
            `apply` optional (parseSchemaType "principalExchangeFeatures")
            `apply` many (parseSchemaType "additionalPayment")
            `apply` many (parseSchemaType "earlyTermination")
            `apply` optional (parseSchemaType "extraordinaryEvents")
    schemaTypeToXML s x@ReturnSwap{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ returnSwap_ID x
                       ]
            [ maybe [] (schemaTypeToXML "primaryAssetClass") $ returnSwap_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ returnSwap_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ returnSwap_productType x
            , concatMap (schemaTypeToXML "productId") $ returnSwap_productId x
            , maybe [] (schemaTypeToXML "buyerPartyReference") $ returnSwap_buyerPartyReference x
            , maybe [] (schemaTypeToXML "buyerAccountReference") $ returnSwap_buyerAccountReference x
            , maybe [] (schemaTypeToXML "sellerPartyReference") $ returnSwap_sellerPartyReference x
            , maybe [] (schemaTypeToXML "sellerAccountReference") $ returnSwap_sellerAccountReference x
            , concatMap (elementToXMLReturnSwapLeg) $ returnSwap_leg x
            , maybe [] (schemaTypeToXML "principalExchangeFeatures") $ returnSwap_principalExchangeFeatures x
            , concatMap (schemaTypeToXML "additionalPayment") $ returnSwap_additionalPayment x
            , concatMap (schemaTypeToXML "earlyTermination") $ returnSwap_earlyTermination x
            , maybe [] (schemaTypeToXML "extraordinaryEvents") $ returnSwap_extraordinaryEvents x
            ]
instance Extension ReturnSwap ReturnSwapBase where
    supertype v = ReturnSwapBase_ReturnSwap v
instance Extension ReturnSwap Product where
    supertype = (supertype :: ReturnSwapBase -> Product)
              . (supertype :: ReturnSwap -> ReturnSwapBase)
              
 
-- | A type describing the additional payment(s) between the 
--   principal parties to the trade. This component extends some 
--   of the features of the additionalPayment component 
--   previously developed in FpML. Appropriate discussions will 
--   determine whether it would be appropriate to extend the 
--   shared component in order to meet the further requirements 
--   of equity swaps.
data ReturnSwapAdditionalPayment = ReturnSwapAdditionalPayment
        { returnSwapAddPayment_ID :: Maybe Xsd.ID
        , returnSwapAddPayment_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , returnSwapAddPayment_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , returnSwapAddPayment_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , returnSwapAddPayment_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , returnSwapAddPayment_additionalPaymentAmount :: Maybe AdditionalPaymentAmount
          -- ^ Specifies the amount of the fee along with, when 
          --   applicable, the formula that supports its determination.
        , returnSwapAddPayment_additionalPaymentDate :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the value date of the fee payment/receipt.
        , returnSwapAddPayment_paymentType :: Maybe PaymentType
          -- ^ Classification of the payment.
        }
        deriving (Eq,Show)
instance SchemaType ReturnSwapAdditionalPayment where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ReturnSwapAdditionalPayment a0)
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (parseSchemaType "additionalPaymentAmount")
            `apply` optional (parseSchemaType "additionalPaymentDate")
            `apply` optional (parseSchemaType "paymentType")
    schemaTypeToXML s x@ReturnSwapAdditionalPayment{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ returnSwapAddPayment_ID x
                       ]
            [ maybe [] (schemaTypeToXML "payerPartyReference") $ returnSwapAddPayment_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ returnSwapAddPayment_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ returnSwapAddPayment_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ returnSwapAddPayment_receiverAccountReference x
            , maybe [] (schemaTypeToXML "additionalPaymentAmount") $ returnSwapAddPayment_additionalPaymentAmount x
            , maybe [] (schemaTypeToXML "additionalPaymentDate") $ returnSwapAddPayment_additionalPaymentDate x
            , maybe [] (schemaTypeToXML "paymentType") $ returnSwapAddPayment_paymentType x
            ]
instance Extension ReturnSwapAdditionalPayment PaymentBase where
    supertype v = PaymentBase_ReturnSwapAdditionalPayment v
 
-- | Specifies, in relation to each Payment Date, the amount to 
--   which the Payment Date relates. For Equity Swaps this 
--   element is equivalent to the Equity Amount term as defined 
--   in the ISDA 2002 Equity Derivatives Definitions.
data ReturnSwapAmount = ReturnSwapAmount
        { returnSwapAmount_choice0 :: (Maybe (OneOf3 IdentifiedCurrency DeterminationMethod IdentifiedCurrencyReference))
          -- ^ Choice between:
          --   
          --   (1) The currency in which an amount is denominated.
          --   
          --   (2) Specifies the method according to which an amount or a 
          --   date is determined.
          --   
          --   (3) Reference to a currency defined elsewhere in the 
          --   document
        , returnSwapAmount_choice1 :: (Maybe (OneOf3 ReferenceAmount Formula Xsd.Base64Binary))
          -- ^ Choice between:
          --   
          --   (1) Specifies the reference Amount when this term either 
          --   corresponds to the standard ISDA Definition (either the 
          --   2002 Equity Definition for the Equity Amount, or the 
          --   2000 Definition for the Interest Amount), or points to 
          --   a term defined elsewhere in the swap document.
          --   
          --   (2) Specifies a formula, with its description and 
          --   components.
          --   
          --   (3) Description of the leg amount when represented through 
          --   an encoded image.
        , returnSwapAmount_calculationDates :: Maybe AdjustableRelativeOrPeriodicDates
          -- ^ Specifies the date on which a calculation or an observation 
          --   will be performed for the purpose of defining the Equity 
          --   Amount, and in accordance to the definition terms of this 
          --   latter.
        , returnSwapAmount_cashSettlement :: Maybe Xsd.Boolean
          -- ^ If true, then cash settlement is applicable.
        , returnSwapAmount_optionsExchangeDividends :: Maybe Xsd.Boolean
          -- ^ If present and true, then options exchange dividends are 
          --   applicable.
        , returnSwapAmount_additionalDividends :: Maybe Xsd.Boolean
          -- ^ If present and true, then additional dividends are 
          --   applicable.
        , returnSwapAmount_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.
        }
        deriving (Eq,Show)
instance SchemaType ReturnSwapAmount where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReturnSwapAmount
            `apply` optional (oneOf' [ ("IdentifiedCurrency", fmap OneOf3 (parseSchemaType "currency"))
                                     , ("DeterminationMethod", fmap TwoOf3 (parseSchemaType "determinationMethod"))
                                     , ("IdentifiedCurrencyReference", fmap ThreeOf3 (parseSchemaType "currencyReference"))
                                     ])
            `apply` optional (oneOf' [ ("ReferenceAmount", fmap OneOf3 (parseSchemaType "referenceAmount"))
                                     , ("Formula", fmap TwoOf3 (parseSchemaType "formula"))
                                     , ("Xsd.Base64Binary", fmap ThreeOf3 (parseSchemaType "encodedDescription"))
                                     ])
            `apply` optional (parseSchemaType "calculationDates")
            `apply` optional (parseSchemaType "cashSettlement")
            `apply` optional (parseSchemaType "optionsExchangeDividends")
            `apply` optional (parseSchemaType "additionalDividends")
            `apply` optional (parseSchemaType "allDividends")
    schemaTypeToXML s x@ReturnSwapAmount{} =
        toXMLElement s []
            [ maybe [] (foldOneOf3  (schemaTypeToXML "currency")
                                    (schemaTypeToXML "determinationMethod")
                                    (schemaTypeToXML "currencyReference")
                                   ) $ returnSwapAmount_choice0 x
            , maybe [] (foldOneOf3  (schemaTypeToXML "referenceAmount")
                                    (schemaTypeToXML "formula")
                                    (schemaTypeToXML "encodedDescription")
                                   ) $ returnSwapAmount_choice1 x
            , maybe [] (schemaTypeToXML "calculationDates") $ returnSwapAmount_calculationDates x
            , maybe [] (schemaTypeToXML "cashSettlement") $ returnSwapAmount_cashSettlement x
            , maybe [] (schemaTypeToXML "optionsExchangeDividends") $ returnSwapAmount_optionsExchangeDividends x
            , maybe [] (schemaTypeToXML "additionalDividends") $ returnSwapAmount_additionalDividends x
            , maybe [] (schemaTypeToXML "allDividends") $ returnSwapAmount_allDividends x
            ]
instance Extension ReturnSwapAmount LegAmount where
    supertype (ReturnSwapAmount e0 e1 e2 e3 e4 e5 e6) =
               LegAmount e0 e1 e2
 
-- | A type describing the components that are common for return 
--   type swaps, including short and long form return swaps 
--   representations.
data ReturnSwapBase
        = ReturnSwapBase_ReturnSwap ReturnSwap
        | ReturnSwapBase_EquitySwapTransactionSupplement EquitySwapTransactionSupplement
        
        deriving (Eq,Show)
instance SchemaType ReturnSwapBase where
    parseSchemaType s = do
        (fmap ReturnSwapBase_ReturnSwap $ parseSchemaType s)
        `onFail`
        (fmap ReturnSwapBase_EquitySwapTransactionSupplement $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of ReturnSwapBase,\n\
\  namely one of:\n\
\ReturnSwap,EquitySwapTransactionSupplement"
    schemaTypeToXML _s (ReturnSwapBase_ReturnSwap x) = schemaTypeToXML "returnSwap" x
    schemaTypeToXML _s (ReturnSwapBase_EquitySwapTransactionSupplement x) = schemaTypeToXML "equitySwapTransactionSupplement" x
instance Extension ReturnSwapBase Product where
    supertype v = Product_ReturnSwapBase v
 
-- | A type describing the date from which each of the party may 
--   be allowed to terminate the trade.
data ReturnSwapEarlyTermination = ReturnSwapEarlyTermination
        { returnSwapEarlyTermin_partyReference :: Maybe PartyReference
          -- ^ Reference to a party defined elsewhere in this document 
          --   which may be allowed to terminate the trade.
        , returnSwapEarlyTermin_startingDate :: Maybe StartingDate
          -- ^ Specifies the date from which the early termination clause 
          --   can be exercised.
        }
        deriving (Eq,Show)
instance SchemaType ReturnSwapEarlyTermination where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReturnSwapEarlyTermination
            `apply` optional (parseSchemaType "partyReference")
            `apply` optional (parseSchemaType "startingDate")
    schemaTypeToXML s x@ReturnSwapEarlyTermination{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "partyReference") $ returnSwapEarlyTermin_partyReference x
            , maybe [] (schemaTypeToXML "startingDate") $ returnSwapEarlyTermin_startingDate x
            ]
 
-- | A base class for all return leg types with an underlyer.
data ReturnSwapLegUnderlyer
        = ReturnSwapLegUnderlyer_ReturnLeg ReturnLeg
        
        deriving (Eq,Show)
instance SchemaType ReturnSwapLegUnderlyer where
    parseSchemaType s = do
        (fmap ReturnSwapLegUnderlyer_ReturnLeg $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of ReturnSwapLegUnderlyer,\n\
\  namely one of:\n\
\ReturnLeg"
    schemaTypeToXML _s (ReturnSwapLegUnderlyer_ReturnLeg x) = schemaTypeToXML "returnLeg" x
instance Extension ReturnSwapLegUnderlyer DirectionalLeg where
    supertype v = DirectionalLeg_ReturnSwapLegUnderlyer v
 
-- | Specifies the notional of return type swap. When used in 
--   the equity leg, the definition will typically combine the 
--   actual amount (using the notional component defined by the 
--   FpML industry group) and the determination method. When 
--   used in the interest leg, the definition will typically 
--   point to the definition of the equity leg.
data ReturnSwapNotional = ReturnSwapNotional
        { returnSwapNotion_ID :: Maybe Xsd.ID
        , returnSwapNotion_choice0 :: (Maybe (OneOf4 ReturnSwapNotionalAmountReference DeterminationMethodReference DeterminationMethod NotionalAmount))
          -- ^ Choice between:
          --   
          --   (1) A reference to the return swap notional amount defined 
          --   elsewhere in this document.
          --   
          --   (2) A reference to the return swap notional determination 
          --   method defined elsewhere in this document.
          --   
          --   (3) Specifies the method according to which an amount or a 
          --   date is determined.
          --   
          --   (4) The notional amount.
        }
        deriving (Eq,Show)
instance SchemaType ReturnSwapNotional where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ReturnSwapNotional a0)
            `apply` optional (oneOf' [ ("ReturnSwapNotionalAmountReference", fmap OneOf4 (parseSchemaType "relativeNotionalAmount"))
                                     , ("DeterminationMethodReference", fmap TwoOf4 (parseSchemaType "relativeDeterminationMethod"))
                                     , ("DeterminationMethod", fmap ThreeOf4 (parseSchemaType "determinationMethod"))
                                     , ("NotionalAmount", fmap FourOf4 (parseSchemaType "notionalAmount"))
                                     ])
    schemaTypeToXML s x@ReturnSwapNotional{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ returnSwapNotion_ID x
                       ]
            [ maybe [] (foldOneOf4  (schemaTypeToXML "relativeNotionalAmount")
                                    (schemaTypeToXML "relativeDeterminationMethod")
                                    (schemaTypeToXML "determinationMethod")
                                    (schemaTypeToXML "notionalAmount")
                                   ) $ returnSwapNotion_choice0 x
            ]
 
-- | A type describing the return payment dates of the swap.
data ReturnSwapPaymentDates = ReturnSwapPaymentDates
        { returnSwapPaymentDates_ID :: Maybe Xsd.ID
        , returnSwapPaymentDates_paymentDatesInterim :: Maybe AdjustableOrRelativeDates
          -- ^ Specifies the interim payment dates of the swap. When 
          --   defined in relation to a date specified somewhere else in 
          --   the document (through the relativeDates component), this 
          --   element will typically refer to the valuation dates and add 
          --   a lag corresponding to the settlement cycle of the 
          --   underlyer.
        , returnSwapPaymentDates_paymentDateFinal :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the final payment date of the swap. When defined 
          --   in relation to a date specified somewhere else in the 
          --   document (through the relativeDate component), this element 
          --   will typically refer to the final valuation date and add a 
          --   lag corresponding to the settlement cycle of the underlyer.
        }
        deriving (Eq,Show)
instance SchemaType ReturnSwapPaymentDates where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ReturnSwapPaymentDates a0)
            `apply` optional (parseSchemaType "paymentDatesInterim")
            `apply` optional (parseSchemaType "paymentDateFinal")
    schemaTypeToXML s x@ReturnSwapPaymentDates{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ returnSwapPaymentDates_ID x
                       ]
            [ maybe [] (schemaTypeToXML "paymentDatesInterim") $ returnSwapPaymentDates_paymentDatesInterim x
            , maybe [] (schemaTypeToXML "paymentDateFinal") $ returnSwapPaymentDates_paymentDateFinal x
            ]
 
-- | A type specifying the date from which the early termination 
--   clause can be exercised.
data StartingDate = StartingDate
        { startingDate_choice0 :: (Maybe (OneOf2 DateReference AdjustableDate))
          -- ^ Choice between:
          --   
          --   (1) Reference to a date defined elswhere in the document.
          --   
          --   (2) Date from which early termination clause can be 
          --   exercised.
        }
        deriving (Eq,Show)
instance SchemaType StartingDate where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return StartingDate
            `apply` optional (oneOf' [ ("DateReference", fmap OneOf2 (parseSchemaType "dateRelativeTo"))
                                     , ("AdjustableDate", fmap TwoOf2 (parseSchemaType "adjustableDate"))
                                     ])
    schemaTypeToXML s x@StartingDate{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "dateRelativeTo")
                                    (schemaTypeToXML "adjustableDate")
                                   ) $ startingDate_choice0 x
            ]
 
-- | A type describing the Stub Calculation Period.
data StubCalculationPeriod = StubCalculationPeriod
        { stubCalcPeriod_choice0 :: (Maybe (OneOf1 ((Maybe (Stub)),(Maybe (Stub)))))
          -- ^ Choice group between mandatory specification of initial 
          --   stub and optional specification of final stub, or mandatory 
          --   final stub.
          --   
          --   Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * initialStub
          --   
          --     * finalStub
        }
        deriving (Eq,Show)
instance SchemaType StubCalculationPeriod where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return StubCalculationPeriod
            `apply` optional (oneOf' [ ("Maybe Stub Maybe Stub", fmap OneOf1 (return (,) `apply` optional (parseSchemaType "initialStub")
                                                                                         `apply` optional (parseSchemaType "finalStub")))
                                     ])
    schemaTypeToXML s x@StubCalculationPeriod{} =
        toXMLElement s []
            [ maybe [] (foldOneOf1  (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "initialStub") a
                                                       , maybe [] (schemaTypeToXML "finalStub") b
                                                       ])
                                   ) $ stubCalcPeriod_choice0 x
            ]
 
-- | A type describing the variance amount of a variance swap.
data Variance = Variance
        { variance_choice0 :: (Maybe (OneOf3 Xsd.Decimal Xsd.Boolean Xsd.Boolean))
          -- ^ Choice between:
          --   
          --   (1) Contract will strike off this initial level.
          --   
          --   (2) If true this contract will strike off the closing level 
          --   of the default exchange traded contract.
          --   
          --   (3) If true this contract will strike off the expiring 
          --   level of the default exchange traded contract.
        , variance_expectedN :: Maybe Xsd.PositiveInteger
          -- ^ Expected number of trading days.
        , variance_amount :: Maybe NonNegativeMoney
          -- ^ Variance amount, which is a cash multiplier.
        , variance_choice3 :: (Maybe (OneOf2 NonNegativeDecimal NonNegativeDecimal))
          -- ^ Choice between expressing the strike as volatility or 
          --   variance.
          --   
          --   Choice between:
          --   
          --   (1) volatilityStrikePrice
          --   
          --   (2) varianceStrikePrice
        , variance_cap :: Maybe Xsd.Boolean
          -- ^ If present and true, then variance cap is applicable.
        , variance_unadjustedVarianceCap :: Maybe PositiveDecimal
          -- ^ For use when varianceCap is applicable. Contains the 
          --   scaling factor of the Variance Cap that can differ on a 
          --   trade-by-trade basis in the European market. For example, a 
          --   Variance Cap of 2.5^2 x Variance Strike Price has an 
          --   unadjustedVarianceCap of 2.5.
        , variance_boundedVariance :: Maybe BoundedVariance
          -- ^ Conditions which bound variance. The contract specifies one 
          --   or more boundary levels. These levels are expressed as 
          --   prices for confirmation purposes Underlyer price must be 
          --   equal to or higher than Lower Barrier is known as Up 
          --   Conditional Swap Underlyer price must be equal to or lower 
          --   than Upper Barrier is known as Down Conditional Swap 
          --   Underlyer price must be equal to or higher than Lower 
          --   Barrier and must be equal to or lower than Upper Barrier is 
          --   known as Barrier Conditional Swap.
        , variance_exchangeTradedContractNearest :: Maybe ExchangeTradedContract
          -- ^ Specification of the exchange traded contract nearest.
        , variance_vegaNotionalAmount :: Maybe Xsd.Decimal
          -- ^ Vega Notional represents the approximate gain/loss at 
          --   maturity for a 1% difference between RVol (realised vol) 
          --   and KVol (strike vol). It does not necessarily represent 
          --   the Vega Risk of the trade.
        }
        deriving (Eq,Show)
instance SchemaType Variance where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Variance
            `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf3 (parseSchemaType "initialLevel"))
                                     , ("Xsd.Boolean", fmap TwoOf3 (parseSchemaType "closingLevel"))
                                     , ("Xsd.Boolean", fmap ThreeOf3 (parseSchemaType "expiringLevel"))
                                     ])
            `apply` optional (parseSchemaType "expectedN")
            `apply` optional (parseSchemaType "varianceAmount")
            `apply` optional (oneOf' [ ("NonNegativeDecimal", fmap OneOf2 (parseSchemaType "volatilityStrikePrice"))
                                     , ("NonNegativeDecimal", fmap TwoOf2 (parseSchemaType "varianceStrikePrice"))
                                     ])
            `apply` optional (parseSchemaType "varianceCap")
            `apply` optional (parseSchemaType "unadjustedVarianceCap")
            `apply` optional (parseSchemaType "boundedVariance")
            `apply` optional (parseSchemaType "exchangeTradedContractNearest")
            `apply` optional (parseSchemaType "vegaNotionalAmount")
    schemaTypeToXML s x@Variance{} =
        toXMLElement s []
            [ maybe [] (foldOneOf3  (schemaTypeToXML "initialLevel")
                                    (schemaTypeToXML "closingLevel")
                                    (schemaTypeToXML "expiringLevel")
                                   ) $ variance_choice0 x
            , maybe [] (schemaTypeToXML "expectedN") $ variance_expectedN x
            , maybe [] (schemaTypeToXML "varianceAmount") $ variance_amount x
            , maybe [] (foldOneOf2  (schemaTypeToXML "volatilityStrikePrice")
                                    (schemaTypeToXML "varianceStrikePrice")
                                   ) $ variance_choice3 x
            , maybe [] (schemaTypeToXML "varianceCap") $ variance_cap x
            , maybe [] (schemaTypeToXML "unadjustedVarianceCap") $ variance_unadjustedVarianceCap x
            , maybe [] (schemaTypeToXML "boundedVariance") $ variance_boundedVariance x
            , maybe [] (schemaTypeToXML "exchangeTradedContractNearest") $ variance_exchangeTradedContractNearest x
            , maybe [] (schemaTypeToXML "vegaNotionalAmount") $ variance_vegaNotionalAmount x
            ]
instance Extension Variance CalculationFromObservation where
    supertype v = CalculationFromObservation_Variance v
 
-- | The fixed income amounts of the return type swap.
elementInterestLeg :: XMLParser InterestLeg
elementInterestLeg = parseSchemaType "interestLeg"
elementToXMLInterestLeg :: InterestLeg -> [Content ()]
elementToXMLInterestLeg = schemaTypeToXML "interestLeg"
 
-- | Return amounts of the return type swap.
elementReturnLeg :: XMLParser ReturnLeg
elementReturnLeg = parseSchemaType "returnLeg"
elementToXMLReturnLeg :: ReturnLeg -> [Content ()]
elementToXMLReturnLeg = schemaTypeToXML "returnLeg"
 
-- | Specifies the structure of a return type swap. It can 
--   represent return swaps, total return swaps, variance swaps.
elementReturnSwap :: XMLParser ReturnSwap
elementReturnSwap = parseSchemaType "returnSwap"
elementToXMLReturnSwap :: ReturnSwap -> [Content ()]
elementToXMLReturnSwap = schemaTypeToXML "returnSwap"
 
-- | An placeholder for the actual Return Swap Leg definition.
elementReturnSwapLeg :: XMLParser DirectionalLeg
elementReturnSwapLeg = fmap supertype elementReturnLeg
                       `onFail`
                       fmap supertype elementInterestLeg
                       `onFail` fail "Parse failed when expecting an element in the substitution group for\n\
\    <returnSwapLeg>,\n\
\  namely one of:\n\
\<returnLeg>, <interestLeg>"
elementToXMLReturnSwapLeg :: DirectionalLeg -> [Content ()]
elementToXMLReturnSwapLeg = schemaTypeToXML "returnSwapLeg"