{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Msg
  ( module Data.FpML.V53.Msg
  , module Data.FpML.V53.Doc
  ) 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.Doc
import Data.Xmldsig.Core.Schema as Dsig
 
-- Some hs-boot imports are required, for fwd-declaring types.
import {-# SOURCE #-} Data.FpML.V53.Notification.CreditEvent ( CreditEventNotification )
import {-# SOURCE #-} Data.FpML.V53.Processes.Recordkeeping ( NonpublicExecutionReport )
import {-# SOURCE #-} Data.FpML.V53.Reporting.Valuation ( RequestValuationReport )
import {-# SOURCE #-} Data.FpML.V53.Processes.Recordkeeping ( NonpublicExecutionReportRetracted )
import {-# SOURCE #-} Data.FpML.V53.Reporting.Valuation ( ValuationReportRetracted )
import {-# SOURCE #-} Data.FpML.V53.Reporting.Valuation ( ValuationReport )
 
data Acknowledgement = Acknowledgement
        { acknow_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , acknow_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.
        , acknow_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.
        , acknow_header :: Maybe ResponseMessageHeader
        , acknow_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , acknow_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , acknow_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , acknow_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , acknow_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.
        , acknow_originalMessage :: Maybe UnprocessedElementWrapper
        , acknow_party :: [Party]
        , acknow_account :: [Account]
          -- ^ Optional account information used to precisely define the 
          --   origination and destination of financial instruments.
        }
        deriving (Eq,Show)
instance SchemaType Acknowledgement 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 (Acknowledgement 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 "originalMessage")
            `apply` many (parseSchemaType "party")
            `apply` many (parseSchemaType "account")
    schemaTypeToXML s x@Acknowledgement{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ acknow_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ acknow_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ acknow_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ acknow_header x
            , concatMap (schemaTypeToXML "validation") $ acknow_validation x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ acknow_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ acknow_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ acknow_sequenceNumber x
            , concatMap (schemaTypeToXML "onBehalfOf") $ acknow_onBehalfOf x
            , maybe [] (schemaTypeToXML "originalMessage") $ acknow_originalMessage x
            , concatMap (schemaTypeToXML "party") $ acknow_party x
            , concatMap (schemaTypeToXML "account") $ acknow_account x
            ]
instance Extension Acknowledgement ResponseMessage where
    supertype v = ResponseMessage_Acknowledgement v
instance Extension Acknowledgement Message where
    supertype = (supertype :: ResponseMessage -> Message)
              . (supertype :: Acknowledgement -> ResponseMessage)
              
instance Extension Acknowledgement Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: ResponseMessage -> Message)
              . (supertype :: Acknowledgement -> ResponseMessage)
              
 
-- | Provides extra information not represented in the model 
--   that may be useful in processing the message i.e. 
--   diagnosing the reason for failure.
data AdditionalData = AdditionalData
        { addData_mimeType :: Maybe MimeType
          -- ^ Indicates the type of media used to provide the extra 
          --   information. mimeType is used to determine the software 
          --   product(s) that can read the content. MIME Types are 
          --   described in RFC 2046.
        , addData_choice1 :: (Maybe (OneOf4 Xsd.XsdString Xsd.HexBinary Xsd.Base64Binary [AnyElement]))
          -- ^ Choice between:
          --   
          --   (1) Provides extra information as string. In case the extra 
          --   information is in XML format, a CDATA section must be 
          --   placed around the source message to prevent its 
          --   interpretation as XML content.
          --   
          --   (2) Provides extra information as binary contents coded in 
          --   hexadecimal.
          --   
          --   (3) Provides extra information as binary contents coded in 
          --   base64.
          --   
          --   (4) Provides extra information as binary contents coded in 
          --   base64.
        }
        deriving (Eq,Show)
instance SchemaType AdditionalData where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return AdditionalData
            `apply` optional (parseSchemaType "mimeType")
            `apply` optional (oneOf' [ ("Xsd.XsdString", fmap OneOf4 (parseSchemaType "string"))
                                     , ("Xsd.HexBinary", fmap TwoOf4 (parseSchemaType "hexadecimalBinary"))
                                     , ("Xsd.Base64Binary", fmap ThreeOf4 (parseSchemaType "base64Binary"))
                                     , ("Xsd:any", fmap FourOf4 (many (parseSchemaType "originalMessage")))
                                     ])
    schemaTypeToXML s x@AdditionalData{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "mimeType") $ addData_mimeType x
            , maybe [] (foldOneOf4  (schemaTypeToXML "string")
                                    (schemaTypeToXML "hexadecimalBinary")
                                    (schemaTypeToXML "base64Binary")
                                    (concatMap (schemaTypeToXML "originalMessage"))
                                   ) $ addData_choice1 x
            ]
 
-- | A type defining the content model for a request message 
--   that can be subsequently corrected or retracted.
data CorrectableRequestMessage
        = CorrectableRequestMessage_CreditEventNotification CreditEventNotification
        | CorrectableRequestMessage_NonpublicExecutionReport NonpublicExecutionReport
        | CorrectableRequestMessage_RequestValuationReport RequestValuationReport
        
        deriving (Eq,Show)
instance SchemaType CorrectableRequestMessage where
    parseSchemaType s = do
        (fmap CorrectableRequestMessage_CreditEventNotification $ parseSchemaType s)
        `onFail`
        (fmap CorrectableRequestMessage_NonpublicExecutionReport $ parseSchemaType s)
        `onFail`
        (fmap CorrectableRequestMessage_RequestValuationReport $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of CorrectableRequestMessage,\n\
\  namely one of:\n\
\CreditEventNotification,NonpublicExecutionReport,RequestValuationReport"
    schemaTypeToXML _s (CorrectableRequestMessage_CreditEventNotification x) = schemaTypeToXML "creditEventNotification" x
    schemaTypeToXML _s (CorrectableRequestMessage_NonpublicExecutionReport x) = schemaTypeToXML "nonpublicExecutionReport" x
    schemaTypeToXML _s (CorrectableRequestMessage_RequestValuationReport x) = schemaTypeToXML "requestValuationReport" x
instance Extension CorrectableRequestMessage RequestMessage where
    supertype v = RequestMessage_CorrectableRequestMessage v
instance Extension CorrectableRequestMessage Message where
    supertype = (supertype :: RequestMessage -> Message)
              . (supertype :: CorrectableRequestMessage -> RequestMessage)
              
instance Extension CorrectableRequestMessage Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: RequestMessage -> Message)
              . (supertype :: CorrectableRequestMessage -> RequestMessage)
              
 
-- | A type defining a correlation identifier and qualifying 
--   scheme
data CorrelationId = CorrelationId Xsd.NormalizedString CorrelationIdAttributes deriving (Eq,Show)
data CorrelationIdAttributes = CorrelationIdAttributes
    { correlIdAttrib_correlationIdScheme :: Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType CorrelationId where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- getAttribute "correlationIdScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ CorrelationId v (CorrelationIdAttributes a0)
    schemaTypeToXML s (CorrelationId bt at) =
        addXMLAttributes [ toXMLAttribute "correlationIdScheme" $ correlIdAttrib_correlationIdScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension CorrelationId Xsd.NormalizedString where
    supertype (CorrelationId s _) = s
 
-- | Identification of a business event, for example through its 
--   correlation id or a business identifier.
data EventIdentifier = EventIdentifier
        { eventIdent_choice0 :: (Maybe (OneOf2 ([CorrelationId],(Maybe (Xsd.PositiveInteger))) TradeIdentifier))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * A qualified identifier used to correlate between 
          --   messages
          --   
          --     * A numeric value that can be used to order messages 
          --   with the same correlation identifier from the same 
          --   sender.
          --   
          --   (2) tradeIdentifier
        }
        deriving (Eq,Show)
instance SchemaType EventIdentifier where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return EventIdentifier
            `apply` optional (oneOf' [ ("[CorrelationId] Maybe Xsd.PositiveInteger", fmap OneOf2 (return (,) `apply` between (Occurs (Just 0) (Just 2))
                                                                                                                             (parseSchemaType "correlationId")
                                                                                                             `apply` optional (parseSchemaType "sequenceNumber")))
                                     , ("TradeIdentifier", fmap TwoOf2 (parseSchemaType "tradeIdentifier"))
                                     ])
    schemaTypeToXML s x@EventIdentifier{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (\ (a,b) -> concat [ concatMap (schemaTypeToXML "correlationId") a
                                                       , maybe [] (schemaTypeToXML "sequenceNumber") b
                                                       ])
                                    (schemaTypeToXML "tradeIdentifier")
                                   ) $ eventIdent_choice0 x
            ]
 
-- | A coding scheme used to describe the matching/confirmation 
--   status of a trade, post-trade event, position, or cash 
--   flows.
data EventStatus = EventStatus Scheme EventStatusAttributes deriving (Eq,Show)
data EventStatusAttributes = EventStatusAttributes
    { eventStatusAttrib_eventStatusScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType EventStatus where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "eventStatusScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ EventStatus v (EventStatusAttributes a0)
    schemaTypeToXML s (EventStatus bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "eventStatusScheme") $ eventStatusAttrib_eventStatusScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension EventStatus Scheme where
    supertype (EventStatus s _) = s
 
-- | A type used in event status enquiry messages which relates 
--   an event identifier to its current status value.
data EventStatusItem = EventStatusItem
        { eventStatusItem_eventIdentifier :: Maybe EventIdentifier
          -- ^ An instance of a unique event identifier.
        , eventStatusItem_status :: Maybe EventStatus
          -- ^ An event status value.
        }
        deriving (Eq,Show)
instance SchemaType EventStatusItem where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return EventStatusItem
            `apply` optional (parseSchemaType "eventIdentifier")
            `apply` optional (parseSchemaType "status")
    schemaTypeToXML s x@EventStatusItem{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "eventIdentifier") $ eventStatusItem_eventIdentifier x
            , maybe [] (schemaTypeToXML "status") $ eventStatusItem_status x
            ]
 
-- | A type defining the content model for a message normally 
--   generated in response to a requestEventStatus request.
data EventStatusResponse = EventStatusResponse
        { eventStatusRespon_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , eventStatusRespon_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.
        , eventStatusRespon_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.
        , eventStatusRespon_header :: Maybe ResponseMessageHeader
        , eventStatusRespon_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , eventStatusRespon_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , eventStatusRespon_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , eventStatusRespon_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , eventStatusRespon_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.
        , eventStatusRespon_statusItem :: [EventStatusItem]
        , eventStatusRespon_party :: [Party]
        , eventStatusRespon_account :: [Account]
          -- ^ Optional account information used to precisely define the 
          --   origination and destination of financial instruments.
        }
        deriving (Eq,Show)
instance SchemaType EventStatusResponse 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 (EventStatusResponse 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` many (parseSchemaType "statusItem")
            `apply` many (parseSchemaType "party")
            `apply` many (parseSchemaType "account")
    schemaTypeToXML s x@EventStatusResponse{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ eventStatusRespon_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ eventStatusRespon_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ eventStatusRespon_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ eventStatusRespon_header x
            , concatMap (schemaTypeToXML "validation") $ eventStatusRespon_validation x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ eventStatusRespon_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ eventStatusRespon_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ eventStatusRespon_sequenceNumber x
            , concatMap (schemaTypeToXML "onBehalfOf") $ eventStatusRespon_onBehalfOf x
            , concatMap (schemaTypeToXML "statusItem") $ eventStatusRespon_statusItem x
            , concatMap (schemaTypeToXML "party") $ eventStatusRespon_party x
            , concatMap (schemaTypeToXML "account") $ eventStatusRespon_account x
            ]
instance Extension EventStatusResponse ResponseMessage where
    supertype v = ResponseMessage_EventStatusResponse v
instance Extension EventStatusResponse Message where
    supertype = (supertype :: ResponseMessage -> Message)
              . (supertype :: EventStatusResponse -> ResponseMessage)
              
instance Extension EventStatusResponse Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: ResponseMessage -> Message)
              . (supertype :: EventStatusResponse -> ResponseMessage)
              
 
-- | A type defining the basic content for a message sent to 
--   inform another system that some exception has been 
--   detected.
data Exception = Exception
        { exception_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , exception_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.
        , exception_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.
        , exception_header :: Maybe ExceptionMessageHeader
        , exception_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , exception_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , exception_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , exception_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , exception_reason :: [Reason]
          -- ^ An instance of the Reason type used to record the nature of 
          --   any errors associated with a message.
        , exception_additionalData :: Maybe AdditionalData
          -- ^ Any string of additional data that may help the message 
          --   processor, for example in a rejection message this might 
          --   contain a code value or the text of the original request 
          --   (within a CDATA section).
        }
        deriving (Eq,Show)
instance SchemaType Exception 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 (Exception 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` many (parseSchemaType "reason")
            `apply` optional (parseSchemaType "additionalData")
    schemaTypeToXML s x@Exception{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ exception_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ exception_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ exception_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ exception_header x
            , concatMap (schemaTypeToXML "validation") $ exception_validation x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ exception_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ exception_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ exception_sequenceNumber x
            , concatMap (schemaTypeToXML "reason") $ exception_reason x
            , maybe [] (schemaTypeToXML "additionalData") $ exception_additionalData x
            ]
instance Extension Exception Message where
    supertype v = Message_Exception v
instance Extension Exception Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: Exception -> Message)
              
 
-- | A type defining the content model for an exception message 
--   header.
data ExceptionMessageHeader = ExceptionMessageHeader
        { exceptMessageHeader_messageId :: Maybe MessageId
          -- ^ A unique identifier (within its coding scheme) assigned to 
          --   the message by its creating party.
        , exceptMessageHeader_inReplyTo :: Maybe MessageId
          -- ^ A copy of the unique message identifier (within it own 
          --   coding scheme) to which this message is responding.
        , exceptMessageHeader_sentBy :: Maybe MessageAddress
          -- ^ The unique identifier (within its coding scheme) for the 
          --   originator of a message instance.
        , exceptMessageHeader_sendTo :: [MessageAddress]
          -- ^ A unique identifier (within its coding scheme) indicating 
          --   an intended recipent of a message.
        , exceptMessageHeader_copyTo :: [MessageAddress]
          -- ^ A unique identifier (within the specified coding scheme) 
          --   giving the details of some party to whom a copy of this 
          --   message will be sent for reference.
        , exceptMessageHeader_creationTimestamp :: Maybe Xsd.DateTime
          -- ^ The date and time (on the source system) when this message 
          --   instance was created.
        , exceptMessageHeader_expiryTimestamp :: Maybe Xsd.DateTime
          -- ^ The date and time (on the source system) when this message 
          --   instance will be considered expired.
        , exceptMessageHeader_implementationSpecification :: Maybe ImplementationSpecification
          -- ^ The version(s) of specifications that the sender asserts 
          --   the message was developed for.
        , exceptMessageHeader_partyMessageInformation :: [PartyMessageInformation]
          -- ^ Additional message information that may be provided by each 
          --   involved party.
        , exceptMessageHeader_signature :: [SignatureType]
        }
        deriving (Eq,Show)
instance SchemaType ExceptionMessageHeader where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ExceptionMessageHeader
            `apply` optional (parseSchemaType "messageId")
            `apply` optional (parseSchemaType "inReplyTo")
            `apply` optional (parseSchemaType "sentBy")
            `apply` many (parseSchemaType "sendTo")
            `apply` many (parseSchemaType "copyTo")
            `apply` optional (parseSchemaType "creationTimestamp")
            `apply` optional (parseSchemaType "expiryTimestamp")
            `apply` optional (parseSchemaType "implementationSpecification")
            `apply` many (parseSchemaType "partyMessageInformation")
            `apply` many (elementSignature)
    schemaTypeToXML s x@ExceptionMessageHeader{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "messageId") $ exceptMessageHeader_messageId x
            , maybe [] (schemaTypeToXML "inReplyTo") $ exceptMessageHeader_inReplyTo x
            , maybe [] (schemaTypeToXML "sentBy") $ exceptMessageHeader_sentBy x
            , concatMap (schemaTypeToXML "sendTo") $ exceptMessageHeader_sendTo x
            , concatMap (schemaTypeToXML "copyTo") $ exceptMessageHeader_copyTo x
            , maybe [] (schemaTypeToXML "creationTimestamp") $ exceptMessageHeader_creationTimestamp x
            , maybe [] (schemaTypeToXML "expiryTimestamp") $ exceptMessageHeader_expiryTimestamp x
            , maybe [] (schemaTypeToXML "implementationSpecification") $ exceptMessageHeader_implementationSpecification x
            , concatMap (schemaTypeToXML "partyMessageInformation") $ exceptMessageHeader_partyMessageInformation x
            , concatMap (elementToXMLSignature) $ exceptMessageHeader_signature x
            ]
instance Extension ExceptionMessageHeader MessageHeader where
    supertype v = MessageHeader_ExceptionMessageHeader v
 
-- | A type defining the basic structure of all FpML messages 
--   which is refined by its derived types.
data Message
        = Message_ResponseMessage ResponseMessage
        | Message_RequestMessage RequestMessage
        | Message_NotificationMessage NotificationMessage
        | Message_Exception Exception
        
        deriving (Eq,Show)
instance SchemaType Message where
    parseSchemaType s = do
        (fmap Message_ResponseMessage $ parseSchemaType s)
        `onFail`
        (fmap Message_RequestMessage $ parseSchemaType s)
        `onFail`
        (fmap Message_NotificationMessage $ parseSchemaType s)
        `onFail`
        (fmap Message_Exception $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of Message,\n\
\  namely one of:\n\
\ResponseMessage,RequestMessage,NotificationMessage,Exception"
    schemaTypeToXML _s (Message_ResponseMessage x) = schemaTypeToXML "responseMessage" x
    schemaTypeToXML _s (Message_RequestMessage x) = schemaTypeToXML "requestMessage" x
    schemaTypeToXML _s (Message_NotificationMessage x) = schemaTypeToXML "notificationMessage" x
    schemaTypeToXML _s (Message_Exception x) = schemaTypeToXML "exception" x
instance Extension Message Document where
    supertype v = Document_Message v
 
-- | A type holding a structure that is unvalidated
data UnprocessedElementWrapper = UnprocessedElementWrapper
        { unprocElementWrapper_any0 :: AnyElement
        }
        deriving (Eq,Show)
instance SchemaType UnprocessedElementWrapper where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return UnprocessedElementWrapper
            `apply` parseAnyElement
    schemaTypeToXML s x@UnprocessedElementWrapper{} =
        toXMLElement s []
            [ toXMLAnyElement $ unprocElementWrapper_any0 x
            ]
 
-- | The data type used for identifying a message address.
data MessageAddress = MessageAddress Scheme MessageAddressAttributes deriving (Eq,Show)
data MessageAddressAttributes = MessageAddressAttributes
    { messageAddressAttrib_messageAddressScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType MessageAddress where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "messageAddressScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ MessageAddress v (MessageAddressAttributes a0)
    schemaTypeToXML s (MessageAddress bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "messageAddressScheme") $ messageAddressAttrib_messageAddressScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension MessageAddress Scheme where
    supertype (MessageAddress s _) = s
 
-- | A type defining the content model for a generic message 
--   header that is refined by its derived classes.
data MessageHeader
        = MessageHeader_ResponseMessageHeader ResponseMessageHeader
        | MessageHeader_RequestMessageHeader RequestMessageHeader
        | MessageHeader_NotificationMessageHeader NotificationMessageHeader
        | MessageHeader_ExceptionMessageHeader ExceptionMessageHeader
        
        deriving (Eq,Show)
instance SchemaType MessageHeader where
    parseSchemaType s = do
        (fmap MessageHeader_ResponseMessageHeader $ parseSchemaType s)
        `onFail`
        (fmap MessageHeader_RequestMessageHeader $ parseSchemaType s)
        `onFail`
        (fmap MessageHeader_NotificationMessageHeader $ parseSchemaType s)
        `onFail`
        (fmap MessageHeader_ExceptionMessageHeader $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of MessageHeader,\n\
\  namely one of:\n\
\ResponseMessageHeader,RequestMessageHeader,NotificationMessageHeader,ExceptionMessageHeader"
    schemaTypeToXML _s (MessageHeader_ResponseMessageHeader x) = schemaTypeToXML "responseMessageHeader" x
    schemaTypeToXML _s (MessageHeader_RequestMessageHeader x) = schemaTypeToXML "requestMessageHeader" x
    schemaTypeToXML _s (MessageHeader_NotificationMessageHeader x) = schemaTypeToXML "notificationMessageHeader" x
    schemaTypeToXML _s (MessageHeader_ExceptionMessageHeader x) = schemaTypeToXML "exceptionMessageHeader" x
 
-- | The data type use for message identifiers.
data MessageId = MessageId Scheme MessageIdAttributes deriving (Eq,Show)
data MessageIdAttributes = MessageIdAttributes
    { messageIdAttrib_messageIdScheme :: Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType MessageId where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- getAttribute "messageIdScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ MessageId v (MessageIdAttributes a0)
    schemaTypeToXML s (MessageId bt at) =
        addXMLAttributes [ toXMLAttribute "messageIdScheme" $ messageIdAttrib_messageIdScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension MessageId Scheme where
    supertype (MessageId s _) = s
 
-- | A type defining the content model for a request message 
--   that cannot be subsequently corrected or retracted.
data NonCorrectableRequestMessage
        = NonCorrectableRequestMessage_VerificationStatusNotification VerificationStatusNotification
        | NonCorrectableRequestMessage_RequestRetransmission RequestRetransmission
        | NonCorrectableRequestMessage_RequestEventStatus RequestEventStatus
        | NonCorrectableRequestMessage_NonpublicExecutionReportRetracted NonpublicExecutionReportRetracted
        
        deriving (Eq,Show)
instance SchemaType NonCorrectableRequestMessage where
    parseSchemaType s = do
        (fmap NonCorrectableRequestMessage_VerificationStatusNotification $ parseSchemaType s)
        `onFail`
        (fmap NonCorrectableRequestMessage_RequestRetransmission $ parseSchemaType s)
        `onFail`
        (fmap NonCorrectableRequestMessage_RequestEventStatus $ parseSchemaType s)
        `onFail`
        (fmap NonCorrectableRequestMessage_NonpublicExecutionReportRetracted $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of NonCorrectableRequestMessage,\n\
\  namely one of:\n\
\VerificationStatusNotification,RequestRetransmission,RequestEventStatus,NonpublicExecutionReportRetracted"
    schemaTypeToXML _s (NonCorrectableRequestMessage_VerificationStatusNotification x) = schemaTypeToXML "verificationStatusNotification" x
    schemaTypeToXML _s (NonCorrectableRequestMessage_RequestRetransmission x) = schemaTypeToXML "requestRetransmission" x
    schemaTypeToXML _s (NonCorrectableRequestMessage_RequestEventStatus x) = schemaTypeToXML "requestEventStatus" x
    schemaTypeToXML _s (NonCorrectableRequestMessage_NonpublicExecutionReportRetracted x) = schemaTypeToXML "nonpublicExecutionReportRetracted" x
instance Extension NonCorrectableRequestMessage RequestMessage where
    supertype v = RequestMessage_NonCorrectableRequestMessage v
instance Extension NonCorrectableRequestMessage Message where
    supertype = (supertype :: RequestMessage -> Message)
              . (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              
instance Extension NonCorrectableRequestMessage Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: RequestMessage -> Message)
              . (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              
 
-- | A type defining the basic content for a message sent to 
--   inform another system that some 'business event' has 
--   occured. Notifications are not expected to be replied to.
data NotificationMessage
        = NotificationMessage_ServiceNotification ServiceNotification
        | NotificationMessage_ValuationReportRetracted ValuationReportRetracted
        | NotificationMessage_ValuationReport ValuationReport
        
        deriving (Eq,Show)
instance SchemaType NotificationMessage where
    parseSchemaType s = do
        (fmap NotificationMessage_ServiceNotification $ parseSchemaType s)
        `onFail`
        (fmap NotificationMessage_ValuationReportRetracted $ parseSchemaType s)
        `onFail`
        (fmap NotificationMessage_ValuationReport $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of NotificationMessage,\n\
\  namely one of:\n\
\ServiceNotification,ValuationReportRetracted,ValuationReport"
    schemaTypeToXML _s (NotificationMessage_ServiceNotification x) = schemaTypeToXML "serviceNotification" x
    schemaTypeToXML _s (NotificationMessage_ValuationReportRetracted x) = schemaTypeToXML "valuationReportRetracted" x
    schemaTypeToXML _s (NotificationMessage_ValuationReport x) = schemaTypeToXML "valuationReport" x
instance Extension NotificationMessage Message where
    supertype v = Message_NotificationMessage v
 
-- | A type that refines the generic message header to match the 
--   requirements of a NotificationMessage.
data NotificationMessageHeader = NotificationMessageHeader
        { notifMessageHeader_messageId :: Maybe MessageId
          -- ^ A unique identifier (within its coding scheme) assigned to 
          --   the message by its creating party.
        , notifMessageHeader_inReplyTo :: Maybe MessageId
          -- ^ A copy of the unique message identifier (within it own 
          --   coding scheme) to which this message is responding.
        , notifMessageHeader_sentBy :: Maybe MessageAddress
          -- ^ The unique identifier (within its coding scheme) for the 
          --   originator of a message instance.
        , notifMessageHeader_sendTo :: [MessageAddress]
          -- ^ A unique identifier (within its coding scheme) indicating 
          --   an intended recipent of a message.
        , notifMessageHeader_copyTo :: [MessageAddress]
          -- ^ A unique identifier (within the specified coding scheme) 
          --   giving the details of some party to whom a copy of this 
          --   message will be sent for reference.
        , notifMessageHeader_creationTimestamp :: Maybe Xsd.DateTime
          -- ^ The date and time (on the source system) when this message 
          --   instance was created.
        , notifMessageHeader_expiryTimestamp :: Maybe Xsd.DateTime
          -- ^ The date and time (on the source system) when this message 
          --   instance will be considered expired.
        , notifMessageHeader_implementationSpecification :: Maybe ImplementationSpecification
          -- ^ The version(s) of specifications that the sender asserts 
          --   the message was developed for.
        , notifMessageHeader_partyMessageInformation :: [PartyMessageInformation]
          -- ^ Additional message information that may be provided by each 
          --   involved party.
        , notifMessageHeader_signature :: [SignatureType]
        }
        deriving (Eq,Show)
instance SchemaType NotificationMessageHeader where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return NotificationMessageHeader
            `apply` optional (parseSchemaType "messageId")
            `apply` optional (parseSchemaType "inReplyTo")
            `apply` optional (parseSchemaType "sentBy")
            `apply` many (parseSchemaType "sendTo")
            `apply` many (parseSchemaType "copyTo")
            `apply` optional (parseSchemaType "creationTimestamp")
            `apply` optional (parseSchemaType "expiryTimestamp")
            `apply` optional (parseSchemaType "implementationSpecification")
            `apply` many (parseSchemaType "partyMessageInformation")
            `apply` many (elementSignature)
    schemaTypeToXML s x@NotificationMessageHeader{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "messageId") $ notifMessageHeader_messageId x
            , maybe [] (schemaTypeToXML "inReplyTo") $ notifMessageHeader_inReplyTo x
            , maybe [] (schemaTypeToXML "sentBy") $ notifMessageHeader_sentBy x
            , concatMap (schemaTypeToXML "sendTo") $ notifMessageHeader_sendTo x
            , concatMap (schemaTypeToXML "copyTo") $ notifMessageHeader_copyTo x
            , maybe [] (schemaTypeToXML "creationTimestamp") $ notifMessageHeader_creationTimestamp x
            , maybe [] (schemaTypeToXML "expiryTimestamp") $ notifMessageHeader_expiryTimestamp x
            , maybe [] (schemaTypeToXML "implementationSpecification") $ notifMessageHeader_implementationSpecification x
            , concatMap (schemaTypeToXML "partyMessageInformation") $ notifMessageHeader_partyMessageInformation x
            , concatMap (elementToXMLSignature) $ notifMessageHeader_signature x
            ]
instance Extension NotificationMessageHeader MessageHeader where
    supertype v = MessageHeader_NotificationMessageHeader v
 
-- | A version of a specification document used by the message 
--   generator to format the document.
data ImplementationSpecification = ImplementationSpecification
        { implemSpecif_name :: Maybe Xsd.NormalizedString
        , implemSpecif_version :: Maybe ImplementationSpecificationVersion
        , implemSpecif_date :: Maybe Xsd.Date
        }
        deriving (Eq,Show)
instance SchemaType ImplementationSpecification where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ImplementationSpecification
            `apply` optional (parseSchemaType "name")
            `apply` optional (parseSchemaType "version")
            `apply` optional (parseSchemaType "date")
    schemaTypeToXML s x@ImplementationSpecification{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "name") $ implemSpecif_name x
            , maybe [] (schemaTypeToXML "version") $ implemSpecif_version x
            , maybe [] (schemaTypeToXML "date") $ implemSpecif_date x
            ]
 
data ImplementationSpecificationVersion = ImplementationSpecificationVersion Scheme ImplementationSpecificationVersionAttributes deriving (Eq,Show)
data ImplementationSpecificationVersionAttributes = ImplementationSpecificationVersionAttributes
    { isva_implementationSpecificationVersionScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType ImplementationSpecificationVersion where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "implementationSpecificationVersionScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ ImplementationSpecificationVersion v (ImplementationSpecificationVersionAttributes a0)
    schemaTypeToXML s (ImplementationSpecificationVersion bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "implementationSpecificationVersionScheme") $ isva_implementationSpecificationVersionScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension ImplementationSpecificationVersion Scheme where
    supertype (ImplementationSpecificationVersion s _) = s
 
-- | A type defining additional information that may be recorded 
--   against a message.
data PartyMessageInformation = PartyMessageInformation
        { partyMessageInfo_partyReference :: Maybe PartyReference
          -- ^ Identifies that party that has ownership of this 
          --   information.
        }
        deriving (Eq,Show)
instance SchemaType PartyMessageInformation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PartyMessageInformation
            `apply` optional (parseSchemaType "partyReference")
    schemaTypeToXML s x@PartyMessageInformation{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "partyReference") $ partyMessageInfo_partyReference x
            ]
 
-- | A structure used to group together individual messages that 
--   can be acted on at a group level.
data PortfolioReference = PortfolioReference
        { portfRef_portfolioName :: Maybe PortfolioName
          -- ^ An identifier that is unique for each portfolio-level 
          --   request, and which can be used to group together the 
          --   individual messages in the portfolio request.
        , portfRef_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric, sequentially ascending (i.e. gapless) value 
          --   (starting at 1) that can be used to identify and 
          --   distinguish the individual constituents of a portfolio 
          --   request. A recipient should ensure that all sequence 
          --   numbers from 1 to the final sequence number (where 
          --   submissionsComplete is true) have arrived before completing 
          --   the portfolio request.
        , portfRef_submissionsComplete :: Maybe Xsd.Boolean
          -- ^ Indicates whether all individual requests have been 
          --   submitted for this portfolio request.
        }
        deriving (Eq,Show)
instance SchemaType PortfolioReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PortfolioReference
            `apply` optional (parseSchemaType "portfolioName")
            `apply` optional (parseSchemaType "sequenceNumber")
            `apply` optional (parseSchemaType "submissionsComplete")
    schemaTypeToXML s x@PortfolioReference{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "portfolioName") $ portfRef_portfolioName x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ portfRef_sequenceNumber x
            , maybe [] (schemaTypeToXML "submissionsComplete") $ portfRef_submissionsComplete x
            ]
instance Extension PortfolioReference PortfolioReferenceBase where
    supertype (PortfolioReference e0 e1 e2) =
               PortfolioReferenceBase e0
 
-- | A structure used to group together individual messages that 
--   can be acted on at a group level.
data PortfolioConstituentReference = PortfolioConstituentReference
        { portfConstitRef_portfolioName :: Maybe PortfolioName
          -- ^ An identifier that is unique for each portfolio-level 
          --   request, and which can be used to group together the 
          --   individual messages in the portfolio request.
        , portfConstitRef_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric, sequentially ascending (i.e. gapless) value 
          --   (starting at 1) that can be used to identify and 
          --   distinguish the individual constituents of a portfolio 
          --   request. A recipient should ensure that all sequence 
          --   numbers from 1 to the final sequence number (where 
          --   submissionsComplete is true) have arrived before completing 
          --   the portfolio request.
        }
        deriving (Eq,Show)
instance SchemaType PortfolioConstituentReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PortfolioConstituentReference
            `apply` optional (parseSchemaType "portfolioName")
            `apply` optional (parseSchemaType "sequenceNumber")
    schemaTypeToXML s x@PortfolioConstituentReference{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "portfolioName") $ portfConstitRef_portfolioName x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ portfConstitRef_sequenceNumber x
            ]
instance Extension PortfolioConstituentReference PortfolioReferenceBase where
    supertype (PortfolioConstituentReference e0 e1) =
               PortfolioReferenceBase e0
 
-- | A structure used to identify a portfolio in a message.
data PortfolioReferenceBase = PortfolioReferenceBase
        { portfRefBase_portfolioName :: Maybe PortfolioName
          -- ^ An identifier that is unique for each portfolio-level 
          --   request, and which can be used to group together the 
          --   individual messages in the portfolio request.
        }
        deriving (Eq,Show)
instance SchemaType PortfolioReferenceBase where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PortfolioReferenceBase
            `apply` optional (parseSchemaType "portfolioName")
    schemaTypeToXML s x@PortfolioReferenceBase{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "portfolioName") $ portfRefBase_portfolioName x
            ]
 
 
 
 
 
-- | Provides a lexical location (i.e. a line number and 
--   character for bad XML) or an XPath location (i.e. place to 
--   identify the bad location for valid XML).
data ProblemLocation = ProblemLocation Xsd.NormalizedString ProblemLocationAttributes deriving (Eq,Show)
data ProblemLocationAttributes = ProblemLocationAttributes
    { problemLocatAttrib_locationType :: Maybe Xsd.Token
      -- ^ The value of the locationType attribute defines which type 
      --   of location has been given. It may take the values 
      --   'lexical' or 'xpath'.
    }
    deriving (Eq,Show)
instance SchemaType ProblemLocation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "locationType" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ ProblemLocation v (ProblemLocationAttributes a0)
    schemaTypeToXML s (ProblemLocation bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "locationType") $ problemLocatAttrib_locationType at
                         ]
            $ schemaTypeToXML s bt
instance Extension ProblemLocation Xsd.NormalizedString where
    supertype (ProblemLocation s _) = s
 
-- | A type defining a content model for describing the nature 
--   and possible location of a error within a previous message.
data Reason = Reason
        { reason_code :: Maybe ReasonCode
          -- ^ A machine interpretable error code.
        , reason_location :: Maybe ProblemLocation
          -- ^ A value indicating the location of the problem within the 
          --   subject message.
        , reason_description :: Maybe Xsd.XsdString
          -- ^ Plain English text describing the associated error 
          --   condition
        , reason_validationRuleId :: Maybe Validation
          -- ^ A reference identifying a rule within a validation scheme
        , reason_additionalData :: [AdditionalData]
          -- ^ Any string of additional data that may help the message 
          --   processor, for example in a rejection message this might 
          --   contain a code value or the text of any one of the messages 
          --   (within a CDATA section).
        }
        deriving (Eq,Show)
instance SchemaType Reason where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return Reason
            `apply` optional (parseSchemaType "reasonCode")
            `apply` optional (parseSchemaType "location")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "validationRuleId")
            `apply` many (parseSchemaType "additionalData")
    schemaTypeToXML s x@Reason{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "reasonCode") $ reason_code x
            , maybe [] (schemaTypeToXML "location") $ reason_location x
            , maybe [] (schemaTypeToXML "description") $ reason_description x
            , maybe [] (schemaTypeToXML "validationRuleId") $ reason_validationRuleId x
            , concatMap (schemaTypeToXML "additionalData") $ reason_additionalData x
            ]
 
-- | Defines a list of machine interpretable error codes.
data ReasonCode = ReasonCode Scheme ReasonCodeAttributes deriving (Eq,Show)
data ReasonCodeAttributes = ReasonCodeAttributes
    { reasonCodeAttrib_reasonCodeScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType ReasonCode where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "reasonCodeScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ ReasonCode v (ReasonCodeAttributes a0)
    schemaTypeToXML s (ReasonCode bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "reasonCodeScheme") $ reasonCodeAttrib_reasonCodeScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension ReasonCode Scheme where
    supertype (ReasonCode s _) = s
 
-- | A type that allows the specific report and section to be 
--   identified.
data ReportIdentification = ReportIdentification
        { reportIdent_reportId :: Maybe ReportId
          -- ^ An identifier for the specific instance of this report.
        , reportIdent_sectionNumber :: Maybe Xsd.PositiveInteger
          -- ^ A strictly ascending sequential (gapless) numeric value 
          --   that can be used to identify the section of a report.
        , reportIdent_numberOfSections :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value, optionally supplied by the sender, that 
          --   can be used to specify the number of sections constituting 
          --   a report.
        , reportIdent_submissionsComplete :: Maybe Xsd.Boolean
          -- ^ Indicates whether all sections have been sent for this 
          --   report instance ID.
        }
        deriving (Eq,Show)
instance SchemaType ReportIdentification where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReportIdentification
            `apply` optional (parseSchemaType "reportId")
            `apply` optional (parseSchemaType "sectionNumber")
            `apply` optional (parseSchemaType "numberOfSections")
            `apply` optional (parseSchemaType "submissionsComplete")
    schemaTypeToXML s x@ReportIdentification{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "reportId") $ reportIdent_reportId x
            , maybe [] (schemaTypeToXML "sectionNumber") $ reportIdent_sectionNumber x
            , maybe [] (schemaTypeToXML "numberOfSections") $ reportIdent_numberOfSections x
            , maybe [] (schemaTypeToXML "submissionsComplete") $ reportIdent_submissionsComplete x
            ]
instance Extension ReportIdentification ReportSectionIdentification where
    supertype (ReportIdentification e0 e1 e2 e3) =
               ReportSectionIdentification e0 e1
 
-- | A type that allows the specific report and section to be 
--   identified.
data ReportSectionIdentification = ReportSectionIdentification
        { reportSectionIdent_reportId :: Maybe ReportId
          -- ^ An identifier for the specific instance of this report.
        , reportSectionIdent_sectionNumber :: Maybe Xsd.PositiveInteger
          -- ^ A strictly ascending sequential (gapless) numeric value 
          --   that can be used to identify the section of a report.
        }
        deriving (Eq,Show)
instance SchemaType ReportSectionIdentification where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ReportSectionIdentification
            `apply` optional (parseSchemaType "reportId")
            `apply` optional (parseSchemaType "sectionNumber")
    schemaTypeToXML s x@ReportSectionIdentification{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "reportId") $ reportSectionIdent_reportId x
            , maybe [] (schemaTypeToXML "sectionNumber") $ reportSectionIdent_sectionNumber x
            ]
 
-- | A type that can be used to hold an identifier for a report 
--   instance.
data ReportId = ReportId Scheme ReportIdAttributes deriving (Eq,Show)
data ReportIdAttributes = ReportIdAttributes
    { reportIdAttrib_reportIdScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType ReportId where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "reportIdScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ ReportId v (ReportIdAttributes a0)
    schemaTypeToXML s (ReportId bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "reportIdScheme") $ reportIdAttrib_reportIdScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension ReportId Scheme where
    supertype (ReportId s _) = s
 
-- | A type defining the content model for a message allowing 
--   one party to query the status of one event (trade or 
--   post-trade event) previously sent to another party.
data RequestEventStatus = RequestEventStatus
        { reqEventStatus_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , reqEventStatus_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.
        , reqEventStatus_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.
        , reqEventStatus_header :: Maybe RequestMessageHeader
        , reqEventStatus_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , reqEventStatus_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , reqEventStatus_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , reqEventStatus_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , reqEventStatus_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.
        , reqEventStatus_businessProcess :: Maybe BusinessProcess
        , reqEventStatus_eventIdentifier :: Maybe EventIdentifier
        , reqEventStatus_party :: [Party]
        , reqEventStatus_account :: [Account]
          -- ^ Optional account information used to precisely define the 
          --   origination and destination of financial instruments.
        }
        deriving (Eq,Show)
instance SchemaType RequestEventStatus 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 (RequestEventStatus 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 "businessProcess")
            `apply` optional (parseSchemaType "eventIdentifier")
            `apply` many (parseSchemaType "party")
            `apply` many (parseSchemaType "account")
    schemaTypeToXML s x@RequestEventStatus{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ reqEventStatus_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ reqEventStatus_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ reqEventStatus_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ reqEventStatus_header x
            , concatMap (schemaTypeToXML "validation") $ reqEventStatus_validation x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ reqEventStatus_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ reqEventStatus_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ reqEventStatus_sequenceNumber x
            , concatMap (schemaTypeToXML "onBehalfOf") $ reqEventStatus_onBehalfOf x
            , maybe [] (schemaTypeToXML "businessProcess") $ reqEventStatus_businessProcess x
            , maybe [] (schemaTypeToXML "eventIdentifier") $ reqEventStatus_eventIdentifier x
            , concatMap (schemaTypeToXML "party") $ reqEventStatus_party x
            , concatMap (schemaTypeToXML "account") $ reqEventStatus_account x
            ]
instance Extension RequestEventStatus NonCorrectableRequestMessage where
    supertype v = NonCorrectableRequestMessage_RequestEventStatus v
instance Extension RequestEventStatus RequestMessage where
    supertype = (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              . (supertype :: RequestEventStatus -> NonCorrectableRequestMessage)
              
instance Extension RequestEventStatus Message where
    supertype = (supertype :: RequestMessage -> Message)
              . (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              . (supertype :: RequestEventStatus -> NonCorrectableRequestMessage)
              
instance Extension RequestEventStatus Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: RequestMessage -> Message)
              . (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              . (supertype :: RequestEventStatus -> NonCorrectableRequestMessage)
              
 
-- | A type that can be used to identify the type of business 
--   process in a request. Examples include Allocation, 
--   Clearing, Confirmation, etc.
data BusinessProcess = BusinessProcess Scheme BusinessProcessAttributes deriving (Eq,Show)
data BusinessProcessAttributes = BusinessProcessAttributes
    { busProcessAttrib_businessProcessScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType BusinessProcess where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "businessProcessScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ BusinessProcess v (BusinessProcessAttributes a0)
    schemaTypeToXML s (BusinessProcess bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "businessProcessScheme") $ busProcessAttrib_businessProcessScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension BusinessProcess Scheme where
    supertype (BusinessProcess s _) = s
 
-- | A type defining the basic content of a message that 
--   requests the receiver to perform some business operation 
--   determined by the message type and its content.
data RequestMessage
        = RequestMessage_NonCorrectableRequestMessage NonCorrectableRequestMessage
        | RequestMessage_CorrectableRequestMessage CorrectableRequestMessage
        
        deriving (Eq,Show)
instance SchemaType RequestMessage where
    parseSchemaType s = do
        (fmap RequestMessage_NonCorrectableRequestMessage $ parseSchemaType s)
        `onFail`
        (fmap RequestMessage_CorrectableRequestMessage $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of RequestMessage,\n\
\  namely one of:\n\
\NonCorrectableRequestMessage,CorrectableRequestMessage"
    schemaTypeToXML _s (RequestMessage_NonCorrectableRequestMessage x) = schemaTypeToXML "nonCorrectableRequestMessage" x
    schemaTypeToXML _s (RequestMessage_CorrectableRequestMessage x) = schemaTypeToXML "correctableRequestMessage" x
instance Extension RequestMessage Message where
    supertype v = Message_RequestMessage v
 
-- | A type refining the generic message header content to make 
--   it specific to request messages.
data RequestMessageHeader = RequestMessageHeader
        { reqMessageHeader_messageId :: Maybe MessageId
          -- ^ A unique identifier (within its coding scheme) assigned to 
          --   the message by its creating party.
        , reqMessageHeader_sentBy :: Maybe MessageAddress
          -- ^ The unique identifier (within its coding scheme) for the 
          --   originator of a message instance.
        , reqMessageHeader_sendTo :: [MessageAddress]
          -- ^ A unique identifier (within its coding scheme) indicating 
          --   an intended recipent of a message.
        , reqMessageHeader_copyTo :: [MessageAddress]
          -- ^ A unique identifier (within the specified coding scheme) 
          --   giving the details of some party to whom a copy of this 
          --   message will be sent for reference.
        , reqMessageHeader_creationTimestamp :: Maybe Xsd.DateTime
          -- ^ The date and time (on the source system) when this message 
          --   instance was created.
        , reqMessageHeader_expiryTimestamp :: Maybe Xsd.DateTime
          -- ^ The date and time (on the source system) when this message 
          --   instance will be considered expired.
        , reqMessageHeader_implementationSpecification :: Maybe ImplementationSpecification
          -- ^ The version(s) of specifications that the sender asserts 
          --   the message was developed for.
        , reqMessageHeader_partyMessageInformation :: [PartyMessageInformation]
          -- ^ Additional message information that may be provided by each 
          --   involved party.
        , reqMessageHeader_signature :: [SignatureType]
        }
        deriving (Eq,Show)
instance SchemaType RequestMessageHeader where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return RequestMessageHeader
            `apply` optional (parseSchemaType "messageId")
            `apply` optional (parseSchemaType "sentBy")
            `apply` many (parseSchemaType "sendTo")
            `apply` many (parseSchemaType "copyTo")
            `apply` optional (parseSchemaType "creationTimestamp")
            `apply` optional (parseSchemaType "expiryTimestamp")
            `apply` optional (parseSchemaType "implementationSpecification")
            `apply` many (parseSchemaType "partyMessageInformation")
            `apply` many (elementSignature)
    schemaTypeToXML s x@RequestMessageHeader{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "messageId") $ reqMessageHeader_messageId x
            , maybe [] (schemaTypeToXML "sentBy") $ reqMessageHeader_sentBy x
            , concatMap (schemaTypeToXML "sendTo") $ reqMessageHeader_sendTo x
            , concatMap (schemaTypeToXML "copyTo") $ reqMessageHeader_copyTo x
            , maybe [] (schemaTypeToXML "creationTimestamp") $ reqMessageHeader_creationTimestamp x
            , maybe [] (schemaTypeToXML "expiryTimestamp") $ reqMessageHeader_expiryTimestamp x
            , maybe [] (schemaTypeToXML "implementationSpecification") $ reqMessageHeader_implementationSpecification x
            , concatMap (schemaTypeToXML "partyMessageInformation") $ reqMessageHeader_partyMessageInformation x
            , concatMap (elementToXMLSignature) $ reqMessageHeader_signature x
            ]
instance Extension RequestMessageHeader MessageHeader where
    supertype v = MessageHeader_RequestMessageHeader v
 
-- | A message to request that a message be retransmitted. The 
--   original message will typically be a component of a group 
--   of messages, such as a portfolio or a report in multiple 
--   parts.
data RequestRetransmission = RequestRetransmission
        { reqRetran_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , reqRetran_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.
        , reqRetran_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.
        , reqRetran_header :: Maybe RequestMessageHeader
        , reqRetran_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , reqRetran_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , reqRetran_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , reqRetran_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , reqRetran_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.
        , reqRetran_choice6 :: (Maybe (OneOf2 PortfolioConstituentReference ReportSectionIdentification))
          -- ^ Choice between:
          --   
          --   (1) portfolioReference
          --   
          --   (2) reportIdentification
        , reqRetran_party :: [Party]
        , reqRetran_account :: [Account]
          -- ^ Optional account information used to precisely define the 
          --   origination and destination of financial instruments.
        }
        deriving (Eq,Show)
instance SchemaType RequestRetransmission 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 (RequestRetransmission 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 (oneOf' [ ("PortfolioConstituentReference", fmap OneOf2 (parseSchemaType "portfolioReference"))
                                     , ("ReportSectionIdentification", fmap TwoOf2 (parseSchemaType "reportIdentification"))
                                     ])
            `apply` many (parseSchemaType "party")
            `apply` many (parseSchemaType "account")
    schemaTypeToXML s x@RequestRetransmission{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ reqRetran_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ reqRetran_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ reqRetran_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ reqRetran_header x
            , concatMap (schemaTypeToXML "validation") $ reqRetran_validation x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ reqRetran_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ reqRetran_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ reqRetran_sequenceNumber x
            , concatMap (schemaTypeToXML "onBehalfOf") $ reqRetran_onBehalfOf x
            , maybe [] (foldOneOf2  (schemaTypeToXML "portfolioReference")
                                    (schemaTypeToXML "reportIdentification")
                                   ) $ reqRetran_choice6 x
            , concatMap (schemaTypeToXML "party") $ reqRetran_party x
            , concatMap (schemaTypeToXML "account") $ reqRetran_account x
            ]
instance Extension RequestRetransmission NonCorrectableRequestMessage where
    supertype v = NonCorrectableRequestMessage_RequestRetransmission v
instance Extension RequestRetransmission RequestMessage where
    supertype = (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              . (supertype :: RequestRetransmission -> NonCorrectableRequestMessage)
              
instance Extension RequestRetransmission Message where
    supertype = (supertype :: RequestMessage -> Message)
              . (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              . (supertype :: RequestRetransmission -> NonCorrectableRequestMessage)
              
instance Extension RequestRetransmission Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: RequestMessage -> Message)
              . (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              . (supertype :: RequestRetransmission -> NonCorrectableRequestMessage)
              
 
-- | A type refining the generic message content model to make 
--   it specific to response messages.
data ResponseMessage
        = ResponseMessage_EventStatusResponse EventStatusResponse
        | ResponseMessage_Acknowledgement Acknowledgement
        
        deriving (Eq,Show)
instance SchemaType ResponseMessage where
    parseSchemaType s = do
        (fmap ResponseMessage_EventStatusResponse $ parseSchemaType s)
        `onFail`
        (fmap ResponseMessage_Acknowledgement $ parseSchemaType s)
        `onFail` fail "Parse failed when expecting an extension type of ResponseMessage,\n\
\  namely one of:\n\
\EventStatusResponse,Acknowledgement"
    schemaTypeToXML _s (ResponseMessage_EventStatusResponse x) = schemaTypeToXML "eventStatusResponse" x
    schemaTypeToXML _s (ResponseMessage_Acknowledgement x) = schemaTypeToXML "acknowledgement" x
instance Extension ResponseMessage Message where
    supertype v = Message_ResponseMessage v
 
-- | A type refining the generic message header to make it 
--   specific to response messages.
data ResponseMessageHeader = ResponseMessageHeader
        { responMessageHeader_messageId :: Maybe MessageId
          -- ^ A unique identifier (within its coding scheme) assigned to 
          --   the message by its creating party.
        , responMessageHeader_inReplyTo :: Maybe MessageId
          -- ^ A copy of the unique message identifier (within it own 
          --   coding scheme) to which this message is responding.
        , responMessageHeader_sentBy :: Maybe MessageAddress
          -- ^ The unique identifier (within its coding scheme) for the 
          --   originator of a message instance.
        , responMessageHeader_sendTo :: [MessageAddress]
          -- ^ A unique identifier (within its coding scheme) indicating 
          --   an intended recipent of a message.
        , responMessageHeader_copyTo :: [MessageAddress]
          -- ^ A unique identifier (within the specified coding scheme) 
          --   giving the details of some party to whom a copy of this 
          --   message will be sent for reference.
        , responMessageHeader_creationTimestamp :: Maybe Xsd.DateTime
          -- ^ The date and time (on the source system) when this message 
          --   instance was created.
        , responMessageHeader_expiryTimestamp :: Maybe Xsd.DateTime
          -- ^ The date and time (on the source system) when this message 
          --   instance will be considered expired.
        , responMessageHeader_implementationSpecification :: Maybe ImplementationSpecification
          -- ^ The version(s) of specifications that the sender asserts 
          --   the message was developed for.
        , responMessageHeader_partyMessageInformation :: [PartyMessageInformation]
          -- ^ Additional message information that may be provided by each 
          --   involved party.
        , responMessageHeader_signature :: [SignatureType]
        }
        deriving (Eq,Show)
instance SchemaType ResponseMessageHeader where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ResponseMessageHeader
            `apply` optional (parseSchemaType "messageId")
            `apply` optional (parseSchemaType "inReplyTo")
            `apply` optional (parseSchemaType "sentBy")
            `apply` many (parseSchemaType "sendTo")
            `apply` many (parseSchemaType "copyTo")
            `apply` optional (parseSchemaType "creationTimestamp")
            `apply` optional (parseSchemaType "expiryTimestamp")
            `apply` optional (parseSchemaType "implementationSpecification")
            `apply` many (parseSchemaType "partyMessageInformation")
            `apply` many (elementSignature)
    schemaTypeToXML s x@ResponseMessageHeader{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "messageId") $ responMessageHeader_messageId x
            , maybe [] (schemaTypeToXML "inReplyTo") $ responMessageHeader_inReplyTo x
            , maybe [] (schemaTypeToXML "sentBy") $ responMessageHeader_sentBy x
            , concatMap (schemaTypeToXML "sendTo") $ responMessageHeader_sendTo x
            , concatMap (schemaTypeToXML "copyTo") $ responMessageHeader_copyTo x
            , maybe [] (schemaTypeToXML "creationTimestamp") $ responMessageHeader_creationTimestamp x
            , maybe [] (schemaTypeToXML "expiryTimestamp") $ responMessageHeader_expiryTimestamp x
            , maybe [] (schemaTypeToXML "implementationSpecification") $ responMessageHeader_implementationSpecification x
            , concatMap (schemaTypeToXML "partyMessageInformation") $ responMessageHeader_partyMessageInformation x
            , concatMap (elementToXMLSignature) $ responMessageHeader_signature x
            ]
instance Extension ResponseMessageHeader MessageHeader where
    supertype v = MessageHeader_ResponseMessageHeader v
 
 
 
 
 
 
 
 
 
-- | Event Status messages.
 
elementRequestEventStatus :: XMLParser RequestEventStatus
elementRequestEventStatus = parseSchemaType "requestEventStatus"
elementToXMLRequestEventStatus :: RequestEventStatus -> [Content ()]
elementToXMLRequestEventStatus = schemaTypeToXML "requestEventStatus"
 
elementRequestRetransmission :: XMLParser RequestRetransmission
elementRequestRetransmission = parseSchemaType "requestRetransmission"
elementToXMLRequestRetransmission :: RequestRetransmission -> [Content ()]
elementToXMLRequestRetransmission = schemaTypeToXML "requestRetransmission"
 
-- | A type defining the content model for a message that allows 
--   a service to send a notification message to a user of the 
--   service.
data ServiceNotification = ServiceNotification
        { serviceNotif_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , serviceNotif_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.
        , serviceNotif_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.
        , serviceNotif_header :: Maybe NotificationMessageHeader
        , serviceNotif_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , serviceNotif_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , serviceNotif_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , serviceNotif_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , serviceNotif_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.
        , serviceNotif_serviceName :: Maybe Xsd.NormalizedString
          -- ^ The name of the service to which the message applies
        , serviceNotif_choice7 :: (Maybe (OneOf3 ServiceStatus ServiceProcessingStatus ServiceAdvisory))
          -- ^ Choice between:
          --   
          --   (1) The current state of the service (e.g. Available, 
          --   Unavailable).
          --   
          --   (2) A description of the stage of processing of the 
          --   service, for example EndofDayProcessingCutoffOccurred, 
          --   EndOfDayProcessingCompleted. [TBD: could be combined 
          --   with advisory]
          --   
          --   (3) A human-readable message providing information about 
          --   the service..
        }
        deriving (Eq,Show)
instance SchemaType ServiceNotification 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 (ServiceNotification 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 "serviceName")
            `apply` optional (oneOf' [ ("ServiceStatus", fmap OneOf3 (parseSchemaType "status"))
                                     , ("ServiceProcessingStatus", fmap TwoOf3 (parseSchemaType "processingStatus"))
                                     , ("ServiceAdvisory", fmap ThreeOf3 (parseSchemaType "advisory"))
                                     ])
    schemaTypeToXML s x@ServiceNotification{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ serviceNotif_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ serviceNotif_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ serviceNotif_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ serviceNotif_header x
            , concatMap (schemaTypeToXML "validation") $ serviceNotif_validation x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ serviceNotif_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ serviceNotif_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ serviceNotif_sequenceNumber x
            , concatMap (schemaTypeToXML "onBehalfOf") $ serviceNotif_onBehalfOf x
            , maybe [] (schemaTypeToXML "serviceName") $ serviceNotif_serviceName x
            , maybe [] (foldOneOf3  (schemaTypeToXML "status")
                                    (schemaTypeToXML "processingStatus")
                                    (schemaTypeToXML "advisory")
                                   ) $ serviceNotif_choice7 x
            ]
instance Extension ServiceNotification NotificationMessage where
    supertype v = NotificationMessage_ServiceNotification v
instance Extension ServiceNotification Message where
    supertype = (supertype :: NotificationMessage -> Message)
              . (supertype :: ServiceNotification -> NotificationMessage)
              
instance Extension ServiceNotification Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: NotificationMessage -> Message)
              . (supertype :: ServiceNotification -> NotificationMessage)
              
 
-- | A type defining the content model for report on the status 
--   of the processing by a service. In the future we may wish 
--   to provide some kind of scope or other qualification for 
--   the event, e.g. the currencies, products, or books to which 
--   it applies.
data ServiceProcessingStatus = ServiceProcessingStatus
        { serviceProcesStatus_cycle :: Maybe ServiceProcessingCycle
          -- ^ The processing cycle or phase that this message describes. 
          --   For example, EndOfDay or Intraday.
        , serviceProcesStatus_step :: Maybe ServiceProcessingStep
          -- ^ The stage within a processing cycle or phase that this 
          --   message describes. For example, Netting or Valuation.
        , serviceProcesStatus_event :: Maybe ServiceProcessingEvent
          -- ^ The event that occurred within the cycle or step, for 
          --   example "Started" or "Completed"..
        }
        deriving (Eq,Show)
instance SchemaType ServiceProcessingStatus where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ServiceProcessingStatus
            `apply` optional (parseSchemaType "cycle")
            `apply` optional (parseSchemaType "step")
            `apply` optional (parseSchemaType "event")
    schemaTypeToXML s x@ServiceProcessingStatus{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "cycle") $ serviceProcesStatus_cycle x
            , maybe [] (schemaTypeToXML "step") $ serviceProcesStatus_step x
            , maybe [] (schemaTypeToXML "event") $ serviceProcesStatus_event x
            ]
 
-- | A type that can be used to describe the availability or 
--   other state of a service, e.g. Available, Unavaialble.
data ServiceStatus = ServiceStatus Scheme ServiceStatusAttributes deriving (Eq,Show)
data ServiceStatusAttributes = ServiceStatusAttributes
    { serviceStatusAttrib_serviceStatusScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType ServiceStatus where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "serviceStatusScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ ServiceStatus v (ServiceStatusAttributes a0)
    schemaTypeToXML s (ServiceStatus bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "serviceStatusScheme") $ serviceStatusAttrib_serviceStatusScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension ServiceStatus Scheme where
    supertype (ServiceStatus s _) = s
 
-- | A type that can be used to describe the processing phase of 
--   a service. For example, EndOfDay, Intraday.
data ServiceProcessingCycle = ServiceProcessingCycle Scheme ServiceProcessingCycleAttributes deriving (Eq,Show)
data ServiceProcessingCycleAttributes = ServiceProcessingCycleAttributes
    { serviceProcesCycleAttrib_serviceProcessingCycleScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType ServiceProcessingCycle where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "serviceProcessingCycleScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ ServiceProcessingCycle v (ServiceProcessingCycleAttributes a0)
    schemaTypeToXML s (ServiceProcessingCycle bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "serviceProcessingCycleScheme") $ serviceProcesCycleAttrib_serviceProcessingCycleScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension ServiceProcessingCycle Scheme where
    supertype (ServiceProcessingCycle s _) = s
 
-- | A type that can be used to describe what stage of 
--   processing a service is in. For example, Netting or 
--   Valuation.
data ServiceProcessingStep = ServiceProcessingStep Scheme ServiceProcessingStepAttributes deriving (Eq,Show)
data ServiceProcessingStepAttributes = ServiceProcessingStepAttributes
    { serviceProcesStepAttrib_serviceProcessingStep :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType ServiceProcessingStep where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "serviceProcessingStep" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ ServiceProcessingStep v (ServiceProcessingStepAttributes a0)
    schemaTypeToXML s (ServiceProcessingStep bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "serviceProcessingStep") $ serviceProcesStepAttrib_serviceProcessingStep at
                         ]
            $ schemaTypeToXML s bt
instance Extension ServiceProcessingStep Scheme where
    supertype (ServiceProcessingStep s _) = s
 
-- | A type that can be used to describe a stage or step in 
--   processing provided by a service, for example processing 
--   completed.
data ServiceProcessingEvent = ServiceProcessingEvent Scheme ServiceProcessingEventAttributes deriving (Eq,Show)
data ServiceProcessingEventAttributes = ServiceProcessingEventAttributes
    { serviceProcesEventAttrib_serviceProcessingEventScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType ServiceProcessingEvent where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "serviceProcessingEventScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ ServiceProcessingEvent v (ServiceProcessingEventAttributes a0)
    schemaTypeToXML s (ServiceProcessingEvent bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "serviceProcessingEventScheme") $ serviceProcesEventAttrib_serviceProcessingEventScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension ServiceProcessingEvent Scheme where
    supertype (ServiceProcessingEvent s _) = s
 
-- | A type defining the content model for a human-readable 
--   notification to the users of a service.
data ServiceAdvisory = ServiceAdvisory
        { serviceAdvis_category :: Maybe ServiceAdvisoryCategory
          -- ^ The category or type of the notification message, e.g. 
          --   availability, product coverage, rules, etc.
        , serviceAdvis_description :: Maybe Xsd.XsdString
          -- ^ A human-readable notification.
        , serviceAdvis_effectiveFrom :: Maybe Xsd.DateTime
          -- ^ The time at which the information supplied by the advisory 
          --   becomes effective. For example, if the advisory advises of 
          --   a newly planned service outage, it will be the time the 
          --   service outage begins.
        , serviceAdvis_effectiveTo :: Maybe Xsd.DateTime
          -- ^ The time at which the information supplied by the advisory 
          --   becomes no longer effective. For example, if the advisory 
          --   advises of a newly planned service outage, it will be the 
          --   time the service outage ends.
        }
        deriving (Eq,Show)
instance SchemaType ServiceAdvisory where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ServiceAdvisory
            `apply` optional (parseSchemaType "category")
            `apply` optional (parseSchemaType "description")
            `apply` optional (parseSchemaType "effectiveFrom")
            `apply` optional (parseSchemaType "effectiveTo")
    schemaTypeToXML s x@ServiceAdvisory{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "category") $ serviceAdvis_category x
            , maybe [] (schemaTypeToXML "description") $ serviceAdvis_description x
            , maybe [] (schemaTypeToXML "effectiveFrom") $ serviceAdvis_effectiveFrom x
            , maybe [] (schemaTypeToXML "effectiveTo") $ serviceAdvis_effectiveTo x
            ]
 
-- | A type that can be used to describe the category of an 
--   advisory message, e.g.. Availability, Rules, Products, 
--   etc., etc..
data ServiceAdvisoryCategory = ServiceAdvisoryCategory Scheme ServiceAdvisoryCategoryAttributes deriving (Eq,Show)
data ServiceAdvisoryCategoryAttributes = ServiceAdvisoryCategoryAttributes
    { serviceAdvisCategAttrib_serviceAdvisoryCategoryScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType ServiceAdvisoryCategory where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "serviceAdvisoryCategoryScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ ServiceAdvisoryCategory v (ServiceAdvisoryCategoryAttributes a0)
    schemaTypeToXML s (ServiceAdvisoryCategory bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "serviceAdvisoryCategoryScheme") $ serviceAdvisCategAttrib_serviceAdvisoryCategoryScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension ServiceAdvisoryCategory Scheme where
    supertype (ServiceAdvisoryCategory s _) = s
 
data VerificationStatusNotification = VerificationStatusNotification
        { verifStatusNotif_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , verifStatusNotif_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.
        , verifStatusNotif_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.
        , verifStatusNotif_header :: Maybe RequestMessageHeader
        , verifStatusNotif_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , verifStatusNotif_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , verifStatusNotif_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , verifStatusNotif_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , verifStatusNotif_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.
        , verifStatusNotif_status :: VerificationStatus
        , verifStatusNotif_reason :: [Reason]
          -- ^ The reason for any dispute or change in verification 
          --   status.
        , verifStatusNotif_partyTradeIdentifier :: PartyTradeIdentifier
        , verifStatusNotif_party :: [Party]
        , verifStatusNotif_account :: [Account]
          -- ^ Optional account information used to precisely define the 
          --   origination and destination of financial instruments.
        }
        deriving (Eq,Show)
instance SchemaType VerificationStatusNotification 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 (VerificationStatusNotification 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` parseSchemaType "status"
            `apply` many (parseSchemaType "reason")
            `apply` parseSchemaType "partyTradeIdentifier"
            `apply` many (parseSchemaType "party")
            `apply` many (parseSchemaType "account")
    schemaTypeToXML s x@VerificationStatusNotification{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ verifStatusNotif_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ verifStatusNotif_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ verifStatusNotif_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ verifStatusNotif_header x
            , concatMap (schemaTypeToXML "validation") $ verifStatusNotif_validation x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ verifStatusNotif_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ verifStatusNotif_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ verifStatusNotif_sequenceNumber x
            , concatMap (schemaTypeToXML "onBehalfOf") $ verifStatusNotif_onBehalfOf x
            , schemaTypeToXML "status" $ verifStatusNotif_status x
            , concatMap (schemaTypeToXML "reason") $ verifStatusNotif_reason x
            , schemaTypeToXML "partyTradeIdentifier" $ verifStatusNotif_partyTradeIdentifier x
            , concatMap (schemaTypeToXML "party") $ verifStatusNotif_party x
            , concatMap (schemaTypeToXML "account") $ verifStatusNotif_account x
            ]
instance Extension VerificationStatusNotification NonCorrectableRequestMessage where
    supertype v = NonCorrectableRequestMessage_VerificationStatusNotification v
instance Extension VerificationStatusNotification RequestMessage where
    supertype = (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              . (supertype :: VerificationStatusNotification -> NonCorrectableRequestMessage)
              
instance Extension VerificationStatusNotification Message where
    supertype = (supertype :: RequestMessage -> Message)
              . (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              . (supertype :: VerificationStatusNotification -> NonCorrectableRequestMessage)
              
instance Extension VerificationStatusNotification Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: RequestMessage -> Message)
              . (supertype :: NonCorrectableRequestMessage -> RequestMessage)
              . (supertype :: VerificationStatusNotification -> NonCorrectableRequestMessage)
              
 
-- | The verification status of the position as reported by the 
--   sender (Verified, Disputed).
data VerificationStatus = VerificationStatus Scheme VerificationStatusAttributes deriving (Eq,Show)
data VerificationStatusAttributes = VerificationStatusAttributes
    { verifStatusAttrib_verificationStatusScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType VerificationStatus where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "verificationStatusScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ VerificationStatus v (VerificationStatusAttributes a0)
    schemaTypeToXML s (VerificationStatus bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "verificationStatusScheme") $ verifStatusAttrib_verificationStatusScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension VerificationStatus Scheme where
    supertype (VerificationStatus s _) = s
 
elementEventStatusResponse :: XMLParser EventStatusResponse
elementEventStatusResponse = parseSchemaType "eventStatusResponse"
elementToXMLEventStatusResponse :: EventStatusResponse -> [Content ()]
elementToXMLEventStatusResponse = schemaTypeToXML "eventStatusResponse"
 
elementEventStatusException :: XMLParser Exception
elementEventStatusException = parseSchemaType "eventStatusException"
elementToXMLEventStatusException :: Exception -> [Content ()]
elementToXMLEventStatusException = schemaTypeToXML "eventStatusException"
 
-- | The root element used for rejected message exceptions
elementMessageRejected :: XMLParser Exception
elementMessageRejected = parseSchemaType "messageRejected"
elementToXMLMessageRejected :: Exception -> [Content ()]
elementToXMLMessageRejected = schemaTypeToXML "messageRejected"
 
elementServiceNotification :: XMLParser ServiceNotification
elementServiceNotification = parseSchemaType "serviceNotification"
elementToXMLServiceNotification :: ServiceNotification -> [Content ()]
elementToXMLServiceNotification = schemaTypeToXML "serviceNotification"
 
elementServiceNotificationException :: XMLParser Exception
elementServiceNotificationException = parseSchemaType "serviceNotificationException"
elementToXMLServiceNotificationException :: Exception -> [Content ()]
elementToXMLServiceNotificationException = schemaTypeToXML "serviceNotificationException"
 
elementVerificationStatusNotification :: XMLParser VerificationStatusNotification
elementVerificationStatusNotification = parseSchemaType "verificationStatusNotification"
elementToXMLVerificationStatusNotification :: VerificationStatusNotification -> [Content ()]
elementToXMLVerificationStatusNotification = schemaTypeToXML "verificationStatusNotification"
 
elementVerificationStatusException :: XMLParser Exception
elementVerificationStatusException = parseSchemaType "verificationStatusException"
elementToXMLVerificationStatusException :: Exception -> [Content ()]
elementToXMLVerificationStatusException = schemaTypeToXML "verificationStatusException"
 
elementVerificationStatusAcknowledgement :: XMLParser Acknowledgement
elementVerificationStatusAcknowledgement = parseSchemaType "verificationStatusAcknowledgement"
elementToXMLVerificationStatusAcknowledgement :: Acknowledgement -> [Content ()]
elementToXMLVerificationStatusAcknowledgement = schemaTypeToXML "verificationStatusAcknowledgement"