{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Reporting.Valuation
  ( module Data.FpML.V53.Reporting.Valuation
  , module Data.FpML.V53.Events.Business
  , module Data.FpML.V53.Valuation
  ) 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
import Data.FpML.V53.Valuation
 
-- Some hs-boot imports are required, for fwd-declaring types.
 
-- | A type used to describe the scope/contents of a report.
data ReportContents = ReportContents
        { reportConten_partyReference :: Maybe PartyReference
          -- ^ The party for which this report was generated.
        , reportConten_accountReference :: Maybe AccountReference
          -- ^ The account for which this report was generated.
        , reportConten_category :: [TradeCategory]
          -- ^ Used to categorize trades into user-defined categories, 
          --   such as house trades vs. customer trades.
        , reportConten_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.
        , reportConten_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , reportConten_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , reportConten_queryPortfolio :: Maybe QueryPortfolio
          -- ^ The desired query portfolio.
        }
        deriving (Eq,Show)
instance SchemaType ReportContents where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReportContents
            `apply` optional (parseSchemaType "partyReference")
            `apply` optional (parseSchemaType "accountReference")
            `apply` many (parseSchemaType "category")
            `apply` optional (parseSchemaType "primaryAssetClass")
            `apply` many (parseSchemaType "secondaryAssetClass")
            `apply` many (parseSchemaType "productType")
            `apply` optional (parseSchemaType "queryPortfolio")
    schemaTypeToXML s x@ReportContents{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "partyReference") $ reportConten_partyReference x
            , maybe [] (schemaTypeToXML "accountReference") $ reportConten_accountReference x
            , concatMap (schemaTypeToXML "category") $ reportConten_category x
            , maybe [] (schemaTypeToXML "primaryAssetClass") $ reportConten_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ reportConten_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ reportConten_productType x
            , maybe [] (schemaTypeToXML "queryPortfolio") $ reportConten_queryPortfolio x
            ]
 
-- | A type used in valuation enquiry messages which relates a 
--   portfolio to its trades and current value.
data PortfolioValuationItem = PortfolioValuationItem
        { portfValItem_portfolio :: Maybe Portfolio
          -- ^ Global portfolio element used as a basis for a substitution 
          --   group.
        , portfValItem_tradeValuationItem :: [TradeValuationItem]
          -- ^ Zero or more trade valuation items.
        , portfValItem_valuationSet :: Maybe ValuationSet
        }
        deriving (Eq,Show)
instance SchemaType PortfolioValuationItem where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PortfolioValuationItem
            `apply` optional (elementPortfolio)
            `apply` many (parseSchemaType "tradeValuationItem")
            `apply` optional (elementValuationSet)
    schemaTypeToXML s x@PortfolioValuationItem{} =
        toXMLElement s []
            [ maybe [] (elementToXMLPortfolio) $ portfValItem_portfolio x
            , concatMap (schemaTypeToXML "tradeValuationItem") $ portfValItem_tradeValuationItem x
            , maybe [] (elementToXMLValuationSet) $ portfValItem_valuationSet x
            ]
 
-- | A type defining the content model for a message allowing 
--   one party a report containing valuations of one or many 
--   existing trades.
data RequestValuationReport = RequestValuationReport
        { reqValReport_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , reqValReport_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.
        , reqValReport_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.
        , reqValReport_header :: Maybe RequestMessageHeader
        , reqValReport_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , reqValReport_isCorrection :: Maybe Xsd.Boolean
          -- ^ Indicates if this message corrects an earlier request.
        , reqValReport_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , reqValReport_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , reqValReport_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , reqValReport_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.
        , reqValReport_reportContents :: Maybe ReportContents
          -- ^ The specific characteristics to be included in the report.
        , reqValReport_asOfDate :: Maybe IdentifiedDate
          -- ^ The date for which this report is requested.
        , reqValReport_party :: [Party]
        , reqValReport_account :: [Account]
          -- ^ Optional account information used to precisely define the 
          --   origination and destination of financial instruments.
        , reqValReport_market :: Maybe Market
          -- ^ This is a global element used for creating global types. It 
          --   holds Market information, e.g. curves, surfaces, quotes, 
          --   etc.
        , reqValReport_portfolioValuationItem :: [PortfolioValuationItem]
          -- ^ An instance of a unique portfolio valuation.
        , reqValReport_tradeValuationItem :: [TradeValuationItem]
          -- ^ An instance of a unique trade valuation.
        }
        deriving (Eq,Show)
instance SchemaType RequestValuationReport 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 (RequestValuationReport 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 "reportContents")
            `apply` optional (parseSchemaType "asOfDate")
            `apply` many (parseSchemaType "party")
            `apply` many (parseSchemaType "account")
            `apply` optional (elementMarket)
            `apply` many (parseSchemaType "portfolioValuationItem")
            `apply` many (parseSchemaType "tradeValuationItem")
    schemaTypeToXML s x@RequestValuationReport{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ reqValReport_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ reqValReport_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ reqValReport_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ reqValReport_header x
            , concatMap (schemaTypeToXML "validation") $ reqValReport_validation x
            , maybe [] (schemaTypeToXML "isCorrection") $ reqValReport_isCorrection x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ reqValReport_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ reqValReport_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ reqValReport_sequenceNumber x
            , concatMap (schemaTypeToXML "onBehalfOf") $ reqValReport_onBehalfOf x
            , maybe [] (schemaTypeToXML "reportContents") $ reqValReport_reportContents x
            , maybe [] (schemaTypeToXML "asOfDate") $ reqValReport_asOfDate x
            , concatMap (schemaTypeToXML "party") $ reqValReport_party x
            , concatMap (schemaTypeToXML "account") $ reqValReport_account x
            , maybe [] (elementToXMLMarket) $ reqValReport_market x
            , concatMap (schemaTypeToXML "portfolioValuationItem") $ reqValReport_portfolioValuationItem x
            , concatMap (schemaTypeToXML "tradeValuationItem") $ reqValReport_tradeValuationItem x
            ]
instance Extension RequestValuationReport CorrectableRequestMessage where
    supertype v = CorrectableRequestMessage_RequestValuationReport v
instance Extension RequestValuationReport RequestMessage where
    supertype = (supertype :: CorrectableRequestMessage -> RequestMessage)
              . (supertype :: RequestValuationReport -> CorrectableRequestMessage)
              
instance Extension RequestValuationReport Message where
    supertype = (supertype :: RequestMessage -> Message)
              . (supertype :: CorrectableRequestMessage -> RequestMessage)
              . (supertype :: RequestValuationReport -> CorrectableRequestMessage)
              
instance Extension RequestValuationReport Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: RequestMessage -> Message)
              . (supertype :: CorrectableRequestMessage -> RequestMessage)
              . (supertype :: RequestValuationReport -> CorrectableRequestMessage)
              
 
-- | A type used in trade valuation enquiry messages which 
--   relates a trade identifier to its current value.
data TradeValuationItem = TradeValuationItem
        { tradeValItem_choice0 :: (Maybe (OneOf2 [PartyTradeIdentifier] Trade))
          -- ^ Choice between:
          --   
          --   (1) One or more trade identifiers needed to uniquely 
          --   identify a trade.
          --   
          --   (2) Fully-described trades whose values are reported.
        , tradeValItem_valuationSet :: Maybe ValuationSet
        }
        deriving (Eq,Show)
instance SchemaType TradeValuationItem where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return TradeValuationItem
            `apply` optional (oneOf' [ ("[PartyTradeIdentifier]", fmap OneOf2 (many1 (parseSchemaType "partyTradeIdentifier")))
                                     , ("Trade", fmap TwoOf2 (parseSchemaType "trade"))
                                     ])
            `apply` optional (elementValuationSet)
    schemaTypeToXML s x@TradeValuationItem{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (concatMap (schemaTypeToXML "partyTradeIdentifier"))
                                    (schemaTypeToXML "trade")
                                   ) $ tradeValItem_choice0 x
            , maybe [] (elementToXMLValuationSet) $ tradeValItem_valuationSet x
            ]
 
-- | A type defining the content model for a message normally 
--   generated in response to a RequestValuationReport request.
data ValuationReport = ValuationReport
        { valReport_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , valReport_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.
        , valReport_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.
        , valReport_header :: Maybe NotificationMessageHeader
        , valReport_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , valReport_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , valReport_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , valReport_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , valReport_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.
        , valReport_reportIdentification :: Maybe ReportIdentification
          -- ^ Identifiers for the report instance and section.
        , valReport_reportContents :: Maybe ReportContents
          -- ^ The specific characteristics included in the report.
        , valReport_asOfDate :: Maybe IdentifiedDate
          -- ^ The date for which this request was generated.
        , valReport_party :: [Party]
        , valReport_account :: [Account]
          -- ^ Optional account information used to precisely define the 
          --   origination and destination of financial instruments.
        , valReport_market :: Maybe Market
          -- ^ This is a global element used for creating global types. It 
          --   holds Market information, e.g. curves, surfaces, quotes, 
          --   etc.
        , valReport_portfolioValuationItem :: [PortfolioValuationItem]
          -- ^ An instance of a unique portfolio valuation.
        , valReport_tradeValuationItem :: [TradeValuationItem]
          -- ^ A collection of data values describing the state of the 
          --   given trade.
        }
        deriving (Eq,Show)
instance SchemaType ValuationReport 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 (ValuationReport 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` optional (parseSchemaType "reportIdentification")
            `apply` optional (parseSchemaType "reportContents")
            `apply` optional (parseSchemaType "asOfDate")
            `apply` many (parseSchemaType "party")
            `apply` many (parseSchemaType "account")
            `apply` optional (elementMarket)
            `apply` many (parseSchemaType "portfolioValuationItem")
            `apply` many (parseSchemaType "tradeValuationItem")
    schemaTypeToXML s x@ValuationReport{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ valReport_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ valReport_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ valReport_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ valReport_header x
            , concatMap (schemaTypeToXML "validation") $ valReport_validation x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ valReport_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ valReport_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ valReport_sequenceNumber x
            , concatMap (schemaTypeToXML "onBehalfOf") $ valReport_onBehalfOf x
            , maybe [] (schemaTypeToXML "reportIdentification") $ valReport_reportIdentification x
            , maybe [] (schemaTypeToXML "reportContents") $ valReport_reportContents x
            , maybe [] (schemaTypeToXML "asOfDate") $ valReport_asOfDate x
            , concatMap (schemaTypeToXML "party") $ valReport_party x
            , concatMap (schemaTypeToXML "account") $ valReport_account x
            , maybe [] (elementToXMLMarket) $ valReport_market x
            , concatMap (schemaTypeToXML "portfolioValuationItem") $ valReport_portfolioValuationItem x
            , concatMap (schemaTypeToXML "tradeValuationItem") $ valReport_tradeValuationItem x
            ]
instance Extension ValuationReport NotificationMessage where
    supertype v = NotificationMessage_ValuationReport v
instance Extension ValuationReport Message where
    supertype = (supertype :: NotificationMessage -> Message)
              . (supertype :: ValuationReport -> NotificationMessage)
              
instance Extension ValuationReport Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: NotificationMessage -> Message)
              . (supertype :: ValuationReport -> NotificationMessage)
              
 
-- | A type defining the content model for a message that 
--   retracts a valuation report. This says that the most 
--   recently supplied valuation is erroneous and a previous 
--   value should be used.
data ValuationReportRetracted = ValuationReportRetracted
        { valReportRetrac_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , valReportRetrac_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.
        , valReportRetrac_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.
        , valReportRetrac_header :: Maybe NotificationMessageHeader
        , valReportRetrac_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , valReportRetrac_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , valReportRetrac_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , valReportRetrac_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , valReportRetrac_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.
        , valReportRetrac_reportIdentification :: Maybe ReportIdentification
          -- ^ Identifiers for the report instance and section.
        , valReportRetrac_reportContents :: Maybe ReportContents
          -- ^ The specific characteristics included in the report.
        , valReportRetrac_asOfDate :: Maybe IdentifiedDate
          -- ^ The date for which this request was generated.
        , valReportRetrac_partyTradeIdentifier :: [PartyTradeIdentifier]
          -- ^ One or more trade identifiers needed to uniquely identify a 
          --   trade.
        , valReportRetrac_party :: [Party]
        , valReportRetrac_account :: [Account]
          -- ^ Optional account information used to precisely define the 
          --   origination and destination of financial instruments.
        }
        deriving (Eq,Show)
instance SchemaType ValuationReportRetracted 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 (ValuationReportRetracted 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` optional (parseSchemaType "reportIdentification")
            `apply` optional (parseSchemaType "reportContents")
            `apply` optional (parseSchemaType "asOfDate")
            `apply` many (parseSchemaType "partyTradeIdentifier")
            `apply` many (parseSchemaType "party")
            `apply` many (parseSchemaType "account")
    schemaTypeToXML s x@ValuationReportRetracted{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ valReportRetrac_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ valReportRetrac_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ valReportRetrac_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ valReportRetrac_header x
            , concatMap (schemaTypeToXML "validation") $ valReportRetrac_validation x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ valReportRetrac_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ valReportRetrac_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ valReportRetrac_sequenceNumber x
            , concatMap (schemaTypeToXML "onBehalfOf") $ valReportRetrac_onBehalfOf x
            , maybe [] (schemaTypeToXML "reportIdentification") $ valReportRetrac_reportIdentification x
            , maybe [] (schemaTypeToXML "reportContents") $ valReportRetrac_reportContents x
            , maybe [] (schemaTypeToXML "asOfDate") $ valReportRetrac_asOfDate x
            , concatMap (schemaTypeToXML "partyTradeIdentifier") $ valReportRetrac_partyTradeIdentifier x
            , concatMap (schemaTypeToXML "party") $ valReportRetrac_party x
            , concatMap (schemaTypeToXML "account") $ valReportRetrac_account x
            ]
instance Extension ValuationReportRetracted NotificationMessage where
    supertype v = NotificationMessage_ValuationReportRetracted v
instance Extension ValuationReportRetracted Message where
    supertype = (supertype :: NotificationMessage -> Message)
              . (supertype :: ValuationReportRetracted -> NotificationMessage)
              
instance Extension ValuationReportRetracted Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: NotificationMessage -> Message)
              . (supertype :: ValuationReportRetracted -> NotificationMessage)
              
 
-- | Global portfolio element used as a basis for a substitution 
--   group.
elementPortfolio :: XMLParser Portfolio
elementPortfolio = parseSchemaType "portfolio"
elementToXMLPortfolio :: Portfolio -> [Content ()]
elementToXMLPortfolio = schemaTypeToXML "portfolio"
 
-- | Global element used to substitute for "portfolio".
elementQueryPortfolio :: XMLParser QueryPortfolio
elementQueryPortfolio = parseSchemaType "queryPortfolio"
elementToXMLQueryPortfolio :: QueryPortfolio -> [Content ()]
elementToXMLQueryPortfolio = schemaTypeToXML "queryPortfolio"
 
-- | Reporting messages.
 
elementRequestValuationReport :: XMLParser RequestValuationReport
elementRequestValuationReport = parseSchemaType "requestValuationReport"
elementToXMLRequestValuationReport :: RequestValuationReport -> [Content ()]
elementToXMLRequestValuationReport = schemaTypeToXML "requestValuationReport"
 
elementValuationReport :: XMLParser ValuationReport
elementValuationReport = parseSchemaType "valuationReport"
elementToXMLValuationReport :: ValuationReport -> [Content ()]
elementToXMLValuationReport = schemaTypeToXML "valuationReport"
 
elementValuationReportRetracted :: XMLParser ValuationReportRetracted
elementValuationReportRetracted = parseSchemaType "valuationReportRetracted"
elementToXMLValuationReportRetracted :: ValuationReportRetracted -> [Content ()]
elementToXMLValuationReportRetracted = schemaTypeToXML "valuationReportRetracted"
 
elementValuationReportAcknowledgement :: XMLParser Acknowledgement
elementValuationReportAcknowledgement = parseSchemaType "valuationReportAcknowledgement"
elementToXMLValuationReportAcknowledgement :: Acknowledgement -> [Content ()]
elementToXMLValuationReportAcknowledgement = schemaTypeToXML "valuationReportAcknowledgement"
 
elementValuationReportException :: XMLParser Exception
elementValuationReportException = parseSchemaType "valuationReportException"
elementToXMLValuationReportException :: Exception -> [Content ()]
elementToXMLValuationReportException = schemaTypeToXML "valuationReportException"