{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} module Data.FpML.V53.Events.Business ( module Data.FpML.V53.Events.Business , module Data.FpML.V53.Msg , 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.Msg import Data.FpML.V53.Asset -- Some hs-boot imports are required, for fwd-declaring types. -- | A type defining an event identifier issued by the indicated -- party. data BusinessEventIdentifier = BusinessEventIdentifier { busEventIdent_ID :: Maybe Xsd.ID , busEventIdent_choice0 :: OneOf2 PartyId (PartyReference,(Maybe (AccountReference))) -- ^ Choice between: -- -- (1) issuer -- -- (2) Sequence of: -- -- * Reference to a party. -- -- * Reference to an account. , busEventIdent_eventId :: EventId } deriving (Eq,Show) instance SchemaType BusinessEventIdentifier where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (BusinessEventIdentifier a0) `apply` oneOf' [ ("PartyId", fmap OneOf2 (parseSchemaType "issuer")) , ("PartyReference Maybe AccountReference", fmap TwoOf2 (return (,) `apply` parseSchemaType "partyReference" `apply` optional (parseSchemaType "accountReference"))) ] `apply` parseSchemaType "eventId" schemaTypeToXML s x@BusinessEventIdentifier{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ busEventIdent_ID x ] [ foldOneOf2 (schemaTypeToXML "issuer") (\ (a,b) -> concat [ schemaTypeToXML "partyReference" a , maybe [] (schemaTypeToXML "accountReference") b ]) $ busEventIdent_choice0 x , schemaTypeToXML "eventId" $ busEventIdent_eventId x ] -- | A post-trade event 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 EventId = EventId Scheme EventIdAttributes deriving (Eq,Show) data EventIdAttributes = EventIdAttributes { eventIdAttrib_eventIdScheme :: Maybe Xsd.AnyURI , eventIdAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType EventId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "eventIdScheme" e pos a1 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ EventId v (EventIdAttributes a0 a1) schemaTypeToXML s (EventId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "eventIdScheme") $ eventIdAttrib_eventIdScheme at , maybe [] (toXMLAttribute "id") $ eventIdAttrib_ID at ] $ schemaTypeToXML s bt instance Extension EventId Scheme where supertype (EventId s _) = s -- | Abstract base type for all events. data AbstractEvent = AbstractEvent_TradeNovationContent TradeNovationContent | AbstractEvent_TradeChangeBase TradeChangeBase | AbstractEvent_TradeAmendmentContent TradeAmendmentContent | AbstractEvent_OptionExpiry OptionExpiry | AbstractEvent_OptionExercise OptionExercise | AbstractEvent_ChangeEvent ChangeEvent | AbstractEvent_AdditionalEvent AdditionalEvent deriving (Eq,Show) instance SchemaType AbstractEvent where parseSchemaType s = do (fmap AbstractEvent_TradeNovationContent $ parseSchemaType s) `onFail` (fmap AbstractEvent_TradeChangeBase $ parseSchemaType s) `onFail` (fmap AbstractEvent_TradeAmendmentContent $ parseSchemaType s) `onFail` (fmap AbstractEvent_OptionExpiry $ parseSchemaType s) `onFail` (fmap AbstractEvent_OptionExercise $ parseSchemaType s) `onFail` (fmap AbstractEvent_ChangeEvent $ parseSchemaType s) `onFail` (fmap AbstractEvent_AdditionalEvent $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of AbstractEvent,\n\ \ namely one of:\n\ \TradeNovationContent,TradeChangeBase,TradeAmendmentContent,OptionExpiry,OptionExercise,ChangeEvent,AdditionalEvent" schemaTypeToXML _s (AbstractEvent_TradeNovationContent x) = schemaTypeToXML "tradeNovationContent" x schemaTypeToXML _s (AbstractEvent_TradeChangeBase x) = schemaTypeToXML "tradeChangeBase" x schemaTypeToXML _s (AbstractEvent_TradeAmendmentContent x) = schemaTypeToXML "tradeAmendmentContent" x schemaTypeToXML _s (AbstractEvent_OptionExpiry x) = schemaTypeToXML "optionExpiry" x schemaTypeToXML _s (AbstractEvent_OptionExercise x) = schemaTypeToXML "optionExercise" x schemaTypeToXML _s (AbstractEvent_ChangeEvent x) = schemaTypeToXML "changeEvent" x schemaTypeToXML _s (AbstractEvent_AdditionalEvent x) = schemaTypeToXML "additionalEvent" x -- | Abstract base type for an extension/substitution point to -- customize FpML and add additional events. -- (There are no subtypes defined for this abstract type.) data AdditionalEvent = AdditionalEvent deriving (Eq,Show) instance SchemaType AdditionalEvent where parseSchemaType s = fail "Parse failed when expecting an extension type of AdditionalEvent:\n No extension types are known." schemaTypeToXML s _ = toXMLElement s [] [] instance Extension AdditionalEvent AbstractEvent where supertype v = AbstractEvent_AdditionalEvent v -- | Abstract base type for non-negotiated trade change -- descriptions data ChangeEvent = ChangeEvent_IndexChange IndexChange deriving (Eq,Show) instance SchemaType ChangeEvent where parseSchemaType s = do (fmap ChangeEvent_IndexChange $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of ChangeEvent,\n\ \ namely one of:\n\ \IndexChange" schemaTypeToXML _s (ChangeEvent_IndexChange x) = schemaTypeToXML "indexChange" x instance Extension ChangeEvent AbstractEvent where supertype v = AbstractEvent_ChangeEvent v -- | A type that shows how multiple trades have been combined -- into a result. data CompressionActivity = CompressionActivity { comprActiv_compressionType :: Maybe CompressionType , comprActiv_choice1 :: (Maybe (OneOf2 ((Maybe (TradeIdentifier)),[TradeIdentifier]) ((Maybe (TradeId)),[TradeId]))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * replacementTradeIdentifier -- -- * originatingTradeIdentifier -- -- (2) Sequence of: -- -- * replacementTradeId -- -- * originatingTradeId } deriving (Eq,Show) instance SchemaType CompressionActivity where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CompressionActivity `apply` optional (parseSchemaType "compressionType") `apply` optional (oneOf' [ ("Maybe TradeIdentifier [TradeIdentifier]", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "replacementTradeIdentifier") `apply` many (parseSchemaType "originatingTradeIdentifier"))) , ("Maybe TradeId [TradeId]", fmap TwoOf2 (return (,) `apply` optional (parseSchemaType "replacementTradeId") `apply` many (parseSchemaType "originatingTradeId"))) ]) schemaTypeToXML s x@CompressionActivity{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "compressionType") $ comprActiv_compressionType x , maybe [] (foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "replacementTradeIdentifier") a , concatMap (schemaTypeToXML "originatingTradeIdentifier") b ]) (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "replacementTradeId") a , concatMap (schemaTypeToXML "originatingTradeId") b ]) ) $ comprActiv_choice1 x ] -- | A type that identifies the type of trade amalgamation, for -- example netting or portfolio compression. data CompressionType = CompressionType Scheme CompressionTypeAttributes deriving (Eq,Show) data CompressionTypeAttributes = CompressionTypeAttributes { comprTypeAttrib_compressionTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CompressionType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "compressionTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CompressionType v (CompressionTypeAttributes a0) schemaTypeToXML s (CompressionType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "compressionTypeScheme") $ comprTypeAttrib_compressionTypeScheme at ] $ schemaTypeToXML s bt instance Extension CompressionType Scheme where supertype (CompressionType s _) = s -- | A structure describing an de-clear event. data DeClear = DeClear { deClear_tradeIdentifier :: [PartyTradeIdentifier] , deClear_effectiveDate :: Maybe Xsd.Date } deriving (Eq,Show) instance SchemaType DeClear where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return DeClear `apply` many (parseSchemaType "tradeIdentifier") `apply` optional (parseSchemaType "effectiveDate") schemaTypeToXML s x@DeClear{} = toXMLElement s [] [ concatMap (schemaTypeToXML "tradeIdentifier") $ deClear_tradeIdentifier x , maybe [] (schemaTypeToXML "effectiveDate") $ deClear_effectiveDate x ] -- | A structure describing the removal of a trade from a -- service, such as a reporting service. data Withdrawal = Withdrawal { withdrawal_partyTradeIdentifier :: [PartyTradeIdentifier] , withdrawal_effectiveDate :: Maybe Xsd.Date , withdrawal_requestedAction :: Maybe RequestedWithdrawalAction , withdrawal_reason :: Maybe WithdrawalReason } deriving (Eq,Show) instance SchemaType Withdrawal where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Withdrawal `apply` many (parseSchemaType "partyTradeIdentifier") `apply` optional (parseSchemaType "effectiveDate") `apply` optional (parseSchemaType "requestedAction") `apply` optional (parseSchemaType "reason") schemaTypeToXML s x@Withdrawal{} = toXMLElement s [] [ concatMap (schemaTypeToXML "partyTradeIdentifier") $ withdrawal_partyTradeIdentifier x , maybe [] (schemaTypeToXML "effectiveDate") $ withdrawal_effectiveDate x , maybe [] (schemaTypeToXML "requestedAction") $ withdrawal_requestedAction x , maybe [] (schemaTypeToXML "reason") $ withdrawal_reason x ] -- | A type that describes what the requester would like to see -- done to implement the withdrawal, e.g. ExpungeRecords, -- RetainRecords. data RequestedWithdrawalAction = RequestedWithdrawalAction Scheme RequestedWithdrawalActionAttributes deriving (Eq,Show) data RequestedWithdrawalActionAttributes = RequestedWithdrawalActionAttributes { rwaa_requestedWithdrawalActionScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType RequestedWithdrawalAction where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "requestedWithdrawalActionScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ RequestedWithdrawalAction v (RequestedWithdrawalActionAttributes a0) schemaTypeToXML s (RequestedWithdrawalAction bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "requestedWithdrawalActionScheme") $ rwaa_requestedWithdrawalActionScheme at ] $ schemaTypeToXML s bt instance Extension RequestedWithdrawalAction Scheme where supertype (RequestedWithdrawalAction s _) = s -- | A type that describes why a trade was withdrawn. data WithdrawalReason = WithdrawalReason Scheme WithdrawalReasonAttributes deriving (Eq,Show) data WithdrawalReasonAttributes = WithdrawalReasonAttributes { withdrReasonAttrib_withdrawalReasonScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType WithdrawalReason where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "withdrawalReasonScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ WithdrawalReason v (WithdrawalReasonAttributes a0) schemaTypeToXML s (WithdrawalReason bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "withdrawalReasonScheme") $ withdrReasonAttrib_withdrawalReasonScheme at ] $ schemaTypeToXML s bt instance Extension WithdrawalReason Scheme where supertype (WithdrawalReason s _) = s -- | A structure that describes a proposed match between trades -- or post-trade event reports. data EventProposedMatch = EventProposedMatch { eventProposMatch_choice0 :: (Maybe (OneOf10 ((Maybe (OriginatingEvent)),(Maybe (Trade))) TradeAmendmentContent TradeNotionalChange ((Maybe (TerminatingEvent)),(Maybe (TradeNotionalChange))) TradeNovationContent OptionExercise [OptionExpiry] DeClear Withdrawal AdditionalEvent)) -- ^ Choice between: -- -- (1) Sequence of: -- -- * originatingEvent -- -- * trade -- -- (2) amendment -- -- (3) increase -- -- (4) Sequence of: -- -- * terminatingEvent -- -- * termination -- -- (5) novation -- -- (6) optionExercise -- -- (7) optionExpiry -- -- (8) deClear -- -- (9) withdrawal -- -- (10) The additionalEvent element is an -- extension/substitution point to customize FpML and add -- additional events. , eventProposMatch_matchId :: Maybe MatchId -- ^ A unique identifier assigned by the matching service to -- each set of matched positions. , eventProposMatch_difference :: [TradeDifference] -- ^ A type used to record the details of a difference between -- two sides of a business event. , eventProposMatch_matchScore :: Maybe Xsd.Decimal -- ^ Numeric score to represent the quality of the match. } deriving (Eq,Show) instance SchemaType EventProposedMatch where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return EventProposedMatch `apply` optional (oneOf' [ ("Maybe OriginatingEvent Maybe Trade", fmap OneOf10 (return (,) `apply` optional (parseSchemaType "originatingEvent") `apply` optional (parseSchemaType "trade"))) , ("TradeAmendmentContent", fmap TwoOf10 (parseSchemaType "amendment")) , ("TradeNotionalChange", fmap ThreeOf10 (parseSchemaType "increase")) , ("Maybe TerminatingEvent Maybe TradeNotionalChange", fmap FourOf10 (return (,) `apply` optional (parseSchemaType "terminatingEvent") `apply` optional (parseSchemaType "termination"))) , ("TradeNovationContent", fmap FiveOf10 (parseSchemaType "novation")) , ("OptionExercise", fmap SixOf10 (parseSchemaType "optionExercise")) , ("[OptionExpiry]", fmap SevenOf10 (many1 (parseSchemaType "optionExpiry"))) , ("DeClear", fmap EightOf10 (parseSchemaType "deClear")) , ("Withdrawal", fmap NineOf10 (parseSchemaType "withdrawal")) , ("AdditionalEvent", fmap TenOf10 (elementAdditionalEvent)) ]) `apply` optional (parseSchemaType "matchId") `apply` many (parseSchemaType "difference") `apply` optional (parseSchemaType "matchScore") schemaTypeToXML s x@EventProposedMatch{} = toXMLElement s [] [ maybe [] (foldOneOf10 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "originatingEvent") a , maybe [] (schemaTypeToXML "trade") b ]) (schemaTypeToXML "amendment") (schemaTypeToXML "increase") (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "terminatingEvent") a , maybe [] (schemaTypeToXML "termination") b ]) (schemaTypeToXML "novation") (schemaTypeToXML "optionExercise") (concatMap (schemaTypeToXML "optionExpiry")) (schemaTypeToXML "deClear") (schemaTypeToXML "withdrawal") (elementToXMLAdditionalEvent) ) $ eventProposMatch_choice0 x , maybe [] (schemaTypeToXML "matchId") $ eventProposMatch_matchId x , concatMap (schemaTypeToXML "difference") $ eventProposMatch_difference x , maybe [] (schemaTypeToXML "matchScore") $ eventProposMatch_matchScore x ] data EventsChoice = EventsChoice { eventsChoice_choice0 :: (Maybe (OneOf10 ((Maybe (OriginatingEvent)),(Maybe (Trade))) TradeAmendmentContent TradeNotionalChange ((Maybe (TerminatingEvent)),(Maybe (TradeNotionalChange))) TradeNovationContent OptionExercise [OptionExpiry] DeClear Withdrawal AdditionalEvent)) -- ^ Choice between: -- -- (1) Sequence of: -- -- * originatingEvent -- -- * trade -- -- (2) amendment -- -- (3) increase -- -- (4) Sequence of: -- -- * terminatingEvent -- -- * termination -- -- (5) novation -- -- (6) optionExercise -- -- (7) optionExpiry -- -- (8) deClear -- -- (9) withdrawal -- -- (10) The additionalEvent element is an -- extension/substitution point to customize FpML and add -- additional events. } deriving (Eq,Show) instance SchemaType EventsChoice where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return EventsChoice `apply` optional (oneOf' [ ("Maybe OriginatingEvent Maybe Trade", fmap OneOf10 (return (,) `apply` optional (parseSchemaType "originatingEvent") `apply` optional (parseSchemaType "trade"))) , ("TradeAmendmentContent", fmap TwoOf10 (parseSchemaType "amendment")) , ("TradeNotionalChange", fmap ThreeOf10 (parseSchemaType "increase")) , ("Maybe TerminatingEvent Maybe TradeNotionalChange", fmap FourOf10 (return (,) `apply` optional (parseSchemaType "terminatingEvent") `apply` optional (parseSchemaType "termination"))) , ("TradeNovationContent", fmap FiveOf10 (parseSchemaType "novation")) , ("OptionExercise", fmap SixOf10 (parseSchemaType "optionExercise")) , ("[OptionExpiry]", fmap SevenOf10 (many1 (parseSchemaType "optionExpiry"))) , ("DeClear", fmap EightOf10 (parseSchemaType "deClear")) , ("Withdrawal", fmap NineOf10 (parseSchemaType "withdrawal")) , ("AdditionalEvent", fmap TenOf10 (elementAdditionalEvent)) ]) schemaTypeToXML s x@EventsChoice{} = toXMLElement s [] [ maybe [] (foldOneOf10 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "originatingEvent") a , maybe [] (schemaTypeToXML "trade") b ]) (schemaTypeToXML "amendment") (schemaTypeToXML "increase") (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "terminatingEvent") a , maybe [] (schemaTypeToXML "termination") b ]) (schemaTypeToXML "novation") (schemaTypeToXML "optionExercise") (concatMap (schemaTypeToXML "optionExpiry")) (schemaTypeToXML "deClear") (schemaTypeToXML "withdrawal") (elementToXMLAdditionalEvent) ) $ eventsChoice_choice0 x ] -- | A structure describing the effect of a change to an index. data IndexChange = IndexChange { indexChange_eventIdentifier :: [BusinessEventIdentifier] , indexChange_indexFactor :: Maybe Xsd.Decimal , indexChange_factoredCalculationAmount :: Maybe Money } deriving (Eq,Show) instance SchemaType IndexChange where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return IndexChange `apply` many (parseSchemaType "eventIdentifier") `apply` optional (parseSchemaType "indexFactor") `apply` optional (parseSchemaType "factoredCalculationAmount") schemaTypeToXML s x@IndexChange{} = toXMLElement s [] [ concatMap (schemaTypeToXML "eventIdentifier") $ indexChange_eventIdentifier x , maybe [] (schemaTypeToXML "indexFactor") $ indexChange_indexFactor x , maybe [] (schemaTypeToXML "factoredCalculationAmount") $ indexChange_factoredCalculationAmount x ] instance Extension IndexChange ChangeEvent where supertype v = ChangeEvent_IndexChange v instance Extension IndexChange AbstractEvent where supertype = (supertype :: ChangeEvent -> AbstractEvent) . (supertype :: IndexChange -> ChangeEvent) -- | A structure describing an option exercise. data OptionExercise = OptionExercise { optionExerc_eventIdentifier :: [BusinessEventIdentifier] , optionExerc_optionSeller :: Maybe PartyReference , optionExerc_optionBuyer :: Maybe PartyReference , optionExerc_tradeIdentifier :: [PartyTradeIdentifier] , optionExerc_exerciseDate :: Maybe Xsd.Date , optionExerc_exerciseTime :: Maybe Xsd.Time , optionExerc_choice6 :: (Maybe (OneOf5 Xsd.Boolean Xsd.Boolean ((Maybe (Money)),(Maybe (Money))) ((Maybe (Xsd.Decimal)),(Maybe (Xsd.Decimal))) ((Maybe (Xsd.Decimal)),(Maybe (Xsd.Decimal))))) -- ^ Choice between: -- -- (1) expiry -- -- (2) fullExercise -- -- (3) Sequence of: -- -- * Specifies the fixed amount by which the option -- should be exercised expressed as notional amount. -- -- * Specifies the Notional amount after the Change -- -- (4) Sequence of: -- -- * Specifies the fixed amount by which the option -- should be exercised expressed as number of options. -- -- * Specifies the Number of Options after the Change. -- -- (5) Sequence of: -- -- * Specifies the fixed amount by which the option -- should be exercised express as number of units. -- -- * Specifies the Number of Units , optionExerc_choice7 :: (Maybe (OneOf3 SettlementTypeEnum SimplePayment PhysicalSettlement)) -- ^ Choice between: -- -- (1) settlementType -- -- (2) cashSettlement -- -- (3) physicalSettlement , optionExerc_payment :: Maybe NonNegativePayment } deriving (Eq,Show) instance SchemaType OptionExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return OptionExercise `apply` many (parseSchemaType "eventIdentifier") `apply` optional (parseSchemaType "optionSeller") `apply` optional (parseSchemaType "optionBuyer") `apply` many (parseSchemaType "tradeIdentifier") `apply` optional (parseSchemaType "exerciseDate") `apply` optional (parseSchemaType "exerciseTime") `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf5 (parseSchemaType "expiry")) , ("Xsd.Boolean", fmap TwoOf5 (parseSchemaType "fullExercise")) , ("Maybe Money Maybe Money", fmap ThreeOf5 (return (,) `apply` optional (parseSchemaType "exerciseInNotionalAmount") `apply` optional (parseSchemaType "outstandingNotionalAmount"))) , ("Maybe Xsd.Decimal Maybe Xsd.Decimal", fmap FourOf5 (return (,) `apply` optional (parseSchemaType "exerciseInNumberOfOptions") `apply` optional (parseSchemaType "outstandingNumberOfOptions"))) , ("Maybe Xsd.Decimal Maybe Xsd.Decimal", fmap FiveOf5 (return (,) `apply` optional (parseSchemaType "exerciseInNumberOfUnits") `apply` optional (parseSchemaType "outstandingNumberOfUnits"))) ]) `apply` optional (oneOf' [ ("SettlementTypeEnum", fmap OneOf3 (parseSchemaType "settlementType")) , ("SimplePayment", fmap TwoOf3 (parseSchemaType "cashSettlement")) , ("PhysicalSettlement", fmap ThreeOf3 (parseSchemaType "physicalSettlement")) ]) `apply` optional (parseSchemaType "payment") schemaTypeToXML s x@OptionExercise{} = toXMLElement s [] [ concatMap (schemaTypeToXML "eventIdentifier") $ optionExerc_eventIdentifier x , maybe [] (schemaTypeToXML "optionSeller") $ optionExerc_optionSeller x , maybe [] (schemaTypeToXML "optionBuyer") $ optionExerc_optionBuyer x , concatMap (schemaTypeToXML "tradeIdentifier") $ optionExerc_tradeIdentifier x , maybe [] (schemaTypeToXML "exerciseDate") $ optionExerc_exerciseDate x , maybe [] (schemaTypeToXML "exerciseTime") $ optionExerc_exerciseTime x , maybe [] (foldOneOf5 (schemaTypeToXML "expiry") (schemaTypeToXML "fullExercise") (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "exerciseInNotionalAmount") a , maybe [] (schemaTypeToXML "outstandingNotionalAmount") b ]) (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "exerciseInNumberOfOptions") a , maybe [] (schemaTypeToXML "outstandingNumberOfOptions") b ]) (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "exerciseInNumberOfUnits") a , maybe [] (schemaTypeToXML "outstandingNumberOfUnits") b ]) ) $ optionExerc_choice6 x , maybe [] (foldOneOf3 (schemaTypeToXML "settlementType") (schemaTypeToXML "cashSettlement") (schemaTypeToXML "physicalSettlement") ) $ optionExerc_choice7 x , maybe [] (schemaTypeToXML "payment") $ optionExerc_payment x ] instance Extension OptionExercise AbstractEvent where supertype v = AbstractEvent_OptionExercise v -- | A structure describing an option expiring (i.e. passing its -- last exercise time and becoming worthless.) data OptionExpiry = OptionExpiry { optionExpiry_eventIdentifier :: [BusinessEventIdentifier] , optionExpiry_tradeIdentifier :: [PartyTradeIdentifier] , optionExpiry_date :: Maybe Xsd.Date , optionExpiry_time :: Maybe Xsd.Time , optionExpiry_exerciseProcedure :: Maybe ExerciseProcedureOption } deriving (Eq,Show) instance SchemaType OptionExpiry where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return OptionExpiry `apply` many (parseSchemaType "eventIdentifier") `apply` many (parseSchemaType "tradeIdentifier") `apply` optional (parseSchemaType "date") `apply` optional (parseSchemaType "time") `apply` optional (parseSchemaType "exerciseProcedure") schemaTypeToXML s x@OptionExpiry{} = toXMLElement s [] [ concatMap (schemaTypeToXML "eventIdentifier") $ optionExpiry_eventIdentifier x , concatMap (schemaTypeToXML "tradeIdentifier") $ optionExpiry_tradeIdentifier x , maybe [] (schemaTypeToXML "date") $ optionExpiry_date x , maybe [] (schemaTypeToXML "time") $ optionExpiry_time x , maybe [] (schemaTypeToXML "exerciseProcedure") $ optionExpiry_exerciseProcedure x ] instance Extension OptionExpiry AbstractEvent where supertype v = AbstractEvent_OptionExpiry v -- | A structure describing an option expiring. data OptionExpiryBase = OptionExpiryBase { optionExpiryBase_tradeIdentifier :: [PartyTradeIdentifier] , optionExpiryBase_date :: Maybe Xsd.Date , optionExpiryBase_time :: Maybe Xsd.Time } deriving (Eq,Show) instance SchemaType OptionExpiryBase where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return OptionExpiryBase `apply` many (parseSchemaType "tradeIdentifier") `apply` optional (parseSchemaType "date") `apply` optional (parseSchemaType "time") schemaTypeToXML s x@OptionExpiryBase{} = toXMLElement s [] [ concatMap (schemaTypeToXML "tradeIdentifier") $ optionExpiryBase_tradeIdentifier x , maybe [] (schemaTypeToXML "date") $ optionExpiryBase_date x , maybe [] (schemaTypeToXML "time") $ optionExpiryBase_time x ] -- | A structure that describes how an option settles into a -- physical trade. data PhysicalSettlement = PhysicalSettlement { physicSettl_choice0 :: (Maybe (OneOf3 PartyTradeIdentifier Trade Product)) -- ^ Choice between: -- -- (1) The ID of the trade that resulted from the physical -- settlement. -- -- (2) The trade that resulted from the physical settlement. -- -- (3) An abstract element used as a place holder for the -- substituting product elements. } deriving (Eq,Show) instance SchemaType PhysicalSettlement where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PhysicalSettlement `apply` optional (oneOf' [ ("PartyTradeIdentifier", fmap OneOf3 (parseSchemaType "resultingTradeIdentifier")) , ("Trade", fmap TwoOf3 (parseSchemaType "resultingTrade")) , ("Product", fmap ThreeOf3 (elementProduct)) ]) schemaTypeToXML s x@PhysicalSettlement{} = toXMLElement s [] [ maybe [] (foldOneOf3 (schemaTypeToXML "resultingTradeIdentifier") (schemaTypeToXML "resultingTrade") (elementToXMLProduct) ) $ physicSettl_choice0 x ] data PhysicalExercise = PhysicalExercise { physicExerc_choice0 :: (Maybe (OneOf2 Trade PartyTradeIdentifiers)) -- ^ Choice between: -- -- (1) An element that allows the full details of the trade to -- be used as a mechanism for identifying the trade for -- which the post-trade event pertains -- -- (2) A container since an individual trade can be referenced -- by two or more different partyTradeIdentifier elements -- - each allocated by a different party. } deriving (Eq,Show) instance SchemaType PhysicalExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PhysicalExercise `apply` optional (oneOf' [ ("Trade", fmap OneOf2 (parseSchemaType "trade")) , ("PartyTradeIdentifiers", fmap TwoOf2 (parseSchemaType "tradeReference")) ]) schemaTypeToXML s x@PhysicalExercise{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "trade") (schemaTypeToXML "tradeReference") ) $ physicExerc_choice0 x ] -- | A type that describes why a trade terminated. data TerminatingEvent = TerminatingEvent Scheme TerminatingEventAttributes deriving (Eq,Show) data TerminatingEventAttributes = TerminatingEventAttributes { terminEventAttrib_terminatingEventScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType TerminatingEvent where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "terminatingEventScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ TerminatingEvent v (TerminatingEventAttributes a0) schemaTypeToXML s (TerminatingEvent bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "terminatingEventScheme") $ terminEventAttrib_terminatingEventScheme at ] $ schemaTypeToXML s bt instance Extension TerminatingEvent Scheme where supertype (TerminatingEvent s _) = s -- | A structure describing a negotiated amendment. data TradeAmendmentContent = TradeAmendmentContent { tradeAmendmContent_eventIdentifier :: [BusinessEventIdentifier] , tradeAmendmContent_trade :: Maybe Trade -- ^ A fulll description of the amended trade (i.e. the trade -- after the amendment). , tradeAmendmContent_agreementDate :: Maybe Xsd.Date -- ^ The date on which the change was agreed. , tradeAmendmContent_executionDateTime :: ExecutionDateTime -- ^ The date and time at which the negotiated change to the -- terms of the original contract was agreed, such as via -- telephone or electronic trading system (i.e., agreement -- date/time). , tradeAmendmContent_effectiveDate :: Maybe Xsd.Date -- ^ The date on which the change become effective. , tradeAmendmContent_payment :: Maybe Payment -- ^ Describes a payment made in settlement of the change. } deriving (Eq,Show) instance SchemaType TradeAmendmentContent where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeAmendmentContent `apply` many (parseSchemaType "eventIdentifier") `apply` optional (parseSchemaType "trade") `apply` optional (parseSchemaType "agreementDate") `apply` parseSchemaType "executionDateTime" `apply` optional (parseSchemaType "effectiveDate") `apply` optional (parseSchemaType "payment") schemaTypeToXML s x@TradeAmendmentContent{} = toXMLElement s [] [ concatMap (schemaTypeToXML "eventIdentifier") $ tradeAmendmContent_eventIdentifier x , maybe [] (schemaTypeToXML "trade") $ tradeAmendmContent_trade x , maybe [] (schemaTypeToXML "agreementDate") $ tradeAmendmContent_agreementDate x , schemaTypeToXML "executionDateTime" $ tradeAmendmContent_executionDateTime x , maybe [] (schemaTypeToXML "effectiveDate") $ tradeAmendmContent_effectiveDate x , maybe [] (schemaTypeToXML "payment") $ tradeAmendmContent_payment x ] instance Extension TradeAmendmentContent AbstractEvent where supertype v = AbstractEvent_TradeAmendmentContent v -- | A structure describing a trade change. data TradeChangeBase = TradeChangeBase { tradeChangeBase_eventIdentifier :: [BusinessEventIdentifier] , tradeChangeBase_choice1 :: OneOf2 [PartyTradeIdentifier] Trade -- ^ Choice between: -- -- (1) tradeIdentifier -- -- (2) originalTrade , tradeChangeBase_agreementDate :: Maybe Xsd.Date -- ^ The date on which the change was agreed. , tradeChangeBase_executionDateTime :: ExecutionDateTime -- ^ The date and time at which the negotiated change to the -- terms of the original contract was agreed, such as via -- telephone or electronic trading system (i.e., agreement -- date/time). , tradeChangeBase_effectiveDate :: Maybe Xsd.Date -- ^ The date on which the change become effective. , tradeChangeBase_payment :: Maybe Payment -- ^ Describes a payment made in settlement of the change. } deriving (Eq,Show) instance SchemaType TradeChangeBase where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeChangeBase `apply` many (parseSchemaType "eventIdentifier") `apply` oneOf' [ ("[PartyTradeIdentifier]", fmap OneOf2 (many1 (parseSchemaType "tradeIdentifier"))) , ("Trade", fmap TwoOf2 (parseSchemaType "originalTrade")) ] `apply` optional (parseSchemaType "agreementDate") `apply` parseSchemaType "executionDateTime" `apply` optional (parseSchemaType "effectiveDate") `apply` optional (parseSchemaType "payment") schemaTypeToXML s x@TradeChangeBase{} = toXMLElement s [] [ concatMap (schemaTypeToXML "eventIdentifier") $ tradeChangeBase_eventIdentifier x , foldOneOf2 (concatMap (schemaTypeToXML "tradeIdentifier")) (schemaTypeToXML "originalTrade") $ tradeChangeBase_choice1 x , maybe [] (schemaTypeToXML "agreementDate") $ tradeChangeBase_agreementDate x , schemaTypeToXML "executionDateTime" $ tradeChangeBase_executionDateTime x , maybe [] (schemaTypeToXML "effectiveDate") $ tradeChangeBase_effectiveDate x , maybe [] (schemaTypeToXML "payment") $ tradeChangeBase_payment x ] instance Extension TradeChangeBase AbstractEvent where supertype v = AbstractEvent_TradeChangeBase v -- | A structure describing a non-negotiated trade resulting -- from a market event. data TradeChangeContent = TradeChangeContent { tradeChangeContent_choice0 :: (Maybe (OneOf2 PartyTradeIdentifier Trade)) -- ^ Choice between: -- -- (1) The original qualified trade identifier. -- -- (2) The original trade details. , tradeChangeContent_trade :: Maybe Trade -- ^ A full description of the amended trade. , tradeChangeContent_effectiveDate :: Maybe Xsd.Date -- ^ The date on which the change become effective , tradeChangeContent_changeEvent :: Maybe ChangeEvent -- ^ Abstract substitutable place holder for specific change -- details. , tradeChangeContent_payment :: Maybe Payment -- ^ Describes a payment made in settlement of the change. } deriving (Eq,Show) instance SchemaType TradeChangeContent where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeChangeContent `apply` optional (oneOf' [ ("PartyTradeIdentifier", fmap OneOf2 (parseSchemaType "oldTradeIdentifier")) , ("Trade", fmap TwoOf2 (parseSchemaType "oldTrade")) ]) `apply` optional (parseSchemaType "trade") `apply` optional (parseSchemaType "effectiveDate") `apply` optional (elementChangeEvent) `apply` optional (parseSchemaType "payment") schemaTypeToXML s x@TradeChangeContent{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "oldTradeIdentifier") (schemaTypeToXML "oldTrade") ) $ tradeChangeContent_choice0 x , maybe [] (schemaTypeToXML "trade") $ tradeChangeContent_trade x , maybe [] (schemaTypeToXML "effectiveDate") $ tradeChangeContent_effectiveDate x , maybe [] (elementToXMLChangeEvent) $ tradeChangeContent_changeEvent x , maybe [] (schemaTypeToXML "payment") $ tradeChangeContent_payment x ] -- | A structure describing a trade maturing. data TradeMaturity = TradeMaturity { tradeMatur_tradeIdentifier :: [PartyTradeIdentifier] , tradeMatur_date :: Maybe Xsd.Date } deriving (Eq,Show) instance SchemaType TradeMaturity where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeMaturity `apply` many (parseSchemaType "tradeIdentifier") `apply` optional (parseSchemaType "date") schemaTypeToXML s x@TradeMaturity{} = toXMLElement s [] [ concatMap (schemaTypeToXML "tradeIdentifier") $ tradeMatur_tradeIdentifier x , maybe [] (schemaTypeToXML "date") $ tradeMatur_date x ] -- | A structure describing a change to the trade notional. data TradeNotionalChange = TradeNotionalChange { tradeNotionChange_eventIdentifier :: [BusinessEventIdentifier] , tradeNotionChange_choice1 :: OneOf2 [PartyTradeIdentifier] Trade -- ^ Choice between: -- -- (1) tradeIdentifier -- -- (2) originalTrade , tradeNotionChange_agreementDate :: Maybe Xsd.Date -- ^ The date on which the change was agreed. , tradeNotionChange_executionDateTime :: ExecutionDateTime -- ^ The date and time at which the negotiated change to the -- terms of the original contract was agreed, such as via -- telephone or electronic trading system (i.e., agreement -- date/time). , tradeNotionChange_effectiveDate :: Maybe Xsd.Date -- ^ The date on which the change become effective. , tradeNotionChange_payment :: Maybe Payment -- ^ Describes a payment made in settlement of the change. , tradeNotionChange_choice6 :: (Maybe (OneOf3 ((Maybe (NonNegativeMoney)),(Maybe (Money))) ((Maybe (Xsd.Decimal)),(Maybe (Xsd.Decimal))) ((Maybe (Xsd.Decimal)),(Maybe (Xsd.Decimal))))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * Specifies the fixed amount by which the Notional -- Amount changes. The direction of the change -- (increase or decrease) is specified by the event -- type (Termination => reduction, Increase => -- greater.) -- -- * Specifies the Notional amount after the Change -- -- (2) Sequence of: -- -- * Specifies the fixed amount by which the Number of -- Options changes -- -- * Specifies the Number of Options after the Change. -- -- (3) Sequence of: -- -- * Specifies the fixed amount by which the Number of -- Units changes -- -- * Specifies the Number of Units } deriving (Eq,Show) instance SchemaType TradeNotionalChange where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeNotionalChange `apply` many (parseSchemaType "eventIdentifier") `apply` oneOf' [ ("[PartyTradeIdentifier]", fmap OneOf2 (many1 (parseSchemaType "tradeIdentifier"))) , ("Trade", fmap TwoOf2 (parseSchemaType "originalTrade")) ] `apply` optional (parseSchemaType "agreementDate") `apply` parseSchemaType "executionDateTime" `apply` optional (parseSchemaType "effectiveDate") `apply` optional (parseSchemaType "payment") `apply` optional (oneOf' [ ("Maybe NonNegativeMoney Maybe Money", fmap OneOf3 (return (,) `apply` optional (parseSchemaType "changeInNotionalAmount") `apply` optional (parseSchemaType "outstandingNotionalAmount"))) , ("Maybe Xsd.Decimal Maybe Xsd.Decimal", fmap TwoOf3 (return (,) `apply` optional (parseSchemaType "changeInNumberOfOptions") `apply` optional (parseSchemaType "outstandingNumberOfOptions"))) , ("Maybe Xsd.Decimal Maybe Xsd.Decimal", fmap ThreeOf3 (return (,) `apply` optional (parseSchemaType "changeInNumberOfUnits") `apply` optional (parseSchemaType "outstandingNumberOfUnits"))) ]) schemaTypeToXML s x@TradeNotionalChange{} = toXMLElement s [] [ concatMap (schemaTypeToXML "eventIdentifier") $ tradeNotionChange_eventIdentifier x , foldOneOf2 (concatMap (schemaTypeToXML "tradeIdentifier")) (schemaTypeToXML "originalTrade") $ tradeNotionChange_choice1 x , maybe [] (schemaTypeToXML "agreementDate") $ tradeNotionChange_agreementDate x , schemaTypeToXML "executionDateTime" $ tradeNotionChange_executionDateTime x , maybe [] (schemaTypeToXML "effectiveDate") $ tradeNotionChange_effectiveDate x , maybe [] (schemaTypeToXML "payment") $ tradeNotionChange_payment x , maybe [] (foldOneOf3 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "changeInNotionalAmount") a , maybe [] (schemaTypeToXML "outstandingNotionalAmount") b ]) (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "changeInNumberOfOptions") a , maybe [] (schemaTypeToXML "outstandingNumberOfOptions") b ]) (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "changeInNumberOfUnits") a , maybe [] (schemaTypeToXML "outstandingNumberOfUnits") b ]) ) $ tradeNotionChange_choice6 x ] instance Extension TradeNotionalChange TradeChangeBase where supertype (TradeNotionalChange e0 e1 e2 e3 e4 e5 e6) = TradeChangeBase e0 e1 e2 e3 e4 e5 instance Extension TradeNotionalChange AbstractEvent where supertype = (supertype :: TradeChangeBase -> AbstractEvent) . (supertype :: TradeNotionalChange -> TradeChangeBase) -- | A structure describing a novation. data TradeNovationContent = TradeNovationContent { tradeNovatContent_eventIdentifier :: [BusinessEventIdentifier] , tradeNovatContent_choice1 :: (Maybe (OneOf2 [PartyTradeIdentifier] Trade)) -- ^ Choice between: -- -- (1) Indicates a reference to the original trade between the -- transferor and the remaining party. -- -- (2) Indicates the original trade between the transferor and -- the remaining party. , tradeNovatContent_choice2 :: (Maybe (OneOf2 [PartyTradeIdentifier] Trade)) -- ^ Choice between identification and representation of the new -- contract. -- -- Choice between: -- -- (1) Indicates a reference to the new trade between the -- transferee and the remaining party. -- -- (2) Indicates the original trade between the transferor and -- the remaining party. , tradeNovatContent_transferor :: Maybe PartyReference -- ^ A pointer style reference to a party identifier defined -- elsewhere in the document. In a three-way novation the -- party referenced is the Transferor (outgoing party) in the -- novation. The Transferor means a party which transfers by -- novation to a Transferee all of its rights, liabilities, -- duties and obligations with respect to a Remaining Party. -- In a four-way novation the party referenced is Transferor 1 -- which transfers by novation to Transferee 1 all of its -- rights, liabilities, duties and obligations with respect to -- Transferor 2. ISDA 2004 Novation Term: Transferor -- (three-way novation) or Transferor 1 (four-way novation). , tradeNovatContent_transferorAccount :: Maybe AccountReference , tradeNovatContent_transferee :: Maybe PartyReference -- ^ A pointer style reference to a party identifier defined -- elsewhere in the document. In a three-way novation the -- party referenced is the Transferee (incoming party) in the -- novation. Transferee means a party which accepts by way of -- novation all rights, liabilities, duties and obligations of -- a Transferor with respect to a Remaining Party. In a -- four-way novation the party referenced is Transferee 1 -- which accepts by way of novation the rights, liabilities, -- duties and obligations of Transferor 1. ISDA 2004 Novation -- Term: Transferee (three-way novation) or Transferee 1 -- (four-way novation). , tradeNovatContent_transfereeAccount :: Maybe AccountReference , tradeNovatContent_remainingParty :: Maybe PartyReference -- ^ A pointer style reference to a party identifier defined -- elsewhere in the document. In a three-way novation the -- party referenced is the Remaining Party in the novation. -- Remaining Party means a party which consents to a -- Transferor's transfer by novation and the acceptance -- thereof by the Transferee of all of the Transferor's -- rights, liabilities, duties and obligations with respect to -- such Remaining Party under and with respect of the Novated -- Amount of a transaction. In a four-way novation the party -- referenced is Transferor 2 per the ISDA definition and acts -- in the role of a Transferor. Transferor 2 transfers by -- novation to Transferee 2 all of its rights, liabilities, -- duties and obligations with respect to Transferor 1. ISDA -- 2004 Novation Term: Remaining Party (three-way novation) or -- Transferor 2 (four-way novation). , tradeNovatContent_remainingPartyAccount :: Maybe AccountReference , tradeNovatContent_otherRemainingParty :: Maybe PartyReference -- ^ A pointer style reference to a party identifier defined -- elsewhere in the document. This element is not applicable -- in a three-way novation and should be omitted. In a -- four-way novation the party referenced is Transferee 2. -- Transferee 2 means a party which accepts by way of novation -- the rights, liabilities, duties and obligations of -- Transferor 2. ISDA 2004 Novation Term: Transferee 2 -- (four-way novation). , tradeNovatContent_otherRemainingPartyAccount :: Maybe AccountReference , tradeNovatContent_novationDate :: Xsd.Date -- ^ Specifies the date that one party's legal obligations with -- regard to a trade are transferred to another party. It -- corresponds to the Novation Date section of the 2004 ISDA -- Novation Definitions, section 1.16. , tradeNovatContent_executionDateTime :: ExecutionDateTime -- ^ The date and time at which the change was agreed. , tradeNovatContent_novationTradeDate :: Xsd.Date -- ^ Specifies the date the parties agree to assign or novate a -- Contract. If this element is not specified, the -- novationContractDate will be deemed to be the novationDate. -- It corresponds to the Novation Trade Date section of the -- 2004 ISDA Novation Definitions, section 1.17. , tradeNovatContent_choice14 :: (Maybe (OneOf3 ((Maybe (Money)),(Maybe (Money))) ((Maybe (Xsd.Decimal)),(Maybe (Xsd.Decimal))) ((Maybe (Xsd.Decimal)),(Maybe (Xsd.Decimal))))) -- ^ Choice for expressing the novated amount as either a money -- amount, number of options, or number of units, according -- the the financial product which is being novated. -- -- Choice between: -- -- (1) Sequence of: -- -- * The amount which represents the portion of the Old -- Contract being novated. -- -- * The amount which represents the portion of the Old -- Contract not being novated. -- -- (2) Sequence of: -- -- * The number of options which represent the portion -- of the Old Contract being novated. -- -- * The number of options which represent the portion -- of the Old Contract not being novated. -- -- (3) Sequence of: -- -- * The number of options which represent the portion -- of the Old Contract being novated. -- -- * The number of options which represent the portion -- of the Old Contract not being novated. , tradeNovatContent_fullFirstCalculationPeriod :: Maybe Xsd.Boolean -- ^ This element corresponds to the applicability of the Full -- First Calculation Period as defined in the 2004 ISDA -- Novation Definitions, section 1.20. , tradeNovatContent_firstPeriodStartDate :: [FirstPeriodStartDate] -- ^ Element that is used to be able to make sense of the “new -- transaction” without requiring reference back to the -- “old transaction”. In the case of interest rate -- products there are potentially 2 “first period start -- dates” to reference – one with respect to each party to -- the new transaction. For Credit Default Swaps there is just -- the one with respect to the party that is the fixed rate -- payer. , tradeNovatContent_nonReliance :: Maybe Empty -- ^ This element corresponds to the non-Reliance section in the -- 2004 ISDA Novation Definitions, section 2.1 (c) (i). The -- element appears in the instance document when non-Reliance -- is applicable. , tradeNovatContent_creditDerivativesNotices :: Maybe CreditDerivativesNotices -- ^ This element should be specified if one or more of either a -- Credit Event Notice, Notice of Publicly Available -- Information, Notice of Physical Settlement or Notice of -- Intended Physical Settlement, as applicable, has been -- delivered by or to the Transferor or the Remaining Party. -- The type of notice or notices that have been delivered -- should be indicated by setting the relevant boolean element -- value(s) to true. The absence of the element means that no -- Credit Event Notice, Notice of Publicly Available -- Information, Notice of Physical Settlement or Notice of -- Intended Physical Settlement, as applicable, has been -- delivered by or to the Transferor or the Remaining Party. , tradeNovatContent_contractualDefinitions :: [ContractualDefinitions] -- ^ The definitions (such as those published by ISDA) that will -- define the terms of the novation transaction. , tradeNovatContent_contractualTermsSupplement :: [ContractualTermsSupplement] -- ^ A contractual supplement (such as those published by ISDA) -- that will apply to the trade. , tradeNovatContent_payment :: Maybe Payment -- ^ Describes a payment made in settlement of the novation. } deriving (Eq,Show) instance SchemaType TradeNovationContent where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeNovationContent `apply` many (parseSchemaType "eventIdentifier") `apply` optional (oneOf' [ ("[PartyTradeIdentifier]", fmap OneOf2 (many1 (parseSchemaType "oldTradeIdentifier"))) , ("Trade", fmap TwoOf2 (parseSchemaType "oldTrade")) ]) `apply` optional (oneOf' [ ("[PartyTradeIdentifier]", fmap OneOf2 (many1 (parseSchemaType "newTradeIdentifier"))) , ("Trade", fmap TwoOf2 (parseSchemaType "newTrade")) ]) `apply` optional (parseSchemaType "transferor") `apply` optional (parseSchemaType "transferorAccount") `apply` optional (parseSchemaType "transferee") `apply` optional (parseSchemaType "transfereeAccount") `apply` optional (parseSchemaType "remainingParty") `apply` optional (parseSchemaType "remainingPartyAccount") `apply` optional (parseSchemaType "otherRemainingParty") `apply` optional (parseSchemaType "otherRemainingPartyAccount") `apply` parseSchemaType "novationDate" `apply` parseSchemaType "executionDateTime" `apply` parseSchemaType "novationTradeDate" `apply` optional (oneOf' [ ("Maybe Money Maybe Money", fmap OneOf3 (return (,) `apply` optional (parseSchemaType "novatedAmount") `apply` optional (parseSchemaType "remainingAmount"))) , ("Maybe Xsd.Decimal Maybe Xsd.Decimal", fmap TwoOf3 (return (,) `apply` optional (parseSchemaType "novatedNumberOfOptions") `apply` optional (parseSchemaType "remainingNumberOfOptions"))) , ("Maybe Xsd.Decimal Maybe Xsd.Decimal", fmap ThreeOf3 (return (,) `apply` optional (parseSchemaType "novatedNumberOfUnits") `apply` optional (parseSchemaType "remainingNumberOfUnits"))) ]) `apply` optional (parseSchemaType "fullFirstCalculationPeriod") `apply` between (Occurs (Just 0) (Just 2)) (parseSchemaType "firstPeriodStartDate") `apply` optional (parseSchemaType "nonReliance") `apply` optional (parseSchemaType "creditDerivativesNotices") `apply` many (parseSchemaType "contractualDefinitions") `apply` many (parseSchemaType "contractualTermsSupplement") `apply` optional (parseSchemaType "payment") schemaTypeToXML s x@TradeNovationContent{} = toXMLElement s [] [ concatMap (schemaTypeToXML "eventIdentifier") $ tradeNovatContent_eventIdentifier x , maybe [] (foldOneOf2 (concatMap (schemaTypeToXML "oldTradeIdentifier")) (schemaTypeToXML "oldTrade") ) $ tradeNovatContent_choice1 x , maybe [] (foldOneOf2 (concatMap (schemaTypeToXML "newTradeIdentifier")) (schemaTypeToXML "newTrade") ) $ tradeNovatContent_choice2 x , maybe [] (schemaTypeToXML "transferor") $ tradeNovatContent_transferor x , maybe [] (schemaTypeToXML "transferorAccount") $ tradeNovatContent_transferorAccount x , maybe [] (schemaTypeToXML "transferee") $ tradeNovatContent_transferee x , maybe [] (schemaTypeToXML "transfereeAccount") $ tradeNovatContent_transfereeAccount x , maybe [] (schemaTypeToXML "remainingParty") $ tradeNovatContent_remainingParty x , maybe [] (schemaTypeToXML "remainingPartyAccount") $ tradeNovatContent_remainingPartyAccount x , maybe [] (schemaTypeToXML "otherRemainingParty") $ tradeNovatContent_otherRemainingParty x , maybe [] (schemaTypeToXML "otherRemainingPartyAccount") $ tradeNovatContent_otherRemainingPartyAccount x , schemaTypeToXML "novationDate" $ tradeNovatContent_novationDate x , schemaTypeToXML "executionDateTime" $ tradeNovatContent_executionDateTime x , schemaTypeToXML "novationTradeDate" $ tradeNovatContent_novationTradeDate x , maybe [] (foldOneOf3 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "novatedAmount") a , maybe [] (schemaTypeToXML "remainingAmount") b ]) (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "novatedNumberOfOptions") a , maybe [] (schemaTypeToXML "remainingNumberOfOptions") b ]) (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "novatedNumberOfUnits") a , maybe [] (schemaTypeToXML "remainingNumberOfUnits") b ]) ) $ tradeNovatContent_choice14 x , maybe [] (schemaTypeToXML "fullFirstCalculationPeriod") $ tradeNovatContent_fullFirstCalculationPeriod x , concatMap (schemaTypeToXML "firstPeriodStartDate") $ tradeNovatContent_firstPeriodStartDate x , maybe [] (schemaTypeToXML "nonReliance") $ tradeNovatContent_nonReliance x , maybe [] (schemaTypeToXML "creditDerivativesNotices") $ tradeNovatContent_creditDerivativesNotices x , concatMap (schemaTypeToXML "contractualDefinitions") $ tradeNovatContent_contractualDefinitions x , concatMap (schemaTypeToXML "contractualTermsSupplement") $ tradeNovatContent_contractualTermsSupplement x , maybe [] (schemaTypeToXML "payment") $ tradeNovatContent_payment x ] instance Extension TradeNovationContent AbstractEvent where supertype v = AbstractEvent_TradeNovationContent v -- | Defines a type that allows trade identifiers and/or trade -- information to be represented for a trade. data TradeReferenceInformation = TradeReferenceInformation { tradeRefInfo_choice0 :: (Maybe (OneOf2 OriginatingEvent TerminatingEvent)) -- ^ Choice between: -- -- (1) originatingEvent -- -- (2) terminatingEvent , tradeRefInfo_partyTradeIdentifier :: [PartyTradeIdentifier] -- ^ This allows the acknowledging party to supply additional -- trade identifiers for a trade underlying a request relating -- to a business event. , tradeRefInfo_partyTradeInformation :: [PartyTradeInformation] -- ^ This allows the acknowledging party to supply additional -- trade information about a trade underlying a request -- relating to a business event. , tradeRefInfo_productType :: Maybe ProductType , tradeRefInfo_productId :: Maybe ProductId } deriving (Eq,Show) instance SchemaType TradeReferenceInformation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TradeReferenceInformation `apply` optional (oneOf' [ ("OriginatingEvent", fmap OneOf2 (parseSchemaType "originatingEvent")) , ("TerminatingEvent", fmap TwoOf2 (parseSchemaType "terminatingEvent")) ]) `apply` many (parseSchemaType "partyTradeIdentifier") `apply` many (parseSchemaType "partyTradeInformation") `apply` optional (parseSchemaType "productType") `apply` optional (parseSchemaType "productId") schemaTypeToXML s x@TradeReferenceInformation{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "originatingEvent") (schemaTypeToXML "terminatingEvent") ) $ tradeRefInfo_choice0 x , concatMap (schemaTypeToXML "partyTradeIdentifier") $ tradeRefInfo_partyTradeIdentifier x , concatMap (schemaTypeToXML "partyTradeInformation") $ tradeRefInfo_partyTradeInformation x , maybe [] (schemaTypeToXML "productType") $ tradeRefInfo_productType x , maybe [] (schemaTypeToXML "productId") $ tradeRefInfo_productId x ] -- | The additionalEvent element is an extension/substitution -- point to customize FpML and add additional events. -- (There are no elements in any substitution group for this element.) elementAdditionalEvent :: XMLParser AdditionalEvent elementAdditionalEvent = fail "Parse failed when expecting an element in the substitution group for\n\ \ ,\n\ \ There are no substitutable elements." elementToXMLAdditionalEvent :: AdditionalEvent -> [Content ()] elementToXMLAdditionalEvent = schemaTypeToXML "additionalEvent" -- | Abstract substitutable place holder for specific change -- details. elementChangeEvent :: XMLParser ChangeEvent elementChangeEvent = parseSchemaType "changeEvent" elementToXMLChangeEvent :: ChangeEvent -> [Content ()] elementToXMLChangeEvent = schemaTypeToXML "changeEvent" -- | Describes a change due to an index component being -- adjusted. elementIndexChange :: XMLParser IndexChange elementIndexChange = parseSchemaType "indexChange" elementToXMLIndexChange :: IndexChange -> [Content ()] elementToXMLIndexChange = schemaTypeToXML "indexChange"