{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Riskdef
  ( module Data.FpML.V53.Riskdef
  , module Data.FpML.V53.Doc
  , module Data.FpML.V53.Asset
  , module Data.FpML.V53.Mktenv
  ) 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
 
-- Some hs-boot imports are required, for fwd-declaring types.
import {-# SOURCE #-} Data.FpML.V53.Mktenv ( elementYieldCurve, elementToXMLYieldCurve )
import {-# SOURCE #-} Data.FpML.V53.Mktenv ( elementVolatilityRepresentation, elementToXMLVolatilityRepresentation )
import {-# SOURCE #-} Data.FpML.V53.Mktenv ( elementFxCurve, elementToXMLFxCurve )
import {-# SOURCE #-} Data.FpML.V53.Mktenv ( elementCreditCurve, elementToXMLCreditCurve )
import {-# SOURCE #-} Data.FpML.V53.Mktenv ( elementYieldCurveValuation, elementToXMLYieldCurveValuation )
import {-# SOURCE #-} Data.FpML.V53.Mktenv ( elementVolatilityMatrixValuation, elementToXMLVolatilityMatrixValuation )
import {-# SOURCE #-} Data.FpML.V53.Mktenv ( elementFxCurveValuation, elementToXMLFxCurveValuation )
import {-# SOURCE #-} Data.FpML.V53.Mktenv ( elementCreditCurveValuation, elementToXMLCreditCurveValuation )
 
-- | Reference to an underlying asset, term point or pricing 
--   structure (yield curve).
data AssetOrTermPointOrPricingStructureReference = AssetOrTermPointOrPricingStructureReference
        { aotpopsr_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType AssetOrTermPointOrPricingStructureReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (AssetOrTermPointOrPricingStructureReference a0)
    schemaTypeToXML s x@AssetOrTermPointOrPricingStructureReference{} =
        toXMLElement s [ toXMLAttribute "href" $ aotpopsr_href x
                       ]
            []
instance Extension AssetOrTermPointOrPricingStructureReference Reference where
    supertype v = Reference_AssetOrTermPointOrPricingStructureReference v
 
-- | A structure that holds a set of measures about an asset.
data BasicAssetValuation = BasicAssetValuation
        { basicAssetVal_ID :: Maybe Xsd.ID
        , basicAssetVal_definitionRef :: Maybe Xsd.IDREF
          -- ^ An optional reference to the scenario that this valuation 
          --   applies to.
        , basicAssetVal_objectReference :: Maybe AnyAssetReference
          -- ^ A reference to the asset or pricing structure that this 
          --   values.
        , basicAssetVal_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).
        , basicAssetVal_quote :: [BasicQuotation]
          -- ^ One or more numerical measures relating to the asset, 
          --   possibly together with sensitivities of that measure to 
          --   pricing inputs
        }
        deriving (Eq,Show)
instance SchemaType BasicAssetValuation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        a1 <- optional $ getAttribute "definitionRef" e pos
        commit $ interior e $ return (BasicAssetValuation a0 a1)
            `apply` optional (parseSchemaType "objectReference")
            `apply` optional (parseSchemaType "valuationScenarioReference")
            `apply` many (parseSchemaType "quote")
    schemaTypeToXML s x@BasicAssetValuation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ basicAssetVal_ID x
                       , maybe [] (toXMLAttribute "definitionRef") $ basicAssetVal_definitionRef x
                       ]
            [ maybe [] (schemaTypeToXML "objectReference") $ basicAssetVal_objectReference x
            , maybe [] (schemaTypeToXML "valuationScenarioReference") $ basicAssetVal_valuationScenarioReference x
            , concatMap (schemaTypeToXML "quote") $ basicAssetVal_quote x
            ]
instance Extension BasicAssetValuation Valuation where
    supertype (BasicAssetValuation a0 a1 e0 e1 e2) =
               Valuation a0 a1 e0 e1
 
-- | The type defining a denominator term of the formula. Its 
--   value is (sum of weighted partials) ^ power.
data DenominatorTerm = DenominatorTerm
        { denomTerm_weightedPartial :: Maybe WeightedPartialDerivative
          -- ^ A partial derivative multiplied by a weighting factor.
        , denomTerm_power :: Maybe Xsd.PositiveInteger
          -- ^ The power to which this term is raised.
        }
        deriving (Eq,Show)
instance SchemaType DenominatorTerm where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return DenominatorTerm
            `apply` optional (parseSchemaType "weightedPartial")
            `apply` optional (parseSchemaType "power")
    schemaTypeToXML s x@DenominatorTerm{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "weightedPartial") $ denomTerm_weightedPartial x
            , maybe [] (schemaTypeToXML "power") $ denomTerm_power x
            ]
 
-- | The method by which a derivative is computed.
data DerivativeCalculationMethod = DerivativeCalculationMethod Scheme DerivativeCalculationMethodAttributes deriving (Eq,Show)
data DerivativeCalculationMethodAttributes = DerivativeCalculationMethodAttributes
    { dcma_derivativeCalculationMethodScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType DerivativeCalculationMethod where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "derivativeCalculationMethodScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ DerivativeCalculationMethod v (DerivativeCalculationMethodAttributes a0)
    schemaTypeToXML s (DerivativeCalculationMethod bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "derivativeCalculationMethodScheme") $ dcma_derivativeCalculationMethodScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension DerivativeCalculationMethod Scheme where
    supertype (DerivativeCalculationMethod s _) = s
 
-- | A description of how a numerical derivative is computed.
data DerivativeCalculationProcedure = DerivativeCalculationProcedure
        { derivCalcProced_method :: Maybe DerivativeCalculationMethod
          -- ^ The method by which a derivative is computed, e.g. 
          --   analytic, numerical model, perturbation, etc.
        , derivCalcProced_choice1 :: (Maybe (OneOf3 ((Maybe (Xsd.Decimal)),(Maybe (Xsd.Boolean)),(Maybe (PerturbationType))) Xsd.XsdString PricingStructureReference))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * The size and direction of the perturbation used to 
          --   compute the derivative, e.g. 0.0001 = 1 bp.
          --   
          --     * The value is calculated by perturbing by the 
          --   perturbationAmount and then the negative of the 
          --   perturbationAmount and then averaging the two 
          --   values (i.e. the value is half of the difference 
          --   between perturbing up and perturbing down).
          --   
          --     * The type of perturbation, if any, used to compute 
          --   the derivative (Absolute vs Relative).
          --   
          --   (2) The formula used to compute the derivative (perhaps 
          --   could be updated to use the Formula type in EQS.).
          --   
          --   (3) A reference to the replacement version of the market 
          --   input, e.g. a bumped yield curve.
        }
        deriving (Eq,Show)
instance SchemaType DerivativeCalculationProcedure where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return DerivativeCalculationProcedure
            `apply` optional (parseSchemaType "method")
            `apply` optional (oneOf' [ ("Maybe Xsd.Decimal Maybe Xsd.Boolean Maybe PerturbationType", fmap OneOf3 (return (,,) `apply` optional (parseSchemaType "perturbationAmount")
                                                                                                                               `apply` optional (parseSchemaType "averaged")
                                                                                                                               `apply` optional (parseSchemaType "perturbationType")))
                                     , ("Xsd.XsdString", fmap TwoOf3 (parseSchemaType "derivativeFormula"))
                                     , ("PricingStructureReference", fmap ThreeOf3 (parseSchemaType "replacementMarketInput"))
                                     ])
    schemaTypeToXML s x@DerivativeCalculationProcedure{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "method") $ derivCalcProced_method x
            , maybe [] (foldOneOf3  (\ (a,b,c) -> concat [ maybe [] (schemaTypeToXML "perturbationAmount") a
                                                         , maybe [] (schemaTypeToXML "averaged") b
                                                         , maybe [] (schemaTypeToXML "perturbationType") c
                                                         ])
                                    (schemaTypeToXML "derivativeFormula")
                                    (schemaTypeToXML "replacementMarketInput")
                                   ) $ derivCalcProced_choice1 x
            ]
 
-- | A formula for computing a complex derivative from partial 
--   derivatives. Its value is the sum of the terms divided by 
--   the product of the denominator terms.
data DerivativeFormula = DerivativeFormula
        { derivFormula_term :: Maybe FormulaTerm
          -- ^ A term of the formula. Its value is the product of the its 
          --   coefficient and the referenced partial derivatives.
        , derivFormula_denominatorTerm :: Maybe DenominatorTerm
          -- ^ A denominator term of the formula. Its value is (sum of 
          --   weighted partials) ^ power.
        }
        deriving (Eq,Show)
instance SchemaType DerivativeFormula where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return DerivativeFormula
            `apply` optional (parseSchemaType "term")
            `apply` optional (parseSchemaType "denominatorTerm")
    schemaTypeToXML s x@DerivativeFormula{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "term") $ derivFormula_term x
            , maybe [] (schemaTypeToXML "denominatorTerm") $ derivFormula_denominatorTerm x
            ]
 
-- | A type defining a term of the formula. Its value is the 
--   product of the its coefficient and the referenced partial 
--   derivatives.
data FormulaTerm = FormulaTerm
        { formulaTerm_coefficient :: Maybe Xsd.Decimal
          -- ^ The coefficient by which this term is multiplied, typically 
          --   1 or -1.
        , formulaTerm_partialDerivativeReference :: [PricingParameterDerivativeReference]
          -- ^ A reference to the partial derivative.
        }
        deriving (Eq,Show)
instance SchemaType FormulaTerm where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return FormulaTerm
            `apply` optional (parseSchemaType "coefficient")
            `apply` many (parseSchemaType "partialDerivativeReference")
    schemaTypeToXML s x@FormulaTerm{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "coefficient") $ formulaTerm_coefficient x
            , concatMap (schemaTypeToXML "partialDerivativeReference") $ formulaTerm_partialDerivativeReference x
            ]
 
-- | A generic (user defined) dimension, e.g. for use in a 
--   correlation surface. e.g. a currency, stock, etc. This 
--   would take values like USD, GBP, JPY, or IBM, MSFT, etc.
data GenericDimension = GenericDimension Xsd.XsdString GenericDimensionAttributes deriving (Eq,Show)
data GenericDimensionAttributes = GenericDimensionAttributes
    { genericDimensAttrib_name :: Xsd.NormalizedString
      -- ^ The name of the dimension. E.g.: "Currency", "Stock", 
      --   "Issuer", etc.
    , genericDimensAttrib_href :: Maybe Xsd.IDREF
      -- ^ A reference to an instrument (e.g. currency) that this 
      --   value represents.
    }
    deriving (Eq,Show)
instance SchemaType GenericDimension where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- getAttribute "name" e pos
          a1 <- optional $ getAttribute "href" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ GenericDimension v (GenericDimensionAttributes a0 a1)
    schemaTypeToXML s (GenericDimension bt at) =
        addXMLAttributes [ toXMLAttribute "name" $ genericDimensAttrib_name at
                         , maybe [] (toXMLAttribute "href") $ genericDimensAttrib_href at
                         ]
            $ schemaTypeToXML s bt
instance Extension GenericDimension Xsd.XsdString where
    supertype (GenericDimension s _) = s
 
-- | A collection of instruments usable for quotation purposes. 
--   In future releases, quotable derivative assets may be added 
--   after the underlying asset.
data InstrumentSet = InstrumentSet
        { instrSet_choice0 :: (Maybe (OneOf2 Asset Asset))
          -- ^ Choice between:
          --   
          --   (1) Define the underlying asset, either a listed security 
          --   or other instrument.
          --   
          --   (2) Defines the underlying asset when it is a curve 
          --   instrument.
        }
        deriving (Eq,Show)
instance SchemaType InstrumentSet where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return InstrumentSet
            `apply` optional (oneOf' [ ("Asset", fmap OneOf2 (elementUnderlyingAsset))
                                     , ("Asset", fmap TwoOf2 (elementCurveInstrument))
                                     ])
    schemaTypeToXML s x@InstrumentSet{} =
        toXMLElement s []
            [ maybe [] (foldOneOf2  (elementToXMLUnderlyingAsset)
                                    (elementToXMLCurveInstrument)
                                   ) $ instrSet_choice0 x
            ]
 
-- | A collection of pricing inputs.
data Market = Market
        { market_ID :: Maybe Xsd.ID
        , market_name :: Maybe Xsd.XsdString
          -- ^ The name of the market, e.g. the USDLIBOR market. Used for 
          --   description and understandability.
        , market_benchmarkQuotes :: Maybe QuotedAssetSet
          -- ^ A collection of benchmark instruments and quotes used as 
          --   inputs to the pricing models.
        , market_pricingStructure :: [PricingStructure]
        , market_pricingStructureValuation :: [PricingStructureValuation]
        , market_benchmarkPricingMethod :: [PricingMethod]
          -- ^ The pricing structure used to quote a benchmark instrument.
        }
        deriving (Eq,Show)
instance SchemaType Market where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (Market a0)
            `apply` optional (parseSchemaType "name")
            `apply` optional (parseSchemaType "benchmarkQuotes")
            `apply` many (elementPricingStructure)
            `apply` many (elementPricingStructureValuation)
            `apply` many (parseSchemaType "benchmarkPricingMethod")
    schemaTypeToXML s x@Market{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ market_ID x
                       ]
            [ maybe [] (schemaTypeToXML "name") $ market_name x
            , maybe [] (schemaTypeToXML "benchmarkQuotes") $ market_benchmarkQuotes x
            , concatMap (elementToXMLPricingStructure) $ market_pricingStructure x
            , concatMap (elementToXMLPricingStructureValuation) $ market_pricingStructureValuation x
            , concatMap (schemaTypeToXML "benchmarkPricingMethod") $ market_benchmarkPricingMethod x
            ]
 
-- | Reference to a market structure.
data MarketReference = MarketReference
        { marketRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType MarketReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (MarketReference a0)
    schemaTypeToXML s x@MarketReference{} =
        toXMLElement s [ toXMLAttribute "href" $ marketRef_href x
                       ]
            []
instance Extension MarketReference Reference where
    supertype v = Reference_MarketReference v
 
-- | The type of perturbation applied to compute a derivative 
--   perturbatively.
data PerturbationType = PerturbationType Scheme PerturbationTypeAttributes deriving (Eq,Show)
data PerturbationTypeAttributes = PerturbationTypeAttributes
    { perturTypeAttrib_perturbationTypeScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType PerturbationType where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "perturbationTypeScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ PerturbationType v (PerturbationTypeAttributes a0)
    schemaTypeToXML s (PerturbationType bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "perturbationTypeScheme") $ perturTypeAttrib_perturbationTypeScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension PerturbationType Scheme where
    supertype (PerturbationType s _) = s
 
-- | A unique identifier for the position. The id attribute is 
--   defined for intradocument referencing.
data PositionId = PositionId Scheme PositionIdAttributes deriving (Eq,Show)
data PositionIdAttributes = PositionIdAttributes
    { positIdAttrib_positionIdScheme :: Maybe Xsd.AnyURI
    , positIdAttrib_ID :: Maybe Xsd.ID
    }
    deriving (Eq,Show)
instance SchemaType PositionId where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "positionIdScheme" e pos
          a1 <- optional $ getAttribute "id" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ PositionId v (PositionIdAttributes a0 a1)
    schemaTypeToXML s (PositionId bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "positionIdScheme") $ positIdAttrib_positionIdScheme at
                         , maybe [] (toXMLAttribute "id") $ positIdAttrib_ID at
                         ]
            $ schemaTypeToXML s bt
instance Extension PositionId Scheme where
    supertype (PositionId s _) = s
 
-- | The substitution of a pricing input (e.g. curve) for 
--   another, used in generating prices and risks for valuation 
--   scenarios.
data PricingInputReplacement = PricingInputReplacement
        { pricingInputReplac_originalInputReference :: Maybe PricingStructureReference
          -- ^ A reference to the original value of the pricing input.
        , pricingInputReplac_replacementInputReference :: Maybe PricingStructureReference
          -- ^ A reference to the substitution to do.
        }
        deriving (Eq,Show)
instance SchemaType PricingInputReplacement where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PricingInputReplacement
            `apply` optional (parseSchemaType "originalInputReference")
            `apply` optional (parseSchemaType "replacementInputReference")
    schemaTypeToXML s x@PricingInputReplacement{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "originalInputReference") $ pricingInputReplac_originalInputReference x
            , maybe [] (schemaTypeToXML "replacementInputReference") $ pricingInputReplac_replacementInputReference x
            ]
 
-- | The type of pricing structure represented.
data PricingInputType = PricingInputType Scheme PricingInputTypeAttributes deriving (Eq,Show)
data PricingInputTypeAttributes = PricingInputTypeAttributes
    { pricingInputTypeAttrib_pricingInputTypeScheme :: Maybe Xsd.AnyURI
    }
    deriving (Eq,Show)
instance SchemaType PricingInputType where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "pricingInputTypeScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ PricingInputType v (PricingInputTypeAttributes a0)
    schemaTypeToXML s (PricingInputType bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "pricingInputTypeScheme") $ pricingInputTypeAttrib_pricingInputTypeScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension PricingInputType Scheme where
    supertype (PricingInputType s _) = s
 
-- | A set of index values that identify a pricing data point. 
--   For example: (strike = 17%, expiration = 6M, term = 1Y.
data PricingDataPointCoordinate = PricingDataPointCoordinate
        { pricingDataPointCoord_ID :: Maybe Xsd.ID
        , pricingDataPointCoord_choice0 :: (Maybe (OneOf4 TimeDimension TimeDimension Xsd.Decimal GenericDimension))
          -- ^ Choice between:
          --   
          --   (1) A time dimension that represents the term of a 
          --   financial instrument, e.g. of a zero-coupon bond on a 
          --   curve, or of an underlying caplet or swap for an 
          --   option.
          --   
          --   (2) A time dimension that represents the time to expiration 
          --   of an option.
          --   
          --   (3) A numerical dimension that represents the strike rate 
          --   or price of an option.
          --   
          --   (4) generic
        }
        deriving (Eq,Show)
instance SchemaType PricingDataPointCoordinate where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (PricingDataPointCoordinate a0)
            `apply` optional (oneOf' [ ("TimeDimension", fmap OneOf4 (parseSchemaType "term"))
                                     , ("TimeDimension", fmap TwoOf4 (parseSchemaType "expiration"))
                                     , ("Xsd.Decimal", fmap ThreeOf4 (parseSchemaType "strike"))
                                     , ("GenericDimension", fmap FourOf4 (parseSchemaType "generic"))
                                     ])
    schemaTypeToXML s x@PricingDataPointCoordinate{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ pricingDataPointCoord_ID x
                       ]
            [ maybe [] (foldOneOf4  (schemaTypeToXML "term")
                                    (schemaTypeToXML "expiration")
                                    (schemaTypeToXML "strike")
                                    (schemaTypeToXML "generic")
                                   ) $ pricingDataPointCoord_choice0 x
            ]
 
-- | Reference to a Pricing Data Point Coordinate.
data PricingDataPointCoordinateReference = PricingDataPointCoordinateReference
        { pdpcr_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType PricingDataPointCoordinateReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (PricingDataPointCoordinateReference a0)
    schemaTypeToXML s x@PricingDataPointCoordinateReference{} =
        toXMLElement s [ toXMLAttribute "href" $ pdpcr_href x
                       ]
            []
instance Extension PricingDataPointCoordinateReference Reference where
    supertype v = Reference_PricingDataPointCoordinateReference v
 
-- | For an asset (e.g. a reference/benchmark asset), the 
--   pricing structure used to price it. Used, for example, to 
--   specify that the rateIndex "USD-LIBOR-Telerate" with term = 
--   6M is priced using the "USD-LIBOR-Close" curve.
data PricingMethod = PricingMethod
        { pricingMethod_assetReference :: Maybe AnyAssetReference
          -- ^ The asset whose price is required.
        , pricingMethod_pricingInputReference :: Maybe PricingStructureReference
          -- ^ A reference to the pricing input used to value the asset.
        }
        deriving (Eq,Show)
instance SchemaType PricingMethod where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return PricingMethod
            `apply` optional (parseSchemaType "assetReference")
            `apply` optional (parseSchemaType "pricingInputReference")
    schemaTypeToXML s x@PricingMethod{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "assetReference") $ pricingMethod_assetReference x
            , maybe [] (schemaTypeToXML "pricingInputReference") $ pricingMethod_pricingInputReference x
            ]
 
-- | A definition of the mathematical derivative with respect to 
--   a specific pricing parameter.
data PricingParameterDerivative = PricingParameterDerivative
        { pricingParamDeriv_ID :: Maybe Xsd.ID
        , pricingParamDeriv_description :: Maybe Xsd.XsdString
          -- ^ A description, if needed, of how the derivative is 
          --   computed.
        , pricingParamDeriv_choice1 :: (Maybe (OneOf2 AssetOrTermPointOrPricingStructureReference [ValuationReference]))
          -- ^ Choice between:
          --   
          --   (1) A reference to the pricing input parameter to which the 
          --   sensitivity is computed. If it is omitted, the 
          --   derivative definition is generic, and applies to any 
          --   input point in the valuation set.
          --   
          --   (2) Reference(s) to the pricing input dates that are 
          --   shifted when the sensitivity is computed. Depending on 
          --   the time advance method used, this list could vary. 
          --   Used for describing time-advance derivatives (theta, 
          --   carry, etc.)
        , pricingParamDeriv_calculationProcedure :: Maybe DerivativeCalculationProcedure
          -- ^ The method by which a derivative is computed, e.g. 
          --   analytic, numerical model, perturbation, etc., and the 
          --   corresponding parameters
        }
        deriving (Eq,Show)
instance SchemaType PricingParameterDerivative where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (PricingParameterDerivative a0)
            `apply` optional (parseSchemaType "description")
            `apply` optional (oneOf' [ ("AssetOrTermPointOrPricingStructureReference", fmap OneOf2 (parseSchemaType "parameterReference"))
                                     , ("[ValuationReference]", fmap TwoOf2 (many1 (parseSchemaType "inputDateReference")))
                                     ])
            `apply` optional (parseSchemaType "calculationProcedure")
    schemaTypeToXML s x@PricingParameterDerivative{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ pricingParamDeriv_ID x
                       ]
            [ maybe [] (schemaTypeToXML "description") $ pricingParamDeriv_description x
            , maybe [] (foldOneOf2  (schemaTypeToXML "parameterReference")
                                    (concatMap (schemaTypeToXML "inputDateReference"))
                                   ) $ pricingParamDeriv_choice1 x
            , maybe [] (schemaTypeToXML "calculationProcedure") $ pricingParamDeriv_calculationProcedure x
            ]
 
-- | Reference to a partial derivative.
data PricingParameterDerivativeReference = PricingParameterDerivativeReference
        { ppdr_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType PricingParameterDerivativeReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (PricingParameterDerivativeReference a0)
    schemaTypeToXML s x@PricingParameterDerivativeReference{} =
        toXMLElement s [ toXMLAttribute "href" $ ppdr_href x
                       ]
            []
instance Extension PricingParameterDerivativeReference Reference where
    supertype v = Reference_PricingParameterDerivativeReference v
 
-- | A definition of a shift with respect to a specific pricing 
--   parameter.
data PricingParameterShift = PricingParameterShift
        { pricingParamShift_ID :: Maybe Xsd.ID
        , pricingParamShift_parameterReference :: Maybe AssetOrTermPointOrPricingStructureReference
        , pricingParamShift_shift :: Maybe Xsd.Decimal
          -- ^ The size of the denominator, e.g. 0.0001 = 1 bp.
        , pricingParamShift_shiftUnits :: Maybe PriceQuoteUnits
          -- ^ The units of the denominator, e.g. currency. If not 
          --   present, use the units of the PricingInputReference.
        }
        deriving (Eq,Show)
instance SchemaType PricingParameterShift where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (PricingParameterShift a0)
            `apply` optional (parseSchemaType "parameterReference")
            `apply` optional (parseSchemaType "shift")
            `apply` optional (parseSchemaType "shiftUnits")
    schemaTypeToXML s x@PricingParameterShift{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ pricingParamShift_ID x
                       ]
            [ maybe [] (schemaTypeToXML "parameterReference") $ pricingParamShift_parameterReference x
            , maybe [] (schemaTypeToXML "shift") $ pricingParamShift_shift x
            , maybe [] (schemaTypeToXML "shiftUnits") $ pricingParamShift_shiftUnits x
            ]
 
-- | An abstract pricing structure valuation base type. Used as 
--   a base for values of pricing structures such as yield 
--   curves and volatility matrices. Derived from the 
--   "Valuation" type.
data PricingStructureValuation = PricingStructureValuation
        { pricingStructVal_ID :: Maybe Xsd.ID
        , pricingStructVal_definitionRef :: Maybe Xsd.IDREF
          -- ^ An optional reference to the scenario that this valuation 
          --   applies to.
        , pricingStructVal_objectReference :: Maybe AnyAssetReference
          -- ^ A reference to the asset or pricing structure that this 
          --   values.
        , pricingStructVal_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).
        , pricingStructVal_baseDate :: Maybe IdentifiedDate
          -- ^ The base date for which the structure applies, i.e. the 
          --   curve date. Normally this will align with the valuation 
          --   date.
        , pricingStructVal_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".
        , pricingStructVal_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.
        , pricingStructVal_endDate :: Maybe IdentifiedDate
          -- ^ The last date for which data is supplied in this pricing 
          --   input.
        , pricingStructVal_buildDateTime :: Maybe Xsd.DateTime
          -- ^ The date and time when the pricing input was generated.
        }
        deriving (Eq,Show)
instance SchemaType PricingStructureValuation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        a1 <- optional $ getAttribute "definitionRef" e pos
        commit $ interior e $ return (PricingStructureValuation 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")
    schemaTypeToXML s x@PricingStructureValuation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ pricingStructVal_ID x
                       , maybe [] (toXMLAttribute "definitionRef") $ pricingStructVal_definitionRef x
                       ]
            [ maybe [] (schemaTypeToXML "objectReference") $ pricingStructVal_objectReference x
            , maybe [] (schemaTypeToXML "valuationScenarioReference") $ pricingStructVal_valuationScenarioReference x
            , maybe [] (schemaTypeToXML "baseDate") $ pricingStructVal_baseDate x
            , maybe [] (schemaTypeToXML "spotDate") $ pricingStructVal_spotDate x
            , maybe [] (schemaTypeToXML "inputDataDate") $ pricingStructVal_inputDataDate x
            , maybe [] (schemaTypeToXML "endDate") $ pricingStructVal_endDate x
            , maybe [] (schemaTypeToXML "buildDateTime") $ pricingStructVal_buildDateTime x
            ]
instance Extension PricingStructureValuation Valuation where
    supertype (PricingStructureValuation a0 a1 e0 e1 e2 e3 e4 e5 e6) =
               Valuation a0 a1 e0 e1
 
-- | A collection of quoted assets.
data QuotedAssetSet = QuotedAssetSet
        { quotedAssetSet_instrumentSet :: Maybe InstrumentSet
          -- ^ A collection of instruments used as a basis for quotation.
        , quotedAssetSet_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 QuotedAssetSet where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return QuotedAssetSet
            `apply` optional (parseSchemaType "instrumentSet")
            `apply` many (parseSchemaType "assetQuote")
    schemaTypeToXML s x@QuotedAssetSet{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "instrumentSet") $ quotedAssetSet_instrumentSet x
            , concatMap (schemaTypeToXML "assetQuote") $ quotedAssetSet_assetQuote x
            ]
 
-- | A set of characteristics describing a sensitivity.
data SensitivityDefinition = SensitivityDefinition
        { sensitDefin_ID :: Maybe Xsd.ID
        , sensitDefin_name :: Maybe Xsd.XsdString
          -- ^ The name of the derivative, e.g. first derivative, Hessian, 
          --   etc. Typically not required, but may be used to explain 
          --   more complex derivative calculations.
        , sensitDefin_valuationScenarioReference :: Maybe ValuationScenarioReference
          -- ^ Reference to the valuation scenario to which this 
          --   sensitivity definition applies. If the 
          --   SensitivityDefinition occurs within a 
          --   SensitivitySetDefinition, this is not required and normally 
          --   not used. In this case, if it is supplied it overrides the 
          --   valuationScenarioReference in the SensitivitySetDefinition.
        , sensitDefin_choice2 :: OneOf2 ([PricingParameterDerivative],(Maybe (DerivativeFormula))) (OneOf2 TimeDimension ((Maybe (OneOf2 PricingDataPointCoordinate PricingDataPointCoordinateReference))))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * A partial derivative of the measure with respect to 
          --   an input.
          --   
          --     * A formula defining how to compute the derivative 
          --   from the partial derivatives. If absent, the 
          --   derivative is just the product of the partial 
          --   derivatives. Normally only required for more 
          --   higher-order derivatives, e.g. Hessians.
          --   
          --   (2) unknown
        }
        deriving (Eq,Show)
instance SchemaType SensitivityDefinition where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (SensitivityDefinition a0)
            `apply` optional (parseSchemaType "name")
            `apply` optional (parseSchemaType "valuationScenarioReference")
            `apply` oneOf' [ ("[PricingParameterDerivative] Maybe DerivativeFormula", fmap OneOf2 (return (,) `apply` many (parseSchemaType "partialDerivative")
                                                                                                              `apply` optional (parseSchemaType "formula")))
                           , ("OneOf2 TimeDimension ((Maybe (OneOf2 PricingDataPointCoordinate PricingDataPointCoordinateReference)))", fmap TwoOf2 (oneOf' [ ("TimeDimension", fmap OneOf2 (parseSchemaType "term"))
                                                                                                                                                            , ("(Maybe (OneOf2 PricingDataPointCoordinate PricingDataPointCoordinateReference))", fmap TwoOf2 (optional (oneOf' [ ("PricingDataPointCoordinate", fmap OneOf2 (parseSchemaType "coordinate"))
                                                                                                                                                                                                                                                                                , ("PricingDataPointCoordinateReference", fmap TwoOf2 (parseSchemaType "coordinateReference"))
                                                                                                                                                                                                                                                                                ])))
                                                                                                                                                            ]))
                           ]
    schemaTypeToXML s x@SensitivityDefinition{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ sensitDefin_ID x
                       ]
            [ maybe [] (schemaTypeToXML "name") $ sensitDefin_name x
            , maybe [] (schemaTypeToXML "valuationScenarioReference") $ sensitDefin_valuationScenarioReference x
            , foldOneOf2  (\ (a,b) -> concat [ concatMap (schemaTypeToXML "partialDerivative") a
                                             , maybe [] (schemaTypeToXML "formula") b
                                             ])
                          (foldOneOf2  (schemaTypeToXML "term")
                                       (maybe [] (foldOneOf2  (schemaTypeToXML "coordinate")
                                                              (schemaTypeToXML "coordinateReference")
                                                             ))
                                      )
                          $ sensitDefin_choice2 x
            ]
 
-- | A sensitivity report definition, consisting of a collection 
--   of sensitivity definitions.
data SensitivitySetDefinition = SensitivitySetDefinition
        { sensitSetDefin_ID :: Maybe Xsd.ID
        , sensitSetDefin_name :: Maybe Xsd.XsdString
          -- ^ The name of the sensitivity set definition, e.g. "USDLIBOR 
          --   curve sensitivities".
        , sensitSetDefin_sensitivityCharacteristics :: Maybe QuotationCharacteristics
          -- ^ The default characteristics of the quotation, e.g. type, 
          --   units, etc.
        , sensitSetDefin_valuationScenarioReference :: Maybe ValuationScenarioReference
          -- ^ Reference to the valuation scenario to which this 
          --   sensitivity definition applies, e.g. a reference to the EOD 
          --   valuation scenario. If not supplied, this sensitivity set 
          --   definition is generic to a variety of valuation scenarios.
        , sensitSetDefin_pricingInputType :: Maybe PricingInputType
          -- ^ The type of the pricing input to which the sensitivity is 
          --   shown, e.g. a yield curve or volatility matrix.
        , sensitSetDefin_pricingInputReference :: Maybe PricingStructureReference
          -- ^ A reference to the pricing input to which the sensitivity 
          --   is shown, e.g. a reference to a USDLIBOR yield curve.
        , sensitSetDefin_scale :: Maybe Xsd.Decimal
          -- ^ The size of the denominator, e.g. 0.0001 = 1 bp. For 
          --   derivatives with respect to time, the default period is 1 
          --   day.
        , sensitSetDefin_sensitivityDefinition :: [SensitivityDefinition]
          -- ^ A set of sensitivity definitions. Either one per point 
          --   reported, or one generic definition that applies to all 
          --   points.
        , sensitSetDefin_calculationProcedure :: Maybe DerivativeCalculationProcedure
          -- ^ The method by which each derivative is computed, e.g. 
          --   analytic, numerical model, perturbation, etc., and the 
          --   corresponding parameters (eg. shift amounts).
        }
        deriving (Eq,Show)
instance SchemaType SensitivitySetDefinition where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (SensitivitySetDefinition a0)
            `apply` optional (parseSchemaType "name")
            `apply` optional (parseSchemaType "sensitivityCharacteristics")
            `apply` optional (parseSchemaType "valuationScenarioReference")
            `apply` optional (parseSchemaType "pricingInputType")
            `apply` optional (parseSchemaType "pricingInputReference")
            `apply` optional (parseSchemaType "scale")
            `apply` many (parseSchemaType "sensitivityDefinition")
            `apply` optional (parseSchemaType "calculationProcedure")
    schemaTypeToXML s x@SensitivitySetDefinition{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ sensitSetDefin_ID x
                       ]
            [ maybe [] (schemaTypeToXML "name") $ sensitSetDefin_name x
            , maybe [] (schemaTypeToXML "sensitivityCharacteristics") $ sensitSetDefin_sensitivityCharacteristics x
            , maybe [] (schemaTypeToXML "valuationScenarioReference") $ sensitSetDefin_valuationScenarioReference x
            , maybe [] (schemaTypeToXML "pricingInputType") $ sensitSetDefin_pricingInputType x
            , maybe [] (schemaTypeToXML "pricingInputReference") $ sensitSetDefin_pricingInputReference x
            , maybe [] (schemaTypeToXML "scale") $ sensitSetDefin_scale x
            , concatMap (schemaTypeToXML "sensitivityDefinition") $ sensitSetDefin_sensitivityDefinition x
            , maybe [] (schemaTypeToXML "calculationProcedure") $ sensitSetDefin_calculationProcedure x
            ]
 
-- | A reference to a sensitivity set definition.
data SensitivitySetDefinitionReference = SensitivitySetDefinitionReference
        { sensitSetDefinRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType SensitivitySetDefinitionReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (SensitivitySetDefinitionReference a0)
    schemaTypeToXML s x@SensitivitySetDefinitionReference{} =
        toXMLElement s [ toXMLAttribute "href" $ sensitSetDefinRef_href x
                       ]
            []
instance Extension SensitivitySetDefinitionReference Reference where
    supertype v = Reference_SensitivitySetDefinitionReference v
 
-- | The time dimensions of a term-structure. The user must 
--   supply either a tenor or a date or both.
data TimeDimension = TimeDimension
        { timeDimens_choice0 :: (Maybe (OneOf1 ((Maybe (Xsd.Date)),(Maybe (Period)))))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * The absolute date corresponding to this term point, 
          --   for example January 3, 2005.
          --   
          --     * The amount of time from the base date of the 
          --   pricing input to the specified term point, e.g. 6M 
          --   or 5Y.
        }
        deriving (Eq,Show)
instance SchemaType TimeDimension where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return TimeDimension
            `apply` optional (oneOf' [ ("Maybe Xsd.Date Maybe Period", fmap OneOf1 (return (,) `apply` optional (parseSchemaType "date")
                                                                                               `apply` optional (parseSchemaType "tenor")))
                                     ])
    schemaTypeToXML s x@TimeDimension{} =
        toXMLElement s []
            [ maybe [] (foldOneOf1  (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "date") a
                                                       , maybe [] (schemaTypeToXML "tenor") b
                                                       ])
                                   ) $ timeDimens_choice0 x
            ]
 
-- | A valuation of an valuable object - an asset or a pricing 
--   input. This is an abstract type, used as a base for values 
--   of pricing structures such as yield curves as well as asset 
--   values.
data Valuation = Valuation
        { valuation_ID :: Maybe Xsd.ID
        , valuation_definitionRef :: Maybe Xsd.IDREF
          -- ^ An optional reference to the scenario that this valuation 
          --   applies to.
        , valuation_objectReference :: Maybe AnyAssetReference
          -- ^ A reference to the asset or pricing structure that this 
          --   values.
        , valuation_scenarioReference :: 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).
        }
        deriving (Eq,Show)
instance SchemaType Valuation where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        a1 <- optional $ getAttribute "definitionRef" e pos
        commit $ interior e $ return (Valuation a0 a1)
            `apply` optional (parseSchemaType "objectReference")
            `apply` optional (parseSchemaType "valuationScenarioReference")
    schemaTypeToXML s x@Valuation{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ valuation_ID x
                       , maybe [] (toXMLAttribute "definitionRef") $ valuation_definitionRef x
                       ]
            [ maybe [] (schemaTypeToXML "objectReference") $ valuation_objectReference x
            , maybe [] (schemaTypeToXML "valuationScenarioReference") $ valuation_scenarioReference x
            ]
 
-- | Reference to a Valuation or any derived structure such as 
--   PricingStructureValuation.
data ValuationReference = ValuationReference
        { valRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType ValuationReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (ValuationReference a0)
    schemaTypeToXML s x@ValuationReference{} =
        toXMLElement s [ toXMLAttribute "href" $ valRef_href x
                       ]
            []
instance Extension ValuationReference Reference where
    supertype v = Reference_ValuationReference v
 
-- | A set of rules for generating a valuation.
data ValuationScenario = ValuationScenario
        { valScenar_ID :: Maybe Xsd.ID
        , valScenar_name :: Maybe Xsd.XsdString
          -- ^ The (optional) name for this valuation scenario, used for 
          --   understandability. For example "EOD Valuations".
        , valScenar_valuationDate :: Maybe IdentifiedDate
          -- ^ The date for which the assets are valued.
        , valScenar_marketReference :: Maybe MarketReference
          -- ^ A reference to the market environment used to price the 
          --   asset.
        , valScenar_shift :: [PricingParameterShift]
          -- ^ A collection of shifts to be applied to market inputs prior 
          --   to computation of the derivative.
        , valScenar_replacement :: [PricingInputReplacement]
          -- ^ A collection of shifts to be applied to market inputs prior 
          --   to computation of the derivative.
        }
        deriving (Eq,Show)
instance SchemaType ValuationScenario where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (ValuationScenario a0)
            `apply` optional (parseSchemaType "name")
            `apply` optional (parseSchemaType "valuationDate")
            `apply` optional (parseSchemaType "marketReference")
            `apply` many (parseSchemaType "shift")
            `apply` many (parseSchemaType "replacement")
    schemaTypeToXML s x@ValuationScenario{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ valScenar_ID x
                       ]
            [ maybe [] (schemaTypeToXML "name") $ valScenar_name x
            , maybe [] (schemaTypeToXML "valuationDate") $ valScenar_valuationDate x
            , maybe [] (schemaTypeToXML "marketReference") $ valScenar_marketReference x
            , concatMap (schemaTypeToXML "shift") $ valScenar_shift x
            , concatMap (schemaTypeToXML "replacement") $ valScenar_replacement x
            ]
 
-- | Reference to a valuation scenario.
data ValuationScenarioReference = ValuationScenarioReference
        { valScenarRef_href :: Xsd.IDREF
        }
        deriving (Eq,Show)
instance SchemaType ValuationScenarioReference where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- getAttribute "href" e pos
        commit $ interior e $ return (ValuationScenarioReference a0)
    schemaTypeToXML s x@ValuationScenarioReference{} =
        toXMLElement s [ toXMLAttribute "href" $ valScenarRef_href x
                       ]
            []
instance Extension ValuationScenarioReference Reference where
    supertype v = Reference_ValuationScenarioReference v
 
-- | A partial derivative multiplied by a weighting factor.
data WeightedPartialDerivative = WeightedPartialDerivative
        { weightPartialDeriv_partialDerivativeReference :: Maybe PricingParameterDerivativeReference
          -- ^ A reference to a partial derivative defined in the 
          --   ComputedDerivative.model, i.e. defined as part of this 
          --   sensitivity definition.
        , weightPartialDeriv_weight :: Maybe Xsd.Decimal
          -- ^ The weight factor to be applied to the partial derivative, 
          --   e.g. 1 or -1, or some other scaling value.
        }
        deriving (Eq,Show)
instance SchemaType WeightedPartialDerivative where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ interior e $ return WeightedPartialDerivative
            `apply` optional (parseSchemaType "partialDerivativeReference")
            `apply` optional (parseSchemaType "weight")
    schemaTypeToXML s x@WeightedPartialDerivative{} =
        toXMLElement s []
            [ maybe [] (schemaTypeToXML "partialDerivativeReference") $ weightPartialDeriv_partialDerivativeReference x
            , maybe [] (schemaTypeToXML "weight") $ weightPartialDeriv_weight x
            ]
 
-- | This is a global element used for creating global types. It 
--   holds Market information, e.g. curves, surfaces, quotes, 
--   etc.
elementMarket :: XMLParser Market
elementMarket = parseSchemaType "market"
elementToXMLMarket :: Market -> [Content ()]
elementToXMLMarket = schemaTypeToXML "market"
 
elementPricingStructure :: XMLParser PricingStructure
elementPricingStructure = fmap supertype elementYieldCurve -- FIXME: element is forward-declared
                          `onFail`
                          fmap supertype elementVolatilityRepresentation -- FIXME: element is forward-declared
                          `onFail`
                          fmap supertype elementFxCurve -- FIXME: element is forward-declared
                          `onFail`
                          fmap supertype elementCreditCurve -- FIXME: element is forward-declared
                          `onFail` fail "Parse failed when expecting an element in the substitution group for\n\
\    <pricingStructure>,\n\
\  namely one of:\n\
\<yieldCurve>, <volatilityRepresentation>, <fxCurve>, <creditCurve>"
elementToXMLPricingStructure :: PricingStructure -> [Content ()]
elementToXMLPricingStructure = schemaTypeToXML "pricingStructure"
 
elementPricingStructureValuation :: XMLParser PricingStructureValuation
elementPricingStructureValuation = fmap supertype elementYieldCurveValuation -- FIXME: element is forward-declared
                                   `onFail`
                                   fmap supertype elementVolatilityMatrixValuation -- FIXME: element is forward-declared
                                   `onFail`
                                   fmap supertype elementFxCurveValuation -- FIXME: element is forward-declared
                                   `onFail`
                                   fmap supertype elementCreditCurveValuation -- FIXME: element is forward-declared
                                   `onFail` fail "Parse failed when expecting an element in the substitution group for\n\
\    <pricingStructureValuation>,\n\
\  namely one of:\n\
\<yieldCurveValuation>, <volatilityMatrixValuation>, <fxCurveValuation>, <creditCurveValuation>"
elementToXMLPricingStructureValuation :: PricingStructureValuation -> [Content ()]
elementToXMLPricingStructureValuation = schemaTypeToXML "pricingStructureValuation"