{-# 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"