{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Swaps.Dividend
  ( module Data.FpML.V53.Swaps.Dividend
  , module Data.FpML.V53.Shared.EQ
  , module Data.FpML.V53.Shared
  ) 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.Shared.EQ
import Data.FpML.V53.Shared
 
-- Some hs-boot imports are required, for fwd-declaring types.
 
-- | Floating Payment Leg of a Dividend Swap.
data DividendLeg = DividendLeg
        { dividendLeg_ID :: Maybe Xsd.ID
        , dividendLeg_legIdentifier :: [LegIdentifier]
          -- ^ Version aware identification of this leg.
        , dividendLeg_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , dividendLeg_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , dividendLeg_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , dividendLeg_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , dividendLeg_effectiveDate :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the effective date of this leg of the swap. When 
          --   defined in relation to a date specified somewhere else in 
          --   the document (through the relativeDate component), this 
          --   element will typically point to the effective date of the 
          --   other leg of the swap.
        , dividendLeg_terminationDate :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the termination date of this leg of the swap. 
          --   When defined in relation to a date specified somewhere else 
          --   in the document (through the relativeDate component), this 
          --   element will typically point to the termination date of the 
          --   other leg of the swap.
        , dividendLeg_underlyer :: Maybe Underlyer
          -- ^ Specifies the underlyer of the leg.
        , dividendLeg_settlementType :: Maybe SettlementTypeEnum
        , dividendLeg_settlementDate :: Maybe AdjustableOrRelativeDate
        , dividendLeg_choice10 :: (Maybe (OneOf2 Money Currency))
          -- ^ Choice between:
          --   
          --   (1) Settlement Amount
          --   
          --   (2) Settlement Currency for use where the Settlement Amount 
          --   cannot be known in advance
        , dividendLeg_fxFeature :: Maybe FxFeature
          -- ^ Quanto, Composite, or Cross Currency FX features.
        , dividendLeg_declaredCashDividendPercentage :: Maybe NonNegativeDecimal
          -- ^ Declared Cash Dividend Percentage.
        , dividendLeg_declaredCashEquivalentDividendPercentage :: Maybe NonNegativeDecimal
          -- ^ Declared Cash Equivalent Dividend Percentage.
        , dividendLeg_dividendPeriod :: [DividendPeriodPayment]
          -- ^ One to many time bounded dividend payment periods, each 
          --   with a fixed strike and dividend payment date per period.
        , dividendLeg_specialDividends :: Maybe Xsd.Boolean
          -- ^ If present and true, then special dividends and memorial 
          --   dividends are applicable.
        , dividendLeg_materialDividend :: Maybe Xsd.Boolean
          -- ^ If present and true, then material non cash dividends are 
          --   applicable.
        }
        deriving (Eq,Show)
instance SchemaType DividendLeg where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (DividendLeg a0)
            `apply` many (parseSchemaType "legIdentifier")
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (parseSchemaType "effectiveDate")
            `apply` optional (parseSchemaType "terminationDate")
            `apply` optional (parseSchemaType "underlyer")
            `apply` optional (parseSchemaType "settlementType")
            `apply` optional (parseSchemaType "settlementDate")
            `apply` optional (oneOf' [ ("Money", fmap OneOf2 (parseSchemaType "settlementAmount"))
                                     , ("Currency", fmap TwoOf2 (parseSchemaType "settlementCurrency"))
                                     ])
            `apply` optional (parseSchemaType "fxFeature")
            `apply` optional (parseSchemaType "declaredCashDividendPercentage")
            `apply` optional (parseSchemaType "declaredCashEquivalentDividendPercentage")
            `apply` many (parseSchemaType "dividendPeriod")
            `apply` optional (parseSchemaType "specialDividends")
            `apply` optional (parseSchemaType "materialDividend")
    schemaTypeToXML s x@DividendLeg{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ dividendLeg_ID x
                       ]
            [ concatMap (schemaTypeToXML "legIdentifier") $ dividendLeg_legIdentifier x
            , maybe [] (schemaTypeToXML "payerPartyReference") $ dividendLeg_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ dividendLeg_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ dividendLeg_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ dividendLeg_receiverAccountReference x
            , maybe [] (schemaTypeToXML "effectiveDate") $ dividendLeg_effectiveDate x
            , maybe [] (schemaTypeToXML "terminationDate") $ dividendLeg_terminationDate x
            , maybe [] (schemaTypeToXML "underlyer") $ dividendLeg_underlyer x
            , maybe [] (schemaTypeToXML "settlementType") $ dividendLeg_settlementType x
            , maybe [] (schemaTypeToXML "settlementDate") $ dividendLeg_settlementDate x
            , maybe [] (foldOneOf2  (schemaTypeToXML "settlementAmount")
                                    (schemaTypeToXML "settlementCurrency")
                                   ) $ dividendLeg_choice10 x
            , maybe [] (schemaTypeToXML "fxFeature") $ dividendLeg_fxFeature x
            , maybe [] (schemaTypeToXML "declaredCashDividendPercentage") $ dividendLeg_declaredCashDividendPercentage x
            , maybe [] (schemaTypeToXML "declaredCashEquivalentDividendPercentage") $ dividendLeg_declaredCashEquivalentDividendPercentage x
            , concatMap (schemaTypeToXML "dividendPeriod") $ dividendLeg_dividendPeriod x
            , maybe [] (schemaTypeToXML "specialDividends") $ dividendLeg_specialDividends x
            , maybe [] (schemaTypeToXML "materialDividend") $ dividendLeg_materialDividend x
            ]
instance Extension DividendLeg DirectionalLegUnderlyer where
    supertype v = DirectionalLegUnderlyer_DividendLeg v
instance Extension DividendLeg DirectionalLeg where
    supertype = (supertype :: DirectionalLegUnderlyer -> DirectionalLeg)
              . (supertype :: DividendLeg -> DirectionalLegUnderlyer)
              
instance Extension DividendLeg Leg where
    supertype = (supertype :: DirectionalLeg -> Leg)
              . (supertype :: DirectionalLegUnderlyer -> DirectionalLeg)
              . (supertype :: DividendLeg -> DirectionalLegUnderlyer)
              
 
-- | A time bounded dividend period, with fixed strike and a 
--   dividend payment date per period.
data DividendPeriodPayment = DividendPeriodPayment
        { dividPeriodPayment_ID :: Maybe Xsd.ID
        , dividPeriodPayment_unadjustedStartDate :: Maybe IdentifiedDate
          -- ^ Unadjusted inclusive dividend period start date.
        , dividPeriodPayment_unadjustedEndDate :: Maybe IdentifiedDate
          -- ^ Unadjusted inclusive dividend period end date.
        , dividPeriodPayment_dateAdjustments :: Maybe BusinessDayAdjustments
          -- ^ Date adjustments for all unadjusted dates in this dividend 
          --   period.
        , dividPeriodPayment_underlyerReference :: Maybe AssetReference
          -- ^ Reference to the underlyer which is paying dividends. This 
          --   should be used in all cases, and must be used where there 
          --   are multiple underlying assets, to avoid any ambiguity 
          --   about which asset the dividend period relates to.
        , dividPeriodPayment_fixedStrike :: Maybe PositiveDecimal
          -- ^ Fixed strike.
        , dividPeriodPayment_paymentDate :: Maybe AdjustableOrRelativeDate
          -- ^ Dividend period amount payment date.
        , dividPeriodPayment_valuationDate :: Maybe AdjustableOrRelativeDate
          -- ^ Dividend period amount valuation date.
        }
        deriving (Eq,Show)
instance SchemaType DividendPeriodPayment where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (DividendPeriodPayment a0)
            `apply` optional (parseSchemaType "unadjustedStartDate")
            `apply` optional (parseSchemaType "unadjustedEndDate")
            `apply` optional (parseSchemaType "dateAdjustments")
            `apply` optional (parseSchemaType "underlyerReference")
            `apply` optional (parseSchemaType "fixedStrike")
            `apply` optional (parseSchemaType "paymentDate")
            `apply` optional (parseSchemaType "valuationDate")
    schemaTypeToXML s x@DividendPeriodPayment{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ dividPeriodPayment_ID x
                       ]
            [ maybe [] (schemaTypeToXML "unadjustedStartDate") $ dividPeriodPayment_unadjustedStartDate x
            , maybe [] (schemaTypeToXML "unadjustedEndDate") $ dividPeriodPayment_unadjustedEndDate x
            , maybe [] (schemaTypeToXML "dateAdjustments") $ dividPeriodPayment_dateAdjustments x
            , maybe [] (schemaTypeToXML "underlyerReference") $ dividPeriodPayment_underlyerReference x
            , maybe [] (schemaTypeToXML "fixedStrike") $ dividPeriodPayment_fixedStrike x
            , maybe [] (schemaTypeToXML "paymentDate") $ dividPeriodPayment_paymentDate x
            , maybe [] (schemaTypeToXML "valuationDate") $ dividPeriodPayment_valuationDate x
            ]
instance Extension DividendPeriodPayment DividendPeriod where
    supertype v = DividendPeriod_DividendPeriodPayment v
 
-- | A Dividend Swap Transaction Supplement.
data DividendSwapTransactionSupplement = DividendSwapTransactionSupplement
        { dividSwapTransSuppl_ID :: Maybe Xsd.ID
        , dividSwapTransSuppl_primaryAssetClass :: Maybe AssetClass
          -- ^ A classification of the most important risk class of the 
          --   trade. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , dividSwapTransSuppl_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , dividSwapTransSuppl_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , dividSwapTransSuppl_productId :: [ProductId]
          -- ^ A product reference identifier. The product ID is an 
          --   identifier that describes the key economic characteristics 
          --   of the trade type, with the exception of concepts such as 
          --   size (notional, quantity, number of units) and price (fixed 
          --   rate, strike, etc.) that are negotiated for each 
          --   transaction. It can be used to hold identifiers such as the 
          --   "UPI" (universal product identifier) required by certain 
          --   regulatory reporting rules. It can also be used to hold 
          --   identifiers of benchmark products or product temnplates 
          --   used by certain trading systems or facilities. FpML does 
          --   not define the domain values associated with this element. 
          --   Note that the domain values for this element are not 
          --   strictly an enumerated list.
        , dividSwapTransSuppl_dividendLeg :: Maybe DividendLeg
          -- ^ Dividend leg.
        , dividSwapTransSuppl_fixedLeg :: Maybe FixedPaymentLeg
          -- ^ Fixed payment leg.
        , dividSwapTransSuppl_choice6 :: (Maybe (OneOf2 Xsd.Boolean Xsd.Boolean))
          -- ^ Choice between:
          --   
          --   (1) For an index option transaction, a flag to indicate 
          --   whether a relevant Multiple Exchange Index Annex is 
          --   applicable to the transaction. This annex defines 
          --   additional provisions which are applicable where an 
          --   index is comprised of component securities that are 
          --   traded on multiple exchanges.
          --   
          --   (2) For an index option transaction, a flag to indicate 
          --   whether a relevant Component Security Index Annex is 
          --   applicable to the transaction.
        , dividSwapTransSuppl_localJurisdiction :: Maybe CountryCode
          -- ^ Local Jurisdiction is a term used in the AEJ Master 
          --   Confirmation, which is used to determine local taxes, which 
          --   shall mean taxes, duties, and similar charges imposed by 
          --   the taxing authority of the Local Jurisdiction If this 
          --   element is not present Local Jurisdiction is Not 
          --   Applicable.
        , dividSwapTransSuppl_relevantJurisdiction :: Maybe CountryCode
          -- ^ Relevent Jurisdiction is a term used in the AEJ Master 
          --   Confirmation, which is used to determine local taxes, which 
          --   shall mean taxes, duties and similar charges that would be 
          --   imposed by the taxing authority of the Country of Underlyer 
          --   on a Hypothetical Broker Dealer assuming the Applicable 
          --   Hedge Positions are held by its office in the Relevant 
          --   Jurisdiction. If this element is not present Relevant 
          --   Jurisdiction is Not Applicable.
        }
        deriving (Eq,Show)
instance SchemaType DividendSwapTransactionSupplement where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (DividendSwapTransactionSupplement a0)
            `apply` optional (parseSchemaType "primaryAssetClass")
            `apply` many (parseSchemaType "secondaryAssetClass")
            `apply` many (parseSchemaType "productType")
            `apply` many (parseSchemaType "productId")
            `apply` optional (parseSchemaType "dividendLeg")
            `apply` optional (parseSchemaType "fixedLeg")
            `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf2 (parseSchemaType "multipleExchangeIndexAnnexFallback"))
                                     , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "componentSecurityIndexAnnexFallback"))
                                     ])
            `apply` optional (parseSchemaType "localJurisdiction")
            `apply` optional (parseSchemaType "relevantJurisdiction")
    schemaTypeToXML s x@DividendSwapTransactionSupplement{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ dividSwapTransSuppl_ID x
                       ]
            [ maybe [] (schemaTypeToXML "primaryAssetClass") $ dividSwapTransSuppl_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ dividSwapTransSuppl_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ dividSwapTransSuppl_productType x
            , concatMap (schemaTypeToXML "productId") $ dividSwapTransSuppl_productId x
            , maybe [] (schemaTypeToXML "dividendLeg") $ dividSwapTransSuppl_dividendLeg x
            , maybe [] (schemaTypeToXML "fixedLeg") $ dividSwapTransSuppl_fixedLeg x
            , maybe [] (foldOneOf2  (schemaTypeToXML "multipleExchangeIndexAnnexFallback")
                                    (schemaTypeToXML "componentSecurityIndexAnnexFallback")
                                   ) $ dividSwapTransSuppl_choice6 x
            , maybe [] (schemaTypeToXML "localJurisdiction") $ dividSwapTransSuppl_localJurisdiction x
            , maybe [] (schemaTypeToXML "relevantJurisdiction") $ dividSwapTransSuppl_relevantJurisdiction x
            ]
instance Extension DividendSwapTransactionSupplement Product where
    supertype v = Product_DividendSwapTransactionSupplement v
 
-- | Fixed payment amount within a Dividend Swap.
data FixedPaymentAmount = FixedPaymentAmount
        { fixedPaymentAmount_ID :: Maybe Xsd.ID
        , fixedPaymentAmount_paymentAmount :: Maybe NonNegativeMoney
          -- ^ Payment amount, which is optional since the payment amount 
          --   may be calculated using fixed strike and number of open 
          --   units.
        , fixedPaymentAmount_paymentDate :: Maybe RelativeDateOffset
          -- ^ Payment date relative to another date.
        }
        deriving (Eq,Show)
instance SchemaType FixedPaymentAmount where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (FixedPaymentAmount a0)
            `apply` optional (parseSchemaType "paymentAmount")
            `apply` optional (parseSchemaType "paymentDate")
    schemaTypeToXML s x@FixedPaymentAmount{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ fixedPaymentAmount_ID x
                       ]
            [ maybe [] (schemaTypeToXML "paymentAmount") $ fixedPaymentAmount_paymentAmount x
            , maybe [] (schemaTypeToXML "paymentDate") $ fixedPaymentAmount_paymentDate x
            ]
instance Extension FixedPaymentAmount PaymentBase where
    supertype v = PaymentBase_FixedPaymentAmount v
 
-- | Fixed Payment Leg of a Dividend Swap.
data FixedPaymentLeg = FixedPaymentLeg
        { fixedPaymentLeg_ID :: Maybe Xsd.ID
        , fixedPaymentLeg_legIdentifier :: [LegIdentifier]
          -- ^ Version aware identification of this leg.
        , fixedPaymentLeg_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , fixedPaymentLeg_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , fixedPaymentLeg_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , fixedPaymentLeg_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , fixedPaymentLeg_effectiveDate :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the effective date of this leg of the swap. When 
          --   defined in relation to a date specified somewhere else in 
          --   the document (through the relativeDate component), this 
          --   element will typically point to the effective date of the 
          --   other leg of the swap.
        , fixedPaymentLeg_terminationDate :: Maybe AdjustableOrRelativeDate
          -- ^ Specifies the termination date of this leg of the swap. 
          --   When defined in relation to a date specified somewhere else 
          --   in the document (through the relativeDate component), this 
          --   element will typically point to the termination date of the 
          --   other leg of the swap.
        , fixedPaymentLeg_fixedPayment :: [FixedPaymentAmount]
          -- ^ Fixed payment of a dividend swap, payment date is relative 
          --   to a dividend period payment date. Commonly the dividend 
          --   leg and the fixed payment leg will pay out on the same 
          --   date, and the payments will be netted.
        }
        deriving (Eq,Show)
instance SchemaType FixedPaymentLeg where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (FixedPaymentLeg a0)
            `apply` many (parseSchemaType "legIdentifier")
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
            `apply` optional (parseSchemaType "effectiveDate")
            `apply` optional (parseSchemaType "terminationDate")
            `apply` many (parseSchemaType "fixedPayment")
    schemaTypeToXML s x@FixedPaymentLeg{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ fixedPaymentLeg_ID x
                       ]
            [ concatMap (schemaTypeToXML "legIdentifier") $ fixedPaymentLeg_legIdentifier x
            , maybe [] (schemaTypeToXML "payerPartyReference") $ fixedPaymentLeg_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ fixedPaymentLeg_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ fixedPaymentLeg_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ fixedPaymentLeg_receiverAccountReference x
            , maybe [] (schemaTypeToXML "effectiveDate") $ fixedPaymentLeg_effectiveDate x
            , maybe [] (schemaTypeToXML "terminationDate") $ fixedPaymentLeg_terminationDate x
            , concatMap (schemaTypeToXML "fixedPayment") $ fixedPaymentLeg_fixedPayment x
            ]
instance Extension FixedPaymentLeg DirectionalLeg where
    supertype v = DirectionalLeg_FixedPaymentLeg v
instance Extension FixedPaymentLeg Leg where
    supertype = (supertype :: DirectionalLeg -> Leg)
              . (supertype :: FixedPaymentLeg -> DirectionalLeg)
              
 
-- | Specifies the structure of the dividend swap transaction 
--   supplement.
elementDividendSwapTransactionSupplement :: XMLParser DividendSwapTransactionSupplement
elementDividendSwapTransactionSupplement = parseSchemaType "dividendSwapTransactionSupplement"
elementToXMLDividendSwapTransactionSupplement :: DividendSwapTransactionSupplement -> [Content ()]
elementToXMLDividendSwapTransactionSupplement = schemaTypeToXML "dividendSwapTransactionSupplement"