{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} module Data.FpML.V53.Processes.Recordkeeping ( module Data.FpML.V53.Processes.Recordkeeping , module Data.FpML.V53.Events.Business ) where import Text.XML.HaXml.Schema.Schema (SchemaType(..),SimpleType(..),Extension(..),Restricts(..)) import Text.XML.HaXml.Schema.Schema as Schema import Text.XML.HaXml.OneOfN import qualified Text.XML.HaXml.Schema.PrimitiveTypes as Xsd import Data.FpML.V53.Events.Business -- Some hs-boot imports are required, for fwd-declaring types. data NonpublicExecutionReport = NonpublicExecutionReport { nonpubExecutReport_fpmlVersion :: Xsd.XsdString -- ^ Indicate which version of the FpML Schema an FpML message -- adheres to. , nonpubExecutReport_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. , nonpubExecutReport_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. , nonpubExecutReport_header :: Maybe RequestMessageHeader , nonpubExecutReport_validation :: [Validation] -- ^ A list of validation sets the sender asserts the document -- is valid with respect to. , nonpubExecutReport_isCorrection :: Maybe Xsd.Boolean -- ^ Indicates if this message corrects an earlier request. , nonpubExecutReport_parentCorrelationId :: Maybe CorrelationId -- ^ An optional identifier used to correlate between related -- processes , nonpubExecutReport_correlationId :: [CorrelationId] -- ^ A qualified identifier used to correlate between messages , nonpubExecutReport_sequenceNumber :: Maybe Xsd.PositiveInteger -- ^ A numeric value that can be used to order messages with the -- same correlation identifier from the same sender. , nonpubExecutReport_onBehalfOf :: [OnBehalfOf] -- ^ Indicates which party (or parties) (and accounts) a trade -- or event is being processed for. Normally there will only -- be a maximum of 2 parties, but in the case of a novation -- there could be a transferor, transferee, remaining party, -- and other remaining party. Except for this case, there -- should be no more than two onABehalfOf references in a -- message. , nonpubExecutReport_asOfDate :: Maybe IdentifiedDate -- ^ The date for which this document reports positions and -- valuations. , nonpubExecutReport_asOfTime :: Maybe Xsd.Time -- ^ The time for which this report was generated (i.e., the -- cut-off time of the report). , nonpubExecutReport_portfolioReference :: Maybe PortfolioReferenceBase , nonpubExecutReport_choice10 :: (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. , nonpubExecutReport_quote :: [BasicQuotation] -- ^ Pricing information for the trade. , nonpubExecutReport_party :: [Party] , nonpubExecutReport_account :: [Account] -- ^ Optional account information used to precisely define the -- origination and destination of financial instruments. } deriving (Eq,Show) instance SchemaType NonpublicExecutionReport 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 (NonpublicExecutionReport a0 a1 a2) `apply` optional (parseSchemaType "header") `apply` many (parseSchemaType "validation") `apply` optional (parseSchemaType "isCorrection") `apply` optional (parseSchemaType "parentCorrelationId") `apply` between (Occurs (Just 0) (Just 2)) (parseSchemaType "correlationId") `apply` optional (parseSchemaType "sequenceNumber") `apply` between (Occurs (Just 0) (Just 4)) (parseSchemaType "onBehalfOf") `apply` optional (parseSchemaType "asOfDate") `apply` optional (parseSchemaType "asOfTime") `apply` optional (parseSchemaType "portfolioReference") `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` many (parseSchemaType "quote") `apply` many (parseSchemaType "party") `apply` many (parseSchemaType "account") schemaTypeToXML s x@NonpublicExecutionReport{} = toXMLElement s [ toXMLAttribute "fpmlVersion" $ nonpubExecutReport_fpmlVersion x , maybe [] (toXMLAttribute "expectedBuild") $ nonpubExecutReport_expectedBuild x , maybe [] (toXMLAttribute "actualBuild") $ nonpubExecutReport_actualBuild x ] [ maybe [] (schemaTypeToXML "header") $ nonpubExecutReport_header x , concatMap (schemaTypeToXML "validation") $ nonpubExecutReport_validation x , maybe [] (schemaTypeToXML "isCorrection") $ nonpubExecutReport_isCorrection x , maybe [] (schemaTypeToXML "parentCorrelationId") $ nonpubExecutReport_parentCorrelationId x , concatMap (schemaTypeToXML "correlationId") $ nonpubExecutReport_correlationId x , maybe [] (schemaTypeToXML "sequenceNumber") $ nonpubExecutReport_sequenceNumber x , concatMap (schemaTypeToXML "onBehalfOf") $ nonpubExecutReport_onBehalfOf x , maybe [] (schemaTypeToXML "asOfDate") $ nonpubExecutReport_asOfDate x , maybe [] (schemaTypeToXML "asOfTime") $ nonpubExecutReport_asOfTime x , maybe [] (schemaTypeToXML "portfolioReference") $ nonpubExecutReport_portfolioReference x , 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) ) $ nonpubExecutReport_choice10 x , concatMap (schemaTypeToXML "quote") $ nonpubExecutReport_quote x , concatMap (schemaTypeToXML "party") $ nonpubExecutReport_party x , concatMap (schemaTypeToXML "account") $ nonpubExecutReport_account x ] instance Extension NonpublicExecutionReport CorrectableRequestMessage where supertype v = CorrectableRequestMessage_NonpublicExecutionReport v instance Extension NonpublicExecutionReport RequestMessage where supertype = (supertype :: CorrectableRequestMessage -> RequestMessage) . (supertype :: NonpublicExecutionReport -> CorrectableRequestMessage) instance Extension NonpublicExecutionReport Message where supertype = (supertype :: RequestMessage -> Message) . (supertype :: CorrectableRequestMessage -> RequestMessage) . (supertype :: NonpublicExecutionReport -> CorrectableRequestMessage) instance Extension NonpublicExecutionReport Document where supertype = (supertype :: Message -> Document) . (supertype :: RequestMessage -> Message) . (supertype :: CorrectableRequestMessage -> RequestMessage) . (supertype :: NonpublicExecutionReport -> CorrectableRequestMessage) data NonpublicExecutionReportRetracted = NonpublicExecutionReportRetracted { nonpubExecutReportRetrac_fpmlVersion :: Xsd.XsdString -- ^ Indicate which version of the FpML Schema an FpML message -- adheres to. , nonpubExecutReportRetrac_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. , nonpubExecutReportRetrac_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. , nonpubExecutReportRetrac_header :: Maybe RequestMessageHeader , nonpubExecutReportRetrac_validation :: [Validation] -- ^ A list of validation sets the sender asserts the document -- is valid with respect to. , nonpubExecutReportRetrac_parentCorrelationId :: Maybe CorrelationId -- ^ An optional identifier used to correlate between related -- processes , nonpubExecutReportRetrac_correlationId :: [CorrelationId] -- ^ A qualified identifier used to correlate between messages , nonpubExecutReportRetrac_sequenceNumber :: Maybe Xsd.PositiveInteger -- ^ A numeric value that can be used to order messages with the -- same correlation identifier from the same sender. , nonpubExecutReportRetrac_onBehalfOf :: [OnBehalfOf] -- ^ Indicates which party (or parties) (and accounts) a trade -- or event is being processed for. Normally there will only -- be a maximum of 2 parties, but in the case of a novation -- there could be a transferor, transferee, remaining party, -- and other remaining party. Except for this case, there -- should be no more than two onABehalfOf references in a -- message. , nonpubExecutReportRetrac_choice6 :: OneOf2 ((Maybe (OneOf10 ((Maybe (OriginatingEvent)),(Maybe (Trade))) TradeAmendmentContent TradeNotionalChange ((Maybe (TerminatingEvent)),(Maybe (TradeNotionalChange))) TradeNovationContent OptionExercise [OptionExpiry] DeClear Withdrawal AdditionalEvent))) PartyTradeIdentifier -- ^ Choice between: -- -- (1) unknown -- -- (2) tradeIdentifier , nonpubExecutReportRetrac_party :: [Party] , nonpubExecutReportRetrac_account :: [Account] -- ^ Optional account information used to precisely define the -- origination and destination of financial instruments. } deriving (Eq,Show) instance SchemaType NonpublicExecutionReportRetracted 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 (NonpublicExecutionReportRetracted a0 a1 a2) `apply` optional (parseSchemaType "header") `apply` many (parseSchemaType "validation") `apply` optional (parseSchemaType "parentCorrelationId") `apply` between (Occurs (Just 0) (Just 2)) (parseSchemaType "correlationId") `apply` optional (parseSchemaType "sequenceNumber") `apply` between (Occurs (Just 0) (Just 4)) (parseSchemaType "onBehalfOf") `apply` oneOf' [ ("(Maybe (OneOf10 ((Maybe (OriginatingEvent)),(Maybe (Trade))) TradeAmendmentContent TradeNotionalChange ((Maybe (TerminatingEvent)),(Maybe (TradeNotionalChange))) TradeNovationContent OptionExercise [OptionExpiry] DeClear Withdrawal AdditionalEvent))", fmap OneOf2 (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)) ]))) , ("PartyTradeIdentifier", fmap TwoOf2 (parseSchemaType "tradeIdentifier")) ] `apply` many (parseSchemaType "party") `apply` many (parseSchemaType "account") schemaTypeToXML s x@NonpublicExecutionReportRetracted{} = toXMLElement s [ toXMLAttribute "fpmlVersion" $ nonpubExecutReportRetrac_fpmlVersion x , maybe [] (toXMLAttribute "expectedBuild") $ nonpubExecutReportRetrac_expectedBuild x , maybe [] (toXMLAttribute "actualBuild") $ nonpubExecutReportRetrac_actualBuild x ] [ maybe [] (schemaTypeToXML "header") $ nonpubExecutReportRetrac_header x , concatMap (schemaTypeToXML "validation") $ nonpubExecutReportRetrac_validation x , maybe [] (schemaTypeToXML "parentCorrelationId") $ nonpubExecutReportRetrac_parentCorrelationId x , concatMap (schemaTypeToXML "correlationId") $ nonpubExecutReportRetrac_correlationId x , maybe [] (schemaTypeToXML "sequenceNumber") $ nonpubExecutReportRetrac_sequenceNumber x , concatMap (schemaTypeToXML "onBehalfOf") $ nonpubExecutReportRetrac_onBehalfOf x , foldOneOf2 (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) )) (schemaTypeToXML "tradeIdentifier") $ nonpubExecutReportRetrac_choice6 x , concatMap (schemaTypeToXML "party") $ nonpubExecutReportRetrac_party x , concatMap (schemaTypeToXML "account") $ nonpubExecutReportRetrac_account x ] instance Extension NonpublicExecutionReportRetracted NonCorrectableRequestMessage where supertype v = NonCorrectableRequestMessage_NonpublicExecutionReportRetracted v instance Extension NonpublicExecutionReportRetracted RequestMessage where supertype = (supertype :: NonCorrectableRequestMessage -> RequestMessage) . (supertype :: NonpublicExecutionReportRetracted -> NonCorrectableRequestMessage) instance Extension NonpublicExecutionReportRetracted Message where supertype = (supertype :: RequestMessage -> Message) . (supertype :: NonCorrectableRequestMessage -> RequestMessage) . (supertype :: NonpublicExecutionReportRetracted -> NonCorrectableRequestMessage) instance Extension NonpublicExecutionReportRetracted Document where supertype = (supertype :: Message -> Document) . (supertype :: RequestMessage -> Message) . (supertype :: NonCorrectableRequestMessage -> RequestMessage) . (supertype :: NonpublicExecutionReportRetracted -> NonCorrectableRequestMessage) elementNonpublicExecutionReport :: XMLParser NonpublicExecutionReport elementNonpublicExecutionReport = parseSchemaType "nonpublicExecutionReport" elementToXMLNonpublicExecutionReport :: NonpublicExecutionReport -> [Content ()] elementToXMLNonpublicExecutionReport = schemaTypeToXML "nonpublicExecutionReport" elementNonpublicExecutionReportRetracted :: XMLParser NonpublicExecutionReportRetracted elementNonpublicExecutionReportRetracted = parseSchemaType "nonpublicExecutionReportRetracted" elementToXMLNonpublicExecutionReportRetracted :: NonpublicExecutionReportRetracted -> [Content ()] elementToXMLNonpublicExecutionReportRetracted = schemaTypeToXML "nonpublicExecutionReportRetracted" elementNonpublicExecutionReportAcknowledgement :: XMLParser Acknowledgement elementNonpublicExecutionReportAcknowledgement = parseSchemaType "nonpublicExecutionReportAcknowledgement" elementToXMLNonpublicExecutionReportAcknowledgement :: Acknowledgement -> [Content ()] elementToXMLNonpublicExecutionReportAcknowledgement = schemaTypeToXML "nonpublicExecutionReportAcknowledgement" elementNonpublicExecutionReportException :: XMLParser Exception elementNonpublicExecutionReportException = parseSchemaType "nonpublicExecutionReportException" elementToXMLNonpublicExecutionReportException :: Exception -> [Content ()] elementToXMLNonpublicExecutionReportException = schemaTypeToXML "nonpublicExecutionReportException"