{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.CD
  ( module Data.FpML.V53.CD
  , 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.
 
data AdditionalFixedPayments = AdditionalFixedPayments
        { addFixedPaymen_interestShortfallReimbursement :: Maybe Xsd.Boolean
          -- ^ An additional Fixed Payment Event. Corresponds to the 
          --   payment by or on behalf of the Issuer of an actual interest 
          --   amount in respect to the reference obligation that is 
          --   greater than the expected interest amount. ISDA 2003 Term: 
          --   Interest Shortfall Reimbursement.
        , addFixedPaymen_principalShortfallReimbursement :: Maybe Xsd.Boolean
          -- ^ An additional Fixed Payment Event. Corresponds to the 
          --   payment by or on behalf of the Issuer of an actual 
          --   principal amount in respect to the reference obligation 
          --   that is greater than the expected principal amount. ISDA 
          --   2003 Term: Principal Shortfall Reimbursement.
        , addFixedPaymen_writedownReimbursement :: Maybe Xsd.Boolean
          -- ^ An Additional Fixed Payment. Corresponds to the payment by 
          --   or on behalf of the issuer of an amount in respect to the 
          --   reference obligation in reduction of the prior writedowns. 
          --   ISDA 2003 Term: Writedown Reimbursement.
        }
        deriving (Eq,Show)
instance SchemaType AdditionalFixedPayments where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return AdditionalFixedPayments
            `apply` optional (parseSchemaType "interestShortfallReimbursement")
            `apply` optional (parseSchemaType "principalShortfallReimbursement")
            `apply` optional (parseSchemaType "writedownReimbursement")
    schemaTypeToXML s x@AdditionalFixedPayments{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "interestShortfallReimbursement") $ addFixedPaymen_interestShortfallReimbursement x
            , maybe [] (schemaTypeToXML "principalShortfallReimbursement") $ addFixedPaymen_principalShortfallReimbursement x
            , maybe [] (schemaTypeToXML "writedownReimbursement") $ addFixedPaymen_writedownReimbursement x
            ]
 
data AdditionalTerm = AdditionalTerm Scheme AdditionalTermAttributes deriving (Eq,Show)
data AdditionalTermAttributes = AdditionalTermAttributes
    { addTermAttrib_additionalTermScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType AdditionalTerm where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "additionalTermScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ AdditionalTerm v (AdditionalTermAttributes a0)
    schemaTypeToXML s (AdditionalTerm bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "additionalTermScheme") $ addTermAttrib_additionalTermScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension AdditionalTerm Scheme where
    supertype (AdditionalTerm s _) = s
 
data AdjustedPaymentDates = AdjustedPaymentDates
        { adjustPaymentDates_adjustedPaymentDate :: Maybe Xsd.Date
          -- ^ The adjusted payment date. This date should already be 
          --   adjusted for any applicable business day convention. This 
          --   component is not intended for use in trade confirmation but 
          --   my be specified to allow the fee structure to also serve as 
          --   a cashflow type component (all dates the the Cashflows type 
          --   are adjusted payment dates).
        , adjustPaymentDates_paymentAmount :: Maybe Money
          -- ^ The currency amount of the payment.
        }
        deriving (Eq,Show)
instance SchemaType AdjustedPaymentDates where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return AdjustedPaymentDates
            `apply` optional (parseSchemaType "adjustedPaymentDate")
            `apply` optional (parseSchemaType "paymentAmount")
    schemaTypeToXML s x@AdjustedPaymentDates{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "adjustedPaymentDate") $ adjustPaymentDates_adjustedPaymentDate x
            , maybe [] (schemaTypeToXML "paymentAmount") $ adjustPaymentDates_paymentAmount x
            ]
 
-- | CDS Basket Reference Information
data BasketReferenceInformation = BasketReferenceInformation
        { basketRefInfo_choice0 :: (Maybe (OneOf1 ((Maybe (BasketName)),[BasketId])))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * The name of the basket expressed as a free format 
          --   string. FpML does not define usage rules for this 
          --   element.
          --   
          --     * A CDS basket identifier
        , basketRefInfo_referencePool :: Maybe ReferencePool
          -- ^ This element contains all the reference pool items to 
          --   define the reference entity and reference obligation(s) in 
          --   the basket
        , basketRefInfo_choice2 :: (Maybe (OneOf2 ((Maybe (Xsd.PositiveInteger)),(Maybe (Xsd.PositiveInteger))) Tranche))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * N th reference obligation to default triggers 
          --   payout.
          --   
          --     * M th reference obligation to default to allow 
          --   representation of N th to M th defaults.
          --   
          --   (2) This element contains CDS tranche terms.
        }
        deriving (Eq,Show)
instance SchemaType BasketReferenceInformation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return BasketReferenceInformation
            `apply` optional (oneOf' [ ("Maybe BasketName [BasketId]", fmap OneOf1 (return (,) `apply` optional (parseSchemaType "basketName")
                                                                                               `apply` many (parseSchemaType "basketId")))
                                     ])
            `apply` optional (parseSchemaType "referencePool")
            `apply` optional (oneOf' [ ("Maybe Xsd.PositiveInteger Maybe Xsd.PositiveInteger", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "nthToDefault")
                                                                                                                       `apply` optional (parseSchemaType "mthToDefault")))
                                     , ("Tranche", fmap TwoOf2 (parseSchemaType "tranche"))
                                     ])
    schemaTypeToXML s x@BasketReferenceInformation{} =
        toXMLElement s []
            [ maybe [] (foldOneOf1  (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "basketName") a
                                                       , concatMap (schemaTypeToXML "basketId") b
                                                       ])
                                   ) $ basketRefInfo_choice0 x
            , maybe [] (schemaTypeToXML "referencePool") $ basketRefInfo_referencePool x
            , maybe [] (foldOneOf2  (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "nthToDefault") a
                                                       , maybe [] (schemaTypeToXML "mthToDefault") b
                                                       ])
                                    (schemaTypeToXML "tranche")
                                   ) $ basketRefInfo_choice2 x
            ]
 
data CalculationAmount = CalculationAmount
        { calcAmount_ID :: Maybe Xsd.ID
        , calcAmount_currency :: Currency
          -- ^ The currency in which an amount is denominated.
        , calcAmount_amount :: Xsd.Decimal
          -- ^ The monetary quantity in currency units.
        , calcAmount_step :: [Step]
          -- ^ A schedule of step date and value pairs. On each step date 
          --   the associated step value becomes effective. A list of 
          --   steps may be ordered in the document by ascending step 
          --   date. An FpML document containing an unordered list of 
          --   steps is still regarded as a conformant document.
        }
        deriving (Eq,Show)
instance SchemaType CalculationAmount where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (CalculationAmount a0)
            `apply` parseSchemaType "currency"
            `apply` parseSchemaType "amount"
            `apply` many (parseSchemaType "step")
    schemaTypeToXML s x@CalculationAmount{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ calcAmount_ID x
                       ]
            [ schemaTypeToXML "currency" $ calcAmount_currency x
            , schemaTypeToXML "amount" $ calcAmount_amount x
            , concatMap (schemaTypeToXML "step") $ calcAmount_step x
            ]
instance Extension CalculationAmount Money where
    supertype (CalculationAmount a0 e0 e1 e2) =
               Money a0 e0 e1
instance Extension CalculationAmount MoneyBase where
    supertype = (supertype :: Money -> MoneyBase)
              . (supertype :: CalculationAmount -> Money)
              
 
data CashSettlementTerms = CashSettlementTerms
        { cashSettlTerms_ID :: Maybe Xsd.ID
        , cashSettlTerms_settlementCurrency :: Maybe Currency
          -- ^ ISDA 2003 Term: Settlement Currency
        , cashSettlTerms_valuationDate :: Maybe ValuationDate
          -- ^ The number of business days after conditions to settlement 
          --   have been satisfied when the calculation agent obtains a 
          --   price quotation on the Reference Obligation for purposes of 
          --   cash settlement. There may be one or more valuation dates. 
          --   This is typically specified if the cash settlement amount 
          --   is not a fixed amount. ISDA 2003 Term: Valuation Date
        , cashSettlTerms_valuationTime :: Maybe BusinessCenterTime
          -- ^ The time of day in the specified business center when the 
          --   calculation agent seeks quotations for an amount of the 
          --   reference obligation for purposes of cash settlement. ISDA 
          --   2003 Term: Valuation Time
        , cashSettlTerms_quotationMethod :: Maybe QuotationRateTypeEnum
          -- ^ The type of price quotations to be requested from dealers 
          --   when determining the market value of the reference 
          --   obligation for purposes of cash settlement. For example, 
          --   Bid, Offer or Mid-market. ISDA 2003 Term: Quotation Method
        , cashSettlTerms_quotationAmount :: Maybe Money
          -- ^ In the determination of a cash settlement amount, if 
          --   weighted average quotations are to be obtained, the 
          --   quotation amount specifies an upper limit to the 
          --   outstanding principal balance of the reference obligation 
          --   for which the quote should be obtained. If not specified, 
          --   the ISDA definitions provide for a fallback amount equal to 
          --   the floating rate payer calculation amount. ISDA 2003 Term: 
          --   Quotation Amount
        , cashSettlTerms_minimumQuotationAmount :: Maybe Money
          -- ^ In the determination of a cash settlement amount, if 
          --   weighted average quotations are to be obtained, the minimum 
          --   quotation amount specifies a minimum intended threshold 
          --   amount of outstanding principal balance of the reference 
          --   obligation for which the quote should be obtained. If not 
          --   specified, the ISDA definitions provide for a fallback 
          --   amount of the lower of either USD 1,000,000 (or its 
          --   equivalent in the relevant obligation currency) or the 
          --   quotation amount. ISDA 2003 Term: Minimum Quotation Amount
        , cashSettlTerms_dealer :: [Xsd.XsdString]
          -- ^ A dealer from whom quotations are obtained by the 
          --   calculation agent on the reference obligation for purposes 
          --   of cash settlement. ISDA 2003 Term: Dealer
        , cashSettlTerms_cashSettlementBusinessDays :: Maybe Xsd.NonNegativeInteger
          -- ^ The number of business days used in the determination of 
          --   the cash settlement payment date. If a cash settlement 
          --   amount is specified, the cash settlement payment date will 
          --   be this number of business days following the calculation 
          --   of the final price. If a cash settlement amount is not 
          --   specified, the cash settlement payment date will be this 
          --   number of business days after all conditions to settlement 
          --   are satisfied. ISDA 2003 Term: Cash Settlement Date
        , cashSettlTerms_choice8 :: (Maybe (OneOf2 Money RestrictedPercentage))
          -- ^ Choice between:
          --   
          --   (1) The amount paid by the seller to the buyer for cash 
          --   settlement on the cash settlement date. If not 
          --   otherwise specified, would typically be calculated as 
          --   100 (or the Reference Price) minus the price of the 
          --   Reference Obligation (all expressed as a percentage) 
          --   times Floating Rate Payer Calculation Amount. ISDA 2003 
          --   Term: Cash Settlement Amount.
          --   
          --   (2) Used for fixed recovery, specifies the recovery level, 
          --   determined at contract inception, to be applied on a 
          --   default. Used to calculate the amount paid by the 
          --   seller to the buyer for cash settlement on the cash 
          --   settlement date. Amount calculation is (1 minus the 
          --   Recovery Factor) multiplied by the Floating Rate Payer 
          --   Calculation Amount. The currency will be derived from 
          --   the Floating Rate Payer Calculation Amount.
        , cashSettlTerms_fixedSettlement :: Maybe Xsd.Boolean
          -- ^ Used for Recovery Lock, to indicate whether fixed 
          --   Settlement is Applicable or Not Applicable. If Buyer fails 
          --   to deliver an effective Notice of Physical Settlement on or 
          --   before the Buyer NOPS Cut-off Date, and If Seller fails to 
          --   deliver an effective Seller NOPS on or before the Seller 
          --   NOPS Cut-off Date, then either: (a) if Fixed Settlement is 
          --   specified in the related Confirmation as not applicable, 
          --   then the Seller NOPS Cut-off Date shall be the Termination 
          --   Date; or (b) if Fixed Settlement is specified in the 
          --   related Confirmation as applicable, then: (i) if the Fixed 
          --   Settlement Amount is a positive number, Seller shall, 
          --   subject to Section 3.1 (except for the requirement of 
          --   satisfaction of the Notice of Physical Settlement Condition 
          --   to Settlement), pay the Fixed Settlement Amount to Buyer on 
          --   the Fixed Settlement Payment Date; and (ii) if the Fixed 
          --   Settlement Amount is a negative number, Buyer shall, 
          --   subject to Section 3.1 (except for the requirement of 
          --   satisfaction of the Notice of Physical Settlement Condition 
          --   to Settlement), pay the absolute value of the Fixed 
          --   Settlement Amount to Seller on the Fixed Settlement Payment 
          --   Date.
        , cashSettlTerms_accruedInterest :: Maybe Xsd.Boolean
          -- ^ Indicates whether accrued interest is included (true) or 
          --   not (false). For cash settlement this specifies whether 
          --   quotations should be obtained inclusive or not of accrued 
          --   interest. For physical settlement this specifies whether 
          --   the buyer should deliver the obligation with an outstanding 
          --   principal balance that includes or excludes accrued 
          --   interest. ISDA 2003 Term: Include/Exclude Accrued Interest
        , cashSettlTerms_valuationMethod :: Maybe ValuationMethodEnum
          -- ^ The ISDA defined methodology for determining the final 
          --   price of the reference obligation for purposes of cash 
          --   settlement. (ISDA 2003 Term: Valuation Method). For 
          --   example, Market, Highest etc.
        }
        deriving (Eq,Show)
instance SchemaType CashSettlementTerms where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (CashSettlementTerms a0)
            `apply` optional (parseSchemaType "settlementCurrency")
            `apply` optional (parseSchemaType "valuationDate")
            `apply` optional (parseSchemaType "valuationTime")
            `apply` optional (parseSchemaType "quotationMethod")
            `apply` optional (parseSchemaType "quotationAmount")
            `apply` optional (parseSchemaType "minimumQuotationAmount")
            `apply` many (parseSchemaType "dealer")
            `apply` optional (parseSchemaType "cashSettlementBusinessDays")
            `apply` optional (oneOf' [ ("Money", fmap OneOf2 (parseSchemaType "cashSettlementAmount"))
                                     , ("RestrictedPercentage", fmap TwoOf2 (parseSchemaType "recoveryFactor"))
                                     ])
            `apply` optional (parseSchemaType "fixedSettlement")
            `apply` optional (parseSchemaType "accruedInterest")
            `apply` optional (parseSchemaType "valuationMethod")
    schemaTypeToXML s x@CashSettlementTerms{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ cashSettlTerms_ID x
                       ]
            [ maybe [] (schemaTypeToXML "settlementCurrency") $ cashSettlTerms_settlementCurrency x
            , maybe [] (schemaTypeToXML "valuationDate") $ cashSettlTerms_valuationDate x
            , maybe [] (schemaTypeToXML "valuationTime") $ cashSettlTerms_valuationTime x
            , maybe [] (schemaTypeToXML "quotationMethod") $ cashSettlTerms_quotationMethod x
            , maybe [] (schemaTypeToXML "quotationAmount") $ cashSettlTerms_quotationAmount x
            , maybe [] (schemaTypeToXML "minimumQuotationAmount") $ cashSettlTerms_minimumQuotationAmount x
            , concatMap (schemaTypeToXML "dealer") $ cashSettlTerms_dealer x
            , maybe [] (schemaTypeToXML "cashSettlementBusinessDays") $ cashSettlTerms_cashSettlementBusinessDays x
            , maybe [] (foldOneOf2  (schemaTypeToXML "cashSettlementAmount")
                                    (schemaTypeToXML "recoveryFactor")
                                   ) $ cashSettlTerms_choice8 x
            , maybe [] (schemaTypeToXML "fixedSettlement") $ cashSettlTerms_fixedSettlement x
            , maybe [] (schemaTypeToXML "accruedInterest") $ cashSettlTerms_accruedInterest x
            , maybe [] (schemaTypeToXML "valuationMethod") $ cashSettlTerms_valuationMethod x
            ]
instance Extension CashSettlementTerms SettlementTerms where
    supertype (CashSettlementTerms a0 e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10 e11) =
               SettlementTerms a0 e0
 
data CreditDefaultSwap = CreditDefaultSwap
        { creditDefaultSwap_ID :: Maybe Xsd.ID
        , creditDefaultSwap_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.
        , creditDefaultSwap_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , creditDefaultSwap_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , creditDefaultSwap_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.
        , creditDefaultSwap_generalTerms :: GeneralTerms
          -- ^ This element contains all the data that appears in the 
          --   section entitled "1. General Terms" in the 2003 ISDA Credit 
          --   Derivatives Confirmation.
        , creditDefaultSwap_feeLeg :: FeeLeg
          -- ^ This element contains all the terms relevant to defining 
          --   the fixed amounts/payments per the applicable ISDA 
          --   definitions.
        , creditDefaultSwap_protectionTerms :: [ProtectionTerms]
          -- ^ This element contains all the terms relevant to defining 
          --   the applicable floating rate payer calculation amount, 
          --   credit events and associated conditions to settlement, and 
          --   reference obligations.
        , creditDefaultSwap_choice7 :: [OneOf2 CashSettlementTerms PhysicalSettlementTerms]
          -- ^ Choice between:
          --   
          --   (1) This element contains all the ISDA terms relevant to 
          --   cash settlement for when cash settlement is applicable. 
          --   ISDA 2003 Term: Cash Settlement
          --   
          --   (2) This element contains all the ISDA terms relevant to 
          --   physical settlement for when physical settlement is 
          --   applicable. ISDA 2003 Term: Physical Settlement
        }
        deriving (Eq,Show)
instance SchemaType CreditDefaultSwap where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (CreditDefaultSwap a0)
            `apply` optional (parseSchemaType "primaryAssetClass")
            `apply` many (parseSchemaType "secondaryAssetClass")
            `apply` many (parseSchemaType "productType")
            `apply` many (parseSchemaType "productId")
            `apply` parseSchemaType "generalTerms"
            `apply` parseSchemaType "feeLeg"
            `apply` many1 (parseSchemaType "protectionTerms")
            `apply` many (oneOf' [ ("CashSettlementTerms", fmap OneOf2 (parseSchemaType "cashSettlementTerms"))
                                 , ("PhysicalSettlementTerms", fmap TwoOf2 (parseSchemaType "physicalSettlementTerms"))
                                 ])
    schemaTypeToXML s x@CreditDefaultSwap{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ creditDefaultSwap_ID x
                       ]
            [ maybe [] (schemaTypeToXML "primaryAssetClass") $ creditDefaultSwap_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ creditDefaultSwap_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ creditDefaultSwap_productType x
            , concatMap (schemaTypeToXML "productId") $ creditDefaultSwap_productId x
            , schemaTypeToXML "generalTerms" $ creditDefaultSwap_generalTerms x
            , schemaTypeToXML "feeLeg" $ creditDefaultSwap_feeLeg x
            , concatMap (schemaTypeToXML "protectionTerms") $ creditDefaultSwap_protectionTerms x
            , concatMap (foldOneOf2  (schemaTypeToXML "cashSettlementTerms")
                                     (schemaTypeToXML "physicalSettlementTerms")
                                    ) $ creditDefaultSwap_choice7 x
            ]
instance Extension CreditDefaultSwap Product where
    supertype v = Product_CreditDefaultSwap v
 
-- | A complex type to support the credit default swap option.
data CreditDefaultSwapOption = CreditDefaultSwapOption
        { creditDefaultSwapOption_ID :: Maybe Xsd.ID
        , creditDefaultSwapOption_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.
        , creditDefaultSwapOption_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , creditDefaultSwapOption_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , creditDefaultSwapOption_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.
        , creditDefaultSwapOption_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.
        , creditDefaultSwapOption_buyerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that buys this instrument.
        , creditDefaultSwapOption_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.
        , creditDefaultSwapOption_sellerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that sells this instrument.
        , creditDefaultSwapOption_optionType :: OptionTypeEnum
          -- ^ The type of option transaction. From a usage standpoint, 
          --   put/call is the default option type, while payer/receiver 
          --   indicator is used for options index credit default swaps, 
          --   consistently with the industry practice. Straddle is used 
          --   for the case of straddle strategy, that combine a call and 
          --   a put with the same strike.
        , creditDefaultSwapOption_premium :: Premium
          -- ^ The option premium payable by the buyer to the seller.
        , creditDefaultSwapOption_exercise :: Exercise
          -- ^ An placeholder for the actual option exercise definitions.
        , creditDefaultSwapOption_exerciseProcedure :: Maybe ExerciseProcedure
          -- ^ A set of parameters defining procedures associated with the 
          --   exercise.
        , creditDefaultSwapOption_feature :: Maybe OptionFeature
          -- ^ An Option feature such as quanto, asian, barrier, knock.
        , creditDefaultSwapOption_choice13 :: (Maybe (OneOf2 NotionalAmountReference Money))
          -- ^ A choice between an explicit representation of the notional 
          --   amount, or a reference to a notional amount defined 
          --   elsewhere in this document.
          --   
          --   Choice between:
          --   
          --   (1) notionalReference
          --   
          --   (2) notionalAmount
        , creditDefaultSwapOption_optionEntitlement :: Maybe PositiveDecimal
          -- ^ The number of units of underlyer per option comprised in 
          --   the option transaction.
        , creditDefaultSwapOption_entitlementCurrency :: Maybe Currency
          -- ^ TODO
        , creditDefaultSwapOption_numberOfOptions :: Maybe PositiveDecimal
          -- ^ The number of options comprised in the option transaction.
        , creditDefaultSwapOption_settlementType :: Maybe SettlementTypeEnum
        , creditDefaultSwapOption_settlementDate :: Maybe AdjustableOrRelativeDate
        , creditDefaultSwapOption_choice19 :: (Maybe (OneOf2 Money Currency))
          -- ^ Choice between:
          --   
          --   (1) Settlement Amount
          --   
          --   (2) Settlement Currency for use where the Settlement Amount 
          --   cannot be known in advance
        , creditDefaultSwapOption_strike :: CreditOptionStrike
          -- ^ Specifies the strike of the option on credit default swap.
        , creditDefaultSwapOption_creditDefaultSwap :: CreditDefaultSwap
        }
        deriving (Eq,Show)
instance SchemaType CreditDefaultSwapOption where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (CreditDefaultSwapOption a0)
            `apply` optional (parseSchemaType "primaryAssetClass")
            `apply` many (parseSchemaType "secondaryAssetClass")
            `apply` many (parseSchemaType "productType")
            `apply` many (parseSchemaType "productId")
            `apply` optional (parseSchemaType "buyerPartyReference")
            `apply` optional (parseSchemaType "buyerAccountReference")
            `apply` optional (parseSchemaType "sellerPartyReference")
            `apply` optional (parseSchemaType "sellerAccountReference")
            `apply` parseSchemaType "optionType"
            `apply` parseSchemaType "premium"
            `apply` elementExercise
            `apply` optional (parseSchemaType "exerciseProcedure")
            `apply` optional (parseSchemaType "feature")
            `apply` optional (oneOf' [ ("NotionalAmountReference", fmap OneOf2 (parseSchemaType "notionalReference"))
                                     , ("Money", fmap TwoOf2 (parseSchemaType "notionalAmount"))
                                     ])
            `apply` optional (parseSchemaType "optionEntitlement")
            `apply` optional (parseSchemaType "entitlementCurrency")
            `apply` optional (parseSchemaType "numberOfOptions")
            `apply` optional (parseSchemaType "settlementType")
            `apply` optional (parseSchemaType "settlementDate")
            `apply` optional (oneOf' [ ("Money", fmap OneOf2 (parseSchemaType "settlementAmount"))
                                     , ("Currency", fmap TwoOf2 (parseSchemaType "settlementCurrency"))
                                     ])
            `apply` parseSchemaType "strike"
            `apply` parseSchemaType "creditDefaultSwap"
    schemaTypeToXML s x@CreditDefaultSwapOption{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ creditDefaultSwapOption_ID x
                       ]
            [ maybe [] (schemaTypeToXML "primaryAssetClass") $ creditDefaultSwapOption_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ creditDefaultSwapOption_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ creditDefaultSwapOption_productType x
            , concatMap (schemaTypeToXML "productId") $ creditDefaultSwapOption_productId x
            , maybe [] (schemaTypeToXML "buyerPartyReference") $ creditDefaultSwapOption_buyerPartyReference x
            , maybe [] (schemaTypeToXML "buyerAccountReference") $ creditDefaultSwapOption_buyerAccountReference x
            , maybe [] (schemaTypeToXML "sellerPartyReference") $ creditDefaultSwapOption_sellerPartyReference x
            , maybe [] (schemaTypeToXML "sellerAccountReference") $ creditDefaultSwapOption_sellerAccountReference x
            , schemaTypeToXML "optionType" $ creditDefaultSwapOption_optionType x
            , schemaTypeToXML "premium" $ creditDefaultSwapOption_premium x
            , elementToXMLExercise $ creditDefaultSwapOption_exercise x
            , maybe [] (schemaTypeToXML "exerciseProcedure") $ creditDefaultSwapOption_exerciseProcedure x
            , maybe [] (schemaTypeToXML "feature") $ creditDefaultSwapOption_feature x
            , maybe [] (foldOneOf2  (schemaTypeToXML "notionalReference")
                                    (schemaTypeToXML "notionalAmount")
                                   ) $ creditDefaultSwapOption_choice13 x
            , maybe [] (schemaTypeToXML "optionEntitlement") $ creditDefaultSwapOption_optionEntitlement x
            , maybe [] (schemaTypeToXML "entitlementCurrency") $ creditDefaultSwapOption_entitlementCurrency x
            , maybe [] (schemaTypeToXML "numberOfOptions") $ creditDefaultSwapOption_numberOfOptions x
            , maybe [] (schemaTypeToXML "settlementType") $ creditDefaultSwapOption_settlementType x
            , maybe [] (schemaTypeToXML "settlementDate") $ creditDefaultSwapOption_settlementDate x
            , maybe [] (foldOneOf2  (schemaTypeToXML "settlementAmount")
                                    (schemaTypeToXML "settlementCurrency")
                                   ) $ creditDefaultSwapOption_choice19 x
            , schemaTypeToXML "strike" $ creditDefaultSwapOption_strike x
            , schemaTypeToXML "creditDefaultSwap" $ creditDefaultSwapOption_creditDefaultSwap x
            ]
instance Extension CreditDefaultSwapOption OptionBaseExtended where
    supertype v = OptionBaseExtended_CreditDefaultSwapOption v
instance Extension CreditDefaultSwapOption OptionBase where
    supertype = (supertype :: OptionBaseExtended -> OptionBase)
              . (supertype :: CreditDefaultSwapOption -> OptionBaseExtended)
              
instance Extension CreditDefaultSwapOption Option where
    supertype = (supertype :: OptionBase -> Option)
              . (supertype :: OptionBaseExtended -> OptionBase)
              . (supertype :: CreditDefaultSwapOption -> OptionBaseExtended)
              
instance Extension CreditDefaultSwapOption Product where
    supertype = (supertype :: Option -> Product)
              . (supertype :: OptionBase -> Option)
              . (supertype :: OptionBaseExtended -> OptionBase)
              . (supertype :: CreditDefaultSwapOption -> OptionBaseExtended)
              
 
-- | A complex type to specify the strike of a credit swaption 
--   or a credit default swap option.
data CreditOptionStrike = CreditOptionStrike
        { creditOptionStrike_choice0 :: (Maybe (OneOf3 Xsd.Decimal Xsd.Decimal FixedRateReference))
          -- ^ Choice between:
          --   
          --   (1) The strike of a credit default swap option or credit 
          --   swaption when expressed as a spread per annum.
          --   
          --   (2) The strike of a credit default swap option or credit 
          --   swaption when expressed as in reference to the price of 
          --   the underlying obligation(s) or index.
          --   
          --   (3) The strike of a credit default swap option or credit 
          --   swaption when expressed in reference to the spread of 
          --   the underlying swap (typical practice in the case of 
          --   single name swaps).
        }
        deriving (Eq,Show)
instance SchemaType CreditOptionStrike where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return CreditOptionStrike
            `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf3 (parseSchemaType "spread"))
                                     , ("Xsd.Decimal", fmap TwoOf3 (parseSchemaType "price"))
                                     , ("FixedRateReference", fmap ThreeOf3 (parseSchemaType "strikeReference"))
                                     ])
    schemaTypeToXML s x@CreditOptionStrike{} =
        toXMLElement s []
            [ maybe [] (foldOneOf3  (schemaTypeToXML "spread")
                                    (schemaTypeToXML "price")
                                    (schemaTypeToXML "strikeReference")
                                   ) $ creditOptionStrike_choice0 x
            ]
 
data DeliverableObligations = DeliverableObligations
        { delivOblig_accruedInterest :: Maybe Xsd.Boolean
          -- ^ Indicates whether accrued interest is included (true) or 
          --   not (false). For cash settlement this specifies whether 
          --   quotations should be obtained inclusive or not of accrued 
          --   interest. For physical settlement this specifies whether 
          --   the buyer should deliver the obligation with an outstanding 
          --   principal balance that includes or excludes accrued 
          --   interest. ISDA 2003 Term: Include/Exclude Accrued Interest
        , delivOblig_category :: Maybe ObligationCategoryEnum
          -- ^ Used in both obligations and deliverable obligations to 
          --   represent a class or type of securities which apply. ISDA 
          --   2003 Term: Obligation Category/Deliverable Obligation 
          --   Category
        , delivOblig_notSubordinated :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. An 
          --   obligation that ranks at least equal with the most senior 
          --   Reference Obligation in priority of payment or, if no 
          --   Reference Obligation is specified in the related 
          --   Confirmation, the obligations of the Reference Entity that 
          --   are senior. ISDA 2003 Term: Not Subordinated
        , delivOblig_specifiedCurrency :: Maybe SpecifiedCurrency
          -- ^ An obligation and deliverable obligation characteristic. 
          --   The currency or currencies in which an obligation or 
          --   deliverable obligation must be payable. ISDA 2003 Term: 
          --   Specified Currency
        , delivOblig_notSovereignLender :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Any obligation that is not primarily (majority) owed to a 
          --   Sovereign or Supranational Organization. ISDA 2003 Term: 
          --   Not Sovereign Lender
        , delivOblig_notDomesticCurrency :: Maybe NotDomesticCurrency
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Any obligation that is payable in any currency other than 
          --   the domestic currency. Domestic currency is either the 
          --   currency so specified or, if no currency is specified, the 
          --   currency of (a) the reference entity, if the reference 
          --   entity is a sovereign, or (b) the jurisdiction in which the 
          --   relevant reference entity is organised, if the reference 
          --   entity is not a sovereign. ISDA 2003 Term: Not Domestic 
          --   Currency
        , delivOblig_notDomesticLaw :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. If 
          --   the reference entity is a Sovereign, this means any 
          --   obligation that is not subject to the laws of the reference 
          --   entity. If the reference entity is not a sovereign, this 
          --   means any obligation that is not subject to the laws of the 
          --   jurisdiction of the reference entity. ISDA 2003 Term: Not 
          --   Domestic Law
        , delivOblig_listed :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Indicates whether or not the obligation is quoted, listed 
          --   or ordinarily purchased and sold on an exchange. ISDA 2003 
          --   Term: Listed
        , delivOblig_notContingent :: Maybe Xsd.Boolean
          -- ^ A deliverable obligation characteristic. In essence Not 
          --   Contingent means the repayment of principal cannot be 
          --   dependant on a formula/index, i.e. to prevent the risk of 
          --   being delivered an instrument that may never pay any 
          --   element of principal, and to ensure that the obligation is 
          --   interest bearing (on a regular schedule). ISDA 2003 Term: 
          --   Not Contingent
        , delivOblig_notDomesticIssuance :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Any obligation other than an obligation that was intended 
          --   to be offered for sale primarily in the domestic market of 
          --   the relevant Reference Entity. This specifies that the 
          --   obligation must be an internationally recognized bond. ISDA 
          --   2003 Term: Not Domestic Issuance
        , delivOblig_assignableLoan :: Maybe PCDeliverableObligationCharac
          -- ^ A deliverable obligation characteristic. A loan that is 
          --   freely assignable to a bank or financial institution 
          --   without the consent of the Reference Entity or the 
          --   guarantor, if any, of the loan (or the consent of the 
          --   applicable borrower if a Reference Entity is guaranteeing 
          --   the loan) or any agent. ISDA 2003 Term: Assignable Loan
        , delivOblig_consentRequiredLoan :: Maybe PCDeliverableObligationCharac
          -- ^ A deliverable obligation characteristic. A loan that is 
          --   capable of being assigned with the consent of the Reference 
          --   Entity or the guarantor, if any, of the loan or any agent. 
          --   ISDA 2003 Term: Consent Required Loan
        , delivOblig_directLoanParticipation :: Maybe LoanParticipation
          -- ^ A deliverable obligation characteristic. A loan with a 
          --   participation agreement whereby the buyer is capable of 
          --   creating, or procuring the creation of, a contractual right 
          --   in favour of the seller that provides the seller with 
          --   recourse to the participation seller for a specified share 
          --   in any payments due under the relevant loan which are 
          --   received by the participation seller. ISDA 2003 Term: 
          --   Direct Loan Participation
        , delivOblig_transferable :: Maybe Xsd.Boolean
          -- ^ A deliverable obligation characteristic. An obligation that 
          --   is transferable to institutional investors without any 
          --   contractual, statutory or regulatory restrictions. ISDA 
          --   2003 Term: Transferable
        , delivOblig_maximumMaturity :: Maybe Period
          -- ^ A deliverable obligation characteristic. An obligation that 
          --   has a remaining maturity from the Physical Settlement Date 
          --   of not greater than the period specified. ISDA 2003 Term: 
          --   Maximum Maturity
        , delivOblig_acceleratedOrMatured :: Maybe Xsd.Boolean
          -- ^ A deliverable obligation characteristic. An obligation at 
          --   time of default is due to mature and due to be repaid, or 
          --   as a result of downgrade/bankruptcy is due to be repaid as 
          --   a result of an acceleration clause. ISDA 2003 Term: 
          --   Accelerated or Matured
        , delivOblig_notBearer :: Maybe Xsd.Boolean
          -- ^ A deliverable obligation characteristic. Any obligation 
          --   that is not a bearer instrument. This applies to Bonds only 
          --   and is meant to avoid tax, fraud and security/delivery 
          --   provisions that can potentially be associated with Bearer 
          --   Bonds. ISDA 2003 Term: Not Bearer
        , delivOblig_choice17 :: (Maybe (OneOf3 Xsd.Boolean Xsd.Boolean Xsd.Boolean))
          -- ^ Choice between:
          --   
          --   (1) An obligation and deliverable obligation 
          --   characteristic. Defined in the ISDA published 
          --   additional provisions for U.S. Municipal as Reference 
          --   Entity. ISDA 2003 Term: Full Faith and Credit 
          --   Obligation Liability
          --   
          --   (2) An obligation and deliverable obligation 
          --   characteristic. Defined in the ISDA published 
          --   additional provisions for U.S. Municipal as Reference 
          --   Entity. ISDA 2003 Term: General Fund Obligation 
          --   Liability
          --   
          --   (3) An obligation and deliverable obligation 
          --   characteristic. Defined in the ISDA published 
          --   additional provisions for U.S. Municipal as Reference 
          --   Entity. ISDA 2003 Term: Revenue Obligation Liability
        , delivOblig_indirectLoanParticipation :: Maybe LoanParticipation
          -- ^ ISDA 1999 Term: Indirect Loan Participation. NOTE: Only 
          --   applicable as a deliverable obligation under ISDA Credit 
          --   1999.
        , delivOblig_excluded :: Maybe Xsd.XsdString
          -- ^ A free format string to specify any excluded obligations or 
          --   deliverable obligations, as the case may be, of the 
          --   reference entity or excluded types of obligations or 
          --   deliverable obligations. ISDA 2003 Term: Excluded 
          --   Obligations/Excluded Deliverable Obligations
        , delivOblig_othReferenceEntityObligations :: Maybe Xsd.XsdString
          -- ^ This element is used to specify any other obligations of a 
          --   reference entity in both obligations and deliverable 
          --   obligations. The obligations can be specified free-form. 
          --   ISDA 2003 Term: Other Obligations of a Reference Entity
        }
        deriving (Eq,Show)
instance SchemaType DeliverableObligations where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return DeliverableObligations
            `apply` optional (parseSchemaType "accruedInterest")
            `apply` optional (parseSchemaType "category")
            `apply` optional (parseSchemaType "notSubordinated")
            `apply` optional (parseSchemaType "specifiedCurrency")
            `apply` optional (parseSchemaType "notSovereignLender")
            `apply` optional (parseSchemaType "notDomesticCurrency")
            `apply` optional (parseSchemaType "notDomesticLaw")
            `apply` optional (parseSchemaType "listed")
            `apply` optional (parseSchemaType "notContingent")
            `apply` optional (parseSchemaType "notDomesticIssuance")
            `apply` optional (parseSchemaType "assignableLoan")
            `apply` optional (parseSchemaType "consentRequiredLoan")
            `apply` optional (parseSchemaType "directLoanParticipation")
            `apply` optional (parseSchemaType "transferable")
            `apply` optional (parseSchemaType "maximumMaturity")
            `apply` optional (parseSchemaType "acceleratedOrMatured")
            `apply` optional (parseSchemaType "notBearer")
            `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf3 (parseSchemaType "fullFaithAndCreditObLiability"))
                                     , ("Xsd.Boolean", fmap TwoOf3 (parseSchemaType "generalFundObligationLiability"))
                                     , ("Xsd.Boolean", fmap ThreeOf3 (parseSchemaType "revenueObligationLiability"))
                                     ])
            `apply` optional (parseSchemaType "indirectLoanParticipation")
            `apply` optional (parseSchemaType "excluded")
            `apply` optional (parseSchemaType "othReferenceEntityObligations")
    schemaTypeToXML s x@DeliverableObligations{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "accruedInterest") $ delivOblig_accruedInterest x
            , maybe [] (schemaTypeToXML "category") $ delivOblig_category x
            , maybe [] (schemaTypeToXML "notSubordinated") $ delivOblig_notSubordinated x
            , maybe [] (schemaTypeToXML "specifiedCurrency") $ delivOblig_specifiedCurrency x
            , maybe [] (schemaTypeToXML "notSovereignLender") $ delivOblig_notSovereignLender x
            , maybe [] (schemaTypeToXML "notDomesticCurrency") $ delivOblig_notDomesticCurrency x
            , maybe [] (schemaTypeToXML "notDomesticLaw") $ delivOblig_notDomesticLaw x
            , maybe [] (schemaTypeToXML "listed") $ delivOblig_listed x
            , maybe [] (schemaTypeToXML "notContingent") $ delivOblig_notContingent x
            , maybe [] (schemaTypeToXML "notDomesticIssuance") $ delivOblig_notDomesticIssuance x
            , maybe [] (schemaTypeToXML "assignableLoan") $ delivOblig_assignableLoan x
            , maybe [] (schemaTypeToXML "consentRequiredLoan") $ delivOblig_consentRequiredLoan x
            , maybe [] (schemaTypeToXML "directLoanParticipation") $ delivOblig_directLoanParticipation x
            , maybe [] (schemaTypeToXML "transferable") $ delivOblig_transferable x
            , maybe [] (schemaTypeToXML "maximumMaturity") $ delivOblig_maximumMaturity x
            , maybe [] (schemaTypeToXML "acceleratedOrMatured") $ delivOblig_acceleratedOrMatured x
            , maybe [] (schemaTypeToXML "notBearer") $ delivOblig_notBearer x
            , maybe [] (foldOneOf3  (schemaTypeToXML "fullFaithAndCreditObLiability")
                                    (schemaTypeToXML "generalFundObligationLiability")
                                    (schemaTypeToXML "revenueObligationLiability")
                                   ) $ delivOblig_choice17 x
            , maybe [] (schemaTypeToXML "indirectLoanParticipation") $ delivOblig_indirectLoanParticipation x
            , maybe [] (schemaTypeToXML "excluded") $ delivOblig_excluded x
            , maybe [] (schemaTypeToXML "othReferenceEntityObligations") $ delivOblig_othReferenceEntityObligations x
            ]
 
-- | Defines a coding scheme of the entity types defined in the 
--   ISDA First to Default documentation.
data EntityType = EntityType Scheme EntityTypeAttributes deriving (Eq,Show)
data EntityTypeAttributes = EntityTypeAttributes
    { entityTypeAttrib_entityTypeScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType EntityType where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "entityTypeScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ EntityType v (EntityTypeAttributes a0)
    schemaTypeToXML s (EntityType bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "entityTypeScheme") $ entityTypeAttrib_entityTypeScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension EntityType Scheme where
    supertype (EntityType s _) = s
 
data FeeLeg = FeeLeg
        { feeLeg_ID :: Maybe Xsd.ID
        , feeLeg_initialPayment :: Maybe InitialPayment
          -- ^ Specifies a single fixed payment that is payable by the 
          --   payer to the receiver on the initial payment date. The 
          --   fixed payment to be paid is specified in terms of a known 
          --   currency amount. This element should be used for CDS Index 
          --   trades and can be used for CDS trades where it is necessary 
          --   to represent a payment from Seller to Buyer. For CDS trades 
          --   where a payment is to be made from Buyer to Seller the 
          --   feeLeg/singlePayment structure must be used.
        , feeLeg_singlePayment :: [SinglePayment]
          -- ^ Specifies a single fixed amount that is payable by the 
          --   buyer to the seller on the fixed rate payer payment date. 
          --   The fixed amount to be paid is specified in terms of a 
          --   known currency amount.
        , feeLeg_periodicPayment :: Maybe PeriodicPayment
          -- ^ Specifies a periodic schedule of fixed amounts that are 
          --   payable by the buyer to the seller on the fixed rate payer 
          --   payment dates. The fixed amount to be paid on each payment 
          --   date can be specified in terms of a known currency amount 
          --   or as an amount calculated on a formula basis by reference 
          --   to a per annum fixed rate. The applicable business day 
          --   convention and business day for adjusting any fixed rate 
          --   payer payment date if it would otherwise fall on a day that 
          --   is not a business day are those specified in the 
          --   dateAdjustments element within the generalTerms component. 
          --   ISDA 2003 Term:
        , feeLeg_marketFixedRate :: Maybe Xsd.Decimal
          -- ^ An optional element that only has meaning in a credit index 
          --   trade. This element contains the credit spread ("fair 
          --   value") at which the trade was executed. Unlike the 
          --   fixedRate of an index, the marketFixedRate varies over the 
          --   life of the index depending on market conditions. The 
          --   marketFixedRate is the price of the index as quoted by 
          --   trading desks.
        , feeLeg_paymentDelay :: Maybe Xsd.Boolean
          -- ^ Applicable to CDS on MBS to specify whether payment delays 
          --   are applicable to the fixed Amount. RMBS typically have a 
          --   payment delay of 5 days between the coupon date of the 
          --   reference obligation and the payment date of the synthetic 
          --   swap. CMBS do not, on the other hand, with both payment 
          --   dates being on the 25th of each month.
        , feeLeg_initialPoints :: Maybe Xsd.Decimal
          -- ^ An optional element that contains the up-front points 
          --   expressed as a percentage of the notional. An initialPoints 
          --   value of 5% would be represented as 0.05. The initialPoints 
          --   element is an alternative to marketFixedRate in quoting the 
          --   traded level of a trade. When initialPoints is used, the 
          --   traded level is the sum of fixedRate and initialPoints. The 
          --   initialPoints is one of the items that are factored into 
          --   the initialPayment calculation and is payable by the Buyer 
          --   to the Seller. Note that initialPoints and marketFixedRate 
          --   may both be present in the same document when both implied 
          --   values are desired.
        , feeLeg_quotationStyle :: Maybe QuotationStyleEnum
          -- ^ The type of quotation that was used between the trading 
          --   desks. The purpose of this element is to indicate the 
          --   actual quotation style that was used to quote this trade 
          --   which may not be apparent when both marketFixedRate and 
          --   initialPoints are included in the document. When 
          --   quotationStyle is ‘PointsUpFront’, the initialPoints 
          --   element should be populated. When quotationStyle is 
          --   ‘TradedSpread’, the marketFixedRate element should be 
          --   populated.
        }
        deriving (Eq,Show)
instance SchemaType FeeLeg where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (FeeLeg a0)
            `apply` optional (parseSchemaType "initialPayment")
            `apply` many (parseSchemaType "singlePayment")
            `apply` optional (parseSchemaType "periodicPayment")
            `apply` optional (parseSchemaType "marketFixedRate")
            `apply` optional (parseSchemaType "paymentDelay")
            `apply` optional (parseSchemaType "initialPoints")
            `apply` optional (parseSchemaType "quotationStyle")
    schemaTypeToXML s x@FeeLeg{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ feeLeg_ID x
                       ]
            [ maybe [] (schemaTypeToXML "initialPayment") $ feeLeg_initialPayment x
            , concatMap (schemaTypeToXML "singlePayment") $ feeLeg_singlePayment x
            , maybe [] (schemaTypeToXML "periodicPayment") $ feeLeg_periodicPayment x
            , maybe [] (schemaTypeToXML "marketFixedRate") $ feeLeg_marketFixedRate x
            , maybe [] (schemaTypeToXML "paymentDelay") $ feeLeg_paymentDelay x
            , maybe [] (schemaTypeToXML "initialPoints") $ feeLeg_initialPoints x
            , maybe [] (schemaTypeToXML "quotationStyle") $ feeLeg_quotationStyle x
            ]
instance Extension FeeLeg Leg where
    supertype v = Leg_FeeLeg v
 
data FixedAmountCalculation = FixedAmountCalculation
        { fixedAmountCalc_calculationAmount :: Maybe CalculationAmount
          -- ^ The notional amount used in the calculation of fixed 
          --   amounts where an amount is calculated on a formula basis, 
          --   i.e. fixed amount = fixed rate payer calculation amount x 
          --   fixed rate x fixed rate day count fraction. ISDA 2003 Term: 
          --   Fixed Rate Payer Calculation Amount.
        , fixedAmountCalc_fixedRate :: FixedRate
          -- ^ The calculation period fixed rate. A per annum rate, 
          --   expressed as a decimal. A fixed rate of 5% would be 
          --   represented as 0.05.
        , fixedAmountCalc_dayCountFraction :: Maybe DayCountFraction
          -- ^ The day count fraction. ISDA 2003 Term: Fixed Rate Day 
          --   Count Fraction.
        }
        deriving (Eq,Show)
instance SchemaType FixedAmountCalculation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return FixedAmountCalculation
            `apply` optional (parseSchemaType "calculationAmount")
            `apply` parseSchemaType "fixedRate"
            `apply` optional (parseSchemaType "dayCountFraction")
    schemaTypeToXML s x@FixedAmountCalculation{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "calculationAmount") $ fixedAmountCalc_calculationAmount x
            , schemaTypeToXML "fixedRate" $ fixedAmountCalc_fixedRate x
            , maybe [] (schemaTypeToXML "dayCountFraction") $ fixedAmountCalc_dayCountFraction x
            ]
 
-- | The calculation period fixed rate. A per annum rate, 
--   expressed as a decimal. A fixed rate of 5% would be 
--   represented as 0.05.
data FixedRate = FixedRate Xsd.Decimal FixedRateAttributes deriving (Eq,Show)
data FixedRateAttributes = FixedRateAttributes
    { fixedRateAttrib_ID :: Maybe Xsd.ID
    }
    deriving (Eq,Show)
instance SchemaType FixedRate where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "id" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ FixedRate v (FixedRateAttributes a0)
    schemaTypeToXML s (FixedRate bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "id") $ fixedRateAttrib_ID at
                         ]
            $ schemaTypeToXML s bt
instance Extension FixedRate Xsd.Decimal where
    supertype (FixedRate s _) = s
 
data FixedRateReference = FixedRateReference
        { fixedRateRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType FixedRateReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (FixedRateReference a0)
    schemaTypeToXML s x@FixedRateReference{} =
        toXMLElement s [ toXMLAttribute "href" $ fixedRateRef_href x
                       ]
            []
instance Extension FixedRateReference Reference where
    supertype v = Reference_FixedRateReference v
 
data FloatingAmountEvents = FloatingAmountEvents
        { floatAmountEvents_failureToPayPrincipal :: Maybe Xsd.Boolean
          -- ^ A floating rate payment event. Corresponds to the failure 
          --   by the Reference Entity to pay an expected principal amount 
          --   or the payment of an actual principal amount that is less 
          --   than the expected principal amount. ISDA 2003 Term: Failure 
          --   to Pay Principal.
        , floatAmountEvents_interestShortfall :: Maybe InterestShortFall
          -- ^ A floating rate payment event. With respect to any 
          --   Reference Obligation Payment Date, either (a) the 
          --   non-payment of an Expected Interest Amount or (b) the 
          --   payment of an Actual Interest Amount that is less than the 
          --   Expected Interest Amount. ISDA 2003 Term: Interest 
          --   Shortfall.
        , floatAmountEvents_writedown :: Maybe Xsd.Boolean
          -- ^ A floating rate payment event. Results from the fact that 
          --   the underlyer writes down its outstanding principal amount. 
          --   ISDA 2003 Term: Writedown.
        , floatAmountEvents_impliedWritedown :: Maybe Xsd.Boolean
          -- ^ A floating rate payment event. Results from the fact that 
          --   losses occur to the underlying instruments that do not 
          --   result in reductions of the outstanding principal of the 
          --   reference obligation.
        , floatAmountEvents_floatingAmountProvisions :: Maybe FloatingAmountProvisions
          -- ^ Specifies the floating amount provisions associated with 
          --   the floatingAmountEvents.
        , floatAmountEvents_additionalFixedPayments :: Maybe AdditionalFixedPayments
          -- ^ Specifies the events that will give rise to the payment a 
          --   additional fixed payments.
        }
        deriving (Eq,Show)
instance SchemaType FloatingAmountEvents where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return FloatingAmountEvents
            `apply` optional (parseSchemaType "failureToPayPrincipal")
            `apply` optional (parseSchemaType "interestShortfall")
            `apply` optional (parseSchemaType "writedown")
            `apply` optional (parseSchemaType "impliedWritedown")
            `apply` optional (parseSchemaType "floatingAmountProvisions")
            `apply` optional (parseSchemaType "additionalFixedPayments")
    schemaTypeToXML s x@FloatingAmountEvents{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "failureToPayPrincipal") $ floatAmountEvents_failureToPayPrincipal x
            , maybe [] (schemaTypeToXML "interestShortfall") $ floatAmountEvents_interestShortfall x
            , maybe [] (schemaTypeToXML "writedown") $ floatAmountEvents_writedown x
            , maybe [] (schemaTypeToXML "impliedWritedown") $ floatAmountEvents_impliedWritedown x
            , maybe [] (schemaTypeToXML "floatingAmountProvisions") $ floatAmountEvents_floatingAmountProvisions x
            , maybe [] (schemaTypeToXML "additionalFixedPayments") $ floatAmountEvents_additionalFixedPayments x
            ]
 
data FloatingAmountProvisions = FloatingAmountProvisions
        { floatAmountProvis_wACCapInterestProvision :: Maybe Xsd.Boolean
          -- ^ As specified by the ISDA Supplement for use with trades on 
          --   mortgage-backed securities, "WAC Cap" means a weighted 
          --   average coupon or weighted average rate cap provision 
          --   (however defined in the Underlying Instruments) of the 
          --   Underlying Instruments that limits, increases or decreases 
          --   the interest rate or interest entitlement, as set out in 
          --   the Underlying Instruments on the Effective Date without 
          --   regard to any subsequent amendment The presence of the 
          --   element with value set to 'true' signifies that the 
          --   provision is applicable. From a usage standpoint, this 
          --   provision is typically applicable in the case of CMBS and 
          --   not applicable in case of RMBS trades.
        , floatAmountProvis_stepUpProvision :: Maybe Xsd.Boolean
          -- ^ As specified by the ISDA Standard Terms Supplement for use 
          --   with trades on mortgage-backed securities. The presence of 
          --   the element with value set to 'true' signifies that the 
          --   provision is applicable. If applicable, the applicable 
          --   step-up terms are specified as part of that ISDA Standard 
          --   Terms Supplement. From a usage standpoint, this provision 
          --   is typically applicable in the case of RMBS and not 
          --   applicable in case of CMBS trades.
        }
        deriving (Eq,Show)
instance SchemaType FloatingAmountProvisions where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return FloatingAmountProvisions
            `apply` optional (parseSchemaType "WACCapInterestProvision")
            `apply` optional (parseSchemaType "stepUpProvision")
    schemaTypeToXML s x@FloatingAmountProvisions{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "WACCapInterestProvision") $ floatAmountProvis_wACCapInterestProvision x
            , maybe [] (schemaTypeToXML "stepUpProvision") $ floatAmountProvis_stepUpProvision x
            ]
 
data GeneralTerms = GeneralTerms
        { generalTerms_effectiveDate :: AdjustableDate2
          -- ^ The first day of the term of the trade. This day may be 
          --   subject to adjustment in accordance with a business day 
          --   convention. ISDA 2003 Term: Effective Date.
        , generalTerms_scheduledTerminationDate :: AdjustableDate2
          -- ^ The scheduled date on which the credit protection will 
          --   lapse. This day may be subject to adjustment in accordance 
          --   with a business day convention. ISDA 2003 Term: Scheduled 
          --   Termination Date.
        , generalTerms_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.
        , generalTerms_buyerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that buys this instrument.
        , generalTerms_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.
        , generalTerms_sellerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that sells this instrument.
        , generalTerms_dateAdjustments :: Maybe BusinessDayAdjustments
          -- ^ ISDA 2003 Terms: Business Day and Business Day Convention.
        , generalTerms_choice7 :: OneOf3 ReferenceInformation IndexReferenceInformation BasketReferenceInformation
          -- ^ Choice between:
          --   
          --   (1) This element contains all the terms relevant to 
          --   defining the reference entity and reference 
          --   obligation(s).
          --   
          --   (2) This element contains all the terms relevant to 
          --   defining the Credit DefaultSwap Index.
          --   
          --   (3) This element contains all the terms relevant to 
          --   defining the Credit Default Swap Basket.
        , generalTerms_additionalTerm :: [AdditionalTerm]
          -- ^ This element is used for representing information contained 
          --   in the Additional Terms field of the 2003 Master Credit 
          --   Derivatives confirm.
        , generalTerms_substitution :: Maybe Xsd.Boolean
          -- ^ Value of this element set to 'true' indicates that 
          --   substitution is applicable.
        , generalTerms_modifiedEquityDelivery :: Maybe Xsd.Boolean
          -- ^ Value of this element set to 'true' indicates that modified 
          --   equity delivery is applicable.
        }
        deriving (Eq,Show)
instance SchemaType GeneralTerms where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return GeneralTerms
            `apply` parseSchemaType "effectiveDate"
            `apply` parseSchemaType "scheduledTerminationDate"
            `apply` optional (parseSchemaType "buyerPartyReference")
            `apply` optional (parseSchemaType "buyerAccountReference")
            `apply` optional (parseSchemaType "sellerPartyReference")
            `apply` optional (parseSchemaType "sellerAccountReference")
            `apply` optional (parseSchemaType "dateAdjustments")
            `apply` oneOf' [ ("ReferenceInformation", fmap OneOf3 (parseSchemaType "referenceInformation"))
                           , ("IndexReferenceInformation", fmap TwoOf3 (parseSchemaType "indexReferenceInformation"))
                           , ("BasketReferenceInformation", fmap ThreeOf3 (parseSchemaType "basketReferenceInformation"))
                           ]
            `apply` many (parseSchemaType "additionalTerm")
            `apply` optional (parseSchemaType "substitution")
            `apply` optional (parseSchemaType "modifiedEquityDelivery")
    schemaTypeToXML s x@GeneralTerms{} =
        toXMLElement s []
            [ schemaTypeToXML "effectiveDate" $ generalTerms_effectiveDate x
            , schemaTypeToXML "scheduledTerminationDate" $ generalTerms_scheduledTerminationDate x
            , maybe [] (schemaTypeToXML "buyerPartyReference") $ generalTerms_buyerPartyReference x
            , maybe [] (schemaTypeToXML "buyerAccountReference") $ generalTerms_buyerAccountReference x
            , maybe [] (schemaTypeToXML "sellerPartyReference") $ generalTerms_sellerPartyReference x
            , maybe [] (schemaTypeToXML "sellerAccountReference") $ generalTerms_sellerAccountReference x
            , maybe [] (schemaTypeToXML "dateAdjustments") $ generalTerms_dateAdjustments x
            , foldOneOf3  (schemaTypeToXML "referenceInformation")
                          (schemaTypeToXML "indexReferenceInformation")
                          (schemaTypeToXML "basketReferenceInformation")
                          $ generalTerms_choice7 x
            , concatMap (schemaTypeToXML "additionalTerm") $ generalTerms_additionalTerm x
            , maybe [] (schemaTypeToXML "substitution") $ generalTerms_substitution x
            , maybe [] (schemaTypeToXML "modifiedEquityDelivery") $ generalTerms_modifiedEquityDelivery x
            ]
 
data IndexAnnexSource = IndexAnnexSource Scheme IndexAnnexSourceAttributes deriving (Eq,Show)
data IndexAnnexSourceAttributes = IndexAnnexSourceAttributes
    { indexAnnexSourceAttrib_indexAnnexSourceScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType IndexAnnexSource where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "indexAnnexSourceScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ IndexAnnexSource v (IndexAnnexSourceAttributes a0)
    schemaTypeToXML s (IndexAnnexSource bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "indexAnnexSourceScheme") $ indexAnnexSourceAttrib_indexAnnexSourceScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension IndexAnnexSource Scheme where
    supertype (IndexAnnexSource s _) = s
 
data IndexId = IndexId Scheme IndexIdAttributes deriving (Eq,Show)
data IndexIdAttributes = IndexIdAttributes
    { indexIdAttrib_indexIdScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType IndexId where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "indexIdScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ IndexId v (IndexIdAttributes a0)
    schemaTypeToXML s (IndexId bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "indexIdScheme") $ indexIdAttrib_indexIdScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension IndexId Scheme where
    supertype (IndexId s _) = s
 
data IndexName = IndexName Scheme IndexNameAttributes deriving (Eq,Show)
data IndexNameAttributes = IndexNameAttributes
    { indexNameAttrib_indexNameScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType IndexName where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "indexNameScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ IndexName v (IndexNameAttributes a0)
    schemaTypeToXML s (IndexName bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "indexNameScheme") $ indexNameAttrib_indexNameScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension IndexName Scheme where
    supertype (IndexName s _) = s
 
-- | A type defining a Credit Default Swap Index.
data IndexReferenceInformation = IndexReferenceInformation
        { indexRefInfo_ID :: Maybe Xsd.ID
        , indexRefInfo_choice0 :: OneOf2 (IndexName,[IndexId]) [IndexId]
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * The name of the index expressed as a free format 
          --   string. FpML does not define usage rules for this 
          --   element.
          --   
          --     * A CDS index identifier (e.g. RED pair code).
          --   
          --   (2) A CDS index identifier (e.g. RED pair code).
        , indexRefInfo_indexSeries :: Maybe Xsd.PositiveInteger
          -- ^ A CDS index series identifier, e.g. 1, 2, 3 etc.
        , indexRefInfo_indexAnnexVersion :: Maybe Xsd.PositiveInteger
          -- ^ A CDS index series version identifier, e.g. 1, 2, 3 etc.
        , indexRefInfo_indexAnnexDate :: Maybe Xsd.Date
          -- ^ A CDS index series annex date.
        , indexRefInfo_indexAnnexSource :: Maybe IndexAnnexSource
          -- ^ A CDS index series annex source.
        , indexRefInfo_excludedReferenceEntity :: [LegalEntity]
          -- ^ Excluded reference entity.
        , indexRefInfo_tranche :: Maybe Tranche
          -- ^ This element contains CDS tranche terms.
        , indexRefInfo_settledEntityMatrix :: Maybe SettledEntityMatrix
          -- ^ Used to specify the Relevant Settled Entity Matrix when 
          --   there are settled entities at the time of the trade.
        }
        deriving (Eq,Show)
instance SchemaType IndexReferenceInformation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (IndexReferenceInformation a0)
            `apply` oneOf' [ ("IndexName [IndexId]", fmap OneOf2 (return (,) `apply` parseSchemaType "indexName"
                                                                             `apply` many (parseSchemaType "indexId")))
                           , ("[IndexId]", fmap TwoOf2 (many1 (parseSchemaType "indexId")))
                           ]
            `apply` optional (parseSchemaType "indexSeries")
            `apply` optional (parseSchemaType "indexAnnexVersion")
            `apply` optional (parseSchemaType "indexAnnexDate")
            `apply` optional (parseSchemaType "indexAnnexSource")
            `apply` many (parseSchemaType "excludedReferenceEntity")
            `apply` optional (parseSchemaType "tranche")
            `apply` optional (parseSchemaType "settledEntityMatrix")
    schemaTypeToXML s x@IndexReferenceInformation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ indexRefInfo_ID x
                       ]
            [ foldOneOf2  (\ (a,b) -> concat [ schemaTypeToXML "indexName" a
                                             , concatMap (schemaTypeToXML "indexId") b
                                             ])
                          (concatMap (schemaTypeToXML "indexId"))
                          $ indexRefInfo_choice0 x
            , maybe [] (schemaTypeToXML "indexSeries") $ indexRefInfo_indexSeries x
            , maybe [] (schemaTypeToXML "indexAnnexVersion") $ indexRefInfo_indexAnnexVersion x
            , maybe [] (schemaTypeToXML "indexAnnexDate") $ indexRefInfo_indexAnnexDate x
            , maybe [] (schemaTypeToXML "indexAnnexSource") $ indexRefInfo_indexAnnexSource x
            , concatMap (schemaTypeToXML "excludedReferenceEntity") $ indexRefInfo_excludedReferenceEntity x
            , maybe [] (schemaTypeToXML "tranche") $ indexRefInfo_tranche x
            , maybe [] (schemaTypeToXML "settledEntityMatrix") $ indexRefInfo_settledEntityMatrix x
            ]
 
data InitialPayment = InitialPayment
        { initialPayment_ID :: Maybe Xsd.ID
        , initialPayment_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , initialPayment_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , initialPayment_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , initialPayment_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , initialPayment_adjustablePaymentDate :: Maybe Xsd.Date
          -- ^ A fixed payment date that shall be subject to adjustment in 
          --   accordance with the applicable business day convention if 
          --   it would otherwise fall on a day that is not a business 
          --   day. The applicable business day convention and business 
          --   day are those specified in the dateAdjustments element 
          --   within the generalTerms component.
        , initialPayment_adjustedPaymentDate :: Maybe Xsd.Date
          -- ^ The adjusted payment date. This date should already be 
          --   adjusted for any applicable business day convention. This 
          --   component is not intended for use in trade confirmation but 
          --   may be specified to allow the fee structure to also serve 
          --   as a cashflow type component.
        , initialPayment_paymentAmount :: Money
          -- ^ A fixed payment amount.
        }
        deriving (Eq,Show)
instance SchemaType InitialPayment where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (InitialPayment a0)
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (parseSchemaType "adjustablePaymentDate")
            `apply` optional (parseSchemaType "adjustedPaymentDate")
            `apply` parseSchemaType "paymentAmount"
    schemaTypeToXML s x@InitialPayment{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ initialPayment_ID x
                       ]
            [ maybe [] (schemaTypeToXML "payerPartyReference") $ initialPayment_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ initialPayment_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ initialPayment_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ initialPayment_receiverAccountReference x
            , maybe [] (schemaTypeToXML "adjustablePaymentDate") $ initialPayment_adjustablePaymentDate x
            , maybe [] (schemaTypeToXML "adjustedPaymentDate") $ initialPayment_adjustedPaymentDate x
            , schemaTypeToXML "paymentAmount" $ initialPayment_paymentAmount x
            ]
instance Extension InitialPayment PaymentBase where
    supertype v = PaymentBase_InitialPayment v
 
data InterestShortFall = InterestShortFall
        { interShortFall_interestShortfallCap :: Maybe InterestShortfallCapEnum
          -- ^ Specifies the nature of the interest Shortfall cap (i.e. 
          --   Fixed Cap or Variable Cap) in the case where it is 
          --   applicable. ISDA 2003 Term: Interest Shortfall Cap.
        , interShortFall_compounding :: Maybe Xsd.Boolean
        , interShortFall_rateSource :: Maybe FloatingRateIndex
          -- ^ The rate source in the case of a variable cap.
        }
        deriving (Eq,Show)
instance SchemaType InterestShortFall where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return InterestShortFall
            `apply` optional (parseSchemaType "interestShortfallCap")
            `apply` optional (parseSchemaType "compounding")
            `apply` optional (parseSchemaType "rateSource")
    schemaTypeToXML s x@InterestShortFall{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "interestShortfallCap") $ interShortFall_interestShortfallCap x
            , maybe [] (schemaTypeToXML "compounding") $ interShortFall_compounding x
            , maybe [] (schemaTypeToXML "rateSource") $ interShortFall_rateSource x
            ]
 
data LoanParticipation = LoanParticipation
        { loanPartic_applicable :: Maybe Xsd.Boolean
          -- ^ Indicates whether the provision is applicable.
        , loanPartic_partialCashSettlement :: Maybe Xsd.Boolean
          -- ^ Specifies whether either 'Partial Cash Settlement of 
          --   Assignable Loans', 'Partial Cash Settlement of Consent 
          --   Required Loans' or 'Partial Cash Settlement of 
          --   Participations' is applicable. If this element is specified 
          --   and Assignable Loan is a Deliverable Obligation 
          --   Chracteristic, any Assignable Loan that is deliverable, but 
          --   where a non-receipt of Consent by the Physical Settlement 
          --   Date has occurred, the Loan can be cash settled rather than 
          --   physically delivered. If this element is specified and 
          --   Consent Required Loan is a Deliverable Obligation 
          --   Characterisitc, any Consent Required Loan that is 
          --   deliverable, but where a non-receipt of Consent by the 
          --   Physical Settlement Date has occurred, the Loan can be cash 
          --   settled rather than physically delivered. If this element 
          --   is specified and Direct Loan Participation is a Deliverable 
          --   Obligation Characterisitic, any Participation that is 
          --   deliverable, but where this participation has not been 
          --   effected (has not come into effect) by the Physical 
          --   Settlement Date, the participation can be cash settled 
          --   rather than physically delivered.
        , loanPartic_qualifyingParticipationSeller :: Maybe Xsd.XsdString
          -- ^ If Direct Loan Participation is specified as a deliverable 
          --   obligation characteristic, this specifies any requirements 
          --   for the Qualifying Participation Seller. The requirements 
          --   may be listed free-form. ISDA 2003 Term: Qualifying 
          --   Participation Seller
        }
        deriving (Eq,Show)
instance SchemaType LoanParticipation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return LoanParticipation
            `apply` optional (parseSchemaType "applicable")
            `apply` optional (parseSchemaType "partialCashSettlement")
            `apply` optional (parseSchemaType "qualifyingParticipationSeller")
    schemaTypeToXML s x@LoanParticipation{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "applicable") $ loanPartic_applicable x
            , maybe [] (schemaTypeToXML "partialCashSettlement") $ loanPartic_partialCashSettlement x
            , maybe [] (schemaTypeToXML "qualifyingParticipationSeller") $ loanPartic_qualifyingParticipationSeller x
            ]
instance Extension LoanParticipation PCDeliverableObligationCharac where
    supertype (LoanParticipation e0 e1 e2) =
               PCDeliverableObligationCharac e0 e1
 
data MatrixSource = MatrixSource Scheme MatrixSourceAttributes deriving (Eq,Show)
data MatrixSourceAttributes = MatrixSourceAttributes
    { matrixSourceAttrib_settledEntityMatrixSourceScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType MatrixSource where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "settledEntityMatrixSourceScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ MatrixSource v (MatrixSourceAttributes a0)
    schemaTypeToXML s (MatrixSource bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "settledEntityMatrixSourceScheme") $ matrixSourceAttrib_settledEntityMatrixSourceScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension MatrixSource Scheme where
    supertype (MatrixSource s _) = s
 
data MultipleValuationDates = MultipleValuationDates
        { multiValDates_businessDays :: Maybe Xsd.NonNegativeInteger
          -- ^ A number of business days. Its precise meaning is dependant 
          --   on the context in which this element is used. ISDA 2003 
          --   Term: Business Day
        , multiValDates_businessDaysThereafter :: Maybe Xsd.PositiveInteger
          -- ^ The number of business days between successive valuation 
          --   dates when multiple valuation dates are applicable for cash 
          --   settlement. ISDA 2003 Term: Business Days thereafter
        , multiValDates_numberValuationDates :: Maybe Xsd.PositiveInteger
          -- ^ Where multiple valuation dates are specified as being 
          --   applicable for cash settlement, this element specifies (a) 
          --   the number of applicable valuation dates, and (b) the 
          --   number of business days after satisfaction of all 
          --   conditions to settlement when the first such valuation date 
          --   occurs, and (c) the number of business days thereafter of 
          --   each successive valuation date. ISDA 2003 Term: Multiple 
          --   Valuation Dates
        }
        deriving (Eq,Show)
instance SchemaType MultipleValuationDates where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return MultipleValuationDates
            `apply` optional (parseSchemaType "businessDays")
            `apply` optional (parseSchemaType "businessDaysThereafter")
            `apply` optional (parseSchemaType "numberValuationDates")
    schemaTypeToXML s x@MultipleValuationDates{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "businessDays") $ multiValDates_businessDays x
            , maybe [] (schemaTypeToXML "businessDaysThereafter") $ multiValDates_businessDaysThereafter x
            , maybe [] (schemaTypeToXML "numberValuationDates") $ multiValDates_numberValuationDates x
            ]
instance Extension MultipleValuationDates SingleValuationDate where
    supertype (MultipleValuationDates e0 e1 e2) =
               SingleValuationDate e0
 
data NotDomesticCurrency = NotDomesticCurrency
        { notDomestCurren_applicable :: Maybe Xsd.Boolean
          -- ^ Indicates whether the not domestic currency provision is 
          --   applicable.
        , notDomestCurren_currency :: Maybe Currency
          -- ^ An explicit specification of the domestic currency.
        }
        deriving (Eq,Show)
instance SchemaType NotDomesticCurrency where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return NotDomesticCurrency
            `apply` optional (parseSchemaType "applicable")
            `apply` optional (parseSchemaType "currency")
    schemaTypeToXML s x@NotDomesticCurrency{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "applicable") $ notDomestCurren_applicable x
            , maybe [] (schemaTypeToXML "currency") $ notDomestCurren_currency x
            ]
 
data Obligations = Obligations
        { obligations_category :: Maybe ObligationCategoryEnum
          -- ^ Used in both obligations and deliverable obligations to 
          --   represent a class or type of securities which apply. ISDA 
          --   2003 Term: Obligation Category/Deliverable Obligation 
          --   Category
        , obligations_notSubordinated :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. An 
          --   obligation that ranks at least equal with the most senior 
          --   Reference Obligation in priority of payment or, if no 
          --   Reference Obligation is specified in the related 
          --   Confirmation, the obligations of the Reference Entity that 
          --   are senior. ISDA 2003 Term: Not Subordinated
        , obligations_specifiedCurrency :: Maybe SpecifiedCurrency
          -- ^ An obligation and deliverable obligation characteristic. 
          --   The currency or currencies in which an obligation or 
          --   deliverable obligation must be payable. ISDA 2003 Term: 
          --   Specified Currency
        , obligations_notSovereignLender :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Any obligation that is not primarily (majority) owed to a 
          --   Sovereign or Supranational Organization. ISDA 2003 Term: 
          --   Not Sovereign Lender
        , obligations_notDomesticCurrency :: Maybe NotDomesticCurrency
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Any obligation that is payable in any currency other than 
          --   the domestic currency. Domestic currency is either the 
          --   currency so specified or, if no currency is specified, the 
          --   currency of (a) the reference entity, if the reference 
          --   entity is a sovereign, or (b) the jurisdiction in which the 
          --   relevant reference entity is organised, if the reference 
          --   entity is not a sovereign. ISDA 2003 Term: Not Domestic 
          --   Currency
        , obligations_notDomesticLaw :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. If 
          --   the reference entity is a Sovereign, this means any 
          --   obligation that is not subject to the laws of the reference 
          --   entity. If the reference entity is not a sovereign, this 
          --   means any obligation that is not subject to the laws of the 
          --   jurisdiction of the reference entity. ISDA 2003 Term: Not 
          --   Domestic Law
        , obligations_listed :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Indicates whether or not the obligation is quoted, listed 
          --   or ordinarily purchased and sold on an exchange. ISDA 2003 
          --   Term: Listed
        , obligations_notDomesticIssuance :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Any obligation other than an obligation that was intended 
          --   to be offered for sale primarily in the domestic market of 
          --   the relevant Reference Entity. This specifies that the 
          --   obligation must be an internationally recognized bond. ISDA 
          --   2003 Term: Not Domestic Issuance
        , obligations_choice8 :: (Maybe (OneOf3 Xsd.Boolean Xsd.Boolean Xsd.Boolean))
          -- ^ Choice between:
          --   
          --   (1) An obligation and deliverable obligation 
          --   characteristic. Defined in the ISDA published 
          --   additional provisions for U.S. Municipal as Reference 
          --   Entity. ISDA 2003 Term: Full Faith and Credit 
          --   Obligation Liability
          --   
          --   (2) An obligation and deliverable obligation 
          --   characteristic. Defined in the ISDA published 
          --   additional provisions for U.S. Municipal as Reference 
          --   Entity. ISDA 2003 Term: General Fund Obligation 
          --   Liability
          --   
          --   (3) An obligation and deliverable obligation 
          --   characteristic. Defined in the ISDA published 
          --   additional provisions for U.S. Municipal as Reference 
          --   Entity. ISDA 2003 Term: Revenue Obligation Liability
        , obligations_notContingent :: Maybe Xsd.Boolean
          -- ^ NOTE: Only allowed as an obligation charcteristic under 
          --   ISDA Credit 1999. In essence Not Contingent means the 
          --   repayment of principal cannot be dependant on a 
          --   formula/index, i.e. to prevent the risk of being delivered 
          --   an instrument that may never pay any element of principal, 
          --   and to ensure that the obligation is interest bearing (on a 
          --   regular schedule). ISDA 2003 Term: Not Contingent
        , obligations_excluded :: Maybe Xsd.XsdString
          -- ^ A free format string to specify any excluded obligations or 
          --   deliverable obligations, as the case may be, of the 
          --   reference entity or excluded types of obligations or 
          --   deliverable obligations. ISDA 2003 Term: Excluded 
          --   Obligations/Excluded Deliverable Obligations
        , obligations_othReferenceEntityObligations :: Maybe Xsd.XsdString
          -- ^ This element is used to specify any other obligations of a 
          --   reference entity in both obligations and deliverable 
          --   obligations. The obligations can be specified free-form. 
          --   ISDA 2003 Term: Other Obligations of a Reference Entity
        , obligations_designatedPriority :: Maybe Lien
          -- ^ Applies to Loan CDS, to indicate what lien level is 
          --   appropriate for a deliverable obligation. Applies to 
          --   European Loan CDS, to indicate the Ranking of the 
          --   obligation. Example: a 2nd lien Loan CDS would imply that 
          --   the deliverable obligations are 1st or 2nd lien loans.
        , obligations_cashSettlementOnly :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Defined in the ISDA published Standard Terms Supplement for 
          --   use with CDS Transactions on Leveraged Loans. ISDA 2003 
          --   Term: Cash Settlement Only.
        , obligations_deliveryOfCommitments :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Defined in the ISDA published Standard Terms Supplement for 
          --   use with CDS Transactions on Leveraged Loans. ISDA 2003 
          --   Term: Delivery of Commitments.
        , obligations_continuity :: Maybe Xsd.Boolean
          -- ^ An obligation and deliverable obligation characteristic. 
          --   Defined in the ISDA published Standard Terms Supplement for 
          --   use with CDS Transactions on Leveraged Loans. ISDA 2003 
          --   Term: Continuity.
        }
        deriving (Eq,Show)
instance SchemaType Obligations where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Obligations
            `apply` optional (parseSchemaType "category")
            `apply` optional (parseSchemaType "notSubordinated")
            `apply` optional (parseSchemaType "specifiedCurrency")
            `apply` optional (parseSchemaType "notSovereignLender")
            `apply` optional (parseSchemaType "notDomesticCurrency")
            `apply` optional (parseSchemaType "notDomesticLaw")
            `apply` optional (parseSchemaType "listed")
            `apply` optional (parseSchemaType "notDomesticIssuance")
            `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf3 (parseSchemaType "fullFaithAndCreditObLiability"))
                                     , ("Xsd.Boolean", fmap TwoOf3 (parseSchemaType "generalFundObligationLiability"))
                                     , ("Xsd.Boolean", fmap ThreeOf3 (parseSchemaType "revenueObligationLiability"))
                                     ])
            `apply` optional (parseSchemaType "notContingent")
            `apply` optional (parseSchemaType "excluded")
            `apply` optional (parseSchemaType "othReferenceEntityObligations")
            `apply` optional (parseSchemaType "designatedPriority")
            `apply` optional (parseSchemaType "cashSettlementOnly")
            `apply` optional (parseSchemaType "deliveryOfCommitments")
            `apply` optional (parseSchemaType "continuity")
    schemaTypeToXML s x@Obligations{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "category") $ obligations_category x
            , maybe [] (schemaTypeToXML "notSubordinated") $ obligations_notSubordinated x
            , maybe [] (schemaTypeToXML "specifiedCurrency") $ obligations_specifiedCurrency x
            , maybe [] (schemaTypeToXML "notSovereignLender") $ obligations_notSovereignLender x
            , maybe [] (schemaTypeToXML "notDomesticCurrency") $ obligations_notDomesticCurrency x
            , maybe [] (schemaTypeToXML "notDomesticLaw") $ obligations_notDomesticLaw x
            , maybe [] (schemaTypeToXML "listed") $ obligations_listed x
            , maybe [] (schemaTypeToXML "notDomesticIssuance") $ obligations_notDomesticIssuance x
            , maybe [] (foldOneOf3  (schemaTypeToXML "fullFaithAndCreditObLiability")
                                    (schemaTypeToXML "generalFundObligationLiability")
                                    (schemaTypeToXML "revenueObligationLiability")
                                   ) $ obligations_choice8 x
            , maybe [] (schemaTypeToXML "notContingent") $ obligations_notContingent x
            , maybe [] (schemaTypeToXML "excluded") $ obligations_excluded x
            , maybe [] (schemaTypeToXML "othReferenceEntityObligations") $ obligations_othReferenceEntityObligations x
            , maybe [] (schemaTypeToXML "designatedPriority") $ obligations_designatedPriority x
            , maybe [] (schemaTypeToXML "cashSettlementOnly") $ obligations_cashSettlementOnly x
            , maybe [] (schemaTypeToXML "deliveryOfCommitments") $ obligations_deliveryOfCommitments x
            , maybe [] (schemaTypeToXML "continuity") $ obligations_continuity x
            ]
 
data PCDeliverableObligationCharac = PCDeliverableObligationCharac
        { pCDelivObligCharac_applicable :: Maybe Xsd.Boolean
          -- ^ Indicates whether the provision is applicable.
        , pCDelivObligCharac_partialCashSettlement :: Maybe Xsd.Boolean
          -- ^ Specifies whether either 'Partial Cash Settlement of 
          --   Assignable Loans', 'Partial Cash Settlement of Consent 
          --   Required Loans' or 'Partial Cash Settlement of 
          --   Participations' is applicable. If this element is specified 
          --   and Assignable Loan is a Deliverable Obligation 
          --   Chracteristic, any Assignable Loan that is deliverable, but 
          --   where a non-receipt of Consent by the Physical Settlement 
          --   Date has occurred, the Loan can be cash settled rather than 
          --   physically delivered. If this element is specified and 
          --   Consent Required Loan is a Deliverable Obligation 
          --   Characterisitc, any Consent Required Loan that is 
          --   deliverable, but where a non-receipt of Consent by the 
          --   Physical Settlement Date has occurred, the Loan can be cash 
          --   settled rather than physically delivered. If this element 
          --   is specified and Direct Loan Participation is a Deliverable 
          --   Obligation Characterisitic, any Participation that is 
          --   deliverable, but where this participation has not been 
          --   effected (has not come into effect) by the Physical 
          --   Settlement Date, the participation can be cash settled 
          --   rather than physically delivered.
        }
        deriving (Eq,Show)
instance SchemaType PCDeliverableObligationCharac where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PCDeliverableObligationCharac
            `apply` optional (parseSchemaType "applicable")
            `apply` optional (parseSchemaType "partialCashSettlement")
    schemaTypeToXML s x@PCDeliverableObligationCharac{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "applicable") $ pCDelivObligCharac_applicable x
            , maybe [] (schemaTypeToXML "partialCashSettlement") $ pCDelivObligCharac_partialCashSettlement x
            ]
 
data PeriodicPayment = PeriodicPayment
        { periodPayment_ID :: Maybe Xsd.ID
        , periodPayment_paymentFrequency :: Maybe Period
          -- ^ The time interval between regular fixed rate payer payment 
          --   dates.
        , periodPayment_firstPeriodStartDate :: Maybe Xsd.Date
          -- ^ The start date of the initial calculation period if such 
          --   date is not equal to the trade’s effective date. It must 
          --   only be specified if it is not equal to the effective date. 
          --   The applicable business day convention and business day are 
          --   those specified in the dateAdjustments element within the 
          --   generalTerms component (or in a transaction supplement FpML 
          --   representation defined within the referenced general terms 
          --   confirmation agreement).
        , periodPayment_firstPaymentDate :: Maybe Xsd.Date
          -- ^ The first unadjusted fixed rate payer payment date. The 
          --   applicable business day convention and business day are 
          --   those specified in the dateAdjustments element within the 
          --   generalTerms component (or in a transaction supplement FpML 
          --   representation defined within the referenced general terms 
          --   confirmation agreement). ISDA 2003 Term: Fixed Rate Payer 
          --   Payment Date
        , periodPayment_lastRegularPaymentDate :: Maybe Xsd.Date
          -- ^ The last regular unadjusted fixed rate payer payment date. 
          --   The applicable business day convention and business day are 
          --   those specified in the dateAdjustments element within the 
          --   generalTerms component (or in a transaction supplement FpML 
          --   representation defined within the referenced general terms 
          --   confirmation agreement). This element should only be 
          --   included if there is a final payment stub, i.e. where the 
          --   last regular unadjusted fixed rate payer payment date is 
          --   not equal to the scheduled termination date. ISDA 2003 
          --   Term: Fixed Rate Payer Payment Date
        , periodPayment_rollConvention :: Maybe RollConventionEnum
          -- ^ Used in conjunction with the effectiveDate, 
          --   scheduledTerminationDate, firstPaymentDate, 
          --   lastRegularPaymentDate and paymentFrequency to determine 
          --   the regular fixed rate payer payment dates.
        , periodPayment_choice5 :: OneOf2 Money FixedAmountCalculation
          -- ^ Choice between:
          --   
          --   (1) A fixed payment amount. ISDA 2003 Term: Fixed Amount
          --   
          --   (2) This element contains all the terms relevant to 
          --   calculating a fixed amount where the fixed amount is 
          --   calculated by reference to a per annum fixed rate. 
          --   There is no corresponding ISDA 2003 Term. The 
          --   equivalent is Sec 5.1 "Calculation of Fixed Amount" but 
          --   this in itself is not a defined Term.
        , periodPayment_adjustedPaymentDates :: [AdjustedPaymentDates]
          -- ^ An optional cashflow-like structure allowing the equivalent 
          --   representation of the periodic fixed payments in terms of a 
          --   series of adjusted payment dates and amounts. This is 
          --   intended to support application integration within an 
          --   organisation and is not intended for use in inter-firm 
          --   communication or confirmations. ISDA 2003 Term: Fixed Rate 
          --   Payer Payment Date
        }
        deriving (Eq,Show)
instance SchemaType PeriodicPayment where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (PeriodicPayment a0)
            `apply` optional (parseSchemaType "paymentFrequency")
            `apply` optional (parseSchemaType "firstPeriodStartDate")
            `apply` optional (parseSchemaType "firstPaymentDate")
            `apply` optional (parseSchemaType "lastRegularPaymentDate")
            `apply` optional (parseSchemaType "rollConvention")
            `apply` oneOf' [ ("Money", fmap OneOf2 (parseSchemaType "fixedAmount"))
                           , ("FixedAmountCalculation", fmap TwoOf2 (parseSchemaType "fixedAmountCalculation"))
                           ]
            `apply` many (parseSchemaType "adjustedPaymentDates")
    schemaTypeToXML s x@PeriodicPayment{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ periodPayment_ID x
                       ]
            [ maybe [] (schemaTypeToXML "paymentFrequency") $ periodPayment_paymentFrequency x
            , maybe [] (schemaTypeToXML "firstPeriodStartDate") $ periodPayment_firstPeriodStartDate x
            , maybe [] (schemaTypeToXML "firstPaymentDate") $ periodPayment_firstPaymentDate x
            , maybe [] (schemaTypeToXML "lastRegularPaymentDate") $ periodPayment_lastRegularPaymentDate x
            , maybe [] (schemaTypeToXML "rollConvention") $ periodPayment_rollConvention x
            , foldOneOf2  (schemaTypeToXML "fixedAmount")
                          (schemaTypeToXML "fixedAmountCalculation")
                          $ periodPayment_choice5 x
            , concatMap (schemaTypeToXML "adjustedPaymentDates") $ periodPayment_adjustedPaymentDates x
            ]
instance Extension PeriodicPayment PaymentBase where
    supertype v = PaymentBase_PeriodicPayment v
 
data PhysicalSettlementPeriod = PhysicalSettlementPeriod
        { physicSettlPeriod_choice0 :: (Maybe (OneOf3 Xsd.Boolean Xsd.NonNegativeInteger Xsd.NonNegativeInteger))
          -- ^ Choice between:
          --   
          --   (1) An explicit indication that a number of business days 
          --   are not specified and therefore ISDA fallback 
          --   provisions should apply.
          --   
          --   (2) A number of business days. Its precise meaning is 
          --   dependant on the context in which this element is used. 
          --   ISDA 2003 Term: Business Day
          --   
          --   (3) A maximum number of business days. Its precise meaning 
          --   is dependant on the context in which this element is 
          --   used. Intended to be used to limit a particular ISDA 
          --   fallback provision.
        }
        deriving (Eq,Show)
instance SchemaType PhysicalSettlementPeriod where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PhysicalSettlementPeriod
            `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf3 (parseSchemaType "businessDaysNotSpecified"))
                                     , ("Xsd.NonNegativeInteger", fmap TwoOf3 (parseSchemaType "businessDays"))
                                     , ("Xsd.NonNegativeInteger", fmap ThreeOf3 (parseSchemaType "maximumBusinessDays"))
                                     ])
    schemaTypeToXML s x@PhysicalSettlementPeriod{} =
        toXMLElement s []
            [ maybe [] (foldOneOf3  (schemaTypeToXML "businessDaysNotSpecified")
                                    (schemaTypeToXML "businessDays")
                                    (schemaTypeToXML "maximumBusinessDays")
                                   ) $ physicSettlPeriod_choice0 x
            ]
 
data PhysicalSettlementTerms = PhysicalSettlementTerms
        { physicSettlTerms_ID :: Maybe Xsd.ID
        , physicSettlTerms_settlementCurrency :: Maybe Currency
          -- ^ ISDA 2003 Term: Settlement Currency
        , physicSettlTerms_physicalSettlementPeriod :: Maybe PhysicalSettlementPeriod
          -- ^ The number of business days used in the determination of 
          --   the physical settlement date. The physical settlement date 
          --   is this number of business days after all applicable 
          --   conditions to settlement are satisfied. If a number of 
          --   business days is not specified fallback provisions apply 
          --   for determining the number of business days. If Section 
          --   8.5/8.6 of the 1999/2003 ISDA Definitions are to apply the 
          --   businessDaysNotSpecified element should be included. If a 
          --   specified number of business days are to apply these should 
          --   be specified in the businessDays element. If Section 
          --   8.5/8.6 of the 1999/2003 ISDA Definitions are to apply but 
          --   capped at a maximum number of business days then the 
          --   maximum number should be specified in the 
          --   maximumBusinessDays element. ISDA 2003 Term: Physical 
          --   Settlement Period
        , physicSettlTerms_deliverableObligations :: Maybe DeliverableObligations
          -- ^ This element contains all the ISDA terms relevant to 
          --   defining the deliverable obligations.
        , physicSettlTerms_escrow :: Maybe Xsd.Boolean
          -- ^ If this element is specified and set to 'true', indicates 
          --   that physical settlement must take place through the use of 
          --   an escrow agent. (For Canadian counterparties this is 
          --   always "Not Applicable". ISDA 2003 Term: Escrow.
        , physicSettlTerms_sixtyBusinessDaySettlementCap :: Maybe Xsd.Boolean
          -- ^ If this element is specified and set to 'true', for a 
          --   transaction documented under the 2003 ISDA Credit 
          --   Derivatives Definitions, has the effect of incorporating 
          --   the language set forth below into the confirmation. The 
          --   section references are to the 2003 ISDA Credit Derivatives 
          --   Definitions. Notwithstanding Section 1.7 or any provisions 
          --   of Sections 9.9 or 9.10 to the contrary, but without 
          --   prejudice to Section 9.3 and (where applicable) Sections 
          --   9.4, 9.5 and 9.6, if the Termination Date has not occurred 
          --   on or prior to the date that is 60 Business Days following 
          --   the Physical Settlement Date, such 60th Business Day shall 
          --   be deemed to be the Termination Date with respect to this 
          --   Transaction except in relation to any portion of the 
          --   Transaction (an "Affected Portion") in respect of which: 
          --   (1) a valid notice of Buy-in Price has been delivered that 
          --   is effective fewer than three Business Days prior to such 
          --   60th Business Day, in which case the Termination Date for 
          --   that Affected Portion shall be the third Business Day 
          --   following the date on which such notice is effective; or 
          --   (2) Buyer has purchased but not Delivered Deliverable 
          --   Obligations validly specified by Seller pursuant to Section 
          --   9.10(b), in which case the Termination Date for that 
          --   Affected Portion shall be the tenth Business Day following 
          --   the date on which Seller validly specified such Deliverable 
          --   Obligations to Buyer.
        }
        deriving (Eq,Show)
instance SchemaType PhysicalSettlementTerms where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (PhysicalSettlementTerms a0)
            `apply` optional (parseSchemaType "settlementCurrency")
            `apply` optional (parseSchemaType "physicalSettlementPeriod")
            `apply` optional (parseSchemaType "deliverableObligations")
            `apply` optional (parseSchemaType "escrow")
            `apply` optional (parseSchemaType "sixtyBusinessDaySettlementCap")
    schemaTypeToXML s x@PhysicalSettlementTerms{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ physicSettlTerms_ID x
                       ]
            [ maybe [] (schemaTypeToXML "settlementCurrency") $ physicSettlTerms_settlementCurrency x
            , maybe [] (schemaTypeToXML "physicalSettlementPeriod") $ physicSettlTerms_physicalSettlementPeriod x
            , maybe [] (schemaTypeToXML "deliverableObligations") $ physicSettlTerms_deliverableObligations x
            , maybe [] (schemaTypeToXML "escrow") $ physicSettlTerms_escrow x
            , maybe [] (schemaTypeToXML "sixtyBusinessDaySettlementCap") $ physicSettlTerms_sixtyBusinessDaySettlementCap x
            ]
instance Extension PhysicalSettlementTerms SettlementTerms where
    supertype (PhysicalSettlementTerms a0 e0 e1 e2 e3 e4) =
               SettlementTerms a0 e0
 
data ProtectionTerms = ProtectionTerms
        { protecTerms_ID :: Maybe Xsd.ID
        , protecTerms_calculationAmount :: Money
          -- ^ The notional amount of protection coverage. ISDA 2003 Term: 
          --   Floating Rate Payer Calculation Amount
        , protecTerms_creditEvents :: Maybe CreditEvents
          -- ^ This element contains all the ISDA terms relating to credit 
          --   events.
        , protecTerms_obligations :: Maybe Obligations
          -- ^ The underlying obligations of the reference entity on which 
          --   you are buying or selling protection. The credit events 
          --   Failure to Pay, Obligation Acceleration, Obligation 
          --   Default, Restructuring, Repudiation/Moratorium are defined 
          --   with respect to these obligations. ISDA 2003 Term:
        , protecTerms_floatingAmountEvents :: Maybe FloatingAmountEvents
          -- ^ This element contains the ISDA terms relating to the 
          --   floating rate payment events and the implied additional 
          --   fixed payments, applicable to the credit derivatives 
          --   transactions on mortgage-backed securities with 
          --   pay-as-you-go or physical settlement.
        }
        deriving (Eq,Show)
instance SchemaType ProtectionTerms where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ProtectionTerms a0)
            `apply` parseSchemaType "calculationAmount"
            `apply` optional (parseSchemaType "creditEvents")
            `apply` optional (parseSchemaType "obligations")
            `apply` optional (parseSchemaType "floatingAmountEvents")
    schemaTypeToXML s x@ProtectionTerms{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ protecTerms_ID x
                       ]
            [ schemaTypeToXML "calculationAmount" $ protecTerms_calculationAmount x
            , maybe [] (schemaTypeToXML "creditEvents") $ protecTerms_creditEvents x
            , maybe [] (schemaTypeToXML "obligations") $ protecTerms_obligations x
            , maybe [] (schemaTypeToXML "floatingAmountEvents") $ protecTerms_floatingAmountEvents x
            ]
 
-- | Reference to protectionTerms component.
data ProtectionTermsReference = ProtectionTermsReference
        { protecTermsRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType ProtectionTermsReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (ProtectionTermsReference a0)
    schemaTypeToXML s x@ProtectionTermsReference{} =
        toXMLElement s [ toXMLAttribute "href" $ protecTermsRef_href x
                       ]
            []
instance Extension ProtectionTermsReference Reference where
    supertype v = Reference_ProtectionTermsReference v
 
data ReferenceInformation = ReferenceInformation
        { refInfo_referenceEntity :: LegalEntity
          -- ^ The corporate or sovereign entity on which you are buying 
          --   or selling protection and any successor that assumes all or 
          --   substantially all of its contractual and other obligations. 
          --   It is vital to use the correct legal name of the entity and 
          --   to be careful not to choose a subsidiary if you really want 
          --   to trade protection on a parent company. Please note, 
          --   Reference Entities cannot be senior or subordinated. It is 
          --   the obligations of the Reference Entities that can be 
          --   senior or subordinated. ISDA 2003 Term: Reference Entity
        , refInfo_choice1 :: (Maybe (OneOf3 [ReferenceObligation] Xsd.Boolean Xsd.Boolean))
          -- ^ Choice between:
          --   
          --   (1) The Reference Obligation is a financial instrument that 
          --   is either issued or guaranteed by the reference entity. 
          --   It serves to clarify the precise reference entity 
          --   protection is being offered upon, and its legal 
          --   position with regard to other related firms 
          --   (parents/subsidiaries). Furthermore the Reference 
          --   Obligation is ALWAYS deliverable and establishes the 
          --   Pari Passu ranking (as the deliverable bonds must rank 
          --   equal to the reference obligation). ISDA 2003 Term: 
          --   Reference Obligation
          --   
          --   (2) Used to indicate that there is no Reference Obligation 
          --   associated with this Credit Default Swap and that there 
          --   will never be one.
          --   
          --   (3) Used to indicate that the Reference obligation 
          --   associated with the Credit Default Swap is currently 
          --   not known. This is not valid for Legal Confirmation 
          --   purposes, but is valid for earlier stages in the trade 
          --   life cycle (e.g. Broker Confirmation).
        , refInfo_allGuarantees :: Maybe Xsd.Boolean
          -- ^ Indicates whether an obligation of the Reference Entity, 
          --   guaranteed by the Reference Entity on behalf of a 
          --   non-Affiliate, is to be considered an Obligation for the 
          --   purpose of the transaction. It will be considered an 
          --   obligation if allGuarantees is applicable (true) and not if 
          --   allGuarantees is inapplicable (false). ISDA 2003 Term: All 
          --   Guarantees
        , refInfo_referencePrice :: Maybe Xsd.Decimal
          -- ^ Used to determine (a) for physically settled trades, the 
          --   Physical Settlement Amount, which equals the Floating Rate 
          --   Payer Calculation Amount times the Reference Price and (b) 
          --   for cash settled trades, the Cash Settlement Amount, which 
          --   equals the greater of (i) the difference between the 
          --   Reference Price and the Final Price and (ii) zero. ISDA 
          --   2003 Term: Reference Price
        , refInfo_referencePolicy :: Maybe Xsd.Boolean
          -- ^ Applicable to the transactions on mortgage-backed security, 
          --   which can make use of a reference policy. Presence of the 
          --   element with value set to 'true' indicates that the 
          --   reference policy is applicable; absence implies that it is 
          --   not.
        , refInfo_securedList :: Maybe Xsd.Boolean
          -- ^ With respect to any day, the list of Syndicated Secured 
          --   Obligations of the Designated Priority of the Reference 
          --   Entity published by Markit Group Limited or any successor 
          --   thereto appointed by the Specified Dealers (the "Secured 
          --   List Publisher") on or most recently before such day, which 
          --   list is currently available at [http://www.markit.com]. 
          --   ISDA 2003 Term: Relevant Secured List.
        }
        deriving (Eq,Show)
instance SchemaType ReferenceInformation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReferenceInformation
            `apply` parseSchemaType "referenceEntity"
            `apply` optional (oneOf' [ ("[ReferenceObligation]", fmap OneOf3 (many1 (parseSchemaType "referenceObligation")))
                                     , ("Xsd.Boolean", fmap TwoOf3 (parseSchemaType "noReferenceObligation"))
                                     , ("Xsd.Boolean", fmap ThreeOf3 (parseSchemaType "unknownReferenceObligation"))
                                     ])
            `apply` optional (parseSchemaType "allGuarantees")
            `apply` optional (parseSchemaType "referencePrice")
            `apply` optional (parseSchemaType "referencePolicy")
            `apply` optional (parseSchemaType "securedList")
    schemaTypeToXML s x@ReferenceInformation{} =
        toXMLElement s []
            [ schemaTypeToXML "referenceEntity" $ refInfo_referenceEntity x
            , maybe [] (foldOneOf3  (concatMap (schemaTypeToXML "referenceObligation"))
                                    (schemaTypeToXML "noReferenceObligation")
                                    (schemaTypeToXML "unknownReferenceObligation")
                                   ) $ refInfo_choice1 x
            , maybe [] (schemaTypeToXML "allGuarantees") $ refInfo_allGuarantees x
            , maybe [] (schemaTypeToXML "referencePrice") $ refInfo_referencePrice x
            , maybe [] (schemaTypeToXML "referencePolicy") $ refInfo_referencePolicy x
            , maybe [] (schemaTypeToXML "securedList") $ refInfo_securedList x
            ]
 
data ReferenceObligation = ReferenceObligation
        { refOblig_choice0 :: (Maybe (OneOf4 Bond ConvertibleBond Mortgage Loan))
          -- ^ Choice between:
          --   
          --   (1) Identifies the underlying asset when it is a series or 
          --   a class of bonds.
          --   
          --   (2) Identifies the underlying asset when it is a 
          --   convertible bond.
          --   
          --   (3) Identifies a mortgage backed security.
          --   
          --   (4) Identifies a simple underlying asset that is a loan.
        , refOblig_choice1 :: (Maybe (OneOf2 LegalEntity LegalEntityReference))
          -- ^ Choice between:
          --   
          --   (1) The entity primarily responsible for repaying debt to a 
          --   creditor as a result of borrowing or issuing bonds. 
          --   ISDA 2003 Term: Primary Obligor
          --   
          --   (2) A pointer style reference to a reference entity defined 
          --   elsewhere in the document. Used when the reference 
          --   entity is the primary obligor.
        , refOblig_choice2 :: [OneOf2 LegalEntity LegalEntityReference]
          -- ^ Choice between:
          --   
          --   (1) The party that guarantees by way of a contractual 
          --   arrangement to pay the debts of an obligor if the 
          --   obligor is unable to make the required payments itself. 
          --   ISDA 2003 Term: Guarantor
          --   
          --   (2) A pointer style reference to a reference entity defined 
          --   elsewhere in the document. Used when the reference 
          --   entity is the guarantor.
        }
        deriving (Eq,Show)
instance SchemaType ReferenceObligation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReferenceObligation
            `apply` optional (oneOf' [ ("Bond", fmap OneOf4 (elementBond))
                                     , ("ConvertibleBond", fmap TwoOf4 (elementConvertibleBond))
                                     , ("Mortgage", fmap ThreeOf4 (elementMortgage))
                                     , ("Loan", fmap FourOf4 (elementLoan))
                                     ])
            `apply` optional (oneOf' [ ("LegalEntity", fmap OneOf2 (parseSchemaType "primaryObligor"))
                                     , ("LegalEntityReference", fmap TwoOf2 (parseSchemaType "primaryObligorReference"))
                                     ])
            `apply` many (oneOf' [ ("LegalEntity", fmap OneOf2 (parseSchemaType "guarantor"))
                                 , ("LegalEntityReference", fmap TwoOf2 (parseSchemaType "guarantorReference"))
                                 ])
    schemaTypeToXML s x@ReferenceObligation{} =
        toXMLElement s []
            [ maybe [] (foldOneOf4  (elementToXMLBond)
                                    (elementToXMLConvertibleBond)
                                    (elementToXMLMortgage)
                                    (elementToXMLLoan)
                                   ) $ refOblig_choice0 x
            , maybe [] (foldOneOf2  (schemaTypeToXML "primaryObligor")
                                    (schemaTypeToXML "primaryObligorReference")
                                   ) $ refOblig_choice1 x
            , concatMap (foldOneOf2  (schemaTypeToXML "guarantor")
                                     (schemaTypeToXML "guarantorReference")
                                    ) $ refOblig_choice2 x
            ]
 
data ReferencePair = ReferencePair
        { refPair_referenceEntity :: Maybe LegalEntity
          -- ^ The corporate or sovereign entity on which you are buying 
          --   or selling protection and any successor that assumes all or 
          --   substantially all of its contractual and other obligations. 
          --   It is vital to use the correct legal name of the entity and 
          --   to be careful not to choose a subsidiary if you really want 
          --   to trade protection on a parent company. Please note, 
          --   Reference Entities cannot be senior or subordinated. It is 
          --   the obligations of the Reference Entities that can be 
          --   senior or subordinated. ISDA 2003 Term: Reference Entity
        , refPair_choice1 :: (Maybe (OneOf2 ReferenceObligation Xsd.Boolean))
          -- ^ Choice between:
          --   
          --   (1) The Reference Obligation is a financial instrument that 
          --   is either issued or guaranteed by the reference entity. 
          --   It serves to clarify the precise reference entity 
          --   protection is being offered upon, and its legal 
          --   position with regard to other related firms 
          --   (parents/subsidiaries). Furthermore the Reference 
          --   Obligation is ALWAYS deliverable and establishes the 
          --   Pari Passu ranking (as the deliverable bonds must rank 
          --   equal to the reference obligation). ISDA 2003 Term: 
          --   Reference Obligation
          --   
          --   (2) Used to indicate that there is no Reference Obligation 
          --   associated with this Credit Default Swap and that there 
          --   will never be one.
        , refPair_entityType :: Maybe EntityType
          -- ^ Defines the reference entity types corresponding to a list 
          --   of types in the ISDA First to Default documentation.
        }
        deriving (Eq,Show)
instance SchemaType ReferencePair where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReferencePair
            `apply` optional (parseSchemaType "referenceEntity")
            `apply` optional (oneOf' [ ("ReferenceObligation", fmap OneOf2 (parseSchemaType "referenceObligation"))
                                     , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "noReferenceObligation"))
                                     ])
            `apply` optional (parseSchemaType "entityType")
    schemaTypeToXML s x@ReferencePair{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "referenceEntity") $ refPair_referenceEntity x
            , maybe [] (foldOneOf2  (schemaTypeToXML "referenceObligation")
                                    (schemaTypeToXML "noReferenceObligation")
                                   ) $ refPair_choice1 x
            , maybe [] (schemaTypeToXML "entityType") $ refPair_entityType x
            ]
 
-- | This type contains all the reference pool items to define 
--   the reference entity and reference obligation(s) in the 
--   basket.
data ReferencePool = ReferencePool
        { referencePool_item :: [ReferencePoolItem]
        }
        deriving (Eq,Show)
instance SchemaType ReferencePool where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReferencePool
            `apply` many (parseSchemaType "referencePoolItem")
    schemaTypeToXML s x@ReferencePool{} =
        toXMLElement s []
            [ concatMap (schemaTypeToXML "referencePoolItem") $ referencePool_item x
            ]
 
-- | This type contains all the constituent weight and reference 
--   information.
data ReferencePoolItem = ReferencePoolItem
        { refPoolItem_constituentWeight :: Maybe ConstituentWeight
          -- ^ Describes the weight of each of the constituents within the 
          --   basket. If not provided, it is assumed to be equal 
          --   weighted.
        , refPoolItem_referencePair :: Maybe ReferencePair
        , refPoolItem_protectionTermsReference :: Maybe ProtectionTermsReference
          -- ^ Reference to the documentation terms applicable to this 
          --   item.
        , refPoolItem_settlementTermsReference :: Maybe SettlementTermsReference
          -- ^ Reference to the settlement terms applicable to this item.
        }
        deriving (Eq,Show)
instance SchemaType ReferencePoolItem where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReferencePoolItem
            `apply` optional (parseSchemaType "constituentWeight")
            `apply` optional (parseSchemaType "referencePair")
            `apply` optional (parseSchemaType "protectionTermsReference")
            `apply` optional (parseSchemaType "settlementTermsReference")
    schemaTypeToXML s x@ReferencePoolItem{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "constituentWeight") $ refPoolItem_constituentWeight x
            , maybe [] (schemaTypeToXML "referencePair") $ refPoolItem_referencePair x
            , maybe [] (schemaTypeToXML "protectionTermsReference") $ refPoolItem_protectionTermsReference x
            , maybe [] (schemaTypeToXML "settlementTermsReference") $ refPoolItem_settlementTermsReference x
            ]
 
data SettledEntityMatrix = SettledEntityMatrix
        { settledEntityMatrix_matrixSource :: Maybe MatrixSource
          -- ^ Relevant settled entity matrix source.
        , settledEntityMatrix_publicationDate :: Maybe Xsd.Date
          -- ^ Specifies the publication date of the applicable version of 
          --   the matrix. When this element is omitted, the Standard 
          --   Terms Supplement defines rules for which version of the 
          --   matrix is applicable.
        }
        deriving (Eq,Show)
instance SchemaType SettledEntityMatrix where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return SettledEntityMatrix
            `apply` optional (parseSchemaType "matrixSource")
            `apply` optional (parseSchemaType "publicationDate")
    schemaTypeToXML s x@SettledEntityMatrix{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "matrixSource") $ settledEntityMatrix_matrixSource x
            , maybe [] (schemaTypeToXML "publicationDate") $ settledEntityMatrix_publicationDate x
            ]
 
data SettlementTerms = SettlementTerms
        { settlTerms_ID :: Maybe Xsd.ID
        , settlTerms_settlementCurrency :: Maybe Currency
          -- ^ ISDA 2003 Term: Settlement Currency
        }
        deriving (Eq,Show)
instance SchemaType SettlementTerms where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (SettlementTerms a0)
            `apply` optional (parseSchemaType "settlementCurrency")
    schemaTypeToXML s x@SettlementTerms{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ settlTerms_ID x
                       ]
            [ maybe [] (schemaTypeToXML "settlementCurrency") $ settlTerms_settlementCurrency x
            ]
 
-- | Reference to a settlement terms derived construct 
--   (cashSettlementTerms or physicalSettlementTerms).
data SettlementTermsReference = SettlementTermsReference
        { settlTermsRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType SettlementTermsReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (SettlementTermsReference a0)
    schemaTypeToXML s x@SettlementTermsReference{} =
        toXMLElement s [ toXMLAttribute "href" $ settlTermsRef_href x
                       ]
            []
instance Extension SettlementTermsReference Reference where
    supertype v = Reference_SettlementTermsReference v
 
data SinglePayment = SinglePayment
        { singlePayment_ID :: Maybe Xsd.ID
        , singlePayment_adjustablePaymentDate :: Maybe Xsd.Date
          -- ^ A fixed amount payment date that shall be subject to 
          --   adjustment in accordance with the applicable business day 
          --   convention if it would otherwise fall on a day that is not 
          --   a business day. The applicable business day convention and 
          --   business day are those specified in the dateAdjustments 
          --   element within the generalTerms component. ISDA 2003 Term: 
          --   Fixed Rate Payer Payment Date
        , singlePayment_adjustedPaymentDate :: Maybe Xsd.Date
          -- ^ The adjusted payment date. This date should already be 
          --   adjusted for any applicable business day convention. This 
          --   component is not intended for use in trade confirmation but 
          --   may be specified to allow the fee structure to also serve 
          --   as a cashflow type component.
        , singlePayment_fixedAmount :: Money
          -- ^ A fixed payment amount. ISDA 2003 Term: Fixed Amount
        }
        deriving (Eq,Show)
instance SchemaType SinglePayment where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (SinglePayment a0)
            `apply` optional (parseSchemaType "adjustablePaymentDate")
            `apply` optional (parseSchemaType "adjustedPaymentDate")
            `apply` parseSchemaType "fixedAmount"
    schemaTypeToXML s x@SinglePayment{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ singlePayment_ID x
                       ]
            [ maybe [] (schemaTypeToXML "adjustablePaymentDate") $ singlePayment_adjustablePaymentDate x
            , maybe [] (schemaTypeToXML "adjustedPaymentDate") $ singlePayment_adjustedPaymentDate x
            , schemaTypeToXML "fixedAmount" $ singlePayment_fixedAmount x
            ]
instance Extension SinglePayment PaymentBase where
    supertype v = PaymentBase_SinglePayment v
 
data SingleValuationDate = SingleValuationDate
        { singleValDate_businessDays :: Maybe Xsd.NonNegativeInteger
          -- ^ A number of business days. Its precise meaning is dependant 
          --   on the context in which this element is used. ISDA 2003 
          --   Term: Business Day
        }
        deriving (Eq,Show)
instance SchemaType SingleValuationDate where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return SingleValuationDate
            `apply` optional (parseSchemaType "businessDays")
    schemaTypeToXML s x@SingleValuationDate{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "businessDays") $ singleValDate_businessDays x
            ]
 
data SpecifiedCurrency = SpecifiedCurrency
        { specifCurren_applicable :: Maybe Xsd.Boolean
          -- ^ Indicates whether the specified currency provision is 
          --   applicable.
        , specifCurren_currency :: [Currency]
          -- ^ The currency in which an amount is denominated.
        }
        deriving (Eq,Show)
instance SchemaType SpecifiedCurrency where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return SpecifiedCurrency
            `apply` optional (parseSchemaType "applicable")
            `apply` many (parseSchemaType "currency")
    schemaTypeToXML s x@SpecifiedCurrency{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "applicable") $ specifCurren_applicable x
            , concatMap (schemaTypeToXML "currency") $ specifCurren_currency x
            ]
 
-- | This type represents a CDS Tranche.
data Tranche = Tranche
        { tranche_attachmentPoint :: Maybe Xsd.Decimal
          -- ^ Lower bound percentage of the loss that the Tranche can 
          --   endure, expressed as a decimal. An attachment point of 5% 
          --   would be represented as 0.05. The difference between 
          --   Attachment and Exhaustion points is call the width of the 
          --   Tranche. A schema facet to constraint the value between 0 
          --   to 1 will be introduced in FpML 4.3.
        , tranche_exhaustionPoint :: Maybe Xsd.Decimal
          -- ^ Upper bound percentage of the loss that the Tranche can 
          --   endure, expressed as a decimal. An exhaustion point of 5% 
          --   would be represented as 0.05. The difference between 
          --   Attachment and Exhaustion points is call the width of the 
          --   Tranche. A schema facet to constraint the value between 0 
          --   to 1 will be introduced in FpML 4.3.
        , tranche_incurredRecoveryApplicable :: Maybe Xsd.Boolean
          -- ^ Outstanding Swap Notional Amount is defined at any time on 
          --   any day, as the greater of: (a) Zero; If Incurred Recovery 
          --   Amount Applicable: (b) The Original Swap Notional Amount 
          --   minus the sum of all Incurred Loss Amounts and all Incurred 
          --   Recovery Amounts (if any) determined under this 
          --   Confirmation at or prior to such time.Incurred Recovery 
          --   Amount not populated: (b) The Original Swap Notional Amount 
          --   minus the sum of all Incurred Loss Amounts determined under 
          --   this Confirmation at or prior to such time.
        }
        deriving (Eq,Show)
instance SchemaType Tranche where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Tranche
            `apply` optional (parseSchemaType "attachmentPoint")
            `apply` optional (parseSchemaType "exhaustionPoint")
            `apply` optional (parseSchemaType "incurredRecoveryApplicable")
    schemaTypeToXML s x@Tranche{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "attachmentPoint") $ tranche_attachmentPoint x
            , maybe [] (schemaTypeToXML "exhaustionPoint") $ tranche_exhaustionPoint x
            , maybe [] (schemaTypeToXML "incurredRecoveryApplicable") $ tranche_incurredRecoveryApplicable x
            ]
 
data ValuationDate = ValuationDate
        { valDate_choice0 :: (Maybe (OneOf2 SingleValuationDate MultipleValuationDates))
          -- ^ Choice between:
          --   
          --   (1) Where single valuation date is specified as being 
          --   applicable for cash settlement, this element specifies 
          --   the number of business days after satisfaction of all 
          --   conditions to settlement when such valuation date 
          --   occurs. ISDA 2003 Term: Single Valuation Date
          --   
          --   (2) Where multiple valuation dates are specified as being 
          --   applicable for cash settlement, this element specifies 
          --   (a) the number of applicable valuation dates, and (b) 
          --   the number of business days after satisfaction of all 
          --   conditions to settlement when the first such valuation 
          --   date occurs, and (c) the number of business days 
          --   thereafter of each successive valuation date. ISDA 2003 
          --   Term: Multiple Valuation Dates
        }
        deriving (Eq,Show)
instance SchemaType ValuationDate where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ValuationDate
            `apply` optional (oneOf' [ ("SingleValuationDate", fmap OneOf2 (parseSchemaType "singleValuationDate"))
                                     , ("MultipleValuationDates", fmap TwoOf2 (parseSchemaType "multipleValuationDates"))
                                     ])
    schemaTypeToXML s x@ValuationDate{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "singleValuationDate")
                                    (schemaTypeToXML "multipleValuationDates")
                                   ) $ valDate_choice0 x
            ]
 
-- | A limited version of the CDS type used as an underlyer to 
--   CDS options in Transparency view, to avoid requiring 
--   product type etc.
data LimitedCreditDefaultSwap = LimitedCreditDefaultSwap
        { limitedCreditDefaultSwap_generalTerms :: GeneralTerms
          -- ^ This element contains all the data that appears in the 
          --   section entitled "1. General Terms" in the 2003 ISDA Credit 
          --   Derivatives Confirmation.
        , limitedCreditDefaultSwap_feeLeg :: FeeLeg
          -- ^ This element contains all the terms relevant to defining 
          --   the fixed amounts/payments per the applicable ISDA 
          --   definitions.
        , limitedCreditDefaultSwap_protectionTerms :: [ProtectionTerms]
          -- ^ This element contains all the terms relevant to defining 
          --   the applicable floating rate payer calculation amount, 
          --   credit events and associated conditions to settlement, and 
          --   reference obligations.
        }
        deriving (Eq,Show)
instance SchemaType LimitedCreditDefaultSwap where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return LimitedCreditDefaultSwap
            `apply` parseSchemaType "generalTerms"
            `apply` parseSchemaType "feeLeg"
            `apply` many1 (parseSchemaType "protectionTerms")
    schemaTypeToXML s x@LimitedCreditDefaultSwap{} =
        toXMLElement s []
            [ schemaTypeToXML "generalTerms" $ limitedCreditDefaultSwap_generalTerms x
            , schemaTypeToXML "feeLeg" $ limitedCreditDefaultSwap_feeLeg x
            , concatMap (schemaTypeToXML "protectionTerms") $ limitedCreditDefaultSwap_protectionTerms x
            ]
 
-- | In a credit default swap one party (the protection seller) 
--   agrees to compensate another party (the protection buyer) 
--   if a specified company or Sovereign (the reference entity) 
--   experiences a credit event, indicating it is or may be 
--   unable to service its debts. The protection seller is 
--   typically paid a fee and/or premium, expressed as an 
--   annualized percent of the notional in basis points, 
--   regularly over the life of the transaction or otherwise as 
--   agreed by the parties.
elementCreditDefaultSwap :: XMLParser CreditDefaultSwap
elementCreditDefaultSwap = parseSchemaType "creditDefaultSwap"
elementToXMLCreditDefaultSwap :: CreditDefaultSwap -> [Content ()]
elementToXMLCreditDefaultSwap = schemaTypeToXML "creditDefaultSwap"
 
-- | An option on a credit default swap.
elementCreditDefaultSwapOption :: XMLParser CreditDefaultSwapOption
elementCreditDefaultSwapOption = parseSchemaType "creditDefaultSwapOption"
elementToXMLCreditDefaultSwapOption :: CreditDefaultSwapOption -> [Content ()]
elementToXMLCreditDefaultSwapOption = schemaTypeToXML "creditDefaultSwapOption"