{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Shared.Option
  ( module Data.FpML.V53.Shared.Option
  , module Data.FpML.V53.Asset
  ) 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.Asset
 
-- Some hs-boot imports are required, for fwd-declaring types.
import {-# SOURCE #-} Data.FpML.V53.FX ( FxOption )
import {-# SOURCE #-} Data.FpML.V53.FX ( FxDigitalOption )
import {-# SOURCE #-} Data.FpML.V53.Swaps.Variance ( VarianceOptionTransactionSupplement )
import {-# SOURCE #-} Data.FpML.V53.CD ( CreditDefaultSwapOption )
import {-# SOURCE #-} Data.FpML.V53.Option.Bond ( BondOption )
 
-- | As per ISDA 2002 Definitions.
data Asian = Asian
        { asian_averagingInOut :: Maybe AveragingInOutEnum
        , asian_strikeFactor :: Maybe Xsd.Decimal
          -- ^ The factor of strike.
        , asian_averagingPeriodIn :: Maybe AveragingPeriod
          -- ^ The averaging in period.
        , asian_averagingPeriodOut :: Maybe AveragingPeriod
          -- ^ The averaging out period.
        }
        deriving (Eq,Show)
instance SchemaType Asian where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Asian
            `apply` optional (parseSchemaType "averagingInOut")
            `apply` optional (parseSchemaType "strikeFactor")
            `apply` optional (parseSchemaType "averagingPeriodIn")
            `apply` optional (parseSchemaType "averagingPeriodOut")
    schemaTypeToXML s x@Asian{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "averagingInOut") $ asian_averagingInOut x
            , maybe [] (schemaTypeToXML "strikeFactor") $ asian_strikeFactor x
            , maybe [] (schemaTypeToXML "averagingPeriodIn") $ asian_averagingPeriodIn x
            , maybe [] (schemaTypeToXML "averagingPeriodOut") $ asian_averagingPeriodOut x
            ]
 
-- | An un ordered list of weighted averaging observations.
data AveragingObservationList = AveragingObservationList
        { averagObservList_averagingObservation :: [WeightedAveragingObservation]
          -- ^ A single weighted averaging observation.
        }
        deriving (Eq,Show)
instance SchemaType AveragingObservationList where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return AveragingObservationList
            `apply` many (parseSchemaType "averagingObservation")
    schemaTypeToXML s x@AveragingObservationList{} =
        toXMLElement s []
            [ concatMap (schemaTypeToXML "averagingObservation") $ averagObservList_averagingObservation x
            ]
 
-- | Period over which an average value is taken.
data AveragingPeriod = AveragingPeriod
        { averagPeriod_schedule :: [AveragingSchedule]
          -- ^ A schedule for generating averaging observation dates.
        , averagPeriod_choice1 :: (Maybe (OneOf2 DateTimeList AveragingObservationList))
          -- ^ A choice between unweighted and weighted averaging date and 
          --   times.
          --   
          --   Choice between:
          --   
          --   (1) An unweighted list of averaging observation date and 
          --   times.
          --   
          --   (2) A weighted list of averaging observation date and 
          --   times.
        , averagPeriod_marketDisruption :: Maybe MarketDisruption
          -- ^ The market disruption event as defined by ISDA 2002 
          --   Definitions.
        }
        deriving (Eq,Show)
instance SchemaType AveragingPeriod where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return AveragingPeriod
            `apply` many (parseSchemaType "schedule")
            `apply` optional (oneOf' [ ("DateTimeList", fmap OneOf2 (parseSchemaType "averagingDateTimes"))
                                     , ("AveragingObservationList", fmap TwoOf2 (parseSchemaType "averagingObservations"))
                                     ])
            `apply` optional (parseSchemaType "marketDisruption")
    schemaTypeToXML s x@AveragingPeriod{} =
        toXMLElement s []
            [ concatMap (schemaTypeToXML "schedule") $ averagPeriod_schedule x
            , maybe [] (foldOneOf2  (schemaTypeToXML "averagingDateTimes")
                                    (schemaTypeToXML "averagingObservations")
                                   ) $ averagPeriod_choice1 x
            , maybe [] (schemaTypeToXML "marketDisruption") $ averagPeriod_marketDisruption x
            ]
 
-- | Method of generating a series of dates.
data AveragingSchedule = AveragingSchedule
        { averagSched_startDate :: Maybe Xsd.Date
          -- ^ Date on which this period begins.
        , averagSched_endDate :: Maybe Xsd.Date
          -- ^ Date on which this period ends.
        , averagSched_averagingPeriodFrequency :: Maybe CalculationPeriodFrequency
          -- ^ The frequency at which averaging period occurs with the 
          --   regular part of the valuation schedule and their roll date 
          --   convention.
        }
        deriving (Eq,Show)
instance SchemaType AveragingSchedule where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return AveragingSchedule
            `apply` optional (parseSchemaType "startDate")
            `apply` optional (parseSchemaType "endDate")
            `apply` optional (parseSchemaType "averagingPeriodFrequency")
    schemaTypeToXML s x@AveragingSchedule{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "startDate") $ averagSched_startDate x
            , maybe [] (schemaTypeToXML "endDate") $ averagSched_endDate x
            , maybe [] (schemaTypeToXML "averagingPeriodFrequency") $ averagSched_averagingPeriodFrequency x
            ]
 
-- | As per ISDA 2002 Definitions.
data Barrier = Barrier
        { barrier_cap :: Maybe TriggerEvent
          -- ^ A trigger level approached from beneath.
        , barrier_floor :: Maybe TriggerEvent
          -- ^ A trigger level approached from above.
        }
        deriving (Eq,Show)
instance SchemaType Barrier where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Barrier
            `apply` optional (parseSchemaType "barrierCap")
            `apply` optional (parseSchemaType "barrierFloor")
    schemaTypeToXML s x@Barrier{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "barrierCap") $ barrier_cap x
            , maybe [] (schemaTypeToXML "barrierFloor") $ barrier_floor x
            ]
 
-- | A type for defining a calendar spread feature.
data CalendarSpread = CalendarSpread
        { calSpread_expirationDateTwo :: Maybe AdjustableOrRelativeDate
        }
        deriving (Eq,Show)
instance SchemaType CalendarSpread where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return CalendarSpread
            `apply` optional (parseSchemaType "expirationDateTwo")
    schemaTypeToXML s x@CalendarSpread{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "expirationDateTwo") $ calSpread_expirationDateTwo x
            ]
 
-- | A classified non negative payment.
data ClassifiedPayment = ClassifiedPayment
        { classPayment_ID :: Maybe Xsd.ID
        , classPayment_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , classPayment_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , classPayment_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , classPayment_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , classPayment_paymentDate :: Maybe AdjustableOrRelativeDate
          -- ^ The payment date, which can be expressed as either an 
          --   adjustable or relative date.
        , classPayment_paymentAmount :: Maybe NonNegativeMoney
          -- ^ Non negative payment amount.
        , classPayment_paymentType :: [PaymentType]
          -- ^ Payment classification.
        }
        deriving (Eq,Show)
instance SchemaType ClassifiedPayment where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ClassifiedPayment a0)
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (parseSchemaType "paymentDate")
            `apply` optional (parseSchemaType "paymentAmount")
            `apply` many (parseSchemaType "paymentType")
    schemaTypeToXML s x@ClassifiedPayment{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ classPayment_ID x
                       ]
            [ maybe [] (schemaTypeToXML "payerPartyReference") $ classPayment_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ classPayment_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ classPayment_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ classPayment_receiverAccountReference x
            , maybe [] (schemaTypeToXML "paymentDate") $ classPayment_paymentDate x
            , maybe [] (schemaTypeToXML "paymentAmount") $ classPayment_paymentAmount x
            , concatMap (schemaTypeToXML "paymentType") $ classPayment_paymentType x
            ]
instance Extension ClassifiedPayment NonNegativePayment where
    supertype (ClassifiedPayment a0 e0 e1 e2 e3 e4 e5 e6) =
               NonNegativePayment a0 e0 e1 e2 e3 e4 e5
instance Extension ClassifiedPayment PaymentBaseExtended where
    supertype = (supertype :: NonNegativePayment -> PaymentBaseExtended)
              . (supertype :: ClassifiedPayment -> NonNegativePayment)
              
instance Extension ClassifiedPayment PaymentBase where
    supertype = (supertype :: PaymentBaseExtended -> PaymentBase)
              . (supertype :: NonNegativePayment -> PaymentBaseExtended)
              . (supertype :: ClassifiedPayment -> NonNegativePayment)
              
 
-- | Specifies the conditions to be applied for converting into 
--   a reference currency when the actual currency rate is not 
--   determined upfront.
data Composite = Composite
        { composite_determinationMethod :: Maybe DeterminationMethod
          -- ^ Specifies the method according to which an amount or a date 
          --   is determined.
        , composite_relativeDate :: Maybe RelativeDateOffset
          -- ^ A date specified as some offset to another date (the anchor 
          --   date).
        , composite_fxSpotRateSource :: Maybe FxSpotRateSource
          -- ^ Specifies the methodology (reference source and, 
          --   optionally, fixing time) to be used for determining a 
          --   currency conversion rate.
        }
        deriving (Eq,Show)
instance SchemaType Composite where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Composite
            `apply` optional (parseSchemaType "determinationMethod")
            `apply` optional (parseSchemaType "relativeDate")
            `apply` optional (parseSchemaType "fxSpotRateSource")
    schemaTypeToXML s x@Composite{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "determinationMethod") $ composite_determinationMethod x
            , maybe [] (schemaTypeToXML "relativeDate") $ composite_relativeDate x
            , maybe [] (schemaTypeToXML "fxSpotRateSource") $ composite_fxSpotRateSource x
            ]
 
data CreditEventNotice = CreditEventNotice
        { creditEventNotice_notifyingParty :: Maybe NotifyingParty
          -- ^ Pointer style references to a party identifier defined 
          --   elsewhere in the document. The notifying party is the party 
          --   that notifies the other party when a credit event has 
          --   occurred by means of a credit event notice. If more than 
          --   one party is referenced as being the notifying party then 
          --   either party may notify the other of a credit event 
          --   occurring. ISDA 2003 Term: Notifying Party.
        , creditEventNotice_businessCenter :: Maybe BusinessCenter
          -- ^ Inclusion of this business center element implies that 
          --   Greenwich Mean Time in Section 3.3 of the 2003 ISDA Credit 
          --   Derivatives Definitions is replaced by the local time of 
          --   the city indicated by the businessCenter element value.
        , creditEventNotice_publiclyAvailableInformation :: Maybe PubliclyAvailableInformation
          -- ^ A specified condition to settlement. Publicly available 
          --   information means information that reasonably confirms any 
          --   of the facts relevant to determining that a credit event or 
          --   potential repudiation/moratorium, as applicable, has 
          --   occurred. The ISDA defined list (2003) is the market 
          --   standard and is considered comprehensive, and a minimum of 
          --   two differing public sources must have published the 
          --   relevant information, to declare a Credit Event. ISDA 2003 
          --   Term: Notice of Publicly Available Information Applicable.
        }
        deriving (Eq,Show)
instance SchemaType CreditEventNotice where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return CreditEventNotice
            `apply` optional (parseSchemaType "notifyingParty")
            `apply` optional (parseSchemaType "businessCenter")
            `apply` optional (parseSchemaType "publiclyAvailableInformation")
    schemaTypeToXML s x@CreditEventNotice{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "notifyingParty") $ creditEventNotice_notifyingParty x
            , maybe [] (schemaTypeToXML "businessCenter") $ creditEventNotice_businessCenter x
            , maybe [] (schemaTypeToXML "publiclyAvailableInformation") $ creditEventNotice_publiclyAvailableInformation x
            ]
 
data CreditEvents = CreditEvents
        { creditEvents_ID :: Maybe Xsd.ID
        , creditEvents_bankruptcy :: Maybe Xsd.Boolean
          -- ^ A credit event. The reference entity has been dissolved or 
          --   has become insolvent. It also covers events that may be a 
          --   precursor to insolvency such as instigation of bankruptcy 
          --   or insolvency proceedings. Sovereign trades are not subject 
          --   to Bankruptcy as "technically" a Sovereign cannot become 
          --   bankrupt. ISDA 2003 Term: Bankruptcy.
        , creditEvents_failureToPay :: Maybe FailureToPay
          -- ^ A credit event. This credit event triggers, after the 
          --   expiration of any applicable grace period, if the reference 
          --   entity fails to make due payments in an aggregrate amount 
          --   of not less than the payment requirement on one or more 
          --   obligations (e.g. a missed coupon payment). ISDA 2003 Term: 
          --   Failure to Pay.
        , creditEvents_failureToPayPrincipal :: Maybe Xsd.Boolean
          -- ^ A credit 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.
        , creditEvents_failureToPayInterest :: Maybe Xsd.Boolean
          -- ^ A credit event. Corresponds to the failure by the Reference 
          --   Entity to pay an expected interest amount or the payment of 
          --   an actual interest amount that is less than the expected 
          --   interest amount. ISDA 2003 Term: Failure to Pay Interest.
        , creditEvents_obligationDefault :: Maybe Xsd.Boolean
          -- ^ A credit event. One or more of the obligations have become 
          --   capable of being declared due and payable before they would 
          --   otherwise have been due and payable as a result of, or on 
          --   the basis of, the occurrence of a default, event of default 
          --   or other similar condition or event other than failure to 
          --   pay. ISDA 2003 Term: Obligation Default.
        , creditEvents_obligationAcceleration :: Maybe Xsd.Boolean
          -- ^ A credit event. One or more of the obligations have been 
          --   declared due and payable before they would otherwise have 
          --   been due and payable as a result of, or on the basis of, 
          --   the occurrence of a default, event of default or other 
          --   similar condition or event other than failure to pay 
          --   (preferred by the market over Obligation Default, because 
          --   more definitive and encompasses the definition of 
          --   Obligation Default - this is more favorable to the Seller). 
          --   Subject to the default requirement amount. ISDA 2003 Term: 
          --   Obligation Acceleration.
        , creditEvents_repudiationMoratorium :: Maybe Xsd.Boolean
          -- ^ A credit event. The reference entity, or a governmental 
          --   authority, either refuses to recognise or challenges the 
          --   validity of one or more obligations of the reference 
          --   entity, or imposes a moratorium thereby postponing payments 
          --   on one or more of the obligations of the reference entity. 
          --   Subject to the default requirement amount. ISDA 2003 Term: 
          --   Repudiation/Moratorium.
        , creditEvents_restructuring :: Maybe Restructuring
          -- ^ A credit event. A restructuring is an event that materially 
          --   impacts the reference entity's obligations, such as an 
          --   interest rate reduction, principal reduction, deferral of 
          --   interest or principal, change in priority ranking, or 
          --   change in currency or composition of payment. ISDA 2003 
          --   Term: Restructuring.
        , creditEvents_distressedRatingsDowngrade :: Maybe Xsd.Boolean
          -- ^ A credit event. Results from the fact that the rating of 
          --   the reference obligation is downgraded to a distressed 
          --   rating level. From a usage standpoint, this credit event is 
          --   typically not applicable in case of RMBS trades.
        , creditEvents_maturityExtension :: Maybe Xsd.Boolean
          -- ^ A credit event. Results from the fact that the underlier 
          --   fails to make principal payments as expected.
        , creditEvents_writedown :: Maybe Xsd.Boolean
          -- ^ A credit event. Results from the fact that the underlier 
          --   writes down its outstanding principal amount.
        , creditEvents_impliedWritedown :: Maybe Xsd.Boolean
          -- ^ A credit 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.
        , creditEvents_defaultRequirement :: Maybe Money
          -- ^ In relation to certain credit events, serves as a threshold 
          --   for Obligation Acceleration, Obligation Default, 
          --   Repudiation/Moratorium and Restructuring. Market standard 
          --   is USD 10,000,000 (JPY 1,000,000,000 for all Japanese Yen 
          --   trades). This is applied on an aggregate or total basis 
          --   across all Obligations of the Reference Entity. Used to 
          --   prevent technical/operational errors from triggering credit 
          --   events. ISDA 2003 Term: Default Requirement.
        , creditEvents_creditEventNotice :: Maybe CreditEventNotice
          -- ^ A specified condition to settlement. An irrevocable written 
          --   or verbal notice that describes a credit event that has 
          --   occurred. The notice is sent from the notifying party 
          --   (either the buyer or the seller) to the counterparty. It 
          --   provides information relevant to determining that a credit 
          --   event has occurred. This is typically accompanied by 
          --   Publicly Available Information. ISDA 2003 Term: Credit 
          --   Event Notice.
        }
        deriving (Eq,Show)
instance SchemaType CreditEvents where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (CreditEvents a0)
            `apply` optional (parseSchemaType "bankruptcy")
            `apply` optional (parseSchemaType "failureToPay")
            `apply` optional (parseSchemaType "failureToPayPrincipal")
            `apply` optional (parseSchemaType "failureToPayInterest")
            `apply` optional (parseSchemaType "obligationDefault")
            `apply` optional (parseSchemaType "obligationAcceleration")
            `apply` optional (parseSchemaType "repudiationMoratorium")
            `apply` optional (parseSchemaType "restructuring")
            `apply` optional (parseSchemaType "distressedRatingsDowngrade")
            `apply` optional (parseSchemaType "maturityExtension")
            `apply` optional (parseSchemaType "writedown")
            `apply` optional (parseSchemaType "impliedWritedown")
            `apply` optional (parseSchemaType "defaultRequirement")
            `apply` optional (parseSchemaType "creditEventNotice")
    schemaTypeToXML s x@CreditEvents{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ creditEvents_ID x
                       ]
            [ maybe [] (schemaTypeToXML "bankruptcy") $ creditEvents_bankruptcy x
            , maybe [] (schemaTypeToXML "failureToPay") $ creditEvents_failureToPay x
            , maybe [] (schemaTypeToXML "failureToPayPrincipal") $ creditEvents_failureToPayPrincipal x
            , maybe [] (schemaTypeToXML "failureToPayInterest") $ creditEvents_failureToPayInterest x
            , maybe [] (schemaTypeToXML "obligationDefault") $ creditEvents_obligationDefault x
            , maybe [] (schemaTypeToXML "obligationAcceleration") $ creditEvents_obligationAcceleration x
            , maybe [] (schemaTypeToXML "repudiationMoratorium") $ creditEvents_repudiationMoratorium x
            , maybe [] (schemaTypeToXML "restructuring") $ creditEvents_restructuring x
            , maybe [] (schemaTypeToXML "distressedRatingsDowngrade") $ creditEvents_distressedRatingsDowngrade x
            , maybe [] (schemaTypeToXML "maturityExtension") $ creditEvents_maturityExtension x
            , maybe [] (schemaTypeToXML "writedown") $ creditEvents_writedown x
            , maybe [] (schemaTypeToXML "impliedWritedown") $ creditEvents_impliedWritedown x
            , maybe [] (schemaTypeToXML "defaultRequirement") $ creditEvents_defaultRequirement x
            , maybe [] (schemaTypeToXML "creditEventNotice") $ creditEvents_creditEventNotice x
            ]
 
-- | Reference to credit events.
data CreditEventsReference = CreditEventsReference
        { creditEventsRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType CreditEventsReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (CreditEventsReference a0)
    schemaTypeToXML s x@CreditEventsReference{} =
        toXMLElement s [ toXMLAttribute "href" $ creditEventsRef_href x
                       ]
            []
instance Extension CreditEventsReference Reference where
    supertype v = Reference_CreditEventsReference v
 
data FailureToPay = FailureToPay
        { failureToPay_applicable :: Maybe Xsd.Boolean
          -- ^ Indicates whether the failure to pay provision is 
          --   applicable.
        , failureToPay_gracePeriodExtension :: Maybe GracePeriodExtension
          -- ^ If this element is specified, indicates whether or not a 
          --   grace period extension is applicable. ISDA 2003 Term: Grace 
          --   Period Extension Applicable.
        , failureToPay_paymentRequirement :: Maybe Money
          -- ^ Specifies a threshold for the failure to pay credit event. 
          --   Market standard is USD 1,000,000 (JPY 100,000,000 for 
          --   Japanese Yen trades) or its equivalent in the relevant 
          --   obligation currency. This is applied on an aggregate basis 
          --   across all Obligations of the Reference Entity. Intended to 
          --   prevent technical/operational errors from triggering credit 
          --   events. ISDA 2003 Term: Payment Requirement.
        }
        deriving (Eq,Show)
instance SchemaType FailureToPay where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return FailureToPay
            `apply` optional (parseSchemaType "applicable")
            `apply` optional (parseSchemaType "gracePeriodExtension")
            `apply` optional (parseSchemaType "paymentRequirement")
    schemaTypeToXML s x@FailureToPay{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "applicable") $ failureToPay_applicable x
            , maybe [] (schemaTypeToXML "gracePeriodExtension") $ failureToPay_gracePeriodExtension x
            , maybe [] (schemaTypeToXML "paymentRequirement") $ failureToPay_paymentRequirement x
            ]
 
-- | Payment made following trigger occurence.
data FeaturePayment = FeaturePayment
        { featurePayment_ID :: Maybe Xsd.ID
        , featurePayment_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , featurePayment_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , featurePayment_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , featurePayment_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , featurePayment_choice4 :: (Maybe (OneOf2 Xsd.Decimal NonNegativeDecimal))
          -- ^ Choice between:
          --   
          --   (1) The trigger level percentage.
          --   
          --   (2) The monetary quantity in currency units.
        , featurePayment_time :: Maybe TimeTypeEnum
          -- ^ The feature payment time.
        , featurePayment_currency :: Maybe Currency
          -- ^ The currency in which an amount is denominated.
        , featurePayment_date :: Maybe AdjustableOrRelativeDate
          -- ^ The feature payment date.
        }
        deriving (Eq,Show)
instance SchemaType FeaturePayment where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (FeaturePayment a0)
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "levelPercentage"))
                                     , ("NonNegativeDecimal", fmap TwoOf2 (parseSchemaType "amount"))
                                     ])
            `apply` optional (parseSchemaType "time")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "featurePaymentDate")
    schemaTypeToXML s x@FeaturePayment{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ featurePayment_ID x
                       ]
            [ maybe [] (schemaTypeToXML "payerPartyReference") $ featurePayment_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ featurePayment_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ featurePayment_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ featurePayment_receiverAccountReference x
            , maybe [] (foldOneOf2  (schemaTypeToXML "levelPercentage")
                                    (schemaTypeToXML "amount")
                                   ) $ featurePayment_choice4 x
            , maybe [] (schemaTypeToXML "time") $ featurePayment_time x
            , maybe [] (schemaTypeToXML "currency") $ featurePayment_currency x
            , maybe [] (schemaTypeToXML "featurePaymentDate") $ featurePayment_date x
            ]
instance Extension FeaturePayment PaymentBase where
    supertype v = PaymentBase_FeaturePayment v
 
-- | Frequency Type.
data FrequencyType = FrequencyType Scheme FrequencyTypeAttributes deriving (Eq,Show)
data FrequencyTypeAttributes = FrequencyTypeAttributes
    { frequTypeAttrib_frequencyTypeScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType FrequencyType where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "frequencyTypeScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ FrequencyType v (FrequencyTypeAttributes a0)
    schemaTypeToXML s (FrequencyType bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "frequencyTypeScheme") $ frequTypeAttrib_frequencyTypeScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension FrequencyType Scheme where
    supertype (FrequencyType s _) = s
 
-- | A type for defining Fx Features.
data FxFeature = FxFeature
        { fxFeature_referenceCurrency :: Maybe IdentifiedCurrency
          -- ^ Specifies the reference currency of the trade.
        , fxFeature_choice1 :: (Maybe (OneOf3 Composite Quanto Composite))
          -- ^ Choice between:
          --   
          --   (1) If “Composite” is specified as the Settlement Type 
          --   in the relevant Transaction Supplement, an amount in 
          --   the Settlement Currency, determined by the Calculation 
          --   Agent as being equal to the number of Options exercised 
          --   or deemed exercised, multiplied by: (Settlement Price 
          --   – Strike Price) / (Strike Price – Settlement Price) 
          --   x Multiplier provided that if the above is equal to a 
          --   negative amount the Option Cash Settlement Amount shall 
          --   be deemed to be zero.
          --   
          --   (2) If “Quanto” is specified as the Settlement Type in 
          --   the relevant Transaction Supplement, an amount, as 
          --   determined by the Calculation Agent in accordance with 
          --   the Section 8.2 of the Equity Definitions.
          --   
          --   (3) If “Cross-Currency” is specified as the Settlement 
          --   Type in the relevant Transaction Supplement, an amount 
          --   in the Settlement Currency, determined by the 
          --   Calculation Agent as being equal to the number of 
          --   Options exercised or deemed exercised, multiplied by: 
          --   (Settlement Price – Strike Price) / (Strike Price – 
          --   Settlement Price) x Multiplier x one unit of the 
          --   Reference Currency converted into an amount in the 
          --   Settlement Currency using the rate of exchange of the 
          --   Settlement Currency as quoted on the Reference Price 
          --   Source on the Valuation Date, provided that if the 
          --   above is equal to a negative amount the Option Cash 
          --   Settlement Amount shall be deemed to be zero.
        }
        deriving (Eq,Show)
instance SchemaType FxFeature where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return FxFeature
            `apply` optional (parseSchemaType "referenceCurrency")
            `apply` optional (oneOf' [ ("Composite", fmap OneOf3 (parseSchemaType "composite"))
                                     , ("Quanto", fmap TwoOf3 (parseSchemaType "quanto"))
                                     , ("Composite", fmap ThreeOf3 (parseSchemaType "crossCurrency"))
                                     ])
    schemaTypeToXML s x@FxFeature{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "referenceCurrency") $ fxFeature_referenceCurrency x
            , maybe [] (foldOneOf3  (schemaTypeToXML "composite")
                                    (schemaTypeToXML "quanto")
                                    (schemaTypeToXML "crossCurrency")
                                   ) $ fxFeature_choice1 x
            ]
 
data GracePeriodExtension = GracePeriodExtension
        { gracePeriodExtens_applicable :: Maybe Xsd.Boolean
          -- ^ Indicates whether the grace period extension provision is 
          --   applicable.
        , gracePeriodExtens_gracePeriod :: Maybe Offset
          -- ^ The number of calendar or business days after any due date 
          --   that the reference entity has to fulfil its obligations 
          --   before a failure to pay credit event is deemed to have 
          --   occurred. ISDA 2003 Term: Grace Period.
        }
        deriving (Eq,Show)
instance SchemaType GracePeriodExtension where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return GracePeriodExtension
            `apply` optional (parseSchemaType "applicable")
            `apply` optional (parseSchemaType "gracePeriod")
    schemaTypeToXML s x@GracePeriodExtension{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "applicable") $ gracePeriodExtens_applicable x
            , maybe [] (schemaTypeToXML "gracePeriod") $ gracePeriodExtens_gracePeriod x
            ]
 
-- | Knock In means option to exercise comes into existence. 
--   Knock Out means option to exercise goes out of existence.
data Knock = Knock
        { knock_in :: Maybe TriggerEvent
          -- ^ The knock in.
        , knock_out :: Maybe TriggerEvent
          -- ^ The knock out.
        }
        deriving (Eq,Show)
instance SchemaType Knock where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Knock
            `apply` optional (parseSchemaType "knockIn")
            `apply` optional (parseSchemaType "knockOut")
    schemaTypeToXML s x@Knock{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "knockIn") $ knock_in x
            , maybe [] (schemaTypeToXML "knockOut") $ knock_out x
            ]
 
-- | Defines the handling of an averaging date market disruption 
--   for an equity derivative transaction.
data MarketDisruption = MarketDisruption Scheme MarketDisruptionAttributes deriving (Eq,Show)
data MarketDisruptionAttributes = MarketDisruptionAttributes
    { marketDisrupAttrib_marketDisruptionScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType MarketDisruption where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "marketDisruptionScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ MarketDisruption v (MarketDisruptionAttributes a0)
    schemaTypeToXML s (MarketDisruption bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "marketDisruptionScheme") $ marketDisrupAttrib_marketDisruptionScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension MarketDisruption Scheme where
    supertype (MarketDisruption s _) = s
 
data NotifyingParty = NotifyingParty
        { notifParty_buyerPartyReference :: Maybe PartyReference
        , notifParty_sellerPartyReference :: Maybe PartyReference
        }
        deriving (Eq,Show)
instance SchemaType NotifyingParty where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return NotifyingParty
            `apply` optional (parseSchemaType "buyerPartyReference")
            `apply` optional (parseSchemaType "sellerPartyReference")
    schemaTypeToXML s x@NotifyingParty{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "buyerPartyReference") $ notifParty_buyerPartyReference x
            , maybe [] (schemaTypeToXML "sellerPartyReference") $ notifParty_sellerPartyReference x
            ]
 
-- | A type for defining the common features of options.
data Option
        = Option_OptionBase OptionBase
        | Option_FxOption FxOption
        | Option_FxDigitalOption FxDigitalOption
        
        deriving (Eq,Show)
instance SchemaType Option where
    parseSchemaType s = do
        (fmap Option_OptionBase $ parseSchemaType s)
        `onFail`
        (fmap Option_FxOption $ parseSchemaType s)
        `onFail`
        (fmap Option_FxDigitalOption $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of Option,\n\
\  namely one of:\n\
\OptionBase,FxOption,FxDigitalOption"
    schemaTypeToXML _s (Option_OptionBase x) = schemaTypeToXML "optionBase" x
    schemaTypeToXML _s (Option_FxOption x) = schemaTypeToXML "fxOption" x
    schemaTypeToXML _s (Option_FxDigitalOption x) = schemaTypeToXML "fxDigitalOption" x
instance Extension Option Product where
    supertype v = Product_Option v
 
-- | A type for defining the common features of options.
data OptionBase
        = OptionBase_OptionBaseExtended OptionBaseExtended
        | OptionBase_VarianceOptionTransactionSupplement VarianceOptionTransactionSupplement
        
        deriving (Eq,Show)
instance SchemaType OptionBase where
    parseSchemaType s = do
        (fmap OptionBase_OptionBaseExtended $ parseSchemaType s)
        `onFail`
        (fmap OptionBase_VarianceOptionTransactionSupplement $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of OptionBase,\n\
\  namely one of:\n\
\OptionBaseExtended,VarianceOptionTransactionSupplement"
    schemaTypeToXML _s (OptionBase_OptionBaseExtended x) = schemaTypeToXML "optionBaseExtended" x
    schemaTypeToXML _s (OptionBase_VarianceOptionTransactionSupplement x) = schemaTypeToXML "varianceOptionTransactionSupplement" x
instance Extension OptionBase Option where
    supertype v = Option_OptionBase v
 
-- | Base type for options starting with the 4-3 release, until 
--   we refactor the schema as part of the 5-0 release series.
data OptionBaseExtended
        = OptionBaseExtended_CreditDefaultSwapOption CreditDefaultSwapOption
        | OptionBaseExtended_BondOption BondOption
        
        deriving (Eq,Show)
instance SchemaType OptionBaseExtended where
    parseSchemaType s = do
        (fmap OptionBaseExtended_CreditDefaultSwapOption $ parseSchemaType s)
        `onFail`
        (fmap OptionBaseExtended_BondOption $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of OptionBaseExtended,\n\
\  namely one of:\n\
\CreditDefaultSwapOption,BondOption"
    schemaTypeToXML _s (OptionBaseExtended_CreditDefaultSwapOption x) = schemaTypeToXML "creditDefaultSwapOption" x
    schemaTypeToXML _s (OptionBaseExtended_BondOption x) = schemaTypeToXML "bondOption" x
instance Extension OptionBaseExtended OptionBase where
    supertype v = OptionBase_OptionBaseExtended v
 
-- | A type for defining option features.
data OptionFeature = OptionFeature
        { optionFeature_fxFeature :: Maybe FxFeature
          -- ^ A quanto or composite FX feature.
        , optionFeature_strategyFeature :: Maybe StrategyFeature
          -- ^ A simple strategy feature.
        , optionFeature_asian :: Maybe Asian
          -- ^ An option where and average price is taken on valuation.
        , optionFeature_barrier :: Maybe Barrier
          -- ^ An option with a barrier feature.
        , optionFeature_knock :: Maybe Knock
          -- ^ A knock feature.
        , optionFeature_passThrough :: Maybe PassThrough
          -- ^ Pass through payments from the underlyer, such as 
          --   dividends.
        }
        deriving (Eq,Show)
instance SchemaType OptionFeature where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return OptionFeature
            `apply` optional (parseSchemaType "fxFeature")
            `apply` optional (parseSchemaType "strategyFeature")
            `apply` optional (parseSchemaType "asian")
            `apply` optional (parseSchemaType "barrier")
            `apply` optional (parseSchemaType "knock")
            `apply` optional (parseSchemaType "passThrough")
    schemaTypeToXML s x@OptionFeature{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "fxFeature") $ optionFeature_fxFeature x
            , maybe [] (schemaTypeToXML "strategyFeature") $ optionFeature_strategyFeature x
            , maybe [] (schemaTypeToXML "asian") $ optionFeature_asian x
            , maybe [] (schemaTypeToXML "barrier") $ optionFeature_barrier x
            , maybe [] (schemaTypeToXML "knock") $ optionFeature_knock x
            , maybe [] (schemaTypeToXML "passThrough") $ optionFeature_passThrough x
            ]
 
-- | A type for defining the strike price for an option as a 
--   numeric value without currency.
data OptionNumericStrike = OptionNumericStrike
        { optionNumericStrike_choice0 :: (Maybe (OneOf2 Xsd.Decimal Xsd.Decimal))
          -- ^ Choice between:
          --   
          --   (1) The price or level at which the option has been struck.
          --   
          --   (2) The price or level expressed as a percentage of the 
          --   forward starting spot price.
        }
        deriving (Eq,Show)
instance SchemaType OptionNumericStrike where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return OptionNumericStrike
            `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "strikePrice"))
                                     , ("Xsd.Decimal", fmap TwoOf2 (parseSchemaType "strikePercentage"))
                                     ])
    schemaTypeToXML s x@OptionNumericStrike{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "strikePrice")
                                    (schemaTypeToXML "strikePercentage")
                                   ) $ optionNumericStrike_choice0 x
            ]
 
-- | A type for defining the strike price for an equity option. 
--   The strike price is either: (i) in respect of an index 
--   option transaction, the level of the relevant index 
--   specified or otherwise determined in the transaction; or 
--   (ii) in respect of a share option transaction, the price 
--   per share specified or otherwise determined in the 
--   transaction. This can be expressed either as a percentage 
--   of notional amount or as an absolute value.
data OptionStrike = OptionStrike
        { optionStrike_choice0 :: (Maybe (OneOf2 Xsd.Decimal Xsd.Decimal))
          -- ^ Choice between:
          --   
          --   (1) The price or level at which the option has been struck.
          --   
          --   (2) The price or level expressed as a percentage of the 
          --   forward starting spot price.
        , optionStrike_currency :: Maybe Currency
          -- ^ The currency in which an amount is denominated.
        }
        deriving (Eq,Show)
instance SchemaType OptionStrike where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return OptionStrike
            `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "strikePrice"))
                                     , ("Xsd.Decimal", fmap TwoOf2 (parseSchemaType "strikePercentage"))
                                     ])
            `apply` optional (parseSchemaType "currency")
    schemaTypeToXML s x@OptionStrike{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "strikePrice")
                                    (schemaTypeToXML "strikePercentage")
                                   ) $ optionStrike_choice0 x
            , maybe [] (schemaTypeToXML "currency") $ optionStrike_currency x
            ]
instance Extension OptionStrike OptionNumericStrike where
    supertype (OptionStrike e0 e1) =
               OptionNumericStrike e0
 
-- | Type which contains pass through payments.
data PassThrough = PassThrough
        { passThrough_item :: [PassThroughItem]
          -- ^ One to many pass through payment items.
        }
        deriving (Eq,Show)
instance SchemaType PassThrough where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PassThrough
            `apply` many (parseSchemaType "passThroughItem")
    schemaTypeToXML s x@PassThrough{} =
        toXMLElement s []
            [ concatMap (schemaTypeToXML "passThroughItem") $ passThrough_item x
            ]
 
-- | Type to represent a single pass through payment.
data PassThroughItem = PassThroughItem
        { passThroughItem_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , passThroughItem_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , passThroughItem_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , passThroughItem_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , passThroughItem_underlyerReference :: Maybe AssetReference
          -- ^ Reference to the underlyer whose payments are being passed 
          --   through.
        , passThroughItem_passThroughPercentage :: Maybe Xsd.Decimal
          -- ^ Percentage of payments from the underlyer which are passed 
          --   through.
        }
        deriving (Eq,Show)
instance SchemaType PassThroughItem where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PassThroughItem
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (parseSchemaType "underlyerReference")
            `apply` optional (parseSchemaType "passThroughPercentage")
    schemaTypeToXML s x@PassThroughItem{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "payerPartyReference") $ passThroughItem_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ passThroughItem_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ passThroughItem_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ passThroughItem_receiverAccountReference x
            , maybe [] (schemaTypeToXML "underlyerReference") $ passThroughItem_underlyerReference x
            , maybe [] (schemaTypeToXML "passThroughPercentage") $ passThroughItem_passThroughPercentage x
            ]
 
-- | A type for defining a premium.
data Premium = Premium
        { premium_ID :: Maybe Xsd.ID
        , premium_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , premium_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , premium_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , premium_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , premium_paymentAmount :: Maybe NonNegativeMoney
        , premium_paymentDate :: Maybe AdjustableOrRelativeDate
          -- ^ The payment date. This date is subject to adjustment in 
          --   accordance with any applicable business day convention.
        , premium_type :: Maybe PremiumTypeEnum
          -- ^ Forward start Premium type
        , premium_pricePerOption :: Maybe Money
          -- ^ The amount of premium to be paid expressed as a function of 
          --   the number of options.
        , premium_percentageOfNotional :: Maybe Xsd.Decimal
          -- ^ The amount of premium to be paid expressed as a percentage 
          --   of the notional value of the transaction. A percentage of 
          --   5% would be expressed as 0.05.
        , premium_discountFactor :: Maybe Xsd.Decimal
          -- ^ The value representing the discount factor used to 
          --   calculate the present value of the cash flow.
        , premium_presentValueAmount :: Maybe Money
          -- ^ The amount representing the present value of the forecast 
          --   payment.
        }
        deriving (Eq,Show)
instance SchemaType Premium where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Premium a0)
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (parseSchemaType "paymentAmount")
            `apply` optional (parseSchemaType "paymentDate")
            `apply` optional (parseSchemaType "premiumType")
            `apply` optional (parseSchemaType "pricePerOption")
            `apply` optional (parseSchemaType "percentageOfNotional")
            `apply` optional (parseSchemaType "discountFactor")
            `apply` optional (parseSchemaType "presentValueAmount")
    schemaTypeToXML s x@Premium{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ premium_ID x
                       ]
            [ maybe [] (schemaTypeToXML "payerPartyReference") $ premium_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ premium_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ premium_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ premium_receiverAccountReference x
            , maybe [] (schemaTypeToXML "paymentAmount") $ premium_paymentAmount x
            , maybe [] (schemaTypeToXML "paymentDate") $ premium_paymentDate x
            , maybe [] (schemaTypeToXML "premiumType") $ premium_type x
            , maybe [] (schemaTypeToXML "pricePerOption") $ premium_pricePerOption x
            , maybe [] (schemaTypeToXML "percentageOfNotional") $ premium_percentageOfNotional x
            , maybe [] (schemaTypeToXML "discountFactor") $ premium_discountFactor x
            , maybe [] (schemaTypeToXML "presentValueAmount") $ premium_presentValueAmount x
            ]
instance Extension Premium SimplePayment where
    supertype (Premium a0 e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10) =
               SimplePayment a0 e0 e1 e2 e3 e4 e5
instance Extension Premium PaymentBase where
    supertype = (supertype :: SimplePayment -> PaymentBase)
              . (supertype :: Premium -> SimplePayment)
              
 
data PubliclyAvailableInformation = PubliclyAvailableInformation
        { publicAvailInfo_standardPublicSources :: Maybe Xsd.Boolean
          -- ^ If this element is specified and set to 'true', indicates 
          --   that ISDA defined Standard Public Sources are applicable.
        , publicAvailInfo_publicSource :: [Xsd.XsdString]
          -- ^ A public information source, e.g. a particular newspaper or 
          --   electronic news service, that may publish relevant 
          --   information used in the determination of whether or not a 
          --   credit event has occurred. ISDA 2003 Term: Public Source.
        , publicAvailInfo_specifiedNumber :: Maybe Xsd.PositiveInteger
          -- ^ The minimum number of the specified public information 
          --   sources that must publish information that reasonably 
          --   confirms that a credit event has occurred. The market 
          --   convention is two. ISDA 2003 Term: Specified Number.
        }
        deriving (Eq,Show)
instance SchemaType PubliclyAvailableInformation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PubliclyAvailableInformation
            `apply` optional (parseSchemaType "standardPublicSources")
            `apply` many (parseSchemaType "publicSource")
            `apply` optional (parseSchemaType "specifiedNumber")
    schemaTypeToXML s x@PubliclyAvailableInformation{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "standardPublicSources") $ publicAvailInfo_standardPublicSources x
            , concatMap (schemaTypeToXML "publicSource") $ publicAvailInfo_publicSource x
            , maybe [] (schemaTypeToXML "specifiedNumber") $ publicAvailInfo_specifiedNumber x
            ]
 
-- | Determines the currency rate that the seller of the equity 
--   amounts will apply at each valuation date for converting 
--   the respective amounts into a currency that is different 
--   from the currency denomination of the underlyer.
data Quanto = Quanto
        { quanto_fxRate :: [FxRate]
          -- ^ Specifies a currency conversion rate.
        , quanto_fxSpotRateSource :: Maybe FxSpotRateSource
          -- ^ Specifies the methodology (reference source and, 
          --   optionally, fixing time) to be used for determining a 
          --   currency conversion rate.
        }
        deriving (Eq,Show)
instance SchemaType Quanto where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Quanto
            `apply` many (parseSchemaType "fxRate")
            `apply` optional (parseSchemaType "fxSpotRateSource")
    schemaTypeToXML s x@Quanto{} =
        toXMLElement s []
            [ concatMap (schemaTypeToXML "fxRate") $ quanto_fxRate x
            , maybe [] (schemaTypeToXML "fxSpotRateSource") $ quanto_fxSpotRateSource x
            ]
 
data Restructuring = Restructuring
        { restr_applicable :: Maybe Xsd.Boolean
          -- ^ Indicates whether the restructuring provision is 
          --   applicable.
        , restructuring_type :: Maybe RestructuringType
          -- ^ Specifies the type of restructuring that is applicable.
        , restr_multipleHolderObligation :: Maybe Xsd.Boolean
          -- ^ In relation to a restructuring credit event, unless 
          --   multiple holder obligation is not specified restructurings 
          --   are limited to multiple holder obligations. A multiple 
          --   holder obligation means an obligation that is held by more 
          --   than three holders that are not affiliates of each other 
          --   and where at least two thirds of the holders must agree to 
          --   the event that constitutes the restructuring credit event. 
          --   ISDA 2003 Term: Multiple Holder Obligation.
        , restr_multipleCreditEventNotices :: Maybe Xsd.Boolean
          -- ^ Presence of this element and value set to 'true' indicates 
          --   that Section 3.9 of the 2003 Credit Derivatives Definitions 
          --   shall apply. Absence of this element indicates that Section 
          --   3.9 shall not apply. NOTE: Not allowed under ISDA Credit 
          --   1999.
        }
        deriving (Eq,Show)
instance SchemaType Restructuring where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Restructuring
            `apply` optional (parseSchemaType "applicable")
            `apply` optional (parseSchemaType "restructuringType")
            `apply` optional (parseSchemaType "multipleHolderObligation")
            `apply` optional (parseSchemaType "multipleCreditEventNotices")
    schemaTypeToXML s x@Restructuring{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "applicable") $ restr_applicable x
            , maybe [] (schemaTypeToXML "restructuringType") $ restructuring_type x
            , maybe [] (schemaTypeToXML "multipleHolderObligation") $ restr_multipleHolderObligation x
            , maybe [] (schemaTypeToXML "multipleCreditEventNotices") $ restr_multipleCreditEventNotices x
            ]
 
data RestructuringType = RestructuringType Scheme RestructuringTypeAttributes deriving (Eq,Show)
data RestructuringTypeAttributes = RestructuringTypeAttributes
    { restrTypeAttrib_restructuringScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType RestructuringType where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "restructuringScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ RestructuringType v (RestructuringTypeAttributes a0)
    schemaTypeToXML s (RestructuringType bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "restructuringScheme") $ restrTypeAttrib_restructuringScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension RestructuringType Scheme where
    supertype (RestructuringType s _) = s
 
-- | A type for definining equity option simple strike or 
--   calendar spread strategy features.
data StrategyFeature = StrategyFeature
        { stratFeature_choice0 :: (Maybe (OneOf2 StrikeSpread CalendarSpread))
          -- ^ Choice between:
          --   
          --   (1) Definition of the upper strike in a strike spread.
          --   
          --   (2) Definition of the later expiration date in a calendar 
          --   spread.
        }
        deriving (Eq,Show)
instance SchemaType StrategyFeature where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return StrategyFeature
            `apply` optional (oneOf' [ ("StrikeSpread", fmap OneOf2 (parseSchemaType "strikeSpread"))
                                     , ("CalendarSpread", fmap TwoOf2 (parseSchemaType "calendarSpread"))
                                     ])
    schemaTypeToXML s x@StrategyFeature{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "strikeSpread")
                                    (schemaTypeToXML "calendarSpread")
                                   ) $ stratFeature_choice0 x
            ]
 
-- | A type for defining a strike spread feature.
data StrikeSpread = StrikeSpread
        { strikeSpread_upperStrike :: Maybe OptionStrike
          -- ^ Upper strike in a strike spread.
        , strikeSpread_upperStrikeNumberOfOptions :: Maybe PositiveDecimal
          -- ^ Number of options at the upper strike price in a strike 
          --   spread.
        }
        deriving (Eq,Show)
instance SchemaType StrikeSpread where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return StrikeSpread
            `apply` optional (parseSchemaType "upperStrike")
            `apply` optional (parseSchemaType "upperStrikeNumberOfOptions")
    schemaTypeToXML s x@StrikeSpread{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "upperStrike") $ strikeSpread_upperStrike x
            , maybe [] (schemaTypeToXML "upperStrikeNumberOfOptions") $ strikeSpread_upperStrikeNumberOfOptions x
            ]
 
-- | Trigger point at which feature is effective.
data Trigger = Trigger
        { trigger_choice0 :: OneOf3 Xsd.Decimal Xsd.Decimal ((Maybe (OneOf2 CreditEvents CreditEventsReference)))
          -- ^ Choice between:
          --   
          --   (1) The trigger level.
          --   
          --   (2) The trigger level percentage.
          --   
          --   (3) Choice between either an explicit representation of 
          --   Credit Events, or Credit Events defined elsewhere in 
          --   the document.
        , trigger_type :: Maybe TriggerTypeEnum
          -- ^ The Triggering condition.
        , trigger_timeType :: Maybe TriggerTimeTypeEnum
          -- ^ The valuation time type of knock condition.
        }
        deriving (Eq,Show)
instance SchemaType Trigger where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Trigger
            `apply` oneOf' [ ("Xsd.Decimal", fmap OneOf3 (parseSchemaType "level"))
                           , ("Xsd.Decimal", fmap TwoOf3 (parseSchemaType "levelPercentage"))
                           , ("(Maybe (OneOf2 CreditEvents CreditEventsReference))", fmap ThreeOf3 (optional (oneOf' [ ("CreditEvents", fmap OneOf2 (parseSchemaType "creditEvents"))
                                                                                                                     , ("CreditEventsReference", fmap TwoOf2 (parseSchemaType "creditEventsReference"))
                                                                                                                     ])))
                           ]
            `apply` optional (parseSchemaType "triggerType")
            `apply` optional (parseSchemaType "triggerTimeType")
    schemaTypeToXML s x@Trigger{} =
        toXMLElement s []
            [ foldOneOf3  (schemaTypeToXML "level")
                          (schemaTypeToXML "levelPercentage")
                          (maybe [] (foldOneOf2  (schemaTypeToXML "creditEvents")
                                                 (schemaTypeToXML "creditEventsReference")
                                                ))
                          $ trigger_choice0 x
            , maybe [] (schemaTypeToXML "triggerType") $ trigger_type x
            , maybe [] (schemaTypeToXML "triggerTimeType") $ trigger_timeType x
            ]
 
-- | Observation point for trigger.
data TriggerEvent = TriggerEvent
        { triggerEvent_schedule :: [AveragingSchedule]
          -- ^ A Equity Derivative schedule.
        , triggerEvent_triggerDates :: Maybe DateList
          -- ^ The trigger Dates.
        , triggerEvent_trigger :: Maybe Trigger
          -- ^ The trigger level.
        , triggerEvent_featurePayment :: Maybe FeaturePayment
          -- ^ The feature payment.
        }
        deriving (Eq,Show)
instance SchemaType TriggerEvent where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return TriggerEvent
            `apply` many (parseSchemaType "schedule")
            `apply` optional (parseSchemaType "triggerDates")
            `apply` optional (parseSchemaType "trigger")
            `apply` optional (parseSchemaType "featurePayment")
    schemaTypeToXML s x@TriggerEvent{} =
        toXMLElement s []
            [ concatMap (schemaTypeToXML "schedule") $ triggerEvent_schedule x
            , maybe [] (schemaTypeToXML "triggerDates") $ triggerEvent_triggerDates x
            , maybe [] (schemaTypeToXML "trigger") $ triggerEvent_trigger x
            , maybe [] (schemaTypeToXML "featurePayment") $ triggerEvent_featurePayment x
            ]
 
-- | A single weighted averaging observation.
data WeightedAveragingObservation = WeightedAveragingObservation
        { weightAveragObserv_choice0 :: (Maybe (OneOf2 Xsd.DateTime Xsd.PositiveInteger))
          -- ^ Choice between date times for literal date values, and 
          --   observation numbers for schedule generated observations.
          --   
          --   Choice between:
          --   
          --   (1) Observation date time, which should be used when 
          --   literal observation dates are required.
          --   
          --   (2) Observation number, which should be unique, within a 
          --   series generated by a date schedule.
        , weightAveragObserv_weight :: Maybe NonNegativeDecimal
          -- ^ Observation weight, which is used as a multiplier for the 
          --   observation value.
        }
        deriving (Eq,Show)
instance SchemaType WeightedAveragingObservation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return WeightedAveragingObservation
            `apply` optional (oneOf' [ ("Xsd.DateTime", fmap OneOf2 (parseSchemaType "dateTime"))
                                     , ("Xsd.PositiveInteger", fmap TwoOf2 (parseSchemaType "observationNumber"))
                                     ])
            `apply` optional (parseSchemaType "weight")
    schemaTypeToXML s x@WeightedAveragingObservation{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "dateTime")
                                    (schemaTypeToXML "observationNumber")
                                   ) $ weightAveragObserv_choice0 x
            , maybe [] (schemaTypeToXML "weight") $ weightAveragObserv_weight x
            ]