{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Asset
  ( module Data.FpML.V53.Asset
  , module Data.FpML.V53.Shared
  ) 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
 
-- Some hs-boot imports are required, for fwd-declaring types.
 
data ActualPrice = ActualPrice
        { actualPrice_currency :: Maybe Currency
          -- ^ Specifies the currency associated with the net price. This 
          --   element is not present if the price is expressed in 
          --   percentage terms (as specified through the priceExpression 
          --   element).
        , actualPrice_amount :: Maybe Xsd.Decimal
          -- ^ Specifies the net price amount. In the case of a fixed 
          --   income security or a convertible bond, this price includes 
          --   the accrued interests.
        , actualPrice_priceExpression :: Maybe PriceExpressionEnum
          -- ^ Specifies whether the price is expressed in absolute or 
          --   relative terms.
        }
        deriving (Eq,Show)
instance SchemaType ActualPrice where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ActualPrice
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "amount")
            `apply` optional (parseSchemaType "priceExpression")
    schemaTypeToXML s x@ActualPrice{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "currency") $ actualPrice_currency x
            , maybe [] (schemaTypeToXML "amount") $ actualPrice_amount x
            , maybe [] (schemaTypeToXML "priceExpression") $ actualPrice_priceExpression x
            ]
 
-- | A reference to an asset, e.g. a portfolio, trade, or 
--   reference instrument..
data AnyAssetReference = AnyAssetReference
        { anyAssetRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType AnyAssetReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (AnyAssetReference a0)
    schemaTypeToXML s x@AnyAssetReference{} =
        toXMLElement s [ toXMLAttribute "href" $ anyAssetRef_href x
                       ]
            []
instance Extension AnyAssetReference Reference where
    supertype v = Reference_AnyAssetReference v
 
-- | Abstract base class for all underlying assets.
data Asset
        = Asset_IdentifiedAsset IdentifiedAsset
        | Asset_Cash Cash
        | Asset_Basket Basket
        
        deriving (Eq,Show)
instance SchemaType Asset where
    parseSchemaType s = do
        (fmap Asset_IdentifiedAsset $ parseSchemaType s)
        `onFail`
        (fmap Asset_Cash $ parseSchemaType s)
        `onFail`
        (fmap Asset_Basket $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of Asset,\n\
\  namely one of:\n\
\IdentifiedAsset,Cash,Basket"
    schemaTypeToXML _s (Asset_IdentifiedAsset x) = schemaTypeToXML "identifiedAsset" x
    schemaTypeToXML _s (Asset_Cash x) = schemaTypeToXML "cash" x
    schemaTypeToXML _s (Asset_Basket x) = schemaTypeToXML "basket" x
 
-- | A scheme identifying the types of measures that can be used 
--   to describe an asset.
data AssetMeasureType = AssetMeasureType Scheme AssetMeasureTypeAttributes deriving (Eq,Show)
data AssetMeasureTypeAttributes = AssetMeasureTypeAttributes
    { assetMeasureTypeAttrib_assetMeasureScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType AssetMeasureType where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "assetMeasureScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ AssetMeasureType v (AssetMeasureTypeAttributes a0)
    schemaTypeToXML s (AssetMeasureType bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "assetMeasureScheme") $ assetMeasureTypeAttrib_assetMeasureScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension AssetMeasureType Scheme where
    supertype (AssetMeasureType s _) = s
 
-- | A scheme identifying the types of pricing model used to 
--   evaluate the price of an asset. Examples include Intrinsic, 
--   ClosedForm, MonteCarlo, BackwardInduction.
data PricingModel = PricingModel Scheme PricingModelAttributes deriving (Eq,Show)
data PricingModelAttributes = PricingModelAttributes
    { pricingModelAttrib_pricingModelScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType PricingModel where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "pricingModelScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ PricingModel v (PricingModelAttributes a0)
    schemaTypeToXML s (PricingModel bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "pricingModelScheme") $ pricingModelAttrib_pricingModelScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension PricingModel Scheme where
    supertype (PricingModel s _) = s
 
-- | Characterise the asset pool behind an asset backed bond.
data AssetPool = AssetPool
        { assetPool_version :: Maybe Xsd.NonNegativeInteger
          -- ^ The version number
        , assetPool_effectiveDate :: Maybe IdentifiedDate
          -- ^ Optionally it is possible to specify a version effective 
          --   date when a versionId is supplied.
        , assetPool_initialFactor :: Maybe Xsd.Decimal
          -- ^ The part of the mortgage that is outstanding on trade 
          --   inception, i.e. has not been repaid yet as principal. It is 
          --   expressed as a multiplier factor to the morgage: 1 means 
          --   that the whole mortage amount is outstanding, 0.8 means 
          --   that 20% has been repaid.
        , assetPool_currentFactor :: Maybe Xsd.Decimal
          -- ^ The part of the mortgage that is currently outstanding. It 
          --   is expressed similarly to the initial factor, as factor 
          --   multiplier to the mortgage. This term is formally defined 
          --   as part of the "ISDA Standard Terms Supplement for use with 
          --   credit derivatives transactions on mortgage-backed security 
          --   with pas-as-you-go or physical settlement".
        }
        deriving (Eq,Show)
instance SchemaType AssetPool where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return AssetPool
            `apply` optional (parseSchemaType "version")
            `apply` optional (parseSchemaType "effectiveDate")
            `apply` optional (parseSchemaType "initialFactor")
            `apply` optional (parseSchemaType "currentFactor")
    schemaTypeToXML s x@AssetPool{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "version") $ assetPool_version x
            , maybe [] (schemaTypeToXML "effectiveDate") $ assetPool_effectiveDate x
            , maybe [] (schemaTypeToXML "initialFactor") $ assetPool_initialFactor x
            , maybe [] (schemaTypeToXML "currentFactor") $ assetPool_currentFactor x
            ]
 
-- | Reference to an underlying asset.
data AssetReference = AssetReference
        { assetRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType AssetReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (AssetReference a0)
    schemaTypeToXML s x@AssetReference{} =
        toXMLElement s [ toXMLAttribute "href" $ assetRef_href x
                       ]
            []
instance Extension AssetReference Reference where
    supertype v = Reference_AssetReference v
 
-- | Some kind of numerical measure about an asset, eg. its NPV, 
--   together with characteristics of that measure.
data BasicQuotation = BasicQuotation
        { basicQuot_ID :: Maybe Xsd.ID
        , basicQuot_value :: Maybe Xsd.Decimal
          -- ^ The value of the the quotation.
        , basicQuot_measureType :: Maybe AssetMeasureType
          -- ^ The type of the value that is measured. This could be an 
          --   NPV, a cash flow, a clean price, etc.
        , basicQuot_quoteUnits :: Maybe PriceQuoteUnits
          -- ^ The optional units that the measure is expressed in. If not 
          --   supplied, this is assumed to be a price/value in currency 
          --   units.
        , basicQuot_side :: Maybe QuotationSideEnum
          -- ^ The side (bid/mid/ask) of the measure.
        , basicQuot_currency :: Maybe Currency
          -- ^ The optional currency that the measure is expressed in. If 
          --   not supplied, this is defaulted from the reportingCurrency 
          --   in the valuationScenarioDefinition.
        , basicQuot_currencyType :: Maybe ReportingCurrencyType
          -- ^ The optional currency that the measure is expressed in. If 
          --   not supplied, this is defaulted from the reportingCurrency 
          --   in the valuationScenarioDefinition.
        , basicQuot_timing :: Maybe QuoteTiming
          -- ^ When during a day the quote is for. Typically, if this 
          --   element is supplied, the QuoteLocation needs also to be 
          --   supplied.
        , basicQuot_choice7 :: (Maybe (OneOf2 BusinessCenter ExchangeId))
          -- ^ Choice between:
          --   
          --   (1) A city or other business center.
          --   
          --   (2) The exchange (e.g. stock or futures exchange) from 
          --   which the quote is obtained.
        , basicQuot_informationSource :: [InformationSource]
          -- ^ The information source where a published or displayed 
          --   market rate will be obtained, e.g. Telerate Page 3750.
        , basicQuot_pricingModel :: Maybe PricingModel
          -- ^ .
        , basicQuot_time :: Maybe Xsd.DateTime
          -- ^ When the quote was observed or derived.
        , basicQuot_valuationDate :: Maybe Xsd.Date
          -- ^ When the quote was computed.
        , basicQuot_expiryTime :: Maybe Xsd.DateTime
          -- ^ When does the quote cease to be valid.
        , basicQuot_cashflowType :: Maybe CashflowType
          -- ^ For cash flows, the type of the cash flows. Examples 
          --   include: Coupon payment, Premium Fee, Settlement Fee, 
          --   Brokerage Fee, etc.
        }
        deriving (Eq,Show)
instance SchemaType BasicQuotation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (BasicQuotation a0)
            `apply` optional (parseSchemaType "value")
            `apply` optional (parseSchemaType "measureType")
            `apply` optional (parseSchemaType "quoteUnits")
            `apply` optional (parseSchemaType "side")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "currencyType")
            `apply` optional (parseSchemaType "timing")
            `apply` optional (oneOf' [ ("BusinessCenter", fmap OneOf2 (parseSchemaType "businessCenter"))
                                     , ("ExchangeId", fmap TwoOf2 (parseSchemaType "exchangeId"))
                                     ])
            `apply` many (parseSchemaType "informationSource")
            `apply` optional (parseSchemaType "pricingModel")
            `apply` optional (parseSchemaType "time")
            `apply` optional (parseSchemaType "valuationDate")
            `apply` optional (parseSchemaType "expiryTime")
            `apply` optional (parseSchemaType "cashflowType")
    schemaTypeToXML s x@BasicQuotation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ basicQuot_ID x
                       ]
            [ maybe [] (schemaTypeToXML "value") $ basicQuot_value x
            , maybe [] (schemaTypeToXML "measureType") $ basicQuot_measureType x
            , maybe [] (schemaTypeToXML "quoteUnits") $ basicQuot_quoteUnits x
            , maybe [] (schemaTypeToXML "side") $ basicQuot_side x
            , maybe [] (schemaTypeToXML "currency") $ basicQuot_currency x
            , maybe [] (schemaTypeToXML "currencyType") $ basicQuot_currencyType x
            , maybe [] (schemaTypeToXML "timing") $ basicQuot_timing x
            , maybe [] (foldOneOf2  (schemaTypeToXML "businessCenter")
                                    (schemaTypeToXML "exchangeId")
                                   ) $ basicQuot_choice7 x
            , concatMap (schemaTypeToXML "informationSource") $ basicQuot_informationSource x
            , maybe [] (schemaTypeToXML "pricingModel") $ basicQuot_pricingModel x
            , maybe [] (schemaTypeToXML "time") $ basicQuot_time x
            , maybe [] (schemaTypeToXML "valuationDate") $ basicQuot_valuationDate x
            , maybe [] (schemaTypeToXML "expiryTime") $ basicQuot_expiryTime x
            , maybe [] (schemaTypeToXML "cashflowType") $ basicQuot_cashflowType x
            ]
 
-- | A type describing the underlyer features of a basket swap. 
--   Each of the basket constituents are described through an 
--   embedded component, the basketConstituentsType.
data Basket = Basket
        { basket_ID :: Maybe Xsd.ID
        , basket_openUnits :: Maybe Xsd.Decimal
          -- ^ The number of units (index or securities) that constitute 
          --   the underlyer of the swap. In the case of a basket swap, 
          --   this element is used to reference both the number of basket 
          --   units, and the number of each asset components of the 
          --   basket when these are expressed in absolute terms.
        , basket_constituent :: [BasketConstituent]
          -- ^ Describes each of the components of the basket.
        , basket_divisor :: Maybe Xsd.Decimal
          -- ^ Specifies the basket divisor amount. This value is normally 
          --   used to adjust the constituent weight for pricing or to 
          --   adjust for dividends, or other corporate actions.
        , basket_choice3 :: (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
        , basket_currency :: Maybe Currency
          -- ^ Specifies the currency for this basket.
        }
        deriving (Eq,Show)
instance SchemaType Basket where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Basket a0)
            `apply` optional (parseSchemaType "openUnits")
            `apply` many (parseSchemaType "basketConstituent")
            `apply` optional (parseSchemaType "basketDivisor")
            `apply` optional (oneOf' [ ("Maybe BasketName [BasketId]", fmap OneOf1 (return (,) `apply` optional (parseSchemaType "basketName")
                                                                                               `apply` many (parseSchemaType "basketId")))
                                     ])
            `apply` optional (parseSchemaType "basketCurrency")
    schemaTypeToXML s x@Basket{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ basket_ID x
                       ]
            [ maybe [] (schemaTypeToXML "openUnits") $ basket_openUnits x
            , concatMap (schemaTypeToXML "basketConstituent") $ basket_constituent x
            , maybe [] (schemaTypeToXML "basketDivisor") $ basket_divisor x
            , maybe [] (foldOneOf1  (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "basketName") a
                                                       , concatMap (schemaTypeToXML "basketId") b
                                                       ])
                                   ) $ basket_choice3 x
            , maybe [] (schemaTypeToXML "basketCurrency") $ basket_currency x
            ]
instance Extension Basket Asset where
    supertype v = Asset_Basket v
 
-- | A type describing each of the constituents of a basket.
data BasketConstituent = BasketConstituent
        { basketConstit_ID :: Maybe Xsd.ID
        , basketConstit_underlyingAsset :: Maybe Asset
          -- ^ Define the underlying asset, either a listed security or 
          --   other instrument.
        , basketConstit_constituentWeight :: Maybe ConstituentWeight
          -- ^ Specifies the weight of each of the underlyer constituent 
          --   within the basket, either in absolute or relative terms. 
          --   This is an optional component, as certain swaps do not 
          --   specify a specific weight for each of their basket 
          --   constituents.
        , basketConstit_dividendPayout :: Maybe DividendPayout
          -- ^ Specifies the dividend payout ratio associated with an 
          --   equity underlyer. A basket swap can have different payout 
          --   ratios across the various underlying constituents. In 
          --   certain cases the actual ratio is not known on trade 
          --   inception, and only general conditions are then specified. 
          --   Users should note that FpML makes a distinction between the 
          --   derivative contract and the underlyer of the contract. It 
          --   would be better if the agreed dividend payout on a 
          --   derivative contract was modelled at the level of the 
          --   derivative contract, an approach which may be adopted in 
          --   the next major version of FpML.
        , basketConstit_underlyerPrice :: Maybe Price
          -- ^ Specifies the price that is associated with each of the 
          --   basket constituents. This component is optional, as it is 
          --   not absolutely required to accurately describe the 
          --   economics of the trade, considering the price that 
          --   characterizes the equity swap is associated to the leg of 
          --   the trade.
        , basketConstit_underlyerNotional :: Maybe Money
          -- ^ Specifies the notional (i.e. price * quantity) that is 
          --   associated with each of the basket constituents. This 
          --   component is optional, as it is not absolutely required to 
          --   accurately describe the economics of the trade, considering 
          --   the notional that characterizes the equity swap is 
          --   associated to the leg of the trade.
        , basketConstit_underlyerSpread :: Maybe SpreadScheduleReference
          -- ^ Provides a link to the spread schedule used for this 
          --   underlyer.
        , basketConstit_couponPayment :: Maybe PendingPayment
          -- ^ The next upcoming coupon payment.
        }
        deriving (Eq,Show)
instance SchemaType BasketConstituent where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (BasketConstituent a0)
            `apply` optional (elementUnderlyingAsset)
            `apply` optional (parseSchemaType "constituentWeight")
            `apply` optional (parseSchemaType "dividendPayout")
            `apply` optional (parseSchemaType "underlyerPrice")
            `apply` optional (parseSchemaType "underlyerNotional")
            `apply` optional (parseSchemaType "underlyerSpread")
            `apply` optional (parseSchemaType "couponPayment")
    schemaTypeToXML s x@BasketConstituent{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ basketConstit_ID x
                       ]
            [ maybe [] (elementToXMLUnderlyingAsset) $ basketConstit_underlyingAsset x
            , maybe [] (schemaTypeToXML "constituentWeight") $ basketConstit_constituentWeight x
            , maybe [] (schemaTypeToXML "dividendPayout") $ basketConstit_dividendPayout x
            , maybe [] (schemaTypeToXML "underlyerPrice") $ basketConstit_underlyerPrice x
            , maybe [] (schemaTypeToXML "underlyerNotional") $ basketConstit_underlyerNotional x
            , maybe [] (schemaTypeToXML "underlyerSpread") $ basketConstit_underlyerSpread x
            , maybe [] (schemaTypeToXML "couponPayment") $ basketConstit_couponPayment x
            ]
 
data BasketId = BasketId Scheme BasketIdAttributes deriving (Eq,Show)
data BasketIdAttributes = BasketIdAttributes
    { basketIdAttrib_basketIdScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType BasketId where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "basketIdScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ BasketId v (BasketIdAttributes a0)
    schemaTypeToXML s (BasketId bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "basketIdScheme") $ basketIdAttrib_basketIdScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension BasketId Scheme where
    supertype (BasketId s _) = s
 
data BasketName = BasketName Scheme BasketNameAttributes deriving (Eq,Show)
data BasketNameAttributes = BasketNameAttributes
    { basketNameAttrib_basketNameScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType BasketName where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "basketNameScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ BasketName v (BasketNameAttributes a0)
    schemaTypeToXML s (BasketName bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "basketNameScheme") $ basketNameAttrib_basketNameScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension BasketName Scheme where
    supertype (BasketName s _) = s
 
-- | An exchange traded bond.
data Bond = Bond
        { bond_ID :: Maybe Xsd.ID
        , bond_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , bond_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , bond_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , bond_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , bond_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , bond_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , bond_choice6 :: (Maybe (OneOf2 Xsd.XsdString PartyReference))
          -- ^ Specifies the issuer name of a fixed income security or 
          --   convertible bond. This name can either be explicitly 
          --   stated, or specified as an href into another element of the 
          --   document, such as the obligor.
          --   
          --   Choice between:
          --   
          --   (1) issuerName
          --   
          --   (2) issuerPartyReference
        , bond_seniority :: Maybe CreditSeniority
          -- ^ The repayment precedence of a debt instrument.
        , bond_couponType :: Maybe CouponType
          -- ^ Specifies if the bond has a variable coupon, step-up/down 
          --   coupon or a zero-coupon.
        , bond_couponRate :: Maybe Xsd.Decimal
          -- ^ Specifies the coupon rate (expressed in percentage) of a 
          --   fixed income security or convertible bond.
        , bond_maturity :: Maybe Xsd.Date
          -- ^ The date when the principal amount of a security becomes 
          --   due and payable.
        , bond_parValue :: Maybe Xsd.Decimal
          -- ^ Specifies the nominal amount of a fixed income security or 
          --   convertible bond.
        , bond_faceAmount :: Maybe Xsd.Decimal
          -- ^ Specifies the total amount of the issue. Corresponds to the 
          --   par value multiplied by the number of issued security.
        , bond_paymentFrequency :: Maybe Period
          -- ^ Specifies the frequency at which the bond pays, e.g. 6M.
        , bond_dayCountFraction :: Maybe DayCountFraction
          -- ^ The day count basis for the bond.
        }
        deriving (Eq,Show)
instance SchemaType Bond where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Bond a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` optional (oneOf' [ ("Xsd.XsdString", fmap OneOf2 (parseSchemaType "issuerName"))
                                     , ("PartyReference", fmap TwoOf2 (parseSchemaType "issuerPartyReference"))
                                     ])
            `apply` optional (parseSchemaType "seniority")
            `apply` optional (parseSchemaType "couponType")
            `apply` optional (parseSchemaType "couponRate")
            `apply` optional (parseSchemaType "maturity")
            `apply` optional (parseSchemaType "parValue")
            `apply` optional (parseSchemaType "faceAmount")
            `apply` optional (parseSchemaType "paymentFrequency")
            `apply` optional (parseSchemaType "dayCountFraction")
    schemaTypeToXML s x@Bond{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ bond_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ bond_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ bond_description x
            , maybe [] (schemaTypeToXML "currency") $ bond_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ bond_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ bond_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ bond_definition x
            , maybe [] (foldOneOf2  (schemaTypeToXML "issuerName")
                                    (schemaTypeToXML "issuerPartyReference")
                                   ) $ bond_choice6 x
            , maybe [] (schemaTypeToXML "seniority") $ bond_seniority x
            , maybe [] (schemaTypeToXML "couponType") $ bond_couponType x
            , maybe [] (schemaTypeToXML "couponRate") $ bond_couponRate x
            , maybe [] (schemaTypeToXML "maturity") $ bond_maturity x
            , maybe [] (schemaTypeToXML "parValue") $ bond_parValue x
            , maybe [] (schemaTypeToXML "faceAmount") $ bond_faceAmount x
            , maybe [] (schemaTypeToXML "paymentFrequency") $ bond_paymentFrequency x
            , maybe [] (schemaTypeToXML "dayCountFraction") $ bond_dayCountFraction x
            ]
instance Extension Bond UnderlyingAsset where
    supertype v = UnderlyingAsset_Bond v
instance Extension Bond IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: Bond -> UnderlyingAsset)
              
instance Extension Bond Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: Bond -> UnderlyingAsset)
              
 
data Cash = Cash
        { cash_ID :: Maybe Xsd.ID
        , cash_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , cash_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , cash_currency :: Maybe Currency
          -- ^ The currency in which an amount is denominated.
        }
        deriving (Eq,Show)
instance SchemaType Cash where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Cash a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
    schemaTypeToXML s x@Cash{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ cash_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ cash_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ cash_description x
            , maybe [] (schemaTypeToXML "currency") $ cash_currency x
            ]
instance Extension Cash Asset where
    supertype v = Asset_Cash v
 
-- | A type describing the commission that will be charged for 
--   each of the hedge transactions.
data Commission = Commission
        { commission_denomination :: Maybe CommissionDenominationEnum
          -- ^ The type of units used to express a commission.
        , commission_amount :: Maybe Xsd.Decimal
          -- ^ The commission amount, expressed in the way indicated by 
          --   the commissionType element.
        , commission_currency :: Maybe Currency
          -- ^ The currency in which an amount is denominated.
        , commission_perTrade :: Maybe Xsd.Decimal
          -- ^ The total commission per trade.
        , commission_fxRate :: [FxRate]
          -- ^ FX Rates that have been used to convert commissions to a 
          --   single currency.
        }
        deriving (Eq,Show)
instance SchemaType Commission where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Commission
            `apply` optional (parseSchemaType "commissionDenomination")
            `apply` optional (parseSchemaType "commissionAmount")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "commissionPerTrade")
            `apply` many (parseSchemaType "fxRate")
    schemaTypeToXML s x@Commission{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "commissionDenomination") $ commission_denomination x
            , maybe [] (schemaTypeToXML "commissionAmount") $ commission_amount x
            , maybe [] (schemaTypeToXML "currency") $ commission_currency x
            , maybe [] (schemaTypeToXML "commissionPerTrade") $ commission_perTrade x
            , concatMap (schemaTypeToXML "fxRate") $ commission_fxRate x
            ]
 
-- | A type describing a commodity underlying asset.
data Commodity = Commodity
        { commodity_ID :: Maybe Xsd.ID
        , commodity_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , commodity_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , commodity_base :: Maybe CommodityBase
          -- ^ A coding scheme value to identify the base type of the 
          --   commodity being traded. Where possible, this should follow 
          --   the naming convention used in the 2005 ISDA Commodity 
          --   Definitions. For example, 'Oil'.
        , commodity_details :: Maybe CommodityDetails
          -- ^ A coding scheme value to identify the commodity being 
          --   traded more specifically. Where possible, this should 
          --   follow the naming convention used in the 2005 ISDA 
          --   Commodity Definitions. For example, 'Brent'.
        , commodity_unit :: Maybe QuantityUnit
          -- ^ A coding scheme value to identify the unit in which the 
          --   undelryer is denominated. Where possible, this should 
          --   follow the naming convention used in the 2005 ISDA 
          --   Commodity Definitions.
        , commodity_currency :: Maybe Currency
          -- ^ The currency in which the Commodity Reference Price is 
          --   published.
        , commodity_choice6 :: (Maybe (OneOf2 ExchangeId InformationSource))
          -- ^ Choice between:
          --   
          --   (1) For those commodities being traded with reference to 
          --   the price of a listed future, the exchange where that 
          --   future is listed should be specified here.
          --   
          --   (2) For those commodities being traded with reference to a 
          --   price distributed by a publication, that publication 
          --   should be specified here.
        , commodity_specifiedPrice :: Maybe SpecifiedPriceEnum
          -- ^ The Specified Price is not defined in the Commodity 
          --   Reference Price and so needs to be stated in the Underlyer 
          --   definition as it will impact the calculation of the 
          --   Floating Price.
        , commodity_choice8 :: (Maybe (OneOf3 DeliveryDatesEnum AdjustableDate Xsd.GYearMonth))
          -- ^ Choice between:
          --   
          --   (1) The Delivery Date is a NearbyMonth, for use when the 
          --   Commodity Transaction references Futures Contract.
          --   
          --   (2) The Delivery Date is a fixed, single day.
          --   
          --   (3) The Delivery Date is a fixed, single month.
        , commodity_deliveryDateRollConvention :: Maybe Offset
          -- ^ Specifies, for a Commodity Transaction that references a 
          --   listed future via the deliveryDates element, the day on 
          --   which the specified future will roll to the next nearby 
          --   month when the referenced future expires. If the future 
          --   will not roll at all - i.e. the price will be taken from 
          --   the expiring contract, 0 should be specified here. If the 
          --   future will roll to the next nearby on the last trading day 
          --   - i.e. the price will be taken from the next nearby on the 
          --   last trading day, then 1 should be specified and so on.
        , commodity_multiplier :: Maybe PositiveDecimal
          -- ^ Specifies the multiplier associated with a Transaction.
        }
        deriving (Eq,Show)
instance SchemaType Commodity where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Commodity a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "commodityBase")
            `apply` optional (parseSchemaType "commodityDetails")
            `apply` optional (parseSchemaType "unit")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (oneOf' [ ("ExchangeId", fmap OneOf2 (parseSchemaType "exchangeId"))
                                     , ("InformationSource", fmap TwoOf2 (parseSchemaType "publication"))
                                     ])
            `apply` optional (parseSchemaType "specifiedPrice")
            `apply` optional (oneOf' [ ("DeliveryDatesEnum", fmap OneOf3 (parseSchemaType "deliveryDates"))
                                     , ("AdjustableDate", fmap TwoOf3 (parseSchemaType "deliveryDate"))
                                     , ("Xsd.GYearMonth", fmap ThreeOf3 (parseSchemaType "deliveryDateYearMonth"))
                                     ])
            `apply` optional (parseSchemaType "deliveryDateRollConvention")
            `apply` optional (parseSchemaType "multiplier")
    schemaTypeToXML s x@Commodity{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodity_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ commodity_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ commodity_description x
            , maybe [] (schemaTypeToXML "commodityBase") $ commodity_base x
            , maybe [] (schemaTypeToXML "commodityDetails") $ commodity_details x
            , maybe [] (schemaTypeToXML "unit") $ commodity_unit x
            , maybe [] (schemaTypeToXML "currency") $ commodity_currency x
            , maybe [] (foldOneOf2  (schemaTypeToXML "exchangeId")
                                    (schemaTypeToXML "publication")
                                   ) $ commodity_choice6 x
            , maybe [] (schemaTypeToXML "specifiedPrice") $ commodity_specifiedPrice x
            , maybe [] (foldOneOf3  (schemaTypeToXML "deliveryDates")
                                    (schemaTypeToXML "deliveryDate")
                                    (schemaTypeToXML "deliveryDateYearMonth")
                                   ) $ commodity_choice8 x
            , maybe [] (schemaTypeToXML "deliveryDateRollConvention") $ commodity_deliveryDateRollConvention x
            , maybe [] (schemaTypeToXML "multiplier") $ commodity_multiplier x
            ]
instance Extension Commodity IdentifiedAsset where
    supertype v = IdentifiedAsset_Commodity v
instance Extension Commodity Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: Commodity -> IdentifiedAsset)
              
 
data CommodityBase = CommodityBase Scheme CommodityBaseAttributes deriving (Eq,Show)
data CommodityBaseAttributes = CommodityBaseAttributes
    { commodBaseAttrib_commodityBaseScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType CommodityBase where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "commodityBaseScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ CommodityBase v (CommodityBaseAttributes a0)
    schemaTypeToXML s (CommodityBase bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "commodityBaseScheme") $ commodBaseAttrib_commodityBaseScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension CommodityBase Scheme where
    supertype (CommodityBase s _) = s
 
-- | Defines a commodity business day calendar.
data CommodityBusinessCalendar = CommodityBusinessCalendar Scheme CommodityBusinessCalendarAttributes deriving (Eq,Show)
data CommodityBusinessCalendarAttributes = CommodityBusinessCalendarAttributes
    { cbca_commodityBusinessCalendarScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType CommodityBusinessCalendar where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "commodityBusinessCalendarScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ CommodityBusinessCalendar v (CommodityBusinessCalendarAttributes a0)
    schemaTypeToXML s (CommodityBusinessCalendar bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "commodityBusinessCalendarScheme") $ cbca_commodityBusinessCalendarScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension CommodityBusinessCalendar Scheme where
    supertype (CommodityBusinessCalendar s _) = s
 
-- | Specifies the time with respect to a commodity business 
--   calendar.
data CommodityBusinessCalendarTime = CommodityBusinessCalendarTime
        { commodBusCalTime_hourMinuteTime :: Maybe HourMinuteTime
          -- ^ A time specified as Hour Ending in hh:mm:ss format where 
          --   the second component must be '00', e.g. 11am would be 
          --   represented as 11:00:00.
        , commodBusCalTime_timeZone :: Maybe TimeZone
          -- ^ An identifier for a specific location or region which 
          --   translates into a combination of rules for calculating the 
          --   UTC offset.
        , commodBusCalTime_businessCalendar :: Maybe CommodityBusinessCalendar
          -- ^ Identifies a commodity business day calendar.
        }
        deriving (Eq,Show)
instance SchemaType CommodityBusinessCalendarTime where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return CommodityBusinessCalendarTime
            `apply` optional (parseSchemaType "hourMinuteTime")
            `apply` optional (parseSchemaType "timeZone")
            `apply` optional (parseSchemaType "businessCalendar")
    schemaTypeToXML s x@CommodityBusinessCalendarTime{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "hourMinuteTime") $ commodBusCalTime_hourMinuteTime x
            , maybe [] (schemaTypeToXML "timeZone") $ commodBusCalTime_timeZone x
            , maybe [] (schemaTypeToXML "businessCalendar") $ commodBusCalTime_businessCalendar x
            ]
 
data CommodityDetails = CommodityDetails Scheme CommodityDetailsAttributes deriving (Eq,Show)
data CommodityDetailsAttributes = CommodityDetailsAttributes
    { commodDetailsAttrib_commodityDetailsScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType CommodityDetails where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "commodityDetailsScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ CommodityDetails v (CommodityDetailsAttributes a0)
    schemaTypeToXML s (CommodityDetails bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "commodityDetailsScheme") $ commodDetailsAttrib_commodityDetailsScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension CommodityDetails Scheme where
    supertype (CommodityDetails s _) = s
 
-- | A type describing the weight of each of the underlyer 
--   constituent within the basket, either in absolute or 
--   relative terms.
data ConstituentWeight = ConstituentWeight
        { constitWeight_choice0 :: (Maybe (OneOf3 Xsd.Decimal RestrictedPercentage Money))
          -- ^ Choice between:
          --   
          --   (1) The number of units (index or securities) that 
          --   constitute the underlyer of the swap. In the case of a 
          --   basket swap, this element is used to reference both the 
          --   number of basket units, and the number of each asset 
          --   components of the basket when these are expressed in 
          --   absolute terms.
          --   
          --   (2) The relative weight of each respective basket 
          --   constituent, expressed in percentage. A basket 
          --   percentage of 5% would be represented as 0.05.
          --   
          --   (3) DEPRECATED. The relative weight of each respective 
          --   basket constituent, expressed as a monetary amount.
        }
        deriving (Eq,Show)
instance SchemaType ConstituentWeight where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ConstituentWeight
            `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf3 (parseSchemaType "openUnits"))
                                     , ("RestrictedPercentage", fmap TwoOf3 (parseSchemaType "basketPercentage"))
                                     , ("Money", fmap ThreeOf3 (parseSchemaType "basketAmount"))
                                     ])
    schemaTypeToXML s x@ConstituentWeight{} =
        toXMLElement s []
            [ maybe [] (foldOneOf3  (schemaTypeToXML "openUnits")
                                    (schemaTypeToXML "basketPercentage")
                                    (schemaTypeToXML "basketAmount")
                                   ) $ constitWeight_choice0 x
            ]
 
data ConvertibleBond = ConvertibleBond
        { convertBond_ID :: Maybe Xsd.ID
        , convertBond_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , convertBond_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , convertBond_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , convertBond_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , convertBond_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , convertBond_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , convertBond_choice6 :: (Maybe (OneOf2 Xsd.XsdString PartyReference))
          -- ^ Specifies the issuer name of a fixed income security or 
          --   convertible bond. This name can either be explicitly 
          --   stated, or specified as an href into another element of the 
          --   document, such as the obligor.
          --   
          --   Choice between:
          --   
          --   (1) issuerName
          --   
          --   (2) issuerPartyReference
        , convertBond_seniority :: Maybe CreditSeniority
          -- ^ The repayment precedence of a debt instrument.
        , convertBond_couponType :: Maybe CouponType
          -- ^ Specifies if the bond has a variable coupon, step-up/down 
          --   coupon or a zero-coupon.
        , convertBond_couponRate :: Maybe Xsd.Decimal
          -- ^ Specifies the coupon rate (expressed in percentage) of a 
          --   fixed income security or convertible bond.
        , convertBond_maturity :: Maybe Xsd.Date
          -- ^ The date when the principal amount of a security becomes 
          --   due and payable.
        , convertBond_parValue :: Maybe Xsd.Decimal
          -- ^ Specifies the nominal amount of a fixed income security or 
          --   convertible bond.
        , convertBond_faceAmount :: Maybe Xsd.Decimal
          -- ^ Specifies the total amount of the issue. Corresponds to the 
          --   par value multiplied by the number of issued security.
        , convertBond_paymentFrequency :: Maybe Period
          -- ^ Specifies the frequency at which the bond pays, e.g. 6M.
        , convertBond_dayCountFraction :: Maybe DayCountFraction
          -- ^ The day count basis for the bond.
        , convertBond_underlyingEquity :: Maybe EquityAsset
          -- ^ Specifies the equity in which the convertible bond can be 
          --   converted.
        , convertBond_redemptionDate :: Maybe Xsd.Date
          -- ^ Earlier date between the convertible bond put dates and its 
          --   maturity date.
        }
        deriving (Eq,Show)
instance SchemaType ConvertibleBond where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ConvertibleBond a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` optional (oneOf' [ ("Xsd.XsdString", fmap OneOf2 (parseSchemaType "issuerName"))
                                     , ("PartyReference", fmap TwoOf2 (parseSchemaType "issuerPartyReference"))
                                     ])
            `apply` optional (parseSchemaType "seniority")
            `apply` optional (parseSchemaType "couponType")
            `apply` optional (parseSchemaType "couponRate")
            `apply` optional (parseSchemaType "maturity")
            `apply` optional (parseSchemaType "parValue")
            `apply` optional (parseSchemaType "faceAmount")
            `apply` optional (parseSchemaType "paymentFrequency")
            `apply` optional (parseSchemaType "dayCountFraction")
            `apply` optional (parseSchemaType "underlyingEquity")
            `apply` optional (parseSchemaType "redemptionDate")
    schemaTypeToXML s x@ConvertibleBond{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ convertBond_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ convertBond_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ convertBond_description x
            , maybe [] (schemaTypeToXML "currency") $ convertBond_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ convertBond_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ convertBond_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ convertBond_definition x
            , maybe [] (foldOneOf2  (schemaTypeToXML "issuerName")
                                    (schemaTypeToXML "issuerPartyReference")
                                   ) $ convertBond_choice6 x
            , maybe [] (schemaTypeToXML "seniority") $ convertBond_seniority x
            , maybe [] (schemaTypeToXML "couponType") $ convertBond_couponType x
            , maybe [] (schemaTypeToXML "couponRate") $ convertBond_couponRate x
            , maybe [] (schemaTypeToXML "maturity") $ convertBond_maturity x
            , maybe [] (schemaTypeToXML "parValue") $ convertBond_parValue x
            , maybe [] (schemaTypeToXML "faceAmount") $ convertBond_faceAmount x
            , maybe [] (schemaTypeToXML "paymentFrequency") $ convertBond_paymentFrequency x
            , maybe [] (schemaTypeToXML "dayCountFraction") $ convertBond_dayCountFraction x
            , maybe [] (schemaTypeToXML "underlyingEquity") $ convertBond_underlyingEquity x
            , maybe [] (schemaTypeToXML "redemptionDate") $ convertBond_redemptionDate x
            ]
instance Extension ConvertibleBond Bond where
    supertype (ConvertibleBond a0 e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10 e11 e12 e13 e14 e15 e16) =
               Bond a0 e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10 e11 e12 e13 e14
instance Extension ConvertibleBond UnderlyingAsset where
    supertype = (supertype :: Bond -> UnderlyingAsset)
              . (supertype :: ConvertibleBond -> Bond)
              
instance Extension ConvertibleBond IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: Bond -> UnderlyingAsset)
              . (supertype :: ConvertibleBond -> Bond)
              
instance Extension ConvertibleBond Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: Bond -> UnderlyingAsset)
              . (supertype :: ConvertibleBond -> Bond)
              
 
-- | Defines a scheme of values for specifiying if the bond has 
--   a variable coupon, step-up/down coupon or a zero-coupon.
data CouponType = CouponType Scheme CouponTypeAttributes deriving (Eq,Show)
data CouponTypeAttributes = CouponTypeAttributes
    { couponTypeAttrib_couponTypeScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType CouponType where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "couponTypeScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ CouponType v (CouponTypeAttributes a0)
    schemaTypeToXML s (CouponType bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "couponTypeScheme") $ couponTypeAttrib_couponTypeScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension CouponType Scheme where
    supertype (CouponType s _) = s
 
-- | Abstract base class for instruments intended to be used 
--   primarily for building curves.
--  (There are no subtypes defined for this abstract type.)
data CurveInstrument = CurveInstrument deriving (Eq,Show)
instance SchemaType CurveInstrument where
    parseSchemaType s = fail "Parse failed when expecting an extension type of CurveInstrument:\n  No extension types are known."
    schemaTypeToXML s _ = toXMLElement s [] []
instance Extension CurveInstrument IdentifiedAsset where
    supertype v = IdentifiedAsset_CurveInstrument v
 
data Deposit = Deposit
        { deposit_ID :: Maybe Xsd.ID
        , deposit_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , deposit_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , deposit_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , deposit_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , deposit_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , deposit_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , deposit_term :: Maybe Period
          -- ^ Specifies the term of the deposit, e.g. 5Y.
        , deposit_paymentFrequency :: Maybe Period
          -- ^ Specifies the frequency at which the deposit pays, e.g. 6M.
        , deposit_dayCountFraction :: Maybe DayCountFraction
          -- ^ The day count basis for the deposit.
        }
        deriving (Eq,Show)
instance SchemaType Deposit where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Deposit a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` optional (parseSchemaType "term")
            `apply` optional (parseSchemaType "paymentFrequency")
            `apply` optional (parseSchemaType "dayCountFraction")
    schemaTypeToXML s x@Deposit{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ deposit_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ deposit_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ deposit_description x
            , maybe [] (schemaTypeToXML "currency") $ deposit_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ deposit_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ deposit_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ deposit_definition x
            , maybe [] (schemaTypeToXML "term") $ deposit_term x
            , maybe [] (schemaTypeToXML "paymentFrequency") $ deposit_paymentFrequency x
            , maybe [] (schemaTypeToXML "dayCountFraction") $ deposit_dayCountFraction x
            ]
instance Extension Deposit UnderlyingAsset where
    supertype v = UnderlyingAsset_Deposit v
instance Extension Deposit IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: Deposit -> UnderlyingAsset)
              
instance Extension Deposit Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: Deposit -> UnderlyingAsset)
              
 
-- | A type describing the dividend payout ratio associated with 
--   an equity underlyer. In certain cases the actual ratio is 
--   not known on trade inception, and only general conditions 
--   are then specified.
data DividendPayout = DividendPayout
        { dividPayout_choice0 :: (Maybe (OneOf2 Xsd.Decimal Xsd.XsdString))
          -- ^ Choice between:
          --   
          --   (1) Specifies the actual dividend payout ratio associated 
          --   with the equity underlyer.
          --   
          --   (2) Specifies the dividend payout conditions that will be 
          --   applied in the case where the actual ratio is not 
          --   known, typically because of regulatory or legal 
          --   uncertainties.
        , dividPayout_dividendPayment :: [PendingPayment]
          -- ^ The next upcoming dividend payment or payments.
        }
        deriving (Eq,Show)
instance SchemaType DividendPayout where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return DividendPayout
            `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "dividendPayoutRatio"))
                                     , ("Xsd.XsdString", fmap TwoOf2 (parseSchemaType "dividendPayoutConditions"))
                                     ])
            `apply` many (parseSchemaType "dividendPayment")
    schemaTypeToXML s x@DividendPayout{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "dividendPayoutRatio")
                                    (schemaTypeToXML "dividendPayoutConditions")
                                   ) $ dividPayout_choice0 x
            , concatMap (schemaTypeToXML "dividendPayment") $ dividPayout_dividendPayment x
            ]
 
-- | An exchange traded equity asset.
data EquityAsset = EquityAsset
        { equityAsset_ID :: Maybe Xsd.ID
        , equityAsset_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , equityAsset_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , equityAsset_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , equityAsset_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , equityAsset_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , equityAsset_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , equityAsset_relatedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a related exchange. If 
          --   the element is not present then the exchange shall be the 
          --   primary exchange on which listed futures and options on the 
          --   underlying are listed. The term "Exchange" is assumed to 
          --   have the meaning as defined in the ISDA 2002 Equity 
          --   Derivatives Definitions.
        , equityAsset_optionsExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for an exchange on which the 
          --   reference option contract is listed. This is to address the 
          --   case where the reference exchange for the future is 
          --   different than the one for the option. The options Exchange 
          --   is referenced on share options when Merger Elections are 
          --   selected as Options Exchange Adjustment.
        , equityAsset_specifiedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a specified exchange. If 
          --   the element is not present then the exchange shall be 
          --   default terms as defined in the MCA; unless otherwise 
          --   specified in the Transaction Supplement.
        }
        deriving (Eq,Show)
instance SchemaType EquityAsset where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (EquityAsset a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` many (parseSchemaType "relatedExchangeId")
            `apply` many (parseSchemaType "optionsExchangeId")
            `apply` many (parseSchemaType "specifiedExchangeId")
    schemaTypeToXML s x@EquityAsset{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ equityAsset_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ equityAsset_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ equityAsset_description x
            , maybe [] (schemaTypeToXML "currency") $ equityAsset_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ equityAsset_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ equityAsset_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ equityAsset_definition x
            , concatMap (schemaTypeToXML "relatedExchangeId") $ equityAsset_relatedExchangeId x
            , concatMap (schemaTypeToXML "optionsExchangeId") $ equityAsset_optionsExchangeId x
            , concatMap (schemaTypeToXML "specifiedExchangeId") $ equityAsset_specifiedExchangeId x
            ]
instance Extension EquityAsset ExchangeTraded where
    supertype v = ExchangeTraded_EquityAsset v
instance Extension EquityAsset UnderlyingAsset where
    supertype = (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: EquityAsset -> ExchangeTraded)
              
instance Extension EquityAsset IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: EquityAsset -> ExchangeTraded)
              
instance Extension EquityAsset Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: EquityAsset -> ExchangeTraded)
              
 
-- | An abstract base class for all exchange traded financial 
--   products.
data ExchangeTraded
        = ExchangeTraded_Future Future
        | ExchangeTraded_ExchangeTradedContract ExchangeTradedContract
        | ExchangeTraded_ExchangeTradedCalculatedPrice ExchangeTradedCalculatedPrice
        | ExchangeTraded_EquityAsset EquityAsset
        
        deriving (Eq,Show)
instance SchemaType ExchangeTraded where
    parseSchemaType s = do
        (fmap ExchangeTraded_Future $ parseSchemaType s)
        `onFail`
        (fmap ExchangeTraded_ExchangeTradedContract $ parseSchemaType s)
        `onFail`
        (fmap ExchangeTraded_ExchangeTradedCalculatedPrice $ parseSchemaType s)
        `onFail`
        (fmap ExchangeTraded_EquityAsset $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of ExchangeTraded,\n\
\  namely one of:\n\
\Future,ExchangeTradedContract,ExchangeTradedCalculatedPrice,EquityAsset"
    schemaTypeToXML _s (ExchangeTraded_Future x) = schemaTypeToXML "future" x
    schemaTypeToXML _s (ExchangeTraded_ExchangeTradedContract x) = schemaTypeToXML "exchangeTradedContract" x
    schemaTypeToXML _s (ExchangeTraded_ExchangeTradedCalculatedPrice x) = schemaTypeToXML "exchangeTradedCalculatedPrice" x
    schemaTypeToXML _s (ExchangeTraded_EquityAsset x) = schemaTypeToXML "equityAsset" x
instance Extension ExchangeTraded UnderlyingAsset where
    supertype v = UnderlyingAsset_ExchangeTraded v
 
-- | Abstract base class for all exchange traded financial 
--   products with a price which is calculated from exchange 
--   traded constituents.
data ExchangeTradedCalculatedPrice
        = ExchangeTradedCalculatedPrice_Index Index
        | ExchangeTradedCalculatedPrice_ExchangeTradedFund ExchangeTradedFund
        
        deriving (Eq,Show)
instance SchemaType ExchangeTradedCalculatedPrice where
    parseSchemaType s = do
        (fmap ExchangeTradedCalculatedPrice_Index $ parseSchemaType s)
        `onFail`
        (fmap ExchangeTradedCalculatedPrice_ExchangeTradedFund $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of ExchangeTradedCalculatedPrice,\n\
\  namely one of:\n\
\Index,ExchangeTradedFund"
    schemaTypeToXML _s (ExchangeTradedCalculatedPrice_Index x) = schemaTypeToXML "index" x
    schemaTypeToXML _s (ExchangeTradedCalculatedPrice_ExchangeTradedFund x) = schemaTypeToXML "exchangeTradedFund" x
instance Extension ExchangeTradedCalculatedPrice ExchangeTraded where
    supertype v = ExchangeTraded_ExchangeTradedCalculatedPrice v
 
-- | An exchange traded derivative contract.
data ExchangeTradedContract = ExchangeTradedContract
        { exchTradedContr_ID :: Maybe Xsd.ID
        , exchTradedContr_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , exchTradedContr_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , exchTradedContr_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , exchTradedContr_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , exchTradedContr_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , exchTradedContr_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , exchTradedContr_relatedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a related exchange. If 
          --   the element is not present then the exchange shall be the 
          --   primary exchange on which listed futures and options on the 
          --   underlying are listed. The term "Exchange" is assumed to 
          --   have the meaning as defined in the ISDA 2002 Equity 
          --   Derivatives Definitions.
        , exchTradedContr_optionsExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for an exchange on which the 
          --   reference option contract is listed. This is to address the 
          --   case where the reference exchange for the future is 
          --   different than the one for the option. The options Exchange 
          --   is referenced on share options when Merger Elections are 
          --   selected as Options Exchange Adjustment.
        , exchTradedContr_specifiedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a specified exchange. If 
          --   the element is not present then the exchange shall be 
          --   default terms as defined in the MCA; unless otherwise 
          --   specified in the Transaction Supplement.
        , exchTradedContr_multiplier :: Maybe Xsd.PositiveInteger
          -- ^ Specifies the contract multiplier that can be associated 
          --   with the number of units.
        , exchTradedContr_contractReference :: Maybe Xsd.XsdString
          -- ^ Specifies the contract that can be referenced, besides the 
          --   undelyer type.
        , exchTradedContr_expirationDate :: Maybe AdjustableOrRelativeDate
          -- ^ The date when the contract expires.
        }
        deriving (Eq,Show)
instance SchemaType ExchangeTradedContract where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ExchangeTradedContract a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` many (parseSchemaType "relatedExchangeId")
            `apply` many (parseSchemaType "optionsExchangeId")
            `apply` many (parseSchemaType "specifiedExchangeId")
            `apply` optional (parseSchemaType "multiplier")
            `apply` optional (parseSchemaType "contractReference")
            `apply` optional (parseSchemaType "expirationDate")
    schemaTypeToXML s x@ExchangeTradedContract{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ exchTradedContr_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ exchTradedContr_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ exchTradedContr_description x
            , maybe [] (schemaTypeToXML "currency") $ exchTradedContr_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ exchTradedContr_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ exchTradedContr_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ exchTradedContr_definition x
            , concatMap (schemaTypeToXML "relatedExchangeId") $ exchTradedContr_relatedExchangeId x
            , concatMap (schemaTypeToXML "optionsExchangeId") $ exchTradedContr_optionsExchangeId x
            , concatMap (schemaTypeToXML "specifiedExchangeId") $ exchTradedContr_specifiedExchangeId x
            , maybe [] (schemaTypeToXML "multiplier") $ exchTradedContr_multiplier x
            , maybe [] (schemaTypeToXML "contractReference") $ exchTradedContr_contractReference x
            , maybe [] (schemaTypeToXML "expirationDate") $ exchTradedContr_expirationDate x
            ]
instance Extension ExchangeTradedContract ExchangeTraded where
    supertype v = ExchangeTraded_ExchangeTradedContract v
instance Extension ExchangeTradedContract UnderlyingAsset where
    supertype = (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: ExchangeTradedContract -> ExchangeTraded)
              
instance Extension ExchangeTradedContract IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: ExchangeTradedContract -> ExchangeTraded)
              
instance Extension ExchangeTradedContract Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: ExchangeTradedContract -> ExchangeTraded)
              
 
-- | An exchange traded fund whose price depends on exchange 
--   traded constituents.
data ExchangeTradedFund = ExchangeTradedFund
        { exchTradedFund_ID :: Maybe Xsd.ID
        , exchTradedFund_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , exchTradedFund_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , exchTradedFund_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , exchTradedFund_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , exchTradedFund_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , exchTradedFund_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , exchTradedFund_relatedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a related exchange. If 
          --   the element is not present then the exchange shall be the 
          --   primary exchange on which listed futures and options on the 
          --   underlying are listed. The term "Exchange" is assumed to 
          --   have the meaning as defined in the ISDA 2002 Equity 
          --   Derivatives Definitions.
        , exchTradedFund_optionsExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for an exchange on which the 
          --   reference option contract is listed. This is to address the 
          --   case where the reference exchange for the future is 
          --   different than the one for the option. The options Exchange 
          --   is referenced on share options when Merger Elections are 
          --   selected as Options Exchange Adjustment.
        , exchTradedFund_specifiedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a specified exchange. If 
          --   the element is not present then the exchange shall be 
          --   default terms as defined in the MCA; unless otherwise 
          --   specified in the Transaction Supplement.
        , exchTradedFund_constituentExchangeId :: [ExchangeId]
          -- ^ Identification of all the exchanges where constituents are 
          --   traded. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , exchTradedFund_fundManager :: Maybe Xsd.XsdString
          -- ^ Specifies the fund manager that is in charge of the fund.
        }
        deriving (Eq,Show)
instance SchemaType ExchangeTradedFund where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ExchangeTradedFund a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` many (parseSchemaType "relatedExchangeId")
            `apply` many (parseSchemaType "optionsExchangeId")
            `apply` many (parseSchemaType "specifiedExchangeId")
            `apply` many (parseSchemaType "constituentExchangeId")
            `apply` optional (parseSchemaType "fundManager")
    schemaTypeToXML s x@ExchangeTradedFund{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ exchTradedFund_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ exchTradedFund_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ exchTradedFund_description x
            , maybe [] (schemaTypeToXML "currency") $ exchTradedFund_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ exchTradedFund_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ exchTradedFund_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ exchTradedFund_definition x
            , concatMap (schemaTypeToXML "relatedExchangeId") $ exchTradedFund_relatedExchangeId x
            , concatMap (schemaTypeToXML "optionsExchangeId") $ exchTradedFund_optionsExchangeId x
            , concatMap (schemaTypeToXML "specifiedExchangeId") $ exchTradedFund_specifiedExchangeId x
            , concatMap (schemaTypeToXML "constituentExchangeId") $ exchTradedFund_constituentExchangeId x
            , maybe [] (schemaTypeToXML "fundManager") $ exchTradedFund_fundManager x
            ]
instance Extension ExchangeTradedFund ExchangeTradedCalculatedPrice where
    supertype v = ExchangeTradedCalculatedPrice_ExchangeTradedFund v
instance Extension ExchangeTradedFund ExchangeTraded where
    supertype = (supertype :: ExchangeTradedCalculatedPrice -> ExchangeTraded)
              . (supertype :: ExchangeTradedFund -> ExchangeTradedCalculatedPrice)
              
instance Extension ExchangeTradedFund UnderlyingAsset where
    supertype = (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: ExchangeTradedCalculatedPrice -> ExchangeTraded)
              . (supertype :: ExchangeTradedFund -> ExchangeTradedCalculatedPrice)
              
instance Extension ExchangeTradedFund IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: ExchangeTradedCalculatedPrice -> ExchangeTraded)
              . (supertype :: ExchangeTradedFund -> ExchangeTradedCalculatedPrice)
              
instance Extension ExchangeTradedFund Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: ExchangeTradedCalculatedPrice -> ExchangeTraded)
              . (supertype :: ExchangeTradedFund -> ExchangeTradedCalculatedPrice)
              
 
-- | A type describing the type of loan facility.
data FacilityType = FacilityType Scheme FacilityTypeAttributes deriving (Eq,Show)
data FacilityTypeAttributes = FacilityTypeAttributes
    { facilTypeAttrib_facilityTypeScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType FacilityType where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "facilityTypeScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ FacilityType v (FacilityTypeAttributes a0)
    schemaTypeToXML s (FacilityType bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "facilityTypeScheme") $ facilTypeAttrib_facilityTypeScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension FacilityType Scheme where
    supertype (FacilityType s _) = s
 
-- | An exchange traded future contract.
data Future = Future
        { future_ID :: Maybe Xsd.ID
        , future_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , future_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , future_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , future_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , future_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , future_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , future_relatedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a related exchange. If 
          --   the element is not present then the exchange shall be the 
          --   primary exchange on which listed futures and options on the 
          --   underlying are listed. The term "Exchange" is assumed to 
          --   have the meaning as defined in the ISDA 2002 Equity 
          --   Derivatives Definitions.
        , future_optionsExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for an exchange on which the 
          --   reference option contract is listed. This is to address the 
          --   case where the reference exchange for the future is 
          --   different than the one for the option. The options Exchange 
          --   is referenced on share options when Merger Elections are 
          --   selected as Options Exchange Adjustment.
        , future_specifiedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a specified exchange. If 
          --   the element is not present then the exchange shall be 
          --   default terms as defined in the MCA; unless otherwise 
          --   specified in the Transaction Supplement.
        , future_multiplier :: Maybe Xsd.PositiveInteger
          -- ^ Specifies the contract multiplier that can be associated 
          --   with the number of units.
        , future_contractReference :: Maybe Xsd.XsdString
          -- ^ Specifies the future contract that can be referenced, 
          --   besides the equity or index reference defined as part of 
          --   the UnderlyerAsset type.
        , future_maturity :: Maybe Xsd.Date
          -- ^ The date when the future contract expires.
        }
        deriving (Eq,Show)
instance SchemaType Future where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Future a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` many (parseSchemaType "relatedExchangeId")
            `apply` many (parseSchemaType "optionsExchangeId")
            `apply` many (parseSchemaType "specifiedExchangeId")
            `apply` optional (parseSchemaType "multiplier")
            `apply` optional (parseSchemaType "futureContractReference")
            `apply` optional (parseSchemaType "maturity")
    schemaTypeToXML s x@Future{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ future_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ future_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ future_description x
            , maybe [] (schemaTypeToXML "currency") $ future_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ future_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ future_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ future_definition x
            , concatMap (schemaTypeToXML "relatedExchangeId") $ future_relatedExchangeId x
            , concatMap (schemaTypeToXML "optionsExchangeId") $ future_optionsExchangeId x
            , concatMap (schemaTypeToXML "specifiedExchangeId") $ future_specifiedExchangeId x
            , maybe [] (schemaTypeToXML "multiplier") $ future_multiplier x
            , maybe [] (schemaTypeToXML "futureContractReference") $ future_contractReference x
            , maybe [] (schemaTypeToXML "maturity") $ future_maturity x
            ]
instance Extension Future ExchangeTraded where
    supertype v = ExchangeTraded_Future v
instance Extension Future UnderlyingAsset where
    supertype = (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: Future -> ExchangeTraded)
              
instance Extension Future IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: Future -> ExchangeTraded)
              
instance Extension Future Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: Future -> ExchangeTraded)
              
 
-- | A type defining a short form unique identifier for a future 
--   contract.
data FutureId = FutureId Scheme FutureIdAttributes deriving (Eq,Show)
data FutureIdAttributes = FutureIdAttributes
    { futureIdAttrib_futureIdScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType FutureId where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "futureIdScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ FutureId v (FutureIdAttributes a0)
    schemaTypeToXML s (FutureId bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "futureIdScheme") $ futureIdAttrib_futureIdScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension FutureId Scheme where
    supertype (FutureId s _) = s
 
data FxConversion = FxConversion
        { fxConversion_choice0 :: (Maybe (OneOf2 AmountReference [FxRate]))
          -- ^ Choice between:
          --   
          --   (1) amountRelativeTo
          --   
          --   (2) Specifies a currency conversion rate.
        }
        deriving (Eq,Show)
instance SchemaType FxConversion where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return FxConversion
            `apply` optional (oneOf' [ ("AmountReference", fmap OneOf2 (parseSchemaType "amountRelativeTo"))
                                     , ("[FxRate]", fmap TwoOf2 (many1 (parseSchemaType "fxRate")))
                                     ])
    schemaTypeToXML s x@FxConversion{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "amountRelativeTo")
                                    (concatMap (schemaTypeToXML "fxRate"))
                                   ) $ fxConversion_choice0 x
            ]
 
data FxRateAsset = FxRateAsset
        { fxRateAsset_ID :: Maybe Xsd.ID
        , fxRateAsset_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , fxRateAsset_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , fxRateAsset_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , fxRateAsset_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , fxRateAsset_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , fxRateAsset_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , fxRateAsset_quotedCurrencyPair :: Maybe QuotedCurrencyPair
          -- ^ Defines the two currencies for an FX trade and the 
          --   quotation relationship between the two currencies.
        , fxRateAsset_rateSource :: Maybe FxSpotRateSource
          -- ^ Defines the source of the FX rate.
        }
        deriving (Eq,Show)
instance SchemaType FxRateAsset where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (FxRateAsset a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` optional (parseSchemaType "quotedCurrencyPair")
            `apply` optional (parseSchemaType "rateSource")
    schemaTypeToXML s x@FxRateAsset{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxRateAsset_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ fxRateAsset_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ fxRateAsset_description x
            , maybe [] (schemaTypeToXML "currency") $ fxRateAsset_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ fxRateAsset_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ fxRateAsset_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ fxRateAsset_definition x
            , maybe [] (schemaTypeToXML "quotedCurrencyPair") $ fxRateAsset_quotedCurrencyPair x
            , maybe [] (schemaTypeToXML "rateSource") $ fxRateAsset_rateSource x
            ]
instance Extension FxRateAsset UnderlyingAsset where
    supertype v = UnderlyingAsset_FxRateAsset v
instance Extension FxRateAsset IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: FxRateAsset -> UnderlyingAsset)
              
instance Extension FxRateAsset Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: FxRateAsset -> UnderlyingAsset)
              
 
-- | A generic type describing an identified asset.
data IdentifiedAsset
        = IdentifiedAsset_UnderlyingAsset UnderlyingAsset
        | IdentifiedAsset_CurveInstrument CurveInstrument
        | IdentifiedAsset_Commodity Commodity
        
        deriving (Eq,Show)
instance SchemaType IdentifiedAsset where
    parseSchemaType s = do
        (fmap IdentifiedAsset_UnderlyingAsset $ parseSchemaType s)
        `onFail`
        (fmap IdentifiedAsset_CurveInstrument $ parseSchemaType s)
        `onFail`
        (fmap IdentifiedAsset_Commodity $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of IdentifiedAsset,\n\
\  namely one of:\n\
\UnderlyingAsset,CurveInstrument,Commodity"
    schemaTypeToXML _s (IdentifiedAsset_UnderlyingAsset x) = schemaTypeToXML "underlyingAsset" x
    schemaTypeToXML _s (IdentifiedAsset_CurveInstrument x) = schemaTypeToXML "curveInstrument" x
    schemaTypeToXML _s (IdentifiedAsset_Commodity x) = schemaTypeToXML "commodity" x
instance Extension IdentifiedAsset Asset where
    supertype v = Asset_IdentifiedAsset v
 
-- | A published index whose price depends on exchange traded 
--   constituents.
data Index = Index
        { index_ID :: Maybe Xsd.ID
        , index_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , index_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , index_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , index_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , index_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , index_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , index_relatedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a related exchange. If 
          --   the element is not present then the exchange shall be the 
          --   primary exchange on which listed futures and options on the 
          --   underlying are listed. The term "Exchange" is assumed to 
          --   have the meaning as defined in the ISDA 2002 Equity 
          --   Derivatives Definitions.
        , index_optionsExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for an exchange on which the 
          --   reference option contract is listed. This is to address the 
          --   case where the reference exchange for the future is 
          --   different than the one for the option. The options Exchange 
          --   is referenced on share options when Merger Elections are 
          --   selected as Options Exchange Adjustment.
        , index_specifiedExchangeId :: [ExchangeId]
          -- ^ A short form unique identifier for a specified exchange. If 
          --   the element is not present then the exchange shall be 
          --   default terms as defined in the MCA; unless otherwise 
          --   specified in the Transaction Supplement.
        , index_constituentExchangeId :: [ExchangeId]
          -- ^ Identification of all the exchanges where constituents are 
          --   traded. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , index_futureId :: Maybe FutureId
          -- ^ A short form unique identifier for the reference future 
          --   contract in the case of an index underlyer.
        }
        deriving (Eq,Show)
instance SchemaType Index where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Index a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` many (parseSchemaType "relatedExchangeId")
            `apply` many (parseSchemaType "optionsExchangeId")
            `apply` many (parseSchemaType "specifiedExchangeId")
            `apply` many (parseSchemaType "constituentExchangeId")
            `apply` optional (parseSchemaType "futureId")
    schemaTypeToXML s x@Index{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ index_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ index_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ index_description x
            , maybe [] (schemaTypeToXML "currency") $ index_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ index_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ index_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ index_definition x
            , concatMap (schemaTypeToXML "relatedExchangeId") $ index_relatedExchangeId x
            , concatMap (schemaTypeToXML "optionsExchangeId") $ index_optionsExchangeId x
            , concatMap (schemaTypeToXML "specifiedExchangeId") $ index_specifiedExchangeId x
            , concatMap (schemaTypeToXML "constituentExchangeId") $ index_constituentExchangeId x
            , maybe [] (schemaTypeToXML "futureId") $ index_futureId x
            ]
instance Extension Index ExchangeTradedCalculatedPrice where
    supertype v = ExchangeTradedCalculatedPrice_Index v
instance Extension Index ExchangeTraded where
    supertype = (supertype :: ExchangeTradedCalculatedPrice -> ExchangeTraded)
              . (supertype :: Index -> ExchangeTradedCalculatedPrice)
              
instance Extension Index UnderlyingAsset where
    supertype = (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: ExchangeTradedCalculatedPrice -> ExchangeTraded)
              . (supertype :: Index -> ExchangeTradedCalculatedPrice)
              
instance Extension Index IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: ExchangeTradedCalculatedPrice -> ExchangeTraded)
              . (supertype :: Index -> ExchangeTradedCalculatedPrice)
              
instance Extension Index Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: ExchangeTraded -> UnderlyingAsset)
              . (supertype :: ExchangeTradedCalculatedPrice -> ExchangeTraded)
              . (supertype :: Index -> ExchangeTradedCalculatedPrice)
              
 
-- | A type describing the liens associated with a loan 
--   facility.
data Lien = Lien Scheme LienAttributes deriving (Eq,Show)
data LienAttributes = LienAttributes
    { lienAttrib_lienScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType Lien where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "lienScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ Lien v (LienAttributes a0)
    schemaTypeToXML s (Lien bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "lienScheme") $ lienAttrib_lienScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension Lien Scheme where
    supertype (Lien s _) = s
 
-- | A type describing a loan underlying asset.
data Loan = Loan
        { loan_ID :: Maybe Xsd.ID
        , loan_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , loan_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , loan_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , loan_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , loan_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , loan_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , loan_choice6 :: [OneOf2 LegalEntity LegalEntityReference]
          -- ^ Specifies the borrower. There can be more than one 
          --   borrower. It is meant to be used in the event that there is 
          --   no Bloomberg Id or the Secured List isn't applicable.
          --   
          --   Choice between:
          --   
          --   (1) borrower
          --   
          --   (2) borrowerReference
        , loan_lien :: Maybe Lien
          -- ^ Specifies the seniority level of the lien.
        , loan_facilityType :: Maybe FacilityType
          -- ^ The type of loan facility (letter of credit, revolving, 
          --   ...).
        , loan_maturity :: Maybe Xsd.Date
          -- ^ The date when the principal amount of the loan becomes due 
          --   and payable.
        , loan_creditAgreementDate :: Maybe Xsd.Date
          -- ^ The credit agreement date is the closing date (the date 
          --   where the agreement has been signed) for the loans in the 
          --   credit agreement. Funding of the facilities occurs on (or 
          --   sometimes a little after) the Credit Agreement date. This 
          --   underlyer attribute is used to help identify which of the 
          --   company's outstanding loans are being referenced by knowing 
          --   to which credit agreement it belongs. ISDA Standards Terms 
          --   Supplement term: Date of Original Credit Agreement.
        , loan_tranche :: Maybe UnderlyingAssetTranche
          -- ^ The loan tranche that is subject to the derivative 
          --   transaction. It will typically be referenced as the 
          --   Bloomberg tranche number. ISDA Standards Terms Supplement 
          --   term: Bloomberg Tranche Number.
        }
        deriving (Eq,Show)
instance SchemaType Loan where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Loan a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` many (oneOf' [ ("LegalEntity", fmap OneOf2 (parseSchemaType "borrower"))
                                 , ("LegalEntityReference", fmap TwoOf2 (parseSchemaType "borrowerReference"))
                                 ])
            `apply` optional (parseSchemaType "lien")
            `apply` optional (parseSchemaType "facilityType")
            `apply` optional (parseSchemaType "maturity")
            `apply` optional (parseSchemaType "creditAgreementDate")
            `apply` optional (parseSchemaType "tranche")
    schemaTypeToXML s x@Loan{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ loan_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ loan_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ loan_description x
            , maybe [] (schemaTypeToXML "currency") $ loan_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ loan_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ loan_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ loan_definition x
            , concatMap (foldOneOf2  (schemaTypeToXML "borrower")
                                     (schemaTypeToXML "borrowerReference")
                                    ) $ loan_choice6 x
            , maybe [] (schemaTypeToXML "lien") $ loan_lien x
            , maybe [] (schemaTypeToXML "facilityType") $ loan_facilityType x
            , maybe [] (schemaTypeToXML "maturity") $ loan_maturity x
            , maybe [] (schemaTypeToXML "creditAgreementDate") $ loan_creditAgreementDate x
            , maybe [] (schemaTypeToXML "tranche") $ loan_tranche x
            ]
instance Extension Loan UnderlyingAsset where
    supertype v = UnderlyingAsset_Loan v
instance Extension Loan IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: Loan -> UnderlyingAsset)
              
instance Extension Loan Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: Loan -> UnderlyingAsset)
              
 
-- | A type describing a mortgage asset.
data Mortgage = Mortgage
        { mortgage_ID :: Maybe Xsd.ID
        , mortgage_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , mortgage_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , mortgage_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , mortgage_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , mortgage_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , mortgage_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , mortgage_choice6 :: (Maybe (OneOf2 LegalEntity LegalEntityReference))
          -- ^ Applicable to the case of default swaps on MBS terms. For 
          --   specifying the insurer name, when applicable (when the 
          --   element is not present, it signifies that the insurer is 
          --   Not Applicable)
          --   
          --   Choice between:
          --   
          --   (1) insurer
          --   
          --   (2) insurerReference
        , mortgage_choice7 :: (Maybe (OneOf2 Xsd.XsdString PartyReference))
          -- ^ Specifies the issuer name of a fixed income security or 
          --   convertible bond. This name can either be explicitly 
          --   stated, or specified as an href into another element of the 
          --   document, such as the obligor.
          --   
          --   Choice between:
          --   
          --   (1) issuerName
          --   
          --   (2) issuerPartyReference
        , mortgage_seniority :: Maybe CreditSeniority
          -- ^ The repayment precedence of a debt instrument.
        , mortgage_couponType :: Maybe CouponType
          -- ^ Specifies if the bond has a variable coupon, step-up/down 
          --   coupon or a zero-coupon.
        , mortgage_couponRate :: Maybe Xsd.Decimal
          -- ^ Specifies the coupon rate (expressed in percentage) of a 
          --   fixed income security or convertible bond.
        , mortgage_maturity :: Maybe Xsd.Date
          -- ^ The date when the principal amount of a security becomes 
          --   due and payable.
        , mortgage_paymentFrequency :: Maybe Period
          -- ^ Specifies the frequency at which the bond pays, e.g. 6M.
        , mortgage_dayCountFraction :: Maybe DayCountFraction
          -- ^ The day count basis for the bond.
        , mortgage_originalPrincipalAmount :: Maybe Xsd.Decimal
          -- ^ The initial issued amount of the mortgage obligation.
        , mortgage_pool :: Maybe AssetPool
          -- ^ The morgage pool that is underneath the mortgage 
          --   obligation.
        , mortgage_sector :: Maybe MortgageSector
          -- ^ The sector classification of the mortgage obligation.
        , mortgage_tranche :: Maybe Xsd.Token
          -- ^ The mortgage obligation tranche that is subject to the 
          --   derivative transaction.
        }
        deriving (Eq,Show)
instance SchemaType Mortgage where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Mortgage a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` optional (oneOf' [ ("LegalEntity", fmap OneOf2 (parseSchemaType "insurer"))
                                     , ("LegalEntityReference", fmap TwoOf2 (parseSchemaType "insurerReference"))
                                     ])
            `apply` optional (oneOf' [ ("Xsd.XsdString", fmap OneOf2 (parseSchemaType "issuerName"))
                                     , ("PartyReference", fmap TwoOf2 (parseSchemaType "issuerPartyReference"))
                                     ])
            `apply` optional (parseSchemaType "seniority")
            `apply` optional (parseSchemaType "couponType")
            `apply` optional (parseSchemaType "couponRate")
            `apply` optional (parseSchemaType "maturity")
            `apply` optional (parseSchemaType "paymentFrequency")
            `apply` optional (parseSchemaType "dayCountFraction")
            `apply` optional (parseSchemaType "originalPrincipalAmount")
            `apply` optional (parseSchemaType "pool")
            `apply` optional (parseSchemaType "sector")
            `apply` optional (parseSchemaType "tranche")
    schemaTypeToXML s x@Mortgage{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ mortgage_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ mortgage_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ mortgage_description x
            , maybe [] (schemaTypeToXML "currency") $ mortgage_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ mortgage_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ mortgage_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ mortgage_definition x
            , maybe [] (foldOneOf2  (schemaTypeToXML "insurer")
                                    (schemaTypeToXML "insurerReference")
                                   ) $ mortgage_choice6 x
            , maybe [] (foldOneOf2  (schemaTypeToXML "issuerName")
                                    (schemaTypeToXML "issuerPartyReference")
                                   ) $ mortgage_choice7 x
            , maybe [] (schemaTypeToXML "seniority") $ mortgage_seniority x
            , maybe [] (schemaTypeToXML "couponType") $ mortgage_couponType x
            , maybe [] (schemaTypeToXML "couponRate") $ mortgage_couponRate x
            , maybe [] (schemaTypeToXML "maturity") $ mortgage_maturity x
            , maybe [] (schemaTypeToXML "paymentFrequency") $ mortgage_paymentFrequency x
            , maybe [] (schemaTypeToXML "dayCountFraction") $ mortgage_dayCountFraction x
            , maybe [] (schemaTypeToXML "originalPrincipalAmount") $ mortgage_originalPrincipalAmount x
            , maybe [] (schemaTypeToXML "pool") $ mortgage_pool x
            , maybe [] (schemaTypeToXML "sector") $ mortgage_sector x
            , maybe [] (schemaTypeToXML "tranche") $ mortgage_tranche x
            ]
instance Extension Mortgage UnderlyingAsset where
    supertype v = UnderlyingAsset_Mortgage v
instance Extension Mortgage IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: Mortgage -> UnderlyingAsset)
              
instance Extension Mortgage Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: Mortgage -> UnderlyingAsset)
              
 
-- | A type describing the typology of mortgage obligations.
data MortgageSector = MortgageSector Scheme MortgageSectorAttributes deriving (Eq,Show)
data MortgageSectorAttributes = MortgageSectorAttributes
    { mortgSectorAttrib_mortgageSectorScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType MortgageSector where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "mortgageSectorScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ MortgageSector v (MortgageSectorAttributes a0)
    schemaTypeToXML s (MortgageSector bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "mortgageSectorScheme") $ mortgSectorAttrib_mortgageSectorScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension MortgageSector Scheme where
    supertype (MortgageSector s _) = s
 
data MutualFund = MutualFund
        { mutualFund_ID :: Maybe Xsd.ID
        , mutualFund_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , mutualFund_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , mutualFund_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , mutualFund_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , mutualFund_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , mutualFund_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , mutualFund_openEndedFund :: Maybe Xsd.Boolean
          -- ^ Boolean indicator to specify whether the mutual fund is an 
          --   open-ended mutual fund.
        , mutualFund_fundManager :: Maybe Xsd.XsdString
          -- ^ Specifies the fund manager that is in charge of the fund.
        }
        deriving (Eq,Show)
instance SchemaType MutualFund where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (MutualFund a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` optional (parseSchemaType "openEndedFund")
            `apply` optional (parseSchemaType "fundManager")
    schemaTypeToXML s x@MutualFund{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ mutualFund_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ mutualFund_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ mutualFund_description x
            , maybe [] (schemaTypeToXML "currency") $ mutualFund_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ mutualFund_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ mutualFund_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ mutualFund_definition x
            , maybe [] (schemaTypeToXML "openEndedFund") $ mutualFund_openEndedFund x
            , maybe [] (schemaTypeToXML "fundManager") $ mutualFund_fundManager x
            ]
instance Extension MutualFund UnderlyingAsset where
    supertype v = UnderlyingAsset_MutualFund v
instance Extension MutualFund IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: MutualFund -> UnderlyingAsset)
              
instance Extension MutualFund Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: MutualFund -> UnderlyingAsset)
              
 
-- | A structure representing a pending dividend or coupon 
--   payment.
data PendingPayment = PendingPayment
        { pendingPayment_ID :: Maybe Xsd.ID
        , pendingPayment_paymentDate :: Maybe Xsd.Date
          -- ^ The date that the dividend or coupon is due.
        , pendingPayment_amount :: Maybe Money
          -- ^ The amount of the dividend or coupon payment. Value of 
          --   dividends or coupon between ex and pay date. Stock: if we 
          --   are between ex-date and pay-date and the dividend is 
          --   payable under the swap, then this should be the ex-div 
          --   amount * # of securities. Bond: regardless of where we are 
          --   vis-a-vis resets: (coupon % * face of bonds on swap * (bond 
          --   day count fraction using days last coupon pay date of the 
          --   bond through today).
        , pendingPayment_accruedInterest :: Maybe Money
          -- ^ Accrued interest on the dividend or coupon payment. When 
          --   the TRS is structured to pay a dividend or coupon on reset 
          --   after payable date, you may earn interest on these amounts. 
          --   This field indicates the interest accrued on 
          --   dividend/coupon from pay date to statement date. This will 
          --   only apply to a handful of agreements where dividendss are 
          --   held to the next reset AND you receive/pay interest on 
          --   unpaid amounts.
        }
        deriving (Eq,Show)
instance SchemaType PendingPayment where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (PendingPayment a0)
            `apply` optional (parseSchemaType "paymentDate")
            `apply` optional (parseSchemaType "amount")
            `apply` optional (parseSchemaType "accruedInterest")
    schemaTypeToXML s x@PendingPayment{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ pendingPayment_ID x
                       ]
            [ maybe [] (schemaTypeToXML "paymentDate") $ pendingPayment_paymentDate x
            , maybe [] (schemaTypeToXML "amount") $ pendingPayment_amount x
            , maybe [] (schemaTypeToXML "accruedInterest") $ pendingPayment_accruedInterest x
            ]
instance Extension PendingPayment PaymentBase where
    supertype v = PaymentBase_PendingPayment v
 
-- | A type describing the strike price.
data Price = Price
        { price_commission :: Maybe Commission
          -- ^ This optional component specifies the commission to be 
          --   charged for executing the hedge transactions.
        , price_choice1 :: OneOf3 (DeterminationMethod,(Maybe (ActualPrice)),(Maybe (ActualPrice)),(Maybe (Xsd.Decimal)),(Maybe (FxConversion))) AmountReference ((Maybe (ActualPrice)),(Maybe (ActualPrice)),(Maybe (Xsd.Decimal)),(Maybe (FxConversion)))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * Specifies the method according to which an amount 
          --   or a date is determined.
          --   
          --     * Specifies the price of the underlyer, before 
          --   commissions.
          --   
          --     * Specifies the price of the underlyer, net of 
          --   commissions.
          --   
          --     * Specifies the accrued interest that are part of the 
          --   dirty price in the case of a fixed income security 
          --   or a convertible bond. Expressed in percentage of 
          --   the notional.
          --   
          --     * Specifies the currency conversion rate that applies 
          --   to an amount. This rate can either be defined 
          --   elsewhere in the document (case of a quanto swap), 
          --   or explicitly described through this component.
          --   
          --   (2) The href attribute value will be a pointer style 
          --   reference to the element or component elsewhere in the 
          --   document where the anchor amount is defined.
          --   
          --   (3) Sequence of:
          --   
          --     * Specifies the price of the underlyer, before 
          --   commissions.
          --   
          --     * Specifies the price of the underlyer, net of 
          --   commissions.
          --   
          --     * Specifies the accrued interest that are part of the 
          --   dirty price in the case of a fixed income security 
          --   or a convertible bond. Expressed in percentage of 
          --   the notional.
          --   
          --     * Specifies the currency conversion rate that applies 
          --   to an amount. This rate can either be defined 
          --   elsewhere in the document (case of a quanto swap), 
          --   or explicitly described through this component.
        , price_cleanNetPrice :: Maybe Xsd.Decimal
          -- ^ The net price excluding accrued interest. The "Dirty Price" 
          --   for bonds is put in the "netPrice" element, which includes 
          --   accrued interest. Thus netPrice - cleanNetPrice = 
          --   accruedInterest. The currency and price expression for this 
          --   field are the same as those for the (dirty) netPrice.
        , price_quotationCharacteristics :: Maybe QuotationCharacteristics
          -- ^ Allows information about how the price was quoted to be 
          --   provided.
        }
        deriving (Eq,Show)
instance SchemaType Price where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Price
            `apply` optional (parseSchemaType "commission")
            `apply` oneOf' [ ("DeterminationMethod Maybe ActualPrice Maybe ActualPrice Maybe Xsd.Decimal Maybe FxConversion", fmap OneOf3 (return (,,,,) `apply` parseSchemaType "determinationMethod"
                                                                                                                                                         `apply` optional (parseSchemaType "grossPrice")
                                                                                                                                                         `apply` optional (parseSchemaType "netPrice")
                                                                                                                                                         `apply` optional (parseSchemaType "accruedInterestPrice")
                                                                                                                                                         `apply` optional (parseSchemaType "fxConversion")))
                           , ("AmountReference", fmap TwoOf3 (parseSchemaType "amountRelativeTo"))
                           , ("Maybe ActualPrice Maybe ActualPrice Maybe Xsd.Decimal Maybe FxConversion", fmap ThreeOf3 (return (,,,) `apply` optional (parseSchemaType "grossPrice")
                                                                                                                                      `apply` optional (parseSchemaType "netPrice")
                                                                                                                                      `apply` optional (parseSchemaType "accruedInterestPrice")
                                                                                                                                      `apply` optional (parseSchemaType "fxConversion")))
                           ]
            `apply` optional (parseSchemaType "cleanNetPrice")
            `apply` optional (parseSchemaType "quotationCharacteristics")
    schemaTypeToXML s x@Price{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "commission") $ price_commission x
            , foldOneOf3  (\ (a,b,c,d,e) -> concat [ schemaTypeToXML "determinationMethod" a
                                                   , maybe [] (schemaTypeToXML "grossPrice") b
                                                   , maybe [] (schemaTypeToXML "netPrice") c
                                                   , maybe [] (schemaTypeToXML "accruedInterestPrice") d
                                                   , maybe [] (schemaTypeToXML "fxConversion") e
                                                   ])
                          (schemaTypeToXML "amountRelativeTo")
                          (\ (a,b,c,d) -> concat [ maybe [] (schemaTypeToXML "grossPrice") a
                                                 , maybe [] (schemaTypeToXML "netPrice") b
                                                 , maybe [] (schemaTypeToXML "accruedInterestPrice") c
                                                 , maybe [] (schemaTypeToXML "fxConversion") d
                                                 ])
                          $ price_choice1 x
            , maybe [] (schemaTypeToXML "cleanNetPrice") $ price_cleanNetPrice x
            , maybe [] (schemaTypeToXML "quotationCharacteristics") $ price_quotationCharacteristics x
            ]
 
-- | The units in which a price is quoted.
data PriceQuoteUnits = PriceQuoteUnits Scheme PriceQuoteUnitsAttributes deriving (Eq,Show)
data PriceQuoteUnitsAttributes = PriceQuoteUnitsAttributes
    { priceQuoteUnitsAttrib_priceQuoteUnitsScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType PriceQuoteUnits where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "priceQuoteUnitsScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ PriceQuoteUnits v (PriceQuoteUnitsAttributes a0)
    schemaTypeToXML s (PriceQuoteUnits bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "priceQuoteUnitsScheme") $ priceQuoteUnitsAttrib_priceQuoteUnitsScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension PriceQuoteUnits Scheme where
    supertype (PriceQuoteUnits s _) = s
 
data QuantityUnit = QuantityUnit Scheme QuantityUnitAttributes deriving (Eq,Show)
data QuantityUnitAttributes = QuantityUnitAttributes
    { quantUnitAttrib_quantityUnitScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType QuantityUnit where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "quantityUnitScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ QuantityUnit v (QuantityUnitAttributes a0)
    schemaTypeToXML s (QuantityUnit bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "quantityUnitScheme") $ quantUnitAttrib_quantityUnitScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension QuantityUnit Scheme where
    supertype (QuantityUnit s _) = s
 
-- | A type representing a set of characteristics that describe 
--   a quotation.
data QuotationCharacteristics = QuotationCharacteristics
        { quotChar_measureType :: Maybe AssetMeasureType
          -- ^ The type of the value that is measured. This could be an 
          --   NPV, a cash flow, a clean price, etc.
        , quotChar_quoteUnits :: Maybe PriceQuoteUnits
          -- ^ The optional units that the measure is expressed in. If not 
          --   supplied, this is assumed to be a price/value in currency 
          --   units.
        , quotChar_side :: Maybe QuotationSideEnum
          -- ^ The side (bid/mid/ask) of the measure.
        , quotChar_currency :: Maybe Currency
          -- ^ The optional currency that the measure is expressed in. If 
          --   not supplied, this is defaulted from the reportingCurrency 
          --   in the valuationScenarioDefinition.
        , quotChar_currencyType :: Maybe ReportingCurrencyType
          -- ^ The optional currency that the measure is expressed in. If 
          --   not supplied, this is defaulted from the reportingCurrency 
          --   in the valuationScenarioDefinition.
        , quotChar_timing :: Maybe QuoteTiming
          -- ^ When during a day the quote is for. Typically, if this 
          --   element is supplied, the QuoteLocation needs also to be 
          --   supplied.
        , quotChar_choice6 :: (Maybe (OneOf2 BusinessCenter ExchangeId))
          -- ^ Choice between:
          --   
          --   (1) A city or other business center.
          --   
          --   (2) The exchange (e.g. stock or futures exchange) from 
          --   which the quote is obtained.
        , quotChar_informationSource :: [InformationSource]
          -- ^ The information source where a published or displayed 
          --   market rate will be obtained, e.g. Telerate Page 3750.
        , quotChar_pricingModel :: Maybe PricingModel
          -- ^ .
        , quotChar_time :: Maybe Xsd.DateTime
          -- ^ When the quote was observed or derived.
        , quotChar_valuationDate :: Maybe Xsd.Date
          -- ^ When the quote was computed.
        , quotChar_expiryTime :: Maybe Xsd.DateTime
          -- ^ When does the quote cease to be valid.
        , quotChar_cashflowType :: Maybe CashflowType
          -- ^ For cash flows, the type of the cash flows. Examples 
          --   include: Coupon payment, Premium Fee, Settlement Fee, 
          --   Brokerage Fee, etc.
        }
        deriving (Eq,Show)
instance SchemaType QuotationCharacteristics where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return QuotationCharacteristics
            `apply` optional (parseSchemaType "measureType")
            `apply` optional (parseSchemaType "quoteUnits")
            `apply` optional (parseSchemaType "side")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "currencyType")
            `apply` optional (parseSchemaType "timing")
            `apply` optional (oneOf' [ ("BusinessCenter", fmap OneOf2 (parseSchemaType "businessCenter"))
                                     , ("ExchangeId", fmap TwoOf2 (parseSchemaType "exchangeId"))
                                     ])
            `apply` many (parseSchemaType "informationSource")
            `apply` optional (parseSchemaType "pricingModel")
            `apply` optional (parseSchemaType "time")
            `apply` optional (parseSchemaType "valuationDate")
            `apply` optional (parseSchemaType "expiryTime")
            `apply` optional (parseSchemaType "cashflowType")
    schemaTypeToXML s x@QuotationCharacteristics{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "measureType") $ quotChar_measureType x
            , maybe [] (schemaTypeToXML "quoteUnits") $ quotChar_quoteUnits x
            , maybe [] (schemaTypeToXML "side") $ quotChar_side x
            , maybe [] (schemaTypeToXML "currency") $ quotChar_currency x
            , maybe [] (schemaTypeToXML "currencyType") $ quotChar_currencyType x
            , maybe [] (schemaTypeToXML "timing") $ quotChar_timing x
            , maybe [] (foldOneOf2  (schemaTypeToXML "businessCenter")
                                    (schemaTypeToXML "exchangeId")
                                   ) $ quotChar_choice6 x
            , concatMap (schemaTypeToXML "informationSource") $ quotChar_informationSource x
            , maybe [] (schemaTypeToXML "pricingModel") $ quotChar_pricingModel x
            , maybe [] (schemaTypeToXML "time") $ quotChar_time x
            , maybe [] (schemaTypeToXML "valuationDate") $ quotChar_valuationDate x
            , maybe [] (schemaTypeToXML "expiryTime") $ quotChar_expiryTime x
            , maybe [] (schemaTypeToXML "cashflowType") $ quotChar_cashflowType x
            ]
 
-- | The type of the time of the quote.
data QuoteTiming = QuoteTiming Scheme QuoteTimingAttributes deriving (Eq,Show)
data QuoteTimingAttributes = QuoteTimingAttributes
    { quoteTimingAttrib_quoteTimingScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType QuoteTiming where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "quoteTimingScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ QuoteTiming v (QuoteTimingAttributes a0)
    schemaTypeToXML s (QuoteTiming bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "quoteTimingScheme") $ quoteTimingAttrib_quoteTimingScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension QuoteTiming Scheme where
    supertype (QuoteTiming s _) = s
 
data RateIndex = RateIndex
        { rateIndex_ID :: Maybe Xsd.ID
        , rateIndex_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , rateIndex_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , rateIndex_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , rateIndex_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , rateIndex_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , rateIndex_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , rateIndex_floatingRateIndex :: Maybe FloatingRateIndex
        , rateIndex_term :: Maybe Period
          -- ^ Specifies the term of the simple swap, e.g. 5Y.
        , rateIndex_paymentFrequency :: Maybe Period
          -- ^ Specifies the frequency at which the index pays, e.g. 6M.
        , rateIndex_dayCountFraction :: Maybe DayCountFraction
          -- ^ The day count basis for the index.
        }
        deriving (Eq,Show)
instance SchemaType RateIndex where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (RateIndex a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` optional (parseSchemaType "floatingRateIndex")
            `apply` optional (parseSchemaType "term")
            `apply` optional (parseSchemaType "paymentFrequency")
            `apply` optional (parseSchemaType "dayCountFraction")
    schemaTypeToXML s x@RateIndex{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ rateIndex_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ rateIndex_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ rateIndex_description x
            , maybe [] (schemaTypeToXML "currency") $ rateIndex_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ rateIndex_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ rateIndex_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ rateIndex_definition x
            , maybe [] (schemaTypeToXML "floatingRateIndex") $ rateIndex_floatingRateIndex x
            , maybe [] (schemaTypeToXML "term") $ rateIndex_term x
            , maybe [] (schemaTypeToXML "paymentFrequency") $ rateIndex_paymentFrequency x
            , maybe [] (schemaTypeToXML "dayCountFraction") $ rateIndex_dayCountFraction x
            ]
instance Extension RateIndex UnderlyingAsset where
    supertype v = UnderlyingAsset_RateIndex v
instance Extension RateIndex IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: RateIndex -> UnderlyingAsset)
              
instance Extension RateIndex Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: RateIndex -> UnderlyingAsset)
              
 
-- | A scheme identifying the type of currency that was used to 
--   report the value of an asset. For example, this could 
--   contain values like SettlementCurrency, QuoteCurrency, 
--   UnitCurrency, etc.
data ReportingCurrencyType = ReportingCurrencyType Scheme ReportingCurrencyTypeAttributes deriving (Eq,Show)
data ReportingCurrencyTypeAttributes = ReportingCurrencyTypeAttributes
    { reportCurrenTypeAttrib_reportingCurrencyTypeScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType ReportingCurrencyType where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "reportingCurrencyTypeScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ ReportingCurrencyType v (ReportingCurrencyTypeAttributes a0)
    schemaTypeToXML s (ReportingCurrencyType bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "reportingCurrencyTypeScheme") $ reportCurrenTypeAttrib_reportingCurrencyTypeScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension ReportingCurrencyType Scheme where
    supertype (ReportingCurrencyType s _) = s
 
data SimpleCreditDefaultSwap = SimpleCreditDefaultSwap
        { simpleCreditDefaultSwap_ID :: Maybe Xsd.ID
        , simpleCreditDefaultSwap_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , simpleCreditDefaultSwap_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , simpleCreditDefaultSwap_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , simpleCreditDefaultSwap_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , simpleCreditDefaultSwap_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , simpleCreditDefaultSwap_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , simpleCreditDefaultSwap_choice6 :: (Maybe (OneOf2 LegalEntity LegalEntityReference))
          -- ^ Choice between:
          --   
          --   (1) The entity for which this is defined.
          --   
          --   (2) An XML reference a credit entity defined elsewhere in 
          --   the document.
        , simpleCreditDefaultSwap_term :: Maybe Period
          -- ^ Specifies the term of the simple CD swap, e.g. 5Y.
        , simpleCreditDefaultSwap_paymentFrequency :: Maybe Period
          -- ^ Specifies the frequency at which the swap pays, e.g. 6M.
        }
        deriving (Eq,Show)
instance SchemaType SimpleCreditDefaultSwap where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (SimpleCreditDefaultSwap a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` optional (oneOf' [ ("LegalEntity", fmap OneOf2 (parseSchemaType "referenceEntity"))
                                     , ("LegalEntityReference", fmap TwoOf2 (parseSchemaType "creditEntityReference"))
                                     ])
            `apply` optional (parseSchemaType "term")
            `apply` optional (parseSchemaType "paymentFrequency")
    schemaTypeToXML s x@SimpleCreditDefaultSwap{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ simpleCreditDefaultSwap_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ simpleCreditDefaultSwap_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ simpleCreditDefaultSwap_description x
            , maybe [] (schemaTypeToXML "currency") $ simpleCreditDefaultSwap_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ simpleCreditDefaultSwap_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ simpleCreditDefaultSwap_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ simpleCreditDefaultSwap_definition x
            , maybe [] (foldOneOf2  (schemaTypeToXML "referenceEntity")
                                    (schemaTypeToXML "creditEntityReference")
                                   ) $ simpleCreditDefaultSwap_choice6 x
            , maybe [] (schemaTypeToXML "term") $ simpleCreditDefaultSwap_term x
            , maybe [] (schemaTypeToXML "paymentFrequency") $ simpleCreditDefaultSwap_paymentFrequency x
            ]
instance Extension SimpleCreditDefaultSwap UnderlyingAsset where
    supertype v = UnderlyingAsset_SimpleCreditDefaultSwap v
instance Extension SimpleCreditDefaultSwap IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: SimpleCreditDefaultSwap -> UnderlyingAsset)
              
instance Extension SimpleCreditDefaultSwap Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: SimpleCreditDefaultSwap -> UnderlyingAsset)
              
 
data SimpleFra = SimpleFra
        { simpleFra_ID :: Maybe Xsd.ID
        , simpleFra_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , simpleFra_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , simpleFra_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , simpleFra_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , simpleFra_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , simpleFra_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , simpleFra_startTerm :: Maybe Period
          -- ^ Specifies the start term of the simple fra, e.g. 3M.
        , simpleFra_endTerm :: Maybe Period
          -- ^ Specifies the end term of the simple fra, e.g. 9M.
        , simpleFra_dayCountFraction :: Maybe DayCountFraction
          -- ^ The day count basis for the FRA.
        }
        deriving (Eq,Show)
instance SchemaType SimpleFra where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (SimpleFra a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` optional (parseSchemaType "startTerm")
            `apply` optional (parseSchemaType "endTerm")
            `apply` optional (parseSchemaType "dayCountFraction")
    schemaTypeToXML s x@SimpleFra{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ simpleFra_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ simpleFra_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ simpleFra_description x
            , maybe [] (schemaTypeToXML "currency") $ simpleFra_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ simpleFra_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ simpleFra_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ simpleFra_definition x
            , maybe [] (schemaTypeToXML "startTerm") $ simpleFra_startTerm x
            , maybe [] (schemaTypeToXML "endTerm") $ simpleFra_endTerm x
            , maybe [] (schemaTypeToXML "dayCountFraction") $ simpleFra_dayCountFraction x
            ]
instance Extension SimpleFra UnderlyingAsset where
    supertype v = UnderlyingAsset_SimpleFra v
instance Extension SimpleFra IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: SimpleFra -> UnderlyingAsset)
              
instance Extension SimpleFra Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: SimpleFra -> UnderlyingAsset)
              
 
data SimpleIRSwap = SimpleIRSwap
        { simpleIRSwap_ID :: Maybe Xsd.ID
        , simpleIRSwap_instrumentId :: [InstrumentId]
          -- ^ Identification of the underlying asset, using public and/or 
          --   private identifiers.
        , simpleIRSwap_description :: Maybe Xsd.XsdString
          -- ^ Long name of the underlying asset.
        , simpleIRSwap_currency :: Maybe IdentifiedCurrency
          -- ^ Trading currency of the underlyer when transacted as a cash 
          --   instrument.
        , simpleIRSwap_exchangeId :: Maybe ExchangeId
          -- ^ Identification of the exchange on which this asset is 
          --   transacted for the purposes of calculating a contractural 
          --   payoff. The term "Exchange" is assumed to have the meaning 
          --   as defined in the ISDA 2002 Equity Derivatives Definitions.
        , simpleIRSwap_clearanceSystem :: Maybe ClearanceSystem
          -- ^ Identification of the clearance system associated with the 
          --   transaction exchange.
        , simpleIRSwap_definition :: Maybe ProductReference
          -- ^ An optional reference to a full FpML product that defines 
          --   the simple product in greater detail. In case of 
          --   inconsistency between the terms of the simple product and 
          --   those of the detailed definition, the values in the simple 
          --   product override those in the detailed definition.
        , simpleIRSwap_term :: Maybe Period
          -- ^ Specifies the term of the simple swap, e.g. 5Y.
        , simpleIRSwap_paymentFrequency :: Maybe Period
          -- ^ Specifies the frequency at which the swap pays, e.g. 6M.
        , simpleIRSwap_dayCountFraction :: Maybe DayCountFraction
          -- ^ The day count basis for the swap.
        }
        deriving (Eq,Show)
instance SchemaType SimpleIRSwap where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (SimpleIRSwap a0)
            `apply` many (parseSchemaType "instrumentId")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "exchangeId")
            `apply` optional (parseSchemaType "clearanceSystem")
            `apply` optional (parseSchemaType "definition")
            `apply` optional (parseSchemaType "term")
            `apply` optional (parseSchemaType "paymentFrequency")
            `apply` optional (parseSchemaType "dayCountFraction")
    schemaTypeToXML s x@SimpleIRSwap{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ simpleIRSwap_ID x
                       ]
            [ concatMap (schemaTypeToXML "instrumentId") $ simpleIRSwap_instrumentId x
            , maybe [] (schemaTypeToXML "description") $ simpleIRSwap_description x
            , maybe [] (schemaTypeToXML "currency") $ simpleIRSwap_currency x
            , maybe [] (schemaTypeToXML "exchangeId") $ simpleIRSwap_exchangeId x
            , maybe [] (schemaTypeToXML "clearanceSystem") $ simpleIRSwap_clearanceSystem x
            , maybe [] (schemaTypeToXML "definition") $ simpleIRSwap_definition x
            , maybe [] (schemaTypeToXML "term") $ simpleIRSwap_term x
            , maybe [] (schemaTypeToXML "paymentFrequency") $ simpleIRSwap_paymentFrequency x
            , maybe [] (schemaTypeToXML "dayCountFraction") $ simpleIRSwap_dayCountFraction x
            ]
instance Extension SimpleIRSwap UnderlyingAsset where
    supertype v = UnderlyingAsset_SimpleIRSwap v
instance Extension SimpleIRSwap IdentifiedAsset where
    supertype = (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: SimpleIRSwap -> UnderlyingAsset)
              
instance Extension SimpleIRSwap Asset where
    supertype = (supertype :: IdentifiedAsset -> Asset)
              . (supertype :: UnderlyingAsset -> IdentifiedAsset)
              . (supertype :: SimpleIRSwap -> UnderlyingAsset)
              
 
-- | A type describing a single underlyer
data SingleUnderlyer = SingleUnderlyer
        { singleUnderly_underlyingAsset :: Maybe Asset
          -- ^ Define the underlying asset, either a listed security or 
          --   other instrument.
        , singleUnderly_openUnits :: Maybe Xsd.Decimal
          -- ^ The number of units (index or securities) that constitute 
          --   the underlyer of the swap. In the case of a basket swap, 
          --   this element is used to reference both the number of basket 
          --   units, and the number of each asset components of the 
          --   basket when these are expressed in absolute terms.
        , singleUnderly_dividendPayout :: Maybe DividendPayout
          -- ^ Specifies the dividend payout ratio associated with an 
          --   equity underlyer. A basket swap can have different payout 
          --   ratios across the various underlying constituents. In 
          --   certain cases the actual ratio is not known on trade 
          --   inception, and only general conditions are then specified. 
          --   Users should note that FpML makes a distinction between the 
          --   derivative contract and the underlyer of the contract. It 
          --   would be better if the agreed dividend payout on a 
          --   derivative contract was modelled at the level of the 
          --   derivative contract, an approach which may be adopted in 
          --   the next major version of FpML.
        , singleUnderly_couponPayment :: Maybe PendingPayment
          -- ^ The next upcoming coupon payment.
        , singleUnderly_averageDailyTradingVolume :: Maybe AverageDailyTradingVolumeLimit
          -- ^ The average amount of individual securities traded in a day 
          --   or over a specified amount of time.
        , singleUnderly_depositoryReceipt :: Maybe Xsd.Boolean
          -- ^ A Depository Receipt is a negotiable certificate issued by 
          --   a trust company or security depository. This element is 
          --   used to represent whether a Depository Receipt is 
          --   applicable or not to the underlyer.
        }
        deriving (Eq,Show)
instance SchemaType SingleUnderlyer where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return SingleUnderlyer
            `apply` optional (elementUnderlyingAsset)
            `apply` optional (parseSchemaType "openUnits")
            `apply` optional (parseSchemaType "dividendPayout")
            `apply` optional (parseSchemaType "couponPayment")
            `apply` optional (parseSchemaType "averageDailyTradingVolume")
            `apply` optional (parseSchemaType "depositoryReceipt")
    schemaTypeToXML s x@SingleUnderlyer{} =
        toXMLElement s []
            [ maybe [] (elementToXMLUnderlyingAsset) $ singleUnderly_underlyingAsset x
            , maybe [] (schemaTypeToXML "openUnits") $ singleUnderly_openUnits x
            , maybe [] (schemaTypeToXML "dividendPayout") $ singleUnderly_dividendPayout x
            , maybe [] (schemaTypeToXML "couponPayment") $ singleUnderly_couponPayment x
            , maybe [] (schemaTypeToXML "averageDailyTradingVolume") $ singleUnderly_averageDailyTradingVolume x
            , maybe [] (schemaTypeToXML "depositoryReceipt") $ singleUnderly_depositoryReceipt x
            ]
 
-- | Defines an identifier for a specific location or region 
--   which translates into a combination of rules for 
--   calculating the UTC offset.
data TimeZone = TimeZone Scheme TimeZoneAttributes deriving (Eq,Show)
data TimeZoneAttributes = TimeZoneAttributes
    { timeZoneAttrib_timeZoneScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType TimeZone where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "timeZoneScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ TimeZone v (TimeZoneAttributes a0)
    schemaTypeToXML s (TimeZone bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "timeZoneScheme") $ timeZoneAttrib_timeZoneScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension TimeZone Scheme where
    supertype (TimeZone s _) = s
 
-- | A type describing the whole set of possible underlyers: 
--   single underlyers or multiple underlyers, each of these 
--   having either security or index components.
data Underlyer = Underlyer
        { underlyer_choice0 :: (Maybe (OneOf2 SingleUnderlyer Basket))
          -- ^ Choice between:
          --   
          --   (1) Describes the swap's underlyer when it has only one 
          --   asset component.
          --   
          --   (2) Describes the swap's underlyer when it has multiple 
          --   asset components.
        }
        deriving (Eq,Show)
instance SchemaType Underlyer where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Underlyer
            `apply` optional (oneOf' [ ("SingleUnderlyer", fmap OneOf2 (parseSchemaType "singleUnderlyer"))
                                     , ("Basket", fmap TwoOf2 (parseSchemaType "basket"))
                                     ])
    schemaTypeToXML s x@Underlyer{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "singleUnderlyer")
                                    (schemaTypeToXML "basket")
                                   ) $ underlyer_choice0 x
            ]
 
-- | Abstract base class for all underlying assets.
data UnderlyingAsset
        = UnderlyingAsset_SimpleIRSwap SimpleIRSwap
        | UnderlyingAsset_SimpleFra SimpleFra
        | UnderlyingAsset_SimpleCreditDefaultSwap SimpleCreditDefaultSwap
        | UnderlyingAsset_RateIndex RateIndex
        | UnderlyingAsset_MutualFund MutualFund
        | UnderlyingAsset_Mortgage Mortgage
        | UnderlyingAsset_Loan Loan
        | UnderlyingAsset_FxRateAsset FxRateAsset
        | UnderlyingAsset_ExchangeTraded ExchangeTraded
        | UnderlyingAsset_Deposit Deposit
        | UnderlyingAsset_Bond Bond
        
        deriving (Eq,Show)
instance SchemaType UnderlyingAsset where
    parseSchemaType s = do
        (fmap UnderlyingAsset_SimpleIRSwap $ parseSchemaType s)
        `onFail`
        (fmap UnderlyingAsset_SimpleFra $ parseSchemaType s)
        `onFail`
        (fmap UnderlyingAsset_SimpleCreditDefaultSwap $ parseSchemaType s)
        `onFail`
        (fmap UnderlyingAsset_RateIndex $ parseSchemaType s)
        `onFail`
        (fmap UnderlyingAsset_MutualFund $ parseSchemaType s)
        `onFail`
        (fmap UnderlyingAsset_Mortgage $ parseSchemaType s)
        `onFail`
        (fmap UnderlyingAsset_Loan $ parseSchemaType s)
        `onFail`
        (fmap UnderlyingAsset_FxRateAsset $ parseSchemaType s)
        `onFail`
        (fmap UnderlyingAsset_ExchangeTraded $ parseSchemaType s)
        `onFail`
        (fmap UnderlyingAsset_Deposit $ parseSchemaType s)
        `onFail`
        (fmap UnderlyingAsset_Bond $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of UnderlyingAsset,\n\
\  namely one of:\n\
\SimpleIRSwap,SimpleFra,SimpleCreditDefaultSwap,RateIndex,MutualFund,Mortgage,Loan,FxRateAsset,ExchangeTraded,Deposit,Bond"
    schemaTypeToXML _s (UnderlyingAsset_SimpleIRSwap x) = schemaTypeToXML "simpleIRSwap" x
    schemaTypeToXML _s (UnderlyingAsset_SimpleFra x) = schemaTypeToXML "simpleFra" x
    schemaTypeToXML _s (UnderlyingAsset_SimpleCreditDefaultSwap x) = schemaTypeToXML "simpleCreditDefaultSwap" x
    schemaTypeToXML _s (UnderlyingAsset_RateIndex x) = schemaTypeToXML "rateIndex" x
    schemaTypeToXML _s (UnderlyingAsset_MutualFund x) = schemaTypeToXML "mutualFund" x
    schemaTypeToXML _s (UnderlyingAsset_Mortgage x) = schemaTypeToXML "mortgage" x
    schemaTypeToXML _s (UnderlyingAsset_Loan x) = schemaTypeToXML "loan" x
    schemaTypeToXML _s (UnderlyingAsset_FxRateAsset x) = schemaTypeToXML "fxRateAsset" x
    schemaTypeToXML _s (UnderlyingAsset_ExchangeTraded x) = schemaTypeToXML "exchangeTraded" x
    schemaTypeToXML _s (UnderlyingAsset_Deposit x) = schemaTypeToXML "deposit" x
    schemaTypeToXML _s (UnderlyingAsset_Bond x) = schemaTypeToXML "bond" x
instance Extension UnderlyingAsset IdentifiedAsset where
    supertype v = IdentifiedAsset_UnderlyingAsset v
 
data UnderlyingAssetTranche = UnderlyingAssetTranche Scheme UnderlyingAssetTrancheAttributes deriving (Eq,Show)
data UnderlyingAssetTrancheAttributes = UnderlyingAssetTrancheAttributes
    { underlyAssetTrancheAttrib_loanTrancheScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType UnderlyingAssetTranche where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "loanTrancheScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ UnderlyingAssetTranche v (UnderlyingAssetTrancheAttributes a0)
    schemaTypeToXML s (UnderlyingAssetTranche bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "loanTrancheScheme") $ underlyAssetTrancheAttrib_loanTrancheScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension UnderlyingAssetTranche Scheme where
    supertype (UnderlyingAssetTranche s _) = s
 
-- | Defines the underlying asset when it is a basket.
elementBasket :: XMLParser Basket
elementBasket = parseSchemaType "basket"
elementToXMLBasket :: Basket -> [Content ()]
elementToXMLBasket = schemaTypeToXML "basket"
 
-- | Identifies the underlying asset when it is a series or a 
--   class of bonds.
elementBond :: XMLParser Bond
elementBond = parseSchemaType "bond"
elementToXMLBond :: Bond -> [Content ()]
elementToXMLBond = schemaTypeToXML "bond"
 
-- | Identifies a simple underlying asset type that is a cash 
--   payment. Used for specifying discounting factors for future 
--   cash flows in the pricing and risk model.
elementCash :: XMLParser Cash
elementCash = parseSchemaType "cash"
elementToXMLCash :: Cash -> [Content ()]
elementToXMLCash = schemaTypeToXML "cash"
 
-- | Identifies the underlying asset when it is a listed 
--   commodity.
elementCommodity :: XMLParser Commodity
elementCommodity = parseSchemaType "commodity"
elementToXMLCommodity :: Commodity -> [Content ()]
elementToXMLCommodity = schemaTypeToXML "commodity"
 
-- | Identifies the underlying asset when it is a convertible 
--   bond.
elementConvertibleBond :: XMLParser ConvertibleBond
elementConvertibleBond = parseSchemaType "convertibleBond"
elementToXMLConvertibleBond :: ConvertibleBond -> [Content ()]
elementToXMLConvertibleBond = schemaTypeToXML "convertibleBond"
 
-- | Defines the underlying asset when it is a curve instrument.
elementCurveInstrument :: XMLParser Asset
elementCurveInstrument = fmap supertype elementSimpleIrSwap
                         `onFail`
                         fmap supertype elementSimpleFra
                         `onFail`
                         fmap supertype elementSimpleCreditDefaultSwap
                         `onFail`
                         fmap supertype elementRateIndex
                         `onFail`
                         fmap supertype elementFx
                         `onFail`
                         fmap supertype elementDeposit
                         `onFail` fail "Parse failed when expecting an element in the substitution group for\n\
\    <curveInstrument>,\n\
\  namely one of:\n\
\<simpleIrSwap>, <simpleFra>, <simpleCreditDefaultSwap>, <rateIndex>, <fx>, <deposit>"
elementToXMLCurveInstrument :: Asset -> [Content ()]
elementToXMLCurveInstrument = schemaTypeToXML "curveInstrument"
 
-- | Identifies a simple underlying asset that is a term 
--   deposit.
elementDeposit :: XMLParser Deposit
elementDeposit = parseSchemaType "deposit"
elementToXMLDeposit :: Deposit -> [Content ()]
elementToXMLDeposit = schemaTypeToXML "deposit"
 
-- | Identifies the underlying asset when it is a listed equity.
elementEquity :: XMLParser EquityAsset
elementEquity = parseSchemaType "equity"
elementToXMLEquity :: EquityAsset -> [Content ()]
elementToXMLEquity = schemaTypeToXML "equity"
 
-- | Identifies the underlying asset when it is an 
--   exchange-traded fund.
elementExchangeTradedFund :: XMLParser ExchangeTradedFund
elementExchangeTradedFund = parseSchemaType "exchangeTradedFund"
elementToXMLExchangeTradedFund :: ExchangeTradedFund -> [Content ()]
elementToXMLExchangeTradedFund = schemaTypeToXML "exchangeTradedFund"
 
-- | Identifies the underlying asset when it is a listed future 
--   contract.
elementFuture :: XMLParser Future
elementFuture = parseSchemaType "future"
elementToXMLFuture :: Future -> [Content ()]
elementToXMLFuture = schemaTypeToXML "future"
 
-- | Identifies a simple underlying asset type that is an FX 
--   rate. Used for specifying FX rates in the pricing and risk 
--   model.
elementFx :: XMLParser FxRateAsset
elementFx = parseSchemaType "fx"
elementToXMLFx :: FxRateAsset -> [Content ()]
elementToXMLFx = schemaTypeToXML "fx"
 
-- | Identifies the underlying asset when it is a financial 
--   index.
elementIndex :: XMLParser Index
elementIndex = parseSchemaType "index"
elementToXMLIndex :: Index -> [Content ()]
elementToXMLIndex = schemaTypeToXML "index"
 
-- | Identifies a simple underlying asset that is a loan.
elementLoan :: XMLParser Loan
elementLoan = parseSchemaType "loan"
elementToXMLLoan :: Loan -> [Content ()]
elementToXMLLoan = schemaTypeToXML "loan"
 
-- | Identifies a mortgage backed security.
elementMortgage :: XMLParser Mortgage
elementMortgage = parseSchemaType "mortgage"
elementToXMLMortgage :: Mortgage -> [Content ()]
elementToXMLMortgage = schemaTypeToXML "mortgage"
 
-- | Identifies the class of unit issued by a fund.
elementMutualFund :: XMLParser MutualFund
elementMutualFund = parseSchemaType "mutualFund"
elementToXMLMutualFund :: MutualFund -> [Content ()]
elementToXMLMutualFund = schemaTypeToXML "mutualFund"
 
-- | Identifies a simple underlying asset that is an interest 
--   rate index. Used for specifying benchmark assets in the 
--   market environment in the pricing and risk model.
elementRateIndex :: XMLParser RateIndex
elementRateIndex = parseSchemaType "rateIndex"
elementToXMLRateIndex :: RateIndex -> [Content ()]
elementToXMLRateIndex = schemaTypeToXML "rateIndex"
 
-- | Identifies a simple underlying asset that is a credit 
--   default swap.
elementSimpleCreditDefaultSwap :: XMLParser SimpleCreditDefaultSwap
elementSimpleCreditDefaultSwap = parseSchemaType "simpleCreditDefaultSwap"
elementToXMLSimpleCreditDefaultSwap :: SimpleCreditDefaultSwap -> [Content ()]
elementToXMLSimpleCreditDefaultSwap = schemaTypeToXML "simpleCreditDefaultSwap"
 
-- | Identifies a simple underlying asset that is a forward rate 
--   agreement.
elementSimpleFra :: XMLParser SimpleFra
elementSimpleFra = parseSchemaType "simpleFra"
elementToXMLSimpleFra :: SimpleFra -> [Content ()]
elementToXMLSimpleFra = schemaTypeToXML "simpleFra"
 
-- | Identifies a simple underlying asset that is a swap.
elementSimpleIrSwap :: XMLParser SimpleIRSwap
elementSimpleIrSwap = parseSchemaType "simpleIrSwap"
elementToXMLSimpleIrSwap :: SimpleIRSwap -> [Content ()]
elementToXMLSimpleIrSwap = schemaTypeToXML "simpleIrSwap"
 
-- | Define the underlying asset, either a listed security or 
--   other instrument.
elementUnderlyingAsset :: XMLParser Asset
elementUnderlyingAsset = fmap supertype elementMutualFund
                         `onFail`
                         fmap supertype elementMortgage
                         `onFail`
                         fmap supertype elementLoan
                         `onFail`
                         fmap supertype elementIndex
                         `onFail`
                         fmap supertype elementFuture
                         `onFail`
                         fmap supertype elementExchangeTradedFund
                         `onFail`
                         fmap supertype elementEquity
                         `onFail`
                         fmap supertype elementConvertibleBond
                         `onFail`
                         fmap supertype elementCommodity
                         `onFail`
                         fmap supertype elementCash
                         `onFail`
                         fmap supertype elementBond
                         `onFail`
                         fmap supertype elementBasket
                         `onFail` fail "Parse failed when expecting an element in the substitution group for\n\
\    <underlyingAsset>,\n\
\  namely one of:\n\
\<mutualFund>, <mortgage>, <loan>, <index>, <future>, <exchangeTradedFund>, <equity>, <convertibleBond>, <commodity>, <cash>, <bond>, <basket>"
elementToXMLUnderlyingAsset :: Asset -> [Content ()]
elementToXMLUnderlyingAsset = schemaTypeToXML "underlyingAsset"