{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Notification.CreditEvent
  ( module Data.FpML.V53.Notification.CreditEvent
  , module Data.FpML.V53.Msg
  ) where
 
import Text.XML.HaXml.Schema.Schema (SchemaType(..),SimpleType(..),Extension(..),Restricts(..))
import Text.XML.HaXml.Schema.Schema as Schema
import Text.XML.HaXml.OneOfN
import qualified Text.XML.HaXml.Schema.PrimitiveTypes as Xsd
import Data.FpML.V53.Msg
 
-- Some hs-boot imports are required, for fwd-declaring types.
 
data AffectedTransactions = AffectedTransactions
        { affectTrans_choice0 :: (Maybe (OneOf2 Trade PartyTradeIdentifiers))
          -- ^ Choice between:
          --   
          --   (1) An element that allows the full details of the trade to 
          --   be used as a mechanism for identifying the trade for 
          --   which the post-trade event pertains
          --   
          --   (2) A container since an individual trade can be referenced 
          --   by two or more different partyTradeIdentifier elements 
          --   - each allocated by a different party.
        }
        deriving (Eq,Show)
instance SchemaType AffectedTransactions where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return AffectedTransactions
            `apply` optional (oneOf' [ ("Trade", fmap OneOf2 (parseSchemaType "trade"))
                                     , ("PartyTradeIdentifiers", fmap TwoOf2 (parseSchemaType "tradeReference"))
                                     ])
    schemaTypeToXML s x@AffectedTransactions{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (schemaTypeToXML "trade")
                                    (schemaTypeToXML "tradeReference")
                                   ) $ affectTrans_choice0 x
            ]
 
data BankruptcyEvent = BankruptcyEvent
        deriving (Eq,Show)
instance SchemaType BankruptcyEvent where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return BankruptcyEvent
    schemaTypeToXML s x@BankruptcyEvent{} =
        toXMLElement s []
            []
instance Extension BankruptcyEvent CreditEvent where
    supertype (BankruptcyEvent) =
               CreditEvent
 
data CreditEvent = CreditEvent
        deriving (Eq,Show)
instance SchemaType CreditEvent where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return CreditEvent
    schemaTypeToXML s x@CreditEvent{} =
        toXMLElement s []
            []
 
-- | An event type that records the occurrence of a credit event 
--   notice.
data CreditEventNoticeDocument = CreditEventNoticeDocument
        { creditEventNoticeDocum_affectedTransactions :: Maybe AffectedTransactions
          -- ^ Trades affected by this event.
        , creditEventNoticeDocum_referenceEntity :: Maybe LegalEntity
        , creditEventNoticeDocum_creditEvent :: Maybe CreditEvent
        , creditEventNoticeDocum_publiclyAvailableInformation :: [Resource]
          -- ^ A public information source, e.g. a particular newspaper or 
          --   electronic news service, that may publish relevant 
          --   information used in the determination of whether or not a 
          --   credit event has occurred.
        , creditEventNoticeDocum_notifyingPartyReference :: Maybe PartyReference
        , creditEventNoticeDocum_notifiedPartyReference :: Maybe PartyReference
        , creditEventNoticeDocum_creditEventNoticeDate :: Maybe Xsd.Date
        , creditEventNoticeDocum_creditEventDate :: Maybe Xsd.Date
        }
        deriving (Eq,Show)
instance SchemaType CreditEventNoticeDocument where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return CreditEventNoticeDocument
            `apply` optional (parseSchemaType "affectedTransactions")
            `apply` optional (parseSchemaType "referenceEntity")
            `apply` optional (elementCreditEvent)
            `apply` many (parseSchemaType "publiclyAvailableInformation")
            `apply` optional (parseSchemaType "notifyingPartyReference")
            `apply` optional (parseSchemaType "notifiedPartyReference")
            `apply` optional (parseSchemaType "creditEventNoticeDate")
            `apply` optional (parseSchemaType "creditEventDate")
    schemaTypeToXML s x@CreditEventNoticeDocument{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "affectedTransactions") $ creditEventNoticeDocum_affectedTransactions x
            , maybe [] (schemaTypeToXML "referenceEntity") $ creditEventNoticeDocum_referenceEntity x
            , maybe [] (elementToXMLCreditEvent) $ creditEventNoticeDocum_creditEvent x
            , concatMap (schemaTypeToXML "publiclyAvailableInformation") $ creditEventNoticeDocum_publiclyAvailableInformation x
            , maybe [] (schemaTypeToXML "notifyingPartyReference") $ creditEventNoticeDocum_notifyingPartyReference x
            , maybe [] (schemaTypeToXML "notifiedPartyReference") $ creditEventNoticeDocum_notifiedPartyReference x
            , maybe [] (schemaTypeToXML "creditEventNoticeDate") $ creditEventNoticeDocum_creditEventNoticeDate x
            , maybe [] (schemaTypeToXML "creditEventDate") $ creditEventNoticeDocum_creditEventDate x
            ]
 
-- | A message type defining the ISDA defined Credit Event 
--   Notice. ISDA defines it as an irrevocable notice from a 
--   Notifying Party to the other party that describes a Credit 
--   Event that occurred. A Credit Event Notice must contain 
--   detail of the facts relevant to the determination that a 
--   Credit Event has occurred.
data CreditEventNotification = CreditEventNotification
        { creditEventNotif_fpmlVersion :: Xsd.XsdString
          -- ^ Indicate which version of the FpML Schema an FpML message 
          --   adheres to.
        , creditEventNotif_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.
        , creditEventNotif_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.
        , creditEventNotif_header :: Maybe RequestMessageHeader
        , creditEventNotif_validation :: [Validation]
          -- ^ A list of validation sets the sender asserts the document 
          --   is valid with respect to.
        , creditEventNotif_isCorrection :: Maybe Xsd.Boolean
          -- ^ Indicates if this message corrects an earlier request.
        , creditEventNotif_parentCorrelationId :: Maybe CorrelationId
          -- ^ An optional identifier used to correlate between related 
          --   processes
        , creditEventNotif_correlationId :: [CorrelationId]
          -- ^ A qualified identifier used to correlate between messages
        , creditEventNotif_sequenceNumber :: Maybe Xsd.PositiveInteger
          -- ^ A numeric value that can be used to order messages with the 
          --   same correlation identifier from the same sender.
        , creditEventNotif_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.
        , creditEventNotif_creditEventNotice :: Maybe CreditEventNoticeDocument
        , creditEventNotif_party :: [Party]
        }
        deriving (Eq,Show)
instance SchemaType CreditEventNotification 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 (CreditEventNotification a0 a1 a2)
            `apply` optional (parseSchemaType "header")
            `apply` many (parseSchemaType "validation")
            `apply` optional (parseSchemaType "isCorrection")
            `apply` optional (parseSchemaType "parentCorrelationId")
            `apply` between (Occurs (Just 0) (Just 2))
                            (parseSchemaType "correlationId")
            `apply` optional (parseSchemaType "sequenceNumber")
            `apply` between (Occurs (Just 0) (Just 4))
                            (parseSchemaType "onBehalfOf")
            `apply` optional (parseSchemaType "creditEventNotice")
            `apply` many (parseSchemaType "party")
    schemaTypeToXML s x@CreditEventNotification{} =
        toXMLElement s [ toXMLAttribute "fpmlVersion" $ creditEventNotif_fpmlVersion x
                       , maybe [] (toXMLAttribute "expectedBuild") $ creditEventNotif_expectedBuild x
                       , maybe [] (toXMLAttribute "actualBuild") $ creditEventNotif_actualBuild x
                       ]
            [ maybe [] (schemaTypeToXML "header") $ creditEventNotif_header x
            , concatMap (schemaTypeToXML "validation") $ creditEventNotif_validation x
            , maybe [] (schemaTypeToXML "isCorrection") $ creditEventNotif_isCorrection x
            , maybe [] (schemaTypeToXML "parentCorrelationId") $ creditEventNotif_parentCorrelationId x
            , concatMap (schemaTypeToXML "correlationId") $ creditEventNotif_correlationId x
            , maybe [] (schemaTypeToXML "sequenceNumber") $ creditEventNotif_sequenceNumber x
            , concatMap (schemaTypeToXML "onBehalfOf") $ creditEventNotif_onBehalfOf x
            , maybe [] (schemaTypeToXML "creditEventNotice") $ creditEventNotif_creditEventNotice x
            , concatMap (schemaTypeToXML "party") $ creditEventNotif_party x
            ]
instance Extension CreditEventNotification CorrectableRequestMessage where
    supertype v = CorrectableRequestMessage_CreditEventNotification v
instance Extension CreditEventNotification RequestMessage where
    supertype = (supertype :: CorrectableRequestMessage -> RequestMessage)
              . (supertype :: CreditEventNotification -> CorrectableRequestMessage)
              
instance Extension CreditEventNotification Message where
    supertype = (supertype :: RequestMessage -> Message)
              . (supertype :: CorrectableRequestMessage -> RequestMessage)
              . (supertype :: CreditEventNotification -> CorrectableRequestMessage)
              
instance Extension CreditEventNotification Document where
    supertype = (supertype :: Message -> Document)
              . (supertype :: RequestMessage -> Message)
              . (supertype :: CorrectableRequestMessage -> RequestMessage)
              . (supertype :: CreditEventNotification -> CorrectableRequestMessage)
              
 
data FailureToPayEvent = FailureToPayEvent
        deriving (Eq,Show)
instance SchemaType FailureToPayEvent where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return FailureToPayEvent
    schemaTypeToXML s x@FailureToPayEvent{} =
        toXMLElement s []
            []
instance Extension FailureToPayEvent CreditEvent where
    supertype (FailureToPayEvent) =
               CreditEvent
 
data ObligationAccelerationEvent = ObligationAccelerationEvent
        deriving (Eq,Show)
instance SchemaType ObligationAccelerationEvent where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ObligationAccelerationEvent
    schemaTypeToXML s x@ObligationAccelerationEvent{} =
        toXMLElement s []
            []
instance Extension ObligationAccelerationEvent CreditEvent where
    supertype (ObligationAccelerationEvent) =
               CreditEvent
 
data ObligationDefaultEvent = ObligationDefaultEvent
        deriving (Eq,Show)
instance SchemaType ObligationDefaultEvent where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ObligationDefaultEvent
    schemaTypeToXML s x@ObligationDefaultEvent{} =
        toXMLElement s []
            []
instance Extension ObligationDefaultEvent CreditEvent where
    supertype (ObligationDefaultEvent) =
               CreditEvent
 
data RepudiationMoratoriumEvent = RepudiationMoratoriumEvent
        deriving (Eq,Show)
instance SchemaType RepudiationMoratoriumEvent where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return RepudiationMoratoriumEvent
    schemaTypeToXML s x@RepudiationMoratoriumEvent{} =
        toXMLElement s []
            []
instance Extension RepudiationMoratoriumEvent CreditEvent where
    supertype (RepudiationMoratoriumEvent) =
               CreditEvent
 
data RestructuringEvent = RestructuringEvent
        { restrEvent_partialExerciseAmount :: Maybe Money
        }
        deriving (Eq,Show)
instance SchemaType RestructuringEvent where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return RestructuringEvent
            `apply` optional (parseSchemaType "partialExerciseAmount")
    schemaTypeToXML s x@RestructuringEvent{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "partialExerciseAmount") $ restrEvent_partialExerciseAmount x
            ]
instance Extension RestructuringEvent CreditEvent where
    supertype (RestructuringEvent e0) =
               CreditEvent
 
elementBankruptcy :: XMLParser BankruptcyEvent
elementBankruptcy = parseSchemaType "bankruptcy"
elementToXMLBankruptcy :: BankruptcyEvent -> [Content ()]
elementToXMLBankruptcy = schemaTypeToXML "bankruptcy"
 
elementCreditEvent :: XMLParser CreditEvent
elementCreditEvent = fmap supertype elementRestructuring
                     `onFail`
                     fmap supertype elementRepudiationMoratorium
                     `onFail`
                     fmap supertype elementObligationDefault
                     `onFail`
                     fmap supertype elementObligationAcceleration
                     `onFail`
                     fmap supertype elementFailureToPay
                     `onFail`
                     fmap supertype elementBankruptcy
                     `onFail` fail "Parse failed when expecting an element in the substitution group for\n\
\    <creditEvent>,\n\
\  namely one of:\n\
\<restructuring>, <repudiationMoratorium>, <obligationDefault>, <obligationAcceleration>, <failureToPay>, <bankruptcy>"
elementToXMLCreditEvent :: CreditEvent -> [Content ()]
elementToXMLCreditEvent = schemaTypeToXML "creditEvent"
 
-- | A global element used to hold CENs.
elementCreditEventNotice :: XMLParser CreditEventNoticeDocument
elementCreditEventNotice = parseSchemaType "creditEventNotice"
elementToXMLCreditEventNotice :: CreditEventNoticeDocument -> [Content ()]
elementToXMLCreditEventNotice = schemaTypeToXML "creditEventNotice"
 
elementFailureToPay :: XMLParser FailureToPayEvent
elementFailureToPay = parseSchemaType "failureToPay"
elementToXMLFailureToPay :: FailureToPayEvent -> [Content ()]
elementToXMLFailureToPay = schemaTypeToXML "failureToPay"
 
elementObligationAcceleration :: XMLParser ObligationAccelerationEvent
elementObligationAcceleration = parseSchemaType "obligationAcceleration"
elementToXMLObligationAcceleration :: ObligationAccelerationEvent -> [Content ()]
elementToXMLObligationAcceleration = schemaTypeToXML "obligationAcceleration"
 
elementObligationDefault :: XMLParser ObligationDefaultEvent
elementObligationDefault = parseSchemaType "obligationDefault"
elementToXMLObligationDefault :: ObligationDefaultEvent -> [Content ()]
elementToXMLObligationDefault = schemaTypeToXML "obligationDefault"
 
elementRepudiationMoratorium :: XMLParser RepudiationMoratoriumEvent
elementRepudiationMoratorium = parseSchemaType "repudiationMoratorium"
elementToXMLRepudiationMoratorium :: RepudiationMoratoriumEvent -> [Content ()]
elementToXMLRepudiationMoratorium = schemaTypeToXML "repudiationMoratorium"
 
elementRestructuring :: XMLParser RestructuringEvent
elementRestructuring = parseSchemaType "restructuring"
elementToXMLRestructuring :: RestructuringEvent -> [Content ()]
elementToXMLRestructuring = schemaTypeToXML "restructuring"
 
-- | Credit Event Notification message.
 
-- | A message defining the ISDA defined Credit Event Notice. 
--   ISDA defines it as an irrevocable notice from a Notifying 
--   Party to the other party that describes a Credit Event that 
--   occurred. A Credit Event Notice must contain detail of the 
--   facts relevant to the determination that a Credit Event has 
--   occurred.
elementCreditEventNotification :: XMLParser CreditEventNotification
elementCreditEventNotification = parseSchemaType "creditEventNotification"
elementToXMLCreditEventNotification :: CreditEventNotification -> [Content ()]
elementToXMLCreditEventNotification = schemaTypeToXML "creditEventNotification"
 
elementCreditEventAcknowledgement :: XMLParser Acknowledgement
elementCreditEventAcknowledgement = parseSchemaType "creditEventAcknowledgement"
elementToXMLCreditEventAcknowledgement :: Acknowledgement -> [Content ()]
elementToXMLCreditEventAcknowledgement = schemaTypeToXML "creditEventAcknowledgement"
 
elementCreditEventException :: XMLParser Exception
elementCreditEventException = parseSchemaType "creditEventException"
elementToXMLCreditEventException :: Exception -> [Content ()]
elementToXMLCreditEventException = schemaTypeToXML "creditEventException"