{-# 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\ \ ,\n\ \ namely one of:\n\ \, , , , , " 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\ \ ,\n\ \ namely one of:\n\ \, , , , , , , , , , , " elementToXMLUnderlyingAsset :: Asset -> [Content ()] elementToXMLUnderlyingAsset = schemaTypeToXML "underlyingAsset"