{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} module Data.FpML.V53.Valuation ( module Data.FpML.V53.Valuation , module Data.FpML.V53.Enum , module Data.FpML.V53.Riskdef , module Data.FpML.V53.Msg , module Data.FpML.V53.Events.Business ) 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.Enum import Data.FpML.V53.Riskdef import Data.FpML.V53.Msg import Data.FpML.V53.Events.Business -- Some hs-boot imports are required, for fwd-declaring types. -- | A structure that holds a set of measures about an asset, -- including possibly their sensitivities. data AssetValuation = AssetValuation { assetVal_ID :: Maybe Xsd.ID , assetVal_definitionRef :: Maybe Xsd.IDREF -- ^ An optional reference to the scenario that this valuation -- applies to. , assetVal_objectReference :: Maybe AnyAssetReference -- ^ A reference to the asset or pricing structure that this -- values. , assetVal_valuationScenarioReference :: Maybe ValuationScenarioReference -- ^ A reference to the valuation scenario used to calculate -- this valuation. If the Valuation occurs within a -- ValuationSet, this value is optional and is defaulted from -- the ValuationSet. If this value occurs in both places, the -- lower level value (i.e. the one here) overrides that in the -- higher (i.e. ValuationSet). , assetVal_quote :: [Quotation] -- ^ One or more numerical measures relating to the asset, -- possibly together with sensitivities of that measure to -- pricing inputs. , assetVal_fxRate :: [FxRate] -- ^ Indicates the rate of a currency conversion that may have -- been used to compute valuations. } deriving (Eq,Show) instance SchemaType AssetValuation where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos a1 <- optional $ getAttribute "definitionRef" e pos commit $ interior e $ return (AssetValuation a0 a1) `apply` optional (parseSchemaType "objectReference") `apply` optional (parseSchemaType "valuationScenarioReference") `apply` many (parseSchemaType "quote") `apply` many (parseSchemaType "fxRate") schemaTypeToXML s x@AssetValuation{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ assetVal_ID x , maybe [] (toXMLAttribute "definitionRef") $ assetVal_definitionRef x ] [ maybe [] (schemaTypeToXML "objectReference") $ assetVal_objectReference x , maybe [] (schemaTypeToXML "valuationScenarioReference") $ assetVal_valuationScenarioReference x , concatMap (schemaTypeToXML "quote") $ assetVal_quote x , concatMap (schemaTypeToXML "fxRate") $ assetVal_fxRate x ] instance Extension AssetValuation Valuation where supertype (AssetValuation a0 a1 e0 e1 e2 e3) = Valuation a0 a1 e0 e1 -- | A valuation scenario that is derived from another valuation -- scenario. data DerivedValuationScenario = DerivedValuationScenario { derivedValScenar_ID :: Maybe Xsd.ID , derivedValScenar_name :: Maybe Xsd.XsdString -- ^ The (optional) name for this valuation scenario, used for -- understandability. For example "EOD Valuations". , derivedValScenar_baseValuationScenario :: Maybe ValuationScenarioReference -- ^ An (optional) reference to a valuation scenario from which -- this one is derived. , derivedValScenar_valuationDate :: Maybe IdentifiedDate -- ^ The (optional) date for which the assets are valued. If not -- present, the valuation date will be that of the base -- valuation scenario. , derivedValScenar_marketReference :: Maybe MarketReference -- ^ A reference to the market environment used to price the -- asset. If not present, the market will be that of the base -- valuation scenario. , derivedValScenar_shift :: [PricingParameterShift] -- ^ A collection of shifts to be applied to market inputs prior -- to computation of the derivative. } deriving (Eq,Show) instance SchemaType DerivedValuationScenario where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (DerivedValuationScenario a0) `apply` optional (parseSchemaType "name") `apply` optional (parseSchemaType "baseValuationScenario") `apply` optional (parseSchemaType "valuationDate") `apply` optional (parseSchemaType "marketReference") `apply` many (parseSchemaType "shift") schemaTypeToXML s x@DerivedValuationScenario{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ derivedValScenar_ID x ] [ maybe [] (schemaTypeToXML "name") $ derivedValScenar_name x , maybe [] (schemaTypeToXML "baseValuationScenario") $ derivedValScenar_baseValuationScenario x , maybe [] (schemaTypeToXML "valuationDate") $ derivedValScenar_valuationDate x , maybe [] (schemaTypeToXML "marketReference") $ derivedValScenar_marketReference x , concatMap (schemaTypeToXML "shift") $ derivedValScenar_shift x ] -- | Some kind of numerical measure about an asset, eg. its NPV, -- together with characteristics of that measure, together -- with optional sensitivities. data Quotation = Quotation { quotation_value :: Maybe Xsd.Decimal -- ^ The value of the the quotation. , quotation_measureType :: Maybe AssetMeasureType -- ^ The type of the value that is measured. This could be an -- NPV, a cash flow, a clean price, etc. , quotation_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. , quotation_side :: Maybe QuotationSideEnum -- ^ The side (bid/mid/ask) of the measure. , quotation_currency :: Maybe Currency -- ^ The optional currency that the measure is expressed in. If -- not supplied, this is defaulted from the reportingCurrency -- in the valuationScenarioDefinition. , quotation_currencyType :: Maybe ReportingCurrencyType -- ^ The optional currency that the measure is expressed in. If -- not supplied, this is defaulted from the reportingCurrency -- in the valuationScenarioDefinition. , quotation_timing :: Maybe QuoteTiming -- ^ When during a day the quote is for. Typically, if this -- element is supplied, the QuoteLocation needs also to be -- supplied. , quotation_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. , quotation_informationSource :: [InformationSource] -- ^ The information source where a published or displayed -- market rate will be obtained, e.g. Telerate Page 3750. , quotation_pricingModel :: Maybe PricingModel -- ^ . , quotation_time :: Maybe Xsd.DateTime -- ^ When the quote was observed or derived. , quotation_valuationDate :: Maybe Xsd.Date -- ^ When the quote was computed. , quotation_expiryTime :: Maybe Xsd.DateTime -- ^ When does the quote cease to be valid. , quotation_cashflowType :: Maybe CashflowType -- ^ For cash flows, the type of the cash flows. Examples -- include: Coupon payment, Premium Fee, Settlement Fee, -- Brokerage Fee, etc. , quotation_sensitivitySet :: [SensitivitySet] -- ^ Zero or more sets of sensitivities of this measure to -- various input parameters. } deriving (Eq,Show) instance SchemaType Quotation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Quotation `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") `apply` many (parseSchemaType "sensitivitySet") schemaTypeToXML s x@Quotation{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "value") $ quotation_value x , maybe [] (schemaTypeToXML "measureType") $ quotation_measureType x , maybe [] (schemaTypeToXML "quoteUnits") $ quotation_quoteUnits x , maybe [] (schemaTypeToXML "side") $ quotation_side x , maybe [] (schemaTypeToXML "currency") $ quotation_currency x , maybe [] (schemaTypeToXML "currencyType") $ quotation_currencyType x , maybe [] (schemaTypeToXML "timing") $ quotation_timing x , maybe [] (foldOneOf2 (schemaTypeToXML "businessCenter") (schemaTypeToXML "exchangeId") ) $ quotation_choice7 x , concatMap (schemaTypeToXML "informationSource") $ quotation_informationSource x , maybe [] (schemaTypeToXML "pricingModel") $ quotation_pricingModel x , maybe [] (schemaTypeToXML "time") $ quotation_time x , maybe [] (schemaTypeToXML "valuationDate") $ quotation_valuationDate x , maybe [] (schemaTypeToXML "expiryTime") $ quotation_expiryTime x , maybe [] (schemaTypeToXML "cashflowType") $ quotation_cashflowType x , concatMap (schemaTypeToXML "sensitivitySet") $ quotation_sensitivitySet x ] -- | The roles of the parties in reporting information such as -- positions. data ReportingRoles = ReportingRoles { reportRoles_baseParty :: Maybe PartyReference -- ^ A reference to the party from whose perspective the -- position is valued, ie. the owner or holder of the -- position. , reportRoles_baseAccount :: Maybe AccountReference -- ^ A reference to the party from whose perspective the -- position is valued, ie. the owner or holder of the -- position. , reportRoles_activityProvider :: Maybe PartyReference -- ^ A reference to the party responsible for reporting trading -- activities. , reportRoles_positionProvider :: Maybe PartyReference -- ^ A reference to the party responsible for reporting the -- position itself and its constituents. , reportRoles_valuationProvider :: Maybe PartyReference -- ^ A reference to the party responsible for calculating and -- reporting the valuations of the positions. } deriving (Eq,Show) instance SchemaType ReportingRoles where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ReportingRoles `apply` optional (parseSchemaType "baseParty") `apply` optional (parseSchemaType "baseAccount") `apply` optional (parseSchemaType "activityProvider") `apply` optional (parseSchemaType "positionProvider") `apply` optional (parseSchemaType "valuationProvider") schemaTypeToXML s x@ReportingRoles{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "baseParty") $ reportRoles_baseParty x , maybe [] (schemaTypeToXML "baseAccount") $ reportRoles_baseAccount x , maybe [] (schemaTypeToXML "activityProvider") $ reportRoles_activityProvider x , maybe [] (schemaTypeToXML "positionProvider") $ reportRoles_positionProvider x , maybe [] (schemaTypeToXML "valuationProvider") $ reportRoles_valuationProvider x ] -- | An servicing date relevant for a trade structure, such as a -- payment or a reset. data ScheduledDate = ScheduledDate { schedDate_choice0 :: (Maybe (OneOf1 ((Maybe (Xsd.Date)),(Maybe (Xsd.Date))))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * unadjustedDate -- -- * adjustedDate , schedDate_type :: Maybe ScheduledDateType -- ^ The type of the date, e.g. next or previous payment. , schedDate_assetReference :: Maybe AnyAssetReference -- ^ A reference to the leg (or other product component) for -- which these dates occur. , schedDate_choice3 :: (Maybe (OneOf2 AssetValuation ValuationReference)) -- ^ Choice between: -- -- (1) The value that is associated with the scheduled date. -- -- (2) A reference to the value associated with this scheduled -- date. } deriving (Eq,Show) instance SchemaType ScheduledDate where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ScheduledDate `apply` optional (oneOf' [ ("Maybe Xsd.Date Maybe Xsd.Date", fmap OneOf1 (return (,) `apply` optional (parseSchemaType "unadjustedDate") `apply` optional (parseSchemaType "adjustedDate"))) ]) `apply` optional (parseSchemaType "type") `apply` optional (parseSchemaType "assetReference") `apply` optional (oneOf' [ ("AssetValuation", fmap OneOf2 (parseSchemaType "associatedValue")) , ("ValuationReference", fmap TwoOf2 (parseSchemaType "associatedValueReference")) ]) schemaTypeToXML s x@ScheduledDate{} = toXMLElement s [] [ maybe [] (foldOneOf1 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "unadjustedDate") a , maybe [] (schemaTypeToXML "adjustedDate") b ]) ) $ schedDate_choice0 x , maybe [] (schemaTypeToXML "type") $ schedDate_type x , maybe [] (schemaTypeToXML "assetReference") $ schedDate_assetReference x , maybe [] (foldOneOf2 (schemaTypeToXML "associatedValue") (schemaTypeToXML "associatedValueReference") ) $ schedDate_choice3 x ] -- | A list of dates (cash flows, resets, etc.) that are -- relevant for this structure, e.g. next cash flow, last -- reset, etc. Provides a way to list upcoming or recent -- servicing dates related to this trade stream in a way that -- is simpler and more flexible than the FpML "cashflows" -- structure. data ScheduledDates = ScheduledDates { schedDates_scheduledDate :: [ScheduledDate] -- ^ A single stream level scheduled servicing date. } deriving (Eq,Show) instance SchemaType ScheduledDates where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ScheduledDates `apply` many (parseSchemaType "scheduledDate") schemaTypeToXML s x@ScheduledDates{} = toXMLElement s [] [ concatMap (schemaTypeToXML "scheduledDate") $ schedDates_scheduledDate x ] -- | A scheme used to identify the type of a stream scheduled -- servicing date. data ScheduledDateType = ScheduledDateType Scheme ScheduledDateTypeAttributes deriving (Eq,Show) data ScheduledDateTypeAttributes = ScheduledDateTypeAttributes { schedDateTypeAttrib_scheduledDateTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ScheduledDateType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "scheduledDateTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ScheduledDateType v (ScheduledDateTypeAttributes a0) schemaTypeToXML s (ScheduledDateType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "scheduledDateTypeScheme") $ schedDateTypeAttrib_scheduledDateTypeScheme at ] $ schemaTypeToXML s bt instance Extension ScheduledDateType Scheme where supertype (ScheduledDateType s _) = s -- | The sensitivity of a value to a defined change in input -- parameters. data Sensitivity = Sensitivity Xsd.Decimal SensitivityAttributes deriving (Eq,Show) data SensitivityAttributes = SensitivityAttributes { sensitAttrib_name :: Maybe Xsd.NormalizedString -- ^ A optional name for this sensitivity. This is primarily -- intended for display purposes. , sensitAttrib_definitionRef :: Maybe Xsd.IDREF -- ^ A optional (but normally supplied) reference to the -- definition of this sensitivity. } deriving (Eq,Show) instance SchemaType Sensitivity where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "name" e pos a1 <- optional $ getAttribute "definitionRef" e pos reparse [CElem e pos] v <- parseSchemaType s return $ Sensitivity v (SensitivityAttributes a0 a1) schemaTypeToXML s (Sensitivity bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "name") $ sensitAttrib_name at , maybe [] (toXMLAttribute "definitionRef") $ sensitAttrib_definitionRef at ] $ schemaTypeToXML s bt instance Extension Sensitivity Xsd.Decimal where supertype (Sensitivity s _) = s -- | A collection of sensitivities. References a definition that -- explains the meaning/type of the sensitivities. data SensitivitySet = SensitivitySet { sensitSet_ID :: Maybe Xsd.ID , sensitSet_name :: Maybe Xsd.XsdString , sensitSet_definitionReference :: Maybe SensitivitySetDefinitionReference -- ^ A reference to a sensitivity set definition. , sensitSet_sensitivity :: [Sensitivity] } deriving (Eq,Show) instance SchemaType SensitivitySet where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (SensitivitySet a0) `apply` optional (parseSchemaType "name") `apply` optional (parseSchemaType "definitionReference") `apply` many (parseSchemaType "sensitivity") schemaTypeToXML s x@SensitivitySet{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ sensitSet_ID x ] [ maybe [] (schemaTypeToXML "name") $ sensitSet_name x , maybe [] (schemaTypeToXML "definitionReference") $ sensitSet_definitionReference x , concatMap (schemaTypeToXML "sensitivity") $ sensitSet_sensitivity x ] -- | A set of valuation. data Valuations = Valuations { valuations_choice0 :: (Maybe (OneOf2 AssetValuation ValuationReference)) -- ^ Choice between: -- -- (1) valuation -- -- (2) A reference to a quotation } deriving (Eq,Show) instance SchemaType Valuations where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Valuations `apply` optional (oneOf' [ ("AssetValuation", fmap OneOf2 (parseSchemaType "valuation")) , ("ValuationReference", fmap TwoOf2 (parseSchemaType "valuationReference")) ]) schemaTypeToXML s x@Valuations{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "valuation") (schemaTypeToXML "valuationReference") ) $ valuations_choice0 x ] -- | A set of valuation inputs and results. This structure can -- be used for requesting valuations, or for reporting them. -- In general, the request fills in fewer elements. data ValuationSet = ValuationSet { valuationSet_ID :: Maybe Xsd.ID , valuationSet_name :: Maybe Xsd.XsdString -- ^ The name of the valuation set, used to understand what it -- means. E.g., "EOD Values and Risks for Party A". , valuationSet_valuationScenario :: [ValuationScenario] -- ^ Valuation scenerios used (requested/reported) in this -- valuation set. E.g., the EOD valuation scenario for a -- particular value date. Used for the first occurrence of a -- valuation scenario in a document. , valuationSet_valuationScenarioReference :: [ValuationScenarioReference] -- ^ References to valuation scenarios used (requested/reported) -- in this valuation set. E..g, a reference to the EOD -- valuation scenario for a particular value date. Used for -- subsequence occurrences of a valuation set in an FpML -- document. , valuationSet_baseParty :: Maybe PartyReference -- ^ Reference to the party from whose point of view the assets -- are valued. , valuationSet_quotationCharacteristics :: [QuotationCharacteristics] -- ^ Charactistics (measure types, units, sides, etc.) of the -- quotes used (requested/reported) in the valuation set. , valuationSet_sensitivitySetDefinition :: [SensitivitySetDefinition] -- ^ Definition(s) of sensitivity sets used (requested or -- reported) in this valuation set. , valuationSet_detail :: Maybe ValuationSetDetail -- ^ Does this valuation set include a market environment? , valuationSet_assetValuation :: [AssetValuation] -- ^ Valuations reported in this valuation set. These values can -- be values (NPVs, prices, etc.) or risks (DAR, etc.) and can -- include sensitivities. } deriving (Eq,Show) instance SchemaType ValuationSet where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (ValuationSet a0) `apply` optional (parseSchemaType "name") `apply` many (parseSchemaType "valuationScenario") `apply` many (parseSchemaType "valuationScenarioReference") `apply` optional (parseSchemaType "baseParty") `apply` many (parseSchemaType "quotationCharacteristics") `apply` many (parseSchemaType "sensitivitySetDefinition") `apply` optional (parseSchemaType "detail") `apply` many (parseSchemaType "assetValuation") schemaTypeToXML s x@ValuationSet{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ valuationSet_ID x ] [ maybe [] (schemaTypeToXML "name") $ valuationSet_name x , concatMap (schemaTypeToXML "valuationScenario") $ valuationSet_valuationScenario x , concatMap (schemaTypeToXML "valuationScenarioReference") $ valuationSet_valuationScenarioReference x , maybe [] (schemaTypeToXML "baseParty") $ valuationSet_baseParty x , concatMap (schemaTypeToXML "quotationCharacteristics") $ valuationSet_quotationCharacteristics x , concatMap (schemaTypeToXML "sensitivitySetDefinition") $ valuationSet_sensitivitySetDefinition x , maybe [] (schemaTypeToXML "detail") $ valuationSet_detail x , concatMap (schemaTypeToXML "assetValuation") $ valuationSet_assetValuation x ] -- | The amount of detail provided in the valuation set, e.g. is -- market environment data provided, are risk definitions -- provided, etc. data ValuationSetDetail = ValuationSetDetail Scheme ValuationSetDetailAttributes deriving (Eq,Show) data ValuationSetDetailAttributes = ValuationSetDetailAttributes { valSetDetailAttrib_valuationSetDetailScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ValuationSetDetail where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "valuationSetDetailScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ValuationSetDetail v (ValuationSetDetailAttributes a0) schemaTypeToXML s (ValuationSetDetail bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "valuationSetDetailScheme") $ valSetDetailAttrib_valuationSetDetailScheme at ] $ schemaTypeToXML s bt instance Extension ValuationSetDetail Scheme where supertype (ValuationSetDetail s _) = s elementValuationSet :: XMLParser ValuationSet elementValuationSet = parseSchemaType "valuationSet" elementToXMLValuationSet :: ValuationSet -> [Content ()] elementToXMLValuationSet = schemaTypeToXML "valuationSet" -- | A collection of related trades or positions and the -- corresponding aggregate exposures generated by these. data Position = Position { position_ID :: Maybe Xsd.ID , position_id :: Maybe PositionId -- ^ A version-independent identifier for the position, possibly -- based on trade identifier. , position_version :: Maybe Xsd.PositiveInteger -- ^ A version identifier. Version identifiers must be -- ascending, i.e. higher numbers imply newer versions. There -- is no requirement that version identifiers for a position -- be sequential or small, so for example timestamp-based -- version identifiers could be used. , position_status :: Maybe PositionStatusEnum , position_creationDate :: Maybe Xsd.Date , position_originatingEvent :: Maybe PositionOriginEnum , position_history :: Maybe PositionHistory , position_reportingRoles :: Maybe ReportingRoles -- ^ Information about the roles of the parties with respect to -- reporting the positions. , position_constituent :: Maybe PositionConstituent -- ^ The components that create this position. , position_scheduledDate :: [ScheduledDate] -- ^ Position level schedule date, such as final payment dates, -- in a simple and flexible format. , position_valuation :: [AssetValuation] -- ^ Valuation reported for the position, such as NPV or accrued -- interest. The asset/object references in the valuations -- should refer to the deal or components of the deal in the -- position, e.g. legs, streams, or underlyers. } deriving (Eq,Show) instance SchemaType Position where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Position a0) `apply` optional (parseSchemaType "positionId") `apply` optional (parseSchemaType "version") `apply` optional (parseSchemaType "status") `apply` optional (parseSchemaType "creationDate") `apply` optional (parseSchemaType "originatingEvent") `apply` optional (parseSchemaType "history") `apply` optional (parseSchemaType "reportingRoles") `apply` optional (parseSchemaType "constituent") `apply` many (parseSchemaType "scheduledDate") `apply` many (parseSchemaType "valuation") schemaTypeToXML s x@Position{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ position_ID x ] [ maybe [] (schemaTypeToXML "positionId") $ position_id x , maybe [] (schemaTypeToXML "version") $ position_version x , maybe [] (schemaTypeToXML "status") $ position_status x , maybe [] (schemaTypeToXML "creationDate") $ position_creationDate x , maybe [] (schemaTypeToXML "originatingEvent") $ position_originatingEvent x , maybe [] (schemaTypeToXML "history") $ position_history x , maybe [] (schemaTypeToXML "reportingRoles") $ position_reportingRoles x , maybe [] (schemaTypeToXML "constituent") $ position_constituent x , concatMap (schemaTypeToXML "scheduledDate") $ position_scheduledDate x , concatMap (schemaTypeToXML "valuation") $ position_valuation x ] -- | A list of events that have affected a position. data PositionHistory = PositionHistory { positHistory_choice0 :: (Maybe (OneOf10 ((Maybe (OriginatingEvent)),(Maybe (Trade))) TradeAmendmentContent TradeNotionalChange ((Maybe (TerminatingEvent)),(Maybe (TradeNotionalChange))) TradeNovationContent OptionExercise [OptionExpiry] DeClear Withdrawal AdditionalEvent)) -- ^ Choice between: -- -- (1) Sequence of: -- -- * originatingEvent -- -- * trade -- -- (2) amendment -- -- (3) increase -- -- (4) Sequence of: -- -- * terminatingEvent -- -- * termination -- -- (5) novation -- -- (6) optionExercise -- -- (7) optionExpiry -- -- (8) deClear -- -- (9) withdrawal -- -- (10) The additionalEvent element is an -- extension/substitution point to customize FpML and add -- additional events. } deriving (Eq,Show) instance SchemaType PositionHistory where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PositionHistory `apply` optional (oneOf' [ ("Maybe OriginatingEvent Maybe Trade", fmap OneOf10 (return (,) `apply` optional (parseSchemaType "originatingEvent") `apply` optional (parseSchemaType "trade"))) , ("TradeAmendmentContent", fmap TwoOf10 (parseSchemaType "amendment")) , ("TradeNotionalChange", fmap ThreeOf10 (parseSchemaType "increase")) , ("Maybe TerminatingEvent Maybe TradeNotionalChange", fmap FourOf10 (return (,) `apply` optional (parseSchemaType "terminatingEvent") `apply` optional (parseSchemaType "termination"))) , ("TradeNovationContent", fmap FiveOf10 (parseSchemaType "novation")) , ("OptionExercise", fmap SixOf10 (parseSchemaType "optionExercise")) , ("[OptionExpiry]", fmap SevenOf10 (many1 (parseSchemaType "optionExpiry"))) , ("DeClear", fmap EightOf10 (parseSchemaType "deClear")) , ("Withdrawal", fmap NineOf10 (parseSchemaType "withdrawal")) , ("AdditionalEvent", fmap TenOf10 (elementAdditionalEvent)) ]) schemaTypeToXML s x@PositionHistory{} = toXMLElement s [] [ maybe [] (foldOneOf10 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "originatingEvent") a , maybe [] (schemaTypeToXML "trade") b ]) (schemaTypeToXML "amendment") (schemaTypeToXML "increase") (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "terminatingEvent") a , maybe [] (schemaTypeToXML "termination") b ]) (schemaTypeToXML "novation") (schemaTypeToXML "optionExercise") (concatMap (schemaTypeToXML "optionExpiry")) (schemaTypeToXML "deClear") (schemaTypeToXML "withdrawal") (elementToXMLAdditionalEvent) ) $ positHistory_choice0 x ] -- | The items (trades, trade references, holdings, other -- positions) that comprise this position. Currently a -- position may consist only of a single trade, a reference to -- a previously submitted position, or a reference to the -- trade. The choice structure is optional to allow extensions -- to be placed within this container. data PositionConstituent = PositionConstituent { positConstit_choice0 :: (Maybe (OneOf3 Trade Xsd.PositiveInteger PartyTradeIdentifiers)) -- ^ Choice between: -- -- (1) An element that allows the full details of the trade to -- be used as a mechanism for identifying the trade for -- which the post-trade event pertains. -- -- (2) A previously submitted version of the position. -- -- (3) The trade reference identifier(s) allocated to the -- trade by the parties involved. } deriving (Eq,Show) instance SchemaType PositionConstituent where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PositionConstituent `apply` optional (oneOf' [ ("Trade", fmap OneOf3 (parseSchemaType "trade")) , ("Xsd.PositiveInteger", fmap TwoOf3 (parseSchemaType "positionVersionReference")) , ("PartyTradeIdentifiers", fmap ThreeOf3 (parseSchemaType "tradeReference")) ]) schemaTypeToXML s x@PositionConstituent{} = toXMLElement s [] [ maybe [] (foldOneOf3 (schemaTypeToXML "trade") (schemaTypeToXML "positionVersionReference") (schemaTypeToXML "tradeReference") ) $ positConstit_choice0 x ]