{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Swaps.Return
  ( module Data.FpML.V53.Swaps.Return
  , 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.
 
-- | A type for defining Equity Swap Transaction Supplement
data EquitySwapTransactionSupplement = EquitySwapTransactionSupplement
        { equitySwapTransSuppl_ID :: Maybe Xsd.ID
        , equitySwapTransSuppl_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.
        , equitySwapTransSuppl_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , equitySwapTransSuppl_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , equitySwapTransSuppl_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.
        , equitySwapTransSuppl_buyerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that buys this instrument, ie. 
          --   pays for this instrument and receives the rights defined by 
          --   it. See 2000 ISDA definitions Article 11.1 (b). In the case 
          --   of FRAs this the fixed rate payer.
        , equitySwapTransSuppl_buyerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that buys this instrument.
        , equitySwapTransSuppl_sellerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that sells ("writes") this 
          --   instrument, i.e. that grants the rights defined by this 
          --   instrument and in return receives a payment for it. See 
          --   2000 ISDA definitions Article 11.1 (a). In the case of FRAs 
          --   this is the floating rate payer.
        , equitySwapTransSuppl_sellerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that sells this instrument.
        , equitySwapTransSuppl_returnSwapLeg :: [DirectionalLeg]
          -- ^ An placeholder for the actual Return Swap Leg definition.
        , equitySwapTransSuppl_principalExchangeFeatures :: Maybe PrincipalExchangeFeatures
          -- ^ This is used to document a Fully Funded Return Swap.
        , equitySwapTransSuppl_choice10 :: (Maybe (OneOf2 Xsd.Boolean ((Maybe (Xsd.Boolean)),(Maybe (Xsd.Boolean)),(Maybe (FeeElectionEnum)),(Maybe (NonNegativeDecimal)))))
          -- ^ Choice between:
          --   
          --   (1) Used for specifying whether the Mutual Early 
          --   Termination Right that is detailed in the Master 
          --   Confirmation will apply.
          --   
          --   (2) Sequence of:
          --   
          --     * A Boolean element used for specifying whether the 
          --   Optional Early Termination clause detailed in the 
          --   agreement will apply.
          --   
          --     * A Boolean element used for specifying whether the 
          --   Break Funding Recovery detailed in the agreement 
          --   will apply.
          --   
          --     * Defines the fee type.
          --   
          --     * breakFeeRate
        , equitySwapTransSuppl_choice11 :: (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.
        , equitySwapTransSuppl_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.
        , equitySwapTransSuppl_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.
        , equitySwapTransSuppl_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.
        }
        deriving (Eq,Show)
instance SchemaType EquitySwapTransactionSupplement where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (EquitySwapTransactionSupplement a0)
            `apply` optional (parseSchemaType "primaryAssetClass")
            `apply` many (parseSchemaType "secondaryAssetClass")
            `apply` many (parseSchemaType "productType")
            `apply` many (parseSchemaType "productId")
            `apply` optional (parseSchemaType "buyerPartyReference")
            `apply` optional (parseSchemaType "buyerAccountReference")
            `apply` optional (parseSchemaType "sellerPartyReference")
            `apply` optional (parseSchemaType "sellerAccountReference")
            `apply` between (Occurs (Just 0) (Just 2))
                            (elementReturnSwapLeg)
            `apply` optional (parseSchemaType "principalExchangeFeatures")
            `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf2 (parseSchemaType "mutualEarlyTermination"))
                                     , ("Maybe Xsd.Boolean Maybe Xsd.Boolean Maybe FeeElectionEnum Maybe NonNegativeDecimal", fmap TwoOf2 (return (,,,) `apply` optional (parseSchemaType "optionalEarlyTermination")
                                                                                                                                                        `apply` optional (parseSchemaType "breakFundingRecovery")
                                                                                                                                                        `apply` optional (parseSchemaType "breakFeeElection")
                                                                                                                                                        `apply` optional (parseSchemaType "breakFeeRate")))
                                     ])
            `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf2 (parseSchemaType "multipleExchangeIndexAnnexFallback"))
                                     , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "componentSecurityIndexAnnexFallback"))
                                     ])
            `apply` optional (parseSchemaType "localJurisdiction")
            `apply` optional (parseSchemaType "relevantJurisdiction")
            `apply` optional (parseSchemaType "extraordinaryEvents")
    schemaTypeToXML s x@EquitySwapTransactionSupplement{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ equitySwapTransSuppl_ID x
                       ]
            [ maybe [] (schemaTypeToXML "primaryAssetClass") $ equitySwapTransSuppl_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ equitySwapTransSuppl_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ equitySwapTransSuppl_productType x
            , concatMap (schemaTypeToXML "productId") $ equitySwapTransSuppl_productId x
            , maybe [] (schemaTypeToXML "buyerPartyReference") $ equitySwapTransSuppl_buyerPartyReference x
            , maybe [] (schemaTypeToXML "buyerAccountReference") $ equitySwapTransSuppl_buyerAccountReference x
            , maybe [] (schemaTypeToXML "sellerPartyReference") $ equitySwapTransSuppl_sellerPartyReference x
            , maybe [] (schemaTypeToXML "sellerAccountReference") $ equitySwapTransSuppl_sellerAccountReference x
            , concatMap (elementToXMLReturnSwapLeg) $ equitySwapTransSuppl_returnSwapLeg x
            , maybe [] (schemaTypeToXML "principalExchangeFeatures") $ equitySwapTransSuppl_principalExchangeFeatures x
            , maybe [] (foldOneOf2  (schemaTypeToXML "mutualEarlyTermination")
                                    (\ (a,b,c,d) -> concat [ maybe [] (schemaTypeToXML "optionalEarlyTermination") a
                                                           , maybe [] (schemaTypeToXML "breakFundingRecovery") b
                                                           , maybe [] (schemaTypeToXML "breakFeeElection") c
                                                           , maybe [] (schemaTypeToXML "breakFeeRate") d
                                                           ])
                                   ) $ equitySwapTransSuppl_choice10 x
            , maybe [] (foldOneOf2  (schemaTypeToXML "multipleExchangeIndexAnnexFallback")
                                    (schemaTypeToXML "componentSecurityIndexAnnexFallback")
                                   ) $ equitySwapTransSuppl_choice11 x
            , maybe [] (schemaTypeToXML "localJurisdiction") $ equitySwapTransSuppl_localJurisdiction x
            , maybe [] (schemaTypeToXML "relevantJurisdiction") $ equitySwapTransSuppl_relevantJurisdiction x
            , maybe [] (schemaTypeToXML "extraordinaryEvents") $ equitySwapTransSuppl_extraordinaryEvents x
            ]
instance Extension EquitySwapTransactionSupplement ReturnSwapBase where
    supertype v = ReturnSwapBase_EquitySwapTransactionSupplement v
instance Extension EquitySwapTransactionSupplement Product where
    supertype = (supertype :: ReturnSwapBase -> Product)
              . (supertype :: EquitySwapTransactionSupplement -> ReturnSwapBase)
              
 
-- | Specifies the structure of the equity swap transaction 
--   supplement.
elementEquitySwapTransactionSupplement :: XMLParser EquitySwapTransactionSupplement
elementEquitySwapTransactionSupplement = parseSchemaType "equitySwapTransactionSupplement"
elementToXMLEquitySwapTransactionSupplement :: EquitySwapTransactionSupplement -> [Content ()]
elementToXMLEquitySwapTransactionSupplement = schemaTypeToXML "equitySwapTransactionSupplement"