{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} module Data.FpML.V53.FX ( module Data.FpML.V53.FX , module Data.FpML.V53.Shared.Option ) where import Text.XML.HaXml.Schema.Schema (SchemaType(..),SimpleType(..),Extension(..),Restricts(..)) import Text.XML.HaXml.Schema.Schema as Schema import Text.XML.HaXml.OneOfN import qualified Text.XML.HaXml.Schema.PrimitiveTypes as Xsd import Data.FpML.V53.Shared.Option -- Some hs-boot imports are required, for fwd-declaring types. -- | Constrains the forward point tick/pip factor to 1, 0.1, -- 0.01, 0.001, etc. newtype PointValue = PointValue Xsd.Decimal deriving (Eq,Show) instance Restricts PointValue Xsd.Decimal where restricts (PointValue x) = x instance SchemaType PointValue where parseSchemaType s = do e <- element [s] commit $ interior e $ parseSimpleType schemaTypeToXML s (PointValue x) = toXMLElement s [] [toXMLText (simpleTypeText x)] instance SimpleType PointValue where acceptingParser = fmap PointValue acceptingParser -- XXX should enforce the restrictions somehow? -- The restrictions are: -- (Pattern 1) -- (Pattern 0.0*1) simpleTypeText (PointValue x) = simpleTypeText x -- | A type that is used for including the currency exchange -- rates used to cross between the traded currencies for -- non-base currency FX contracts. data CrossRate = CrossRate { crossRate_currency1 :: Maybe Currency -- ^ The first currency specified when a pair of currencies is -- to be evaluated. , crossRate_currency2 :: Maybe Currency -- ^ The second currency specified when a pair of currencies is -- to be evaluated. , crossRate_quoteBasis :: Maybe QuoteBasisEnum -- ^ The method by which the exchange rate is quoted. , crossRate_rate :: Maybe PositiveDecimal -- ^ The exchange rate used to cross between the traded -- currencies. , crossRate_spotRate :: Maybe PositiveDecimal -- ^ An optional element used for FX forwards and certain types -- of FX OTC options. For deals consumated in the FX Forwards -- Market, this represents the current market rate for a -- particular currency pair. , crossRate_forwardPoints :: Maybe Xsd.Decimal -- ^ An optional element used for deals consumated in the FX -- Forwards market. Forward points represent the interest rate -- differential between the two currencies traded and are -- quoted as a preminum or a discount. Forward points are -- added to, or subtracted from, the spot rate to create the -- rate of the forward trade. } deriving (Eq,Show) instance SchemaType CrossRate where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CrossRate `apply` optional (parseSchemaType "currency1") `apply` optional (parseSchemaType "currency2") `apply` optional (parseSchemaType "quoteBasis") `apply` optional (parseSchemaType "rate") `apply` optional (parseSchemaType "spotRate") `apply` optional (parseSchemaType "forwardPoints") schemaTypeToXML s x@CrossRate{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "currency1") $ crossRate_currency1 x , maybe [] (schemaTypeToXML "currency2") $ crossRate_currency2 x , maybe [] (schemaTypeToXML "quoteBasis") $ crossRate_quoteBasis x , maybe [] (schemaTypeToXML "rate") $ crossRate_rate x , maybe [] (schemaTypeToXML "spotRate") $ crossRate_spotRate x , maybe [] (schemaTypeToXML "forwardPoints") $ crossRate_forwardPoints x ] instance Extension CrossRate QuotedCurrencyPair where supertype (CrossRate e0 e1 e2 e3 e4 e5) = QuotedCurrencyPair e0 e1 e2 -- | Allows for an expiryDateTime cut to be described by name. data CutName = CutName Scheme CutNameAttributes deriving (Eq,Show) data CutNameAttributes = CutNameAttributes { cutNameAttrib_cutNameScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CutName where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "cutNameScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CutName v (CutNameAttributes a0) schemaTypeToXML s (CutName bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "cutNameScheme") $ cutNameAttrib_cutNameScheme at ] $ schemaTypeToXML s bt instance Extension CutName Scheme where supertype (CutName s _) = s -- | Describes the parameters for a dual currency deposit. data DualCurrencyFeature = DualCurrencyFeature { dualCurrenFeature_currency :: Maybe Currency -- ^ The currency in which the principal and interest will be -- repaid. , dualCurrenFeature_fixingDate :: Maybe Xsd.Date -- ^ The date on which the decion on delivery currency will be -- made. , dualCurrenFeature_fixingTime :: Maybe BusinessCenterTime -- ^ Time at which the option expires on the expiry date. , dualCurrenFeature_strike :: Maybe DualCurrencyStrikePrice -- ^ The strike rate at which the deposit will be converted. , dualCurrenFeature_spotRate :: Maybe Xsd.Decimal -- ^ The spot rate at the time the trade was agreed. , dualCurrenFeature_interestAtRisk :: Maybe Xsd.Boolean -- ^ Specifies whether the interest component of the redemption -- amount is subject to conversion to the Alternate currency, -- in the event that the spot rate is strictly lower than the -- strike level at the specified fixing date and time. } deriving (Eq,Show) instance SchemaType DualCurrencyFeature where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return DualCurrencyFeature `apply` optional (parseSchemaType "currency") `apply` optional (parseSchemaType "fixingDate") `apply` optional (parseSchemaType "fixingTime") `apply` optional (parseSchemaType "strike") `apply` optional (parseSchemaType "spotRate") `apply` optional (parseSchemaType "interestAtRisk") schemaTypeToXML s x@DualCurrencyFeature{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "currency") $ dualCurrenFeature_currency x , maybe [] (schemaTypeToXML "fixingDate") $ dualCurrenFeature_fixingDate x , maybe [] (schemaTypeToXML "fixingTime") $ dualCurrenFeature_fixingTime x , maybe [] (schemaTypeToXML "strike") $ dualCurrenFeature_strike x , maybe [] (schemaTypeToXML "spotRate") $ dualCurrenFeature_spotRate x , maybe [] (schemaTypeToXML "interestAtRisk") $ dualCurrenFeature_interestAtRisk x ] -- | A type that describes the rate of exchange at which the -- embedded option in a Dual Currency Deposit has been struck. data DualCurrencyStrikePrice = DualCurrencyStrikePrice { dualCurrenStrikePrice_rate :: Maybe PositiveDecimal -- ^ The rate of exchange between the two currencies of the leg -- of a deal. , dualCurrenStrikePrice_strikeQuoteBasis :: Maybe DualCurrencyStrikeQuoteBasisEnum -- ^ The method by which the strike rate is quoted, in terms of -- the deposit (principal) and alternate currencies. } deriving (Eq,Show) instance SchemaType DualCurrencyStrikePrice where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return DualCurrencyStrikePrice `apply` optional (parseSchemaType "rate") `apply` optional (parseSchemaType "strikeQuoteBasis") schemaTypeToXML s x@DualCurrencyStrikePrice{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "rate") $ dualCurrenStrikePrice_rate x , maybe [] (schemaTypeToXML "strikeQuoteBasis") $ dualCurrenStrikePrice_strikeQuoteBasis x ] -- | A type that is used for describing the exchange rate for a -- particular transaction. data ExchangeRate = ExchangeRate { exchangeRate_quotedCurrencyPair :: Maybe QuotedCurrencyPair -- ^ Defines the two currencies for an FX trade and the -- quotation relationship between the two currencies. , exchangeRate_rate :: Maybe PositiveDecimal -- ^ The rate of exchange between the two currencies of the leg -- of a deal. Must be specified with a quote basis. , exchangeRate_spotRate :: Maybe PositiveDecimal -- ^ An element used for FX forwards and certain types of FX OTC -- options. For deals consumated in the FX Forwards Market, -- this represents the current market rate for a particular -- currency pair. For barrier and digital/binary options, it -- can be useful to include the spot rate at the time the -- option was executed to make it easier to know whether the -- option needs to move "up" or "down" to be triggered. , exchangeRate_forwardPoints :: Maybe Xsd.Decimal -- ^ An optional element used for deals consumated in the FX -- Forwards market. Forward points represent the interest rate -- differential between the two currencies traded and are -- quoted as a preminum or a discount. Forward points are -- added to, or subtracted from, the spot rate to create the -- rate of the forward trade. , exchangeRate_pointValue :: Maybe PointValue -- ^ An optional element that documents the size of point (pip) -- in which a rate was quoted (or in this case, forwardPoints -- are calculated). Point (pip) size varies by currency pair: -- major currencies are all traded in points of 0.0001, with -- the exception of JPY which has a point size of 0.01. , exchangeRate_crossRate :: [CrossRate] -- ^ An optional element that allow for definition of the -- currency exchange rates used to cross between the traded -- currencies for non-base currency FX contracts. } deriving (Eq,Show) instance SchemaType ExchangeRate where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ExchangeRate `apply` optional (parseSchemaType "quotedCurrencyPair") `apply` optional (parseSchemaType "rate") `apply` optional (parseSchemaType "spotRate") `apply` optional (parseSchemaType "forwardPoints") `apply` optional (parseSchemaType "pointValue") `apply` many (parseSchemaType "crossRate") schemaTypeToXML s x@ExchangeRate{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "quotedCurrencyPair") $ exchangeRate_quotedCurrencyPair x , maybe [] (schemaTypeToXML "rate") $ exchangeRate_rate x , maybe [] (schemaTypeToXML "spotRate") $ exchangeRate_spotRate x , maybe [] (schemaTypeToXML "forwardPoints") $ exchangeRate_forwardPoints x , maybe [] (schemaTypeToXML "pointValue") $ exchangeRate_pointValue x , concatMap (schemaTypeToXML "crossRate") $ exchangeRate_crossRate x ] -- | Describes the characteristics for american exercise of FX -- products. data FxAmericanExercise = FxAmericanExercise { fxAmericExerc_ID :: Maybe Xsd.ID , fxAmericExerc_commencementDate :: Maybe AdjustableOrRelativeDate -- ^ The earliest date on which the option can be exercised. , fxAmericExerc_expiryDate :: Maybe Xsd.Date -- ^ The latest date on which the option can be exercised. , fxAmericExerc_expiryTime :: Maybe BusinessCenterTime -- ^ Time at which the option expires on the expiry date. , fxAmericExerc_cutName :: Maybe CutName -- ^ The code by which the expiry time is known in the market. , fxAmericExerc_latestValueDate :: Maybe Xsd.Date -- ^ The latest date on which both currencies traded will -- settle. , fxAmericExerc_multipleExercise :: Maybe FxMultipleExercise -- ^ Characteristics for multiple exercise. } deriving (Eq,Show) instance SchemaType FxAmericanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FxAmericanExercise a0) `apply` optional (parseSchemaType "commencementDate") `apply` optional (parseSchemaType "expiryDate") `apply` optional (parseSchemaType "expiryTime") `apply` optional (parseSchemaType "cutName") `apply` optional (parseSchemaType "latestValueDate") `apply` optional (parseSchemaType "multipleExercise") schemaTypeToXML s x@FxAmericanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxAmericExerc_ID x ] [ maybe [] (schemaTypeToXML "commencementDate") $ fxAmericExerc_commencementDate x , maybe [] (schemaTypeToXML "expiryDate") $ fxAmericExerc_expiryDate x , maybe [] (schemaTypeToXML "expiryTime") $ fxAmericExerc_expiryTime x , maybe [] (schemaTypeToXML "cutName") $ fxAmericExerc_cutName x , maybe [] (schemaTypeToXML "latestValueDate") $ fxAmericExerc_latestValueDate x , maybe [] (schemaTypeToXML "multipleExercise") $ fxAmericExerc_multipleExercise x ] instance Extension FxAmericanExercise FxDigitalAmericanExercise where supertype (FxAmericanExercise a0 e0 e1 e2 e3 e4 e5) = FxDigitalAmericanExercise a0 e0 e1 e2 e3 e4 instance Extension FxAmericanExercise Exercise where supertype = (supertype :: FxDigitalAmericanExercise -> Exercise) . (supertype :: FxAmericanExercise -> FxDigitalAmericanExercise) -- | Descibes the averaging period properties for an asian -- option. data FxAsianFeature = FxAsianFeature { fxAsianFeature_primaryRateSource :: Maybe InformationSource -- ^ The primary source for where the rate observation will -- occur. Will typically be either a page or a reference bank -- published rate. , fxAsianFeature_secondaryRateSource :: Maybe InformationSource -- ^ An alternative, or secondary, source for where the rate -- observation will occur. Will typically be either a page or -- a reference bank published rate. , fxAsianFeature_fixingTime :: Maybe BusinessCenterTime -- ^ The time at which the spot currency exchange rate will be -- observed. It is specified as a time in a business day -- calendar location, e.g. 11:00am London time. , fxAsianFeature_observationSchedule :: Maybe FxAverageRateObservationSchedule -- ^ Parametric schedule of rate observations. , fxAsianFeature_rateObservation :: [FxAverageRateObservation] -- ^ One or more specific rate observation dates. , fxAsianFeature_rateObservationQuoteBasis :: Maybe StrikeQuoteBasisEnum -- ^ The method by which observed rate values are quoted, in -- terms of the option put/call currencies. In the absence of -- this element, rate observations are assumed to be quoted as -- per the option strikeQuoteBasis. , fxAsianFeature_payoutFormula :: Maybe Xsd.XsdString -- ^ The description of the mathematical computation for how the -- payout is computed. , fxAsianFeature_precision :: Maybe Xsd.NonNegativeInteger -- ^ Specifies the rounding precision in terms of a number of -- decimal places. Note how a percentage rate rounding of 5 -- decimal places is expressed as a rounding precision of 7 in -- the FpML document since the percentage is expressed as a -- decimal, e.g. 9.876543% (or 0.09876543) being rounded to -- the nearest 5 decimal places is 9.87654% (or 0.0987654). } deriving (Eq,Show) instance SchemaType FxAsianFeature where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxAsianFeature `apply` optional (parseSchemaType "primaryRateSource") `apply` optional (parseSchemaType "secondaryRateSource") `apply` optional (parseSchemaType "fixingTime") `apply` optional (parseSchemaType "observationSchedule") `apply` many (parseSchemaType "rateObservation") `apply` optional (parseSchemaType "rateObservationQuoteBasis") `apply` optional (parseSchemaType "payoutFormula") `apply` optional (parseSchemaType "precision") schemaTypeToXML s x@FxAsianFeature{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "primaryRateSource") $ fxAsianFeature_primaryRateSource x , maybe [] (schemaTypeToXML "secondaryRateSource") $ fxAsianFeature_secondaryRateSource x , maybe [] (schemaTypeToXML "fixingTime") $ fxAsianFeature_fixingTime x , maybe [] (schemaTypeToXML "observationSchedule") $ fxAsianFeature_observationSchedule x , concatMap (schemaTypeToXML "rateObservation") $ fxAsianFeature_rateObservation x , maybe [] (schemaTypeToXML "rateObservationQuoteBasis") $ fxAsianFeature_rateObservationQuoteBasis x , maybe [] (schemaTypeToXML "payoutFormula") $ fxAsianFeature_payoutFormula x , maybe [] (schemaTypeToXML "precision") $ fxAsianFeature_precision x ] -- | A type that, for average rate options, is used to describe -- each specific observation date, as opposed to a parametric -- frequency of rate observations. data FxAverageRateObservation = FxAverageRateObservation { fxAverageRateObserv_date :: Maybe Xsd.Date -- ^ A specific date for which an observation against a -- particular rate will be made and will be used for -- subsequent computations. , fxAverageRateObserv_averageRateWeightingFactor :: Maybe Xsd.Decimal -- ^ An optional factor that can be used for weighting certain -- observation dates. Typically, firms will weight each date -- with a factor of 1 if there are standard, unweighted -- adjustments. , fxAverageRateObserv_rate :: Maybe NonNegativeDecimal -- ^ The observed rate of exchange between the two option -- currencies. In the absence of rateObservationQuoteBasis, -- the rate is assumed to be quoted as per option -- strike/strikeQuoteBasis. } deriving (Eq,Show) instance SchemaType FxAverageRateObservation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxAverageRateObservation `apply` optional (parseSchemaType "date") `apply` optional (parseSchemaType "averageRateWeightingFactor") `apply` optional (parseSchemaType "rate") schemaTypeToXML s x@FxAverageRateObservation{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "date") $ fxAverageRateObserv_date x , maybe [] (schemaTypeToXML "averageRateWeightingFactor") $ fxAverageRateObserv_averageRateWeightingFactor x , maybe [] (schemaTypeToXML "rate") $ fxAverageRateObserv_rate x ] -- | A type that describes average rate options rate -- observations. This is used to describe a parametric -- frequency of rate observations against a particular rate. -- Typical frequencies might include daily, every Friday, etc. data FxAverageRateObservationSchedule = FxAverageRateObservationSchedule { fxAverageRateObservSched_startDate :: Maybe Xsd.Date -- ^ The start of the period over which observations are made to -- determine whether a trigger has occurred. , fxAverageRateObservSched_endDate :: Maybe Xsd.Date -- ^ The end of the period over which observations are made to -- determine whether a trigger event has occurred. , fxAverageRateObservSched_calculationPeriodFrequency :: Maybe CalculationPeriodFrequency -- ^ The frequency at which calculation period end dates occur -- with the regular part of the calculation period schedule -- and their roll date convention. } deriving (Eq,Show) instance SchemaType FxAverageRateObservationSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxAverageRateObservationSchedule `apply` optional (parseSchemaType "startDate") `apply` optional (parseSchemaType "endDate") `apply` optional (parseSchemaType "calculationPeriodFrequency") schemaTypeToXML s x@FxAverageRateObservationSchedule{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "startDate") $ fxAverageRateObservSched_startDate x , maybe [] (schemaTypeToXML "endDate") $ fxAverageRateObservSched_endDate x , maybe [] (schemaTypeToXML "calculationPeriodFrequency") $ fxAverageRateObservSched_calculationPeriodFrequency x ] -- | Describes the properties of an Fx barrier. data FxBarrierFeature = FxBarrierFeature { fxBarrierFeature_barrierType :: Maybe FxBarrierTypeEnum -- ^ This specifies whether the option becomes effective -- ("knock-in") or is annulled ("knock-out") when the -- respective trigger event occurs. , fxBarrierFeature_quotedCurrencyPair :: Maybe QuotedCurrencyPair -- ^ Defines the two currencies for an FX trade and the -- quotation relationship between the two currencies. , fxBarrierFeature_triggerRate :: Maybe PositiveDecimal -- ^ The market rate is observed relative to the trigger rate, -- and if it is found to be on the predefined side of (above -- or below) the trigger rate, a trigger event is deemed to -- have occurred. , fxBarrierFeature_informationSource :: [InformationSource] -- ^ The information source where a published or displayed -- market rate will be obtained, e.g. Telerate Page 3750. , fxBarrierFeature_observationStartDate :: Maybe Xsd.Date -- ^ The start of the period over which observations are made to -- determine whether a trigger has occurred. , fxBarrierFeature_observationEndDate :: Maybe Xsd.Date -- ^ The end of the period over which observations are made to -- determine whether a trigger event has occurred. } deriving (Eq,Show) instance SchemaType FxBarrierFeature where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxBarrierFeature `apply` optional (parseSchemaType "barrierType") `apply` optional (parseSchemaType "quotedCurrencyPair") `apply` optional (parseSchemaType "triggerRate") `apply` many (parseSchemaType "informationSource") `apply` optional (parseSchemaType "observationStartDate") `apply` optional (parseSchemaType "observationEndDate") schemaTypeToXML s x@FxBarrierFeature{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "barrierType") $ fxBarrierFeature_barrierType x , maybe [] (schemaTypeToXML "quotedCurrencyPair") $ fxBarrierFeature_quotedCurrencyPair x , maybe [] (schemaTypeToXML "triggerRate") $ fxBarrierFeature_triggerRate x , concatMap (schemaTypeToXML "informationSource") $ fxBarrierFeature_informationSource x , maybe [] (schemaTypeToXML "observationStartDate") $ fxBarrierFeature_observationStartDate x , maybe [] (schemaTypeToXML "observationEndDate") $ fxBarrierFeature_observationEndDate x ] -- | Describes a precise boundary value. data FxBoundary = FxBoundary { fxBoundary_choice0 :: (Maybe (OneOf2 Inclusive Exclusive)) -- ^ Choice between: -- -- (1) inclusive -- -- (2) exclusive } deriving (Eq,Show) instance SchemaType FxBoundary where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxBoundary `apply` optional (oneOf' [ ("Inclusive", fmap OneOf2 elementInclusive) , ("Exclusive", fmap TwoOf2 elementExclusive) ]) schemaTypeToXML s x@FxBoundary{} = toXMLElement s [] [ maybe [] (foldOneOf2 (elementToXMLInclusive) (elementToXMLExclusive) ) $ fxBoundary_choice0 x ] data Inclusive = Inclusive deriving (Eq,Show) data Exclusive = Exclusive deriving (Eq,Show) elementInclusive = do element ["inclusive"]; return Inclusive elementExclusive = do element ["exclusive"]; return Exclusive elementToXMLInclusive Inclusive = toXMLElement "inclusive" [] [] elementToXMLExclusive Exclusive = toXMLElement "exclusive" [] [] -- | Descrines the characteristics for American exercise in FX -- digital options. data FxDigitalAmericanExercise = FxDigitalAmericanExercise { fxDigitalAmericExerc_ID :: Maybe Xsd.ID , fxDigitalAmericExerc_commencementDate :: Maybe AdjustableOrRelativeDate -- ^ The earliest date on which the option can be exercised. , fxDigitalAmericExerc_expiryDate :: Maybe Xsd.Date -- ^ The latest date on which the option can be exercised. , fxDigitalAmericExerc_expiryTime :: Maybe BusinessCenterTime -- ^ Time at which the option expires on the expiry date. , fxDigitalAmericExerc_cutName :: Maybe CutName -- ^ The code by which the expiry time is known in the market. , fxDigitalAmericExerc_latestValueDate :: Maybe Xsd.Date -- ^ The latest date on which both currencies traded will -- settle. } deriving (Eq,Show) instance SchemaType FxDigitalAmericanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FxDigitalAmericanExercise a0) `apply` optional (parseSchemaType "commencementDate") `apply` optional (parseSchemaType "expiryDate") `apply` optional (parseSchemaType "expiryTime") `apply` optional (parseSchemaType "cutName") `apply` optional (parseSchemaType "latestValueDate") schemaTypeToXML s x@FxDigitalAmericanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxDigitalAmericExerc_ID x ] [ maybe [] (schemaTypeToXML "commencementDate") $ fxDigitalAmericExerc_commencementDate x , maybe [] (schemaTypeToXML "expiryDate") $ fxDigitalAmericExerc_expiryDate x , maybe [] (schemaTypeToXML "expiryTime") $ fxDigitalAmericExerc_expiryTime x , maybe [] (schemaTypeToXML "cutName") $ fxDigitalAmericExerc_cutName x , maybe [] (schemaTypeToXML "latestValueDate") $ fxDigitalAmericExerc_latestValueDate x ] instance Extension FxDigitalAmericanExercise Exercise where supertype v = Exercise_FxDigitalAmericanExercise v -- | Describes an option having a triggerable fixed payout. data FxDigitalOption = FxDigitalOption { fxDigitalOption_ID :: Maybe Xsd.ID , fxDigitalOption_primaryAssetClass :: Maybe AssetClass -- ^ A classification of the most important risk class of the -- trade. FpML defines a simple asset class categorization -- using a coding scheme. , fxDigitalOption_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , fxDigitalOption_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , fxDigitalOption_productId :: [ProductId] -- ^ A product reference identifier. The product ID is an -- identifier that describes the key economic characteristics -- of the trade type, with the exception of concepts such as -- size (notional, quantity, number of units) and price (fixed -- rate, strike, etc.) that are negotiated for each -- transaction. It can be used to hold identifiers such as the -- "UPI" (universal product identifier) required by certain -- regulatory reporting rules. It can also be used to hold -- identifiers of benchmark products or product temnplates -- used by certain trading systems or facilities. FpML does -- not define the domain values associated with this element. -- Note that the domain values for this element are not -- strictly an enumerated list. , fxDigitalOption_buyerPartyReference :: Maybe PartyReference -- ^ A reference to the party that buys this instrument, ie. -- pays for this instrument and receives the rights defined by -- it. See 2000 ISDA definitions Article 11.1 (b). In the case -- of FRAs this the fixed rate payer. , fxDigitalOption_buyerAccountReference :: Maybe AccountReference -- ^ A reference to the account that buys this instrument. , fxDigitalOption_sellerPartyReference :: Maybe PartyReference -- ^ A reference to the party that sells ("writes") this -- instrument, i.e. that grants the rights defined by this -- instrument and in return receives a payment for it. See -- 2000 ISDA definitions Article 11.1 (a). In the case of FRAs -- this is the floating rate payer. , fxDigitalOption_sellerAccountReference :: Maybe AccountReference -- ^ A reference to the account that sells this instrument. , fxDigitalOption_effectiveDate :: Maybe AdjustableOrRelativeDate -- ^ Effective date for a forward starting derivative. If this -- element is not present, the effective date is the trade -- date. , fxDigitalOption_tenorPeriod :: Maybe Period -- ^ A tenor expressed as a period type and multiplier (e.g. 1D, -- 1Y, etc.) , fxDigitalOption_choice10 :: (Maybe (OneOf2 ((Maybe (FxDigitalAmericanExercise)),[FxTouch]) ((Maybe (FxEuropeanExercise)),[FxTrigger]))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * The parameters for defining the exercise period for -- an American style option. -- -- * Defines one or more conditions underwhich the -- option will payout if exercisable. -- -- (2) Sequence of: -- -- * The parameters for defining the exercise period for -- an European style option. -- -- * Defines one or more conditions underwhich the -- option will payout if exercisable. , fxDigitalOption_exerciseProcedure :: Maybe ExerciseProcedure -- ^ A set of parameters defining procedures associated with the -- exercise. , fxDigitalOption_payout :: Maybe FxOptionPayout -- ^ The amount of currency which becomes payable if and when a -- trigger event occurs. , fxDigitalOption_premium :: [FxOptionPremium] -- ^ Premium amount or premium installment amount for an option. } deriving (Eq,Show) instance SchemaType FxDigitalOption where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FxDigitalOption a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` optional (parseSchemaType "buyerPartyReference") `apply` optional (parseSchemaType "buyerAccountReference") `apply` optional (parseSchemaType "sellerPartyReference") `apply` optional (parseSchemaType "sellerAccountReference") `apply` optional (parseSchemaType "effectiveDate") `apply` optional (parseSchemaType "tenorPeriod") `apply` optional (oneOf' [ ("Maybe FxDigitalAmericanExercise [FxTouch]", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "americanExercise") `apply` many (parseSchemaType "touch"))) , ("Maybe FxEuropeanExercise [FxTrigger]", fmap TwoOf2 (return (,) `apply` optional (parseSchemaType "europeanExercise") `apply` many (parseSchemaType "trigger"))) ]) `apply` optional (parseSchemaType "exerciseProcedure") `apply` optional (parseSchemaType "payout") `apply` many (parseSchemaType "premium") schemaTypeToXML s x@FxDigitalOption{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxDigitalOption_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ fxDigitalOption_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ fxDigitalOption_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ fxDigitalOption_productType x , concatMap (schemaTypeToXML "productId") $ fxDigitalOption_productId x , maybe [] (schemaTypeToXML "buyerPartyReference") $ fxDigitalOption_buyerPartyReference x , maybe [] (schemaTypeToXML "buyerAccountReference") $ fxDigitalOption_buyerAccountReference x , maybe [] (schemaTypeToXML "sellerPartyReference") $ fxDigitalOption_sellerPartyReference x , maybe [] (schemaTypeToXML "sellerAccountReference") $ fxDigitalOption_sellerAccountReference x , maybe [] (schemaTypeToXML "effectiveDate") $ fxDigitalOption_effectiveDate x , maybe [] (schemaTypeToXML "tenorPeriod") $ fxDigitalOption_tenorPeriod x , maybe [] (foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "americanExercise") a , concatMap (schemaTypeToXML "touch") b ]) (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "europeanExercise") a , concatMap (schemaTypeToXML "trigger") b ]) ) $ fxDigitalOption_choice10 x , maybe [] (schemaTypeToXML "exerciseProcedure") $ fxDigitalOption_exerciseProcedure x , maybe [] (schemaTypeToXML "payout") $ fxDigitalOption_payout x , concatMap (schemaTypeToXML "premium") $ fxDigitalOption_premium x ] instance Extension FxDigitalOption Option where supertype v = Option_FxDigitalOption v instance Extension FxDigitalOption Product where supertype = (supertype :: Option -> Product) . (supertype :: FxDigitalOption -> Option) -- | Describes the characteristics for European exercise of FX -- products. data FxEuropeanExercise = FxEuropeanExercise { fxEuropExerc_ID :: Maybe Xsd.ID , fxEuropExerc_expiryDate :: Maybe Xsd.Date -- ^ Represents a standard expiry date as defined for an FX OTC -- option. , fxEuropExerc_expiryTime :: Maybe BusinessCenterTime -- ^ Time at which the option expires on the expiry date. , fxEuropExerc_cutName :: Maybe CutName -- ^ The code by which the expiry time is known in the market. , fxEuropExerc_valueDate :: Maybe Xsd.Date -- ^ The date on which both currencies traded will settle. } deriving (Eq,Show) instance SchemaType FxEuropeanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FxEuropeanExercise a0) `apply` optional (parseSchemaType "expiryDate") `apply` optional (parseSchemaType "expiryTime") `apply` optional (parseSchemaType "cutName") `apply` optional (parseSchemaType "valueDate") schemaTypeToXML s x@FxEuropeanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxEuropExerc_ID x ] [ maybe [] (schemaTypeToXML "expiryDate") $ fxEuropExerc_expiryDate x , maybe [] (schemaTypeToXML "expiryTime") $ fxEuropExerc_expiryTime x , maybe [] (schemaTypeToXML "cutName") $ fxEuropExerc_cutName x , maybe [] (schemaTypeToXML "valueDate") $ fxEuropExerc_valueDate x ] instance Extension FxEuropeanExercise Exercise where supertype v = Exercise_FxEuropeanExercise v -- | Describes the limits on the size of notional when multiple -- exercise is allowed. data FxMultipleExercise = FxMultipleExercise { fxMultiExerc_minimumNotionalAmount :: Maybe NonNegativeMoney -- ^ The minimum amount of notional that can be exercised. , fxMultiExerc_maximumNotionalAmount :: Maybe NonNegativeMoney -- ^ The maximum amount of notiional that can be exercised. } deriving (Eq,Show) instance SchemaType FxMultipleExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxMultipleExercise `apply` optional (parseSchemaType "minimumNotionalAmount") `apply` optional (parseSchemaType "maximumNotionalAmount") schemaTypeToXML s x@FxMultipleExercise{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "minimumNotionalAmount") $ fxMultiExerc_minimumNotionalAmount x , maybe [] (schemaTypeToXML "maximumNotionalAmount") $ fxMultiExerc_maximumNotionalAmount x ] -- | Describes an FX option with optional asian and barrier -- features. data FxOption = FxOption { fxOption_ID :: Maybe Xsd.ID , fxOption_primaryAssetClass :: Maybe AssetClass -- ^ A classification of the most important risk class of the -- trade. FpML defines a simple asset class categorization -- using a coding scheme. , fxOption_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , fxOption_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , fxOption_productId :: [ProductId] -- ^ A product reference identifier. The product ID is an -- identifier that describes the key economic characteristics -- of the trade type, with the exception of concepts such as -- size (notional, quantity, number of units) and price (fixed -- rate, strike, etc.) that are negotiated for each -- transaction. It can be used to hold identifiers such as the -- "UPI" (universal product identifier) required by certain -- regulatory reporting rules. It can also be used to hold -- identifiers of benchmark products or product temnplates -- used by certain trading systems or facilities. FpML does -- not define the domain values associated with this element. -- Note that the domain values for this element are not -- strictly an enumerated list. , fxOption_buyerPartyReference :: Maybe PartyReference -- ^ A reference to the party that buys this instrument, ie. -- pays for this instrument and receives the rights defined by -- it. See 2000 ISDA definitions Article 11.1 (b). In the case -- of FRAs this the fixed rate payer. , fxOption_buyerAccountReference :: Maybe AccountReference -- ^ A reference to the account that buys this instrument. , fxOption_sellerPartyReference :: Maybe PartyReference -- ^ A reference to the party that sells ("writes") this -- instrument, i.e. that grants the rights defined by this -- instrument and in return receives a payment for it. See -- 2000 ISDA definitions Article 11.1 (a). In the case of FRAs -- this is the floating rate payer. , fxOption_sellerAccountReference :: Maybe AccountReference -- ^ A reference to the account that sells this instrument. , fxOption_effectiveDate :: Maybe AdjustableOrRelativeDate -- ^ Effective date for a forward starting derivative. If this -- element is not present, the effective date is the trade -- date. , fxOption_tenorPeriod :: Maybe Period -- ^ A tenor expressed as a period type and multiplier (e.g. 1D, -- 1Y, etc.) , fxOption_choice10 :: OneOf2 FxAmericanExercise FxEuropeanExercise -- ^ Choice between: -- -- (1) The parameters for defining the exercise period for an -- American style option. -- -- (2) The parameters for defining the exercise period for an -- European style option. , fxOption_exerciseProcedure :: Maybe ExerciseProcedure -- ^ A set of parameters defining procedures associated with the -- exercise. , fxOption_putCurrencyAmount :: NonNegativeMoney -- ^ The currency amount that the option gives the right to -- sell. , fxOption_callCurrencyAmount :: NonNegativeMoney -- ^ The currency amount that the option gives the right to buy. , fxOption_soldAs :: Maybe PutCallEnum -- ^ Indicates how the product was original sold as a Put or a -- Call. , fxOption_strike :: FxStrikePrice -- ^ Defines the option strike price. , fxOption_spotRate :: Maybe PositiveDecimal -- ^ An optional element used for FX forwards and certain types -- of FX OTC options. For deals consumated in the FX Forwards -- Market, this represents the current market rate for a -- particular currency pair. For barrier and digital/binary -- options, it can be useful to include the spot rate at the -- time the option was executed to make it easier to know -- whether the option needs to move "up" or "down" to be -- triggered. , fxOption_features :: Maybe FxOptionFeatures -- ^ Describes additional features within the option. , fxOption_premium :: FxOptionPremium -- ^ Premium amount or premium installment amount for an option. , fxOption_cashSettlement :: Maybe FxCashSettlement -- ^ Specifies the currency and fixing details for cash -- settlement. This optional element is produced only where it -- has been specified at execution time that the option wlll -- be settled into a single cash payment - for example, in the -- case of a non-deliverable option (although note that an Fx -- option may be contractually cash settled, without -- necessarily being non-deliverable). } deriving (Eq,Show) instance SchemaType FxOption where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FxOption a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` optional (parseSchemaType "buyerPartyReference") `apply` optional (parseSchemaType "buyerAccountReference") `apply` optional (parseSchemaType "sellerPartyReference") `apply` optional (parseSchemaType "sellerAccountReference") `apply` optional (parseSchemaType "effectiveDate") `apply` optional (parseSchemaType "tenorPeriod") `apply` oneOf' [ ("FxAmericanExercise", fmap OneOf2 (parseSchemaType "americanExercise")) , ("FxEuropeanExercise", fmap TwoOf2 (parseSchemaType "europeanExercise")) ] `apply` optional (parseSchemaType "exerciseProcedure") `apply` parseSchemaType "putCurrencyAmount" `apply` parseSchemaType "callCurrencyAmount" `apply` optional (parseSchemaType "soldAs") `apply` parseSchemaType "strike" `apply` optional (parseSchemaType "spotRate") `apply` optional (parseSchemaType "features") `apply` parseSchemaType "premium" `apply` optional (parseSchemaType "cashSettlement") schemaTypeToXML s x@FxOption{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxOption_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ fxOption_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ fxOption_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ fxOption_productType x , concatMap (schemaTypeToXML "productId") $ fxOption_productId x , maybe [] (schemaTypeToXML "buyerPartyReference") $ fxOption_buyerPartyReference x , maybe [] (schemaTypeToXML "buyerAccountReference") $ fxOption_buyerAccountReference x , maybe [] (schemaTypeToXML "sellerPartyReference") $ fxOption_sellerPartyReference x , maybe [] (schemaTypeToXML "sellerAccountReference") $ fxOption_sellerAccountReference x , maybe [] (schemaTypeToXML "effectiveDate") $ fxOption_effectiveDate x , maybe [] (schemaTypeToXML "tenorPeriod") $ fxOption_tenorPeriod x , foldOneOf2 (schemaTypeToXML "americanExercise") (schemaTypeToXML "europeanExercise") $ fxOption_choice10 x , maybe [] (schemaTypeToXML "exerciseProcedure") $ fxOption_exerciseProcedure x , schemaTypeToXML "putCurrencyAmount" $ fxOption_putCurrencyAmount x , schemaTypeToXML "callCurrencyAmount" $ fxOption_callCurrencyAmount x , maybe [] (schemaTypeToXML "soldAs") $ fxOption_soldAs x , schemaTypeToXML "strike" $ fxOption_strike x , maybe [] (schemaTypeToXML "spotRate") $ fxOption_spotRate x , maybe [] (schemaTypeToXML "features") $ fxOption_features x , schemaTypeToXML "premium" $ fxOption_premium x , maybe [] (schemaTypeToXML "cashSettlement") $ fxOption_cashSettlement x ] instance Extension FxOption Option where supertype v = Option_FxOption v instance Extension FxOption Product where supertype = (supertype :: Option -> Product) . (supertype :: FxOption -> Option) -- | A type describing the features that may be present in an FX -- option. data FxOptionFeatures = FxOptionFeatures { fxOptionFeatur_choice0 :: OneOf2 (FxAsianFeature,[FxBarrierFeature]) [FxBarrierFeature] -- ^ Choice between: -- -- (1) Sequence of: -- -- * asian -- -- * barrier -- -- (2) barrier } deriving (Eq,Show) instance SchemaType FxOptionFeatures where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxOptionFeatures `apply` oneOf' [ ("FxAsianFeature [FxBarrierFeature]", fmap OneOf2 (return (,) `apply` parseSchemaType "asian" `apply` many (parseSchemaType "barrier"))) , ("[FxBarrierFeature]", fmap TwoOf2 (many1 (parseSchemaType "barrier"))) ] schemaTypeToXML s x@FxOptionFeatures{} = toXMLElement s [] [ foldOneOf2 (\ (a,b) -> concat [ schemaTypeToXML "asian" a , concatMap (schemaTypeToXML "barrier") b ]) (concatMap (schemaTypeToXML "barrier")) $ fxOptionFeatur_choice0 x ] -- | A type that contains full details of a predefined fixed -- payout which may occur (or not) in a Barrier Option or -- Digital Option when a trigger event occurs (or not). data FxOptionPayout = FxOptionPayout { fxOptionPayout_ID :: Maybe Xsd.ID , fxOptionPayout_currency :: Currency -- ^ The currency in which an amount is denominated. , fxOptionPayout_amount :: NonNegativeDecimal -- ^ The non negative monetary quantity in currency units. , fxOptionPayout_payoutStyle :: Maybe PayoutEnum -- ^ The trigger event and payout may be asynchonous. A payout -- may become due on the trigger event, or the payout may (by -- agreeement at initiation) be deferred (for example) to the -- maturity date. , fxOptionPayout_settlementInformation :: Maybe SettlementInformation -- ^ The information required to settle a currency payment that -- results from a trade. } deriving (Eq,Show) instance SchemaType FxOptionPayout where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FxOptionPayout a0) `apply` parseSchemaType "currency" `apply` parseSchemaType "amount" `apply` optional (parseSchemaType "payoutStyle") `apply` optional (parseSchemaType "settlementInformation") schemaTypeToXML s x@FxOptionPayout{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxOptionPayout_ID x ] [ schemaTypeToXML "currency" $ fxOptionPayout_currency x , schemaTypeToXML "amount" $ fxOptionPayout_amount x , maybe [] (schemaTypeToXML "payoutStyle") $ fxOptionPayout_payoutStyle x , maybe [] (schemaTypeToXML "settlementInformation") $ fxOptionPayout_settlementInformation x ] instance Extension FxOptionPayout NonNegativeMoney where supertype (FxOptionPayout a0 e0 e1 e2 e3) = NonNegativeMoney a0 e0 e1 instance Extension FxOptionPayout MoneyBase where supertype = (supertype :: NonNegativeMoney -> MoneyBase) . (supertype :: FxOptionPayout -> NonNegativeMoney) -- | A type that specifies the premium exchanged for a single -- option trade or option strategy. data FxOptionPremium = FxOptionPremium { fxOptionPremium_ID :: Maybe Xsd.ID , fxOptionPremium_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , fxOptionPremium_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , fxOptionPremium_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , fxOptionPremium_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , fxOptionPremium_paymentDate :: Maybe AdjustableOrRelativeDate -- ^ The payment date, which can be expressed as either an -- adjustable or relative date. , fxOptionPremium_paymentAmount :: Maybe NonNegativeMoney -- ^ Non negative payment amount. , fxOptionPremium_settlementInformation :: Maybe SettlementInformation -- ^ The information required to settle a currency payment that -- results from a trade. , fxOptionPremium_quote :: Maybe PremiumQuote -- ^ This is the option premium as quoted. It is expected to be -- consistent with the premiumAmount and is for information -- only. } deriving (Eq,Show) instance SchemaType FxOptionPremium where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FxOptionPremium a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "paymentDate") `apply` optional (parseSchemaType "paymentAmount") `apply` optional (parseSchemaType "settlementInformation") `apply` optional (parseSchemaType "quote") schemaTypeToXML s x@FxOptionPremium{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxOptionPremium_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ fxOptionPremium_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ fxOptionPremium_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ fxOptionPremium_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ fxOptionPremium_receiverAccountReference x , maybe [] (schemaTypeToXML "paymentDate") $ fxOptionPremium_paymentDate x , maybe [] (schemaTypeToXML "paymentAmount") $ fxOptionPremium_paymentAmount x , maybe [] (schemaTypeToXML "settlementInformation") $ fxOptionPremium_settlementInformation x , maybe [] (schemaTypeToXML "quote") $ fxOptionPremium_quote x ] instance Extension FxOptionPremium NonNegativePayment where supertype (FxOptionPremium a0 e0 e1 e2 e3 e4 e5 e6 e7) = NonNegativePayment a0 e0 e1 e2 e3 e4 e5 instance Extension FxOptionPremium PaymentBaseExtended where supertype = (supertype :: NonNegativePayment -> PaymentBaseExtended) . (supertype :: FxOptionPremium -> NonNegativePayment) instance Extension FxOptionPremium PaymentBase where supertype = (supertype :: PaymentBaseExtended -> PaymentBase) . (supertype :: NonNegativePayment -> PaymentBaseExtended) . (supertype :: FxOptionPremium -> NonNegativePayment) -- | A type defining either a spot or forward FX transactions. data FxSingleLeg = FxSingleLeg { fxSingleLeg_ID :: Maybe Xsd.ID , fxSingleLeg_primaryAssetClass :: Maybe AssetClass -- ^ A classification of the most important risk class of the -- trade. FpML defines a simple asset class categorization -- using a coding scheme. , fxSingleLeg_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , fxSingleLeg_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , fxSingleLeg_productId :: [ProductId] -- ^ A product reference identifier. The product ID is an -- identifier that describes the key economic characteristics -- of the trade type, with the exception of concepts such as -- size (notional, quantity, number of units) and price (fixed -- rate, strike, etc.) that are negotiated for each -- transaction. It can be used to hold identifiers such as the -- "UPI" (universal product identifier) required by certain -- regulatory reporting rules. It can also be used to hold -- identifiers of benchmark products or product temnplates -- used by certain trading systems or facilities. FpML does -- not define the domain values associated with this element. -- Note that the domain values for this element are not -- strictly an enumerated list. , fxSingleLeg_exchangedCurrency1 :: Payment -- ^ This is the first of the two currency flows that define a -- single leg of a standard foreign exchange transaction. , fxSingleLeg_exchangedCurrency2 :: Payment -- ^ This is the second of the two currency flows that define a -- single leg of a standard foreign exchange transaction. , fxSingleLeg_dealtCurrency :: Maybe DealtCurrencyEnum -- ^ Indicates which currency was dealt. , fxSingleLeg_choice7 :: (Maybe (OneOf2 FxTenorPeriodEnum Period)) -- ^ Choice between: -- -- (1) A tenor expressed with a standard business term (i.e. -- Spot, TomorrowNext, etc.) -- -- (2) A tenor expressed as a period type and multiplier (e.g. -- 1D, 1Y, etc.) , fxSingleLeg_choice8 :: OneOf2 Xsd.Date (Xsd.Date,Xsd.Date) -- ^ Choice between: -- -- (1) The date on which both currencies traded will settle. -- -- (2) Sequence of: -- -- * The date on which the currency1 amount will be -- settled. To be used in a split value date scenario. -- -- * The date on which the currency2 amount will be -- settled. To be used in a split value date scenario. , fxSingleLeg_exchangeRate :: ExchangeRate -- ^ The rate of exchange between the two currencies. , fxSingleLeg_nonDeliverableSettlement :: Maybe FxCashSettlement -- ^ Used to describe a particular type of FX forward -- transaction that is settled in a single currency (for -- example, a non-deliverable forward). } deriving (Eq,Show) instance SchemaType FxSingleLeg where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FxSingleLeg a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` parseSchemaType "exchangedCurrency1" `apply` parseSchemaType "exchangedCurrency2" `apply` optional (parseSchemaType "dealtCurrency") `apply` optional (oneOf' [ ("FxTenorPeriodEnum", fmap OneOf2 (parseSchemaType "tenorName")) , ("Period", fmap TwoOf2 (parseSchemaType "tenorPeriod")) ]) `apply` oneOf' [ ("Xsd.Date", fmap OneOf2 (parseSchemaType "valueDate")) , ("Xsd.Date Xsd.Date", fmap TwoOf2 (return (,) `apply` parseSchemaType "currency1ValueDate" `apply` parseSchemaType "currency2ValueDate")) ] `apply` parseSchemaType "exchangeRate" `apply` optional (parseSchemaType "nonDeliverableSettlement") schemaTypeToXML s x@FxSingleLeg{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxSingleLeg_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ fxSingleLeg_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ fxSingleLeg_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ fxSingleLeg_productType x , concatMap (schemaTypeToXML "productId") $ fxSingleLeg_productId x , schemaTypeToXML "exchangedCurrency1" $ fxSingleLeg_exchangedCurrency1 x , schemaTypeToXML "exchangedCurrency2" $ fxSingleLeg_exchangedCurrency2 x , maybe [] (schemaTypeToXML "dealtCurrency") $ fxSingleLeg_dealtCurrency x , maybe [] (foldOneOf2 (schemaTypeToXML "tenorName") (schemaTypeToXML "tenorPeriod") ) $ fxSingleLeg_choice7 x , foldOneOf2 (schemaTypeToXML "valueDate") (\ (a,b) -> concat [ schemaTypeToXML "currency1ValueDate" a , schemaTypeToXML "currency2ValueDate" b ]) $ fxSingleLeg_choice8 x , schemaTypeToXML "exchangeRate" $ fxSingleLeg_exchangeRate x , maybe [] (schemaTypeToXML "nonDeliverableSettlement") $ fxSingleLeg_nonDeliverableSettlement x ] instance Extension FxSingleLeg Product where supertype v = Product_FxSingleLeg v -- | A type that describes the rate of exchange at which the -- option has been struck. data FxStrikePrice = FxStrikePrice { fxStrikePrice_rate :: Maybe PositiveDecimal -- ^ The rate of exchange between the two currencies of the leg -- of a deal. , fxStrikePrice_strikeQuoteBasis :: Maybe StrikeQuoteBasisEnum -- ^ The method by which the strike rate is quoted. } deriving (Eq,Show) instance SchemaType FxStrikePrice where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxStrikePrice `apply` optional (parseSchemaType "rate") `apply` optional (parseSchemaType "strikeQuoteBasis") schemaTypeToXML s x@FxStrikePrice{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "rate") $ fxStrikePrice_rate x , maybe [] (schemaTypeToXML "strikeQuoteBasis") $ fxStrikePrice_strikeQuoteBasis x ] -- | A type defining either a spot/forward or forward/forward FX -- swap transaction. data FxSwap = FxSwap { fxSwap_ID :: Maybe Xsd.ID , fxSwap_primaryAssetClass :: Maybe AssetClass -- ^ A classification of the most important risk class of the -- trade. FpML defines a simple asset class categorization -- using a coding scheme. , fxSwap_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , fxSwap_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , fxSwap_productId :: [ProductId] -- ^ A product reference identifier. The product ID is an -- identifier that describes the key economic characteristics -- of the trade type, with the exception of concepts such as -- size (notional, quantity, number of units) and price (fixed -- rate, strike, etc.) that are negotiated for each -- transaction. It can be used to hold identifiers such as the -- "UPI" (universal product identifier) required by certain -- regulatory reporting rules. It can also be used to hold -- identifiers of benchmark products or product temnplates -- used by certain trading systems or facilities. FpML does -- not define the domain values associated with this element. -- Note that the domain values for this element are not -- strictly an enumerated list. , fxSwap_nearLeg :: FxSwapLeg -- ^ The FX transaction with the earliest value date. , fxSwap_farLeg :: FxSwapLeg -- ^ The FX transaction with the latest value date. } deriving (Eq,Show) instance SchemaType FxSwap where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FxSwap a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` parseSchemaType "nearLeg" `apply` parseSchemaType "farLeg" schemaTypeToXML s x@FxSwap{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxSwap_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ fxSwap_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ fxSwap_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ fxSwap_productType x , concatMap (schemaTypeToXML "productId") $ fxSwap_productId x , schemaTypeToXML "nearLeg" $ fxSwap_nearLeg x , schemaTypeToXML "farLeg" $ fxSwap_farLeg x ] instance Extension FxSwap Product where supertype v = Product_FxSwap v -- | A type defining the details for one of the transactions in -- an FX swap. data FxSwapLeg = FxSwapLeg { fxSwapLeg_ID :: Maybe Xsd.ID , fxSwapLeg_exchangedCurrency1 :: Payment -- ^ This is the first of the two currency flows that define a -- single leg of a standard foreign exchange transaction. , fxSwapLeg_exchangedCurrency2 :: Payment -- ^ This is the second of the two currency flows that define a -- single leg of a standard foreign exchange transaction. , fxSwapLeg_dealtCurrency :: Maybe DealtCurrencyEnum -- ^ Indicates which currency was dealt. , fxSwapLeg_choice3 :: (Maybe (OneOf2 FxTenorPeriodEnum Period)) -- ^ Choice between: -- -- (1) A tenor expressed with a standard business term (i.e. -- Spot, TomorrowNext, etc.) -- -- (2) A tenor expressed as a period type and multiplier (e.g. -- 1D, 1Y, etc.) , fxSwapLeg_choice4 :: OneOf2 Xsd.Date (Xsd.Date,Xsd.Date) -- ^ Choice between: -- -- (1) The date on which both currencies traded will settle. -- -- (2) Sequence of: -- -- * The date on which the currency1 amount will be -- settled. To be used in a split value date scenario. -- -- * The date on which the currency2 amount will be -- settled. To be used in a split value date scenario. , fxSwapLeg_exchangeRate :: ExchangeRate -- ^ The rate of exchange between the two currencies. , fxSwapLeg_nonDeliverableSettlement :: Maybe FxCashSettlement -- ^ Used to describe a particular type of FX forward -- transaction that is settled in a single currency (for -- example, a non-deliverable forward). } deriving (Eq,Show) instance SchemaType FxSwapLeg where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FxSwapLeg a0) `apply` parseSchemaType "exchangedCurrency1" `apply` parseSchemaType "exchangedCurrency2" `apply` optional (parseSchemaType "dealtCurrency") `apply` optional (oneOf' [ ("FxTenorPeriodEnum", fmap OneOf2 (parseSchemaType "tenorName")) , ("Period", fmap TwoOf2 (parseSchemaType "tenorPeriod")) ]) `apply` oneOf' [ ("Xsd.Date", fmap OneOf2 (parseSchemaType "valueDate")) , ("Xsd.Date Xsd.Date", fmap TwoOf2 (return (,) `apply` parseSchemaType "currency1ValueDate" `apply` parseSchemaType "currency2ValueDate")) ] `apply` parseSchemaType "exchangeRate" `apply` optional (parseSchemaType "nonDeliverableSettlement") schemaTypeToXML s x@FxSwapLeg{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxSwapLeg_ID x ] [ schemaTypeToXML "exchangedCurrency1" $ fxSwapLeg_exchangedCurrency1 x , schemaTypeToXML "exchangedCurrency2" $ fxSwapLeg_exchangedCurrency2 x , maybe [] (schemaTypeToXML "dealtCurrency") $ fxSwapLeg_dealtCurrency x , maybe [] (foldOneOf2 (schemaTypeToXML "tenorName") (schemaTypeToXML "tenorPeriod") ) $ fxSwapLeg_choice3 x , foldOneOf2 (schemaTypeToXML "valueDate") (\ (a,b) -> concat [ schemaTypeToXML "currency1ValueDate" a , schemaTypeToXML "currency2ValueDate" b ]) $ fxSwapLeg_choice4 x , schemaTypeToXML "exchangeRate" $ fxSwapLeg_exchangeRate x , maybe [] (schemaTypeToXML "nonDeliverableSettlement") $ fxSwapLeg_nonDeliverableSettlement x ] instance Extension FxSwapLeg Leg where supertype v = Leg_FxSwapLeg v -- | Describes an FX touch condition. data FxTouch = FxTouch { fxTouch_touchCondition :: Maybe TouchConditionEnum -- ^ The binary condition that applies to an American-style -- trigger. There can only be two domain values for this -- element: "touch" or "no touch". , fxTouch_quotedCurrencyPair :: Maybe QuotedCurrencyPair -- ^ Defines the two currencies for an FX trade and the -- quotation relationship between the two currencies. , fxTouch_triggerRate :: Maybe PositiveDecimal -- ^ The market rate is observed relative to the trigger rate, -- and if it is found to be on the predefined side of (above -- or below) the trigger rate, a trigger event is deemed to -- have occurred. , fxTouch_spotRate :: Maybe PositiveDecimal -- ^ An optional element used for FX forwards and certain types -- of FX OTC options. For deals consumated in the FX Forwards -- Market, this represents the current market rate for a -- particular currency pair. For barrier and digital/binary -- options, it can be useful to include the spot rate at the -- time the option was executed to make it easier to know -- whether the option needs to move "up" or "down" to be -- triggered. , fxTouch_informationSource :: [InformationSource] -- ^ The information source where a published or displayed -- market rate will be obtained, e.g. Telerate Page 3750. , fxTouch_observationStartDate :: Maybe Xsd.Date -- ^ The start of the period over which observations are made to -- determine whether a trigger has occurred. , fxTouch_observationEndDate :: Maybe Xsd.Date -- ^ The end of the period over which observations are made to -- determine whether a trigger event has occurred. } deriving (Eq,Show) instance SchemaType FxTouch where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxTouch `apply` optional (parseSchemaType "touchCondition") `apply` optional (parseSchemaType "quotedCurrencyPair") `apply` optional (parseSchemaType "triggerRate") `apply` optional (parseSchemaType "spotRate") `apply` many (parseSchemaType "informationSource") `apply` optional (parseSchemaType "observationStartDate") `apply` optional (parseSchemaType "observationEndDate") schemaTypeToXML s x@FxTouch{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "touchCondition") $ fxTouch_touchCondition x , maybe [] (schemaTypeToXML "quotedCurrencyPair") $ fxTouch_quotedCurrencyPair x , maybe [] (schemaTypeToXML "triggerRate") $ fxTouch_triggerRate x , maybe [] (schemaTypeToXML "spotRate") $ fxTouch_spotRate x , concatMap (schemaTypeToXML "informationSource") $ fxTouch_informationSource x , maybe [] (schemaTypeToXML "observationStartDate") $ fxTouch_observationStartDate x , maybe [] (schemaTypeToXML "observationEndDate") $ fxTouch_observationEndDate x ] -- | Describes an FX trigger condition. data FxTrigger = FxTrigger { fxTrigger_triggerCondition :: Maybe TriggerConditionEnum -- ^ The condition that applies to a European-style trigger. It -- determines where the rate at expiry date and time at must -- be relative to the triggerRate for the option to be -- exercisable. The allowed values are "Above" and "Below". , fxTrigger_quotedCurrencyPair :: Maybe QuotedCurrencyPair -- ^ Defines the two currencies for an FX trade and the -- quotation relationship between the two currencies. , fxTrigger_triggerRate :: Maybe PositiveDecimal -- ^ The market rate is observed relative to the trigger rate, -- and if it is found to be on the predefined side of (above -- or below) the trigger rate, a trigger event is deemed to -- have occurred. , fxTrigger_spotRate :: Maybe PositiveDecimal -- ^ An optional element used for FX forwards and certain types -- of FX OTC options. For deals consumated in the FX Forwards -- Market, this represents the current market rate for a -- particular currency pair. For barrier and digital/binary -- options, it can be useful to include the spot rate at the -- time the option was executed to make it easier to know -- whether the option needs to move "up" or "down" to be -- triggered. , fxTrigger_informationSource :: [InformationSource] -- ^ The information source where a published or displayed -- market rate will be obtained, e.g. Telerate Page 3750. } deriving (Eq,Show) instance SchemaType FxTrigger where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxTrigger `apply` optional (parseSchemaType "triggerCondition") `apply` optional (parseSchemaType "quotedCurrencyPair") `apply` optional (parseSchemaType "triggerRate") `apply` optional (parseSchemaType "spotRate") `apply` many (parseSchemaType "informationSource") schemaTypeToXML s x@FxTrigger{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "triggerCondition") $ fxTrigger_triggerCondition x , maybe [] (schemaTypeToXML "quotedCurrencyPair") $ fxTrigger_quotedCurrencyPair x , maybe [] (schemaTypeToXML "triggerRate") $ fxTrigger_triggerRate x , maybe [] (schemaTypeToXML "spotRate") $ fxTrigger_spotRate x , concatMap (schemaTypeToXML "informationSource") $ fxTrigger_informationSource x ] data LowerBound = LowerBound { lowerBound_choice0 :: (Maybe (OneOf2 PositiveDecimal PositiveDecimal)) -- ^ Choice between: -- -- (1) minimumInclusive -- -- (2) minimumExclusive } deriving (Eq,Show) instance SchemaType LowerBound where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return LowerBound `apply` optional (oneOf' [ ("PositiveDecimal", fmap OneOf2 (parseSchemaType "minimumInclusive")) , ("PositiveDecimal", fmap TwoOf2 (parseSchemaType "minimumExclusive")) ]) schemaTypeToXML s x@LowerBound{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "minimumInclusive") (schemaTypeToXML "minimumExclusive") ) $ lowerBound_choice0 x ] -- | References a Money instance. data MoneyReference = MoneyReference { moneyRef_href :: Maybe Xsd.IDREF } deriving (Eq,Show) instance SchemaType MoneyReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "href" e pos commit $ interior e $ return (MoneyReference a0) schemaTypeToXML s x@MoneyReference{} = toXMLElement s [ maybe [] (toXMLAttribute "href") $ moneyRef_href x ] [] instance Extension MoneyReference Reference where supertype v = Reference_MoneyReference v data ObservationSchedule = ObservationSchedule { observSched_startDate :: Maybe Xsd.Date -- ^ The start of the period over which observations are made to -- determine whether a condition has occurred. , observSched_endDate :: Maybe Xsd.Date -- ^ The end of the period over which observations are made to -- determine whether a condition has occurred. , observSched_observationPeriodFrequency :: Maybe Frequency -- ^ Describes how often observations are made. } deriving (Eq,Show) instance SchemaType ObservationSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ObservationSchedule `apply` optional (parseSchemaType "startDate") `apply` optional (parseSchemaType "endDate") `apply` optional (parseSchemaType "observationPeriodFrequency") schemaTypeToXML s x@ObservationSchedule{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "startDate") $ observSched_startDate x , maybe [] (schemaTypeToXML "endDate") $ observSched_endDate x , maybe [] (schemaTypeToXML "observationPeriodFrequency") $ observSched_observationPeriodFrequency x ] -- | A type that describes the option premium as quoted. data PremiumQuote = PremiumQuote { premiumQuote_value :: Maybe Xsd.Decimal -- ^ The value of the premium quote. In general this will be -- either a percentage or an explicit amount. , premiumQuote_quoteBasis :: Maybe PremiumQuoteBasisEnum -- ^ The method by which the option premium was quoted. } deriving (Eq,Show) instance SchemaType PremiumQuote where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PremiumQuote `apply` optional (parseSchemaType "value") `apply` optional (parseSchemaType "quoteBasis") schemaTypeToXML s x@PremiumQuote{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "value") $ premiumQuote_value x , maybe [] (schemaTypeToXML "quoteBasis") $ premiumQuote_quoteBasis x ] -- | A class defining the content model for a term deposit -- product. data TermDeposit = TermDeposit { termDeposit_ID :: Maybe Xsd.ID , termDeposit_primaryAssetClass :: Maybe AssetClass -- ^ A classification of the most important risk class of the -- trade. FpML defines a simple asset class categorization -- using a coding scheme. , termDeposit_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , termDeposit_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , termDeposit_productId :: [ProductId] -- ^ A product reference identifier. The product ID is an -- identifier that describes the key economic characteristics -- of the trade type, with the exception of concepts such as -- size (notional, quantity, number of units) and price (fixed -- rate, strike, etc.) that are negotiated for each -- transaction. It can be used to hold identifiers such as the -- "UPI" (universal product identifier) required by certain -- regulatory reporting rules. It can also be used to hold -- identifiers of benchmark products or product temnplates -- used by certain trading systems or facilities. FpML does -- not define the domain values associated with this element. -- Note that the domain values for this element are not -- strictly an enumerated list. , termDeposit_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , termDeposit_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , termDeposit_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , termDeposit_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , termDeposit_startDate :: Maybe Xsd.Date -- ^ The start date of the calculation period. , termDeposit_maturityDate :: Maybe Xsd.Date -- ^ The end date of the calculation period. This date should -- already be adjusted for any applicable business day -- convention. , termDeposit_choice10 :: (Maybe (OneOf2 FxTenorPeriodEnum Period)) -- ^ Choice between: -- -- (1) A tenor expressed with a standard business term (i.e. -- Spot, TomorrowNext, etc.) -- -- (2) A tenor expressed as a period type and multiplier (e.g. -- 1D, 1Y, etc.) , termDeposit_principal :: Maybe PositiveMoney -- ^ The principal amount of the trade. , termDeposit_fixedRate :: Maybe PositiveDecimal -- ^ The calculation period fixed rate. A per annum rate, -- expressed as a decimal. A fixed rate of 5% would be -- represented as 0.05. , termDeposit_dayCountFraction :: Maybe DayCountFraction -- ^ The day count fraction. , termDeposit_features :: Maybe TermDepositFeatures -- ^ An optional container that hold additional features of the -- deposit (e.g. Dual Currency feature). , termDeposit_interest :: Maybe Money -- ^ The total interest of at maturity of the trade. , termDeposit_payment :: [Payment] -- ^ A known payment between two parties. } deriving (Eq,Show) instance SchemaType TermDeposit where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (TermDeposit a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "startDate") `apply` optional (parseSchemaType "maturityDate") `apply` optional (oneOf' [ ("FxTenorPeriodEnum", fmap OneOf2 (parseSchemaType "tenorName")) , ("Period", fmap TwoOf2 (parseSchemaType "tenorPeriod")) ]) `apply` optional (parseSchemaType "principal") `apply` optional (parseSchemaType "fixedRate") `apply` optional (parseSchemaType "dayCountFraction") `apply` optional (parseSchemaType "features") `apply` optional (parseSchemaType "interest") `apply` many (parseSchemaType "payment") schemaTypeToXML s x@TermDeposit{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ termDeposit_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ termDeposit_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ termDeposit_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ termDeposit_productType x , concatMap (schemaTypeToXML "productId") $ termDeposit_productId x , maybe [] (schemaTypeToXML "payerPartyReference") $ termDeposit_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ termDeposit_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ termDeposit_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ termDeposit_receiverAccountReference x , maybe [] (schemaTypeToXML "startDate") $ termDeposit_startDate x , maybe [] (schemaTypeToXML "maturityDate") $ termDeposit_maturityDate x , maybe [] (foldOneOf2 (schemaTypeToXML "tenorName") (schemaTypeToXML "tenorPeriod") ) $ termDeposit_choice10 x , maybe [] (schemaTypeToXML "principal") $ termDeposit_principal x , maybe [] (schemaTypeToXML "fixedRate") $ termDeposit_fixedRate x , maybe [] (schemaTypeToXML "dayCountFraction") $ termDeposit_dayCountFraction x , maybe [] (schemaTypeToXML "features") $ termDeposit_features x , maybe [] (schemaTypeToXML "interest") $ termDeposit_interest x , concatMap (schemaTypeToXML "payment") $ termDeposit_payment x ] instance Extension TermDeposit Product where supertype v = Product_TermDeposit v data TermDepositFeatures = TermDepositFeatures { termDepositFeatur_dualCurrency :: Maybe DualCurrencyFeature } deriving (Eq,Show) instance SchemaType TermDepositFeatures where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TermDepositFeatures `apply` optional (parseSchemaType "dualCurrency") schemaTypeToXML s x@TermDepositFeatures{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "dualCurrency") $ termDepositFeatur_dualCurrency x ] data UpperBound = UpperBound { upperBound_choice0 :: (Maybe (OneOf2 PositiveDecimal PositiveDecimal)) -- ^ Choice between: -- -- (1) maximumInclusive -- -- (2) maximumExclusive } deriving (Eq,Show) instance SchemaType UpperBound where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return UpperBound `apply` optional (oneOf' [ ("PositiveDecimal", fmap OneOf2 (parseSchemaType "maximumInclusive")) , ("PositiveDecimal", fmap TwoOf2 (parseSchemaType "maximumExclusive")) ]) schemaTypeToXML s x@UpperBound{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "maximumInclusive") (schemaTypeToXML "maximumExclusive") ) $ upperBound_choice0 x ] -- | A simple FX spot or forward transaction definition. elementFxSingleLeg :: XMLParser FxSingleLeg elementFxSingleLeg = parseSchemaType "fxSingleLeg" elementToXMLFxSingleLeg :: FxSingleLeg -> [Content ()] elementToXMLFxSingleLeg = schemaTypeToXML "fxSingleLeg" -- | An FX Swap transaction definition. elementFxSwap :: XMLParser FxSwap elementFxSwap = parseSchemaType "fxSwap" elementToXMLFxSwap :: FxSwap -> [Content ()] elementToXMLFxSwap = schemaTypeToXML "fxSwap" -- | An FX option transaction definition. elementFxOption :: XMLParser FxOption elementFxOption = parseSchemaType "fxOption" elementToXMLFxOption :: FxOption -> [Content ()] elementToXMLFxOption = schemaTypeToXML "fxOption" -- | An FX digital option transaction definition. elementFxDigitalOption :: XMLParser FxDigitalOption elementFxDigitalOption = parseSchemaType "fxDigitalOption" elementToXMLFxDigitalOption :: FxDigitalOption -> [Content ()] elementToXMLFxDigitalOption = schemaTypeToXML "fxDigitalOption" -- | A term deposit product definition. elementTermDeposit :: XMLParser TermDeposit elementTermDeposit = parseSchemaType "termDeposit" elementToXMLTermDeposit :: TermDeposit -> [Content ()] elementToXMLTermDeposit = schemaTypeToXML "termDeposit"