{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} module Data.FpML.V53.Eqd ( module Data.FpML.V53.Eqd , 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 the broker equity options. data BrokerEquityOption = BrokerEquityOption { brokerEquityOption_ID :: Maybe Xsd.ID , brokerEquityOption_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. , brokerEquityOption_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , brokerEquityOption_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , brokerEquityOption_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. , brokerEquityOption_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. , brokerEquityOption_buyerAccountReference :: Maybe AccountReference -- ^ A reference to the account that buys this instrument. , brokerEquityOption_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. , brokerEquityOption_sellerAccountReference :: Maybe AccountReference -- ^ A reference to the account that sells this instrument. , brokerEquityOption_optionType :: Maybe EquityOptionTypeEnum -- ^ The type of option transaction. , brokerEquityOption_equityEffectiveDate :: Maybe Xsd.Date -- ^ Effective date for a forward starting option. , brokerEquityOption_underlyer :: Maybe Underlyer -- ^ Specifies the underlying component, which can be either one -- or many and consists in either equity, index or convertible -- bond component, or a combination of these. , brokerEquityOption_notional :: Maybe NonNegativeMoney -- ^ The notional amount. , brokerEquityOption_equityExercise :: Maybe EquityExerciseValuationSettlement -- ^ The parameters for defining how the equity option can be -- exercised, how it is valued and how it is settled. , brokerEquityOption_feature :: Maybe OptionFeatures -- ^ Asian, Barrier, Knock and Pass Through features. , brokerEquityOption_fxFeature :: Maybe FxFeature -- ^ Quanto, Composite, or Cross Currency FX features. , brokerEquityOption_strategyFeature :: Maybe StrategyFeature -- ^ A equity option simple strategy feature. , brokerEquityOption_strike :: Maybe EquityStrike -- ^ Defines whether it is a price or level at which the option -- has been, or will be, struck. , brokerEquityOption_spotPrice :: Maybe NonNegativeDecimal -- ^ The price per share, index or basket observed on the trade -- or effective date. , brokerEquityOption_numberOfOptions :: Maybe NonNegativeDecimal -- ^ The number of options comprised in the option transaction. , brokerEquityOption_equityPremium :: Maybe EquityPremium -- ^ The equity option premium payable by the buyer to the -- seller. , brokerEquityOption_deltaCrossed :: Maybe Xsd.Boolean , brokerEquityOption_brokerageFee :: Maybe Money , brokerEquityOption_brokerNotes :: Maybe Xsd.XsdString } deriving (Eq,Show) instance SchemaType BrokerEquityOption where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (BrokerEquityOption 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` optional (parseSchemaType "optionType") `apply` optional (parseSchemaType "equityEffectiveDate") `apply` optional (parseSchemaType "underlyer") `apply` optional (parseSchemaType "notional") `apply` optional (parseSchemaType "equityExercise") `apply` optional (parseSchemaType "feature") `apply` optional (parseSchemaType "fxFeature") `apply` optional (parseSchemaType "strategyFeature") `apply` optional (parseSchemaType "strike") `apply` optional (parseSchemaType "spotPrice") `apply` optional (parseSchemaType "numberOfOptions") `apply` optional (parseSchemaType "equityPremium") `apply` optional (parseSchemaType "deltaCrossed") `apply` optional (parseSchemaType "brokerageFee") `apply` optional (parseSchemaType "brokerNotes") schemaTypeToXML s x@BrokerEquityOption{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ brokerEquityOption_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ brokerEquityOption_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ brokerEquityOption_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ brokerEquityOption_productType x , concatMap (schemaTypeToXML "productId") $ brokerEquityOption_productId x , maybe [] (schemaTypeToXML "buyerPartyReference") $ brokerEquityOption_buyerPartyReference x , maybe [] (schemaTypeToXML "buyerAccountReference") $ brokerEquityOption_buyerAccountReference x , maybe [] (schemaTypeToXML "sellerPartyReference") $ brokerEquityOption_sellerPartyReference x , maybe [] (schemaTypeToXML "sellerAccountReference") $ brokerEquityOption_sellerAccountReference x , maybe [] (schemaTypeToXML "optionType") $ brokerEquityOption_optionType x , maybe [] (schemaTypeToXML "equityEffectiveDate") $ brokerEquityOption_equityEffectiveDate x , maybe [] (schemaTypeToXML "underlyer") $ brokerEquityOption_underlyer x , maybe [] (schemaTypeToXML "notional") $ brokerEquityOption_notional x , maybe [] (schemaTypeToXML "equityExercise") $ brokerEquityOption_equityExercise x , maybe [] (schemaTypeToXML "feature") $ brokerEquityOption_feature x , maybe [] (schemaTypeToXML "fxFeature") $ brokerEquityOption_fxFeature x , maybe [] (schemaTypeToXML "strategyFeature") $ brokerEquityOption_strategyFeature x , maybe [] (schemaTypeToXML "strike") $ brokerEquityOption_strike x , maybe [] (schemaTypeToXML "spotPrice") $ brokerEquityOption_spotPrice x , maybe [] (schemaTypeToXML "numberOfOptions") $ brokerEquityOption_numberOfOptions x , maybe [] (schemaTypeToXML "equityPremium") $ brokerEquityOption_equityPremium x , maybe [] (schemaTypeToXML "deltaCrossed") $ brokerEquityOption_deltaCrossed x , maybe [] (schemaTypeToXML "brokerageFee") $ brokerEquityOption_brokerageFee x , maybe [] (schemaTypeToXML "brokerNotes") $ brokerEquityOption_brokerNotes x ] instance Extension BrokerEquityOption EquityDerivativeShortFormBase where supertype v = EquityDerivativeShortFormBase_BrokerEquityOption v instance Extension BrokerEquityOption EquityDerivativeBase where supertype = (supertype :: EquityDerivativeShortFormBase -> EquityDerivativeBase) . (supertype :: BrokerEquityOption -> EquityDerivativeShortFormBase) instance Extension BrokerEquityOption Product where supertype = (supertype :: EquityDerivativeBase -> Product) . (supertype :: EquityDerivativeShortFormBase -> EquityDerivativeBase) . (supertype :: BrokerEquityOption -> EquityDerivativeShortFormBase) -- | A type for defining exercise procedures associated with an -- American style exercise of an equity option. This entity -- inherits from the type SharedAmericanExercise. data EquityAmericanExercise = EquityAmericanExercise { equityAmericExerc_ID :: Maybe Xsd.ID , equityAmericExerc_commencementDate :: Maybe AdjustableOrRelativeDate -- ^ The first day of the exercise period for an American style -- option. , equityAmericExerc_expirationDate :: Maybe AdjustableOrRelativeDate -- ^ The last day within an exercise period for an American -- style option. For a European style option it is the only -- day within the exercise period. , equityAmericExerc_choice2 :: (Maybe (OneOf2 BusinessCenterTime DeterminationMethod)) -- ^ Choice between latest exercise time expressed as literal -- time, or using a determination method. -- -- Choice between: -- -- (1) For a Bermuda or American style option, the latest time -- on an exercise business day (excluding the expiration -- date) within the exercise period that notice can be -- given by the buyer to the seller or seller's agent. -- Notice of exercise given after this time will be deemed -- to have been given on the next exercise business day. -- -- (2) Latest exercise time determination method. , equityAmericExerc_latestExerciseTimeType :: Maybe TimeTypeEnum -- ^ The latest time of day at which the equity option can be -- exercised, for example the official closing time of the -- exchange. , equityAmericExerc_choice4 :: (Maybe (OneOf2 ((Maybe (TimeTypeEnum)),(Maybe (BusinessCenterTime))) DeterminationMethod)) -- ^ Choice between: -- -- (1) Sequence of: -- -- * The time of day at which the equity option expires, -- for example the official closing time of the -- exchange. -- -- * The specific time of day at which the equity option -- expires. -- -- (2) Expiration time determination method. , equityAmericExerc_equityMultipleExercise :: Maybe EquityMultipleExercise -- ^ The presence of this element indicates that the option may -- be exercised on different days. It is not applicable to -- European options. } deriving (Eq,Show) instance SchemaType EquityAmericanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (EquityAmericanExercise a0) `apply` optional (parseSchemaType "commencementDate") `apply` optional (parseSchemaType "expirationDate") `apply` optional (oneOf' [ ("BusinessCenterTime", fmap OneOf2 (parseSchemaType "latestExerciseTime")) , ("DeterminationMethod", fmap TwoOf2 (parseSchemaType "latestExerciseTimeDetermination")) ]) `apply` optional (parseSchemaType "latestExerciseTimeType") `apply` optional (oneOf' [ ("Maybe TimeTypeEnum Maybe BusinessCenterTime", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "equityExpirationTimeType") `apply` optional (parseSchemaType "equityExpirationTime"))) , ("DeterminationMethod", fmap TwoOf2 (parseSchemaType "expirationTimeDetermination")) ]) `apply` optional (parseSchemaType "equityMultipleExercise") schemaTypeToXML s x@EquityAmericanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ equityAmericExerc_ID x ] [ maybe [] (schemaTypeToXML "commencementDate") $ equityAmericExerc_commencementDate x , maybe [] (schemaTypeToXML "expirationDate") $ equityAmericExerc_expirationDate x , maybe [] (foldOneOf2 (schemaTypeToXML "latestExerciseTime") (schemaTypeToXML "latestExerciseTimeDetermination") ) $ equityAmericExerc_choice2 x , maybe [] (schemaTypeToXML "latestExerciseTimeType") $ equityAmericExerc_latestExerciseTimeType x , maybe [] (foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "equityExpirationTimeType") a , maybe [] (schemaTypeToXML "equityExpirationTime") b ]) (schemaTypeToXML "expirationTimeDetermination") ) $ equityAmericExerc_choice4 x , maybe [] (schemaTypeToXML "equityMultipleExercise") $ equityAmericExerc_equityMultipleExercise x ] instance Extension EquityAmericanExercise SharedAmericanExercise where supertype (EquityAmericanExercise a0 e0 e1 e2 e3 e4 e5) = SharedAmericanExercise a0 e0 e1 e2 instance Extension EquityAmericanExercise Exercise where supertype = (supertype :: SharedAmericanExercise -> Exercise) . (supertype :: EquityAmericanExercise -> SharedAmericanExercise) -- | A type for defining exercise procedures associated with a -- Bermuda style exercise of an equity option. The term -- Bermuda is adopted in FpML for consistency with the ISDA -- Definitions. data EquityBermudaExercise = EquityBermudaExercise { equityBermudaExerc_ID :: Maybe Xsd.ID , equityBermudaExerc_commencementDate :: Maybe AdjustableOrRelativeDate -- ^ The first day of the exercise period for an American style -- option. , equityBermudaExerc_expirationDate :: Maybe AdjustableOrRelativeDate -- ^ The last day within an exercise period for an American -- style option. For a European style option it is the only -- day within the exercise period. , equityBermudaExerc_choice2 :: (Maybe (OneOf2 BusinessCenterTime DeterminationMethod)) -- ^ Choice between latest exercise time expressed as literal -- time, or using a determination method. -- -- Choice between: -- -- (1) For a Bermuda or American style option, the latest time -- on an exercise business day (excluding the expiration -- date) within the exercise period that notice can be -- given by the buyer to the seller or seller's agent. -- Notice of exercise given after this time will be deemed -- to have been given on the next exercise business day. -- -- (2) Latest exercise time determination method. , equityBermudaExerc_bermudaExerciseDates :: Maybe DateList -- ^ List of Exercise Dates for a Bermuda option. , equityBermudaExerc_latestExerciseTimeType :: Maybe TimeTypeEnum -- ^ The latest time of day at which the equity option can be -- exercised, for example the official closing time of the -- exchange. , equityBermudaExerc_choice5 :: (Maybe (OneOf2 ((Maybe (TimeTypeEnum)),(Maybe (BusinessCenterTime))) DeterminationMethod)) -- ^ Choice between: -- -- (1) Sequence of: -- -- * The time of day at which the equity option expires, -- for example the official closing time of the -- exchange. -- -- * The specific time of day at which the equity option -- expires. -- -- (2) Expiration time determination method. , equityBermudaExerc_equityMultipleExercise :: Maybe EquityMultipleExercise -- ^ The presence of this element indicates that the option may -- be exercised on different days. It is not applicable to -- European options. } deriving (Eq,Show) instance SchemaType EquityBermudaExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (EquityBermudaExercise a0) `apply` optional (parseSchemaType "commencementDate") `apply` optional (parseSchemaType "expirationDate") `apply` optional (oneOf' [ ("BusinessCenterTime", fmap OneOf2 (parseSchemaType "latestExerciseTime")) , ("DeterminationMethod", fmap TwoOf2 (parseSchemaType "latestExerciseTimeDetermination")) ]) `apply` optional (parseSchemaType "bermudaExerciseDates") `apply` optional (parseSchemaType "latestExerciseTimeType") `apply` optional (oneOf' [ ("Maybe TimeTypeEnum Maybe BusinessCenterTime", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "equityExpirationTimeType") `apply` optional (parseSchemaType "equityExpirationTime"))) , ("DeterminationMethod", fmap TwoOf2 (parseSchemaType "expirationTimeDetermination")) ]) `apply` optional (parseSchemaType "equityMultipleExercise") schemaTypeToXML s x@EquityBermudaExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ equityBermudaExerc_ID x ] [ maybe [] (schemaTypeToXML "commencementDate") $ equityBermudaExerc_commencementDate x , maybe [] (schemaTypeToXML "expirationDate") $ equityBermudaExerc_expirationDate x , maybe [] (foldOneOf2 (schemaTypeToXML "latestExerciseTime") (schemaTypeToXML "latestExerciseTimeDetermination") ) $ equityBermudaExerc_choice2 x , maybe [] (schemaTypeToXML "bermudaExerciseDates") $ equityBermudaExerc_bermudaExerciseDates x , maybe [] (schemaTypeToXML "latestExerciseTimeType") $ equityBermudaExerc_latestExerciseTimeType x , maybe [] (foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "equityExpirationTimeType") a , maybe [] (schemaTypeToXML "equityExpirationTime") b ]) (schemaTypeToXML "expirationTimeDetermination") ) $ equityBermudaExerc_choice5 x , maybe [] (schemaTypeToXML "equityMultipleExercise") $ equityBermudaExerc_equityMultipleExercise x ] instance Extension EquityBermudaExercise SharedAmericanExercise where supertype (EquityBermudaExercise a0 e0 e1 e2 e3 e4 e5 e6) = SharedAmericanExercise a0 e0 e1 e2 instance Extension EquityBermudaExercise Exercise where supertype = (supertype :: SharedAmericanExercise -> Exercise) . (supertype :: EquityBermudaExercise -> SharedAmericanExercise) -- | A type for defining the common features of equity -- derivatives. data EquityDerivativeBase = EquityDerivativeBase_EquityDerivativeShortFormBase EquityDerivativeShortFormBase | EquityDerivativeBase_EquityDerivativeLongFormBase EquityDerivativeLongFormBase deriving (Eq,Show) instance SchemaType EquityDerivativeBase where parseSchemaType s = do (fmap EquityDerivativeBase_EquityDerivativeShortFormBase $ parseSchemaType s) `onFail` (fmap EquityDerivativeBase_EquityDerivativeLongFormBase $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of EquityDerivativeBase,\n\ \ namely one of:\n\ \EquityDerivativeShortFormBase,EquityDerivativeLongFormBase" schemaTypeToXML _s (EquityDerivativeBase_EquityDerivativeShortFormBase x) = schemaTypeToXML "equityDerivativeShortFormBase" x schemaTypeToXML _s (EquityDerivativeBase_EquityDerivativeLongFormBase x) = schemaTypeToXML "equityDerivativeLongFormBase" x instance Extension EquityDerivativeBase Product where supertype v = Product_EquityDerivativeBase v -- | type for defining the common features of equity -- derivatives. data EquityDerivativeLongFormBase = EquityDerivativeLongFormBase_EquityOption EquityOption | EquityDerivativeLongFormBase_EquityForward EquityForward deriving (Eq,Show) instance SchemaType EquityDerivativeLongFormBase where parseSchemaType s = do (fmap EquityDerivativeLongFormBase_EquityOption $ parseSchemaType s) `onFail` (fmap EquityDerivativeLongFormBase_EquityForward $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of EquityDerivativeLongFormBase,\n\ \ namely one of:\n\ \EquityOption,EquityForward" schemaTypeToXML _s (EquityDerivativeLongFormBase_EquityOption x) = schemaTypeToXML "equityOption" x schemaTypeToXML _s (EquityDerivativeLongFormBase_EquityForward x) = schemaTypeToXML "equityForward" x instance Extension EquityDerivativeLongFormBase EquityDerivativeBase where supertype v = EquityDerivativeBase_EquityDerivativeLongFormBase v -- | A type for defining short form equity option basic -- features. data EquityDerivativeShortFormBase = EquityDerivativeShortFormBase_EquityOptionTransactionSupplement EquityOptionTransactionSupplement | EquityDerivativeShortFormBase_BrokerEquityOption BrokerEquityOption deriving (Eq,Show) instance SchemaType EquityDerivativeShortFormBase where parseSchemaType s = do (fmap EquityDerivativeShortFormBase_EquityOptionTransactionSupplement $ parseSchemaType s) `onFail` (fmap EquityDerivativeShortFormBase_BrokerEquityOption $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of EquityDerivativeShortFormBase,\n\ \ namely one of:\n\ \EquityOptionTransactionSupplement,BrokerEquityOption" schemaTypeToXML _s (EquityDerivativeShortFormBase_EquityOptionTransactionSupplement x) = schemaTypeToXML "equityOptionTransactionSupplement" x schemaTypeToXML _s (EquityDerivativeShortFormBase_BrokerEquityOption x) = schemaTypeToXML "brokerEquityOption" x instance Extension EquityDerivativeShortFormBase EquityDerivativeBase where supertype v = EquityDerivativeBase_EquityDerivativeShortFormBase v -- | A type for defining exercise procedures associated with a -- European style exercise of an equity option. data EquityEuropeanExercise = EquityEuropeanExercise { equityEuropExerc_ID :: Maybe Xsd.ID , equityEuropExerc_expirationDate :: Maybe AdjustableOrRelativeDate -- ^ The last day within an exercise period for an American -- style option. For a European style option it is the only -- day within the exercise period. , equityEuropExerc_choice1 :: (Maybe (OneOf2 ((Maybe (TimeTypeEnum)),(Maybe (BusinessCenterTime))) DeterminationMethod)) -- ^ Choice between: -- -- (1) Sequence of: -- -- * The time of day at which the equity option expires, -- for example the official closing time of the -- exchange. -- -- * The specific time of day at which the equity option -- expires. -- -- (2) Expiration time determination method. } deriving (Eq,Show) instance SchemaType EquityEuropeanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (EquityEuropeanExercise a0) `apply` optional (parseSchemaType "expirationDate") `apply` optional (oneOf' [ ("Maybe TimeTypeEnum Maybe BusinessCenterTime", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "equityExpirationTimeType") `apply` optional (parseSchemaType "equityExpirationTime"))) , ("DeterminationMethod", fmap TwoOf2 (parseSchemaType "expirationTimeDetermination")) ]) schemaTypeToXML s x@EquityEuropeanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ equityEuropExerc_ID x ] [ maybe [] (schemaTypeToXML "expirationDate") $ equityEuropExerc_expirationDate x , maybe [] (foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "equityExpirationTimeType") a , maybe [] (schemaTypeToXML "equityExpirationTime") b ]) (schemaTypeToXML "expirationTimeDetermination") ) $ equityEuropExerc_choice1 x ] instance Extension EquityEuropeanExercise Exercise where supertype v = Exercise_EquityEuropeanExercise v -- | A type for defining exercise procedures for equity options. data EquityExerciseValuationSettlement = EquityExerciseValuationSettlement { equityExercValSettl_choice0 :: (Maybe (OneOf3 EquityEuropeanExercise EquityAmericanExercise EquityBermudaExercise)) -- ^ The parameters for defining how the equity option can be -- exercised, how it is valued and how it is settled. -- -- Choice between: -- -- (1) The parameters for defining the expiration date and -- time for a European style equity option. -- -- (2) The parameters for defining the exercise period for an -- American style equity option together with the rules -- governing the quantity of the underlying that can be -- exercised on any given exercise date. -- -- (3) The parameters for defining the exercise period for an -- Bermuda style equity option together with the rules -- governing the quantity of the underlying that can be -- exercised on any given exercise date. , equityExercValSettl_choice1 :: (Maybe (OneOf2 ((Maybe (Xsd.Boolean)),(Maybe (MakeWholeProvisions))) PrePayment)) -- ^ Choice between: -- -- (1) Sequence of: -- -- * If true then each option not previously exercised -- will be deemed to be exercised at the expiration -- time on the expiration date without service of -- notice unless the buyer notifies the seller that it -- no longer wishes this to occur. -- -- * Provisions covering early exercise of option. -- -- (2) Prepayment features for Forward. , equityExercValSettl_equityValuation :: Maybe EquityValuation -- ^ The parameters for defining when valuation of the -- underlying takes place. , equityExercValSettl_settlementDate :: Maybe AdjustableOrRelativeDate -- ^ Date on which settlement of option premiums will occur. , equityExercValSettl_settlementCurrency :: Maybe Currency -- ^ The currency in which a cash settlement for non-deliverable -- forward and non-deliverable options. , equityExercValSettl_settlementPriceSource :: Maybe SettlementPriceSource , equityExercValSettl_settlementType :: Maybe SettlementTypeEnum -- ^ How the option will be settled. , equityExercValSettl_settlementMethodElectionDate :: Maybe AdjustableOrRelativeDate , equityExercValSettl_settlementMethodElectingPartyReference :: Maybe PartyReference , equityExercValSettl_settlementPriceDefaultElection :: Maybe SettlementPriceDefaultElection } deriving (Eq,Show) instance SchemaType EquityExerciseValuationSettlement where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return EquityExerciseValuationSettlement `apply` optional (oneOf' [ ("EquityEuropeanExercise", fmap OneOf3 (parseSchemaType "equityEuropeanExercise")) , ("EquityAmericanExercise", fmap TwoOf3 (parseSchemaType "equityAmericanExercise")) , ("EquityBermudaExercise", fmap ThreeOf3 (parseSchemaType "equityBermudaExercise")) ]) `apply` optional (oneOf' [ ("Maybe Xsd.Boolean Maybe MakeWholeProvisions", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "automaticExercise") `apply` optional (parseSchemaType "makeWholeProvisions"))) , ("PrePayment", fmap TwoOf2 (parseSchemaType "prePayment")) ]) `apply` optional (parseSchemaType "equityValuation") `apply` optional (parseSchemaType "settlementDate") `apply` optional (parseSchemaType "settlementCurrency") `apply` optional (parseSchemaType "settlementPriceSource") `apply` optional (parseSchemaType "settlementType") `apply` optional (parseSchemaType "settlementMethodElectionDate") `apply` optional (parseSchemaType "settlementMethodElectingPartyReference") `apply` optional (parseSchemaType "settlementPriceDefaultElection") schemaTypeToXML s x@EquityExerciseValuationSettlement{} = toXMLElement s [] [ maybe [] (foldOneOf3 (schemaTypeToXML "equityEuropeanExercise") (schemaTypeToXML "equityAmericanExercise") (schemaTypeToXML "equityBermudaExercise") ) $ equityExercValSettl_choice0 x , maybe [] (foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "automaticExercise") a , maybe [] (schemaTypeToXML "makeWholeProvisions") b ]) (schemaTypeToXML "prePayment") ) $ equityExercValSettl_choice1 x , maybe [] (schemaTypeToXML "equityValuation") $ equityExercValSettl_equityValuation x , maybe [] (schemaTypeToXML "settlementDate") $ equityExercValSettl_settlementDate x , maybe [] (schemaTypeToXML "settlementCurrency") $ equityExercValSettl_settlementCurrency x , maybe [] (schemaTypeToXML "settlementPriceSource") $ equityExercValSettl_settlementPriceSource x , maybe [] (schemaTypeToXML "settlementType") $ equityExercValSettl_settlementType x , maybe [] (schemaTypeToXML "settlementMethodElectionDate") $ equityExercValSettl_settlementMethodElectionDate x , maybe [] (schemaTypeToXML "settlementMethodElectingPartyReference") $ equityExercValSettl_settlementMethodElectingPartyReference x , maybe [] (schemaTypeToXML "settlementPriceDefaultElection") $ equityExercValSettl_settlementPriceDefaultElection x ] -- | A type for defining equity forwards. data EquityForward = EquityForward { equityForward_ID :: Maybe Xsd.ID , equityForward_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. , equityForward_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , equityForward_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , equityForward_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. , equityForward_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. , equityForward_buyerAccountReference :: Maybe AccountReference -- ^ A reference to the account that buys this instrument. , equityForward_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. , equityForward_sellerAccountReference :: Maybe AccountReference -- ^ A reference to the account that sells this instrument. , equityForward_optionType :: Maybe EquityOptionTypeEnum -- ^ The type of option transaction. , equityForward_equityEffectiveDate :: Maybe Xsd.Date -- ^ Effective date for a forward starting option. , equityForward_underlyer :: Maybe Underlyer -- ^ Specifies the underlying component, which can be either one -- or many and consists in either equity, index or convertible -- bond component, or a combination of these. , equityForward_notional :: Maybe NonNegativeMoney -- ^ The notional amount. , equityForward_equityExercise :: Maybe EquityExerciseValuationSettlement -- ^ The parameters for defining how the equity option can be -- exercised, how it is valued and how it is settled. , equityForward_feature :: Maybe OptionFeatures -- ^ Asian, Barrier, Knock and Pass Through features. , equityForward_fxFeature :: Maybe FxFeature -- ^ Quanto, Composite, or Cross Currency FX features. , equityForward_strategyFeature :: Maybe StrategyFeature -- ^ A equity option simple strategy feature. , equityForward_dividendConditions :: Maybe DividendConditions , equityForward_methodOfAdjustment :: Maybe MethodOfAdjustmentEnum -- ^ Defines how adjustments will be made to the contract should -- one or more of the extraordinary events occur. , equityForward_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. , equityForward_forwardPrice :: NonNegativeMoney -- ^ The forward price per share, index or basket. } deriving (Eq,Show) instance SchemaType EquityForward where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (EquityForward 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` optional (parseSchemaType "optionType") `apply` optional (parseSchemaType "equityEffectiveDate") `apply` optional (parseSchemaType "underlyer") `apply` optional (parseSchemaType "notional") `apply` optional (parseSchemaType "equityExercise") `apply` optional (parseSchemaType "feature") `apply` optional (parseSchemaType "fxFeature") `apply` optional (parseSchemaType "strategyFeature") `apply` optional (parseSchemaType "dividendConditions") `apply` optional (parseSchemaType "methodOfAdjustment") `apply` optional (parseSchemaType "extraordinaryEvents") `apply` parseSchemaType "forwardPrice" schemaTypeToXML s x@EquityForward{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ equityForward_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ equityForward_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ equityForward_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ equityForward_productType x , concatMap (schemaTypeToXML "productId") $ equityForward_productId x , maybe [] (schemaTypeToXML "buyerPartyReference") $ equityForward_buyerPartyReference x , maybe [] (schemaTypeToXML "buyerAccountReference") $ equityForward_buyerAccountReference x , maybe [] (schemaTypeToXML "sellerPartyReference") $ equityForward_sellerPartyReference x , maybe [] (schemaTypeToXML "sellerAccountReference") $ equityForward_sellerAccountReference x , maybe [] (schemaTypeToXML "optionType") $ equityForward_optionType x , maybe [] (schemaTypeToXML "equityEffectiveDate") $ equityForward_equityEffectiveDate x , maybe [] (schemaTypeToXML "underlyer") $ equityForward_underlyer x , maybe [] (schemaTypeToXML "notional") $ equityForward_notional x , maybe [] (schemaTypeToXML "equityExercise") $ equityForward_equityExercise x , maybe [] (schemaTypeToXML "feature") $ equityForward_feature x , maybe [] (schemaTypeToXML "fxFeature") $ equityForward_fxFeature x , maybe [] (schemaTypeToXML "strategyFeature") $ equityForward_strategyFeature x , maybe [] (schemaTypeToXML "dividendConditions") $ equityForward_dividendConditions x , maybe [] (schemaTypeToXML "methodOfAdjustment") $ equityForward_methodOfAdjustment x , maybe [] (schemaTypeToXML "extraordinaryEvents") $ equityForward_extraordinaryEvents x , schemaTypeToXML "forwardPrice" $ equityForward_forwardPrice x ] instance Extension EquityForward EquityDerivativeLongFormBase where supertype v = EquityDerivativeLongFormBase_EquityForward v instance Extension EquityForward EquityDerivativeBase where supertype = (supertype :: EquityDerivativeLongFormBase -> EquityDerivativeBase) . (supertype :: EquityForward -> EquityDerivativeLongFormBase) instance Extension EquityForward Product where supertype = (supertype :: EquityDerivativeBase -> Product) . (supertype :: EquityDerivativeLongFormBase -> EquityDerivativeBase) . (supertype :: EquityForward -> EquityDerivativeLongFormBase) -- | A type for defining the multiple exercise provisions of an -- American or Bermuda style equity option. data EquityMultipleExercise = EquityMultipleExercise { equityMultiExerc_integralMultipleExercise :: Maybe PositiveDecimal -- ^ When multiple exercise is applicable and this element is -- present it specifies that the number of options that can be -- exercised on a given exercise date must either be equal to -- the value of this element or be an integral multiple of it. , equityMultiExerc_minimumNumberOfOptions :: Maybe NonNegativeDecimal -- ^ When multiple exercise is applicable this element specifies -- the minimum number of options that can be exercised on a -- given exercise date. If this element is not present then -- the minimum number is deemed to be 1. Its value can be a -- fractional number as a result of corporate actions. , equityMultiExerc_maximumNumberOfOptions :: Maybe NonNegativeDecimal -- ^ When multiple exercise is applicable this element specifies -- the maximum number of options that can be exercised on a -- given exercise date. If this element is not present then -- the maximum number is deemed to be the same as the number -- of options. Its value can be a fractional number as a -- result of corporate actions. } deriving (Eq,Show) instance SchemaType EquityMultipleExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return EquityMultipleExercise `apply` optional (parseSchemaType "integralMultipleExercise") `apply` optional (parseSchemaType "minimumNumberOfOptions") `apply` optional (parseSchemaType "maximumNumberOfOptions") schemaTypeToXML s x@EquityMultipleExercise{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "integralMultipleExercise") $ equityMultiExerc_integralMultipleExercise x , maybe [] (schemaTypeToXML "minimumNumberOfOptions") $ equityMultiExerc_minimumNumberOfOptions x , maybe [] (schemaTypeToXML "maximumNumberOfOptions") $ equityMultiExerc_maximumNumberOfOptions x ] -- | A type for defining equity options. data EquityOption = EquityOption { equityOption_ID :: Maybe Xsd.ID , equityOption_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. , equityOption_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , equityOption_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , equityOption_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. , equityOption_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. , equityOption_buyerAccountReference :: Maybe AccountReference -- ^ A reference to the account that buys this instrument. , equityOption_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. , equityOption_sellerAccountReference :: Maybe AccountReference -- ^ A reference to the account that sells this instrument. , equityOption_optionType :: Maybe EquityOptionTypeEnum -- ^ The type of option transaction. , equityOption_equityEffectiveDate :: Maybe Xsd.Date -- ^ Effective date for a forward starting option. , equityOption_underlyer :: Maybe Underlyer -- ^ Specifies the underlying component, which can be either one -- or many and consists in either equity, index or convertible -- bond component, or a combination of these. , equityOption_notional :: Maybe NonNegativeMoney -- ^ The notional amount. , equityOption_equityExercise :: Maybe EquityExerciseValuationSettlement -- ^ The parameters for defining how the equity option can be -- exercised, how it is valued and how it is settled. , equityOption_feature :: Maybe OptionFeatures -- ^ Asian, Barrier, Knock and Pass Through features. , equityOption_fxFeature :: Maybe FxFeature -- ^ Quanto, Composite, or Cross Currency FX features. , equityOption_strategyFeature :: Maybe StrategyFeature -- ^ A equity option simple strategy feature. , equityOption_dividendConditions :: Maybe DividendConditions , equityOption_methodOfAdjustment :: Maybe MethodOfAdjustmentEnum -- ^ Defines how adjustments will be made to the contract should -- one or more of the extraordinary events occur. , equityOption_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. , equityOption_strike :: Maybe EquityStrike -- ^ Defines whether it is a price or level at which the option -- has been, or will be, struck. , equityOption_spotPrice :: Maybe NonNegativeDecimal -- ^ The price per share, index or basket observed on the trade -- or effective date. , equityOption_numberOfOptions :: Maybe NonNegativeDecimal -- ^ The number of options comprised in the option transaction. , equityOption_optionEntitlement :: Maybe PositiveDecimal -- ^ The number of shares per option comprised in the option -- transaction. , equityOption_equityPremium :: Maybe EquityPremium -- ^ The equity option premium payable by the buyer to the -- seller. } deriving (Eq,Show) instance SchemaType EquityOption where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (EquityOption 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` optional (parseSchemaType "optionType") `apply` optional (parseSchemaType "equityEffectiveDate") `apply` optional (parseSchemaType "underlyer") `apply` optional (parseSchemaType "notional") `apply` optional (parseSchemaType "equityExercise") `apply` optional (parseSchemaType "feature") `apply` optional (parseSchemaType "fxFeature") `apply` optional (parseSchemaType "strategyFeature") `apply` optional (parseSchemaType "dividendConditions") `apply` optional (parseSchemaType "methodOfAdjustment") `apply` optional (parseSchemaType "extraordinaryEvents") `apply` optional (parseSchemaType "strike") `apply` optional (parseSchemaType "spotPrice") `apply` optional (parseSchemaType "numberOfOptions") `apply` optional (parseSchemaType "optionEntitlement") `apply` optional (parseSchemaType "equityPremium") schemaTypeToXML s x@EquityOption{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ equityOption_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ equityOption_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ equityOption_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ equityOption_productType x , concatMap (schemaTypeToXML "productId") $ equityOption_productId x , maybe [] (schemaTypeToXML "buyerPartyReference") $ equityOption_buyerPartyReference x , maybe [] (schemaTypeToXML "buyerAccountReference") $ equityOption_buyerAccountReference x , maybe [] (schemaTypeToXML "sellerPartyReference") $ equityOption_sellerPartyReference x , maybe [] (schemaTypeToXML "sellerAccountReference") $ equityOption_sellerAccountReference x , maybe [] (schemaTypeToXML "optionType") $ equityOption_optionType x , maybe [] (schemaTypeToXML "equityEffectiveDate") $ equityOption_equityEffectiveDate x , maybe [] (schemaTypeToXML "underlyer") $ equityOption_underlyer x , maybe [] (schemaTypeToXML "notional") $ equityOption_notional x , maybe [] (schemaTypeToXML "equityExercise") $ equityOption_equityExercise x , maybe [] (schemaTypeToXML "feature") $ equityOption_feature x , maybe [] (schemaTypeToXML "fxFeature") $ equityOption_fxFeature x , maybe [] (schemaTypeToXML "strategyFeature") $ equityOption_strategyFeature x , maybe [] (schemaTypeToXML "dividendConditions") $ equityOption_dividendConditions x , maybe [] (schemaTypeToXML "methodOfAdjustment") $ equityOption_methodOfAdjustment x , maybe [] (schemaTypeToXML "extraordinaryEvents") $ equityOption_extraordinaryEvents x , maybe [] (schemaTypeToXML "strike") $ equityOption_strike x , maybe [] (schemaTypeToXML "spotPrice") $ equityOption_spotPrice x , maybe [] (schemaTypeToXML "numberOfOptions") $ equityOption_numberOfOptions x , maybe [] (schemaTypeToXML "optionEntitlement") $ equityOption_optionEntitlement x , maybe [] (schemaTypeToXML "equityPremium") $ equityOption_equityPremium x ] instance Extension EquityOption EquityDerivativeLongFormBase where supertype v = EquityDerivativeLongFormBase_EquityOption v instance Extension EquityOption EquityDerivativeBase where supertype = (supertype :: EquityDerivativeLongFormBase -> EquityDerivativeBase) . (supertype :: EquityOption -> EquityDerivativeLongFormBase) instance Extension EquityOption Product where supertype = (supertype :: EquityDerivativeBase -> Product) . (supertype :: EquityDerivativeLongFormBase -> EquityDerivativeBase) . (supertype :: EquityOption -> EquityDerivativeLongFormBase) -- | A type for defining Equity Option Termination. data EquityOptionTermination = EquityOptionTermination { equityOptionTermin_settlementAmountPaymentDate :: Maybe AdjustableDate , equityOptionTermin_settlementAmount :: Maybe NonNegativeMoney } deriving (Eq,Show) instance SchemaType EquityOptionTermination where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return EquityOptionTermination `apply` optional (parseSchemaType "settlementAmountPaymentDate") `apply` optional (parseSchemaType "settlementAmount") schemaTypeToXML s x@EquityOptionTermination{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "settlementAmountPaymentDate") $ equityOptionTermin_settlementAmountPaymentDate x , maybe [] (schemaTypeToXML "settlementAmount") $ equityOptionTermin_settlementAmount x ] -- | A type for defining equity option transaction supplements. data EquityOptionTransactionSupplement = EquityOptionTransactionSupplement { equityOptionTransSuppl_ID :: Maybe Xsd.ID , equityOptionTransSuppl_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. , equityOptionTransSuppl_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , equityOptionTransSuppl_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , equityOptionTransSuppl_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. , equityOptionTransSuppl_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. , equityOptionTransSuppl_buyerAccountReference :: Maybe AccountReference -- ^ A reference to the account that buys this instrument. , equityOptionTransSuppl_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. , equityOptionTransSuppl_sellerAccountReference :: Maybe AccountReference -- ^ A reference to the account that sells this instrument. , equityOptionTransSuppl_optionType :: Maybe EquityOptionTypeEnum -- ^ The type of option transaction. , equityOptionTransSuppl_equityEffectiveDate :: Maybe Xsd.Date -- ^ Effective date for a forward starting option. , equityOptionTransSuppl_underlyer :: Maybe Underlyer -- ^ Specifies the underlying component, which can be either one -- or many and consists in either equity, index or convertible -- bond component, or a combination of these. , equityOptionTransSuppl_notional :: Maybe NonNegativeMoney -- ^ The notional amount. , equityOptionTransSuppl_equityExercise :: Maybe EquityExerciseValuationSettlement -- ^ The parameters for defining how the equity option can be -- exercised, how it is valued and how it is settled. , equityOptionTransSuppl_feature :: Maybe OptionFeatures -- ^ Asian, Barrier, Knock and Pass Through features. , equityOptionTransSuppl_fxFeature :: Maybe FxFeature -- ^ Quanto, Composite, or Cross Currency FX features. , equityOptionTransSuppl_strategyFeature :: Maybe StrategyFeature -- ^ A equity option simple strategy feature. , equityOptionTransSuppl_strike :: Maybe EquityStrike -- ^ Defines whether it is a price or level at which the option -- has been, or will be, struck. , equityOptionTransSuppl_spotPrice :: Maybe NonNegativeDecimal -- ^ The price per share, index or basket observed on the trade -- or effective date. , equityOptionTransSuppl_numberOfOptions :: Maybe NonNegativeDecimal -- ^ The number of options comprised in the option transaction. , equityOptionTransSuppl_equityPremium :: Maybe EquityPremium -- ^ The equity option premium payable by the buyer to the -- seller. , equityOptionTransSuppl_exchangeLookAlike :: Maybe Xsd.Boolean -- ^ For a share option transaction, a flag used to indicate -- whether the transaction is to be treated as an 'exchange -- look-alike'. This designation has significance for how -- share adjustments (arising from corporate actions) will be -- determined for the transaction. For an 'exchange -- look-alike' transaction the relevant share adjustments will -- follow that for a corresponding designated contract listed -- on the related exchange (referred to as Options Exchange -- Adjustment (ISDA defined term), otherwise the share -- adjustments will be determined by the calculation agent -- (referred to as Calculation Agent Adjustment (ISDA defined -- term)). , equityOptionTransSuppl_exchangeTradedContractNearest :: Maybe Xsd.Boolean -- ^ For an index option transaction, a flag used in conjuction -- with Futures Price Valuation (ISDA defined term) to -- indicate whether the Nearest Index Contract provision is -- applicable. The Nearest Index Contract provision is a rule -- for determining the Exchange-traded Contract (ISDA defined -- term) without having to explicitly state the actual -- contract, delivery month and exchange on which it is -- traded. , equityOptionTransSuppl_choice22 :: (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. , equityOptionTransSuppl_methodOfAdjustment :: Maybe MethodOfAdjustmentEnum , equityOptionTransSuppl_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. , equityOptionTransSuppl_choice25 :: (Maybe (OneOf2 PositiveDecimal PositiveDecimal)) -- ^ Choice between: -- -- (1) The number of shares per option comprised in the option -- transaction supplement. -- -- (2) Specifies the contract multiplier that can be -- associated with an index option. , equityOptionTransSuppl_extraordinaryEvents :: Maybe ExtraordinaryEvents -- ^ A component to contain elements that represent an -- extraordinary event. } deriving (Eq,Show) instance SchemaType EquityOptionTransactionSupplement where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (EquityOptionTransactionSupplement 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` optional (parseSchemaType "optionType") `apply` optional (parseSchemaType "equityEffectiveDate") `apply` optional (parseSchemaType "underlyer") `apply` optional (parseSchemaType "notional") `apply` optional (parseSchemaType "equityExercise") `apply` optional (parseSchemaType "feature") `apply` optional (parseSchemaType "fxFeature") `apply` optional (parseSchemaType "strategyFeature") `apply` optional (parseSchemaType "strike") `apply` optional (parseSchemaType "spotPrice") `apply` optional (parseSchemaType "numberOfOptions") `apply` optional (parseSchemaType "equityPremium") `apply` optional (parseSchemaType "exchangeLookAlike") `apply` optional (parseSchemaType "exchangeTradedContractNearest") `apply` optional (oneOf' [ ("Xsd.Boolean", fmap OneOf2 (parseSchemaType "multipleExchangeIndexAnnexFallback")) , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "componentSecurityIndexAnnexFallback")) ]) `apply` optional (parseSchemaType "methodOfAdjustment") `apply` optional (parseSchemaType "localJurisdiction") `apply` optional (oneOf' [ ("PositiveDecimal", fmap OneOf2 (parseSchemaType "optionEntitlement")) , ("PositiveDecimal", fmap TwoOf2 (parseSchemaType "multiplier")) ]) `apply` optional (parseSchemaType "extraordinaryEvents") schemaTypeToXML s x@EquityOptionTransactionSupplement{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ equityOptionTransSuppl_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ equityOptionTransSuppl_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ equityOptionTransSuppl_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ equityOptionTransSuppl_productType x , concatMap (schemaTypeToXML "productId") $ equityOptionTransSuppl_productId x , maybe [] (schemaTypeToXML "buyerPartyReference") $ equityOptionTransSuppl_buyerPartyReference x , maybe [] (schemaTypeToXML "buyerAccountReference") $ equityOptionTransSuppl_buyerAccountReference x , maybe [] (schemaTypeToXML "sellerPartyReference") $ equityOptionTransSuppl_sellerPartyReference x , maybe [] (schemaTypeToXML "sellerAccountReference") $ equityOptionTransSuppl_sellerAccountReference x , maybe [] (schemaTypeToXML "optionType") $ equityOptionTransSuppl_optionType x , maybe [] (schemaTypeToXML "equityEffectiveDate") $ equityOptionTransSuppl_equityEffectiveDate x , maybe [] (schemaTypeToXML "underlyer") $ equityOptionTransSuppl_underlyer x , maybe [] (schemaTypeToXML "notional") $ equityOptionTransSuppl_notional x , maybe [] (schemaTypeToXML "equityExercise") $ equityOptionTransSuppl_equityExercise x , maybe [] (schemaTypeToXML "feature") $ equityOptionTransSuppl_feature x , maybe [] (schemaTypeToXML "fxFeature") $ equityOptionTransSuppl_fxFeature x , maybe [] (schemaTypeToXML "strategyFeature") $ equityOptionTransSuppl_strategyFeature x , maybe [] (schemaTypeToXML "strike") $ equityOptionTransSuppl_strike x , maybe [] (schemaTypeToXML "spotPrice") $ equityOptionTransSuppl_spotPrice x , maybe [] (schemaTypeToXML "numberOfOptions") $ equityOptionTransSuppl_numberOfOptions x , maybe [] (schemaTypeToXML "equityPremium") $ equityOptionTransSuppl_equityPremium x , maybe [] (schemaTypeToXML "exchangeLookAlike") $ equityOptionTransSuppl_exchangeLookAlike x , maybe [] (schemaTypeToXML "exchangeTradedContractNearest") $ equityOptionTransSuppl_exchangeTradedContractNearest x , maybe [] (foldOneOf2 (schemaTypeToXML "multipleExchangeIndexAnnexFallback") (schemaTypeToXML "componentSecurityIndexAnnexFallback") ) $ equityOptionTransSuppl_choice22 x , maybe [] (schemaTypeToXML "methodOfAdjustment") $ equityOptionTransSuppl_methodOfAdjustment x , maybe [] (schemaTypeToXML "localJurisdiction") $ equityOptionTransSuppl_localJurisdiction x , maybe [] (foldOneOf2 (schemaTypeToXML "optionEntitlement") (schemaTypeToXML "multiplier") ) $ equityOptionTransSuppl_choice25 x , maybe [] (schemaTypeToXML "extraordinaryEvents") $ equityOptionTransSuppl_extraordinaryEvents x ] instance Extension EquityOptionTransactionSupplement EquityDerivativeShortFormBase where supertype v = EquityDerivativeShortFormBase_EquityOptionTransactionSupplement v instance Extension EquityOptionTransactionSupplement EquityDerivativeBase where supertype = (supertype :: EquityDerivativeShortFormBase -> EquityDerivativeBase) . (supertype :: EquityOptionTransactionSupplement -> EquityDerivativeShortFormBase) instance Extension EquityOptionTransactionSupplement Product where supertype = (supertype :: EquityDerivativeBase -> Product) . (supertype :: EquityDerivativeShortFormBase -> EquityDerivativeBase) . (supertype :: EquityOptionTransactionSupplement -> EquityDerivativeShortFormBase) -- | A type for defining PrePayment. data PrePayment = PrePayment { prePayment_ID :: Maybe Xsd.ID , prePayment_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , prePayment_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , prePayment_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , prePayment_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , prePayment :: Maybe Xsd.Boolean , prePayment_amount :: Maybe NonNegativeMoney , prePayment_date :: Maybe AdjustableDate } deriving (Eq,Show) instance SchemaType PrePayment where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (PrePayment a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "prePayment") `apply` optional (parseSchemaType "prePaymentAmount") `apply` optional (parseSchemaType "prePaymentDate") schemaTypeToXML s x@PrePayment{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ prePayment_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ prePayment_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ prePayment_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ prePayment_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ prePayment_receiverAccountReference x , maybe [] (schemaTypeToXML "prePayment") $ prePayment x , maybe [] (schemaTypeToXML "prePaymentAmount") $ prePayment_amount x , maybe [] (schemaTypeToXML "prePaymentDate") $ prePayment_date x ] instance Extension PrePayment PaymentBase where supertype v = PaymentBase_PrePayment v -- | A component describing a Broker View of an Equity Option. elementBrokerEquityOption :: XMLParser BrokerEquityOption elementBrokerEquityOption = parseSchemaType "brokerEquityOption" elementToXMLBrokerEquityOption :: BrokerEquityOption -> [Content ()] elementToXMLBrokerEquityOption = schemaTypeToXML "brokerEquityOption" -- | A component describing an Equity Forward product. elementEquityForward :: XMLParser EquityForward elementEquityForward = parseSchemaType "equityForward" elementToXMLEquityForward :: EquityForward -> [Content ()] elementToXMLEquityForward = schemaTypeToXML "equityForward" -- | A component describing an Equity Option product. elementEquityOption :: XMLParser EquityOption elementEquityOption = parseSchemaType "equityOption" elementToXMLEquityOption :: EquityOption -> [Content ()] elementToXMLEquityOption = schemaTypeToXML "equityOption" -- | A component describing an Equity Option Transaction -- Supplement. elementEquityOptionTransactionSupplement :: XMLParser EquityOptionTransactionSupplement elementEquityOptionTransactionSupplement = parseSchemaType "equityOptionTransactionSupplement" elementToXMLEquityOptionTransactionSupplement :: EquityOptionTransactionSupplement -> [Content ()] elementToXMLEquityOptionTransactionSupplement = schemaTypeToXML "equityOptionTransactionSupplement"