{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Swaps.Correlation
  ( module Data.FpML.V53.Swaps.Correlation
  , module Data.FpML.V53.Shared.EQ
  ) 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
 
-- Some hs-boot imports are required, for fwd-declaring types.
 
-- | Correlation Amount.
data CorrelationAmount = CorrelationAmount
        { correlAmount_calculationDates :: Maybe AdjustableRelativeOrPeriodicDates
          -- ^ Specifies the date on which a calculation or an observation 
          --   will be performed for the purpose of calculating the 
          --   amount.
        , correlAmount_observationStartDate :: Maybe AdjustableOrRelativeDate
          -- ^ The start of the period over which observations are made 
          --   which are used in the calculation Used when the observation 
          --   start date differs from the trade date such as for forward 
          --   starting swaps.
        , correlAmount_optionsExchangeDividends :: Maybe Xsd.Boolean
          -- ^ If present and true, then options exchange dividends are 
          --   applicable.
        , correlAmount_additionalDividends :: Maybe Xsd.Boolean
          -- ^ If present and true, then additional dividends are 
          --   applicable.
        , correlAmount_allDividends :: Maybe Xsd.Boolean
          -- ^ Represents the European Master Confirmation value of 'All 
          --   Dividends' which, when applicable, signifies that, for a 
          --   given Ex-Date, the daily observed Share Price for that day 
          --   is adjusted (reduced) by the cash dividend and/or the cash 
          --   value of any non cash dividend per Share (including 
          --   Extraordinary Dividends) declared by the Issuer.
        , correlAmount_correlation :: Maybe Correlation
          -- ^ Specifies Correlation.
        }
        deriving (Eq,Show)
instance SchemaType CorrelationAmount where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return CorrelationAmount
            `apply` optional (parseSchemaType "calculationDates")
            `apply` optional (parseSchemaType "observationStartDate")
            `apply` optional (parseSchemaType "optionsExchangeDividends")
            `apply` optional (parseSchemaType "additionalDividends")
            `apply` optional (parseSchemaType "allDividends")
            `apply` optional (parseSchemaType "correlation")
    schemaTypeToXML s x@CorrelationAmount{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "calculationDates") $ correlAmount_calculationDates x
            , maybe [] (schemaTypeToXML "observationStartDate") $ correlAmount_observationStartDate x
            , maybe [] (schemaTypeToXML "optionsExchangeDividends") $ correlAmount_optionsExchangeDividends x
            , maybe [] (schemaTypeToXML "additionalDividends") $ correlAmount_additionalDividends x
            , maybe [] (schemaTypeToXML "allDividends") $ correlAmount_allDividends x
            , maybe [] (schemaTypeToXML "correlation") $ correlAmount_correlation x
            ]
instance Extension CorrelationAmount CalculatedAmount where
    supertype v = CalculatedAmount_CorrelationAmount v
 
-- | A type describing return which is driven by a Correlation 
--   calculation.
data CorrelationLeg = CorrelationLeg
        { correlLeg_ID :: Maybe Xsd.ID
        , correlLeg_legIdentifier :: [LegIdentifier]
          -- ^ Version aware identification of this leg.
        , correlLeg_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , correlLeg_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , correlLeg_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , correlLeg_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        , correlLeg_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.
        , correlLeg_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.
        , correlLeg_underlyer :: Maybe Underlyer
          -- ^ Specifies the underlyer of the leg.
        , correlLeg_settlementType :: Maybe SettlementTypeEnum
        , correlLeg_settlementDate :: Maybe AdjustableOrRelativeDate
        , correlLeg_choice10 :: (Maybe (OneOf2 Money Currency))
          -- ^ Choice between:
          --   
          --   (1) Settlement Amount
          --   
          --   (2) Settlement Currency for use where the Settlement Amount 
          --   cannot be known in advance
        , correlLeg_fxFeature :: Maybe FxFeature
          -- ^ Quanto, Composite, or Cross Currency FX features.
        , correlLeg_valuation :: Maybe EquityValuation
          -- ^ Valuation of the underlyer.
        , correlLeg_amount :: Maybe CorrelationAmount
          -- ^ Specifies, in relation to each Equity Payment Date, the 
          --   Equity Amount to which the Equity Payment Date relates. 
          --   Unless otherwise specified, this term has the meaning 
          --   defined in the ISDA 2002 Equity Derivatives Definitions.
        }
        deriving (Eq,Show)
instance SchemaType CorrelationLeg where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (CorrelationLeg 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 "valuation")
            `apply` optional (parseSchemaType "amount")
    schemaTypeToXML s x@CorrelationLeg{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ correlLeg_ID x
                       ]
            [ concatMap (schemaTypeToXML "legIdentifier") $ correlLeg_legIdentifier x
            , maybe [] (schemaTypeToXML "payerPartyReference") $ correlLeg_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ correlLeg_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ correlLeg_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ correlLeg_receiverAccountReference x
            , maybe [] (schemaTypeToXML "effectiveDate") $ correlLeg_effectiveDate x
            , maybe [] (schemaTypeToXML "terminationDate") $ correlLeg_terminationDate x
            , maybe [] (schemaTypeToXML "underlyer") $ correlLeg_underlyer x
            , maybe [] (schemaTypeToXML "settlementType") $ correlLeg_settlementType x
            , maybe [] (schemaTypeToXML "settlementDate") $ correlLeg_settlementDate x
            , maybe [] (foldOneOf2  (schemaTypeToXML "settlementAmount")
                                    (schemaTypeToXML "settlementCurrency")
                                   ) $ correlLeg_choice10 x
            , maybe [] (schemaTypeToXML "fxFeature") $ correlLeg_fxFeature x
            , maybe [] (schemaTypeToXML "valuation") $ correlLeg_valuation x
            , maybe [] (schemaTypeToXML "amount") $ correlLeg_amount x
            ]
instance Extension CorrelationLeg DirectionalLegUnderlyerValuation where
    supertype v = DirectionalLegUnderlyerValuation_CorrelationLeg v
instance Extension CorrelationLeg DirectionalLegUnderlyer where
    supertype = (supertype :: DirectionalLegUnderlyerValuation -> DirectionalLegUnderlyer)
              . (supertype :: CorrelationLeg -> DirectionalLegUnderlyerValuation)
              
instance Extension CorrelationLeg DirectionalLeg where
    supertype = (supertype :: DirectionalLegUnderlyer -> DirectionalLeg)
              . (supertype :: DirectionalLegUnderlyerValuation -> DirectionalLegUnderlyer)
              . (supertype :: CorrelationLeg -> DirectionalLegUnderlyerValuation)
              
instance Extension CorrelationLeg Leg where
    supertype = (supertype :: DirectionalLeg -> Leg)
              . (supertype :: DirectionalLegUnderlyer -> DirectionalLeg)
              . (supertype :: DirectionalLegUnderlyerValuation -> DirectionalLegUnderlyer)
              . (supertype :: CorrelationLeg -> DirectionalLegUnderlyerValuation)
              
 
-- | A Correlation Swap modelled using a single netted leg.
data CorrelationSwap = CorrelationSwap
        { correlSwap_ID :: Maybe Xsd.ID
        , correlSwap_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.
        , correlSwap_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , correlSwap_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , correlSwap_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.
        , correlSwap_additionalPayment :: [ClassifiedPayment]
          -- ^ Specifies additional payment(s) between the principal 
          --   parties to the netted swap.
        , correlSwap_extraordinaryEvents :: Maybe ExtraordinaryEvents
          -- ^ Where the underlying is shares, specifies events affecting 
          --   the issuer of those shares that may require the terms of 
          --   the transaction to be adjusted.
        , correlSwap_correlationLeg :: Maybe CorrelationLeg
          -- ^ Correlation Leg. Correlation Buyer is deemed to be the 
          --   Equity Amount Receiver, Correlation Seller is deemed to be 
          --   the Equity Amount Payer.
        }
        deriving (Eq,Show)
instance SchemaType CorrelationSwap where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (CorrelationSwap a0)
            `apply` optional (parseSchemaType "primaryAssetClass")
            `apply` many (parseSchemaType "secondaryAssetClass")
            `apply` many (parseSchemaType "productType")
            `apply` many (parseSchemaType "productId")
            `apply` many (parseSchemaType "additionalPayment")
            `apply` optional (parseSchemaType "extraordinaryEvents")
            `apply` optional (parseSchemaType "correlationLeg")
    schemaTypeToXML s x@CorrelationSwap{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ correlSwap_ID x
                       ]
            [ maybe [] (schemaTypeToXML "primaryAssetClass") $ correlSwap_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ correlSwap_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ correlSwap_productType x
            , concatMap (schemaTypeToXML "productId") $ correlSwap_productId x
            , concatMap (schemaTypeToXML "additionalPayment") $ correlSwap_additionalPayment x
            , maybe [] (schemaTypeToXML "extraordinaryEvents") $ correlSwap_extraordinaryEvents x
            , maybe [] (schemaTypeToXML "correlationLeg") $ correlSwap_correlationLeg x
            ]
instance Extension CorrelationSwap NettedSwapBase where
    supertype v = NettedSwapBase_CorrelationSwap v
instance Extension CorrelationSwap Product where
    supertype = (supertype :: NettedSwapBase -> Product)
              . (supertype :: CorrelationSwap -> NettedSwapBase)
              
 
-- | Specifies the structure of a correlation swap.
elementCorrelationSwap :: XMLParser CorrelationSwap
elementCorrelationSwap = parseSchemaType "correlationSwap"
elementToXMLCorrelationSwap :: CorrelationSwap -> [Content ()]
elementToXMLCorrelationSwap = schemaTypeToXML "correlationSwap"