{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} module Data.FpML.V53.Doc ( module Data.FpML.V53.Doc , module Data.FpML.V53.Asset ) where import Text.XML.HaXml.Schema.Schema (SchemaType(..),SimpleType(..),Extension(..),Restricts(..)) import Text.XML.HaXml.Schema.Schema as Schema import Text.XML.HaXml.OneOfN import qualified Text.XML.HaXml.Schema.PrimitiveTypes as Xsd import Data.FpML.V53.Asset -- Some hs-boot imports are required, for fwd-declaring types. import {-# SOURCE #-} Data.FpML.V53.Msg ( Message ) -- | A type representing a value corresponding to an identifier -- for a parameter describing a query portfolio. newtype QueryParameterValue = QueryParameterValue Xsd.XsdString deriving (Eq,Show) instance Restricts QueryParameterValue Xsd.XsdString where restricts (QueryParameterValue x) = x instance SchemaType QueryParameterValue where parseSchemaType s = do e <- element [s] commit $ interior e $ parseSimpleType schemaTypeToXML s (QueryParameterValue x) = toXMLElement s [] [toXMLText (simpleTypeText x)] instance SimpleType QueryParameterValue where acceptingParser = fmap QueryParameterValue acceptingParser -- XXX should enforce the restrictions somehow? -- The restrictions are: simpleTypeText (QueryParameterValue x) = simpleTypeText x data Allocation = Allocation { allocation_tradeId :: Maybe TradeIdentifier -- ^ Unique ID for the allocation. , allocation_partyReference :: PartyReference -- ^ Reference to a party. , allocation_accountReference :: Maybe AccountReference -- ^ Reference to an account. , allocation_choice3 :: (Maybe (OneOf2 Xsd.Decimal [Money])) -- ^ Choice between: -- -- (1) The fractional allocation (0.45 = 45%) of the notional -- and "block" fees to this particular client subaccount. -- -- (2) The notional allocation (amount and currency) to this -- particular client account. , allocation_collateral :: Maybe Collateral -- ^ The sum that must be posted upfront to collateralize -- against counterparty credit risk. , allocation_creditChargeAmount :: Maybe Money -- ^ Special credit fee assessed to certain institutions. , allocation_approvals :: Maybe Approvals -- ^ A container for approval states in the workflow. , allocation_masterConfirmationDate :: Maybe Xsd.Date -- ^ The date of the confirmation executed between the parties -- and intended to govern the allocated trade between those -- parties. , allocation_relatedParty :: [RelatedParty] -- ^ Specifies any relevant parties to the allocation which -- should be referenced. } deriving (Eq,Show) instance SchemaType Allocation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Allocation `apply` optional (parseSchemaType "allocationTradeId") `apply` parseSchemaType "partyReference" `apply` optional (parseSchemaType "accountReference") `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "allocatedFraction")) , ("[Money]", fmap TwoOf2 (between (Occurs (Just 1) (Just 2)) (parseSchemaType "allocatedNotional"))) ]) `apply` optional (parseSchemaType "collateral") `apply` optional (parseSchemaType "creditChargeAmount") `apply` optional (parseSchemaType "approvals") `apply` optional (parseSchemaType "masterConfirmationDate") `apply` many (parseSchemaType "relatedParty") schemaTypeToXML s x@Allocation{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "allocationTradeId") $ allocation_tradeId x , schemaTypeToXML "partyReference" $ allocation_partyReference x , maybe [] (schemaTypeToXML "accountReference") $ allocation_accountReference x , maybe [] (foldOneOf2 (schemaTypeToXML "allocatedFraction") (concatMap (schemaTypeToXML "allocatedNotional")) ) $ allocation_choice3 x , maybe [] (schemaTypeToXML "collateral") $ allocation_collateral x , maybe [] (schemaTypeToXML "creditChargeAmount") $ allocation_creditChargeAmount x , maybe [] (schemaTypeToXML "approvals") $ allocation_approvals x , maybe [] (schemaTypeToXML "masterConfirmationDate") $ allocation_masterConfirmationDate x , concatMap (schemaTypeToXML "relatedParty") $ allocation_relatedParty x ] data Allocations = Allocations { allocations_allocation :: [Allocation] } deriving (Eq,Show) instance SchemaType Allocations where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Allocations `apply` many (parseSchemaType "allocation") schemaTypeToXML s x@Allocations{} = toXMLElement s [] [ concatMap (schemaTypeToXML "allocation") $ allocations_allocation x ] -- | A specific approval state in the workflow. data Approval = Approval { approval_type :: Maybe Xsd.NormalizedString -- ^ The type of approval (e.g. "Credit"). , approval_status :: Maybe Xsd.NormalizedString -- ^ The current state of approval (.e.g preapproved, pending -- approval, etc.) , approval_approver :: Maybe Xsd.NormalizedString -- ^ The full name or identifiying ID of the relevant approver. } deriving (Eq,Show) instance SchemaType Approval where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Approval `apply` optional (parseSchemaType "type") `apply` optional (parseSchemaType "status") `apply` optional (parseSchemaType "approver") schemaTypeToXML s x@Approval{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "type") $ approval_type x , maybe [] (schemaTypeToXML "status") $ approval_status x , maybe [] (schemaTypeToXML "approver") $ approval_approver x ] data Approvals = Approvals { approvals_approval :: [Approval] } deriving (Eq,Show) instance SchemaType Approvals where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Approvals `apply` many (parseSchemaType "approval") schemaTypeToXML s x@Approvals{} = toXMLElement s [] [ concatMap (schemaTypeToXML "approval") $ approvals_approval x ] -- | A type used to record the differences between the current -- trade and another indicated trade. data BestFitTrade = BestFitTrade { bestFitTrade_tradeIdentifier :: Maybe TradeIdentifier -- ^ The identifier for the trade compared against. , bestFitTrade_differences :: [TradeDifference] -- ^ An optional set of detailed difference records. } deriving (Eq,Show) instance SchemaType BestFitTrade where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return BestFitTrade `apply` optional (parseSchemaType "tradeIdentifier") `apply` many (parseSchemaType "differences") schemaTypeToXML s x@BestFitTrade{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "tradeIdentifier") $ bestFitTrade_tradeIdentifier x , concatMap (schemaTypeToXML "differences") $ bestFitTrade_differences x ] -- | A type for defining the obligations of the counterparty -- subject to credit support requirements. data Collateral = Collateral { collateral_independentAmount :: Maybe IndependentAmount -- ^ Independent Amount is an amount that usually less -- creditworthy counterparties are asked to provide. It can -- either be a fixed amount or a percentage of the -- Transaction's value. The Independent Amount can be: (i) -- transferred before any trading between the parties occurs -- (as a deposit at a third party's account or with the -- counterparty) or (ii) callable after trading has occurred -- (typically because a downgrade has occurred). In situation -- (i), the Independent Amount is not included in the -- calculation of Exposure, but in situation (ii), it is -- included in the calculation of Exposure. Thus, for -- situation (ii), the Independent Amount may be transferred -- along with any collateral call. Independent Amount is a -- defined term in the ISDA Credit Support Annex. ("with -- respect to a party, the amount specified as such for that -- party in Paragraph 13; if no amount is specified, zero"). } deriving (Eq,Show) instance SchemaType Collateral where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Collateral `apply` optional (parseSchemaType "independentAmount") schemaTypeToXML s x@Collateral{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "independentAmount") $ collateral_independentAmount x ] -- | A contact id identifier allocated by a party. FpML does not -- define the domain values associated with this element. data ContractId = ContractId Scheme ContractIdAttributes deriving (Eq,Show) data ContractIdAttributes = ContractIdAttributes { contrIdAttrib_contractIdScheme :: Xsd.AnyURI , contrIdAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType ContractId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- getAttribute "contractIdScheme" e pos a1 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ContractId v (ContractIdAttributes a0 a1) schemaTypeToXML s (ContractId bt at) = addXMLAttributes [ toXMLAttribute "contractIdScheme" $ contrIdAttrib_contractIdScheme at , maybe [] (toXMLAttribute "id") $ contrIdAttrib_ID at ] $ schemaTypeToXML s bt instance Extension ContractId Scheme where supertype (ContractId s _) = s -- | A type defining a contract identifier issued by the -- indicated party. data ContractIdentifier = ContractIdentifier { contrIdent_ID :: Maybe Xsd.ID , contrIdent_partyReference :: Maybe PartyReference -- ^ A pointer style reference to a party identifier defined -- elsewhere in the document. The party referenced has -- allocated the contract identifier. , contrIdent_choice1 :: (Maybe (OneOf2 [ContractId] [VersionedContractId])) -- ^ Where the legal activity is to agree a contract of -- variation then the business process should be to modify a -- contract. This is a contract in its own right and not a -- version of a previous contract. Where the business process -- is to replace and supersede a contract then you have a new -- contract and a contract version should not be used. -- -- Choice between: -- -- (1) A contract id which is not version aware. -- -- (2) A contract id which is version aware. } deriving (Eq,Show) instance SchemaType ContractIdentifier where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (ContractIdentifier a0) `apply` optional (parseSchemaType "partyReference") `apply` optional (oneOf' [ ("[ContractId]", fmap OneOf2 (many1 (parseSchemaType "contractId"))) , ("[VersionedContractId]", fmap TwoOf2 (many1 (parseSchemaType "versionedContractId"))) ]) schemaTypeToXML s x@ContractIdentifier{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ contrIdent_ID x ] [ maybe [] (schemaTypeToXML "partyReference") $ contrIdent_partyReference x , maybe [] (foldOneOf2 (concatMap (schemaTypeToXML "contractId")) (concatMap (schemaTypeToXML "versionedContractId")) ) $ contrIdent_choice1 x ] data CreditDerivativesNotices = CreditDerivativesNotices { creditDerivNotices_creditEvent :: Maybe Xsd.Boolean -- ^ This element corresponds to the Credit Event Notice -- Delivered Under Old Transaction and Deemed Delivered Under -- New Transaction under the EXHIBIT C to 2004 ISDA Novation -- Definitions. , creditDerivNotices_publiclyAvailableInformation :: Maybe Xsd.Boolean -- ^ This element corresponds to the Notice of Publicly -- Available Information Delivered Under Old Transaction and -- Deemed Delivered Under New Transaction under the EXHIBIT C -- to 2004 ISDA Novation Definitions. , creditDerivNotices_physicalSettlement :: Maybe Xsd.Boolean -- ^ This element corresponds to the Notice of Intended Physical -- Settlement Delivered Under Old Transaction under the -- EXHIBIT C to 2004 ISDA Novation Definitions. } deriving (Eq,Show) instance SchemaType CreditDerivativesNotices where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CreditDerivativesNotices `apply` optional (parseSchemaType "creditEvent") `apply` optional (parseSchemaType "publiclyAvailableInformation") `apply` optional (parseSchemaType "physicalSettlement") schemaTypeToXML s x@CreditDerivativesNotices{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "creditEvent") $ creditDerivNotices_creditEvent x , maybe [] (schemaTypeToXML "publiclyAvailableInformation") $ creditDerivNotices_publiclyAvailableInformation x , maybe [] (schemaTypeToXML "physicalSettlement") $ creditDerivNotices_physicalSettlement x ] -- | A type defining a content model that is backwards -- compatible with older FpML releases and which can be used -- to contain sets of data without expressing any processing -- intention. data DataDocument = DataDocument { dataDocument_fpmlVersion :: Xsd.XsdString -- ^ Indicate which version of the FpML Schema an FpML message -- adheres to. , dataDocument_expectedBuild :: Maybe Xsd.PositiveInteger -- ^ This optional attribute can be supplied by a message -- creator in an FpML instance to specify which build number -- of the schema was used to define the message when it was -- generated. , dataDocument_actualBuild :: Maybe Xsd.PositiveInteger -- ^ The specific build number of this schema version. This -- attribute is not included in an instance document. Instead, -- it is supplied by the XML parser when the document is -- validated against the FpML schema and indicates the build -- number of the schema file. Every time FpML publishes a -- change to the schema, validation rules, or examples within -- a version (e.g., version 4.2) the actual build number is -- incremented. If no changes have been made between releases -- within a version (i.e. from Trial Recommendation to -- Recommendation) the actual build number stays the same. , dataDocument_validation :: [Validation] -- ^ A list of validation sets the sender asserts the document -- is valid with respect to. , dataDocument_choice1 :: (Maybe (OneOf2 Xsd.Boolean Xsd.Boolean)) -- ^ Choice between: -- -- (1) Indicates if this message corrects an earlier request. -- -- (2) Indicates if this message corrects an earlier request. , dataDocument_onBehalfOf :: Maybe OnBehalfOf -- ^ Indicates which party (and accounts) a trade is being -- processed for. , dataDocument_originatingEvent :: Maybe OriginatingEvent , dataDocument_trade :: [Trade] -- ^ The root element in an FpML trade document. , dataDocument_party :: [Party] , dataDocument_account :: [Account] -- ^ Optional account information used to precisely define the -- origination and destination of financial instruments. } deriving (Eq,Show) instance SchemaType DataDocument where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "fpmlVersion" e pos a1 <- optional $ getAttribute "expectedBuild" e pos a2 <- optional $ getAttribute "actualBuild" e pos commit $ interior e $ return (DataDocument a0 a1 a2) `apply` many (parseSchemaType "validation") `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf2 (parseSchemaType "isCorrection")) , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "isCancellation")) ]) `apply` optional (parseSchemaType "onBehalfOf") `apply` optional (parseSchemaType "originatingEvent") `apply` many1 (parseSchemaType "trade") `apply` many (parseSchemaType "party") `apply` many (parseSchemaType "account") schemaTypeToXML s x@DataDocument{} = toXMLElement s [ toXMLAttribute "fpmlVersion" $ dataDocument_fpmlVersion x , maybe [] (toXMLAttribute "expectedBuild") $ dataDocument_expectedBuild x , maybe [] (toXMLAttribute "actualBuild") $ dataDocument_actualBuild x ] [ concatMap (schemaTypeToXML "validation") $ dataDocument_validation x , maybe [] (foldOneOf2 (schemaTypeToXML "isCorrection") (schemaTypeToXML "isCancellation") ) $ dataDocument_choice1 x , maybe [] (schemaTypeToXML "onBehalfOf") $ dataDocument_onBehalfOf x , maybe [] (schemaTypeToXML "originatingEvent") $ dataDocument_originatingEvent x , concatMap (schemaTypeToXML "trade") $ dataDocument_trade x , concatMap (schemaTypeToXML "party") $ dataDocument_party x , concatMap (schemaTypeToXML "account") $ dataDocument_account x ] instance Extension DataDocument Document where supertype v = Document_DataDocument v -- | The abstract base type from which all FpML compliant -- messages and documents must be derived. data Document = Document_DataDocument DataDocument | Document_Message Message deriving (Eq,Show) instance SchemaType Document where parseSchemaType s = do (fmap Document_DataDocument $ parseSchemaType s) `onFail` (fmap Document_Message $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of Document,\n\ \ namely one of:\n\ \DataDocument,Message" schemaTypeToXML _s (Document_DataDocument x) = schemaTypeToXML "dataDocument" x schemaTypeToXML _s (Document_Message x) = schemaTypeToXML "message" x -- | A type defining the trade execution date time and the -- source of it. For use inside containing types which already -- have a Reference to a Party that has assigned this trade -- execution date time. data ExecutionDateTime = ExecutionDateTime Xsd.DateTime ExecutionDateTimeAttributes deriving (Eq,Show) data ExecutionDateTimeAttributes = ExecutionDateTimeAttributes { executDateTimeAttrib_executionDateTimeScheme :: Maybe Xsd.AnyURI -- ^ Identification of the source (e.g. clock id) generating the -- execution date time. } deriving (Eq,Show) instance SchemaType ExecutionDateTime where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "executionDateTimeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ExecutionDateTime v (ExecutionDateTimeAttributes a0) schemaTypeToXML s (ExecutionDateTime bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "executionDateTimeScheme") $ executDateTimeAttrib_executionDateTimeScheme at ] $ schemaTypeToXML s bt instance Extension ExecutionDateTime Xsd.DateTime where supertype (ExecutionDateTime s _) = s data FirstPeriodStartDate = FirstPeriodStartDate Xsd.Date FirstPeriodStartDateAttributes deriving (Eq,Show) data FirstPeriodStartDateAttributes = FirstPeriodStartDateAttributes { firstPeriodStartDateAttrib_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType FirstPeriodStartDate where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- getAttribute "href" e pos reparse [CElem e pos] v <- parseSchemaType s return $ FirstPeriodStartDate v (FirstPeriodStartDateAttributes a0) schemaTypeToXML s (FirstPeriodStartDate bt at) = addXMLAttributes [ toXMLAttribute "href" $ firstPeriodStartDateAttrib_href at ] $ schemaTypeToXML s bt instance Extension FirstPeriodStartDate Xsd.Date where supertype (FirstPeriodStartDate s _) = s data IndependentAmount = IndependentAmount { indepAmount_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , indepAmount_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , indepAmount_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , indepAmount_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , indepAmount_paymentDetail :: [PaymentDetail] -- ^ A container element allowing a schedule of payments -- associated with the Independent Amount. } deriving (Eq,Show) instance SchemaType IndependentAmount where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return IndependentAmount `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` many (parseSchemaType "paymentDetail") schemaTypeToXML s x@IndependentAmount{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "payerPartyReference") $ indepAmount_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ indepAmount_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ indepAmount_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ indepAmount_receiverAccountReference x , concatMap (schemaTypeToXML "paymentDetail") $ indepAmount_paymentDetail x ] -- | The economics of a trade of a multiply traded instrument. data InstrumentTradeDetails = InstrumentTradeDetails { instrTradeDetails_ID :: Maybe Xsd.ID , instrTradeDetails_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. , instrTradeDetails_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , instrTradeDetails_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , instrTradeDetails_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. , instrTradeDetails_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. , instrTradeDetails_buyerAccountReference :: Maybe AccountReference -- ^ A reference to the account that buys this instrument. , instrTradeDetails_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. , instrTradeDetails_sellerAccountReference :: Maybe AccountReference -- ^ A reference to the account that sells this instrument. , instrTradeDetails_underlyingAsset :: Maybe Asset -- ^ Define the underlying asset, either a listed security or -- other instrument. , instrTradeDetails_quantity :: Maybe InstrumentTradeQuantity -- ^ A description of how much of the instrument was traded. , instrTradeDetails_pricing :: Maybe InstrumentTradePricing -- ^ The price paid for the instrument. , instrTradeDetails_principal :: Maybe InstrumentTradePrincipal -- ^ The value, in instrument currency, of the amount of the -- instrument that was traded. } deriving (Eq,Show) instance SchemaType InstrumentTradeDetails where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (InstrumentTradeDetails 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 (elementUnderlyingAsset) `apply` optional (parseSchemaType "quantity") `apply` optional (parseSchemaType "pricing") `apply` optional (parseSchemaType "principal") schemaTypeToXML s x@InstrumentTradeDetails{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ instrTradeDetails_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ instrTradeDetails_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ instrTradeDetails_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ instrTradeDetails_productType x , concatMap (schemaTypeToXML "productId") $ instrTradeDetails_productId x , maybe [] (schemaTypeToXML "buyerPartyReference") $ instrTradeDetails_buyerPartyReference x , maybe [] (schemaTypeToXML "buyerAccountReference") $ instrTradeDetails_buyerAccountReference x , maybe [] (schemaTypeToXML "sellerPartyReference") $ instrTradeDetails_sellerPartyReference x , maybe [] (schemaTypeToXML "sellerAccountReference") $ instrTradeDetails_sellerAccountReference x , maybe [] (elementToXMLUnderlyingAsset) $ instrTradeDetails_underlyingAsset x , maybe [] (schemaTypeToXML "quantity") $ instrTradeDetails_quantity x , maybe [] (schemaTypeToXML "pricing") $ instrTradeDetails_pricing x , maybe [] (schemaTypeToXML "principal") $ instrTradeDetails_principal x ] instance Extension InstrumentTradeDetails Product where supertype v = Product_InstrumentTradeDetails v -- | A structure describing the amount of an instrument that was -- traded. data InstrumentTradeQuantity = InstrumentTradeQuantity { instrTradeQuant_choice0 :: (Maybe (OneOf2 Xsd.Decimal Money)) -- ^ Choice between: -- -- (1) The (absolute) number of units of the underlying -- instrument that were traded. -- -- (2) The monetary value of the security (eg. fixed income -- security) that was traded). } deriving (Eq,Show) instance SchemaType InstrumentTradeQuantity where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return InstrumentTradeQuantity `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "number")) , ("Money", fmap TwoOf2 (parseSchemaType "nominal")) ]) schemaTypeToXML s x@InstrumentTradeQuantity{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "number") (schemaTypeToXML "nominal") ) $ instrTradeQuant_choice0 x ] -- | A structure describing the price paid for the instrument. data InstrumentTradePricing = InstrumentTradePricing { instrTradePricing_quote :: [BasicQuotation] } deriving (Eq,Show) instance SchemaType InstrumentTradePricing where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return InstrumentTradePricing `apply` many (parseSchemaType "quote") schemaTypeToXML s x@InstrumentTradePricing{} = toXMLElement s [] [ concatMap (schemaTypeToXML "quote") $ instrTradePricing_quote x ] -- | A structure describing the value in "native" currency of an -- instrument that was traded. data InstrumentTradePrincipal = InstrumentTradePrincipal { instrTradePrinc_principalAmount :: Maybe NetAndGross -- ^ The net and/or gross value of the amount traded in native -- currency. } deriving (Eq,Show) instance SchemaType InstrumentTradePrincipal where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return InstrumentTradePrincipal `apply` optional (parseSchemaType "principalAmount") schemaTypeToXML s x@InstrumentTradePrincipal{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "principalAmount") $ instrTradePrinc_principalAmount x ] -- | The data type used for link identifiers. data LinkId = LinkId Scheme LinkIdAttributes deriving (Eq,Show) data LinkIdAttributes = LinkIdAttributes { linkIdAttrib_ID :: Maybe Xsd.ID , linkIdAttrib_linkIdScheme :: Xsd.AnyURI } deriving (Eq,Show) instance SchemaType LinkId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "id" e pos a1 <- getAttribute "linkIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ LinkId v (LinkIdAttributes a0 a1) schemaTypeToXML s (LinkId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "id") $ linkIdAttrib_ID at , toXMLAttribute "linkIdScheme" $ linkIdAttrib_linkIdScheme at ] $ schemaTypeToXML s bt instance Extension LinkId Scheme where supertype (LinkId s _) = s -- | A structure including a net and/or a gross amount and -- possibly fees and commissions. data NetAndGross = NetAndGross { netAndGross_choice0 :: OneOf2 Xsd.Decimal (Xsd.Decimal,(Maybe (Xsd.Decimal))) -- ^ Choice between: -- -- (1) Value including fees and commissions. -- -- (2) Sequence of: -- -- * Value excluding fees and commissions. -- -- * Value including fees and commissions. } deriving (Eq,Show) instance SchemaType NetAndGross where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return NetAndGross `apply` oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "net")) , ("Xsd.Decimal Maybe Xsd.Decimal", fmap TwoOf2 (return (,) `apply` parseSchemaType "gross" `apply` optional (parseSchemaType "net"))) ] schemaTypeToXML s x@NetAndGross{} = toXMLElement s [] [ foldOneOf2 (schemaTypeToXML "net") (\ (a,b) -> concat [ schemaTypeToXML "gross" a , maybe [] (schemaTypeToXML "net") b ]) $ netAndGross_choice0 x ] -- | A type to represent a portfolio name for a particular -- party. data PartyPortfolioName = PartyPortfolioName { partyPortfName_ID :: Maybe Xsd.ID , partyPortfName_partyReference :: Maybe PartyReference -- ^ A pointer style reference to a party identifier defined -- elsewhere in the document. The party referenced has -- allocated the trade identifier. , partyPortfName_portfolioName :: [PortfolioName] } deriving (Eq,Show) instance SchemaType PartyPortfolioName where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (PartyPortfolioName a0) `apply` optional (parseSchemaType "partyReference") `apply` many (parseSchemaType "portfolioName") schemaTypeToXML s x@PartyPortfolioName{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ partyPortfName_ID x ] [ maybe [] (schemaTypeToXML "partyReference") $ partyPortfName_partyReference x , concatMap (schemaTypeToXML "portfolioName") $ partyPortfName_portfolioName x ] -- | A type defining one or more trade identifiers allocated to -- the trade by a party. A link identifier allows the trade to -- be associated with other related trades, e.g. trades -- forming part of a larger structured transaction. It is -- expected that for external communication of trade there -- will be only one tradeId sent in the document per party. data PartyTradeIdentifier = PartyTradeIdentifier { partyTradeIdent_ID :: Maybe Xsd.ID , partyTradeIdent_choice0 :: OneOf2 (IssuerId,TradeId) (PartyReference,(Maybe (AccountReference)),([OneOf2 TradeId VersionedTradeId])) -- ^ Choice between: -- -- (1) Sequence of: -- -- * issuer -- -- * tradeId -- -- (2) Sequence of: -- -- * Reference to a party. -- -- * Reference to an account. -- -- * unknown , partyTradeIdent_linkId :: [LinkId] -- ^ A link identifier allowing the trade to be associated with -- other related trades, e.g. the linkId may contain a tradeId -- for an associated trade or several related trades may be -- given the same linkId. 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. , partyTradeIdent_allocationTradeId :: [TradeIdentifier] -- ^ The trade id of the allocated trade. This is used by the -- block trade to reference the allocated trade. , partyTradeIdent_blockTradeId :: Maybe TradeIdentifier -- ^ The trade id of the block trade. This is used by each one -- of the allocated trades to reference the block trade. This -- element can also represent the trade id of the parent trade -- for N-level allocations. In the case, this element is only -- used to model N-level allocations in which the trade acts -- as block and allocated trade at the same time. This -- basically means the ability to allocate a block trade to -- multiple allocation trades, and then allocate these in turn -- to other allocation trades (and so on if desired). , partyTradeIdent_originatingTradeId :: Maybe TradeIdentifier -- ^ The trade id of the trade upon which this was based, for -- example the ID of the trade that was submitted for clearing -- if this is a cleared trade, or of the original trade if -- this was novated or cancelled and rebooked. The -- originatingEvent will explain why the trade was created. } deriving (Eq,Show) instance SchemaType PartyTradeIdentifier where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (PartyTradeIdentifier a0) `apply` oneOf' [ ("IssuerId TradeId", fmap OneOf2 (return (,) `apply` parseSchemaType "issuer" `apply` parseSchemaType "tradeId")) , ("PartyReference Maybe AccountReference [OneOf2 TradeId VersionedTradeId]", fmap TwoOf2 (return (,,) `apply` parseSchemaType "partyReference" `apply` optional (parseSchemaType "accountReference") `apply` many1 (oneOf' [ ("TradeId", fmap OneOf2 (parseSchemaType "tradeId")) , ("VersionedTradeId", fmap TwoOf2 (parseSchemaType "versionedTradeId")) ]))) ] `apply` many (parseSchemaType "linkId") `apply` many (parseSchemaType "allocationTradeId") `apply` optional (parseSchemaType "blockTradeId") `apply` optional (parseSchemaType "originatingTradeId") schemaTypeToXML s x@PartyTradeIdentifier{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ partyTradeIdent_ID x ] [ foldOneOf2 (\ (a,b) -> concat [ schemaTypeToXML "issuer" a , schemaTypeToXML "tradeId" b ]) (\ (a,b,c) -> concat [ schemaTypeToXML "partyReference" a , maybe [] (schemaTypeToXML "accountReference") b , concatMap (foldOneOf2 (schemaTypeToXML "tradeId") (schemaTypeToXML "versionedTradeId") ) c ]) $ partyTradeIdent_choice0 x , concatMap (schemaTypeToXML "linkId") $ partyTradeIdent_linkId x , concatMap (schemaTypeToXML "allocationTradeId") $ partyTradeIdent_allocationTradeId x , maybe [] (schemaTypeToXML "blockTradeId") $ partyTradeIdent_blockTradeId x , maybe [] (schemaTypeToXML "originatingTradeId") $ partyTradeIdent_originatingTradeId x ] instance Extension PartyTradeIdentifier TradeIdentifier where supertype (PartyTradeIdentifier a0 e0 e1 e2 e3 e4) = TradeIdentifier a0 e0 -- | A type containing multiple partyTradeIdentifier. data PartyTradeIdentifiers = PartyTradeIdentifiers { partyTradeIdent_partyTradeIdentifier :: [PartyTradeIdentifier] } deriving (Eq,Show) instance SchemaType PartyTradeIdentifiers where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PartyTradeIdentifiers `apply` many (parseSchemaType "partyTradeIdentifier") schemaTypeToXML s x@PartyTradeIdentifiers{} = toXMLElement s [] [ concatMap (schemaTypeToXML "partyTradeIdentifier") $ partyTradeIdent_partyTradeIdentifier x ] -- | A type defining additional information that may be recorded -- against a trade. data PartyTradeInformation = PartyTradeInformation { partyTradeInfo_partyReference :: PartyReference -- ^ Reference to a party. , partyTradeInfo_accountReference :: Maybe AccountReference -- ^ Reference to an account. , partyTradeInfo_relatedParty :: [RelatedParty] -- ^ Identifies a related party performing a role within the -- transaction. , partyTradeInfo_reportingRole :: Maybe ReportingRole -- ^ Identifies the role of this party in reporting this trade -- (e.g. originator, counterparty). , partyTradeInfo_relatedBusinessUnit :: [RelatedBusinessUnit] -- ^ Provides information about a unit/division/desk etc. that -- executed or supports this trade , partyTradeInfo_relatedPerson :: [RelatedPerson] -- ^ Provides information about a person that executed or -- supports this trade , partyTradeInfo_isAccountingHedge :: Maybe Xsd.Boolean -- ^ Specifies whether the trade used to hedge a risk for -- accounting purposes for the specified party. (TODO: do we -- need to distinguish between asset and liability hedges?) , partyTradeInfo_category :: [TradeCategory] -- ^ Used to categorize trades into user-defined categories, -- such as house trades vs. customer trades. , partyTradeInfo_executionDateTime :: Maybe ExecutionDateTime -- ^ Trade execution date time provided by a central execution -- facility. , partyTradeInfo_timestamps :: Maybe TradeProcessingTimestamps -- ^ Allows timing information about a trade to be recorded. , partyTradeInfo_intentToAllocate :: Maybe Xsd.Boolean -- ^ Specifies whether the trade is anticipated to be allocated. , partyTradeInfo_allocationStatus :: Maybe AllocationReportingStatus -- ^ Specifies whether the trade is anticipated to be allocated, -- has been allocated, or will not be allocated. , partyTradeInfo_intentToClear :: Maybe Xsd.Boolean -- ^ Specifies whether the trade is anticipated to be cleared -- via a derivative clearing organization , partyTradeInfo_clearingStatus :: Maybe ClearingStatusValue -- ^ Describes the status with respect to clearing (e.g. -- Submitted, Pending, Cleared, RejectedForClearing, etc.) , partyTradeInfo_collateralizationType :: Maybe CollateralizationType -- ^ Specifies whether this party posts collateral. For -- Recordkeeping, the collateralization type refers to -- collateral that is posted by this firm, and One-Way is not -- meaningful. In other words, if the collateralization type -- is Full, this trade is fully collateralized by this party. -- For Transparency view, the options include Full, Partial, -- Uncollateralized, and One-Way. , partyTradeInfo_reportingRegime :: [ReportingRegime] -- ^ Allows the organization to specify which if any relevant -- regulators or other supervisory bodies this is relevant -- for, and what reporting rules apply. , partyTradeInfo_choice16 :: (Maybe (OneOf2 Xsd.Boolean EndUserExceptionDeclaration)) -- ^ Choice between: -- -- (1) Specifies whether the trade is not obligated to be -- cleared via a derivative clearing organization because -- the "End User Exception" was invoked. -- -- (2) Claims an end user exception and provides supporting -- evidence. , partyTradeInfo_nonStandardTerms :: Maybe Xsd.Boolean -- ^ Indicates that the trade has price-affecting -- characteristics in addition to the standard real-time -- reportable terms. The flag indicates that the price for -- this trade is not to be construed as being indicative of -- the market for standardised trades with otherwise identical -- reportable terms. , partyTradeInfo_offMarketPrice :: Maybe Xsd.Boolean -- ^ Indicates that the price does not reflect the current -- market. For example, in a credit trade where the two -- counterparties are not of equal credit standing, there is -- no initial margin and one party pays collateral to the -- other in the form of an add-on to the price (say a price -- that would otherwise be 100 at the market is struck at 105 -- to include the collateral, resulting in a very off-market -- looking price.) , partyTradeInfo_largeSizeTrade :: Maybe Xsd.Boolean -- ^ Specifies whether the sender of this trade considers it to -- be a large notional trade or block trade for reporting -- purposes, and thus eligible for delayed public reporting. -- Normally this will only be applicable for off-facility -- trades. , partyTradeInfo_executionType :: Maybe ExecutionType -- ^ Used to describe how the trade was executed, e.g. via voice -- or electronically. , partyTradeInfo_executionVenueType :: Maybe ExecutionVenueType -- ^ Used to describe the type of venue where trade was -- executed, e.g via an execution facility or privately. , partyTradeInfo_verificationMethod :: Maybe ConfirmationMethod -- ^ Used to describe how the trade was or will be verified, e.g -- via a confirmation facility, via private electronic -- service, or via written documentation. This affect the -- timing of real-time reporting requirements. This field is -- provisional pending detailed confirmation of the data -- requirements, and may not be included in subsequent working -- drafts. , partyTradeInfo_confirmationMethod :: Maybe ConfirmationMethod -- ^ Used to describe how the trade was confirmed, e.g via a -- confirmation facility, via private electronic service, or -- via written documentation. This affects the process flow -- for confirmation messages. This field is provisional -- pending detailed confirmation of the data requirements, and -- may not be included in subsequent working drafts. } deriving (Eq,Show) instance SchemaType PartyTradeInformation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PartyTradeInformation `apply` parseSchemaType "partyReference" `apply` optional (parseSchemaType "accountReference") `apply` many (parseSchemaType "relatedParty") `apply` optional (parseSchemaType "reportingRole") `apply` many (parseSchemaType "relatedBusinessUnit") `apply` many (parseSchemaType "relatedPerson") `apply` optional (parseSchemaType "isAccountingHedge") `apply` many (parseSchemaType "category") `apply` optional (parseSchemaType "executionDateTime") `apply` optional (parseSchemaType "timestamps") `apply` optional (parseSchemaType "intentToAllocate") `apply` optional (parseSchemaType "allocationStatus") `apply` optional (parseSchemaType "intentToClear") `apply` optional (parseSchemaType "clearingStatus") `apply` optional (parseSchemaType "collateralizationType") `apply` many (parseSchemaType "reportingRegime") `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf2 (parseSchemaType "endUserException")) , ("EndUserExceptionDeclaration", fmap TwoOf2 (parseSchemaType "endUserExceptionDeclaration")) ]) `apply` optional (parseSchemaType "nonStandardTerms") `apply` optional (parseSchemaType "offMarketPrice") `apply` optional (parseSchemaType "largeSizeTrade") `apply` optional (parseSchemaType "executionType") `apply` optional (parseSchemaType "executionVenueType") `apply` optional (parseSchemaType "verificationMethod") `apply` optional (parseSchemaType "confirmationMethod") schemaTypeToXML s x@PartyTradeInformation{} = toXMLElement s [] [ schemaTypeToXML "partyReference" $ partyTradeInfo_partyReference x , maybe [] (schemaTypeToXML "accountReference") $ partyTradeInfo_accountReference x , concatMap (schemaTypeToXML "relatedParty") $ partyTradeInfo_relatedParty x , maybe [] (schemaTypeToXML "reportingRole") $ partyTradeInfo_reportingRole x , concatMap (schemaTypeToXML "relatedBusinessUnit") $ partyTradeInfo_relatedBusinessUnit x , concatMap (schemaTypeToXML "relatedPerson") $ partyTradeInfo_relatedPerson x , maybe [] (schemaTypeToXML "isAccountingHedge") $ partyTradeInfo_isAccountingHedge x , concatMap (schemaTypeToXML "category") $ partyTradeInfo_category x , maybe [] (schemaTypeToXML "executionDateTime") $ partyTradeInfo_executionDateTime x , maybe [] (schemaTypeToXML "timestamps") $ partyTradeInfo_timestamps x , maybe [] (schemaTypeToXML "intentToAllocate") $ partyTradeInfo_intentToAllocate x , maybe [] (schemaTypeToXML "allocationStatus") $ partyTradeInfo_allocationStatus x , maybe [] (schemaTypeToXML "intentToClear") $ partyTradeInfo_intentToClear x , maybe [] (schemaTypeToXML "clearingStatus") $ partyTradeInfo_clearingStatus x , maybe [] (schemaTypeToXML "collateralizationType") $ partyTradeInfo_collateralizationType x , concatMap (schemaTypeToXML "reportingRegime") $ partyTradeInfo_reportingRegime x , maybe [] (foldOneOf2 (schemaTypeToXML "endUserException") (schemaTypeToXML "endUserExceptionDeclaration") ) $ partyTradeInfo_choice16 x , maybe [] (schemaTypeToXML "nonStandardTerms") $ partyTradeInfo_nonStandardTerms x , maybe [] (schemaTypeToXML "offMarketPrice") $ partyTradeInfo_offMarketPrice x , maybe [] (schemaTypeToXML "largeSizeTrade") $ partyTradeInfo_largeSizeTrade x , maybe [] (schemaTypeToXML "executionType") $ partyTradeInfo_executionType x , maybe [] (schemaTypeToXML "executionVenueType") $ partyTradeInfo_executionVenueType x , maybe [] (schemaTypeToXML "verificationMethod") $ partyTradeInfo_verificationMethod x , maybe [] (schemaTypeToXML "confirmationMethod") $ partyTradeInfo_confirmationMethod x ] -- | Code that describes what type of allocation applies to the -- trade. Options include Unallocated, ToBeAllocated, -- Allocated. data AllocationReportingStatus = AllocationReportingStatus Scheme AllocationReportingStatusAttributes deriving (Eq,Show) data AllocationReportingStatusAttributes = AllocationReportingStatusAttributes { arsa_allocationReportingStatusScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType AllocationReportingStatus where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "allocationReportingStatusScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ AllocationReportingStatus v (AllocationReportingStatusAttributes a0) schemaTypeToXML s (AllocationReportingStatus bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "allocationReportingStatusScheme") $ arsa_allocationReportingStatusScheme at ] $ schemaTypeToXML s bt instance Extension AllocationReportingStatus Scheme where supertype (AllocationReportingStatus s _) = s -- | The current status value of a clearing request. data ClearingStatusValue = ClearingStatusValue Scheme ClearingStatusValueAttributes deriving (Eq,Show) data ClearingStatusValueAttributes = ClearingStatusValueAttributes { clearStatusValueAttrib_clearingStatusScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ClearingStatusValue where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "clearingStatusScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ClearingStatusValue v (ClearingStatusValueAttributes a0) schemaTypeToXML s (ClearingStatusValue bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "clearingStatusScheme") $ clearStatusValueAttrib_clearingStatusScheme at ] $ schemaTypeToXML s bt instance Extension ClearingStatusValue Scheme where supertype (ClearingStatusValue s _) = s -- | Code that describes what type of collateral is posted by a -- party to a transaction. Options include Uncollateralized, -- Partial, Full, One-Way. data CollateralizationType = CollateralizationType Scheme CollateralizationTypeAttributes deriving (Eq,Show) data CollateralizationTypeAttributes = CollateralizationTypeAttributes { collatTypeAttrib_collateralTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CollateralizationType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "collateralTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CollateralizationType v (CollateralizationTypeAttributes a0) schemaTypeToXML s (CollateralizationType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "collateralTypeScheme") $ collatTypeAttrib_collateralTypeScheme at ] $ schemaTypeToXML s bt instance Extension CollateralizationType Scheme where supertype (CollateralizationType s _) = s -- | Records supporting information justifying an end user -- exception under 17 CFR part 39. data EndUserExceptionDeclaration = EndUserExceptionDeclaration { endUserExceptDeclar_creditDocument :: [CreditDocument] -- ^ What arrangements will be made to provide credit? (e.g. -- CSA, collateral pledge, guaranty, available resources, -- financing). , endUserExceptDeclar_organizationCharacteristic :: [OrganizationCharacteristic] -- ^ Allows the organization to specify which categories or -- characteristics apply to it for end-user exception -- determination. Examples include "FinancialEntity", -- "CaptiveFinanceUnit", "BoardOfDirectorsApproval". , endUserExceptDeclar_transactionCharacteristic :: [TransactionCharacteristic] -- ^ Allows the relevant transaction level categories or -- characteristics to be recorded for end-user exception -- determination. Examples include "BoardOfDirectorsApproval", -- "HedgesCommercialRisk". , endUserExceptDeclar_supervisorRegistration :: [SupervisorRegistration] -- ^ Allows the organization to specify which if any relevant -- regulators it is registered with, and if so their -- identification number. For example, it could specify that -- it is SEC registered and provide its Central Index Key. } deriving (Eq,Show) instance SchemaType EndUserExceptionDeclaration where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return EndUserExceptionDeclaration `apply` many (parseSchemaType "creditDocument") `apply` many (parseSchemaType "organizationCharacteristic") `apply` many (parseSchemaType "transactionCharacteristic") `apply` many (parseSchemaType "supervisorRegistration") schemaTypeToXML s x@EndUserExceptionDeclaration{} = toXMLElement s [] [ concatMap (schemaTypeToXML "creditDocument") $ endUserExceptDeclar_creditDocument x , concatMap (schemaTypeToXML "organizationCharacteristic") $ endUserExceptDeclar_organizationCharacteristic x , concatMap (schemaTypeToXML "transactionCharacteristic") $ endUserExceptDeclar_transactionCharacteristic x , concatMap (schemaTypeToXML "supervisorRegistration") $ endUserExceptDeclar_supervisorRegistration x ] -- | A credit arrangement used in support of swaps trading. data CreditDocument = CreditDocument Scheme CreditDocumentAttributes deriving (Eq,Show) data CreditDocumentAttributes = CreditDocumentAttributes { creditDocumAttrib_creditDocumentScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CreditDocument where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "creditDocumentScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CreditDocument v (CreditDocumentAttributes a0) schemaTypeToXML s (CreditDocument bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "creditDocumentScheme") $ creditDocumAttrib_creditDocumentScheme at ] $ schemaTypeToXML s bt instance Extension CreditDocument Scheme where supertype (CreditDocument s _) = s -- | A characteristic of an organization used in declaring an -- end-user exception. data OrganizationCharacteristic = OrganizationCharacteristic Scheme OrganizationCharacteristicAttributes deriving (Eq,Show) data OrganizationCharacteristicAttributes = OrganizationCharacteristicAttributes { oca_organizationCharacteristicScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType OrganizationCharacteristic where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "organizationCharacteristicScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ OrganizationCharacteristic v (OrganizationCharacteristicAttributes a0) schemaTypeToXML s (OrganizationCharacteristic bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "organizationCharacteristicScheme") $ oca_organizationCharacteristicScheme at ] $ schemaTypeToXML s bt instance Extension OrganizationCharacteristic Scheme where supertype (OrganizationCharacteristic s _) = s -- | A characteristic of a transaction used in declaring an -- end-user exception. data TransactionCharacteristic = TransactionCharacteristic Scheme TransactionCharacteristicAttributes deriving (Eq,Show) data TransactionCharacteristicAttributes = TransactionCharacteristicAttributes { tca_transactionCharacteristicScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType TransactionCharacteristic where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "transactionCharacteristicScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ TransactionCharacteristic v (TransactionCharacteristicAttributes a0) schemaTypeToXML s (TransactionCharacteristic bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "transactionCharacteristicScheme") $ tca_transactionCharacteristicScheme at ] $ schemaTypeToXML s bt instance Extension TransactionCharacteristic Scheme where supertype (TransactionCharacteristic s _) = s -- | A value that explains the reason or purpose that -- information is being reported. Examples might include -- RealTimePublic reporting, PrimaryEconomicTerms reporting, -- Confirmation reporting, or Snapshot reporting. data ReportingPurpose = ReportingPurpose Scheme ReportingPurposeAttributes deriving (Eq,Show) data ReportingPurposeAttributes = ReportingPurposeAttributes { reportPurposeAttrib_reportingPurposeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ReportingPurpose where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "reportingPurposeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ReportingPurpose v (ReportingPurposeAttributes a0) schemaTypeToXML s (ReportingPurpose bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "reportingPurposeScheme") $ reportPurposeAttrib_reportingPurposeScheme at ] $ schemaTypeToXML s bt instance Extension ReportingPurpose Scheme where supertype (ReportingPurpose s _) = s -- | Provides information about a regulator or other supervisory -- body that an organization is registered with. data SupervisorRegistration = SupervisorRegistration { supervRegist_supervisoryBody :: SupervisoryBody -- ^ The regulator or other supervisory body the organization is -- registered with (e.g. SEC). , supervRegist_registrationNumber :: Maybe RegulatorId -- ^ The ID assigned by the regulator (e.g. SEC's Central Index -- Key). } deriving (Eq,Show) instance SchemaType SupervisorRegistration where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return SupervisorRegistration `apply` parseSchemaType "supervisoryBody" `apply` optional (parseSchemaType "registrationNumber") schemaTypeToXML s x@SupervisorRegistration{} = toXMLElement s [] [ schemaTypeToXML "supervisoryBody" $ supervRegist_supervisoryBody x , maybe [] (schemaTypeToXML "registrationNumber") $ supervRegist_registrationNumber x ] -- | Provides information about how the information in this -- message is applicable to a regulatory reporting process. data ReportingRegime = ReportingRegime { reportRegime_choice0 :: OneOf2 (ReportingRegimeName,[SupervisorRegistration]) [SupervisorRegistration] -- ^ Choice between: -- -- (1) Sequence of: -- -- * Identifies the reporting regime under which this -- data is reported. For example, Dodd-Frank, MiFID, -- HongKongOTCDRepository, ODRF -- -- * Identifies the specific regulator or other -- supervisory body for which this data is produced. -- For example, CFTC, SEC, UKFSA, ODRF, SFC, ESMA. -- -- (2) Identifies the specific regulator or other supervisory -- body for which this data is produced. For example, -- CFTC, SEC, UKFSA, ODRF, SFC, ESMA. , reportRegime_reportingRole :: Maybe ReportingRole -- ^ Identifies the role of this party in reporting this trade -- for this regulator; roles could include ReportingParty and -- Voluntary reporting. , reportRegime_reportingPurpose :: [ReportingPurpose] -- ^ The reason this message is being sent, for example -- Snapshot, PET, Confirmation, RealTimePublic. , reportRegime_mandatorilyClearable :: Maybe Xsd.Boolean -- ^ Whether the particular trade type in question is required -- by this regulator to be cleared. } deriving (Eq,Show) instance SchemaType ReportingRegime where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ReportingRegime `apply` oneOf' [ ("ReportingRegimeName [SupervisorRegistration]", fmap OneOf2 (return (,) `apply` parseSchemaType "name" `apply` many (parseSchemaType "supervisorRegistration"))) , ("[SupervisorRegistration]", fmap TwoOf2 (many1 (parseSchemaType "supervisorRegistration"))) ] `apply` optional (parseSchemaType "reportingRole") `apply` many (parseSchemaType "reportingPurpose") `apply` optional (parseSchemaType "mandatorilyClearable") schemaTypeToXML s x@ReportingRegime{} = toXMLElement s [] [ foldOneOf2 (\ (a,b) -> concat [ schemaTypeToXML "name" a , concatMap (schemaTypeToXML "supervisorRegistration") b ]) (concatMap (schemaTypeToXML "supervisorRegistration")) $ reportRegime_choice0 x , maybe [] (schemaTypeToXML "reportingRole") $ reportRegime_reportingRole x , concatMap (schemaTypeToXML "reportingPurpose") $ reportRegime_reportingPurpose x , maybe [] (schemaTypeToXML "mandatorilyClearable") $ reportRegime_mandatorilyClearable x ] -- | An ID assigned by a regulator to an organization registered -- with it. (NOTE: should this just by represented by an -- alternate party ID?) data RegulatorId = RegulatorId Scheme RegulatorIdAttributes deriving (Eq,Show) data RegulatorIdAttributes = RegulatorIdAttributes { regulIdAttrib_regulatorIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType RegulatorId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "regulatorIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ RegulatorId v (RegulatorIdAttributes a0) schemaTypeToXML s (RegulatorId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "regulatorIdScheme") $ regulIdAttrib_regulatorIdScheme at ] $ schemaTypeToXML s bt instance Extension RegulatorId Scheme where supertype (RegulatorId s _) = s -- | Allows timing information about when a trade was processed -- and reported to be recorded. data TradeProcessingTimestamps = TradeProcessingTimestamps { tradeProcesTimest_orderEntered :: Maybe Xsd.DateTime -- ^ When an order was first generated, as recorded for the -- first time when it was first entered by a person or -- generated by a trading algorithm (i.e., the first record of -- the order). , tradeProcesTimest_orderSubmitted :: Maybe Xsd.DateTime -- ^ The time when an order is submitted by a market participant -- to an execution facility, as recorded based on the -- timestamp of the message that was sent by the participant. -- If the participant records this time (i.e. it is in the -- participant's party trade information), it will be the time -- the message was sent. If the execution facility records -- this time (i.e. it is in the facility's party trade -- information), it will be the time the message was received. , tradeProcesTimest_publiclyReported :: Maybe Xsd.DateTime -- ^ When the public report of this was created or received by -- this party. If the participant records this time (i.e. it -- is in the participant's party trade information), it will -- be the time the message was sent. If the execution records -- this time (i.e. it is in the facility's party trade -- information), it will be the time the message was received. , tradeProcesTimest_publicReportUpdated :: Maybe Xsd.DateTime -- ^ When the public report of this was most recently corrected -- or corrections were sent or received by this party. , tradeProcesTimest_nonpubliclyReported :: Maybe Xsd.DateTime -- ^ When the non-public report of this was created or received -- by this party. , tradeProcesTimest_nonpublicReportUpdated :: Maybe Xsd.DateTime -- ^ When the non-public report of this was most recently -- corrected or corrections were received by this party. , tradeProcesTimest_submittedForConfirmation :: Maybe Xsd.DateTime -- ^ When this trade was supplied to a confirmation service or -- counterparty for confirmation. , tradeProcesTimest_updatedForConfirmation :: Maybe Xsd.DateTime -- ^ When the most recent correction to this trade was supplied -- to a confirmation service or counterparty for confirmation. , tradeProcesTimest_confirmed :: Maybe Xsd.DateTime -- ^ When this trade was confirmed. , tradeProcesTimest_submittedForClearing :: Maybe Xsd.DateTime -- ^ When this trade was supplied to a clearing service for -- clearing. , tradeProcesTimest_updatedForClearing :: Maybe Xsd.DateTime -- ^ When the most recent correction to this trade was supplied -- to a clearing service for clearing. , tradeProcesTimest_cleared :: Maybe Xsd.DateTime -- ^ When this trade was cleared. , tradeProcesTimest_allocationsSubmitted :: Maybe Xsd.DateTime -- ^ When allocations for this trade were submitted or received -- by this party. , tradeProcesTimest_allocationsUpdated :: Maybe Xsd.DateTime -- ^ When allocations for this trade were most recently -- corrected. , tradeProcesTimest_allocationsCompleted :: Maybe Xsd.DateTime -- ^ When allocations for this trade were completely processed. , tradeProcesTimest_timestamp :: [TradeTimestamp] -- ^ Other timestamps for this trade. This is provisional in -- Recordkeeping and Transparency view and may be reviewed in -- a subsequent draft. } deriving (Eq,Show) instance SchemaType TradeProcessingTimestamps where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeProcessingTimestamps `apply` optional (parseSchemaType "orderEntered") `apply` optional (parseSchemaType "orderSubmitted") `apply` optional (parseSchemaType "publiclyReported") `apply` optional (parseSchemaType "publicReportUpdated") `apply` optional (parseSchemaType "nonpubliclyReported") `apply` optional (parseSchemaType "nonpublicReportUpdated") `apply` optional (parseSchemaType "submittedForConfirmation") `apply` optional (parseSchemaType "updatedForConfirmation") `apply` optional (parseSchemaType "confirmed") `apply` optional (parseSchemaType "submittedForClearing") `apply` optional (parseSchemaType "updatedForClearing") `apply` optional (parseSchemaType "cleared") `apply` optional (parseSchemaType "allocationsSubmitted") `apply` optional (parseSchemaType "allocationsUpdated") `apply` optional (parseSchemaType "allocationsCompleted") `apply` many (parseSchemaType "timestamp") schemaTypeToXML s x@TradeProcessingTimestamps{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "orderEntered") $ tradeProcesTimest_orderEntered x , maybe [] (schemaTypeToXML "orderSubmitted") $ tradeProcesTimest_orderSubmitted x , maybe [] (schemaTypeToXML "publiclyReported") $ tradeProcesTimest_publiclyReported x , maybe [] (schemaTypeToXML "publicReportUpdated") $ tradeProcesTimest_publicReportUpdated x , maybe [] (schemaTypeToXML "nonpubliclyReported") $ tradeProcesTimest_nonpubliclyReported x , maybe [] (schemaTypeToXML "nonpublicReportUpdated") $ tradeProcesTimest_nonpublicReportUpdated x , maybe [] (schemaTypeToXML "submittedForConfirmation") $ tradeProcesTimest_submittedForConfirmation x , maybe [] (schemaTypeToXML "updatedForConfirmation") $ tradeProcesTimest_updatedForConfirmation x , maybe [] (schemaTypeToXML "confirmed") $ tradeProcesTimest_confirmed x , maybe [] (schemaTypeToXML "submittedForClearing") $ tradeProcesTimest_submittedForClearing x , maybe [] (schemaTypeToXML "updatedForClearing") $ tradeProcesTimest_updatedForClearing x , maybe [] (schemaTypeToXML "cleared") $ tradeProcesTimest_cleared x , maybe [] (schemaTypeToXML "allocationsSubmitted") $ tradeProcesTimest_allocationsSubmitted x , maybe [] (schemaTypeToXML "allocationsUpdated") $ tradeProcesTimest_allocationsUpdated x , maybe [] (schemaTypeToXML "allocationsCompleted") $ tradeProcesTimest_allocationsCompleted x , concatMap (schemaTypeToXML "timestamp") $ tradeProcesTimest_timestamp x ] -- | A generic trade timestamp data TradeTimestamp = TradeTimestamp { tradeTimest_type :: Maybe TimestampTypeScheme , tradeTimest_value :: Maybe Xsd.DateTime } deriving (Eq,Show) instance SchemaType TradeTimestamp where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeTimestamp `apply` optional (parseSchemaType "type") `apply` optional (parseSchemaType "value") schemaTypeToXML s x@TradeTimestamp{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "type") $ tradeTimest_type x , maybe [] (schemaTypeToXML "value") $ tradeTimest_value x ] -- | The type or meaning of a timestamp. data TimestampTypeScheme = TimestampTypeScheme Scheme TimestampTypeSchemeAttributes deriving (Eq,Show) data TimestampTypeSchemeAttributes = TimestampTypeSchemeAttributes { timestTypeSchemeAttrib_timestampScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType TimestampTypeScheme where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "timestampScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ TimestampTypeScheme v (TimestampTypeSchemeAttributes a0) schemaTypeToXML s (TimestampTypeScheme bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "timestampScheme") $ timestTypeSchemeAttrib_timestampScheme at ] $ schemaTypeToXML s bt instance Extension TimestampTypeScheme Scheme where supertype (TimestampTypeScheme s _) = s -- | An identifier of an reporting regime or format used for -- regulatory reporting, for example DoddFrankAct, MiFID, -- HongKongOTCDRepository, etc. data ReportingRegimeName = ReportingRegimeName Scheme ReportingRegimeNameAttributes deriving (Eq,Show) data ReportingRegimeNameAttributes = ReportingRegimeNameAttributes { reportRegimeNameAttrib_reportingRegimeNameScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ReportingRegimeName where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "reportingRegimeNameScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ReportingRegimeName v (ReportingRegimeNameAttributes a0) schemaTypeToXML s (ReportingRegimeName bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "reportingRegimeNameScheme") $ reportRegimeNameAttrib_reportingRegimeNameScheme at ] $ schemaTypeToXML s bt instance Extension ReportingRegimeName Scheme where supertype (ReportingRegimeName s _) = s -- | An identifier of an organization that supervises or -- regulates trading activity, e.g. CFTC, SEC, FSA, ODRF, etc. data SupervisoryBody = SupervisoryBody Scheme SupervisoryBodyAttributes deriving (Eq,Show) data SupervisoryBodyAttributes = SupervisoryBodyAttributes { supervBodyAttrib_supervisoryBodyScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType SupervisoryBody where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "supervisoryBodyScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ SupervisoryBody v (SupervisoryBodyAttributes a0) schemaTypeToXML s (SupervisoryBody bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "supervisoryBodyScheme") $ supervBodyAttrib_supervisoryBodyScheme at ] $ schemaTypeToXML s bt instance Extension SupervisoryBody Scheme where supertype (SupervisoryBody s _) = s -- | A type used to represent the type of market where a trade -- can be executed. data ExecutionVenueType = ExecutionVenueType Scheme ExecutionVenueTypeAttributes deriving (Eq,Show) data ExecutionVenueTypeAttributes = ExecutionVenueTypeAttributes { executVenueTypeAttrib_executionVenueTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ExecutionVenueType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "executionVenueTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ExecutionVenueType v (ExecutionVenueTypeAttributes a0) schemaTypeToXML s (ExecutionVenueType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "executionVenueTypeScheme") $ executVenueTypeAttrib_executionVenueTypeScheme at ] $ schemaTypeToXML s bt instance Extension ExecutionVenueType Scheme where supertype (ExecutionVenueType s _) = s -- | A type used to represent the type of market where a trade -- can be executed. data ExecutionType = ExecutionType Scheme ExecutionTypeAttributes deriving (Eq,Show) data ExecutionTypeAttributes = ExecutionTypeAttributes { executTypeAttrib_executionTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ExecutionType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "executionTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ExecutionType v (ExecutionTypeAttributes a0) schemaTypeToXML s (ExecutionType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "executionTypeScheme") $ executTypeAttrib_executionTypeScheme at ] $ schemaTypeToXML s bt instance Extension ExecutionType Scheme where supertype (ExecutionType s _) = s -- | A type used to represent the type of mechanism that can be -- used to confirm a trade. data ConfirmationMethod = ConfirmationMethod Scheme ConfirmationMethodAttributes deriving (Eq,Show) data ConfirmationMethodAttributes = ConfirmationMethodAttributes { confirMethodAttrib_confirmationMethodScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ConfirmationMethod where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "confirmationMethodScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ConfirmationMethod v (ConfirmationMethodAttributes a0) schemaTypeToXML s (ConfirmationMethod bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "confirmationMethodScheme") $ confirMethodAttrib_confirmationMethodScheme at ] $ schemaTypeToXML s bt instance Extension ConfirmationMethod Scheme where supertype (ConfirmationMethod s _) = s data PaymentDetail = PaymentDetail { paymentDetail_ID :: Maybe Xsd.ID , paymentDetail_paymentDate :: Maybe AdjustableOrRelativeDate -- ^ Payment date. , paymentDetail_paymentRule :: Maybe PaymentRule -- ^ A type defining the calculation rule. , paymentDetail_paymentAmount :: Maybe Money -- ^ A fixed payment amount. } deriving (Eq,Show) instance SchemaType PaymentDetail where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (PaymentDetail a0) `apply` optional (parseSchemaType "paymentDate") `apply` optional (parseSchemaType "paymentRule") `apply` optional (parseSchemaType "paymentAmount") schemaTypeToXML s x@PaymentDetail{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ paymentDetail_ID x ] [ maybe [] (schemaTypeToXML "paymentDate") $ paymentDetail_paymentDate x , maybe [] (schemaTypeToXML "paymentRule") $ paymentDetail_paymentRule x , maybe [] (schemaTypeToXML "paymentAmount") $ paymentDetail_paymentAmount x ] instance Extension PaymentDetail PaymentBase where supertype v = PaymentBase_PaymentDetail v -- | The abstract base type from which all calculation rules of -- the independent amount must be derived. data PaymentRule = PaymentRule_PercentageRule PercentageRule deriving (Eq,Show) instance SchemaType PaymentRule where parseSchemaType s = do (fmap PaymentRule_PercentageRule $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of PaymentRule,\n\ \ namely one of:\n\ \PercentageRule" schemaTypeToXML _s (PaymentRule_PercentageRule x) = schemaTypeToXML "percentageRule" x -- | A type defining a content model for a calculation rule -- defined as percentage of the notional amount. data PercentageRule = PercentageRule { percenRule_paymentPercent :: Maybe Xsd.Decimal -- ^ A percentage of the notional amount. , percenRule_notionalAmountReference :: Maybe NotionalAmountReference -- ^ A reference to the notional amount. } deriving (Eq,Show) instance SchemaType PercentageRule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PercentageRule `apply` optional (parseSchemaType "paymentPercent") `apply` optional (parseSchemaType "notionalAmountReference") schemaTypeToXML s x@PercentageRule{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "paymentPercent") $ percenRule_paymentPercent x , maybe [] (schemaTypeToXML "notionalAmountReference") $ percenRule_notionalAmountReference x ] instance Extension PercentageRule PaymentRule where supertype v = PaymentRule_PercentageRule v -- | A type representing an arbitary grouping of trade -- references. data Portfolio = Portfolio { portfolio_ID :: Maybe Xsd.ID , portfolio_partyPortfolioName :: Maybe PartyPortfolioName -- ^ The name of the portfolio together with the party that gave -- the name. , portfolio_choice1 :: (Maybe (OneOf2 [TradeId] [PartyTradeIdentifier])) -- ^ Choice between: -- -- (1) tradeId -- -- (2) partyTradeIdentifier , portfolio :: [Portfolio] -- ^ An arbitary grouping of trade references (and possibly -- other portfolios). } deriving (Eq,Show) instance SchemaType Portfolio where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Portfolio a0) `apply` optional (parseSchemaType "partyPortfolioName") `apply` optional (oneOf' [ ("[TradeId]", fmap OneOf2 (many1 (parseSchemaType "tradeId"))) , ("[PartyTradeIdentifier]", fmap TwoOf2 (many1 (parseSchemaType "partyTradeIdentifier"))) ]) `apply` many (parseSchemaType "portfolio") schemaTypeToXML s x@Portfolio{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ portfolio_ID x ] [ maybe [] (schemaTypeToXML "partyPortfolioName") $ portfolio_partyPortfolioName x , maybe [] (foldOneOf2 (concatMap (schemaTypeToXML "tradeId")) (concatMap (schemaTypeToXML "partyTradeIdentifier")) ) $ portfolio_choice1 x , concatMap (schemaTypeToXML "portfolio") $ portfolio x ] -- | The data type used for portfolio names. data PortfolioName = PortfolioName Scheme PortfolioNameAttributes deriving (Eq,Show) data PortfolioNameAttributes = PortfolioNameAttributes { portfNameAttrib_ID :: Maybe Xsd.ID , portfNameAttrib_portfolioNameScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType PortfolioName where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "id" e pos a1 <- optional $ getAttribute "portfolioNameScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ PortfolioName v (PortfolioNameAttributes a0 a1) schemaTypeToXML s (PortfolioName bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "id") $ portfNameAttrib_ID at , maybe [] (toXMLAttribute "portfolioNameScheme") $ portfNameAttrib_portfolioNameScheme at ] $ schemaTypeToXML s bt instance Extension PortfolioName Scheme where supertype (PortfolioName s _) = s -- | A type representing criteria for defining a query -- portfolio. The criteria are made up of a QueryParameterId, -- QueryParameterValue and QueryParameterOperator. data QueryParameter = QueryParameter { queryParameter_id :: Maybe QueryParameterId , queryParameter_value :: Maybe Xsd.NormalizedString , queryParameter_operator :: Maybe QueryParameterOperator } deriving (Eq,Show) instance SchemaType QueryParameter where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return QueryParameter `apply` optional (parseSchemaType "queryParameterId") `apply` optional (parseSchemaType "queryParameterValue") `apply` optional (parseSchemaType "queryParameterOperator") schemaTypeToXML s x@QueryParameter{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "queryParameterId") $ queryParameter_id x , maybe [] (schemaTypeToXML "queryParameterValue") $ queryParameter_value x , maybe [] (schemaTypeToXML "queryParameterOperator") $ queryParameter_operator x ] -- | A type representing an identifier for a parameter -- describing a query portfolio. An identifier can be anything -- from a product name like swap to a termination date. data QueryParameterId = QueryParameterId Scheme QueryParameterIdAttributes deriving (Eq,Show) data QueryParameterIdAttributes = QueryParameterIdAttributes { queryParamIdAttrib_queryParameterIdScheme :: Xsd.AnyURI , queryParamIdAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType QueryParameterId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- getAttribute "queryParameterIdScheme" e pos a1 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ QueryParameterId v (QueryParameterIdAttributes a0 a1) schemaTypeToXML s (QueryParameterId bt at) = addXMLAttributes [ toXMLAttribute "queryParameterIdScheme" $ queryParamIdAttrib_queryParameterIdScheme at , maybe [] (toXMLAttribute "id") $ queryParamIdAttrib_ID at ] $ schemaTypeToXML s bt instance Extension QueryParameterId Scheme where supertype (QueryParameterId s _) = s -- | A type representing an operator describing the relationship -- of a value to its corresponding identifier for a parameter -- describing a query portfolio. Possible relationships -- include equals, not equals, less than, greater than. -- Possible operators are listed in the -- queryParameterOperatorScheme. data QueryParameterOperator = QueryParameterOperator Scheme QueryParameterOperatorAttributes deriving (Eq,Show) data QueryParameterOperatorAttributes = QueryParameterOperatorAttributes { queryParamOperatAttrib_queryParameterOperatorScheme :: Maybe Xsd.AnyURI , queryParamOperatAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType QueryParameterOperator where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "queryParameterOperatorScheme" e pos a1 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ QueryParameterOperator v (QueryParameterOperatorAttributes a0 a1) schemaTypeToXML s (QueryParameterOperator bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "queryParameterOperatorScheme") $ queryParamOperatAttrib_queryParameterOperatorScheme at , maybe [] (toXMLAttribute "id") $ queryParamOperatAttrib_ID at ] $ schemaTypeToXML s bt instance Extension QueryParameterOperator Scheme where supertype (QueryParameterOperator s _) = s -- | A type representing a portfolio obtained by querying the -- set of trades held in a repository. It contains trades -- matching the intersection of all criteria specified using -- one or more queryParameters or trades matching the union of -- two or more child queryPortfolios. data QueryPortfolio = QueryPortfolio { queryPortf_ID :: Maybe Xsd.ID , queryPortf_partyPortfolioName :: Maybe PartyPortfolioName -- ^ The name of the portfolio together with the party that gave -- the name. , queryPortf_choice1 :: (Maybe (OneOf2 [TradeId] [PartyTradeIdentifier])) -- ^ Choice between: -- -- (1) tradeId -- -- (2) partyTradeIdentifier , queryPortf_portfolio :: [Portfolio] -- ^ An arbitary grouping of trade references (and possibly -- other portfolios). , queryPortf_queryParameter :: [QueryParameter] } deriving (Eq,Show) instance SchemaType QueryPortfolio where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (QueryPortfolio a0) `apply` optional (parseSchemaType "partyPortfolioName") `apply` optional (oneOf' [ ("[TradeId]", fmap OneOf2 (many1 (parseSchemaType "tradeId"))) , ("[PartyTradeIdentifier]", fmap TwoOf2 (many1 (parseSchemaType "partyTradeIdentifier"))) ]) `apply` many (parseSchemaType "portfolio") `apply` many (parseSchemaType "queryParameter") schemaTypeToXML s x@QueryPortfolio{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ queryPortf_ID x ] [ maybe [] (schemaTypeToXML "partyPortfolioName") $ queryPortf_partyPortfolioName x , maybe [] (foldOneOf2 (concatMap (schemaTypeToXML "tradeId")) (concatMap (schemaTypeToXML "partyTradeIdentifier")) ) $ queryPortf_choice1 x , concatMap (schemaTypeToXML "portfolio") $ queryPortf_portfolio x , concatMap (schemaTypeToXML "queryParameter") $ queryPortf_queryParameter x ] instance Extension QueryPortfolio Portfolio where supertype (QueryPortfolio a0 e0 e1 e2 e3) = Portfolio a0 e0 e1 e2 -- | A type containing a code representing the role of a party -- in a report, e.g. the originator, the recipient, the -- counterparty, etc. This is used to clarify which -- participant's information is being reported. data ReportingRole = ReportingRole Scheme ReportingRoleAttributes deriving (Eq,Show) data ReportingRoleAttributes = ReportingRoleAttributes { reportRoleAttrib_reportingRoleScheme :: Maybe Xsd.AnyURI , reportRoleAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType ReportingRole where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "reportingRoleScheme" e pos a1 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ReportingRole v (ReportingRoleAttributes a0 a1) schemaTypeToXML s (ReportingRole bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "reportingRoleScheme") $ reportRoleAttrib_reportingRoleScheme at , maybe [] (toXMLAttribute "id") $ reportRoleAttrib_ID at ] $ schemaTypeToXML s bt instance Extension ReportingRole Scheme where supertype (ReportingRole s _) = s -- | A type defining a group of products making up a single -- trade. data Strategy = Strategy { strategy_ID :: Maybe Xsd.ID , strategy_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. , strategy_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , strategy_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , strategy_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. , strategy_premiumProductReference :: Maybe ProductReference -- ^ Indicates which product within a strategy represents the -- premium payment. , strategy_product :: [Product] -- ^ An abstract element used as a place holder for the -- substituting product elements. } deriving (Eq,Show) instance SchemaType Strategy where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Strategy a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` optional (parseSchemaType "premiumProductReference") `apply` many (elementProduct) schemaTypeToXML s x@Strategy{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ strategy_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ strategy_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ strategy_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ strategy_productType x , concatMap (schemaTypeToXML "productId") $ strategy_productId x , maybe [] (schemaTypeToXML "premiumProductReference") $ strategy_premiumProductReference x , concatMap (elementToXMLProduct) $ strategy_product x ] instance Extension Strategy Product where supertype v = Product_Strategy v -- | A type defining an FpML trade. data Trade = Trade { trade_ID :: Maybe Xsd.ID , trade_header :: Maybe TradeHeader -- ^ The information on the trade which is not product specific, -- e.g. trade date. , trade_product :: Maybe Product -- ^ An abstract element used as a place holder for the -- substituting product elements. , trade_otherPartyPayment :: [Payment] -- ^ Other fees or additional payments associated with the -- trade, e.g. broker commissions, where one or more of the -- parties involved are not principal parties involved in the -- trade. , trade_brokerPartyReference :: [PartyReference] -- ^ Identifies that party (or parties) that brokered this -- trade. , trade_calculationAgent :: Maybe CalculationAgent -- ^ The ISDA calculation agent responsible for performing -- duties as defined in the applicable product definitions. , trade_calculationAgentBusinessCenter :: Maybe BusinessCenter -- ^ The city in which the office through which ISDA Calculation -- Agent is acting for purposes of the transaction is located -- The short-form confirm for a trade that is executed under a -- Sovereign or Asia Pacific Master Confirmation Agreement ( -- MCA ), does not need to specify the Calculation Agent. -- However, the confirm does need to specify the Calculation -- Agent City. This is due to the fact that the MCA sets the -- value for Calculation Agent but does not set the value for -- Calculation Agent City. , trade_determiningParty :: [PartyReference] -- ^ The party referenced is the ISDA Determination Party that -- specified in the related Confirmation as Determination -- Party. , trade_hedgingParty :: [PartyReference] -- ^ The party referenced is the ISDA Hedging Party that -- specified in the related Confirmation as Hedging, or if no -- Hedging Party is specified, either party to the -- Transaction. , trade_collateral :: Maybe Collateral -- ^ Defines collateral obiligations of a Party , trade_documentation :: Maybe Documentation -- ^ Defines the definitions that govern the document and should -- include the year and type of definitions referenced, along -- with any relevant documentation (such as master agreement) -- and the date it was signed. , trade_governingLaw :: Maybe GoverningLaw -- ^ Identification of the law governing the transaction. , trade_allocations :: Maybe Allocations -- ^ "Short-form" representation of allocations in which the key -- block economics are stated once within the trade structure, -- and the allocation data is contained in this allocations -- structure. } deriving (Eq,Show) instance SchemaType Trade where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Trade a0) `apply` optional (parseSchemaType "tradeHeader") `apply` optional (elementProduct) `apply` many (parseSchemaType "otherPartyPayment") `apply` many (parseSchemaType "brokerPartyReference") `apply` optional (parseSchemaType "calculationAgent") `apply` optional (parseSchemaType "calculationAgentBusinessCenter") `apply` between (Occurs (Just 0) (Just 2)) (parseSchemaType "determiningParty") `apply` between (Occurs (Just 0) (Just 2)) (parseSchemaType "hedgingParty") `apply` optional (parseSchemaType "collateral") `apply` optional (parseSchemaType "documentation") `apply` optional (parseSchemaType "governingLaw") `apply` optional (parseSchemaType "allocations") schemaTypeToXML s x@Trade{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ trade_ID x ] [ maybe [] (schemaTypeToXML "tradeHeader") $ trade_header x , maybe [] (elementToXMLProduct) $ trade_product x , concatMap (schemaTypeToXML "otherPartyPayment") $ trade_otherPartyPayment x , concatMap (schemaTypeToXML "brokerPartyReference") $ trade_brokerPartyReference x , maybe [] (schemaTypeToXML "calculationAgent") $ trade_calculationAgent x , maybe [] (schemaTypeToXML "calculationAgentBusinessCenter") $ trade_calculationAgentBusinessCenter x , concatMap (schemaTypeToXML "determiningParty") $ trade_determiningParty x , concatMap (schemaTypeToXML "hedgingParty") $ trade_hedgingParty x , maybe [] (schemaTypeToXML "collateral") $ trade_collateral x , maybe [] (schemaTypeToXML "documentation") $ trade_documentation x , maybe [] (schemaTypeToXML "governingLaw") $ trade_governingLaw x , maybe [] (schemaTypeToXML "allocations") $ trade_allocations x ] -- | A scheme used to categorize positions. data TradeCategory = TradeCategory Scheme TradeCategoryAttributes deriving (Eq,Show) data TradeCategoryAttributes = TradeCategoryAttributes { tradeCategAttrib_categoryScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType TradeCategory where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "categoryScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ TradeCategory v (TradeCategoryAttributes a0) schemaTypeToXML s (TradeCategory bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "categoryScheme") $ tradeCategAttrib_categoryScheme at ] $ schemaTypeToXML s bt instance Extension TradeCategory Scheme where supertype (TradeCategory s _) = s -- | A type used to record the details of a difference between -- two business objects/ data TradeDifference = TradeDifference { tradeDiffer_differenceType :: Maybe DifferenceTypeEnum -- ^ The type of difference that exists. , tradeDiffer_differenceSeverity :: Maybe DifferenceSeverityEnum -- ^ An indication of the severity of the difference. , tradeDiffer_element :: Maybe Xsd.XsdString -- ^ The name of the element affected. , tradeDiffer_basePath :: Maybe Xsd.XsdString -- ^ XPath to the element in the base object. , tradeDiffer_baseValue :: Maybe Xsd.XsdString -- ^ The value of the element in the base object. , tradeDiffer_otherPath :: Maybe Xsd.XsdString -- ^ XPath to the element in the other object. , tradeDiffer_otherValue :: Maybe Xsd.XsdString -- ^ Value of the element in the other trade. , tradeDiffer_missingElement :: [Xsd.XsdString] -- ^ Element(s) that are missing in the other trade. , tradeDiffer_extraElement :: [Xsd.XsdString] -- ^ Element(s) that are extraneous in the other object. , tradeDiffer_message :: Maybe Xsd.XsdString -- ^ A human readable description of the problem. } deriving (Eq,Show) instance SchemaType TradeDifference where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeDifference `apply` optional (parseSchemaType "differenceType") `apply` optional (parseSchemaType "differenceSeverity") `apply` optional (parseSchemaType "element") `apply` optional (parseSchemaType "basePath") `apply` optional (parseSchemaType "baseValue") `apply` optional (parseSchemaType "otherPath") `apply` optional (parseSchemaType "otherValue") `apply` many (parseSchemaType "missingElement") `apply` many (parseSchemaType "extraElement") `apply` optional (parseSchemaType "message") schemaTypeToXML s x@TradeDifference{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "differenceType") $ tradeDiffer_differenceType x , maybe [] (schemaTypeToXML "differenceSeverity") $ tradeDiffer_differenceSeverity x , maybe [] (schemaTypeToXML "element") $ tradeDiffer_element x , maybe [] (schemaTypeToXML "basePath") $ tradeDiffer_basePath x , maybe [] (schemaTypeToXML "baseValue") $ tradeDiffer_baseValue x , maybe [] (schemaTypeToXML "otherPath") $ tradeDiffer_otherPath x , maybe [] (schemaTypeToXML "otherValue") $ tradeDiffer_otherValue x , concatMap (schemaTypeToXML "missingElement") $ tradeDiffer_missingElement x , concatMap (schemaTypeToXML "extraElement") $ tradeDiffer_extraElement x , maybe [] (schemaTypeToXML "message") $ tradeDiffer_message x ] -- | A type defining trade related information which is not -- product specific. data TradeHeader = TradeHeader { tradeHeader_partyTradeIdentifier :: [PartyTradeIdentifier] -- ^ The trade reference identifier(s) allocated to the trade by -- the parties involved. , tradeHeader_partyTradeInformation :: [PartyTradeInformation] -- ^ Additional trade information that may be provided by each -- involved party. , tradeHeader_tradeDate :: Maybe IdentifiedDate -- ^ The trade date. This is the date the trade was originally -- executed. In the case of a novation, the novated part of -- the trade should be reported (by both the remaining party -- and the transferee) using a trade date corresponding to the -- date the novation was agreed. The remaining part of a trade -- should be reported (by both the transferor and the -- remaining party) using a trade date corresponding to the -- original execution date. , tradeHeader_clearedDate :: Maybe IdentifiedDate -- ^ If the trade was cleared (novated) through a central -- counterparty clearing service, this represents the date the -- trade was cleared (transferred to the central -- counterparty). } deriving (Eq,Show) instance SchemaType TradeHeader where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeHeader `apply` many1 (parseSchemaType "partyTradeIdentifier") `apply` many1 (parseSchemaType "partyTradeInformation") `apply` optional (parseSchemaType "tradeDate") `apply` optional (parseSchemaType "clearedDate") schemaTypeToXML s x@TradeHeader{} = toXMLElement s [] [ concatMap (schemaTypeToXML "partyTradeIdentifier") $ tradeHeader_partyTradeIdentifier x , concatMap (schemaTypeToXML "partyTradeInformation") $ tradeHeader_partyTradeInformation x , maybe [] (schemaTypeToXML "tradeDate") $ tradeHeader_tradeDate x , maybe [] (schemaTypeToXML "clearedDate") $ tradeHeader_clearedDate x ] -- | A trade reference identifier allocated by a party. 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. data TradeId = TradeId Scheme TradeIdAttributes deriving (Eq,Show) data TradeIdAttributes = TradeIdAttributes { tradeIdAttrib_tradeIdScheme :: Maybe Xsd.AnyURI , tradeIdAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType TradeId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "tradeIdScheme" e pos a1 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ TradeId v (TradeIdAttributes a0 a1) schemaTypeToXML s (TradeId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "tradeIdScheme") $ tradeIdAttrib_tradeIdScheme at , maybe [] (toXMLAttribute "id") $ tradeIdAttrib_ID at ] $ schemaTypeToXML s bt instance Extension TradeId Scheme where supertype (TradeId s _) = s -- | A type defining a trade identifier issued by the indicated -- party. data TradeIdentifier = TradeIdentifier { tradeIdent_ID :: Maybe Xsd.ID , tradeIdent_choice0 :: OneOf2 (IssuerId,TradeId) (PartyReference,(Maybe (AccountReference)),([OneOf2 TradeId VersionedTradeId])) -- ^ Choice between: -- -- (1) Sequence of: -- -- * issuer -- -- * tradeId -- -- (2) Sequence of: -- -- * Reference to a party. -- -- * Reference to an account. -- -- * unknown } deriving (Eq,Show) instance SchemaType TradeIdentifier where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (TradeIdentifier a0) `apply` oneOf' [ ("IssuerId TradeId", fmap OneOf2 (return (,) `apply` parseSchemaType "issuer" `apply` parseSchemaType "tradeId")) , ("PartyReference Maybe AccountReference [OneOf2 TradeId VersionedTradeId]", fmap TwoOf2 (return (,,) `apply` parseSchemaType "partyReference" `apply` optional (parseSchemaType "accountReference") `apply` many1 (oneOf' [ ("TradeId", fmap OneOf2 (parseSchemaType "tradeId")) , ("VersionedTradeId", fmap TwoOf2 (parseSchemaType "versionedTradeId")) ]))) ] schemaTypeToXML s x@TradeIdentifier{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ tradeIdent_ID x ] [ foldOneOf2 (\ (a,b) -> concat [ schemaTypeToXML "issuer" a , schemaTypeToXML "tradeId" b ]) (\ (a,b,c) -> concat [ schemaTypeToXML "partyReference" a , maybe [] (schemaTypeToXML "accountReference") b , concatMap (foldOneOf2 (schemaTypeToXML "tradeId") (schemaTypeToXML "versionedTradeId") ) c ]) $ tradeIdent_choice0 x ] -- | The data type used for issuer identifiers. data IssuerId = IssuerId Scheme IssuerIdAttributes deriving (Eq,Show) data IssuerIdAttributes = IssuerIdAttributes { issuerIdAttrib_issuerIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType IssuerId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "issuerIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ IssuerId v (IssuerIdAttributes a0) schemaTypeToXML s (IssuerId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "issuerIdScheme") $ issuerIdAttrib_issuerIdScheme at ] $ schemaTypeToXML s bt instance Extension IssuerId Scheme where supertype (IssuerId s _) = s data Trader = Trader Scheme TraderAttributes deriving (Eq,Show) data TraderAttributes = TraderAttributes { traderAttrib_traderScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType Trader where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "traderScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ Trader v (TraderAttributes a0) schemaTypeToXML s (Trader bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "traderScheme") $ traderAttrib_traderScheme at ] $ schemaTypeToXML s bt instance Extension Trader Scheme where supertype (Trader s _) = s -- | A reference identifying a rule within a validation scheme. data Validation = Validation Scheme ValidationAttributes deriving (Eq,Show) data ValidationAttributes = ValidationAttributes { validAttrib_validationScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType Validation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "validationScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ Validation v (ValidationAttributes a0) schemaTypeToXML s (Validation bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "validationScheme") $ validAttrib_validationScheme at ] $ schemaTypeToXML s bt instance Extension Validation Scheme where supertype (Validation s _) = s -- | Contract Id with Version Support data VersionedContractId = VersionedContractId { versiContrId_contractId :: Maybe ContractId , versiContrId_version :: Maybe Xsd.NonNegativeInteger -- ^ The version number , versiContrId_effectiveDate :: Maybe IdentifiedDate -- ^ Optionally it is possible to specify a version effective -- date when a versionId is supplied. } deriving (Eq,Show) instance SchemaType VersionedContractId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return VersionedContractId `apply` optional (parseSchemaType "contractId") `apply` optional (parseSchemaType "version") `apply` optional (parseSchemaType "effectiveDate") schemaTypeToXML s x@VersionedContractId{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "contractId") $ versiContrId_contractId x , maybe [] (schemaTypeToXML "version") $ versiContrId_version x , maybe [] (schemaTypeToXML "effectiveDate") $ versiContrId_effectiveDate x ] -- | Trade Id with Version Support data VersionedTradeId = VersionedTradeId { versiTradeId_tradeId :: Maybe TradeId , versiTradeId_version :: Maybe Xsd.NonNegativeInteger -- ^ The version number , versiTradeId_effectiveDate :: Maybe IdentifiedDate -- ^ Optionally it is possible to specify a version effective -- date when a versionId is supplied. } deriving (Eq,Show) instance SchemaType VersionedTradeId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return VersionedTradeId `apply` optional (parseSchemaType "tradeId") `apply` optional (parseSchemaType "version") `apply` optional (parseSchemaType "effectiveDate") schemaTypeToXML s x@VersionedTradeId{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "tradeId") $ versiTradeId_tradeId x , maybe [] (schemaTypeToXML "version") $ versiTradeId_version x , maybe [] (schemaTypeToXML "effectiveDate") $ versiTradeId_effectiveDate x ] -- | A type to hold trades of multiply-traded instruments. -- Typically this will be used to represent the trade -- resulting from a physically-settled OTC product where the -- underlying is a security, for example the exercise of a -- physically-settled option. elementInstrumentTradeDetails :: XMLParser InstrumentTradeDetails elementInstrumentTradeDetails = parseSchemaType "instrumentTradeDetails" elementToXMLInstrumentTradeDetails :: InstrumentTradeDetails -> [Content ()] elementToXMLInstrumentTradeDetails = schemaTypeToXML "instrumentTradeDetails" -- | A strategy product. elementStrategy :: XMLParser Strategy elementStrategy = parseSchemaType "strategy" elementToXMLStrategy :: Strategy -> [Content ()] elementToXMLStrategy = schemaTypeToXML "strategy"