{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Mktenv
  ( module Data.FpML.V53.Mktenv
  , module Data.FpML.V53.Doc
  , module Data.FpML.V53.Asset
  , module Data.FpML.V53.Riskdef
  , module Data.FpML.V53.CD
  ) 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.Doc
import Data.FpML.V53.Asset
import Data.FpML.V53.Riskdef
import Data.FpML.V53.CD
 
-- Some hs-boot imports are required, for fwd-declaring types.
 
-- | The frequency at which a rate is compounded.
data CompoundingFrequency = CompoundingFrequency Scheme CompoundingFrequencyAttributes deriving (Eq,Show)
data CompoundingFrequencyAttributes = CompoundingFrequencyAttributes
    { compoFrequAttrib_compoundingFrequencyScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType CompoundingFrequency where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "compoundingFrequencyScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ CompoundingFrequency v (CompoundingFrequencyAttributes a0)
    schemaTypeToXML s (CompoundingFrequency bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "compoundingFrequencyScheme") $ compoFrequAttrib_compoundingFrequencyScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension CompoundingFrequency Scheme where
    supertype (CompoundingFrequency s _) = s
 
-- | A generic credit curve definition.
data CreditCurve = CreditCurve
        { creditCurve_ID :: Maybe Xsd.ID
        , creditCurve_name :: Maybe Xsd.NormalizedString
          -- ^ The name of the structure, e.g "USDLIBOR-3M EOD Curve".
        , creditCurve_currency :: Maybe Currency
          -- ^ The currency that the structure is expressed in (this is 
          --   relevant mostly for the Interes Rates asset class).
        , creditCurve_choice2 :: (Maybe (OneOf2 LegalEntity LegalEntityReference))
          -- ^ Choice between:
          --   
          --   (1) The entity for which this is defined.
          --   
          --   (2) An XML reference a credit entity defined elsewhere in 
          --   the document.
        , creditCurve_creditEvents :: Maybe CreditEvents
          -- ^ The material credit event.
        , creditCurve_seniority :: Maybe CreditSeniority
          -- ^ The level of seniority of the deliverable obligation.
        , creditCurve_secured :: Maybe Xsd.Boolean
          -- ^ Whether the deliverable obligation is secured or unsecured.
        , creditCurve_obligationCurrency :: Maybe Currency
          -- ^ The currency of denomination of the deliverable obligation.
        , creditCurve_obligations :: Maybe Obligations
          -- ^ The underlying obligations of the reference entity on which 
          --   you are buying or selling protection
        , creditCurve_deliverableObligations :: Maybe DeliverableObligations
          -- ^ What sort of obligation may be delivered in the event of 
          --   the credit event. ISDA 2003 Term: Obligation 
          --   Category/Deliverable Obligation Category
        }
        deriving (Eq,Show)
instance SchemaType CreditCurve where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (CreditCurve a0)
            `apply` optional (parseSchemaType "name")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (oneOf' [ ("LegalEntity", fmap OneOf2 (parseSchemaType "referenceEntity"))
                                     , ("LegalEntityReference", fmap TwoOf2 (parseSchemaType "creditEntityReference"))
                                     ])
            `apply` optional (parseSchemaType "creditEvents")
            `apply` optional (parseSchemaType "seniority")
            `apply` optional (parseSchemaType "secured")
            `apply` optional (parseSchemaType "obligationCurrency")
            `apply` optional (parseSchemaType "obligations")
            `apply` optional (parseSchemaType "deliverableObligations")
    schemaTypeToXML s x@CreditCurve{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ creditCurve_ID x
                       ]
            [ maybe [] (schemaTypeToXML "name") $ creditCurve_name x
            , maybe [] (schemaTypeToXML "currency") $ creditCurve_currency x
            , maybe [] (foldOneOf2  (schemaTypeToXML "referenceEntity")
                                    (schemaTypeToXML "creditEntityReference")
                                   ) $ creditCurve_choice2 x
            , maybe [] (schemaTypeToXML "creditEvents") $ creditCurve_creditEvents x
            , maybe [] (schemaTypeToXML "seniority") $ creditCurve_seniority x
            , maybe [] (schemaTypeToXML "secured") $ creditCurve_secured x
            , maybe [] (schemaTypeToXML "obligationCurrency") $ creditCurve_obligationCurrency x
            , maybe [] (schemaTypeToXML "obligations") $ creditCurve_obligations x
            , maybe [] (schemaTypeToXML "deliverableObligations") $ creditCurve_deliverableObligations x
            ]
instance Extension CreditCurve PricingStructure where
    supertype v = PricingStructure_CreditCurve v
 
-- | A set of credit curve values, which can include pricing 
--   inputs (which are typically credit spreads), default 
--   probabilities, and recovery rates.
data CreditCurveValuation = CreditCurveValuation
        { creditCurveVal_ID :: Maybe Xsd.ID
        , creditCurveVal_definitionRef :: Maybe Xsd.IDREF
          -- ^ An optional reference to the scenario that this valuation 
          --   applies to.
        , creditCurveVal_objectReference :: Maybe AnyAssetReference
          -- ^ A reference to the asset or pricing structure that this 
          --   values.
        , creditCurveVal_valuationScenarioReference :: Maybe ValuationScenarioReference
          -- ^ A reference to the valuation scenario used to calculate 
          --   this valuation. If the Valuation occurs within a 
          --   ValuationSet, this value is optional and is defaulted from 
          --   the ValuationSet. If this value occurs in both places, the 
          --   lower level value (i.e. the one here) overrides that in the 
          --   higher (i.e. ValuationSet).
        , creditCurveVal_baseDate :: Maybe IdentifiedDate
          -- ^ The base date for which the structure applies, i.e. the 
          --   curve date. Normally this will align with the valuation 
          --   date.
        , creditCurveVal_spotDate :: Maybe IdentifiedDate
          -- ^ The spot settlement date for which the structure applies, 
          --   normally 0-2 days after the base date. The difference 
          --   between the baseDate and the spotDate is termed the 
          --   settlement lag, and is sometimes called "days to spot".
        , creditCurveVal_inputDataDate :: Maybe IdentifiedDate
          -- ^ The date from which the input data used to construct the 
          --   pricing input was obtained. Often the same as the baseDate, 
          --   but sometimes the pricing input may be "rolled forward", in 
          --   which input data from one date is used to generate a curve 
          --   for a later date.
        , creditCurveVal_endDate :: Maybe IdentifiedDate
          -- ^ The last date for which data is supplied in this pricing 
          --   input.
        , creditCurveVal_buildDateTime :: Maybe Xsd.DateTime
          -- ^ The date and time when the pricing input was generated.
        , creditCurveVal_inputs :: Maybe QuotedAssetSet
        , creditCurveVal_defaultProbabilityCurve :: Maybe DefaultProbabilityCurve
          -- ^ A curve of default probabilities.
        , creditCurveVal_choice9 :: (Maybe (OneOf2 Xsd.Decimal TermCurve))
          -- ^ Choice between:
          --   
          --   (1) A single recovery rate, to be used for all terms.
          --   
          --   (2) A curve of recovery rates, allowing different terms to 
          --   have different recovery rates.
        }
        deriving (Eq,Show)
instance SchemaType CreditCurveValuation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        a1 <- optional $ getAttribute "definitionRef" e pos
        commit $ interior e $ return (CreditCurveValuation a0 a1)
            `apply` optional (parseSchemaType "objectReference")
            `apply` optional (parseSchemaType "valuationScenarioReference")
            `apply` optional (parseSchemaType "baseDate")
            `apply` optional (parseSchemaType "spotDate")
            `apply` optional (parseSchemaType "inputDataDate")
            `apply` optional (parseSchemaType "endDate")
            `apply` optional (parseSchemaType "buildDateTime")
            `apply` optional (parseSchemaType "inputs")
            `apply` optional (parseSchemaType "defaultProbabilityCurve")
            `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "recoveryRate"))
                                     , ("TermCurve", fmap TwoOf2 (parseSchemaType "recoveryRateCurve"))
                                     ])
    schemaTypeToXML s x@CreditCurveValuation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ creditCurveVal_ID x
                       , maybe [] (toXMLAttribute "definitionRef") $ creditCurveVal_definitionRef x
                       ]
            [ maybe [] (schemaTypeToXML "objectReference") $ creditCurveVal_objectReference x
            , maybe [] (schemaTypeToXML "valuationScenarioReference") $ creditCurveVal_valuationScenarioReference x
            , maybe [] (schemaTypeToXML "baseDate") $ creditCurveVal_baseDate x
            , maybe [] (schemaTypeToXML "spotDate") $ creditCurveVal_spotDate x
            , maybe [] (schemaTypeToXML "inputDataDate") $ creditCurveVal_inputDataDate x
            , maybe [] (schemaTypeToXML "endDate") $ creditCurveVal_endDate x
            , maybe [] (schemaTypeToXML "buildDateTime") $ creditCurveVal_buildDateTime x
            , maybe [] (schemaTypeToXML "inputs") $ creditCurveVal_inputs x
            , maybe [] (schemaTypeToXML "defaultProbabilityCurve") $ creditCurveVal_defaultProbabilityCurve x
            , maybe [] (foldOneOf2  (schemaTypeToXML "recoveryRate")
                                    (schemaTypeToXML "recoveryRateCurve")
                                   ) $ creditCurveVal_choice9 x
            ]
instance Extension CreditCurveValuation PricingStructureValuation where
    supertype (CreditCurveValuation a0 a1 e0 e1 e2 e3 e4 e5 e6 e7 e8 e9) =
               PricingStructureValuation a0 a1 e0 e1 e2 e3 e4 e5 e6
instance Extension CreditCurveValuation Valuation where
    supertype = (supertype :: PricingStructureValuation -> Valuation)
              . (supertype :: CreditCurveValuation -> PricingStructureValuation)
              
 
-- | A set of default probabilities.
data DefaultProbabilityCurve = DefaultProbabilityCurve
        { defaultProbabCurve_ID :: Maybe Xsd.ID
        , defaultProbabCurve_definitionRef :: Maybe Xsd.IDREF
          -- ^ An optional reference to the scenario that this valuation 
          --   applies to.
        , defaultProbabCurve_objectReference :: Maybe AnyAssetReference
          -- ^ A reference to the asset or pricing structure that this 
          --   values.
        , defaultProbabCurve_valuationScenarioReference :: Maybe ValuationScenarioReference
          -- ^ A reference to the valuation scenario used to calculate 
          --   this valuation. If the Valuation occurs within a 
          --   ValuationSet, this value is optional and is defaulted from 
          --   the ValuationSet. If this value occurs in both places, the 
          --   lower level value (i.e. the one here) overrides that in the 
          --   higher (i.e. ValuationSet).
        , defaultProbabCurve_baseDate :: Maybe IdentifiedDate
          -- ^ The base date for which the structure applies, i.e. the 
          --   curve date. Normally this will align with the valuation 
          --   date.
        , defaultProbabCurve_spotDate :: Maybe IdentifiedDate
          -- ^ The spot settlement date for which the structure applies, 
          --   normally 0-2 days after the base date. The difference 
          --   between the baseDate and the spotDate is termed the 
          --   settlement lag, and is sometimes called "days to spot".
        , defaultProbabCurve_inputDataDate :: Maybe IdentifiedDate
          -- ^ The date from which the input data used to construct the 
          --   pricing input was obtained. Often the same as the baseDate, 
          --   but sometimes the pricing input may be "rolled forward", in 
          --   which input data from one date is used to generate a curve 
          --   for a later date.
        , defaultProbabCurve_endDate :: Maybe IdentifiedDate
          -- ^ The last date for which data is supplied in this pricing 
          --   input.
        , defaultProbabCurve_buildDateTime :: Maybe Xsd.DateTime
          -- ^ The date and time when the pricing input was generated.
        , defaultProbabCurve_baseYieldCurve :: Maybe PricingStructureReference
          -- ^ A reference to the yield curve values used as a basis for 
          --   this credit curve valuation.
        , defaultProbabCurve_defaultProbabilities :: Maybe TermCurve
          -- ^ A collection of default probabilities.
        }
        deriving (Eq,Show)
instance SchemaType DefaultProbabilityCurve where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        a1 <- optional $ getAttribute "definitionRef" e pos
        commit $ interior e $ return (DefaultProbabilityCurve a0 a1)
            `apply` optional (parseSchemaType "objectReference")
            `apply` optional (parseSchemaType "valuationScenarioReference")
            `apply` optional (parseSchemaType "baseDate")
            `apply` optional (parseSchemaType "spotDate")
            `apply` optional (parseSchemaType "inputDataDate")
            `apply` optional (parseSchemaType "endDate")
            `apply` optional (parseSchemaType "buildDateTime")
            `apply` optional (parseSchemaType "baseYieldCurve")
            `apply` optional (parseSchemaType "defaultProbabilities")
    schemaTypeToXML s x@DefaultProbabilityCurve{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ defaultProbabCurve_ID x
                       , maybe [] (toXMLAttribute "definitionRef") $ defaultProbabCurve_definitionRef x
                       ]
            [ maybe [] (schemaTypeToXML "objectReference") $ defaultProbabCurve_objectReference x
            , maybe [] (schemaTypeToXML "valuationScenarioReference") $ defaultProbabCurve_valuationScenarioReference x
            , maybe [] (schemaTypeToXML "baseDate") $ defaultProbabCurve_baseDate x
            , maybe [] (schemaTypeToXML "spotDate") $ defaultProbabCurve_spotDate x
            , maybe [] (schemaTypeToXML "inputDataDate") $ defaultProbabCurve_inputDataDate x
            , maybe [] (schemaTypeToXML "endDate") $ defaultProbabCurve_endDate x
            , maybe [] (schemaTypeToXML "buildDateTime") $ defaultProbabCurve_buildDateTime x
            , maybe [] (schemaTypeToXML "baseYieldCurve") $ defaultProbabCurve_baseYieldCurve x
            , maybe [] (schemaTypeToXML "defaultProbabilities") $ defaultProbabCurve_defaultProbabilities x
            ]
instance Extension DefaultProbabilityCurve PricingStructureValuation where
    supertype (DefaultProbabilityCurve a0 a1 e0 e1 e2 e3 e4 e5 e6 e7 e8) =
               PricingStructureValuation a0 a1 e0 e1 e2 e3 e4 e5 e6
instance Extension DefaultProbabilityCurve Valuation where
    supertype = (supertype :: PricingStructureValuation -> Valuation)
              . (supertype :: DefaultProbabilityCurve -> PricingStructureValuation)
              
 
-- | A curve used to model a set of forward interest rates. Used 
--   for forecasting interest rates as part of a pricing 
--   calculation.
data ForwardRateCurve = ForwardRateCurve
        { forwardRateCurve_assetReference :: Maybe AssetReference
          -- ^ A reference to the rate index whose forwards are modeled.
        , forwardRateCurve_rateCurve :: Maybe TermCurve
          -- ^ The curve of forward values.
        }
        deriving (Eq,Show)
instance SchemaType ForwardRateCurve where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ForwardRateCurve
            `apply` optional (parseSchemaType "assetReference")
            `apply` optional (parseSchemaType "rateCurve")
    schemaTypeToXML s x@ForwardRateCurve{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "assetReference") $ forwardRateCurve_assetReference x
            , maybe [] (schemaTypeToXML "rateCurve") $ forwardRateCurve_rateCurve x
            ]
 
-- | An fx curve object., which includes pricing inputs and term 
--   structures for fx forwards.
data FxCurve = FxCurve
        { fxCurve_ID :: Maybe Xsd.ID
        , fxCurve_name :: Maybe Xsd.NormalizedString
          -- ^ The name of the structure, e.g "USDLIBOR-3M EOD Curve".
        , fxCurve_currency :: Maybe Currency
          -- ^ The currency that the structure is expressed in (this is 
          --   relevant mostly for the Interes Rates asset class).
        , fxCurve_quotedCurrencyPair :: Maybe QuotedCurrencyPair
          -- ^ Defines the two currencies for an FX trade and the 
          --   quotation relationship between the two currencies.
        }
        deriving (Eq,Show)
instance SchemaType FxCurve where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (FxCurve a0)
            `apply` optional (parseSchemaType "name")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "quotedCurrencyPair")
    schemaTypeToXML s x@FxCurve{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxCurve_ID x
                       ]
            [ maybe [] (schemaTypeToXML "name") $ fxCurve_name x
            , maybe [] (schemaTypeToXML "currency") $ fxCurve_currency x
            , maybe [] (schemaTypeToXML "quotedCurrencyPair") $ fxCurve_quotedCurrencyPair x
            ]
instance Extension FxCurve PricingStructure where
    supertype v = PricingStructure_FxCurve v
 
-- | A valuation of an FX curve object., which includes pricing 
--   inputs and term structures for fx forwards.
data FxCurveValuation = FxCurveValuation
        { fxCurveVal_ID :: Maybe Xsd.ID
        , fxCurveVal_definitionRef :: Maybe Xsd.IDREF
          -- ^ An optional reference to the scenario that this valuation 
          --   applies to.
        , fxCurveVal_objectReference :: Maybe AnyAssetReference
          -- ^ A reference to the asset or pricing structure that this 
          --   values.
        , fxCurveVal_valuationScenarioReference :: Maybe ValuationScenarioReference
          -- ^ A reference to the valuation scenario used to calculate 
          --   this valuation. If the Valuation occurs within a 
          --   ValuationSet, this value is optional and is defaulted from 
          --   the ValuationSet. If this value occurs in both places, the 
          --   lower level value (i.e. the one here) overrides that in the 
          --   higher (i.e. ValuationSet).
        , fxCurveVal_baseDate :: Maybe IdentifiedDate
          -- ^ The base date for which the structure applies, i.e. the 
          --   curve date. Normally this will align with the valuation 
          --   date.
        , fxCurveVal_spotDate :: Maybe IdentifiedDate
          -- ^ The spot settlement date for which the structure applies, 
          --   normally 0-2 days after the base date. The difference 
          --   between the baseDate and the spotDate is termed the 
          --   settlement lag, and is sometimes called "days to spot".
        , fxCurveVal_inputDataDate :: Maybe IdentifiedDate
          -- ^ The date from which the input data used to construct the 
          --   pricing input was obtained. Often the same as the baseDate, 
          --   but sometimes the pricing input may be "rolled forward", in 
          --   which input data from one date is used to generate a curve 
          --   for a later date.
        , fxCurveVal_endDate :: Maybe IdentifiedDate
          -- ^ The last date for which data is supplied in this pricing 
          --   input.
        , fxCurveVal_buildDateTime :: Maybe Xsd.DateTime
          -- ^ The date and time when the pricing input was generated.
        , fxCurveVal_settlementCurrencyYieldCurve :: Maybe PricingStructureReference
        , fxCurveVal_forecastCurrencyYieldCurve :: Maybe PricingStructureReference
        , fxCurveVal_spotRate :: Maybe FxRateSet
        , fxCurveVal_fxForwardCurve :: Maybe TermCurve
          -- ^ A curve of fx forward rates.
        , fxCurveVal_fxForwardPointsCurve :: Maybe TermCurve
          -- ^ A curve of fx forward point spreads.
        }
        deriving (Eq,Show)
instance SchemaType FxCurveValuation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        a1 <- optional $ getAttribute "definitionRef" e pos
        commit $ interior e $ return (FxCurveValuation a0 a1)
            `apply` optional (parseSchemaType "objectReference")
            `apply` optional (parseSchemaType "valuationScenarioReference")
            `apply` optional (parseSchemaType "baseDate")
            `apply` optional (parseSchemaType "spotDate")
            `apply` optional (parseSchemaType "inputDataDate")
            `apply` optional (parseSchemaType "endDate")
            `apply` optional (parseSchemaType "buildDateTime")
            `apply` optional (parseSchemaType "settlementCurrencyYieldCurve")
            `apply` optional (parseSchemaType "forecastCurrencyYieldCurve")
            `apply` optional (parseSchemaType "spotRate")
            `apply` optional (parseSchemaType "fxForwardCurve")
            `apply` optional (parseSchemaType "fxForwardPointsCurve")
    schemaTypeToXML s x@FxCurveValuation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ fxCurveVal_ID x
                       , maybe [] (toXMLAttribute "definitionRef") $ fxCurveVal_definitionRef x
                       ]
            [ maybe [] (schemaTypeToXML "objectReference") $ fxCurveVal_objectReference x
            , maybe [] (schemaTypeToXML "valuationScenarioReference") $ fxCurveVal_valuationScenarioReference x
            , maybe [] (schemaTypeToXML "baseDate") $ fxCurveVal_baseDate x
            , maybe [] (schemaTypeToXML "spotDate") $ fxCurveVal_spotDate x
            , maybe [] (schemaTypeToXML "inputDataDate") $ fxCurveVal_inputDataDate x
            , maybe [] (schemaTypeToXML "endDate") $ fxCurveVal_endDate x
            , maybe [] (schemaTypeToXML "buildDateTime") $ fxCurveVal_buildDateTime x
            , maybe [] (schemaTypeToXML "settlementCurrencyYieldCurve") $ fxCurveVal_settlementCurrencyYieldCurve x
            , maybe [] (schemaTypeToXML "forecastCurrencyYieldCurve") $ fxCurveVal_forecastCurrencyYieldCurve x
            , maybe [] (schemaTypeToXML "spotRate") $ fxCurveVal_spotRate x
            , maybe [] (schemaTypeToXML "fxForwardCurve") $ fxCurveVal_fxForwardCurve x
            , maybe [] (schemaTypeToXML "fxForwardPointsCurve") $ fxCurveVal_fxForwardPointsCurve x
            ]
instance Extension FxCurveValuation PricingStructureValuation where
    supertype (FxCurveValuation a0 a1 e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10 e11) =
               PricingStructureValuation a0 a1 e0 e1 e2 e3 e4 e5 e6
instance Extension FxCurveValuation Valuation where
    supertype = (supertype :: PricingStructureValuation -> Valuation)
              . (supertype :: FxCurveValuation -> PricingStructureValuation)
              
 
-- | A collection of spot FX rates used in pricing.
data FxRateSet = FxRateSet
        { fxRateSet_instrumentSet :: Maybe InstrumentSet
          -- ^ A collection of instruments used as a basis for quotation.
        , fxRateSet_assetQuote :: [BasicAssetValuation]
          -- ^ A collection of valuations (quotes) for the assets needed 
          --   in the set. Normally these quotes will be for the 
          --   underlying assets listed above, but they don't necesarily 
          --   have to be.
        }
        deriving (Eq,Show)
instance SchemaType FxRateSet where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return FxRateSet
            `apply` optional (parseSchemaType "instrumentSet")
            `apply` many (parseSchemaType "assetQuote")
    schemaTypeToXML s x@FxRateSet{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "instrumentSet") $ fxRateSet_instrumentSet x
            , concatMap (schemaTypeToXML "assetQuote") $ fxRateSet_assetQuote x
            ]
instance Extension FxRateSet QuotedAssetSet where
    supertype (FxRateSet e0 e1) =
               QuotedAssetSet e0 e1
 
-- | A pricing data set that contains a series of points with 
--   coordinates. It is a sparse matrix representation of a 
--   multi-dimensional matrix.
data MultiDimensionalPricingData = MultiDimensionalPricingData
        { multiDimensPricingData_measureType :: Maybe AssetMeasureType
          -- ^ The type of the value that is measured. This could be an 
          --   NPV, a cash flow, a clean price, etc.
        , multiDimensPricingData_quoteUnits :: Maybe PriceQuoteUnits
          -- ^ The optional units that the measure is expressed in. If not 
          --   supplied, this is assumed to be a price/value in currency 
          --   units.
        , multiDimensPricingData_side :: Maybe QuotationSideEnum
          -- ^ The side (bid/mid/ask) of the measure.
        , multiDimensPricingData_currency :: Maybe Currency
          -- ^ The optional currency that the measure is expressed in. If 
          --   not supplied, this is defaulted from the reportingCurrency 
          --   in the valuationScenarioDefinition.
        , multiDimensPricingData_currencyType :: Maybe ReportingCurrencyType
          -- ^ The optional currency that the measure is expressed in. If 
          --   not supplied, this is defaulted from the reportingCurrency 
          --   in the valuationScenarioDefinition.
        , multiDimensPricingData_timing :: Maybe QuoteTiming
          -- ^ When during a day the quote is for. Typically, if this 
          --   element is supplied, the QuoteLocation needs also to be 
          --   supplied.
        , multiDimensPricingData_choice6 :: (Maybe (OneOf2 BusinessCenter ExchangeId))
          -- ^ Choice between:
          --   
          --   (1) A city or other business center.
          --   
          --   (2) The exchange (e.g. stock or futures exchange) from 
          --   which the quote is obtained.
        , multiDimensPricingData_informationSource :: [InformationSource]
          -- ^ The information source where a published or displayed 
          --   market rate will be obtained, e.g. Telerate Page 3750.
        , multiDimensPricingData_pricingModel :: Maybe PricingModel
          -- ^ .
        , multiDimensPricingData_time :: Maybe Xsd.DateTime
          -- ^ When the quote was observed or derived.
        , multiDimensPricingData_valuationDate :: Maybe Xsd.Date
          -- ^ When the quote was computed.
        , multiDimensPricingData_expiryTime :: Maybe Xsd.DateTime
          -- ^ When does the quote cease to be valid.
        , multiDimensPricingData_cashflowType :: Maybe CashflowType
          -- ^ For cash flows, the type of the cash flows. Examples 
          --   include: Coupon payment, Premium Fee, Settlement Fee, 
          --   Brokerage Fee, etc.
        , multiDimensPricingData_point :: [PricingStructurePoint]
        }
        deriving (Eq,Show)
instance SchemaType MultiDimensionalPricingData where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return MultiDimensionalPricingData
            `apply` optional (parseSchemaType "measureType")
            `apply` optional (parseSchemaType "quoteUnits")
            `apply` optional (parseSchemaType "side")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "currencyType")
            `apply` optional (parseSchemaType "timing")
            `apply` optional (oneOf' [ ("BusinessCenter", fmap OneOf2 (parseSchemaType "businessCenter"))
                                     , ("ExchangeId", fmap TwoOf2 (parseSchemaType "exchangeId"))
                                     ])
            `apply` many (parseSchemaType "informationSource")
            `apply` optional (parseSchemaType "pricingModel")
            `apply` optional (parseSchemaType "time")
            `apply` optional (parseSchemaType "valuationDate")
            `apply` optional (parseSchemaType "expiryTime")
            `apply` optional (parseSchemaType "cashflowType")
            `apply` many (parseSchemaType "point")
    schemaTypeToXML s x@MultiDimensionalPricingData{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "measureType") $ multiDimensPricingData_measureType x
            , maybe [] (schemaTypeToXML "quoteUnits") $ multiDimensPricingData_quoteUnits x
            , maybe [] (schemaTypeToXML "side") $ multiDimensPricingData_side x
            , maybe [] (schemaTypeToXML "currency") $ multiDimensPricingData_currency x
            , maybe [] (schemaTypeToXML "currencyType") $ multiDimensPricingData_currencyType x
            , maybe [] (schemaTypeToXML "timing") $ multiDimensPricingData_timing x
            , maybe [] (foldOneOf2  (schemaTypeToXML "businessCenter")
                                    (schemaTypeToXML "exchangeId")
                                   ) $ multiDimensPricingData_choice6 x
            , concatMap (schemaTypeToXML "informationSource") $ multiDimensPricingData_informationSource x
            , maybe [] (schemaTypeToXML "pricingModel") $ multiDimensPricingData_pricingModel x
            , maybe [] (schemaTypeToXML "time") $ multiDimensPricingData_time x
            , maybe [] (schemaTypeToXML "valuationDate") $ multiDimensPricingData_valuationDate x
            , maybe [] (schemaTypeToXML "expiryTime") $ multiDimensPricingData_expiryTime x
            , maybe [] (schemaTypeToXML "cashflowType") $ multiDimensPricingData_cashflowType x
            , concatMap (schemaTypeToXML "point") $ multiDimensPricingData_point x
            ]
 
-- | An adjustment used to accommodate a parameter of the input 
--   trade, e.g. the strike.
data ParametricAdjustment = ParametricAdjustment
        { paramAdjust_name :: Maybe Xsd.NormalizedString
          -- ^ The name of the adjustment parameter (e.g. "Volatility 
          --   Skew").
        , paramAdjust_inputUnits :: Maybe PriceQuoteUnits
          -- ^ The units of the input parameter, e.g. Yield.
        , paramAdjust_datapoint :: [ParametricAdjustmentPoint]
          -- ^ The values of the adjustment parameter.
        }
        deriving (Eq,Show)
instance SchemaType ParametricAdjustment where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ParametricAdjustment
            `apply` optional (parseSchemaType "name")
            `apply` optional (parseSchemaType "inputUnits")
            `apply` many (parseSchemaType "datapoint")
    schemaTypeToXML s x@ParametricAdjustment{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "name") $ paramAdjust_name x
            , maybe [] (schemaTypeToXML "inputUnits") $ paramAdjust_inputUnits x
            , concatMap (schemaTypeToXML "datapoint") $ paramAdjust_datapoint x
            ]
 
-- | A value of the adjustment point, consisting of the x value 
--   and the corresponding y value.
data ParametricAdjustmentPoint = ParametricAdjustmentPoint
        { paramAdjustPoint_parameterValue :: Maybe Xsd.Decimal
          -- ^ The value of the independent variable (e.g. strike offset).
        , paramAdjustPoint_adjustmentValue :: Maybe Xsd.Decimal
          -- ^ The value of the dependent variable, the actual adjustment 
          --   amount.
        }
        deriving (Eq,Show)
instance SchemaType ParametricAdjustmentPoint where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ParametricAdjustmentPoint
            `apply` optional (parseSchemaType "parameterValue")
            `apply` optional (parseSchemaType "adjustmentValue")
    schemaTypeToXML s x@ParametricAdjustmentPoint{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "parameterValue") $ paramAdjustPoint_parameterValue x
            , maybe [] (schemaTypeToXML "adjustmentValue") $ paramAdjustPoint_adjustmentValue x
            ]
 
-- | A single valued point with a set of coordinates that define 
--   an arbitrary number of indentifying indexes (0 or more). 
--   Note that the collection of coordinates/coordinate 
--   references for a PricingStructurePoint must not define a 
--   given dimension (other than "generic") more than once. This 
--   is to avoid ambiguity.
data PricingStructurePoint = PricingStructurePoint
        { pricingStructPoint_ID :: Maybe Xsd.ID
        , pricingStructPoint_choice0 :: (Maybe (OneOf2 PricingDataPointCoordinate PricingDataPointCoordinateReference))
          -- ^ Choice between:
          --   
          --   (1) An explicit, filled in data point coordinate. This 
          --   might specify expiration, strike, etc.
          --   
          --   (2) A reference to a pricing data point coordinate within 
          --   this document.
        , pricingStructPoint_choice1 :: (Maybe (OneOf2 Asset AssetReference))
          -- ^ Choice between:
          --   
          --   (1) Define the underlying asset, either a listed security 
          --   or other instrument.
          --   
          --   (2) A reference to an underlying asset that defines the 
          --   meaning of the value, i.e. the product that the value 
          --   corresponds to. For example, this could be a caplet or 
          --   simple european swaption.
        , pricingStructPoint_value :: Maybe Xsd.Decimal
          -- ^ The value of the the quotation.
        , pricingStructPoint_measureType :: Maybe AssetMeasureType
          -- ^ The type of the value that is measured. This could be an 
          --   NPV, a cash flow, a clean price, etc.
        , pricingStructPoint_quoteUnits :: Maybe PriceQuoteUnits
          -- ^ The optional units that the measure is expressed in. If not 
          --   supplied, this is assumed to be a price/value in currency 
          --   units.
        , pricingStructPoint_side :: Maybe QuotationSideEnum
          -- ^ The side (bid/mid/ask) of the measure.
        , pricingStructPoint_currency :: Maybe Currency
          -- ^ The optional currency that the measure is expressed in. If 
          --   not supplied, this is defaulted from the reportingCurrency 
          --   in the valuationScenarioDefinition.
        , pricingStructPoint_currencyType :: Maybe ReportingCurrencyType
          -- ^ The optional currency that the measure is expressed in. If 
          --   not supplied, this is defaulted from the reportingCurrency 
          --   in the valuationScenarioDefinition.
        , pricingStructPoint_timing :: Maybe QuoteTiming
          -- ^ When during a day the quote is for. Typically, if this 
          --   element is supplied, the QuoteLocation needs also to be 
          --   supplied.
        , pricingStructPoint_choice9 :: (Maybe (OneOf2 BusinessCenter ExchangeId))
          -- ^ Choice between:
          --   
          --   (1) A city or other business center.
          --   
          --   (2) The exchange (e.g. stock or futures exchange) from 
          --   which the quote is obtained.
        , pricingStructPoint_informationSource :: [InformationSource]
          -- ^ The information source where a published or displayed 
          --   market rate will be obtained, e.g. Telerate Page 3750.
        , pricingStructPoint_pricingModel :: Maybe PricingModel
          -- ^ .
        , pricingStructPoint_time :: Maybe Xsd.DateTime
          -- ^ When the quote was observed or derived.
        , pricingStructPoint_valuationDate :: Maybe Xsd.Date
          -- ^ When the quote was computed.
        , pricingStructPoint_expiryTime :: Maybe Xsd.DateTime
          -- ^ When does the quote cease to be valid.
        , pricingStructPoint_cashflowType :: Maybe CashflowType
          -- ^ For cash flows, the type of the cash flows. Examples 
          --   include: Coupon payment, Premium Fee, Settlement Fee, 
          --   Brokerage Fee, etc.
        }
        deriving (Eq,Show)
instance SchemaType PricingStructurePoint where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (PricingStructurePoint a0)
            `apply` optional (oneOf' [ ("PricingDataPointCoordinate", fmap OneOf2 (parseSchemaType "coordinate"))
                                     , ("PricingDataPointCoordinateReference", fmap TwoOf2 (parseSchemaType "coordinateReference"))
                                     ])
            `apply` optional (oneOf' [ ("Asset", fmap OneOf2 (elementUnderlyingAsset))
                                     , ("AssetReference", fmap TwoOf2 (parseSchemaType "underlyingAssetReference"))
                                     ])
            `apply` optional (parseSchemaType "value")
            `apply` optional (parseSchemaType "measureType")
            `apply` optional (parseSchemaType "quoteUnits")
            `apply` optional (parseSchemaType "side")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "currencyType")
            `apply` optional (parseSchemaType "timing")
            `apply` optional (oneOf' [ ("BusinessCenter", fmap OneOf2 (parseSchemaType "businessCenter"))
                                     , ("ExchangeId", fmap TwoOf2 (parseSchemaType "exchangeId"))
                                     ])
            `apply` many (parseSchemaType "informationSource")
            `apply` optional (parseSchemaType "pricingModel")
            `apply` optional (parseSchemaType "time")
            `apply` optional (parseSchemaType "valuationDate")
            `apply` optional (parseSchemaType "expiryTime")
            `apply` optional (parseSchemaType "cashflowType")
    schemaTypeToXML s x@PricingStructurePoint{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ pricingStructPoint_ID x
                       ]
            [ maybe [] (foldOneOf2  (schemaTypeToXML "coordinate")
                                    (schemaTypeToXML "coordinateReference")
                                   ) $ pricingStructPoint_choice0 x
            , maybe [] (foldOneOf2  (elementToXMLUnderlyingAsset)
                                    (schemaTypeToXML "underlyingAssetReference")
                                   ) $ pricingStructPoint_choice1 x
            , maybe [] (schemaTypeToXML "value") $ pricingStructPoint_value x
            , maybe [] (schemaTypeToXML "measureType") $ pricingStructPoint_measureType x
            , maybe [] (schemaTypeToXML "quoteUnits") $ pricingStructPoint_quoteUnits x
            , maybe [] (schemaTypeToXML "side") $ pricingStructPoint_side x
            , maybe [] (schemaTypeToXML "currency") $ pricingStructPoint_currency x
            , maybe [] (schemaTypeToXML "currencyType") $ pricingStructPoint_currencyType x
            , maybe [] (schemaTypeToXML "timing") $ pricingStructPoint_timing x
            , maybe [] (foldOneOf2  (schemaTypeToXML "businessCenter")
                                    (schemaTypeToXML "exchangeId")
                                   ) $ pricingStructPoint_choice9 x
            , concatMap (schemaTypeToXML "informationSource") $ pricingStructPoint_informationSource x
            , maybe [] (schemaTypeToXML "pricingModel") $ pricingStructPoint_pricingModel x
            , maybe [] (schemaTypeToXML "time") $ pricingStructPoint_time x
            , maybe [] (schemaTypeToXML "valuationDate") $ pricingStructPoint_valuationDate x
            , maybe [] (schemaTypeToXML "expiryTime") $ pricingStructPoint_expiryTime x
            , maybe [] (schemaTypeToXML "cashflowType") $ pricingStructPoint_cashflowType x
            ]
 
-- | A curve consisting only of values over a term. This is a 
--   restricted form of One Dimensional Structure.
data TermCurve = TermCurve
        { termCurve_interpolationMethod :: Maybe InterpolationMethod
        , termCurve_extrapolationPermitted :: Maybe Xsd.Boolean
        , termCurve_point :: [TermPoint]
        }
        deriving (Eq,Show)
instance SchemaType TermCurve where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return TermCurve
            `apply` optional (parseSchemaType "interpolationMethod")
            `apply` optional (parseSchemaType "extrapolationPermitted")
            `apply` many (parseSchemaType "point")
    schemaTypeToXML s x@TermCurve{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "interpolationMethod") $ termCurve_interpolationMethod x
            , maybe [] (schemaTypeToXML "extrapolationPermitted") $ termCurve_extrapolationPermitted x
            , concatMap (schemaTypeToXML "point") $ termCurve_point x
            ]
 
-- | A value point that can have a time dimension. Allows bid, 
--   mid, ask, and spread values to be represented.
data TermPoint = TermPoint
        { termPoint_ID :: Maybe Xsd.ID
        , termPoint_term :: Maybe TimeDimension
          -- ^ The time dimension of the point (tenor and/or date)
        , termPoint_bid :: Maybe Xsd.Decimal
          -- ^ A price "bid" by a buyer for an asset, i.e. the price a 
          --   buyer is willing to pay.
        , termPoint_mid :: Maybe Xsd.Decimal
          -- ^ A price midway between the bid and the ask price.
        , termPoint_ask :: Maybe Xsd.Decimal
          -- ^ A price "asked" by a seller for an asset, i.e. the price at 
          --   which a seller is willing to sell.
        , termPoint_spreadValue :: Maybe Xsd.Decimal
          -- ^ The spread value can be used in conjunction with the "mid" 
          --   value to define the bid and the ask value.
        , termPoint_definition :: Maybe AssetReference
          -- ^ An optional reference to an underlying asset that defines 
          --   the meaning of the value, i.e. the product that the value 
          --   corresponds to. For example, this could be a discount 
          --   instrument.
        }
        deriving (Eq,Show)
instance SchemaType TermPoint where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (TermPoint a0)
            `apply` optional (parseSchemaType "term")
            `apply` optional (parseSchemaType "bid")
            `apply` optional (parseSchemaType "mid")
            `apply` optional (parseSchemaType "ask")
            `apply` optional (parseSchemaType "spreadValue")
            `apply` optional (parseSchemaType "definition")
    schemaTypeToXML s x@TermPoint{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ termPoint_ID x
                       ]
            [ maybe [] (schemaTypeToXML "term") $ termPoint_term x
            , maybe [] (schemaTypeToXML "bid") $ termPoint_bid x
            , maybe [] (schemaTypeToXML "mid") $ termPoint_mid x
            , maybe [] (schemaTypeToXML "ask") $ termPoint_ask x
            , maybe [] (schemaTypeToXML "spreadValue") $ termPoint_spreadValue x
            , maybe [] (schemaTypeToXML "definition") $ termPoint_definition x
            ]
 
-- | A matrix of volatilities with dimension 0-3.
data VolatilityMatrix = VolatilityMatrix
        { volatMatrix_ID :: Maybe Xsd.ID
        , volatMatrix_definitionRef :: Maybe Xsd.IDREF
          -- ^ An optional reference to the scenario that this valuation 
          --   applies to.
        , volatMatrix_objectReference :: Maybe AnyAssetReference
          -- ^ A reference to the asset or pricing structure that this 
          --   values.
        , volatMatrix_valuationScenarioReference :: Maybe ValuationScenarioReference
          -- ^ A reference to the valuation scenario used to calculate 
          --   this valuation. If the Valuation occurs within a 
          --   ValuationSet, this value is optional and is defaulted from 
          --   the ValuationSet. If this value occurs in both places, the 
          --   lower level value (i.e. the one here) overrides that in the 
          --   higher (i.e. ValuationSet).
        , volatMatrix_baseDate :: Maybe IdentifiedDate
          -- ^ The base date for which the structure applies, i.e. the 
          --   curve date. Normally this will align with the valuation 
          --   date.
        , volatMatrix_spotDate :: Maybe IdentifiedDate
          -- ^ The spot settlement date for which the structure applies, 
          --   normally 0-2 days after the base date. The difference 
          --   between the baseDate and the spotDate is termed the 
          --   settlement lag, and is sometimes called "days to spot".
        , volatMatrix_inputDataDate :: Maybe IdentifiedDate
          -- ^ The date from which the input data used to construct the 
          --   pricing input was obtained. Often the same as the baseDate, 
          --   but sometimes the pricing input may be "rolled forward", in 
          --   which input data from one date is used to generate a curve 
          --   for a later date.
        , volatMatrix_endDate :: Maybe IdentifiedDate
          -- ^ The last date for which data is supplied in this pricing 
          --   input.
        , volatMatrix_buildDateTime :: Maybe Xsd.DateTime
          -- ^ The date and time when the pricing input was generated.
        , volatMatrix_dataPoints :: Maybe MultiDimensionalPricingData
          -- ^ The raw volatility matrix data, expressed as a 
          --   multi-dimensional array.
        , volatMatrix_adjustment :: [ParametricAdjustment]
          -- ^ An adjustment factor, such as for vol smile/skew.
        }
        deriving (Eq,Show)
instance SchemaType VolatilityMatrix where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        a1 <- optional $ getAttribute "definitionRef" e pos
        commit $ interior e $ return (VolatilityMatrix a0 a1)
            `apply` optional (parseSchemaType "objectReference")
            `apply` optional (parseSchemaType "valuationScenarioReference")
            `apply` optional (parseSchemaType "baseDate")
            `apply` optional (parseSchemaType "spotDate")
            `apply` optional (parseSchemaType "inputDataDate")
            `apply` optional (parseSchemaType "endDate")
            `apply` optional (parseSchemaType "buildDateTime")
            `apply` optional (parseSchemaType "dataPoints")
            `apply` many (parseSchemaType "adjustment")
    schemaTypeToXML s x@VolatilityMatrix{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ volatMatrix_ID x
                       , maybe [] (toXMLAttribute "definitionRef") $ volatMatrix_definitionRef x
                       ]
            [ maybe [] (schemaTypeToXML "objectReference") $ volatMatrix_objectReference x
            , maybe [] (schemaTypeToXML "valuationScenarioReference") $ volatMatrix_valuationScenarioReference x
            , maybe [] (schemaTypeToXML "baseDate") $ volatMatrix_baseDate x
            , maybe [] (schemaTypeToXML "spotDate") $ volatMatrix_spotDate x
            , maybe [] (schemaTypeToXML "inputDataDate") $ volatMatrix_inputDataDate x
            , maybe [] (schemaTypeToXML "endDate") $ volatMatrix_endDate x
            , maybe [] (schemaTypeToXML "buildDateTime") $ volatMatrix_buildDateTime x
            , maybe [] (schemaTypeToXML "dataPoints") $ volatMatrix_dataPoints x
            , concatMap (schemaTypeToXML "adjustment") $ volatMatrix_adjustment x
            ]
instance Extension VolatilityMatrix PricingStructureValuation where
    supertype (VolatilityMatrix a0 a1 e0 e1 e2 e3 e4 e5 e6 e7 e8) =
               PricingStructureValuation a0 a1 e0 e1 e2 e3 e4 e5 e6
instance Extension VolatilityMatrix Valuation where
    supertype = (supertype :: PricingStructureValuation -> Valuation)
              . (supertype :: VolatilityMatrix -> PricingStructureValuation)
              
 
-- | A representation of volatilities of an asset. This is a 
--   generic structure whose values can be supplied in a 
--   specific volatility matrix.
data VolatilityRepresentation = VolatilityRepresentation
        { volatRepres_ID :: Maybe Xsd.ID
        , volatRepres_name :: Maybe Xsd.NormalizedString
          -- ^ The name of the structure, e.g "USDLIBOR-3M EOD Curve".
        , volatRepres_currency :: Maybe Currency
          -- ^ The currency that the structure is expressed in (this is 
          --   relevant mostly for the Interes Rates asset class).
        , volatRepres_asset :: Maybe AnyAssetReference
          -- ^ A reference to the asset whose volatility is modeled.
        }
        deriving (Eq,Show)
instance SchemaType VolatilityRepresentation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (VolatilityRepresentation a0)
            `apply` optional (parseSchemaType "name")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "asset")
    schemaTypeToXML s x@VolatilityRepresentation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ volatRepres_ID x
                       ]
            [ maybe [] (schemaTypeToXML "name") $ volatRepres_name x
            , maybe [] (schemaTypeToXML "currency") $ volatRepres_currency x
            , maybe [] (schemaTypeToXML "asset") $ volatRepres_asset x
            ]
instance Extension VolatilityRepresentation PricingStructure where
    supertype v = PricingStructure_VolatilityRepresentation v
 
-- | A generic yield curve object, which can be valued in a 
--   variety of ways.
data YieldCurve = YieldCurve
        { yieldCurve_ID :: Maybe Xsd.ID
        , yieldCurve_name :: Maybe Xsd.NormalizedString
          -- ^ The name of the structure, e.g "USDLIBOR-3M EOD Curve".
        , yieldCurve_currency :: Maybe Currency
          -- ^ The currency that the structure is expressed in (this is 
          --   relevant mostly for the Interes Rates asset class).
        , yieldCurve_algorithm :: Maybe Xsd.XsdString
        , yieldCurve_forecastRateIndex :: Maybe ForecastRateIndex
        }
        deriving (Eq,Show)
instance SchemaType YieldCurve where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (YieldCurve a0)
            `apply` optional (parseSchemaType "name")
            `apply` optional (parseSchemaType "currency")
            `apply` optional (parseSchemaType "algorithm")
            `apply` optional (parseSchemaType "forecastRateIndex")
    schemaTypeToXML s x@YieldCurve{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ yieldCurve_ID x
                       ]
            [ maybe [] (schemaTypeToXML "name") $ yieldCurve_name x
            , maybe [] (schemaTypeToXML "currency") $ yieldCurve_currency x
            , maybe [] (schemaTypeToXML "algorithm") $ yieldCurve_algorithm x
            , maybe [] (schemaTypeToXML "forecastRateIndex") $ yieldCurve_forecastRateIndex x
            ]
instance Extension YieldCurve PricingStructure where
    supertype v = PricingStructure_YieldCurve v
 
-- | The values of a yield curve, including possibly inputs and 
--   outputs (dfs, forwards, zero rates).
data YieldCurveValuation = YieldCurveValuation
        { yieldCurveVal_ID :: Maybe Xsd.ID
        , yieldCurveVal_definitionRef :: Maybe Xsd.IDREF
          -- ^ An optional reference to the scenario that this valuation 
          --   applies to.
        , yieldCurveVal_objectReference :: Maybe AnyAssetReference
          -- ^ A reference to the asset or pricing structure that this 
          --   values.
        , yieldCurveVal_valuationScenarioReference :: Maybe ValuationScenarioReference
          -- ^ A reference to the valuation scenario used to calculate 
          --   this valuation. If the Valuation occurs within a 
          --   ValuationSet, this value is optional and is defaulted from 
          --   the ValuationSet. If this value occurs in both places, the 
          --   lower level value (i.e. the one here) overrides that in the 
          --   higher (i.e. ValuationSet).
        , yieldCurveVal_baseDate :: Maybe IdentifiedDate
          -- ^ The base date for which the structure applies, i.e. the 
          --   curve date. Normally this will align with the valuation 
          --   date.
        , yieldCurveVal_spotDate :: Maybe IdentifiedDate
          -- ^ The spot settlement date for which the structure applies, 
          --   normally 0-2 days after the base date. The difference 
          --   between the baseDate and the spotDate is termed the 
          --   settlement lag, and is sometimes called "days to spot".
        , yieldCurveVal_inputDataDate :: Maybe IdentifiedDate
          -- ^ The date from which the input data used to construct the 
          --   pricing input was obtained. Often the same as the baseDate, 
          --   but sometimes the pricing input may be "rolled forward", in 
          --   which input data from one date is used to generate a curve 
          --   for a later date.
        , yieldCurveVal_endDate :: Maybe IdentifiedDate
          -- ^ The last date for which data is supplied in this pricing 
          --   input.
        , yieldCurveVal_buildDateTime :: Maybe Xsd.DateTime
          -- ^ The date and time when the pricing input was generated.
        , yieldCurveVal_inputs :: Maybe QuotedAssetSet
        , yieldCurveVal_zeroCurve :: Maybe ZeroRateCurve
          -- ^ A curve of zero rates.
        , yieldCurveVal_forwardCurve :: [ForwardRateCurve]
          -- ^ A curve of forward rates.
        , yieldCurveVal_discountFactorCurve :: Maybe TermCurve
          -- ^ A curve of discount factors.
        }
        deriving (Eq,Show)
instance SchemaType YieldCurveValuation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        a1 <- optional $ getAttribute "definitionRef" e pos
        commit $ interior e $ return (YieldCurveValuation a0 a1)
            `apply` optional (parseSchemaType "objectReference")
            `apply` optional (parseSchemaType "valuationScenarioReference")
            `apply` optional (parseSchemaType "baseDate")
            `apply` optional (parseSchemaType "spotDate")
            `apply` optional (parseSchemaType "inputDataDate")
            `apply` optional (parseSchemaType "endDate")
            `apply` optional (parseSchemaType "buildDateTime")
            `apply` optional (parseSchemaType "inputs")
            `apply` optional (parseSchemaType "zeroCurve")
            `apply` many (parseSchemaType "forwardCurve")
            `apply` optional (parseSchemaType "discountFactorCurve")
    schemaTypeToXML s x@YieldCurveValuation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ yieldCurveVal_ID x
                       , maybe [] (toXMLAttribute "definitionRef") $ yieldCurveVal_definitionRef x
                       ]
            [ maybe [] (schemaTypeToXML "objectReference") $ yieldCurveVal_objectReference x
            , maybe [] (schemaTypeToXML "valuationScenarioReference") $ yieldCurveVal_valuationScenarioReference x
            , maybe [] (schemaTypeToXML "baseDate") $ yieldCurveVal_baseDate x
            , maybe [] (schemaTypeToXML "spotDate") $ yieldCurveVal_spotDate x
            , maybe [] (schemaTypeToXML "inputDataDate") $ yieldCurveVal_inputDataDate x
            , maybe [] (schemaTypeToXML "endDate") $ yieldCurveVal_endDate x
            , maybe [] (schemaTypeToXML "buildDateTime") $ yieldCurveVal_buildDateTime x
            , maybe [] (schemaTypeToXML "inputs") $ yieldCurveVal_inputs x
            , maybe [] (schemaTypeToXML "zeroCurve") $ yieldCurveVal_zeroCurve x
            , concatMap (schemaTypeToXML "forwardCurve") $ yieldCurveVal_forwardCurve x
            , maybe [] (schemaTypeToXML "discountFactorCurve") $ yieldCurveVal_discountFactorCurve x
            ]
instance Extension YieldCurveValuation PricingStructureValuation where
    supertype (YieldCurveValuation a0 a1 e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10) =
               PricingStructureValuation a0 a1 e0 e1 e2 e3 e4 e5 e6
instance Extension YieldCurveValuation Valuation where
    supertype = (supertype :: PricingStructureValuation -> Valuation)
              . (supertype :: YieldCurveValuation -> PricingStructureValuation)
              
 
-- | A curve used to model a set of zero-coupon interest rates.
data ZeroRateCurve = ZeroRateCurve
        { zeroRateCurve_compoundingFrequency :: Maybe CompoundingFrequency
          -- ^ The frequency at which the rates are compounded (e.g. 
          --   continuously compounded).
        , zeroRateCurve_rateCurve :: Maybe TermCurve
          -- ^ The curve of zero-coupon values.
        }
        deriving (Eq,Show)
instance SchemaType ZeroRateCurve where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return ZeroRateCurve
            `apply` optional (parseSchemaType "compoundingFrequency")
            `apply` optional (parseSchemaType "rateCurve")
    schemaTypeToXML s x@ZeroRateCurve{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "compoundingFrequency") $ zeroRateCurve_compoundingFrequency x
            , maybe [] (schemaTypeToXML "rateCurve") $ zeroRateCurve_rateCurve x
            ]
 
elementCreditCurve :: XMLParser CreditCurve
elementCreditCurve = parseSchemaType "creditCurve"
elementToXMLCreditCurve :: CreditCurve -> [Content ()]
elementToXMLCreditCurve = schemaTypeToXML "creditCurve"
 
elementCreditCurveValuation :: XMLParser CreditCurveValuation
elementCreditCurveValuation = parseSchemaType "creditCurveValuation"
elementToXMLCreditCurveValuation :: CreditCurveValuation -> [Content ()]
elementToXMLCreditCurveValuation = schemaTypeToXML "creditCurveValuation"
 
elementFxCurve :: XMLParser FxCurve
elementFxCurve = parseSchemaType "fxCurve"
elementToXMLFxCurve :: FxCurve -> [Content ()]
elementToXMLFxCurve = schemaTypeToXML "fxCurve"
 
elementFxCurveValuation :: XMLParser FxCurveValuation
elementFxCurveValuation = parseSchemaType "fxCurveValuation"
elementToXMLFxCurveValuation :: FxCurveValuation -> [Content ()]
elementToXMLFxCurveValuation = schemaTypeToXML "fxCurveValuation"
 
elementVolatilityMatrixValuation :: XMLParser VolatilityMatrix
elementVolatilityMatrixValuation = parseSchemaType "volatilityMatrixValuation"
elementToXMLVolatilityMatrixValuation :: VolatilityMatrix -> [Content ()]
elementToXMLVolatilityMatrixValuation = schemaTypeToXML "volatilityMatrixValuation"
 
elementVolatilityRepresentation :: XMLParser VolatilityRepresentation
elementVolatilityRepresentation = parseSchemaType "volatilityRepresentation"
elementToXMLVolatilityRepresentation :: VolatilityRepresentation -> [Content ()]
elementToXMLVolatilityRepresentation = schemaTypeToXML "volatilityRepresentation"
 
elementYieldCurve :: XMLParser YieldCurve
elementYieldCurve = parseSchemaType "yieldCurve"
elementToXMLYieldCurve :: YieldCurve -> [Content ()]
elementToXMLYieldCurve = schemaTypeToXML "yieldCurve"
 
elementYieldCurveValuation :: XMLParser YieldCurveValuation
elementYieldCurveValuation = parseSchemaType "yieldCurveValuation"
elementToXMLYieldCurveValuation :: YieldCurveValuation -> [Content ()]
elementToXMLYieldCurveValuation = schemaTypeToXML "yieldCurveValuation"