{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} module Data.FpML.V53.Com ( module Data.FpML.V53.Com , module Data.FpML.V53.Shared.Option ) where import Text.XML.HaXml.Schema.Schema (SchemaType(..),SimpleType(..),Extension(..),Restricts(..)) import Text.XML.HaXml.Schema.Schema as Schema import Text.XML.HaXml.OneOfN import qualified Text.XML.HaXml.Schema.PrimitiveTypes as Xsd import Data.FpML.V53.Shared.Option -- Some hs-boot imports are required, for fwd-declaring types. -- | The acceptable tolerance in the delivered quantity of a -- physical commodity product in terms of a number of units of -- that product. data AbsoluteTolerance = AbsoluteTolerance { absToler_positive :: Maybe Xsd.Decimal -- ^ The maxmium amount by which the quantity delivered can -- exceed the agreed quantity. , absToler_negative :: Maybe Xsd.Decimal -- ^ The maximum amount by which the quantity delivered can be -- less than the agreed quantity. , absToler_unit :: Maybe QuantityUnit -- ^ The unit in which the tolerance is specified. , absToler_optionOwnerPartyReference :: Maybe PartyReference -- ^ Indicates whether the tolerance is at the seller's or -- buyer's option. } deriving (Eq,Show) instance SchemaType AbsoluteTolerance where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return AbsoluteTolerance `apply` optional (parseSchemaType "positive") `apply` optional (parseSchemaType "negative") `apply` optional (parseSchemaType "unit") `apply` optional (parseSchemaType "optionOwnerPartyReference") schemaTypeToXML s x@AbsoluteTolerance{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "positive") $ absToler_positive x , maybe [] (schemaTypeToXML "negative") $ absToler_negative x , maybe [] (schemaTypeToXML "unit") $ absToler_unit x , maybe [] (schemaTypeToXML "optionOwnerPartyReference") $ absToler_optionOwnerPartyReference x ] -- | A scheme defining where bullion is to be delivered for a -- Bullion Transaction. data BullionDeliveryLocation = BullionDeliveryLocation Scheme BullionDeliveryLocationAttributes deriving (Eq,Show) data BullionDeliveryLocationAttributes = BullionDeliveryLocationAttributes { bullionDelivLocatAttrib_bullionDeliveryLocationScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType BullionDeliveryLocation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "bullionDeliveryLocationScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ BullionDeliveryLocation v (BullionDeliveryLocationAttributes a0) schemaTypeToXML s (BullionDeliveryLocation bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "bullionDeliveryLocationScheme") $ bullionDelivLocatAttrib_bullionDeliveryLocationScheme at ] $ schemaTypeToXML s bt instance Extension BullionDeliveryLocation Scheme where supertype (BullionDeliveryLocation s _) = s -- | Physically settled leg of a physically settled Bullion -- Transaction. data BullionPhysicalLeg = BullionPhysicalLeg { bullionPhysicLeg_ID :: Maybe Xsd.ID , bullionPhysicLeg_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , bullionPhysicLeg_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , bullionPhysicLeg_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , bullionPhysicLeg_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , bullionPhysicLeg_bullionType :: Maybe BullionTypeEnum -- ^ The type of Bullion underlying a Bullion Transaction. , bullionPhysicLeg_deliveryLocation :: Maybe BullionDeliveryLocation -- ^ The physical delivery location for the transaction. , bullionPhysicLeg_choice6 :: (Maybe (OneOf2 CommodityNotionalQuantity CommodityPhysicalQuantitySchedule)) -- ^ Choice between: -- -- (1) The Quantity per Delivery Period. -- -- (2) Allows the documentation of a shaped quantity trade -- where the quantity changes over the life of the -- transaction. , bullionPhysicLeg_totalPhysicalQuantity :: UnitQuantity -- ^ The Total Quantity of the commodity to be delivered. , bullionPhysicLeg_settlementDate :: Maybe AdjustableOrRelativeDate -- ^ Date on which the bullion will settle. } deriving (Eq,Show) instance SchemaType BullionPhysicalLeg where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (BullionPhysicalLeg a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "bullionType") `apply` optional (parseSchemaType "deliveryLocation") `apply` optional (oneOf' [ ("CommodityNotionalQuantity", fmap OneOf2 (parseSchemaType "physicalQuantity")) , ("CommodityPhysicalQuantitySchedule", fmap TwoOf2 (parseSchemaType "physicalQuantitySchedule")) ]) `apply` parseSchemaType "totalPhysicalQuantity" `apply` optional (parseSchemaType "settlementDate") schemaTypeToXML s x@BullionPhysicalLeg{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ bullionPhysicLeg_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ bullionPhysicLeg_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ bullionPhysicLeg_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ bullionPhysicLeg_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ bullionPhysicLeg_receiverAccountReference x , maybe [] (schemaTypeToXML "bullionType") $ bullionPhysicLeg_bullionType x , maybe [] (schemaTypeToXML "deliveryLocation") $ bullionPhysicLeg_deliveryLocation x , maybe [] (foldOneOf2 (schemaTypeToXML "physicalQuantity") (schemaTypeToXML "physicalQuantitySchedule") ) $ bullionPhysicLeg_choice6 x , schemaTypeToXML "totalPhysicalQuantity" $ bullionPhysicLeg_totalPhysicalQuantity x , maybe [] (schemaTypeToXML "settlementDate") $ bullionPhysicLeg_settlementDate x ] instance Extension BullionPhysicalLeg PhysicalForwardLeg where supertype v = PhysicalForwardLeg_BullionPhysicalLeg v instance Extension BullionPhysicalLeg CommodityForwardLeg where supertype = (supertype :: PhysicalForwardLeg -> CommodityForwardLeg) . (supertype :: BullionPhysicalLeg -> PhysicalForwardLeg) instance Extension BullionPhysicalLeg Leg where supertype = (supertype :: CommodityForwardLeg -> Leg) . (supertype :: PhysicalForwardLeg -> CommodityForwardLeg) . (supertype :: BullionPhysicalLeg -> PhysicalForwardLeg) -- | A pointer style reference to single-day-duration -- calculation periods defined elsewhere - note that this -- schedule consists of a parameterised schedule in a -- calculationPeriodsSchedule container. data CalculationPeriodsDatesReference = CalculationPeriodsDatesReference { calcPeriodsDatesRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType CalculationPeriodsDatesReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (CalculationPeriodsDatesReference a0) schemaTypeToXML s x@CalculationPeriodsDatesReference{} = toXMLElement s [ toXMLAttribute "href" $ calcPeriodsDatesRef_href x ] [] instance Extension CalculationPeriodsDatesReference Reference where supertype v = Reference_CalculationPeriodsDatesReference v -- | A pointer style reference to a calculation periods schedule -- defined elsewhere - note that this schedule consists of a -- series of actual dates in a calculationPeriods container. data CalculationPeriodsReference = CalculationPeriodsReference { calcPeriodsRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType CalculationPeriodsReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (CalculationPeriodsReference a0) schemaTypeToXML s x@CalculationPeriodsReference{} = toXMLElement s [ toXMLAttribute "href" $ calcPeriodsRef_href x ] [] instance Extension CalculationPeriodsReference Reference where supertype v = Reference_CalculationPeriodsReference v -- | A pointer style reference to a calculation periods schedule -- defined elsewhere - note that this schedule consists of a -- parameterised schedule in a calculationPeriodsSchedule -- container. data CalculationPeriodsScheduleReference = CalculationPeriodsScheduleReference { cpsr_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType CalculationPeriodsScheduleReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (CalculationPeriodsScheduleReference a0) schemaTypeToXML s x@CalculationPeriodsScheduleReference{} = toXMLElement s [ toXMLAttribute "href" $ cpsr_href x ] [] instance Extension CalculationPeriodsScheduleReference Reference where supertype v = Reference_CalculationPeriodsScheduleReference v -- | The different options for specifying the attributes of a -- coal quality measure as a decimal value. data CoalAttributeDecimal = CoalAttributeDecimal { coalAttribDecimal_choice0 :: (Maybe (OneOf1 ((Maybe (Xsd.Decimal)),(Maybe (Xsd.Decimal))))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * The actual content of the quality characteristics -- of the Coal Product Shipment expected by the Buyer. -- -- * The actual limits of the quality characteristics of -- the Coal Product above or below which the Buyer may -- reject a Shipment. } deriving (Eq,Show) instance SchemaType CoalAttributeDecimal where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CoalAttributeDecimal `apply` optional (oneOf' [ ("Maybe Xsd.Decimal Maybe Xsd.Decimal", fmap OneOf1 (return (,) `apply` optional (parseSchemaType "standardContent") `apply` optional (parseSchemaType "rejectionLimit"))) ]) schemaTypeToXML s x@CoalAttributeDecimal{} = toXMLElement s [] [ maybe [] (foldOneOf1 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "standardContent") a , maybe [] (schemaTypeToXML "rejectionLimit") b ]) ) $ coalAttribDecimal_choice0 x ] -- | The different options for specifying the attributes of a -- coal quality measure as a percentage of the measured value. data CoalAttributePercentage = CoalAttributePercentage { coalAttribPercen_choice0 :: (Maybe (OneOf1 ((Maybe (RestrictedPercentage)),(Maybe (RestrictedPercentage))))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * The actual content of the quality characteristics -- of the Coal Product Shipment expected by the Buyer. -- -- * The actual limits of the quality characteristics of -- the Coal Product above or below which the Buyer may -- reject a Shipment. } deriving (Eq,Show) instance SchemaType CoalAttributePercentage where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CoalAttributePercentage `apply` optional (oneOf' [ ("Maybe RestrictedPercentage Maybe RestrictedPercentage", fmap OneOf1 (return (,) `apply` optional (parseSchemaType "standardContent") `apply` optional (parseSchemaType "rejectionLimit"))) ]) schemaTypeToXML s x@CoalAttributePercentage{} = toXMLElement s [] [ maybe [] (foldOneOf1 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "standardContent") a , maybe [] (schemaTypeToXML "rejectionLimit") b ]) ) $ coalAttribPercen_choice0 x ] -- | The physical delivery conditions for coal. data CoalDelivery = CoalDelivery { coalDelivery_choice0 :: OneOf2 CoalDeliveryPoint Xsd.Boolean -- ^ Choice between: -- -- (1) The point at which the Coal Product will be delivered -- and received. -- -- (2) The point at which the Coal Product as a reference to -- the Source of the Coal Product. This should be a -- reference to the source element within product. , coalDelivery_quantityVariationAdjustment :: Maybe Xsd.Boolean -- ^ If true, indicates that QVA is applicable. If false, -- indicates that QVA is inapplicable. , coalDelivery_transportationEquipment :: Maybe CoalTransportationEquipment -- ^ The transportation equipment with which the Coal Product -- will be delivered and received. , coalDelivery_risk :: Maybe CommodityDeliveryRisk -- ^ Specifies how the risk associated with the delivery is -- assigned. } deriving (Eq,Show) instance SchemaType CoalDelivery where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CoalDelivery `apply` oneOf' [ ("CoalDeliveryPoint", fmap OneOf2 (parseSchemaType "deliveryPoint")) , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "deliveryAtSource")) ] `apply` optional (parseSchemaType "quantityVariationAdjustment") `apply` optional (parseSchemaType "transportationEquipment") `apply` optional (parseSchemaType "risk") schemaTypeToXML s x@CoalDelivery{} = toXMLElement s [] [ foldOneOf2 (schemaTypeToXML "deliveryPoint") (schemaTypeToXML "deliveryAtSource") $ coalDelivery_choice0 x , maybe [] (schemaTypeToXML "quantityVariationAdjustment") $ coalDelivery_quantityVariationAdjustment x , maybe [] (schemaTypeToXML "transportationEquipment") $ coalDelivery_transportationEquipment x , maybe [] (schemaTypeToXML "risk") $ coalDelivery_risk x ] -- | A scheme identifying the types of the Delivery Point for a -- physically settled coal trade. data CoalDeliveryPoint = CoalDeliveryPoint Scheme CoalDeliveryPointAttributes deriving (Eq,Show) data CoalDeliveryPointAttributes = CoalDeliveryPointAttributes { coalDelivPointAttrib_deliveryPointScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CoalDeliveryPoint where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "deliveryPointScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CoalDeliveryPoint v (CoalDeliveryPointAttributes a0) schemaTypeToXML s (CoalDeliveryPoint bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "deliveryPointScheme") $ coalDelivPointAttrib_deliveryPointScheme at ] $ schemaTypeToXML s bt instance Extension CoalDeliveryPoint Scheme where supertype (CoalDeliveryPoint s _) = s -- | Physically settled leg of a physically settled coal -- transaction. data CoalPhysicalLeg = CoalPhysicalLeg { coalPhysicLeg_ID :: Maybe Xsd.ID , coalPhysicLeg_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , coalPhysicLeg_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , coalPhysicLeg_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , coalPhysicLeg_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , coalPhysicLeg_deliveryPeriods :: Maybe CommodityDeliveryPeriods -- ^ The period during which delivery/deliveries of Coal -- Products may be scheduled. Equivalent to Nomination -- Period(s) for US Coal. , coalPhysicLeg_coal :: CoalProduct -- ^ The specification of the Coal Product to be delivered. , coalPhysicLeg_deliveryConditions :: CoalDelivery -- ^ The physical delivery conditions for the transaction. , coalPhysicLeg_deliveryQuantity :: CommodityPhysicalQuantity -- ^ The different options for specifying the quantity. } deriving (Eq,Show) instance SchemaType CoalPhysicalLeg where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CoalPhysicalLeg a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "deliveryPeriods") `apply` parseSchemaType "coal" `apply` parseSchemaType "deliveryConditions" `apply` parseSchemaType "deliveryQuantity" schemaTypeToXML s x@CoalPhysicalLeg{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ coalPhysicLeg_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ coalPhysicLeg_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ coalPhysicLeg_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ coalPhysicLeg_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ coalPhysicLeg_receiverAccountReference x , maybe [] (schemaTypeToXML "deliveryPeriods") $ coalPhysicLeg_deliveryPeriods x , schemaTypeToXML "coal" $ coalPhysicLeg_coal x , schemaTypeToXML "deliveryConditions" $ coalPhysicLeg_deliveryConditions x , schemaTypeToXML "deliveryQuantity" $ coalPhysicLeg_deliveryQuantity x ] instance Extension CoalPhysicalLeg PhysicalSwapLeg where supertype v = PhysicalSwapLeg_CoalPhysicalLeg v instance Extension CoalPhysicalLeg CommoditySwapLeg where supertype = (supertype :: PhysicalSwapLeg -> CommoditySwapLeg) . (supertype :: CoalPhysicalLeg -> PhysicalSwapLeg) instance Extension CoalPhysicalLeg Leg where supertype = (supertype :: CommoditySwapLeg -> Leg) . (supertype :: PhysicalSwapLeg -> CommoditySwapLeg) . (supertype :: CoalPhysicalLeg -> PhysicalSwapLeg) -- | A type defining the characteristics of the coal being -- traded in a physically settled gas transaction. data CoalProduct = CoalProduct { coalProduct_choice0 :: OneOf2 CoalProductType CoalProductSpecifications -- ^ Choice between: -- -- (1) The type of coal product to be delivered by reference -- to a pre-defined specification. -- -- (2) The type of coal product to be delivered specified in -- full. , coalProduct_source :: [CoalProductSource] -- ^ The mining region, mine(s), mining complex(es), loadout(s) -- or river dock(s) or other point(s) of origin that Seller -- and Buyer agree are acceptable origins for the Coal -- Product. For International Coal transactions, this is the -- Origin of the Coal Product. , coalProduct_btuQualityAdjustment :: Maybe CoalQualityAdjustments -- ^ The Quality Adjustment formula to be used where the Actual -- Shipment BTU/Lb value differs from the Standard BTU/Lb -- value. , coalProduct_so2QualityAdjustment :: Maybe CoalQualityAdjustments -- ^ The Quality Adjustment formula to be used where the Actual -- Shipment SO2/MMBTU value differs from the Standard -- SO2/MMBTU value. } deriving (Eq,Show) instance SchemaType CoalProduct where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CoalProduct `apply` oneOf' [ ("CoalProductType", fmap OneOf2 (parseSchemaType "type")) , ("CoalProductSpecifications", fmap TwoOf2 (parseSchemaType "coalProductSpecifications")) ] `apply` many (parseSchemaType "source") `apply` optional (parseSchemaType "btuQualityAdjustment") `apply` optional (parseSchemaType "so2QualityAdjustment") schemaTypeToXML s x@CoalProduct{} = toXMLElement s [] [ foldOneOf2 (schemaTypeToXML "type") (schemaTypeToXML "coalProductSpecifications") $ coalProduct_choice0 x , concatMap (schemaTypeToXML "source") $ coalProduct_source x , maybe [] (schemaTypeToXML "btuQualityAdjustment") $ coalProduct_btuQualityAdjustment x , maybe [] (schemaTypeToXML "so2QualityAdjustment") $ coalProduct_so2QualityAdjustment x ] -- | A scheme identifying the sources of coal for a physically -- settled coal trade. data CoalProductSource = CoalProductSource Scheme CoalProductSourceAttributes deriving (Eq,Show) data CoalProductSourceAttributes = CoalProductSourceAttributes { coalProductSourceAttrib_commodityCoalProductSourceScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CoalProductSource where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityCoalProductSourceScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CoalProductSource v (CoalProductSourceAttributes a0) schemaTypeToXML s (CoalProductSource bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityCoalProductSourceScheme") $ coalProductSourceAttrib_commodityCoalProductSourceScheme at ] $ schemaTypeToXML s bt instance Extension CoalProductSource Scheme where supertype (CoalProductSource s _) = s -- | The different options for specifying the quality attributes -- of the coal to be delivered. data CoalProductSpecifications = CoalProductSpecifications { coalProductSpecif_choice0 :: (Maybe (OneOf2 CoalStandardQuality CoalStandardQualitySchedule)) -- ^ Choice between: -- -- (1) standardQuality -- -- (2) standardQualitySchedule } deriving (Eq,Show) instance SchemaType CoalProductSpecifications where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CoalProductSpecifications `apply` optional (oneOf' [ ("CoalStandardQuality", fmap OneOf2 (parseSchemaType "standardQuality")) , ("CoalStandardQualitySchedule", fmap TwoOf2 (parseSchemaType "standardQualitySchedule")) ]) schemaTypeToXML s x@CoalProductSpecifications{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "standardQuality") (schemaTypeToXML "standardQualitySchedule") ) $ coalProductSpecif_choice0 x ] -- | A scheme identifying the types of coal for a physically -- settled coal trade. data CoalProductType = CoalProductType Scheme CoalProductTypeAttributes deriving (Eq,Show) data CoalProductTypeAttributes = CoalProductTypeAttributes { coalProductTypeAttrib_commodityCoalProductTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CoalProductType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityCoalProductTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CoalProductType v (CoalProductTypeAttributes a0) schemaTypeToXML s (CoalProductType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityCoalProductTypeScheme") $ coalProductTypeAttrib_commodityCoalProductTypeScheme at ] $ schemaTypeToXML s bt instance Extension CoalProductType Scheme where supertype (CoalProductType s _) = s -- | A scheme identifying the quality adjustment formulae for a -- physically settled coal trade. data CoalQualityAdjustments = CoalQualityAdjustments Scheme CoalQualityAdjustmentsAttributes deriving (Eq,Show) data CoalQualityAdjustmentsAttributes = CoalQualityAdjustmentsAttributes { coalQualityAdjustAttrib_commodityCoalQualityAdjustmentsScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CoalQualityAdjustments where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityCoalQualityAdjustmentsScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CoalQualityAdjustments v (CoalQualityAdjustmentsAttributes a0) schemaTypeToXML s (CoalQualityAdjustments bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityCoalQualityAdjustmentsScheme") $ coalQualityAdjustAttrib_commodityCoalQualityAdjustmentsScheme at ] $ schemaTypeToXML s bt instance Extension CoalQualityAdjustments Scheme where supertype (CoalQualityAdjustments s _) = s -- | The quality attributes of the coal to be delivered. data CoalStandardQuality = CoalStandardQuality { coalStdQuality_moisture :: Maybe CoalAttributePercentage -- ^ The moisture content of the coal product. , coalStdQuality_ash :: Maybe CoalAttributePercentage -- ^ The ash content of the coal product. , coalStdQuality_sulfur :: Maybe CoalAttributePercentage -- ^ The sulfur/sulphur content of the coal product. , coalStdQuality_sO2 :: Maybe CoalAttributePercentage -- ^ The sulfur/sulphur dioxide content of the coal product. , coalStdQuality_volatile :: Maybe CoalAttributePercentage -- ^ The volatile content of the coal product. , coalStdQuality_bTUperLB :: Maybe CoalAttributeDecimal -- ^ The number of British Thermal Units per Pound of the coal -- product. , coalStdQuality_topSize :: Maybe CoalAttributeDecimal -- ^ The smallest sieve opening that will result in less than 5% -- of a sample of the coal product remaining. , coalStdQuality_finesPassingScreen :: Maybe CoalAttributeDecimal , coalStdQuality_grindability :: Maybe CoalAttributeDecimal -- ^ The Hardgrove Grindability Index value of the coal to be -- delivered. , coalStdQuality_ashFusionTemperature :: Maybe CoalAttributeDecimal -- ^ The temperature at which the ash form of the coal product -- fuses completely in accordance with the ASTM International -- D1857 Standard Test Methodology. , coalStdQuality_initialDeformation :: Maybe CoalAttributeDecimal -- ^ The temperature at which an ash cone shows evidence of -- deformation. , coalStdQuality_softeningHeightWidth :: Maybe CoalAttributeDecimal -- ^ The temperature at which the height of an ash cone equals -- its width. (Softening temperature). , coalStdQuality_softeningHeightHalfWidth :: Maybe CoalAttributeDecimal -- ^ The temperature at which the height of an ash cone equals -- half its width. (Hemisphere temperature). , coalStdQuality_fluid :: Maybe CoalAttributeDecimal -- ^ The temperature at which the ash cone flattens. } deriving (Eq,Show) instance SchemaType CoalStandardQuality where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CoalStandardQuality `apply` optional (parseSchemaType "moisture") `apply` optional (parseSchemaType "ash") `apply` optional (parseSchemaType "sulfur") `apply` optional (parseSchemaType "SO2") `apply` optional (parseSchemaType "volatile") `apply` optional (parseSchemaType "BTUperLB") `apply` optional (parseSchemaType "topSize") `apply` optional (parseSchemaType "finesPassingScreen") `apply` optional (parseSchemaType "grindability") `apply` optional (parseSchemaType "ashFusionTemperature") `apply` optional (parseSchemaType "initialDeformation") `apply` optional (parseSchemaType "softeningHeightWidth") `apply` optional (parseSchemaType "softeningHeightHalfWidth") `apply` optional (parseSchemaType "fluid") schemaTypeToXML s x@CoalStandardQuality{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "moisture") $ coalStdQuality_moisture x , maybe [] (schemaTypeToXML "ash") $ coalStdQuality_ash x , maybe [] (schemaTypeToXML "sulfur") $ coalStdQuality_sulfur x , maybe [] (schemaTypeToXML "SO2") $ coalStdQuality_sO2 x , maybe [] (schemaTypeToXML "volatile") $ coalStdQuality_volatile x , maybe [] (schemaTypeToXML "BTUperLB") $ coalStdQuality_bTUperLB x , maybe [] (schemaTypeToXML "topSize") $ coalStdQuality_topSize x , maybe [] (schemaTypeToXML "finesPassingScreen") $ coalStdQuality_finesPassingScreen x , maybe [] (schemaTypeToXML "grindability") $ coalStdQuality_grindability x , maybe [] (schemaTypeToXML "ashFusionTemperature") $ coalStdQuality_ashFusionTemperature x , maybe [] (schemaTypeToXML "initialDeformation") $ coalStdQuality_initialDeformation x , maybe [] (schemaTypeToXML "softeningHeightWidth") $ coalStdQuality_softeningHeightWidth x , maybe [] (schemaTypeToXML "softeningHeightHalfWidth") $ coalStdQuality_softeningHeightHalfWidth x , maybe [] (schemaTypeToXML "fluid") $ coalStdQuality_fluid x ] -- | The quality attributes of the coal to be delivered, -- specified on a periodic basis. data CoalStandardQualitySchedule = CoalStandardQualitySchedule { coalStdQualitySched_standardQualityStep :: [CoalStandardQuality] , coalStdQualitySched_choice1 :: (Maybe (OneOf2 CalculationPeriodsReference CalculationPeriodsScheduleReference)) -- ^ Choice between: -- -- (1) A pointer style reference to the Delivery Periods -- defined elsewhere. -- -- (2) A pointer style reference to the Calculation Periods -- Schedule defined elsewhere. } deriving (Eq,Show) instance SchemaType CoalStandardQualitySchedule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CoalStandardQualitySchedule `apply` many (parseSchemaType "StandardQualityStep") `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf2 (parseSchemaType "deliveryPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf2 (parseSchemaType "deliveryPeriodsScheduleReference")) ]) schemaTypeToXML s x@CoalStandardQualitySchedule{} = toXMLElement s [] [ concatMap (schemaTypeToXML "StandardQualityStep") $ coalStdQualitySched_standardQualityStep x , maybe [] (foldOneOf2 (schemaTypeToXML "deliveryPeriodsReference") (schemaTypeToXML "deliveryPeriodsScheduleReference") ) $ coalStdQualitySched_choice1 x ] -- | A scheme identifying the methods by which coal may be -- transported. data CoalTransportationEquipment = CoalTransportationEquipment Scheme CoalTransportationEquipmentAttributes deriving (Eq,Show) data CoalTransportationEquipmentAttributes = CoalTransportationEquipmentAttributes { ctea_commodityCoalTransportationEquipmentScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CoalTransportationEquipment where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityCoalTransportationEquipmentScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CoalTransportationEquipment v (CoalTransportationEquipmentAttributes a0) schemaTypeToXML s (CoalTransportationEquipment bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityCoalTransportationEquipmentScheme") $ ctea_commodityCoalTransportationEquipmentScheme at ] $ schemaTypeToXML s bt instance Extension CoalTransportationEquipment Scheme where supertype (CoalTransportationEquipment s _) = s -- | A type for defining exercise procedures associated with an -- American style exercise of a commodity option. data CommodityAmericanExercise = CommodityAmericanExercise { commodAmericExerc_ID :: Maybe Xsd.ID , commodAmericExerc_exercisePeriod :: [CommodityExercisePeriods] -- ^ Describes the American exercise periods. , commodAmericExerc_exerciseFrequency :: Maybe Frequency -- ^ The exercise frequency for the strip. , commodAmericExerc_choice2 :: (Maybe (OneOf2 BusinessCenterTime DeterminationMethod)) -- ^ Choice between latest exercise time expressed as literal -- time, or using a determination method. -- -- Choice between: -- -- (1) For a Bermuda or American style option, the latest time -- on an exercise business day (excluding the expiration -- date) within the exercise period that notice can be -- given by the buyer to the seller or seller's agent. -- Notice of exercise given after this time will be deemed -- to have been given on the next exercise business day. -- -- (2) Latest exercise time determination method. , commodAmericExerc_expirationTime :: Maybe BusinessCenterTime -- ^ The specific time of day on which the option expires. , commodAmericExerc_multipleExercise :: Maybe CommodityMultipleExercise -- ^ The presence of this element indicates that the option may -- be partially exercised. It is not applicable to European or -- Asian options. } deriving (Eq,Show) instance SchemaType CommodityAmericanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityAmericanExercise a0) `apply` many (parseSchemaType "exercisePeriod") `apply` optional (parseSchemaType "exerciseFrequency") `apply` optional (oneOf' [ ("BusinessCenterTime", fmap OneOf2 (parseSchemaType "latestExerciseTime")) , ("DeterminationMethod", fmap TwoOf2 (parseSchemaType "latestExerciseTimeDetermination")) ]) `apply` optional (parseSchemaType "expirationTime") `apply` optional (parseSchemaType "multipleExercise") schemaTypeToXML s x@CommodityAmericanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodAmericExerc_ID x ] [ concatMap (schemaTypeToXML "exercisePeriod") $ commodAmericExerc_exercisePeriod x , maybe [] (schemaTypeToXML "exerciseFrequency") $ commodAmericExerc_exerciseFrequency x , maybe [] (foldOneOf2 (schemaTypeToXML "latestExerciseTime") (schemaTypeToXML "latestExerciseTimeDetermination") ) $ commodAmericExerc_choice2 x , maybe [] (schemaTypeToXML "expirationTime") $ commodAmericExerc_expirationTime x , maybe [] (schemaTypeToXML "multipleExercise") $ commodAmericExerc_multipleExercise x ] instance Extension CommodityAmericanExercise Exercise where supertype v = Exercise_CommodityAmericanExercise v -- | A parametric representation of the Calculation Periods for -- on Asian option or a leg of a swap. In case the calculation -- frequency is of value T (term), the period is defined by -- the commoditySwap\effectiveDate and the -- commoditySwap\terminationDate. data CommodityCalculationPeriodsSchedule = CommodityCalculationPeriodsSchedule { ccps_ID :: Maybe Xsd.ID , ccps_periodMultiplier :: Maybe Xsd.PositiveInteger -- ^ A time period multiplier, e.g. 1, 2 or 3 etc. If the period -- value is T (Term) then periodMultiplier must contain the -- value 1. , ccps_period :: Maybe PeriodExtendedEnum -- ^ A time period, e.g. a day, week, month, year or term of the -- stream. , ccps_balanceOfFirstPeriod :: Maybe Xsd.Boolean -- ^ If true, indicates that that the first Calculation Period -- should run from the Effective Date to the end of the -- calendar period in which the Effective Date falls, e.g. Jan -- 15 - Jan 31 if the calculation periods are one month long -- and Effective Date is Jan 15. If false, the first -- Calculation Period should run from the Effective Date for -- one whole period, e.g. Jan 15 to Feb 14 if the calculation -- periods are one month long and Effective Date is Jan 15. } deriving (Eq,Show) instance SchemaType CommodityCalculationPeriodsSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityCalculationPeriodsSchedule a0) `apply` optional (parseSchemaType "periodMultiplier") `apply` optional (parseSchemaType "period") `apply` optional (parseSchemaType "balanceOfFirstPeriod") schemaTypeToXML s x@CommodityCalculationPeriodsSchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ ccps_ID x ] [ maybe [] (schemaTypeToXML "periodMultiplier") $ ccps_periodMultiplier x , maybe [] (schemaTypeToXML "period") $ ccps_period x , maybe [] (schemaTypeToXML "balanceOfFirstPeriod") $ ccps_balanceOfFirstPeriod x ] instance Extension CommodityCalculationPeriodsSchedule Frequency where supertype (CommodityCalculationPeriodsSchedule a0 e0 e1 e2) = Frequency a0 e0 e1 -- | The different options for specifying the Delivery Periods -- of a physical leg. data CommodityDeliveryPeriods = CommodityDeliveryPeriods { commodDelivPeriods_ID :: Maybe Xsd.ID , commodDelivPeriods_choice0 :: OneOf3 AdjustableDates CommodityCalculationPeriodsSchedule ((Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))) -- ^ Choice between: -- -- (1) The Delivery Periods for this leg of the swap. This -- type is only intended to be used if the Delivery -- Periods differ from the Calculation Periods on the -- fixed or floating leg. If DeliveryPeriods mirror -- another leg, then the calculationPeriodsReference -- element should be used to point to the Calculation -- Periods on that leg - or the -- calculationPeriodsScheduleReference can be used to -- point to the Calculation Periods Schedule for that leg. -- -- (2) The Delivery Periods for this leg of the swap. This -- type is only intended to be used if the Delivery -- Periods differ from the Calculation Periods on the -- fixed or floating leg. If DeliveryPeriods mirror -- another leg, then the calculationPeriodsReference -- element should be used to point to the Calculation -- Periods on that leg - or the -- calculationPeriodsScheduleReference can be used to -- point to the Calculation Periods Schedule for that leg. -- -- (3) unknown } deriving (Eq,Show) instance SchemaType CommodityDeliveryPeriods where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityDeliveryPeriods a0) `apply` oneOf' [ ("AdjustableDates", fmap OneOf3 (parseSchemaType "periods")) , ("CommodityCalculationPeriodsSchedule", fmap TwoOf3 (parseSchemaType "periodsSchedule")) , ("(Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))", fmap ThreeOf3 (optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]))) ] schemaTypeToXML s x@CommodityDeliveryPeriods{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodDelivPeriods_ID x ] [ foldOneOf3 (schemaTypeToXML "periods") (schemaTypeToXML "periodsSchedule") (maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") )) $ commodDelivPeriods_choice0 x ] -- | A scheme identifying the types of the Delivery Point for a -- physically settled commodity trade. data CommodityDeliveryPoint = CommodityDeliveryPoint Scheme CommodityDeliveryPointAttributes deriving (Eq,Show) data CommodityDeliveryPointAttributes = CommodityDeliveryPointAttributes { commodDelivPointAttrib_deliveryPointScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityDeliveryPoint where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "deliveryPointScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityDeliveryPoint v (CommodityDeliveryPointAttributes a0) schemaTypeToXML s (CommodityDeliveryPoint bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "deliveryPointScheme") $ commodDelivPointAttrib_deliveryPointScheme at ] $ schemaTypeToXML s bt instance Extension CommodityDeliveryPoint Scheme where supertype (CommodityDeliveryPoint s _) = s -- | A scheme identifying how the parties to the trade aportion -- responsibility for the delivery of the commodity product -- (for example Free On Board, Cost, Insurance, Freight) data CommodityDeliveryRisk = CommodityDeliveryRisk Scheme CommodityDeliveryRiskAttributes deriving (Eq,Show) data CommodityDeliveryRiskAttributes = CommodityDeliveryRiskAttributes { commodDelivRiskAttrib_deliveryRiskScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityDeliveryRisk where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "deliveryRiskScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityDeliveryRisk v (CommodityDeliveryRiskAttributes a0) schemaTypeToXML s (CommodityDeliveryRisk bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "deliveryRiskScheme") $ commodDelivRiskAttrib_deliveryRiskScheme at ] $ schemaTypeToXML s bt instance Extension CommodityDeliveryRisk Scheme where supertype (CommodityDeliveryRisk s _) = s -- | A type for defining exercise procedures associated with a -- European style exercise of a commodity option. data CommodityEuropeanExercise = CommodityEuropeanExercise { commodEuropExerc_ID :: Maybe Xsd.ID , commodEuropExerc_expirationDate :: [AdjustableOrRelativeDate] -- ^ The last day within an exercise period for an American -- style option. For a European style option it is the only -- day within the exercise period. For an averaging option -- this is equivalent to the Termination Date. , commodEuropExerc_exerciseFrequency :: Maybe Frequency -- ^ The exercise frequency for the strip. , commodEuropExerc_expirationTime :: Maybe BusinessCenterTime -- ^ The specific time of day on which the option expires. } deriving (Eq,Show) instance SchemaType CommodityEuropeanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityEuropeanExercise a0) `apply` many (parseSchemaType "expirationDate") `apply` optional (parseSchemaType "exerciseFrequency") `apply` optional (parseSchemaType "expirationTime") schemaTypeToXML s x@CommodityEuropeanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodEuropExerc_ID x ] [ concatMap (schemaTypeToXML "expirationDate") $ commodEuropExerc_expirationDate x , maybe [] (schemaTypeToXML "exerciseFrequency") $ commodEuropExerc_exerciseFrequency x , maybe [] (schemaTypeToXML "expirationTime") $ commodEuropExerc_expirationTime x ] instance Extension CommodityEuropeanExercise Exercise where supertype v = Exercise_CommodityEuropeanExercise v -- | The parameters for defining how the commodity option can be -- exercised, how it is priced and how it is settled. data CommodityExercise = CommodityExercise { commodExerc_choice0 :: (Maybe (OneOf2 CommodityAmericanExercise CommodityEuropeanExercise)) -- ^ Choice between: -- -- (1) The parameters for defining the exercise period for an -- American style option together with the rules governing -- the quantity of the commodity that can be exercised on -- any given exercise date. -- -- (2) The parameters for defining the expiration date and -- time for a European or Asian style option. For an Asian -- style option the expiration date is equivalent to the -- termination date. , commodExerc_automaticExercise :: Maybe Xsd.Boolean -- ^ Specifies whether or not Automatic Exercise applies to a -- Commodity Option Transaction. , commodExerc_writtenConfirmation :: Maybe Xsd.Boolean -- ^ Specifies whether or not Written Confirmation applies to a -- Commodity Option Transaction. , commodExerc_settlementCurrency :: Maybe IdentifiedCurrency -- ^ The currency into which the Commodity Option Transaction -- will settle. If this is not the same as the currency in -- which the Commodity Reference Price is quoted, then an FX -- determination method should also be specified. , commodExerc_fx :: Maybe CommodityFx -- ^ FX observations to be used to convert the observed -- Commodity Reference Price to the Settlement Currency. , commodExerc_conversionFactor :: Maybe Xsd.Decimal -- ^ If the Notional Quantity is specified in a unit that does -- not match the unit in which the Commodity Reference Price -- is quoted, the scaling or conversion factor used to convert -- the Commodity Reference Price unit into the Notional -- Quantity unit should be stated here. If there is no -- conversion, this element is not intended to be used. , commodExerc_choice6 :: OneOf2 CommodityRelativePaymentDates ((Maybe (OneOf2 AdjustableDatesOrRelativeDateOffset Xsd.Boolean))) -- ^ Choice between: -- -- (1) The Payment Dates of the trade relative to the -- Calculation Periods. -- -- (2) unknown } deriving (Eq,Show) instance SchemaType CommodityExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommodityExercise `apply` optional (oneOf' [ ("CommodityAmericanExercise", fmap OneOf2 (parseSchemaType "americanExercise")) , ("CommodityEuropeanExercise", fmap TwoOf2 (parseSchemaType "europeanExercise")) ]) `apply` optional (parseSchemaType "automaticExercise") `apply` optional (parseSchemaType "writtenConfirmation") `apply` optional (parseSchemaType "settlementCurrency") `apply` optional (parseSchemaType "fx") `apply` optional (parseSchemaType "conversionFactor") `apply` oneOf' [ ("CommodityRelativePaymentDates", fmap OneOf2 (parseSchemaType "relativePaymentDates")) , ("(Maybe (OneOf2 AdjustableDatesOrRelativeDateOffset Xsd.Boolean))", fmap TwoOf2 (optional (oneOf' [ ("AdjustableDatesOrRelativeDateOffset", fmap OneOf2 (parseSchemaType "paymentDates")) , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "masterAgreementPaymentDates")) ]))) ] schemaTypeToXML s x@CommodityExercise{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "americanExercise") (schemaTypeToXML "europeanExercise") ) $ commodExerc_choice0 x , maybe [] (schemaTypeToXML "automaticExercise") $ commodExerc_automaticExercise x , maybe [] (schemaTypeToXML "writtenConfirmation") $ commodExerc_writtenConfirmation x , maybe [] (schemaTypeToXML "settlementCurrency") $ commodExerc_settlementCurrency x , maybe [] (schemaTypeToXML "fx") $ commodExerc_fx x , maybe [] (schemaTypeToXML "conversionFactor") $ commodExerc_conversionFactor x , foldOneOf2 (schemaTypeToXML "relativePaymentDates") (maybe [] (foldOneOf2 (schemaTypeToXML "paymentDates") (schemaTypeToXML "masterAgreementPaymentDates") )) $ commodExerc_choice6 x ] data CommodityExercisePeriods = CommodityExercisePeriods { commodExercPeriods_commencementDate :: Maybe AdjustableOrRelativeDate -- ^ The first day of the exercise period for an American style -- option. , commodExercPeriods_expirationDate :: Maybe AdjustableOrRelativeDate -- ^ The last day within an exercise period for an American -- style option. For a European style option it is the only -- day within the exercise period. } deriving (Eq,Show) instance SchemaType CommodityExercisePeriods where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommodityExercisePeriods `apply` optional (parseSchemaType "commencementDate") `apply` optional (parseSchemaType "expirationDate") schemaTypeToXML s x@CommodityExercisePeriods{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "commencementDate") $ commodExercPeriods_commencementDate x , maybe [] (schemaTypeToXML "expirationDate") $ commodExercPeriods_expirationDate x ] -- | A scheme identifying the physical event relative to which -- option expiration occurs. data CommodityExpireRelativeToEvent = CommodityExpireRelativeToEvent Scheme CommodityExpireRelativeToEventAttributes deriving (Eq,Show) data CommodityExpireRelativeToEventAttributes = CommodityExpireRelativeToEventAttributes { certea_commodityExpireRelativeToEventScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityExpireRelativeToEvent where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityExpireRelativeToEventScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityExpireRelativeToEvent v (CommodityExpireRelativeToEventAttributes a0) schemaTypeToXML s (CommodityExpireRelativeToEvent bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityExpireRelativeToEventScheme") $ certea_commodityExpireRelativeToEventScheme at ] $ schemaTypeToXML s bt instance Extension CommodityExpireRelativeToEvent Scheme where supertype (CommodityExpireRelativeToEvent s _) = s -- | Commodity Forward data CommodityForward = CommodityForward { commodForward_ID :: Maybe Xsd.ID , commodForward_primaryAssetClass :: Maybe AssetClass -- ^ A classification of the most important risk class of the -- trade. FpML defines a simple asset class categorization -- using a coding scheme. , commodForward_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , commodForward_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , commodForward_productId :: [ProductId] -- ^ A product reference identifier. The product ID is an -- identifier that describes the key economic characteristics -- of the trade type, with the exception of concepts such as -- size (notional, quantity, number of units) and price (fixed -- rate, strike, etc.) that are negotiated for each -- transaction. It can be used to hold identifiers such as the -- "UPI" (universal product identifier) required by certain -- regulatory reporting rules. It can also be used to hold -- identifiers of benchmark products or product temnplates -- used by certain trading systems or facilities. FpML does -- not define the domain values associated with this element. -- Note that the domain values for this element are not -- strictly an enumerated list. , commodForward_valueDate :: Maybe AdjustableOrRelativeDate -- ^ Specifies the value date of the Commodity Forward -- Transaction. This is the day on which both the cash and the -- physical commodity settle. , commodForward_fixedLeg :: Maybe NonPeriodicFixedPriceLeg -- ^ The fixed leg of a Commodity Forward Transaction , commodityForward_leg :: Maybe CommodityForwardLeg -- ^ Defines the substitutable commodity forward leg , commodForward_commonPricing :: Maybe Xsd.Boolean -- ^ Common pricing may be relevant for a Transaction that -- references more than one Commodity Reference Price. If -- Common Pricing is not specified as applicable, it will be -- deemed not to apply. , commodForward_marketDisruption :: Maybe CommodityMarketDisruption -- ^ Market disruption events as defined in the ISDA 1993 -- Commodity Definitions or in ISDA 2005 Commodity -- Definitions, as applicable. , commodForward_settlementDisruption :: Maybe CommodityBullionSettlementDisruptionEnum -- ^ The consequences of Bullion Settlement Disruption Events. , commodForward_rounding :: Maybe Rounding -- ^ Rounding direction and precision for amounts. } deriving (Eq,Show) instance SchemaType CommodityForward where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityForward a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` optional (parseSchemaType "valueDate") `apply` optional (parseSchemaType "fixedLeg") `apply` optional (elementCommodityForwardLeg) `apply` optional (parseSchemaType "commonPricing") `apply` optional (parseSchemaType "marketDisruption") `apply` optional (parseSchemaType "settlementDisruption") `apply` optional (parseSchemaType "rounding") schemaTypeToXML s x@CommodityForward{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodForward_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ commodForward_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ commodForward_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ commodForward_productType x , concatMap (schemaTypeToXML "productId") $ commodForward_productId x , maybe [] (schemaTypeToXML "valueDate") $ commodForward_valueDate x , maybe [] (schemaTypeToXML "fixedLeg") $ commodForward_fixedLeg x , maybe [] (elementToXMLCommodityForwardLeg) $ commodityForward_leg x , maybe [] (schemaTypeToXML "commonPricing") $ commodForward_commonPricing x , maybe [] (schemaTypeToXML "marketDisruption") $ commodForward_marketDisruption x , maybe [] (schemaTypeToXML "settlementDisruption") $ commodForward_settlementDisruption x , maybe [] (schemaTypeToXML "rounding") $ commodForward_rounding x ] instance Extension CommodityForward Product where supertype v = Product_CommodityForward v -- | The Fixed Price for a given Calculation Period during the -- life of the trade. There must be a Fixed Price step -- specified for each Calculation Period, regardless of -- whether the Fixed Price changes or remains the same between -- periods. data CommodityFixedPriceSchedule = CommodityFixedPriceSchedule { commodFixedPriceSched_choice0 :: (Maybe (OneOf4 [FixedPrice] [Xsd.Decimal] [NonNegativeMoney] [CommoditySettlementPeriodsPriceSchedule])) -- ^ Choice between: -- -- (1) The Fixed Price for a given Calculation Period during -- the life of the trade. There must be a Fixed Price step -- specified for each Calculation Period, regardless of -- whether the Fixed Price changes or remains the same -- between periods. -- -- (2) For a Wet Voyager Charter Freight Swap, the number of -- Worldscale Points for purposes of the calculation of a -- Fixed Amount for a given Calculation Period during the -- life of the trade. There must be Worldscale Rate Step -- specified for each Calculation Period, regardless of -- whether the Worldscale Rate Step changes or remains the -- same between periods. -- -- (3) For a DRY Voyage Charter or Time Charter Freight Swap, -- the price per relevant unit for pruposes of the -- calculation of a Fixed Amount for a given Calculation -- Period during the life of the trade. There must be -- Worldscale Rate Step specified for each Calculation -- Period, regardless of whether the Worldscale Rate Step -- changes or remains the same between periods. -- -- (4) For an electricity transaction, the fixed price -- schedule for one or more groups of Settlement Periods -- on which fixed payments are based. if the schedule -- differs for different groups of Settlement Periods, -- this element should be repeated. , commodFixedPriceSched_choice1 :: (Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference)) -- ^ Choice between: -- -- (1) A pointer style reference to the Calculation Periods -- defined on another leg. -- -- (2) A pointer style reference to the Calculation Periods -- Schedule defined on another leg. -- -- (3) A pointer style reference to single-day-duration -- Calculation Periods defined on another leg. } deriving (Eq,Show) instance SchemaType CommodityFixedPriceSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommodityFixedPriceSchedule `apply` optional (oneOf' [ ("[FixedPrice]", fmap OneOf4 (many1 (parseSchemaType "fixedPriceStep"))) , ("[Xsd.Decimal]", fmap TwoOf4 (many1 (parseSchemaType "worldscaleRateStep"))) , ("[NonNegativeMoney]", fmap ThreeOf4 (many1 (parseSchemaType "contractRateStep"))) , ("[CommoditySettlementPeriodsPriceSchedule]", fmap FourOf4 (many1 (parseSchemaType "settlementPeriodsPriceSchedule"))) ]) `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]) schemaTypeToXML s x@CommodityFixedPriceSchedule{} = toXMLElement s [] [ maybe [] (foldOneOf4 (concatMap (schemaTypeToXML "fixedPriceStep")) (concatMap (schemaTypeToXML "worldscaleRateStep")) (concatMap (schemaTypeToXML "contractRateStep")) (concatMap (schemaTypeToXML "settlementPeriodsPriceSchedule")) ) $ commodFixedPriceSched_choice0 x , maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") ) $ commodFixedPriceSched_choice1 x ] -- | Abstract base class for all commodity forward legs data CommodityForwardLeg = CommodityForwardLeg_PhysicalForwardLeg PhysicalForwardLeg deriving (Eq,Show) instance SchemaType CommodityForwardLeg where parseSchemaType s = do (fmap CommodityForwardLeg_PhysicalForwardLeg $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of CommodityForwardLeg,\n\ \ namely one of:\n\ \PhysicalForwardLeg" schemaTypeToXML _s (CommodityForwardLeg_PhysicalForwardLeg x) = schemaTypeToXML "physicalForwardLeg" x instance Extension CommodityForwardLeg Leg where supertype v = Leg_CommodityForwardLeg v -- | Frequency Type for use in Pricing Date specifications. data CommodityFrequencyType = CommodityFrequencyType Scheme CommodityFrequencyTypeAttributes deriving (Eq,Show) data CommodityFrequencyTypeAttributes = CommodityFrequencyTypeAttributes { commodFrequTypeAttrib_commodityFrequencyTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityFrequencyType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityFrequencyTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityFrequencyType v (CommodityFrequencyTypeAttributes a0) schemaTypeToXML s (CommodityFrequencyType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityFrequencyTypeScheme") $ commodFrequTypeAttrib_commodityFrequencyTypeScheme at ] $ schemaTypeToXML s bt instance Extension CommodityFrequencyType Scheme where supertype (CommodityFrequencyType s _) = s -- | A type defining the FX observations to be used to convert -- the observed Commodity Reference Price to the Settlement -- Currency. The rate source must be specified. Additionally, -- a time for the spot price to be observed on that source may -- be specified, or else an averaging schedule for trades -- priced using an average FX rate. data CommodityFx = CommodityFx { commodityFx_primaryRateSource :: Maybe InformationSource -- ^ The primary source for where the rate observation will -- occur. Will typically be either a page or a reference bank -- published rate. , commodityFx_secondaryRateSource :: Maybe InformationSource -- ^ An alternative, or secondary, source for where the rate -- observation will occur. Will typically be either a page or -- a reference bank published rate. , commodityFx_fxType :: Maybe CommodityFxType -- ^ A type to identify how the FX rate will be applied. This is -- intended to differentiate between the various methods for -- applying FX to the floating price such as a daily -- calculation, or averaging the FX and applying the average -- at the end of each CalculationPeriod. , commodityFx_averagingMethod :: Maybe AveragingMethodEnum -- ^ The parties may specify a Method of Averaging when -- averaging of the FX rate is applicable. , commodityFx_choice4 :: OneOf2 [AdjustableDates] ((Maybe (CommodityDayTypeEnum)),((Maybe (OneOf2 ((Maybe (CommodityFrequencyType)),(Maybe (Xsd.PositiveInteger))) ([DayOfWeekEnum],(Maybe (Xsd.Integer)))))),((Maybe (OneOf2 Lag LagReference))),((Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference)))) -- ^ Choice between: -- -- (1) A list of the fx observation dates for a given -- Calculation Period. -- -- (2) Sequence of: -- -- * The type of day on which pricing occurs. -- -- * unknown -- -- * unknown -- -- * unknown , commodityFx_fixingTime :: Maybe BusinessCenterTime -- ^ The time at which the spot currency exchange rate will be -- observed. It is specified as a time in a specific business -- center, e.g. 11:00am London time. } deriving (Eq,Show) instance SchemaType CommodityFx where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommodityFx `apply` optional (parseSchemaType "primaryRateSource") `apply` optional (parseSchemaType "secondaryRateSource") `apply` optional (parseSchemaType "fxType") `apply` optional (parseSchemaType "averagingMethod") `apply` oneOf' [ ("[AdjustableDates]", fmap OneOf2 (many1 (parseSchemaType "fxObservationDates"))) , ("Maybe CommodityDayTypeEnum (Maybe (OneOf2 ((Maybe (CommodityFrequencyType)),(Maybe (Xsd.PositiveInteger))) ([DayOfWeekEnum],(Maybe (Xsd.Integer))))) (Maybe (OneOf2 Lag LagReference)) (Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))", fmap TwoOf2 (return (,,,) `apply` optional (parseSchemaType "dayType") `apply` optional (oneOf' [ ("Maybe CommodityFrequencyType Maybe Xsd.PositiveInteger", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "dayDistribution") `apply` optional (parseSchemaType "dayCount"))) , ("[DayOfWeekEnum] Maybe Xsd.Integer", fmap TwoOf2 (return (,) `apply` between (Occurs (Just 0) (Just 7)) (parseSchemaType "dayOfWeek") `apply` optional (parseSchemaType "dayNumber"))) ]) `apply` optional (oneOf' [ ("Lag", fmap OneOf2 (parseSchemaType "lag")) , ("LagReference", fmap TwoOf2 (parseSchemaType "lagReference")) ]) `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]))) ] `apply` optional (parseSchemaType "fixingTime") schemaTypeToXML s x@CommodityFx{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "primaryRateSource") $ commodityFx_primaryRateSource x , maybe [] (schemaTypeToXML "secondaryRateSource") $ commodityFx_secondaryRateSource x , maybe [] (schemaTypeToXML "fxType") $ commodityFx_fxType x , maybe [] (schemaTypeToXML "averagingMethod") $ commodityFx_averagingMethod x , foldOneOf2 (concatMap (schemaTypeToXML "fxObservationDates")) (\ (a,b,c,d) -> concat [ maybe [] (schemaTypeToXML "dayType") a , maybe [] (foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "dayDistribution") a , maybe [] (schemaTypeToXML "dayCount") b ]) (\ (a,b) -> concat [ concatMap (schemaTypeToXML "dayOfWeek") a , maybe [] (schemaTypeToXML "dayNumber") b ]) ) b , maybe [] (foldOneOf2 (schemaTypeToXML "lag") (schemaTypeToXML "lagReference") ) c , maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") ) d ]) $ commodityFx_choice4 x , maybe [] (schemaTypeToXML "fixingTime") $ commodityFx_fixingTime x ] -- | Identifes how the FX rate will be applied. This is intended -- to differentiate between the various methods for applying -- FX to the floating price such as a daily calculation, or -- averaging the FX and applying the average at the end of -- each CalculationPeriod. data CommodityFxType = CommodityFxType Scheme CommodityFxTypeAttributes deriving (Eq,Show) data CommodityFxTypeAttributes = CommodityFxTypeAttributes { commodFxTypeAttrib_commodityFxTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityFxType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityFxTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityFxType v (CommodityFxTypeAttributes a0) schemaTypeToXML s (CommodityFxType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityFxTypeScheme") $ commodFxTypeAttrib_commodityFxTypeScheme at ] $ schemaTypeToXML s bt instance Extension CommodityFxType Scheme where supertype (CommodityFxType s _) = s -- | A type defining a hub or other reference for a physically -- settled commodity trade. data CommodityHub = CommodityHub { commodityHub_partyReference :: PartyReference -- ^ Reference to a party. , commodityHub_accountReference :: Maybe AccountReference -- ^ Reference to an account. , commodityHub_hubCode :: Maybe CommodityHubCode } deriving (Eq,Show) instance SchemaType CommodityHub where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommodityHub `apply` parseSchemaType "partyReference" `apply` optional (parseSchemaType "accountReference") `apply` optional (parseSchemaType "hubCode") schemaTypeToXML s x@CommodityHub{} = toXMLElement s [] [ schemaTypeToXML "partyReference" $ commodityHub_partyReference x , maybe [] (schemaTypeToXML "accountReference") $ commodityHub_accountReference x , maybe [] (schemaTypeToXML "hubCode") $ commodityHub_hubCode x ] -- | A scheme identifying the code for a hub or other reference -- for a physically settled commodity trade. data CommodityHubCode = CommodityHubCode Scheme CommodityHubCodeAttributes deriving (Eq,Show) data CommodityHubCodeAttributes = CommodityHubCodeAttributes { commodHubCodeAttrib_hubCodeScheme :: Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityHubCode where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- getAttribute "hubCodeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityHubCode v (CommodityHubCodeAttributes a0) schemaTypeToXML s (CommodityHubCode bt at) = addXMLAttributes [ toXMLAttribute "hubCodeScheme" $ commodHubCodeAttrib_hubCodeScheme at ] $ schemaTypeToXML s bt instance Extension CommodityHubCode Scheme where supertype (CommodityHubCode s _) = s -- | ISDA 1993 or 2005 commodity market disruption elements. data CommodityMarketDisruption = CommodityMarketDisruption { commodMarketDisrup_choice0 :: (Maybe (OneOf2 ((Maybe (MarketDisruptionEventsEnum)),[MarketDisruptionEvent]) [MarketDisruptionEvent])) -- ^ Choice between: -- -- (1) Sequence of: -- -- * If Market disruption Events are stated to be -- Applicable then the default Market Disruption -- Events of Section 7.4(d)(i) of the ISDA Commodity -- Definitions shall apply unless specific Market -- Disruption Events are stated hereunder, in which -- case these shall override the ISDA defaults. If -- Market Disruption Events are stated to be Not -- Applicable, Market Disruption Events are not -- applicable to the trade at all. It is also possible -- to reference the Market Disruption Events set out -- in the relevant Master Agreement governing the -- trade. -- -- * To be used when marketDisruptionEvents is set to -- "Applicable" and additional market disruption -- events(s) apply to the default market disruption -- events of Section 7.4(d)(i) of the ISDA Commodity -- Definitions. -- -- (2) Market disruption event(s) that apply. Note that these -- should only be specified if the default market -- disruption events of Section 7.4(d)(i) of the ISDA -- Commodity Definitions are to be overridden. , commodMarketDisrup_choice1 :: (Maybe (OneOf2 DisruptionFallbacksEnum [SequencedDisruptionFallback])) -- ^ If omitted then the standard disruption fallbacks of -- Section 7.5(d)(i) of the ISDA Commodity Definitions shall -- apply. -- -- Choice between: -- -- (1) To be used where disruption fallbacks are set out in -- the relevant Master Agreement governing the trade. -- -- (2) disruptionFallback , commodMarketDisrup_fallbackReferencePrice :: Maybe Underlyer -- ^ A fallback commodity reference price for use when relying -- on Disruption Fallbacks in Section 7.5(d)(i) of the ISDA -- Commodity Definitions or have selected "Fallback Reference -- Price" as a disruptionFallback. , commodMarketDisrup_maximumNumberOfDaysOfDisruption :: Maybe Xsd.NonNegativeInteger -- ^ 2005 Commodity Definitions only. If omitted , the number of -- days specified in Section 7.6(a) of the Definitions will -- apply. , commodMarketDisrup_priceMaterialityPercentage :: Maybe Xsd.Decimal -- ^ 2005 Commodity Definitions only. To be used where a price -- materiality percentage applies to the "Price Source -- Disruption" event and this event has been specified by -- setting marketDisruption to true or including it in -- additionalMarketDisruptionEvent , commodMarketDisrup_minimumFuturesContracts :: Maybe Xsd.PositiveInteger -- ^ 1993 Commodity Definitions only. Specifies the Mimum -- Futures Contracts level that dictates whether or not a "De -- Minimis Trading" event has occurred. Only relevant if 'De -- Minimis Trading' has been specified in -- marketDisruptionEvent or additionalMarketDisruptionEvent. } deriving (Eq,Show) instance SchemaType CommodityMarketDisruption where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommodityMarketDisruption `apply` optional (oneOf' [ ("Maybe MarketDisruptionEventsEnum [MarketDisruptionEvent]", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "marketDisruptionEvents") `apply` many (parseSchemaType "additionalMarketDisruptionEvent"))) , ("[MarketDisruptionEvent]", fmap TwoOf2 (many1 (parseSchemaType "marketDisruptionEvent"))) ]) `apply` optional (oneOf' [ ("DisruptionFallbacksEnum", fmap OneOf2 (parseSchemaType "disruptionFallbacks")) , ("[SequencedDisruptionFallback]", fmap TwoOf2 (many1 (parseSchemaType "disruptionFallback"))) ]) `apply` optional (parseSchemaType "fallbackReferencePrice") `apply` optional (parseSchemaType "maximumNumberOfDaysOfDisruption") `apply` optional (parseSchemaType "priceMaterialityPercentage") `apply` optional (parseSchemaType "minimumFuturesContracts") schemaTypeToXML s x@CommodityMarketDisruption{} = toXMLElement s [] [ maybe [] (foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "marketDisruptionEvents") a , concatMap (schemaTypeToXML "additionalMarketDisruptionEvent") b ]) (concatMap (schemaTypeToXML "marketDisruptionEvent")) ) $ commodMarketDisrup_choice0 x , maybe [] (foldOneOf2 (schemaTypeToXML "disruptionFallbacks") (concatMap (schemaTypeToXML "disruptionFallback")) ) $ commodMarketDisrup_choice1 x , maybe [] (schemaTypeToXML "fallbackReferencePrice") $ commodMarketDisrup_fallbackReferencePrice x , maybe [] (schemaTypeToXML "maximumNumberOfDaysOfDisruption") $ commodMarketDisrup_maximumNumberOfDaysOfDisruption x , maybe [] (schemaTypeToXML "priceMaterialityPercentage") $ commodMarketDisrup_priceMaterialityPercentage x , maybe [] (schemaTypeToXML "minimumFuturesContracts") $ commodMarketDisrup_minimumFuturesContracts x ] -- | A type for defining the multiple exercise provisions of an -- American style commodity option. data CommodityMultipleExercise = CommodityMultipleExercise { commodMultiExerc_integralMultipleQuantity :: Maybe CommodityNotionalQuantity -- ^ The integral multiple quantity defines a lower limit of the -- Notional Quantity that can be exercised and also defines a -- unit multiple of the Notional Quantity that can be -- exercised, i.e. only integer multiples of this Notional -- Quantity can be exercised. , commodMultiExerc_minimumNotionalQuantity :: Maybe CommodityNotionalQuantity -- ^ The minimum Notional Quantity that can be exercised on a -- given Exercise Date. See multipleExercise. } deriving (Eq,Show) instance SchemaType CommodityMultipleExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommodityMultipleExercise `apply` optional (parseSchemaType "integralMultipleQuantity") `apply` optional (parseSchemaType "minimumNotionalQuantity") schemaTypeToXML s x@CommodityMultipleExercise{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "integralMultipleQuantity") $ commodMultiExerc_integralMultipleQuantity x , maybe [] (schemaTypeToXML "minimumNotionalQuantity") $ commodMultiExerc_minimumNotionalQuantity x ] -- | Commodity Notional. data CommodityNotionalQuantity = CommodityNotionalQuantity { commodNotionQuant_ID :: Maybe Xsd.ID , commodNotionQuant_quantityUnit :: QuantityUnit -- ^ Quantity Unit is the unit of measure applicable for the -- quantity on the Transaction. , commodNotionQuant_quantityFrequency :: Maybe CommodityQuantityFrequency -- ^ The frequency at which the Notional Quantity is deemed to -- apply for purposes of calculating the Total Notional -- Quantity. , commodNotionQuant_quantity :: Maybe Xsd.Decimal -- ^ Amount of commodity per quantity frequency. } deriving (Eq,Show) instance SchemaType CommodityNotionalQuantity where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityNotionalQuantity a0) `apply` parseSchemaType "quantityUnit" `apply` optional (parseSchemaType "quantityFrequency") `apply` optional (parseSchemaType "quantity") schemaTypeToXML s x@CommodityNotionalQuantity{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodNotionQuant_ID x ] [ schemaTypeToXML "quantityUnit" $ commodNotionQuant_quantityUnit x , maybe [] (schemaTypeToXML "quantityFrequency") $ commodNotionQuant_quantityFrequency x , maybe [] (schemaTypeToXML "quantity") $ commodNotionQuant_quantity x ] -- | The Notional Quantity per Calculation Period. There must be -- a Notional Quantity step specified for each Calculation -- Period, regardless of whether the Notional Quantity changes -- or remains the same between periods. data CommodityNotionalQuantitySchedule = CommodityNotionalQuantitySchedule { commodNotionQuantSched_ID :: Maybe Xsd.ID , commodNotionQuantSched_choice0 :: (Maybe (OneOf2 [CommodityNotionalQuantity] [CommoditySettlementPeriodsNotionalQuantitySchedule])) -- ^ Choice between: -- -- (1) The Notional Quantity per Calculation Period. There -- must be a Notional Quantity specified for each -- Calculation Period, regardless of whether the quantity -- changes or remains the same between periods. -- -- (2) For an electricity transaction, the Notional Quantity -- schedule for a one or more groups of Settlement Periods -- to which the Notional Quantity is based. If the -- schedule differs for different groups of Settlement -- Periods, this element should be repeated. , commodNotionQuantSched_choice1 :: (Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference)) -- ^ Choice between: -- -- (1) A pointer style reference to the Calculation Periods -- defined on another leg. -- -- (2) A pointer style reference to the Calculation Periods -- Schedule defined on another leg. -- -- (3) A pointer style reference to single-day-duration -- Calculation Periods defined on another leg. } deriving (Eq,Show) instance SchemaType CommodityNotionalQuantitySchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityNotionalQuantitySchedule a0) `apply` optional (oneOf' [ ("[CommodityNotionalQuantity]", fmap OneOf2 (many1 (parseSchemaType "notionalStep"))) , ("[CommoditySettlementPeriodsNotionalQuantitySchedule]", fmap TwoOf2 (many1 (parseSchemaType "settlementPeriodsNotionalQuantitySchedule"))) ]) `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]) schemaTypeToXML s x@CommodityNotionalQuantitySchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodNotionQuantSched_ID x ] [ maybe [] (foldOneOf2 (concatMap (schemaTypeToXML "notionalStep")) (concatMap (schemaTypeToXML "settlementPeriodsNotionalQuantitySchedule")) ) $ commodNotionQuantSched_choice0 x , maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") ) $ commodNotionQuantSched_choice1 x ] -- | Commodity Option. data CommodityOption = CommodityOption { commodOption_ID :: Maybe Xsd.ID , commodOption_primaryAssetClass :: Maybe AssetClass -- ^ A classification of the most important risk class of the -- trade. FpML defines a simple asset class categorization -- using a coding scheme. , commodOption_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , commodOption_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , commodOption_productId :: [ProductId] -- ^ A product reference identifier. The product ID is an -- identifier that describes the key economic characteristics -- of the trade type, with the exception of concepts such as -- size (notional, quantity, number of units) and price (fixed -- rate, strike, etc.) that are negotiated for each -- transaction. It can be used to hold identifiers such as the -- "UPI" (universal product identifier) required by certain -- regulatory reporting rules. It can also be used to hold -- identifiers of benchmark products or product temnplates -- used by certain trading systems or facilities. FpML does -- not define the domain values associated with this element. -- Note that the domain values for this element are not -- strictly an enumerated list. , commodOption_buyerPartyReference :: Maybe PartyReference -- ^ A reference to the party that buys this instrument, ie. -- pays for this instrument and receives the rights defined by -- it. See 2000 ISDA definitions Article 11.1 (b). In the case -- of FRAs this the fixed rate payer. , commodOption_buyerAccountReference :: Maybe AccountReference -- ^ A reference to the account that buys this instrument. , commodOption_sellerPartyReference :: Maybe PartyReference -- ^ A reference to the party that sells ("writes") this -- instrument, i.e. that grants the rights defined by this -- instrument and in return receives a payment for it. See -- 2000 ISDA definitions Article 11.1 (a). In the case of FRAs -- this is the floating rate payer. , commodOption_sellerAccountReference :: Maybe AccountReference -- ^ A reference to the account that sells this instrument. , commodOption_optionType :: Maybe PutCallEnum -- ^ The type of option transaction. , commodOption_choice9 :: OneOf2 ((Maybe (Commodity)),(Maybe (AdjustableOrRelativeDate)),((Maybe (OneOf2 CommodityCalculationPeriodsSchedule AdjustableDates))),(Maybe (CommodityPricingDates)),(Maybe (AveragingMethodEnum)),(OneOf2 ((OneOf3 CommodityNotionalQuantitySchedule CommodityNotionalQuantity [CommoditySettlementPeriodsNotionalQuantity]),Xsd.Decimal) QuantityReference),(Maybe (CommodityExercise)),(OneOf2 NonNegativeMoney CommodityStrikeSchedule)) (((Maybe (OneOf2 CommoditySwap CommodityForward))),(Maybe (CommodityPhysicalExercise))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * Specifies the underlying component. At the time of -- the initial schema design, only underlyers of type -- Commodity are supported; the choice group in the -- future could offer the possibility of adding other -- types later. -- -- * The effective date of the Commodity Option -- Transaction. Note that the Termination/Expiration -- Date should be specified in expirationDate within -- the CommodityAmericanExercise type or the -- CommodityEuropeanExercise type, as applicable. -- -- * unknown -- -- * The dates on which the option will price. -- -- * The Method of Averaging if there is more than one -- Pricing Date. -- -- * unknown -- -- * The parameters for defining how the commodity -- option can be exercised and how it is settled. -- -- * unknown -- -- (2) Sequence of: -- -- * unknown -- -- * The parameters for defining how the commodity -- option can be exercised into a physical -- transaction. , commodOption_premium :: [CommodityPremium] -- ^ The option premium payable by the buyer to the seller. , commodOption_commonPricing :: Maybe Xsd.Boolean -- ^ Common pricing may be relevant for a Transaction that -- references more than one Commodity Reference Price. If -- Common Pricing is not specified as applicable, it will be -- deemed not to apply. , commodOption_marketDisruption :: Maybe CommodityMarketDisruption -- ^ Market disruption events as defined in the ISDA 1993 -- Commodity Definitions or in ISDA 2005 Commodity -- Definitions, as applicable. , commodOption_settlementDisruption :: Maybe CommodityBullionSettlementDisruptionEnum -- ^ The consequences of Bullion Settlement Disruption Events. , commodOption_rounding :: Maybe Rounding -- ^ Rounding direction and precision for amounts. } deriving (Eq,Show) instance SchemaType CommodityOption where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityOption a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` optional (parseSchemaType "buyerPartyReference") `apply` optional (parseSchemaType "buyerAccountReference") `apply` optional (parseSchemaType "sellerPartyReference") `apply` optional (parseSchemaType "sellerAccountReference") `apply` optional (parseSchemaType "optionType") `apply` oneOf' [ ("Maybe Commodity Maybe AdjustableOrRelativeDate (Maybe (OneOf2 CommodityCalculationPeriodsSchedule AdjustableDates)) Maybe CommodityPricingDates Maybe AveragingMethodEnum OneOf2 ((OneOf3 CommodityNotionalQuantitySchedule CommodityNotionalQuantity [CommoditySettlementPeriodsNotionalQuantity]),Xsd.Decimal) QuantityReference Maybe CommodityExercise OneOf2 NonNegativeMoney CommodityStrikeSchedule", fmap OneOf2 (return (,,,,,,,) `apply` optional (parseSchemaType "commodity") `apply` optional (parseSchemaType "effectiveDate") `apply` optional (oneOf' [ ("CommodityCalculationPeriodsSchedule", fmap OneOf2 (parseSchemaType "calculationPeriodsSchedule")) , ("AdjustableDates", fmap TwoOf2 (parseSchemaType "calculationPeriods")) ]) `apply` optional (parseSchemaType "pricingDates") `apply` optional (parseSchemaType "averagingMethod") `apply` oneOf' [ ("OneOf3 CommodityNotionalQuantitySchedule CommodityNotionalQuantity [CommoditySettlementPeriodsNotionalQuantity] Xsd.Decimal", fmap OneOf2 (return (,) `apply` oneOf' [ ("CommodityNotionalQuantitySchedule", fmap OneOf3 (parseSchemaType "notionalQuantitySchedule")) , ("CommodityNotionalQuantity", fmap TwoOf3 (parseSchemaType "notionalQuantity")) , ("[CommoditySettlementPeriodsNotionalQuantity]", fmap ThreeOf3 (many1 (parseSchemaType "settlementPeriodsNotionalQuantity"))) ] `apply` parseSchemaType "totalNotionalQuantity")) , ("QuantityReference", fmap TwoOf2 (parseSchemaType "quantityReference")) ] `apply` optional (parseSchemaType "exercise") `apply` oneOf' [ ("NonNegativeMoney", fmap OneOf2 (parseSchemaType "strikePricePerUnit")) , ("CommodityStrikeSchedule", fmap TwoOf2 (parseSchemaType "strikePricePerUnitSchedule")) ])) , ("(Maybe (OneOf2 CommoditySwap CommodityForward)) Maybe CommodityPhysicalExercise", fmap TwoOf2 (return (,) `apply` optional (oneOf' [ ("CommoditySwap", fmap OneOf2 (elementCommoditySwap)) , ("CommodityForward", fmap TwoOf2 (elementCommodityForward)) ]) `apply` optional (parseSchemaType "physicalExercise"))) ] `apply` many (parseSchemaType "premium") `apply` optional (parseSchemaType "commonPricing") `apply` optional (parseSchemaType "marketDisruption") `apply` optional (parseSchemaType "settlementDisruption") `apply` optional (parseSchemaType "rounding") schemaTypeToXML s x@CommodityOption{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodOption_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ commodOption_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ commodOption_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ commodOption_productType x , concatMap (schemaTypeToXML "productId") $ commodOption_productId x , maybe [] (schemaTypeToXML "buyerPartyReference") $ commodOption_buyerPartyReference x , maybe [] (schemaTypeToXML "buyerAccountReference") $ commodOption_buyerAccountReference x , maybe [] (schemaTypeToXML "sellerPartyReference") $ commodOption_sellerPartyReference x , maybe [] (schemaTypeToXML "sellerAccountReference") $ commodOption_sellerAccountReference x , maybe [] (schemaTypeToXML "optionType") $ commodOption_optionType x , foldOneOf2 (\ (a,b,c,d,e,f,g,h) -> concat [ maybe [] (schemaTypeToXML "commodity") a , maybe [] (schemaTypeToXML "effectiveDate") b , maybe [] (foldOneOf2 (schemaTypeToXML "calculationPeriodsSchedule") (schemaTypeToXML "calculationPeriods") ) c , maybe [] (schemaTypeToXML "pricingDates") d , maybe [] (schemaTypeToXML "averagingMethod") e , foldOneOf2 (\ (a,b) -> concat [ foldOneOf3 (schemaTypeToXML "notionalQuantitySchedule") (schemaTypeToXML "notionalQuantity") (concatMap (schemaTypeToXML "settlementPeriodsNotionalQuantity")) a , schemaTypeToXML "totalNotionalQuantity" b ]) (schemaTypeToXML "quantityReference") f , maybe [] (schemaTypeToXML "exercise") g , foldOneOf2 (schemaTypeToXML "strikePricePerUnit") (schemaTypeToXML "strikePricePerUnitSchedule") h ]) (\ (a,b) -> concat [ maybe [] (foldOneOf2 (elementToXMLCommoditySwap) (elementToXMLCommodityForward) ) a , maybe [] (schemaTypeToXML "physicalExercise") b ]) $ commodOption_choice9 x , concatMap (schemaTypeToXML "premium") $ commodOption_premium x , maybe [] (schemaTypeToXML "commonPricing") $ commodOption_commonPricing x , maybe [] (schemaTypeToXML "marketDisruption") $ commodOption_marketDisruption x , maybe [] (schemaTypeToXML "settlementDisruption") $ commodOption_settlementDisruption x , maybe [] (schemaTypeToXML "rounding") $ commodOption_rounding x ] instance Extension CommodityOption Product where supertype v = Product_CommodityOption v -- | A scheme identifying the physical event relative to which -- payment occurs. data CommodityPayRelativeToEvent = CommodityPayRelativeToEvent Scheme CommodityPayRelativeToEventAttributes deriving (Eq,Show) data CommodityPayRelativeToEventAttributes = CommodityPayRelativeToEventAttributes { cprtea_commodityPayRelativeToEventScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityPayRelativeToEvent where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityPayRelativeToEventScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityPayRelativeToEvent v (CommodityPayRelativeToEventAttributes a0) schemaTypeToXML s (CommodityPayRelativeToEvent bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityPayRelativeToEventScheme") $ cprtea_commodityPayRelativeToEventScheme at ] $ schemaTypeToXML s bt instance Extension CommodityPayRelativeToEvent Scheme where supertype (CommodityPayRelativeToEvent s _) = s -- | The parameters for defining the expiration date(s) and -- time(s) for an American style option. data CommodityPhysicalAmericanExercise = CommodityPhysicalAmericanExercise { commodPhysicAmericExerc_ID :: Maybe Xsd.ID , commodPhysicAmericExerc_choice0 :: (Maybe (OneOf2 ((Maybe (AdjustableOrRelativeDates)),(Maybe (AdjustableOrRelativeDates))) ((Maybe (CommodityRelativeExpirationDates)),(Maybe (CommodityRelativeExpirationDates))))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * The first day(s) of the exercise period(s) for an -- American-style option. -- -- * The Expiration Date(s) of an American-style option. -- -- (2) Sequence of: -- -- * The first day(s) of the exercise period(s) for an -- American-style option where it is relative to the -- occurrence of an external event. -- -- * The Expiration Date(s) of an American-style option -- where it is relative to the occurrence of an -- external event. , commodPhysicAmericExerc_latestExerciseTime :: Maybe PrevailingTime -- ^ For a Bermuda or American style option, the latest time on -- an exercise business day (excluding the expiration date) -- within the exercise period that notice can be given by the -- buyer to the seller or seller's agent. Notice of exercise -- given after this time will be deemed to have been given on -- the next exercise business day. , commodPhysicAmericExerc_expirationTime :: Maybe PrevailingTime -- ^ The specific time of day at which the option expires. } deriving (Eq,Show) instance SchemaType CommodityPhysicalAmericanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityPhysicalAmericanExercise a0) `apply` optional (oneOf' [ ("Maybe AdjustableOrRelativeDates Maybe AdjustableOrRelativeDates", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "commencementDates") `apply` optional (parseSchemaType "expirationDates"))) , ("Maybe CommodityRelativeExpirationDates Maybe CommodityRelativeExpirationDates", fmap TwoOf2 (return (,) `apply` optional (parseSchemaType "relativeCommencementDates") `apply` optional (parseSchemaType "relativeExpirationDates"))) ]) `apply` optional (parseSchemaType "latestExerciseTime") `apply` optional (parseSchemaType "expirationTime") schemaTypeToXML s x@CommodityPhysicalAmericanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodPhysicAmericExerc_ID x ] [ maybe [] (foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "commencementDates") a , maybe [] (schemaTypeToXML "expirationDates") b ]) (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "relativeCommencementDates") a , maybe [] (schemaTypeToXML "relativeExpirationDates") b ]) ) $ commodPhysicAmericExerc_choice0 x , maybe [] (schemaTypeToXML "latestExerciseTime") $ commodPhysicAmericExerc_latestExerciseTime x , maybe [] (schemaTypeToXML "expirationTime") $ commodPhysicAmericExerc_expirationTime x ] instance Extension CommodityPhysicalAmericanExercise Exercise where supertype v = Exercise_CommodityPhysicalAmericanExercise v -- | The parameters for defining the expiration date(s) and -- time(s) for a European style option. data CommodityPhysicalEuropeanExercise = CommodityPhysicalEuropeanExercise { commodPhysicEuropExerc_ID :: Maybe Xsd.ID , commodPhysicEuropExerc_choice0 :: (Maybe (OneOf3 AdjustableOrRelativeDate AdjustableRelativeOrPeriodicDates2 CommodityRelativeExpirationDates)) -- ^ Choice between: -- -- (1) The Expiration Date of a single expiry European-style -- option or the first Expiration Date of a multiple -- expiry or daily expiring option. -- -- (2) The Expiration Date(s) of a European-style option. -- -- (3) The Expiration Date(s) of a European-style option where -- it is relative to the occurrence of an external event. , commodPhysicEuropExerc_expirationTime :: Maybe PrevailingTime -- ^ The specific time of day at which the option expires. } deriving (Eq,Show) instance SchemaType CommodityPhysicalEuropeanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityPhysicalEuropeanExercise a0) `apply` optional (oneOf' [ ("AdjustableOrRelativeDate", fmap OneOf3 (parseSchemaType "expirationDate")) , ("AdjustableRelativeOrPeriodicDates2", fmap TwoOf3 (parseSchemaType "expirationDates")) , ("CommodityRelativeExpirationDates", fmap ThreeOf3 (parseSchemaType "relativeExpirationDates")) ]) `apply` optional (parseSchemaType "expirationTime") schemaTypeToXML s x@CommodityPhysicalEuropeanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodPhysicEuropExerc_ID x ] [ maybe [] (foldOneOf3 (schemaTypeToXML "expirationDate") (schemaTypeToXML "expirationDates") (schemaTypeToXML "relativeExpirationDates") ) $ commodPhysicEuropExerc_choice0 x , maybe [] (schemaTypeToXML "expirationTime") $ commodPhysicEuropExerc_expirationTime x ] instance Extension CommodityPhysicalEuropeanExercise Exercise where supertype v = Exercise_CommodityPhysicalEuropeanExercise v -- | The parameters for defining how the physically-settled -- commodity option can be exercised and how it is settled. data CommodityPhysicalExercise = CommodityPhysicalExercise { commodPhysicExerc_choice0 :: (Maybe (OneOf2 CommodityPhysicalAmericanExercise CommodityPhysicalEuropeanExercise)) -- ^ Choice between: -- -- (1) The parameters for defining the expiration date(s) and -- time(s) for an American style option. -- -- (2) The parameters for defining the expiration date(s) and -- time(s) for a European style option. , commodPhysicExerc_automaticExercise :: Maybe Xsd.Boolean -- ^ Specifies whether or not Automatic Exercise applies to a -- Commodity Option Transaction. , commodPhysicExerc_writtenConfirmation :: Maybe Xsd.Boolean -- ^ Specifies whether or not Written Confirmation applies to a -- Commodity Option Transaction. } deriving (Eq,Show) instance SchemaType CommodityPhysicalExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommodityPhysicalExercise `apply` optional (oneOf' [ ("CommodityPhysicalAmericanExercise", fmap OneOf2 (parseSchemaType "americanExercise")) , ("CommodityPhysicalEuropeanExercise", fmap TwoOf2 (parseSchemaType "europeanExercise")) ]) `apply` optional (parseSchemaType "automaticExercise") `apply` optional (parseSchemaType "writtenConfirmation") schemaTypeToXML s x@CommodityPhysicalExercise{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "americanExercise") (schemaTypeToXML "europeanExercise") ) $ commodPhysicExerc_choice0 x , maybe [] (schemaTypeToXML "automaticExercise") $ commodPhysicExerc_automaticExercise x , maybe [] (schemaTypeToXML "writtenConfirmation") $ commodPhysicExerc_writtenConfirmation x ] -- | A type defining the physical quantity of the commodity to -- be delivered. data CommodityPhysicalQuantity = CommodityPhysicalQuantity { commodPhysicQuant_ID :: Maybe Xsd.ID , commodPhysicQuant_choice0 :: (Maybe (OneOf2 CommodityNotionalQuantity CommodityPhysicalQuantitySchedule)) -- ^ Choice between: -- -- (1) The Quantity per Delivery Period. -- -- (2) Allows the documentation of a shaped quantity trade -- where the quantity changes over the life of the -- transaction. , commodPhysicQuant_totalPhysicalQuantity :: UnitQuantity -- ^ The Total Quantity of the commodity to be delivered. } deriving (Eq,Show) instance SchemaType CommodityPhysicalQuantity where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityPhysicalQuantity a0) `apply` optional (oneOf' [ ("CommodityNotionalQuantity", fmap OneOf2 (parseSchemaType "physicalQuantity")) , ("CommodityPhysicalQuantitySchedule", fmap TwoOf2 (parseSchemaType "physicalQuantitySchedule")) ]) `apply` parseSchemaType "totalPhysicalQuantity" schemaTypeToXML s x@CommodityPhysicalQuantity{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodPhysicQuant_ID x ] [ maybe [] (foldOneOf2 (schemaTypeToXML "physicalQuantity") (schemaTypeToXML "physicalQuantitySchedule") ) $ commodPhysicQuant_choice0 x , schemaTypeToXML "totalPhysicalQuantity" $ commodPhysicQuant_totalPhysicalQuantity x ] instance Extension CommodityPhysicalQuantity CommodityPhysicalQuantityBase where supertype v = CommodityPhysicalQuantityBase_CommodityPhysicalQuantity v -- | An abstract base class for physical quantity types. data CommodityPhysicalQuantityBase = CommodityPhysicalQuantityBase_GasPhysicalQuantity GasPhysicalQuantity | CommodityPhysicalQuantityBase_ElectricityPhysicalQuantity ElectricityPhysicalQuantity | CommodityPhysicalQuantityBase_CommodityPhysicalQuantity CommodityPhysicalQuantity deriving (Eq,Show) instance SchemaType CommodityPhysicalQuantityBase where parseSchemaType s = do (fmap CommodityPhysicalQuantityBase_GasPhysicalQuantity $ parseSchemaType s) `onFail` (fmap CommodityPhysicalQuantityBase_ElectricityPhysicalQuantity $ parseSchemaType s) `onFail` (fmap CommodityPhysicalQuantityBase_CommodityPhysicalQuantity $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of CommodityPhysicalQuantityBase,\n\ \ namely one of:\n\ \GasPhysicalQuantity,ElectricityPhysicalQuantity,CommodityPhysicalQuantity" schemaTypeToXML _s (CommodityPhysicalQuantityBase_GasPhysicalQuantity x) = schemaTypeToXML "gasPhysicalQuantity" x schemaTypeToXML _s (CommodityPhysicalQuantityBase_ElectricityPhysicalQuantity x) = schemaTypeToXML "electricityPhysicalQuantity" x schemaTypeToXML _s (CommodityPhysicalQuantityBase_CommodityPhysicalQuantity x) = schemaTypeToXML "commodityPhysicalQuantity" x -- | The Quantity per Delivery Period. There must be a Quantity -- step specified for each Delivery Period, regardless of -- whether the Quantity changes or remains the same between -- periods. data CommodityPhysicalQuantitySchedule = CommodityPhysicalQuantitySchedule { commodPhysicQuantSched_ID :: Maybe Xsd.ID , commodPhysicQuantSched_quantityStep :: [CommodityNotionalQuantity] -- ^ The quantity per Calculation Period. There must be a -- quantity specified for each Calculation Period, regardless -- of whether the quantity changes or remains the same between -- periods. , commodPhysicQuantSched_choice1 :: (Maybe (OneOf2 CalculationPeriodsReference CalculationPeriodsScheduleReference)) -- ^ Choice between: -- -- (1) A pointer style reference to the Delivery Periods -- defined elsewhere. -- -- (2) A pointer style reference to the Calculation Periods -- Schedule defined elsewhere. } deriving (Eq,Show) instance SchemaType CommodityPhysicalQuantitySchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityPhysicalQuantitySchedule a0) `apply` many (parseSchemaType "quantityStep") `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf2 (parseSchemaType "deliveryPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf2 (parseSchemaType "deliveryPeriodsScheduleReference")) ]) schemaTypeToXML s x@CommodityPhysicalQuantitySchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodPhysicQuantSched_ID x ] [ concatMap (schemaTypeToXML "quantityStep") $ commodPhysicQuantSched_quantityStep x , maybe [] (foldOneOf2 (schemaTypeToXML "deliveryPeriodsReference") (schemaTypeToXML "deliveryPeriodsScheduleReference") ) $ commodPhysicQuantSched_choice1 x ] -- | The pipeline through which the physical commodity will be -- delivered. data CommodityPipeline = CommodityPipeline Scheme CommodityPipelineAttributes deriving (Eq,Show) data CommodityPipelineAttributes = CommodityPipelineAttributes { commodPipelAttrib_pipelineScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityPipeline where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "pipelineScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityPipeline v (CommodityPipelineAttributes a0) schemaTypeToXML s (CommodityPipeline bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "pipelineScheme") $ commodPipelAttrib_pipelineScheme at ] $ schemaTypeToXML s bt instance Extension CommodityPipeline Scheme where supertype (CommodityPipeline s _) = s -- | The pipeline cycle during which the physical commodity will -- be delivered. data CommodityPipelineCycle = CommodityPipelineCycle Scheme CommodityPipelineCycleAttributes deriving (Eq,Show) data CommodityPipelineCycleAttributes = CommodityPipelineCycleAttributes { commodPipelCycleAttrib_pipelineCycleScheme :: Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityPipelineCycle where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- getAttribute "pipelineCycleScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityPipelineCycle v (CommodityPipelineCycleAttributes a0) schemaTypeToXML s (CommodityPipelineCycle bt at) = addXMLAttributes [ toXMLAttribute "pipelineCycleScheme" $ commodPipelCycleAttrib_pipelineCycleScheme at ] $ schemaTypeToXML s bt instance Extension CommodityPipelineCycle Scheme where supertype (CommodityPipelineCycle s _) = s -- | The commodity option premium payable by the buyer to the -- seller. data CommodityPremium = CommodityPremium { commodPremium_ID :: Maybe Xsd.ID , commodPremium_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , commodPremium_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , commodPremium_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , commodPremium_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , commodPremium_paymentDate :: Maybe AdjustableOrRelativeDate -- ^ The payment date, which can be expressed as either an -- adjustable or relative date. , commodPremium_paymentAmount :: Maybe NonNegativeMoney -- ^ Non negative payment amount. , commodPremium_premiumPerUnit :: NonNegativeMoney -- ^ The currency amount of premium to be paid per Unit of the -- Total Notional Quantity. } deriving (Eq,Show) instance SchemaType CommodityPremium where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityPremium a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "paymentDate") `apply` optional (parseSchemaType "paymentAmount") `apply` parseSchemaType "premiumPerUnit" schemaTypeToXML s x@CommodityPremium{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodPremium_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ commodPremium_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ commodPremium_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ commodPremium_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ commodPremium_receiverAccountReference x , maybe [] (schemaTypeToXML "paymentDate") $ commodPremium_paymentDate x , maybe [] (schemaTypeToXML "paymentAmount") $ commodPremium_paymentAmount x , schemaTypeToXML "premiumPerUnit" $ commodPremium_premiumPerUnit x ] instance Extension CommodityPremium NonNegativePayment where supertype (CommodityPremium a0 e0 e1 e2 e3 e4 e5 e6) = NonNegativePayment a0 e0 e1 e2 e3 e4 e5 instance Extension CommodityPremium PaymentBaseExtended where supertype = (supertype :: NonNegativePayment -> PaymentBaseExtended) . (supertype :: CommodityPremium -> NonNegativePayment) instance Extension CommodityPremium PaymentBase where supertype = (supertype :: PaymentBaseExtended -> PaymentBase) . (supertype :: NonNegativePayment -> PaymentBaseExtended) . (supertype :: CommodityPremium -> NonNegativePayment) -- | The dates on which prices are observed for the underlyer. data CommodityPricingDates = CommodityPricingDates { commodPricingDates_ID :: Maybe Xsd.ID , commodPricingDates_choice0 :: (Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference)) -- ^ Choice between: -- -- (1) A pointer style reference to the Calculation Periods -- defined on another leg. -- -- (2) A pointer style reference to the Calculation Periods -- Schedule defined on another leg. -- -- (3) A pointer style reference to single-day-duration -- Calculation Periods defined on another leg. , commodPricingDates_choice1 :: OneOf2 ((Maybe (Lag)),(OneOf3 ((Maybe (CommodityDayTypeEnum)),((Maybe (OneOf2 ((Maybe (CommodityFrequencyType)),(Maybe (Xsd.PositiveInteger))) ([DayOfWeekEnum],(Maybe (Xsd.Integer)))))),(Maybe (CommodityBusinessCalendar))) [SettlementPeriods] [SettlementPeriodsReference])) [AdjustableDates] -- ^ Choice between: -- -- (1) Sequence of: -- -- * The pricing period per calculation period if the -- pricing days do not wholly fall within the -- respective calculation period. -- -- * unknown -- -- (2) A list of adjustable dates on which the trade would -- price. Each date will price for the Calculation Period -- within which it falls. } deriving (Eq,Show) instance SchemaType CommodityPricingDates where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityPricingDates a0) `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]) `apply` oneOf' [ ("Maybe Lag OneOf3 ((Maybe (CommodityDayTypeEnum)),((Maybe (OneOf2 ((Maybe (CommodityFrequencyType)),(Maybe (Xsd.PositiveInteger))) ([DayOfWeekEnum],(Maybe (Xsd.Integer)))))),(Maybe (CommodityBusinessCalendar))) [SettlementPeriods] [SettlementPeriodsReference]", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "lag") `apply` oneOf' [ ("Maybe CommodityDayTypeEnum (Maybe (OneOf2 ((Maybe (CommodityFrequencyType)),(Maybe (Xsd.PositiveInteger))) ([DayOfWeekEnum],(Maybe (Xsd.Integer))))) Maybe CommodityBusinessCalendar", fmap OneOf3 (return (,,) `apply` optional (parseSchemaType "dayType") `apply` optional (oneOf' [ ("Maybe CommodityFrequencyType Maybe Xsd.PositiveInteger", fmap OneOf2 (return (,) `apply` optional (parseSchemaType "dayDistribution") `apply` optional (parseSchemaType "dayCount"))) , ("[DayOfWeekEnum] Maybe Xsd.Integer", fmap TwoOf2 (return (,) `apply` between (Occurs (Just 0) (Just 7)) (parseSchemaType "dayOfWeek") `apply` optional (parseSchemaType "dayNumber"))) ]) `apply` optional (parseSchemaType "businessCalendar"))) , ("[SettlementPeriods]", fmap TwoOf3 (many1 (parseSchemaType "settlementPeriods"))) , ("[SettlementPeriodsReference]", fmap ThreeOf3 (many1 (parseSchemaType "settlementPeriodsReference"))) ])) , ("[AdjustableDates]", fmap TwoOf2 (many1 (parseSchemaType "pricingDates"))) ] schemaTypeToXML s x@CommodityPricingDates{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodPricingDates_ID x ] [ maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") ) $ commodPricingDates_choice0 x , foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "lag") a , foldOneOf3 (\ (a,b,c) -> concat [ maybe [] (schemaTypeToXML "dayType") a , maybe [] (foldOneOf2 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "dayDistribution") a , maybe [] (schemaTypeToXML "dayCount") b ]) (\ (a,b) -> concat [ concatMap (schemaTypeToXML "dayOfWeek") a , maybe [] (schemaTypeToXML "dayNumber") b ]) ) b , maybe [] (schemaTypeToXML "businessCalendar") c ]) (concatMap (schemaTypeToXML "settlementPeriods")) (concatMap (schemaTypeToXML "settlementPeriodsReference")) b ]) (concatMap (schemaTypeToXML "pricingDates")) $ commodPricingDates_choice1 x ] -- | A scheme identifying the grade of physical commodity -- product to be delivered. data CommodityProductGrade = CommodityProductGrade Scheme CommodityProductGradeAttributes deriving (Eq,Show) data CommodityProductGradeAttributes = CommodityProductGradeAttributes { commodProductGradeAttrib_productGradeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityProductGrade where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "productGradeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityProductGrade v (CommodityProductGradeAttributes a0) schemaTypeToXML s (CommodityProductGrade bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "productGradeScheme") $ commodProductGradeAttrib_productGradeScheme at ] $ schemaTypeToXML s bt instance Extension CommodityProductGrade Scheme where supertype (CommodityProductGrade s _) = s -- | A type for defining the frequency at which the Notional -- Quantity is deemed to apply for purposes of calculating the -- Total Notional Quantity. data CommodityQuantityFrequency = CommodityQuantityFrequency Scheme CommodityQuantityFrequencyAttributes deriving (Eq,Show) data CommodityQuantityFrequencyAttributes = CommodityQuantityFrequencyAttributes { cqfa_quantityFrequencyScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CommodityQuantityFrequency where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "quantityFrequencyScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CommodityQuantityFrequency v (CommodityQuantityFrequencyAttributes a0) schemaTypeToXML s (CommodityQuantityFrequency bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "quantityFrequencyScheme") $ cqfa_quantityFrequencyScheme at ] $ schemaTypeToXML s bt instance Extension CommodityQuantityFrequency Scheme where supertype (CommodityQuantityFrequency s _) = s -- | The Expiration Dates of the trade relative to the -- Calculation Periods. data CommodityRelativeExpirationDates = CommodityRelativeExpirationDates { commodRelatExpirDates_ID :: Maybe Xsd.ID , commodRelatExpirDates_expireRelativeToEvent :: Maybe CommodityExpireRelativeToEvent -- ^ Specifies whether the payment(s) occur relative to the date -- of a physical event. , commodRelatExpirDates_expirationDateOffset :: Maybe DateOffset -- ^ Specifies any offset from the adjusted Calculation Period -- start date or adjusted Calculation Period end date -- applicable to each Payment Date. , commodRelatExpirDates_choice2 :: (Maybe (OneOf2 BusinessCentersReference BusinessCenters)) -- ^ Choice between: -- -- (1) A pointer style reference to a set of financial -- business centers defined elsewhere in the document. -- This set of business centers is used to determine -- whether a particular day is a business day or not. -- -- (2) businessCenters } deriving (Eq,Show) instance SchemaType CommodityRelativeExpirationDates where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityRelativeExpirationDates a0) `apply` optional (parseSchemaType "expireRelativeToEvent") `apply` optional (parseSchemaType "expirationDateOffset") `apply` optional (oneOf' [ ("BusinessCentersReference", fmap OneOf2 (parseSchemaType "businessCentersReference")) , ("BusinessCenters", fmap TwoOf2 (parseSchemaType "businessCenters")) ]) schemaTypeToXML s x@CommodityRelativeExpirationDates{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodRelatExpirDates_ID x ] [ maybe [] (schemaTypeToXML "expireRelativeToEvent") $ commodRelatExpirDates_expireRelativeToEvent x , maybe [] (schemaTypeToXML "expirationDateOffset") $ commodRelatExpirDates_expirationDateOffset x , maybe [] (foldOneOf2 (schemaTypeToXML "businessCentersReference") (schemaTypeToXML "businessCenters") ) $ commodRelatExpirDates_choice2 x ] -- | The Payment Dates of the trade relative to the Calculation -- Periods. data CommodityRelativePaymentDates = CommodityRelativePaymentDates { commodRelatPaymentDates_ID :: Maybe Xsd.ID , commodRelatPaymentDates_choice0 :: (Maybe (OneOf2 PayRelativeToEnum CommodityPayRelativeToEvent)) -- ^ Choice between: -- -- (1) Specifies whether the payment(s) occur relative to a -- date such as the end of each Calculation Period or the -- last Pricing Date in each Calculation Period. -- -- (2) Specifies whether the payment(s) occur relative to the -- date of a physical event. , commodRelatPaymentDates_choice1 :: (Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference)) -- ^ Choice between: -- -- (1) A pointer style reference to the Calculation Periods -- defined on another leg. -- -- (2) A pointer style reference to the Calculation Periods -- Schedule defined on another leg. -- -- (3) A pointer style reference to single-day-duration -- Calculation Periods defined on another leg. , commodRelatPaymentDates_paymentDaysOffset :: Maybe DateOffset -- ^ Specifies any offset from the adjusted Calculation Period -- start date or adjusted Calculation Period end date -- applicable to each Payment Date. , commodRelatPaymentDates_choice3 :: (Maybe (OneOf2 BusinessCentersReference BusinessCenters)) -- ^ Choice between: -- -- (1) A pointer style reference to a set of financial -- business centers defined elsewhere in the document. -- This set of business centers is used to determine -- whether a particular day is a business day or not. -- -- (2) businessCenters } deriving (Eq,Show) instance SchemaType CommodityRelativePaymentDates where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommodityRelativePaymentDates a0) `apply` optional (oneOf' [ ("PayRelativeToEnum", fmap OneOf2 (parseSchemaType "payRelativeTo")) , ("CommodityPayRelativeToEvent", fmap TwoOf2 (parseSchemaType "payRelativeToEvent")) ]) `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]) `apply` optional (parseSchemaType "paymentDaysOffset") `apply` optional (oneOf' [ ("BusinessCentersReference", fmap OneOf2 (parseSchemaType "businessCentersReference")) , ("BusinessCenters", fmap TwoOf2 (parseSchemaType "businessCenters")) ]) schemaTypeToXML s x@CommodityRelativePaymentDates{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodRelatPaymentDates_ID x ] [ maybe [] (foldOneOf2 (schemaTypeToXML "payRelativeTo") (schemaTypeToXML "payRelativeToEvent") ) $ commodRelatPaymentDates_choice0 x , maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") ) $ commodRelatPaymentDates_choice1 x , maybe [] (schemaTypeToXML "paymentDaysOffset") $ commodRelatPaymentDates_paymentDaysOffset x , maybe [] (foldOneOf2 (schemaTypeToXML "businessCentersReference") (schemaTypeToXML "businessCenters") ) $ commodRelatPaymentDates_choice3 x ] -- | The notional quantity of electricity that applies to one or -- more groups of Settlement Periods. data CommoditySettlementPeriodsNotionalQuantity = CommoditySettlementPeriodsNotionalQuantity { cspnq_ID :: Maybe Xsd.ID , cspnq_quantityUnit :: QuantityUnit -- ^ Quantity Unit is the unit of measure applicable for the -- quantity on the Transaction. , cspnq_quantityFrequency :: Maybe CommodityQuantityFrequency -- ^ The frequency at which the Notional Quantity is deemed to -- apply for purposes of calculating the Total Notional -- Quantity. , cspnq_quantity :: Maybe Xsd.Decimal -- ^ Amount of commodity per quantity frequency. , cspnq_settlementPeriodsReference :: [SettlementPeriodsReference] -- ^ The range(s) of Settlement Periods to which the Notional -- Quantity applies. } deriving (Eq,Show) instance SchemaType CommoditySettlementPeriodsNotionalQuantity where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommoditySettlementPeriodsNotionalQuantity a0) `apply` parseSchemaType "quantityUnit" `apply` optional (parseSchemaType "quantityFrequency") `apply` optional (parseSchemaType "quantity") `apply` many (parseSchemaType "settlementPeriodsReference") schemaTypeToXML s x@CommoditySettlementPeriodsNotionalQuantity{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ cspnq_ID x ] [ schemaTypeToXML "quantityUnit" $ cspnq_quantityUnit x , maybe [] (schemaTypeToXML "quantityFrequency") $ cspnq_quantityFrequency x , maybe [] (schemaTypeToXML "quantity") $ cspnq_quantity x , concatMap (schemaTypeToXML "settlementPeriodsReference") $ cspnq_settlementPeriodsReference x ] instance Extension CommoditySettlementPeriodsNotionalQuantity CommodityNotionalQuantity where supertype (CommoditySettlementPeriodsNotionalQuantity a0 e0 e1 e2 e3) = CommodityNotionalQuantity a0 e0 e1 e2 -- | The notional quantity schedule of electricity that applies -- to one or more groups of Settlement Periods. data CommoditySettlementPeriodsNotionalQuantitySchedule = CommoditySettlementPeriodsNotionalQuantitySchedule { cspnqs_settlementPeriodsNotionalQuantityStep :: [CommodityNotionalQuantity] -- ^ For an electricity transaction, the Notional Quantity for a -- given Calculation Period during the life of the trade which -- applies to the range(s) of Settlement Periods referenced by -- settlementPeriodsReference. There must be a -- settlementPeriodsNotionalQuantityStep specified for each -- Calculation Period, regardless of whether the -- NotionalQuantity changes or remains the same between -- periods. , cspnqs_settlementPeriodsReference :: [SettlementPeriodsReference] -- ^ The range(s) of Settlement Periods to which the Fixed Price -- steps apply. } deriving (Eq,Show) instance SchemaType CommoditySettlementPeriodsNotionalQuantitySchedule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommoditySettlementPeriodsNotionalQuantitySchedule `apply` many (parseSchemaType "settlementPeriodsNotionalQuantityStep") `apply` many (parseSchemaType "settlementPeriodsReference") schemaTypeToXML s x@CommoditySettlementPeriodsNotionalQuantitySchedule{} = toXMLElement s [] [ concatMap (schemaTypeToXML "settlementPeriodsNotionalQuantityStep") $ cspnqs_settlementPeriodsNotionalQuantityStep x , concatMap (schemaTypeToXML "settlementPeriodsReference") $ cspnqs_settlementPeriodsReference x ] -- | The fixed price schedule for electricity that applies to -- one or more groups of Settlement Periods. data CommoditySettlementPeriodsPriceSchedule = CommoditySettlementPeriodsPriceSchedule { cspps_settlementPeriodsPriceStep :: [FixedPrice] -- ^ For an electricity transaction, the Fixed Price for a given -- Calculation Period during the life of the trade which -- applies to the range(s) of Settlement Periods referenced by -- settlementPeriods Reference. There must be a Fixed Price -- step specified for each Calculation Period, regardless of -- whether the Fixed Price changes or remains the same between -- periods. , cspps_settlementPeriodsReference :: [SettlementPeriodsReference] -- ^ The range(s) of Settlement Periods to which the Fixed Price -- steps apply. } deriving (Eq,Show) instance SchemaType CommoditySettlementPeriodsPriceSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommoditySettlementPeriodsPriceSchedule `apply` many (parseSchemaType "settlementPeriodsPriceStep") `apply` many (parseSchemaType "settlementPeriodsReference") schemaTypeToXML s x@CommoditySettlementPeriodsPriceSchedule{} = toXMLElement s [] [ concatMap (schemaTypeToXML "settlementPeriodsPriceStep") $ cspps_settlementPeriodsPriceStep x , concatMap (schemaTypeToXML "settlementPeriodsReference") $ cspps_settlementPeriodsReference x ] data CommoditySpread = CommoditySpread { commodSpread_ID :: Maybe Xsd.ID , commodSpread_currency :: Currency -- ^ The currency in which an amount is denominated. , commodSpread_amount :: Xsd.Decimal -- ^ The monetary quantity in currency units. , commodSpread_spreadConversionFactor :: Maybe Xsd.Decimal -- ^ spreadConversionFactor should be used when the unit of -- measure of the Commodity Reference Price and the unit of -- measure in which the spread is quoted are different. The -- value of spreadConversionFactor is the number of units of -- measure in which the spread is quoted per unit of measure -- of the Commodity Reference Price. , commodSpread_spreadUnit :: Maybe QuantityUnit -- ^ spreadUnit should be used when the unit of measure of the -- Commodity Reference Price and the unit of measure in which -- the spread is quoted are different. The value of spreadUnit -- is the unit of measure in which the spread is quoted. } deriving (Eq,Show) instance SchemaType CommoditySpread where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommoditySpread a0) `apply` parseSchemaType "currency" `apply` parseSchemaType "amount" `apply` optional (parseSchemaType "spreadConversionFactor") `apply` optional (parseSchemaType "spreadUnit") schemaTypeToXML s x@CommoditySpread{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodSpread_ID x ] [ schemaTypeToXML "currency" $ commodSpread_currency x , schemaTypeToXML "amount" $ commodSpread_amount x , maybe [] (schemaTypeToXML "spreadConversionFactor") $ commodSpread_spreadConversionFactor x , maybe [] (schemaTypeToXML "spreadUnit") $ commodSpread_spreadUnit x ] instance Extension CommoditySpread Money where supertype (CommoditySpread a0 e0 e1 e2 e3) = Money a0 e0 e1 instance Extension CommoditySpread MoneyBase where supertype = (supertype :: Money -> MoneyBase) . (supertype :: CommoditySpread -> Money) -- | The Spread per Calculation Period. There must be a Spread -- specified for each Calculation Period, regardless of -- whether the Spread changes or remains the same between -- periods. data CommoditySpreadSchedule = CommoditySpreadSchedule { commodSpreadSched_spreadStep :: [CommoditySpread] -- ^ The spread per Calculation Period. There must be a spread -- step specified for each Calculation Period, regardless of -- whether the spread changes or remains the same between -- periods. , commodSpreadSched_choice1 :: (Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference)) -- ^ Choice between: -- -- (1) A pointer style reference to the Calculation Periods -- defined on another leg. -- -- (2) A pointer style reference to the Calculation Periods -- Schedule defined on another leg. -- -- (3) A pointer style reference to single-day-duration -- Calculation Periods defined on another leg. } deriving (Eq,Show) instance SchemaType CommoditySpreadSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommoditySpreadSchedule `apply` many (parseSchemaType "spreadStep") `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]) schemaTypeToXML s x@CommoditySpreadSchedule{} = toXMLElement s [] [ concatMap (schemaTypeToXML "spreadStep") $ commodSpreadSched_spreadStep x , maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") ) $ commodSpreadSched_choice1 x ] -- | The Strike Price per Unit per Calculation Period. There -- must be a Strike Price per Unit step specified for each -- Calculation Period, regardless of whether the Strike -- changes or remains the same between periods. data CommodityStrikeSchedule = CommodityStrikeSchedule { commodStrikeSched_strikePricePerUnitStep :: [NonNegativeMoney] -- ^ The strike price per unit per Calculation Period. There -- must be a strike price per unit specified for each -- Calculation Period, regardless of whether the price changes -- or remains the same between periods. , commodStrikeSched_choice1 :: (Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference)) -- ^ Choice between: -- -- (1) A pointer style reference to the Calculation Periods -- defined on another leg. -- -- (2) A pointer style reference to the Calculation Periods -- Schedule defined on another leg. -- -- (3) A pointer style reference to single-day-duration -- Calculation Periods defined on another leg. } deriving (Eq,Show) instance SchemaType CommodityStrikeSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommodityStrikeSchedule `apply` many (parseSchemaType "strikePricePerUnitStep") `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]) schemaTypeToXML s x@CommodityStrikeSchedule{} = toXMLElement s [] [ concatMap (schemaTypeToXML "strikePricePerUnitStep") $ commodStrikeSched_strikePricePerUnitStep x , maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") ) $ commodStrikeSched_choice1 x ] -- | Commodity Swap. data CommoditySwap = CommoditySwap { commodSwap_ID :: Maybe Xsd.ID , commodSwap_primaryAssetClass :: Maybe AssetClass -- ^ A classification of the most important risk class of the -- trade. FpML defines a simple asset class categorization -- using a coding scheme. , commodSwap_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , commodSwap_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , commodSwap_productId :: [ProductId] -- ^ A product reference identifier. The product ID is an -- identifier that describes the key economic characteristics -- of the trade type, with the exception of concepts such as -- size (notional, quantity, number of units) and price (fixed -- rate, strike, etc.) that are negotiated for each -- transaction. It can be used to hold identifiers such as the -- "UPI" (universal product identifier) required by certain -- regulatory reporting rules. It can also be used to hold -- identifiers of benchmark products or product temnplates -- used by certain trading systems or facilities. FpML does -- not define the domain values associated with this element. -- Note that the domain values for this element are not -- strictly an enumerated list. , commodSwap_effectiveDate :: AdjustableOrRelativeDate -- ^ Specifies the effective date of this leg of the swap. When -- defined in relation to a date specified somewhere else in -- the document (through the relativeDate component), this -- element will typically point to the effective date of the -- other leg of the swap. , commodSwap_terminationDate :: AdjustableOrRelativeDate -- ^ Specifies the termination date of this leg of the swap. -- When defined in relation to a date specified somewhere else -- in the document (through the relativeDate component), this -- element will typically point to the termination date of the -- other leg of the swap. , commodSwap_settlementCurrency :: Maybe IdentifiedCurrency -- ^ The currency into which the Commodity Swap Transaction will -- settle. If this is not the same as the currency in which -- the Commodity Reference Price is quoted on a given floating -- leg of the Commodity Swap Transaction, then an FX rate -- should also be specified for that leg. , commoditySwap_leg :: [CommoditySwapLeg] -- ^ Defines the substitutable commodity swap leg , commodSwap_commonPricing :: Maybe Xsd.Boolean -- ^ Common pricing may be relevant for a Transaction that -- references more than one Commodity Reference Price. If -- Common Pricing is not specified as applicable, it will be -- deemed not to apply. , commodSwap_marketDisruption :: Maybe CommodityMarketDisruption -- ^ Market disruption events as defined in the ISDA 1993 -- Commodity Definitions or in ISDA 2005 Commodity -- Definitions, as applicable. , commodSwap_settlementDisruption :: Maybe CommodityBullionSettlementDisruptionEnum -- ^ The consequences of Bullion Settlement Disruption Events. , commodSwap_rounding :: Maybe Rounding -- ^ Rounding direction and precision for amounts. } deriving (Eq,Show) instance SchemaType CommoditySwap where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommoditySwap a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` parseSchemaType "effectiveDate" `apply` parseSchemaType "terminationDate" `apply` optional (parseSchemaType "settlementCurrency") `apply` many (elementCommoditySwapLeg) `apply` optional (parseSchemaType "commonPricing") `apply` optional (parseSchemaType "marketDisruption") `apply` optional (parseSchemaType "settlementDisruption") `apply` optional (parseSchemaType "rounding") schemaTypeToXML s x@CommoditySwap{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodSwap_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ commodSwap_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ commodSwap_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ commodSwap_productType x , concatMap (schemaTypeToXML "productId") $ commodSwap_productId x , schemaTypeToXML "effectiveDate" $ commodSwap_effectiveDate x , schemaTypeToXML "terminationDate" $ commodSwap_terminationDate x , maybe [] (schemaTypeToXML "settlementCurrency") $ commodSwap_settlementCurrency x , concatMap (elementToXMLCommoditySwapLeg) $ commoditySwap_leg x , maybe [] (schemaTypeToXML "commonPricing") $ commodSwap_commonPricing x , maybe [] (schemaTypeToXML "marketDisruption") $ commodSwap_marketDisruption x , maybe [] (schemaTypeToXML "settlementDisruption") $ commodSwap_settlementDisruption x , maybe [] (schemaTypeToXML "rounding") $ commodSwap_rounding x ] instance Extension CommoditySwap Product where supertype v = Product_CommoditySwap v -- | Commodity Swaption. data CommoditySwaption = CommoditySwaption { commodSwapt_ID :: Maybe Xsd.ID , commodSwapt_primaryAssetClass :: Maybe AssetClass -- ^ A classification of the most important risk class of the -- trade. FpML defines a simple asset class categorization -- using a coding scheme. , commodSwapt_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , commodSwapt_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , commodSwapt_productId :: [ProductId] -- ^ A product reference identifier. The product ID is an -- identifier that describes the key economic characteristics -- of the trade type, with the exception of concepts such as -- size (notional, quantity, number of units) and price (fixed -- rate, strike, etc.) that are negotiated for each -- transaction. It can be used to hold identifiers such as the -- "UPI" (universal product identifier) required by certain -- regulatory reporting rules. It can also be used to hold -- identifiers of benchmark products or product temnplates -- used by certain trading systems or facilities. FpML does -- not define the domain values associated with this element. -- Note that the domain values for this element are not -- strictly an enumerated list. , commodSwapt_buyerPartyReference :: Maybe PartyReference -- ^ A reference to the party that buys this instrument, ie. -- pays for this instrument and receives the rights defined by -- it. See 2000 ISDA definitions Article 11.1 (b). In the case -- of FRAs this the fixed rate payer. , commodSwapt_buyerAccountReference :: Maybe AccountReference -- ^ A reference to the account that buys this instrument. , commodSwapt_sellerPartyReference :: Maybe PartyReference -- ^ A reference to the party that sells ("writes") this -- instrument, i.e. that grants the rights defined by this -- instrument and in return receives a payment for it. See -- 2000 ISDA definitions Article 11.1 (a). In the case of FRAs -- this is the floating rate payer. , commodSwapt_sellerAccountReference :: Maybe AccountReference -- ^ A reference to the account that sells this instrument. , commodSwapt_optionType :: Maybe PutCallEnum -- ^ The type of option transaction. , commodSwapt_commoditySwap :: Maybe CommoditySwaptionUnderlying -- ^ The underlying commodity swap definiton. , commodSwapt_physicalExercise :: Maybe CommodityPhysicalExercise -- ^ The parameters for defining how the commodity option can be -- exercised into a physical transaction. , commodSwapt_premium :: Maybe CommodityPremium -- ^ The option premium payable by the buyer to the seller. , commodSwapt_commonPricing :: Maybe Xsd.Boolean -- ^ Common pricing may be relevant for a Transaction that -- references more than one Commodity Reference Price. If -- Common Pricing is not specified as applicable, it will be -- deemed not to apply. , commodSwapt_marketDisruption :: Maybe CommodityMarketDisruption -- ^ Market disruption events as defined in the ISDA 1993 -- Commodity Definitions or in ISDA 2005 Commodity -- Definitions, as applicable. , commodSwapt_settlementDisruption :: Maybe CommodityBullionSettlementDisruptionEnum -- ^ The consequences of Bullion Settlement Disruption Events. , commodSwapt_rounding :: Maybe Rounding -- ^ Rounding direction and precision for amounts. } deriving (Eq,Show) instance SchemaType CommoditySwaption where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CommoditySwaption a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` optional (parseSchemaType "buyerPartyReference") `apply` optional (parseSchemaType "buyerAccountReference") `apply` optional (parseSchemaType "sellerPartyReference") `apply` optional (parseSchemaType "sellerAccountReference") `apply` optional (parseSchemaType "optionType") `apply` optional (parseSchemaType "commoditySwap") `apply` optional (parseSchemaType "physicalExercise") `apply` optional (parseSchemaType "premium") `apply` optional (parseSchemaType "commonPricing") `apply` optional (parseSchemaType "marketDisruption") `apply` optional (parseSchemaType "settlementDisruption") `apply` optional (parseSchemaType "rounding") schemaTypeToXML s x@CommoditySwaption{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ commodSwapt_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ commodSwapt_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ commodSwapt_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ commodSwapt_productType x , concatMap (schemaTypeToXML "productId") $ commodSwapt_productId x , maybe [] (schemaTypeToXML "buyerPartyReference") $ commodSwapt_buyerPartyReference x , maybe [] (schemaTypeToXML "buyerAccountReference") $ commodSwapt_buyerAccountReference x , maybe [] (schemaTypeToXML "sellerPartyReference") $ commodSwapt_sellerPartyReference x , maybe [] (schemaTypeToXML "sellerAccountReference") $ commodSwapt_sellerAccountReference x , maybe [] (schemaTypeToXML "optionType") $ commodSwapt_optionType x , maybe [] (schemaTypeToXML "commoditySwap") $ commodSwapt_commoditySwap x , maybe [] (schemaTypeToXML "physicalExercise") $ commodSwapt_physicalExercise x , maybe [] (schemaTypeToXML "premium") $ commodSwapt_premium x , maybe [] (schemaTypeToXML "commonPricing") $ commodSwapt_commonPricing x , maybe [] (schemaTypeToXML "marketDisruption") $ commodSwapt_marketDisruption x , maybe [] (schemaTypeToXML "settlementDisruption") $ commodSwapt_settlementDisruption x , maybe [] (schemaTypeToXML "rounding") $ commodSwapt_rounding x ] instance Extension CommoditySwaption Product where supertype v = Product_CommoditySwaption v data CommoditySwaptionUnderlying = CommoditySwaptionUnderlying { commodSwaptUnderly_effectiveDate :: AdjustableOrRelativeDate -- ^ Specifies the effective date of this leg of the swap. When -- defined in relation to a date specified somewhere else in -- the document (through the relativeDate component), this -- element will typically point to the effective date of the -- other leg of the swap. , commodSwaptUnderly_terminationDate :: AdjustableOrRelativeDate -- ^ Specifies the termination date of this leg of the swap. -- When defined in relation to a date specified somewhere else -- in the document (through the relativeDate component), this -- element will typically point to the termination date of the -- other leg of the swap. , commodSwaptUnderly_settlementCurrency :: Maybe IdentifiedCurrency -- ^ The currency into which the Commodity Swap Transaction will -- settle. If this is not the same as the currency in which -- the Commodity Reference Price is quoted on a given floating -- leg of the Commodity Swap Transaction, then an FX rate -- should also be specified for that leg. , commodSwaptUnderly_commoditySwapLeg :: [CommoditySwapLeg] -- ^ Defines the substitutable commodity swap leg , commodSwaptUnderly_commonPricing :: Maybe Xsd.Boolean -- ^ Common pricing may be relevant for a Transaction that -- references more than one Commodity Reference Price. If -- Common Pricing is not specified as applicable, it will be -- deemed not to apply. , commodSwaptUnderly_marketDisruption :: Maybe CommodityMarketDisruption -- ^ Market disruption events as defined in the ISDA 1993 -- Commodity Definitions or in ISDA 2005 Commodity -- Definitions, as applicable. , commodSwaptUnderly_settlementDisruption :: Maybe CommodityBullionSettlementDisruptionEnum -- ^ The consequences of Bullion Settlement Disruption Events. , commodSwaptUnderly_rounding :: Maybe Rounding -- ^ Rounding direction and precision for amounts. } deriving (Eq,Show) instance SchemaType CommoditySwaptionUnderlying where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CommoditySwaptionUnderlying `apply` parseSchemaType "effectiveDate" `apply` parseSchemaType "terminationDate" `apply` optional (parseSchemaType "settlementCurrency") `apply` many (elementCommoditySwapLeg) `apply` optional (parseSchemaType "commonPricing") `apply` optional (parseSchemaType "marketDisruption") `apply` optional (parseSchemaType "settlementDisruption") `apply` optional (parseSchemaType "rounding") schemaTypeToXML s x@CommoditySwaptionUnderlying{} = toXMLElement s [] [ schemaTypeToXML "effectiveDate" $ commodSwaptUnderly_effectiveDate x , schemaTypeToXML "terminationDate" $ commodSwaptUnderly_terminationDate x , maybe [] (schemaTypeToXML "settlementCurrency") $ commodSwaptUnderly_settlementCurrency x , concatMap (elementToXMLCommoditySwapLeg) $ commodSwaptUnderly_commoditySwapLeg x , maybe [] (schemaTypeToXML "commonPricing") $ commodSwaptUnderly_commonPricing x , maybe [] (schemaTypeToXML "marketDisruption") $ commodSwaptUnderly_marketDisruption x , maybe [] (schemaTypeToXML "settlementDisruption") $ commodSwaptUnderly_settlementDisruption x , maybe [] (schemaTypeToXML "rounding") $ commodSwaptUnderly_rounding x ] -- | Abstract base class for all commodity swap legs data CommoditySwapLeg = CommoditySwapLeg_PhysicalSwapLeg PhysicalSwapLeg | CommoditySwapLeg_NonPeriodicFixedPriceLeg NonPeriodicFixedPriceLeg | CommoditySwapLeg_FinancialSwapLeg FinancialSwapLeg deriving (Eq,Show) instance SchemaType CommoditySwapLeg where parseSchemaType s = do (fmap CommoditySwapLeg_PhysicalSwapLeg $ parseSchemaType s) `onFail` (fmap CommoditySwapLeg_NonPeriodicFixedPriceLeg $ parseSchemaType s) `onFail` (fmap CommoditySwapLeg_FinancialSwapLeg $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of CommoditySwapLeg,\n\ \ namely one of:\n\ \PhysicalSwapLeg,NonPeriodicFixedPriceLeg,FinancialSwapLeg" schemaTypeToXML _s (CommoditySwapLeg_PhysicalSwapLeg x) = schemaTypeToXML "physicalSwapLeg" x schemaTypeToXML _s (CommoditySwapLeg_NonPeriodicFixedPriceLeg x) = schemaTypeToXML "nonPeriodicFixedPriceLeg" x schemaTypeToXML _s (CommoditySwapLeg_FinancialSwapLeg x) = schemaTypeToXML "financialSwapLeg" x instance Extension CommoditySwapLeg Leg where supertype v = Leg_CommoditySwapLeg v -- | A Disruption Fallback. data DisruptionFallback = DisruptionFallback Scheme DisruptionFallbackAttributes deriving (Eq,Show) data DisruptionFallbackAttributes = DisruptionFallbackAttributes { disrupFallbAttrib_commodityMarketDisruptionFallbackScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType DisruptionFallback where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityMarketDisruptionFallbackScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ DisruptionFallback v (DisruptionFallbackAttributes a0) schemaTypeToXML s (DisruptionFallback bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityMarketDisruptionFallbackScheme") $ disrupFallbAttrib_commodityMarketDisruptionFallbackScheme at ] $ schemaTypeToXML s bt instance Extension DisruptionFallback Scheme where supertype (DisruptionFallback s _) = s -- | The physical delivery conditions for electricity. data ElectricityDelivery = ElectricityDelivery { electrDeliv_choice0 :: OneOf2 (ElectricityDeliveryPoint,ElectricityDeliveryType,(Maybe (ElectricityTransmissionContingency))) ((Maybe (CommodityDeliveryPoint)),(Maybe (PartyReference))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * The point at which delivery of the electricity will -- occur. -- -- * Indicates the under what conditions the Parties' -- delivery obligations apply. -- -- * Indicates that the performance of the buyer or -- seller shall be excused (under the conditions -- specified) if transmission of the elctricity is -- unavailable or interrupted. -- -- (2) Sequence of: -- -- * The zone covering potential delivery points for the -- electricity. -- -- * Indicates the party able to decide which delivery -- point within the deliveryPoint is used for -- delivery. For EEI transactions, this should -- reference the seller of the electricity. } deriving (Eq,Show) instance SchemaType ElectricityDelivery where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ElectricityDelivery `apply` oneOf' [ ("ElectricityDeliveryPoint ElectricityDeliveryType Maybe ElectricityTransmissionContingency", fmap OneOf2 (return (,,) `apply` parseSchemaType "deliveryPoint" `apply` parseSchemaType "deliveryType" `apply` optional (parseSchemaType "transmissionContingency"))) , ("Maybe CommodityDeliveryPoint Maybe PartyReference", fmap TwoOf2 (return (,) `apply` optional (parseSchemaType "deliveryZone") `apply` optional (parseSchemaType "electingPartyReference"))) ] schemaTypeToXML s x@ElectricityDelivery{} = toXMLElement s [] [ foldOneOf2 (\ (a,b,c) -> concat [ schemaTypeToXML "deliveryPoint" a , schemaTypeToXML "deliveryType" b , maybe [] (schemaTypeToXML "transmissionContingency") c ]) (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "deliveryZone") a , maybe [] (schemaTypeToXML "electingPartyReference") b ]) $ electrDeliv_choice0 x ] -- | The physical delivery obligation options specific to a firm -- transaction. data ElectricityDeliveryFirm = ElectricityDeliveryFirm { electrDelivFirm_forceMajeure :: Maybe Xsd.Boolean -- ^ If true, indicates that the buyer and seller should be -- excused of their delivery obligations when such performance -- is prevented by Force Majeure. For EEI transactions, this -- would indicate "Firm (LD)" If false, indicates that the -- buyer and seller should not be excused of their delivery -- obligations when such performance is prevented by Force -- Majeure. For EEI transactions, this would indicate "Firm -- (No Force Majeure)" } deriving (Eq,Show) instance SchemaType ElectricityDeliveryFirm where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ElectricityDeliveryFirm `apply` optional (parseSchemaType "forceMajeure") schemaTypeToXML s x@ElectricityDeliveryFirm{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "forceMajeure") $ electrDelivFirm_forceMajeure x ] -- | The different options for specifying the Delivery Periods -- for a physically settled electricity trade. data ElectricityDeliveryPeriods = ElectricityDeliveryPeriods { electrDelivPeriods_ID :: Maybe Xsd.ID , electrDelivPeriods_choice0 :: OneOf3 AdjustableDates CommodityCalculationPeriodsSchedule ((Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))) -- ^ Choice between: -- -- (1) The Delivery Periods for this leg of the swap. This -- type is only intended to be used if the Delivery -- Periods differ from the Calculation Periods on the -- fixed or floating leg. If DeliveryPeriods mirror -- another leg, then the calculationPeriodsReference -- element should be used to point to the Calculation -- Periods on that leg - or the -- calculationPeriodsScheduleReference can be used to -- point to the Calculation Periods Schedule for that leg. -- -- (2) The Delivery Periods for this leg of the swap. This -- type is only intended to be used if the Delivery -- Periods differ from the Calculation Periods on the -- fixed or floating leg. If DeliveryPeriods mirror -- another leg, then the calculationPeriodsReference -- element should be used to point to the Calculation -- Periods on that leg - or the -- calculationPeriodsScheduleReference can be used to -- point to the Calculation Periods Schedule for that leg. -- -- (3) unknown , electrDelivPeriods_settlementPeriods :: [SettlementPeriods] -- ^ The periods within the Delivery Periods during which the -- electricity will be delivered. } deriving (Eq,Show) instance SchemaType ElectricityDeliveryPeriods where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (ElectricityDeliveryPeriods a0) `apply` oneOf' [ ("AdjustableDates", fmap OneOf3 (parseSchemaType "periods")) , ("CommodityCalculationPeriodsSchedule", fmap TwoOf3 (parseSchemaType "periodsSchedule")) , ("(Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))", fmap ThreeOf3 (optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]))) ] `apply` many (parseSchemaType "settlementPeriods") schemaTypeToXML s x@ElectricityDeliveryPeriods{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ electrDelivPeriods_ID x ] [ foldOneOf3 (schemaTypeToXML "periods") (schemaTypeToXML "periodsSchedule") (maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") )) $ electrDelivPeriods_choice0 x , concatMap (schemaTypeToXML "settlementPeriods") $ electrDelivPeriods_settlementPeriods x ] instance Extension ElectricityDeliveryPeriods CommodityDeliveryPeriods where supertype (ElectricityDeliveryPeriods a0 e0 e1) = CommodityDeliveryPeriods a0 e0 -- | A scheme identifying the types of the Delivery Point for a -- physically settled electricity trade. data ElectricityDeliveryPoint = ElectricityDeliveryPoint Scheme ElectricityDeliveryPointAttributes deriving (Eq,Show) data ElectricityDeliveryPointAttributes = ElectricityDeliveryPointAttributes { electrDelivPointAttrib_deliveryPointScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ElectricityDeliveryPoint where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "deliveryPointScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ElectricityDeliveryPoint v (ElectricityDeliveryPointAttributes a0) schemaTypeToXML s (ElectricityDeliveryPoint bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "deliveryPointScheme") $ electrDelivPointAttrib_deliveryPointScheme at ] $ schemaTypeToXML s bt instance Extension ElectricityDeliveryPoint Scheme where supertype (ElectricityDeliveryPoint s _) = s -- | The physical delivery obligation options specific to a -- system firm transaction. data ElectricityDeliverySystemFirm = ElectricityDeliverySystemFirm { electrDelivSystemFirm_applicable :: Maybe Xsd.Boolean -- ^ Indicates that the trade is for a System Firm product. -- Should always be set to "true". , electrDelivSystemFirm_system :: Maybe CommodityDeliveryPoint } deriving (Eq,Show) instance SchemaType ElectricityDeliverySystemFirm where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ElectricityDeliverySystemFirm `apply` optional (parseSchemaType "applicable") `apply` optional (parseSchemaType "system") schemaTypeToXML s x@ElectricityDeliverySystemFirm{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "applicable") $ electrDelivSystemFirm_applicable x , maybe [] (schemaTypeToXML "system") $ electrDelivSystemFirm_system x ] data ElectricityDeliveryType = ElectricityDeliveryType { electrDelivType_choice0 :: (Maybe (OneOf4 ElectricityDeliveryFirm Xsd.Boolean ElectricityDeliverySystemFirm ElectricityDeliveryUnitFirm)) -- ^ Choice between: -- -- (1) Indicates under what condtitions the Parties' delivery -- obligations apply. -- -- (2) If present and set to true, indicates that delivery or -- receipt of the electricity may be interrupted for any -- reason or for no reason, without liability on the part -- of either Party. This element should never have a value -- of false. -- -- (3) Indicates that the electricity is intended to be -- supplied from the owned or controlled generation or -- pre-existing purchased power assets of the system -- specified. -- -- (4) Indicates that the electricity is intended to be -- supplied from a generation asset which can optionally -- be specified. } deriving (Eq,Show) instance SchemaType ElectricityDeliveryType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ElectricityDeliveryType `apply` optional (oneOf' [ ("ElectricityDeliveryFirm", fmap OneOf4 (parseSchemaType "firm")) , ("Xsd.Boolean", fmap TwoOf4 (parseSchemaType "nonFirm")) , ("ElectricityDeliverySystemFirm", fmap ThreeOf4 (parseSchemaType "systemFirm")) , ("ElectricityDeliveryUnitFirm", fmap FourOf4 (parseSchemaType "unitFirm")) ]) schemaTypeToXML s x@ElectricityDeliveryType{} = toXMLElement s [] [ maybe [] (foldOneOf4 (schemaTypeToXML "firm") (schemaTypeToXML "nonFirm") (schemaTypeToXML "systemFirm") (schemaTypeToXML "unitFirm") ) $ electrDelivType_choice0 x ] -- | The physical delivery obligation options specific to a unit -- firm transaction. data ElectricityDeliveryUnitFirm = ElectricityDeliveryUnitFirm { electrDelivUnitFirm_applicable :: Maybe Xsd.Boolean -- ^ Indicates that the trade is for a Unit Firm product. Should -- always be set to "true". , electrDelivUnitFirm_generationAsset :: Maybe CommodityDeliveryPoint } deriving (Eq,Show) instance SchemaType ElectricityDeliveryUnitFirm where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ElectricityDeliveryUnitFirm `apply` optional (parseSchemaType "applicable") `apply` optional (parseSchemaType "generationAsset") schemaTypeToXML s x@ElectricityDeliveryUnitFirm{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "applicable") $ electrDelivUnitFirm_applicable x , maybe [] (schemaTypeToXML "generationAsset") $ electrDelivUnitFirm_generationAsset x ] -- | A type defining the physical quantity of the electricity to -- be delivered. data ElectricityPhysicalDeliveryQuantity = ElectricityPhysicalDeliveryQuantity { epdq_ID :: Maybe Xsd.ID , epdq_quantityUnit :: QuantityUnit -- ^ Quantity Unit is the unit of measure applicable for the -- quantity on the Transaction. , epdq_quantityFrequency :: Maybe CommodityQuantityFrequency -- ^ The frequency at which the Notional Quantity is deemed to -- apply for purposes of calculating the Total Notional -- Quantity. , epdq_quantity :: Maybe Xsd.Decimal -- ^ Amount of commodity per quantity frequency. , epdq_settlementPeriodsReference :: [SettlementPeriodsReference] -- ^ A pointer style reference to the range(s) of Settlement -- Periods to which this quantity applies. } deriving (Eq,Show) instance SchemaType ElectricityPhysicalDeliveryQuantity where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (ElectricityPhysicalDeliveryQuantity a0) `apply` parseSchemaType "quantityUnit" `apply` optional (parseSchemaType "quantityFrequency") `apply` optional (parseSchemaType "quantity") `apply` many (parseSchemaType "settlementPeriodsReference") schemaTypeToXML s x@ElectricityPhysicalDeliveryQuantity{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ epdq_ID x ] [ schemaTypeToXML "quantityUnit" $ epdq_quantityUnit x , maybe [] (schemaTypeToXML "quantityFrequency") $ epdq_quantityFrequency x , maybe [] (schemaTypeToXML "quantity") $ epdq_quantity x , concatMap (schemaTypeToXML "settlementPeriodsReference") $ epdq_settlementPeriodsReference x ] instance Extension ElectricityPhysicalDeliveryQuantity CommodityNotionalQuantity where supertype (ElectricityPhysicalDeliveryQuantity a0 e0 e1 e2 e3) = CommodityNotionalQuantity a0 e0 e1 e2 -- | Allows the documentation of a shaped quantity trade where -- the quantity changes over the life of the transaction. data ElectricityPhysicalDeliveryQuantitySchedule = ElectricityPhysicalDeliveryQuantitySchedule { epdqs_ID :: Maybe Xsd.ID , epdqs_quantityStep :: [CommodityNotionalQuantity] -- ^ The quantity per Calculation Period. There must be a -- quantity specified for each Calculation Period, regardless -- of whether the quantity changes or remains the same between -- periods. , epdqs_choice1 :: (Maybe (OneOf2 CalculationPeriodsReference CalculationPeriodsScheduleReference)) -- ^ Choice between: -- -- (1) A pointer style reference to the Delivery Periods -- defined elsewhere. -- -- (2) A pointer style reference to the Calculation Periods -- Schedule defined elsewhere. , epdqs_settlementPeriodsReference :: [SettlementPeriodsReference] -- ^ A pointer style reference to the range(s) of Settlement -- Periods to which this quantity applies. } deriving (Eq,Show) instance SchemaType ElectricityPhysicalDeliveryQuantitySchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (ElectricityPhysicalDeliveryQuantitySchedule a0) `apply` many (parseSchemaType "quantityStep") `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf2 (parseSchemaType "deliveryPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf2 (parseSchemaType "deliveryPeriodsScheduleReference")) ]) `apply` many (parseSchemaType "settlementPeriodsReference") schemaTypeToXML s x@ElectricityPhysicalDeliveryQuantitySchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ epdqs_ID x ] [ concatMap (schemaTypeToXML "quantityStep") $ epdqs_quantityStep x , maybe [] (foldOneOf2 (schemaTypeToXML "deliveryPeriodsReference") (schemaTypeToXML "deliveryPeriodsScheduleReference") ) $ epdqs_choice1 x , concatMap (schemaTypeToXML "settlementPeriodsReference") $ epdqs_settlementPeriodsReference x ] instance Extension ElectricityPhysicalDeliveryQuantitySchedule CommodityPhysicalQuantitySchedule where supertype (ElectricityPhysicalDeliveryQuantitySchedule a0 e0 e1 e2) = CommodityPhysicalQuantitySchedule a0 e0 e1 -- | Physically settled leg of a physically settled electricity -- transaction. data ElectricityPhysicalLeg = ElectricityPhysicalLeg { electrPhysicLeg_ID :: Maybe Xsd.ID , electrPhysicLeg_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , electrPhysicLeg_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , electrPhysicLeg_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , electrPhysicLeg_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , electrPhysicLeg_deliveryPeriods :: Maybe CommodityDeliveryPeriods -- ^ The different options for specifying the Delivery or Supply -- Periods. Unless the quantity or price is to vary -- periodically during the trade or physical delivery occurs -- on a periodic basis, periodsSchedule should be used and set -- to 1T. , electrPhysicLeg_settlementPeriods :: [SettlementPeriods] -- ^ The specification of the Settlement Periods in which the -- electricity will be delivered. The Settlement Periods will -- apply from and including the Effective Date up to and -- including the Termination Date. If more than one -- settlementPeriods element is present this indicates -- multiple ranges of Settlement Periods apply to the entire -- trade - for example off-peak weekdays and all day weekends. -- Settlement Period ranges should not overlap. , electrPhysicLeg_settlementPeriodsSchedule :: Maybe SettlementPeriodsSchedule -- ^ The specification of the Settlement Periods in which the -- electricity will be delivered for a "shaped" trade i.e. -- where different Settlement Period ranges will apply to -- different periods of the trade. , electrPhysicLeg_electricity :: ElectricityProduct -- ^ The specification of the electricity to be delivered. , electrPhysicLeg_deliveryConditions :: ElectricityDelivery -- ^ The physical delivery conditions for the transaction. , electrPhysicLeg_deliveryQuantity :: ElectricityPhysicalQuantity -- ^ The different options for specifying the quantity. } deriving (Eq,Show) instance SchemaType ElectricityPhysicalLeg where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (ElectricityPhysicalLeg a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "deliveryPeriods") `apply` many1 (parseSchemaType "settlementPeriods") `apply` optional (parseSchemaType "settlementPeriodsSchedule") `apply` parseSchemaType "electricity" `apply` parseSchemaType "deliveryConditions" `apply` parseSchemaType "deliveryQuantity" schemaTypeToXML s x@ElectricityPhysicalLeg{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ electrPhysicLeg_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ electrPhysicLeg_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ electrPhysicLeg_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ electrPhysicLeg_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ electrPhysicLeg_receiverAccountReference x , maybe [] (schemaTypeToXML "deliveryPeriods") $ electrPhysicLeg_deliveryPeriods x , concatMap (schemaTypeToXML "settlementPeriods") $ electrPhysicLeg_settlementPeriods x , maybe [] (schemaTypeToXML "settlementPeriodsSchedule") $ electrPhysicLeg_settlementPeriodsSchedule x , schemaTypeToXML "electricity" $ electrPhysicLeg_electricity x , schemaTypeToXML "deliveryConditions" $ electrPhysicLeg_deliveryConditions x , schemaTypeToXML "deliveryQuantity" $ electrPhysicLeg_deliveryQuantity x ] instance Extension ElectricityPhysicalLeg PhysicalSwapLeg where supertype v = PhysicalSwapLeg_ElectricityPhysicalLeg v instance Extension ElectricityPhysicalLeg CommoditySwapLeg where supertype = (supertype :: PhysicalSwapLeg -> CommoditySwapLeg) . (supertype :: ElectricityPhysicalLeg -> PhysicalSwapLeg) instance Extension ElectricityPhysicalLeg Leg where supertype = (supertype :: CommoditySwapLeg -> Leg) . (supertype :: PhysicalSwapLeg -> CommoditySwapLeg) . (supertype :: ElectricityPhysicalLeg -> PhysicalSwapLeg) -- | The quantity of gas to be delivered. data ElectricityPhysicalQuantity = ElectricityPhysicalQuantity { electrPhysicQuant_ID :: Maybe Xsd.ID , electrPhysicQuant_choice0 :: (Maybe (OneOf2 [ElectricityPhysicalDeliveryQuantity] [ElectricityPhysicalDeliveryQuantitySchedule])) -- ^ Choice between: -- -- (1) The Quantity per Delivery Period. -- -- (2) Allows the documentation of a shaped quantity trade -- where the quantity changes over the life of the -- transaction. Note that if the range of Settlement -- Periods also varies over the life of the transaction -- this element should not be used. Instead, -- physicalQuantity should be repeated for each range of -- Settlement Periods that apply at any point during the -- trade. , electrPhysicQuant_totalPhysicalQuantity :: UnitQuantity -- ^ The Total Quantity of the commodity to be delivered. } deriving (Eq,Show) instance SchemaType ElectricityPhysicalQuantity where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (ElectricityPhysicalQuantity a0) `apply` optional (oneOf' [ ("[ElectricityPhysicalDeliveryQuantity]", fmap OneOf2 (many1 (parseSchemaType "physicalQuantity"))) , ("[ElectricityPhysicalDeliveryQuantitySchedule]", fmap TwoOf2 (many1 (parseSchemaType "physicalQuantitySchedule"))) ]) `apply` parseSchemaType "totalPhysicalQuantity" schemaTypeToXML s x@ElectricityPhysicalQuantity{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ electrPhysicQuant_ID x ] [ maybe [] (foldOneOf2 (concatMap (schemaTypeToXML "physicalQuantity")) (concatMap (schemaTypeToXML "physicalQuantitySchedule")) ) $ electrPhysicQuant_choice0 x , schemaTypeToXML "totalPhysicalQuantity" $ electrPhysicQuant_totalPhysicalQuantity x ] instance Extension ElectricityPhysicalQuantity CommodityPhysicalQuantityBase where supertype v = CommodityPhysicalQuantityBase_ElectricityPhysicalQuantity v -- | The specification of the electricity to be delivered. data ElectricityProduct = ElectricityProduct { electrProduct_type :: Maybe ElectricityProductTypeEnum -- ^ The type of electricity product to be delivered. , electrProduct_voltage :: Maybe PositiveDecimal -- ^ The voltage, expressed as a number of volts, of the -- electricity to be delivered. } deriving (Eq,Show) instance SchemaType ElectricityProduct where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ElectricityProduct `apply` optional (parseSchemaType "type") `apply` optional (parseSchemaType "voltage") schemaTypeToXML s x@ElectricityProduct{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "type") $ electrProduct_type x , maybe [] (schemaTypeToXML "voltage") $ electrProduct_voltage x ] -- | A structure to specify the tranmission contingency and the -- party that bears the obligation. data ElectricityTransmissionContingency = ElectricityTransmissionContingency { electrTransmContin_contingency :: Maybe ElectricityTransmissionContingencyType -- ^ The conditions under which the party specified in -- contingentParty will be excused from damages if -- transmission is interrupted or curtailed. , electrTransmContin_contingentParty :: [PartyReference] -- ^ The party to which the contingency applies. } deriving (Eq,Show) instance SchemaType ElectricityTransmissionContingency where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ElectricityTransmissionContingency `apply` optional (parseSchemaType "contingency") `apply` between (Occurs (Just 0) (Just 2)) (parseSchemaType "contingentParty") schemaTypeToXML s x@ElectricityTransmissionContingency{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "contingency") $ electrTransmContin_contingency x , concatMap (schemaTypeToXML "contingentParty") $ electrTransmContin_contingentParty x ] -- | The type of transmission contingency, i.e. what portion of -- the transmission the delivery obligations are applicable. data ElectricityTransmissionContingencyType = ElectricityTransmissionContingencyType Scheme ElectricityTransmissionContingencyTypeAttributes deriving (Eq,Show) data ElectricityTransmissionContingencyTypeAttributes = ElectricityTransmissionContingencyTypeAttributes { etcta_electricityTransmissionContingencyScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ElectricityTransmissionContingencyType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "electricityTransmissionContingencyScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ElectricityTransmissionContingencyType v (ElectricityTransmissionContingencyTypeAttributes a0) schemaTypeToXML s (ElectricityTransmissionContingencyType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "electricityTransmissionContingencyScheme") $ etcta_electricityTransmissionContingencyScheme at ] $ schemaTypeToXML s bt instance Extension ElectricityTransmissionContingencyType Scheme where supertype (ElectricityTransmissionContingencyType s _) = s -- | The common components of a financially settled leg of a -- Commodity Swap. This is an abstract type and should be -- extended by commodity-specific types. data FinancialSwapLeg = FinancialSwapLeg_FloatingPriceLeg FloatingPriceLeg | FinancialSwapLeg_FixedPriceLeg FixedPriceLeg deriving (Eq,Show) instance SchemaType FinancialSwapLeg where parseSchemaType s = do (fmap FinancialSwapLeg_FloatingPriceLeg $ parseSchemaType s) `onFail` (fmap FinancialSwapLeg_FixedPriceLeg $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of FinancialSwapLeg,\n\ \ namely one of:\n\ \FloatingPriceLeg,FixedPriceLeg" schemaTypeToXML _s (FinancialSwapLeg_FloatingPriceLeg x) = schemaTypeToXML "floatingPriceLeg" x schemaTypeToXML _s (FinancialSwapLeg_FixedPriceLeg x) = schemaTypeToXML "fixedPriceLeg" x instance Extension FinancialSwapLeg CommoditySwapLeg where supertype v = CommoditySwapLeg_FinancialSwapLeg v -- | A type defining the Fixed Price. data FixedPrice = FixedPrice { fixedPrice_ID :: Maybe Xsd.ID , fixedPrice_price :: Xsd.Decimal -- ^ The Fixed Price. , fixedPrice_priceCurrency :: Currency -- ^ Currency of the fixed price. , fixedPrice_priceUnit :: QuantityUnit -- ^ The unit of measure used to calculate the Fixed Price. } deriving (Eq,Show) instance SchemaType FixedPrice where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FixedPrice a0) `apply` parseSchemaType "price" `apply` parseSchemaType "priceCurrency" `apply` parseSchemaType "priceUnit" schemaTypeToXML s x@FixedPrice{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fixedPrice_ID x ] [ schemaTypeToXML "price" $ fixedPrice_price x , schemaTypeToXML "priceCurrency" $ fixedPrice_priceCurrency x , schemaTypeToXML "priceUnit" $ fixedPrice_priceUnit x ] -- | Fixed Price Leg of a Commodity Swap. data FixedPriceLeg = FixedPriceLeg { fixedPriceLeg_ID :: Maybe Xsd.ID , fixedPriceLeg_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , fixedPriceLeg_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , fixedPriceLeg_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , fixedPriceLeg_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , fixedPriceLeg_choice4 :: OneOf4 AdjustableDates AdjustableDates CommodityCalculationPeriodsSchedule ((Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))) -- ^ Choice between: -- -- (1) The Calculation Period dates for this leg of the trade -- where the Calculation Periods are all one day long, -- typically a physically-settled emissions or metals -- trade. Only dates explicitly included determine the -- Calculation Periods and there is a Calculation Period -- for each date specified. -- -- (2) The Calculation Period start dates for this leg of the -- swap. This type is only intended to be used if the -- Calculation Periods differ on each leg. If Calculation -- Periods mirror another leg, then the -- calculationPeriodsReference element should be used to -- point to the Calculation Periods on that leg - or the -- calculationPeriodsScheduleReference can be used to -- point to the Calculation Periods Schedule for that leg. -- -- (3) The Calculation Periods for this leg of the swap. This -- type is only intended to be used if the Calculation -- Periods differ on each leg. If Calculation Periods -- mirror another leg, then the -- calculationPeriodsReference element should be used to -- point to the Calculation Periods on the other leg - or -- the calculationPeriodsScheduleReference can be used to -- point to the Calculation Periods Schedule for that leg. -- -- (4) unknown , fixedPriceLeg_choice5 :: OneOf2 CommodityFixedPriceSchedule (OneOf4 FixedPrice Xsd.Decimal NonNegativeMoney [SettlementPeriodsFixedPrice]) -- ^ Choice between: -- -- (1) Allows the specification of a Fixed Price that varies -- over the life of the trade. -- -- (2) unknown , fixedPriceLeg_totalPrice :: Maybe NonNegativeMoney -- ^ The total amount of all fixed payments due during the term -- of the trade. , fixedPriceLeg_choice7 :: OneOf2 ((OneOf3 CommodityNotionalQuantitySchedule CommodityNotionalQuantity [CommoditySettlementPeriodsNotionalQuantity]),Xsd.Decimal) QuantityReference -- ^ Choice between: -- -- (1) Sequence of: -- -- * unknown -- -- * The Total Notional Quantity. -- -- (2) A pointer style reference to a quantity defined on -- another leg. , fixedPriceLeg_choice8 :: OneOf2 CommodityRelativePaymentDates ((Maybe (OneOf2 AdjustableDatesOrRelativeDateOffset Xsd.Boolean))) -- ^ Choice between: -- -- (1) The Payment Dates of the trade relative to the -- Calculation Periods. -- -- (2) unknown , fixedPriceLeg_flatRate :: Maybe FlatRateEnum -- ^ Whether the Flat Rate is the New Worldwide Tanker Nominal -- Freight Scale for the Freight Index Route taken at the -- Trade Date of the transaction or taken on each Pricing -- Date. , fixedPriceLeg_flatRateAmount :: Maybe NonNegativeMoney -- ^ If flatRate is set to "Fixed", the actual value of the Flat -- Rate. } deriving (Eq,Show) instance SchemaType FixedPriceLeg where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FixedPriceLeg a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` oneOf' [ ("AdjustableDates", fmap OneOf4 (parseSchemaType "calculationDates")) , ("AdjustableDates", fmap TwoOf4 (parseSchemaType "calculationPeriods")) , ("CommodityCalculationPeriodsSchedule", fmap ThreeOf4 (parseSchemaType "calculationPeriodsSchedule")) , ("(Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))", fmap FourOf4 (optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]))) ] `apply` oneOf' [ ("CommodityFixedPriceSchedule", fmap OneOf2 (parseSchemaType "fixedPriceSchedule")) , ("OneOf4 FixedPrice Xsd.Decimal NonNegativeMoney [SettlementPeriodsFixedPrice]", fmap TwoOf2 (oneOf' [ ("FixedPrice", fmap OneOf4 (parseSchemaType "fixedPrice")) , ("Xsd.Decimal", fmap TwoOf4 (parseSchemaType "worldscaleRate")) , ("NonNegativeMoney", fmap ThreeOf4 (parseSchemaType "contractRate")) , ("[SettlementPeriodsFixedPrice]", fmap FourOf4 (many1 (parseSchemaType "settlementPeriodsPrice"))) ])) ] `apply` optional (parseSchemaType "totalPrice") `apply` oneOf' [ ("OneOf3 CommodityNotionalQuantitySchedule CommodityNotionalQuantity [CommoditySettlementPeriodsNotionalQuantity] Xsd.Decimal", fmap OneOf2 (return (,) `apply` oneOf' [ ("CommodityNotionalQuantitySchedule", fmap OneOf3 (parseSchemaType "notionalQuantitySchedule")) , ("CommodityNotionalQuantity", fmap TwoOf3 (parseSchemaType "notionalQuantity")) , ("[CommoditySettlementPeriodsNotionalQuantity]", fmap ThreeOf3 (many1 (parseSchemaType "settlementPeriodsNotionalQuantity"))) ] `apply` parseSchemaType "totalNotionalQuantity")) , ("QuantityReference", fmap TwoOf2 (parseSchemaType "quantityReference")) ] `apply` oneOf' [ ("CommodityRelativePaymentDates", fmap OneOf2 (parseSchemaType "relativePaymentDates")) , ("(Maybe (OneOf2 AdjustableDatesOrRelativeDateOffset Xsd.Boolean))", fmap TwoOf2 (optional (oneOf' [ ("AdjustableDatesOrRelativeDateOffset", fmap OneOf2 (parseSchemaType "paymentDates")) , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "masterAgreementPaymentDates")) ]))) ] `apply` optional (parseSchemaType "flatRate") `apply` optional (parseSchemaType "flatRateAmount") schemaTypeToXML s x@FixedPriceLeg{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ fixedPriceLeg_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ fixedPriceLeg_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ fixedPriceLeg_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ fixedPriceLeg_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ fixedPriceLeg_receiverAccountReference x , foldOneOf4 (schemaTypeToXML "calculationDates") (schemaTypeToXML "calculationPeriods") (schemaTypeToXML "calculationPeriodsSchedule") (maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") )) $ fixedPriceLeg_choice4 x , foldOneOf2 (schemaTypeToXML "fixedPriceSchedule") (foldOneOf4 (schemaTypeToXML "fixedPrice") (schemaTypeToXML "worldscaleRate") (schemaTypeToXML "contractRate") (concatMap (schemaTypeToXML "settlementPeriodsPrice")) ) $ fixedPriceLeg_choice5 x , maybe [] (schemaTypeToXML "totalPrice") $ fixedPriceLeg_totalPrice x , foldOneOf2 (\ (a,b) -> concat [ foldOneOf3 (schemaTypeToXML "notionalQuantitySchedule") (schemaTypeToXML "notionalQuantity") (concatMap (schemaTypeToXML "settlementPeriodsNotionalQuantity")) a , schemaTypeToXML "totalNotionalQuantity" b ]) (schemaTypeToXML "quantityReference") $ fixedPriceLeg_choice7 x , foldOneOf2 (schemaTypeToXML "relativePaymentDates") (maybe [] (foldOneOf2 (schemaTypeToXML "paymentDates") (schemaTypeToXML "masterAgreementPaymentDates") )) $ fixedPriceLeg_choice8 x , maybe [] (schemaTypeToXML "flatRate") $ fixedPriceLeg_flatRate x , maybe [] (schemaTypeToXML "flatRateAmount") $ fixedPriceLeg_flatRateAmount x ] instance Extension FixedPriceLeg FinancialSwapLeg where supertype v = FinancialSwapLeg_FixedPriceLeg v instance Extension FixedPriceLeg CommoditySwapLeg where supertype = (supertype :: FinancialSwapLeg -> CommoditySwapLeg) . (supertype :: FixedPriceLeg -> FinancialSwapLeg) instance Extension FixedPriceLeg Leg where supertype = (supertype :: CommoditySwapLeg -> Leg) . (supertype :: FinancialSwapLeg -> CommoditySwapLeg) . (supertype :: FixedPriceLeg -> FinancialSwapLeg) -- | A type to capture details relevant to the calculation of -- the floating price. data FloatingLegCalculation = FloatingLegCalculation { floatLegCalc_pricingDates :: CommodityPricingDates -- ^ Commodity Pricing Dates. , floatLegCalc_averagingMethod :: Maybe AveragingMethodEnum -- ^ The parties may specify a Method of Averaging where more -- than one pricing Dates is being specified as being -- applicable. , floatLegCalc_conversionFactor :: Maybe Xsd.Decimal -- ^ If the Notional Quantity is specified in a unit that does -- not match the unit in which the Commodity Reference Price -- is quoted, the scaling or conversion factor used to convert -- the Commodity Reference Price unit into the Notional -- Quantity unit should be stated here. If there is no -- conversion, this element is not intended to be used. , floatLegCalc_rounding :: Maybe Rounding -- ^ Rounding direction and precision for price values. , floatLegCalc_choice4 :: (Maybe (OneOf2 CommoditySpread [CommoditySpreadSchedule])) -- ^ Choice between: -- -- (1) The spread over or under the Commodity Reference Price -- for this leg of the trade. This element is intended to -- be used for basis trades. -- -- (2) The spread over or under the Commodity Reference Price -- for this leg of the trade for each Calculation Period. -- This element is intended to be used for basis trades. , floatLegCalc_fx :: Maybe CommodityFx -- ^ FX observations to be used to convert the observed -- Commodity Reference Price to the Settlement Currency. } deriving (Eq,Show) instance SchemaType FloatingLegCalculation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FloatingLegCalculation `apply` parseSchemaType "pricingDates" `apply` optional (parseSchemaType "averagingMethod") `apply` optional (parseSchemaType "conversionFactor") `apply` optional (parseSchemaType "rounding") `apply` optional (oneOf' [ ("CommoditySpread", fmap OneOf2 (parseSchemaType "spread")) , ("[CommoditySpreadSchedule]", fmap TwoOf2 (many1 (parseSchemaType "spreadSchedule"))) ]) `apply` optional (parseSchemaType "fx") schemaTypeToXML s x@FloatingLegCalculation{} = toXMLElement s [] [ schemaTypeToXML "pricingDates" $ floatLegCalc_pricingDates x , maybe [] (schemaTypeToXML "averagingMethod") $ floatLegCalc_averagingMethod x , maybe [] (schemaTypeToXML "conversionFactor") $ floatLegCalc_conversionFactor x , maybe [] (schemaTypeToXML "rounding") $ floatLegCalc_rounding x , maybe [] (foldOneOf2 (schemaTypeToXML "spread") (concatMap (schemaTypeToXML "spreadSchedule")) ) $ floatLegCalc_choice4 x , maybe [] (schemaTypeToXML "fx") $ floatLegCalc_fx x ] -- | Floating Price Leg of a Commodity Swap. data FloatingPriceLeg = FloatingPriceLeg { floatPriceLeg_ID :: Maybe Xsd.ID , floatPriceLeg_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , floatPriceLeg_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , floatPriceLeg_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , floatPriceLeg_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , floatPriceLeg_choice4 :: OneOf4 AdjustableDates AdjustableDates CommodityCalculationPeriodsSchedule ((Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))) -- ^ Choice between: -- -- (1) The Calculation Period dates for this leg of the trade -- where the Calculation Periods are all one day long, -- typically a physically-settled emissions or metals -- trade. Only dates explicitly included determine the -- Calculation Periods and there is a Calculation Period -- for each date specified. -- -- (2) The Calculation Period start dates for this leg of the -- swap. This type is only intended to be used if the -- Calculation Periods differ on each leg. If Calculation -- Periods mirror another leg, then the -- calculationPeriodsReference element should be used to -- point to the Calculation Periods on that leg - or the -- calculationPeriodsScheduleReference can be used to -- point to the Calculation Periods Schedule for that leg. -- -- (3) The Calculation Periods for this leg of the swap. This -- type is only intended to be used if the Calculation -- Periods differ on each leg. If Calculation Periods -- mirror another leg, then the -- calculationPeriodsReference element should be used to -- point to the Calculation Periods on the other leg - or -- the calculationPeriodsScheduleReference can be used to -- point to the Calculation Periods Schedule for that leg. -- -- (4) unknown , floatPriceLeg_commodity :: Commodity -- ^ Specifies the underlying instrument. At this time, only -- underlyers of type Commodity are supported; the choice -- group in the future could offer the possibility of adding -- other types later. , floatPriceLeg_choice6 :: OneOf2 ((OneOf3 CommodityNotionalQuantitySchedule CommodityNotionalQuantity [CommoditySettlementPeriodsNotionalQuantity]),Xsd.Decimal) QuantityReference -- ^ Choice between: -- -- (1) Sequence of: -- -- * unknown -- -- * The Total Notional Quantity. -- -- (2) A pointer style reference to a quantity defined on -- another leg. , floatPriceLeg_calculation :: FloatingLegCalculation -- ^ Defines details relevant to the calculation of the floating -- price. , floatPriceLeg_choice8 :: OneOf2 CommodityRelativePaymentDates ((Maybe (OneOf2 AdjustableDatesOrRelativeDateOffset Xsd.Boolean))) -- ^ Choice between: -- -- (1) The Payment Dates of the trade relative to the -- Calculation Periods. -- -- (2) unknown , floatPriceLeg_flatRate :: Maybe FlatRateEnum -- ^ Whether the Flat Rate is the New Worldwide Tanker Nominal -- Freight Scale for the Freight Index Route taken at the -- Trade Date of the transaction or taken on each Pricing -- Date. , floatPriceLeg_flatRateAmount :: Maybe NonNegativeMoney -- ^ If flatRate is set to "Fixed", the actual value of the Flat -- Rate. } deriving (Eq,Show) instance SchemaType FloatingPriceLeg where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FloatingPriceLeg a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` oneOf' [ ("AdjustableDates", fmap OneOf4 (parseSchemaType "calculationDates")) , ("AdjustableDates", fmap TwoOf4 (parseSchemaType "calculationPeriods")) , ("CommodityCalculationPeriodsSchedule", fmap ThreeOf4 (parseSchemaType "calculationPeriodsSchedule")) , ("(Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))", fmap FourOf4 (optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]))) ] `apply` parseSchemaType "commodity" `apply` oneOf' [ ("OneOf3 CommodityNotionalQuantitySchedule CommodityNotionalQuantity [CommoditySettlementPeriodsNotionalQuantity] Xsd.Decimal", fmap OneOf2 (return (,) `apply` oneOf' [ ("CommodityNotionalQuantitySchedule", fmap OneOf3 (parseSchemaType "notionalQuantitySchedule")) , ("CommodityNotionalQuantity", fmap TwoOf3 (parseSchemaType "notionalQuantity")) , ("[CommoditySettlementPeriodsNotionalQuantity]", fmap ThreeOf3 (many1 (parseSchemaType "settlementPeriodsNotionalQuantity"))) ] `apply` parseSchemaType "totalNotionalQuantity")) , ("QuantityReference", fmap TwoOf2 (parseSchemaType "quantityReference")) ] `apply` parseSchemaType "calculation" `apply` oneOf' [ ("CommodityRelativePaymentDates", fmap OneOf2 (parseSchemaType "relativePaymentDates")) , ("(Maybe (OneOf2 AdjustableDatesOrRelativeDateOffset Xsd.Boolean))", fmap TwoOf2 (optional (oneOf' [ ("AdjustableDatesOrRelativeDateOffset", fmap OneOf2 (parseSchemaType "paymentDates")) , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "masterAgreementPaymentDates")) ]))) ] `apply` optional (parseSchemaType "flatRate") `apply` optional (parseSchemaType "flatRateAmount") schemaTypeToXML s x@FloatingPriceLeg{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ floatPriceLeg_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ floatPriceLeg_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ floatPriceLeg_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ floatPriceLeg_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ floatPriceLeg_receiverAccountReference x , foldOneOf4 (schemaTypeToXML "calculationDates") (schemaTypeToXML "calculationPeriods") (schemaTypeToXML "calculationPeriodsSchedule") (maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") )) $ floatPriceLeg_choice4 x , schemaTypeToXML "commodity" $ floatPriceLeg_commodity x , foldOneOf2 (\ (a,b) -> concat [ foldOneOf3 (schemaTypeToXML "notionalQuantitySchedule") (schemaTypeToXML "notionalQuantity") (concatMap (schemaTypeToXML "settlementPeriodsNotionalQuantity")) a , schemaTypeToXML "totalNotionalQuantity" b ]) (schemaTypeToXML "quantityReference") $ floatPriceLeg_choice6 x , schemaTypeToXML "calculation" $ floatPriceLeg_calculation x , foldOneOf2 (schemaTypeToXML "relativePaymentDates") (maybe [] (foldOneOf2 (schemaTypeToXML "paymentDates") (schemaTypeToXML "masterAgreementPaymentDates") )) $ floatPriceLeg_choice8 x , maybe [] (schemaTypeToXML "flatRate") $ floatPriceLeg_flatRate x , maybe [] (schemaTypeToXML "flatRateAmount") $ floatPriceLeg_flatRateAmount x ] instance Extension FloatingPriceLeg FinancialSwapLeg where supertype v = FinancialSwapLeg_FloatingPriceLeg v instance Extension FloatingPriceLeg CommoditySwapLeg where supertype = (supertype :: FinancialSwapLeg -> CommoditySwapLeg) . (supertype :: FloatingPriceLeg -> FinancialSwapLeg) instance Extension FloatingPriceLeg Leg where supertype = (supertype :: CommoditySwapLeg -> Leg) . (supertype :: FinancialSwapLeg -> CommoditySwapLeg) . (supertype :: FloatingPriceLeg -> FinancialSwapLeg) -- | The specification of the gas to be delivered. data GasDelivery = GasDelivery { gasDelivery_choice0 :: (Maybe (OneOf2 GasDeliveryPoint ((Maybe (CommodityDeliveryPoint)),(Maybe (CommodityDeliveryPoint))))) -- ^ Choice between: -- -- (1) The physical or virtual point at which the commodity -- will be delivered. -- -- (2) Sequence of: -- -- * The physical or virtual point at which the -- commodity enters a transportation system. -- -- * The physical or virtual point at which the -- commodity is withdrawn from a transportation -- system. , gasDelivery_deliveryType :: Maybe DeliveryTypeEnum -- ^ Indicates whether the buyer and seller are contractually -- obliged to consume and supply the specified quantities of -- the commodity. , gasDelivery_buyerHub :: Maybe CommodityHub -- ^ The hub code of the gas buyer. , gasDelivery_sellerHub :: Maybe CommodityHub -- ^ The hub code of the has seller. } deriving (Eq,Show) instance SchemaType GasDelivery where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return GasDelivery `apply` optional (oneOf' [ ("GasDeliveryPoint", fmap OneOf2 (parseSchemaType "deliveryPoint")) , ("Maybe CommodityDeliveryPoint Maybe CommodityDeliveryPoint", fmap TwoOf2 (return (,) `apply` optional (parseSchemaType "entryPoint") `apply` optional (parseSchemaType "withdrawalPoint"))) ]) `apply` optional (parseSchemaType "deliveryType") `apply` optional (parseSchemaType "buyerHub") `apply` optional (parseSchemaType "sellerHub") schemaTypeToXML s x@GasDelivery{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "deliveryPoint") (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "entryPoint") a , maybe [] (schemaTypeToXML "withdrawalPoint") b ]) ) $ gasDelivery_choice0 x , maybe [] (schemaTypeToXML "deliveryType") $ gasDelivery_deliveryType x , maybe [] (schemaTypeToXML "buyerHub") $ gasDelivery_buyerHub x , maybe [] (schemaTypeToXML "sellerHub") $ gasDelivery_sellerHub x ] -- | A scheme identifying the types of the Delivery Point for a -- physically settled gas trade. data GasDeliveryPoint = GasDeliveryPoint Scheme GasDeliveryPointAttributes deriving (Eq,Show) data GasDeliveryPointAttributes = GasDeliveryPointAttributes { gasDelivPointAttrib_deliveryPointScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType GasDeliveryPoint where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "deliveryPointScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ GasDeliveryPoint v (GasDeliveryPointAttributes a0) schemaTypeToXML s (GasDeliveryPoint bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "deliveryPointScheme") $ gasDelivPointAttrib_deliveryPointScheme at ] $ schemaTypeToXML s bt instance Extension GasDeliveryPoint Scheme where supertype (GasDeliveryPoint s _) = s -- | The different options for specifying the Delivery Periods -- for a physically settled gas trade. data GasDeliveryPeriods = GasDeliveryPeriods { gasDelivPeriods_ID :: Maybe Xsd.ID , gasDelivPeriods_choice0 :: OneOf3 AdjustableDates CommodityCalculationPeriodsSchedule ((Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))) -- ^ Choice between: -- -- (1) The Delivery Periods for this leg of the swap. This -- type is only intended to be used if the Delivery -- Periods differ from the Calculation Periods on the -- fixed or floating leg. If DeliveryPeriods mirror -- another leg, then the calculationPeriodsReference -- element should be used to point to the Calculation -- Periods on that leg - or the -- calculationPeriodsScheduleReference can be used to -- point to the Calculation Periods Schedule for that leg. -- -- (2) The Delivery Periods for this leg of the swap. This -- type is only intended to be used if the Delivery -- Periods differ from the Calculation Periods on the -- fixed or floating leg. If DeliveryPeriods mirror -- another leg, then the calculationPeriodsReference -- element should be used to point to the Calculation -- Periods on that leg - or the -- calculationPeriodsScheduleReference can be used to -- point to the Calculation Periods Schedule for that leg. -- -- (3) unknown , gasDelivPeriods_supplyStartTime :: PrevailingTime -- ^ The time at which gas delivery should start on each day of -- the Delivery Period(s). , gasDelivPeriods_supplyEndTime :: PrevailingTime -- ^ The time at which gas delivery should end on each day of -- the Delivery Period(s). } deriving (Eq,Show) instance SchemaType GasDeliveryPeriods where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (GasDeliveryPeriods a0) `apply` oneOf' [ ("AdjustableDates", fmap OneOf3 (parseSchemaType "periods")) , ("CommodityCalculationPeriodsSchedule", fmap TwoOf3 (parseSchemaType "periodsSchedule")) , ("(Maybe (OneOf3 CalculationPeriodsReference CalculationPeriodsScheduleReference CalculationPeriodsDatesReference))", fmap ThreeOf3 (optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf3 (parseSchemaType "calculationPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf3 (parseSchemaType "calculationPeriodsScheduleReference")) , ("CalculationPeriodsDatesReference", fmap ThreeOf3 (parseSchemaType "calculationPeriodsDatesReference")) ]))) ] `apply` parseSchemaType "supplyStartTime" `apply` parseSchemaType "supplyEndTime" schemaTypeToXML s x@GasDeliveryPeriods{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ gasDelivPeriods_ID x ] [ foldOneOf3 (schemaTypeToXML "periods") (schemaTypeToXML "periodsSchedule") (maybe [] (foldOneOf3 (schemaTypeToXML "calculationPeriodsReference") (schemaTypeToXML "calculationPeriodsScheduleReference") (schemaTypeToXML "calculationPeriodsDatesReference") )) $ gasDelivPeriods_choice0 x , schemaTypeToXML "supplyStartTime" $ gasDelivPeriods_supplyStartTime x , schemaTypeToXML "supplyEndTime" $ gasDelivPeriods_supplyEndTime x ] instance Extension GasDeliveryPeriods CommodityDeliveryPeriods where supertype (GasDeliveryPeriods a0 e0 e1 e2) = CommodityDeliveryPeriods a0 e0 -- | Physically settled leg of a physically settled gas -- transaction. data GasPhysicalLeg = GasPhysicalLeg { gasPhysicLeg_ID :: Maybe Xsd.ID , gasPhysicLeg_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , gasPhysicLeg_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , gasPhysicLeg_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , gasPhysicLeg_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , gasPhysicLeg_deliveryPeriods :: GasDeliveryPeriods -- ^ The different options for specifying the Delivery or Supply -- Periods. Unless the quantity or price is to vary -- periodically during the trade or physical delivery occurs -- on a periodic basis, periodsSchedule should be used and set -- to 1T. , gasPhysicLeg_gas :: GasProduct -- ^ The specification of the gas to be delivered. , gasPhysicLeg_deliveryConditions :: Maybe GasDelivery -- ^ The physical delivery conditions for the transaction. , gasPhysicLeg_deliveryQuantity :: GasPhysicalQuantity -- ^ The different options for specifying the quantity. For -- Fixed trades where the quantity is known at the time of -- confirmation, a single quantity or a quantity per Delivery -- Period may be specified. For Variable trades minimum and -- maximum trades may be specified. } deriving (Eq,Show) instance SchemaType GasPhysicalLeg where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (GasPhysicalLeg a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` parseSchemaType "deliveryPeriods" `apply` parseSchemaType "gas" `apply` optional (parseSchemaType "deliveryConditions") `apply` parseSchemaType "deliveryQuantity" schemaTypeToXML s x@GasPhysicalLeg{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ gasPhysicLeg_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ gasPhysicLeg_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ gasPhysicLeg_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ gasPhysicLeg_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ gasPhysicLeg_receiverAccountReference x , schemaTypeToXML "deliveryPeriods" $ gasPhysicLeg_deliveryPeriods x , schemaTypeToXML "gas" $ gasPhysicLeg_gas x , maybe [] (schemaTypeToXML "deliveryConditions") $ gasPhysicLeg_deliveryConditions x , schemaTypeToXML "deliveryQuantity" $ gasPhysicLeg_deliveryQuantity x ] instance Extension GasPhysicalLeg PhysicalSwapLeg where supertype v = PhysicalSwapLeg_GasPhysicalLeg v instance Extension GasPhysicalLeg CommoditySwapLeg where supertype = (supertype :: PhysicalSwapLeg -> CommoditySwapLeg) . (supertype :: GasPhysicalLeg -> PhysicalSwapLeg) instance Extension GasPhysicalLeg Leg where supertype = (supertype :: CommoditySwapLeg -> Leg) . (supertype :: PhysicalSwapLeg -> CommoditySwapLeg) . (supertype :: GasPhysicalLeg -> PhysicalSwapLeg) -- | The quantity of gas to be delivered. data GasPhysicalQuantity = GasPhysicalQuantity { gasPhysicQuant_ID :: Maybe Xsd.ID , gasPhysicQuant_choice0 :: OneOf2 (((Maybe (OneOf2 CommodityNotionalQuantity CommodityPhysicalQuantitySchedule))),UnitQuantity) ([CommodityNotionalQuantity],[CommodityNotionalQuantity],(Maybe (PartyReference))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * unknown -- -- * The Total Quantity of the commodity to be -- delivered. -- -- (2) Sequence of: -- -- * The minimum quantity to be delivered. If separate -- minimums need to be specified for different periods -- (e.g. a minimum per day and a minimum per month) -- this element should be repeated. -- -- * The maximum quantity to be delivered. If separate -- minimums need to be specified for different periods -- (e.g. a minimum per day and a minimum per month) -- this element should be repeated. -- -- * Indicates the party able to choose whether the gas -- is delivered for a particular period e.g. a swing -- or interruptible contract. } deriving (Eq,Show) instance SchemaType GasPhysicalQuantity where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (GasPhysicalQuantity a0) `apply` oneOf' [ ("(Maybe (OneOf2 CommodityNotionalQuantity CommodityPhysicalQuantitySchedule)) UnitQuantity", fmap OneOf2 (return (,) `apply` optional (oneOf' [ ("CommodityNotionalQuantity", fmap OneOf2 (parseSchemaType "physicalQuantity")) , ("CommodityPhysicalQuantitySchedule", fmap TwoOf2 (parseSchemaType "physicalQuantitySchedule")) ]) `apply` parseSchemaType "totalPhysicalQuantity")) , ("[CommodityNotionalQuantity] [CommodityNotionalQuantity] Maybe PartyReference", fmap TwoOf2 (return (,,) `apply` many (parseSchemaType "minPhysicalQuantity") `apply` many (parseSchemaType "maxPhysicalQuantity") `apply` optional (parseSchemaType "electingParty"))) ] schemaTypeToXML s x@GasPhysicalQuantity{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ gasPhysicQuant_ID x ] [ foldOneOf2 (\ (a,b) -> concat [ maybe [] (foldOneOf2 (schemaTypeToXML "physicalQuantity") (schemaTypeToXML "physicalQuantitySchedule") ) a , schemaTypeToXML "totalPhysicalQuantity" b ]) (\ (a,b,c) -> concat [ concatMap (schemaTypeToXML "minPhysicalQuantity") a , concatMap (schemaTypeToXML "maxPhysicalQuantity") b , maybe [] (schemaTypeToXML "electingParty") c ]) $ gasPhysicQuant_choice0 x ] instance Extension GasPhysicalQuantity CommodityPhysicalQuantityBase where supertype v = CommodityPhysicalQuantityBase_GasPhysicalQuantity v -- | A type defining the characteristics of the gas being traded -- in a physically settled gas transaction. data GasProduct = GasProduct { gasProduct_type :: GasProductTypeEnum -- ^ The type of gas to be delivered. , gasProduct_choice1 :: (Maybe (OneOf2 NonNegativeDecimal GasQuality)) -- ^ Choice between: -- -- (1) The calorific value of the gas to be delivered, -- specified in megajoules per cubic meter (MJ/m3). -- -- (2) The quality of the gas to be delivered. } deriving (Eq,Show) instance SchemaType GasProduct where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return GasProduct `apply` parseSchemaType "type" `apply` optional (oneOf' [ ("NonNegativeDecimal", fmap OneOf2 (parseSchemaType "calorificValue")) , ("GasQuality", fmap TwoOf2 (parseSchemaType "quality")) ]) schemaTypeToXML s x@GasProduct{} = toXMLElement s [] [ schemaTypeToXML "type" $ gasProduct_type x , maybe [] (foldOneOf2 (schemaTypeToXML "calorificValue") (schemaTypeToXML "quality") ) $ gasProduct_choice1 x ] -- | The quantity of gas to be delivered. data GasQuality = GasQuality Scheme GasQualityAttributes deriving (Eq,Show) data GasQualityAttributes = GasQualityAttributes { gasQualityAttrib_gasQualityScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType GasQuality where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "gasQualityScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ GasQuality v (GasQualityAttributes a0) schemaTypeToXML s (GasQuality bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "gasQualityScheme") $ gasQualityAttrib_gasQualityScheme at ] $ schemaTypeToXML s bt instance Extension GasQuality Scheme where supertype (GasQuality s _) = s -- | An observation period that is offset from a Calculation -- Period. data Lag = Lag { lag_ID :: Maybe Xsd.ID , lag_duration :: Maybe Period -- ^ The period during which observations will be made. If a -- firstObservationDateOffset is specified, the observation -- period will start the specified interval prior to each -- Calculation Period - i.e. if the firstObservationDateOffset -- is 4 months and the lagDuration is 3 months, observations -- will be taken in months 4,3 and 2 (but not 1) prior to each -- Calculation Period. If no firstObservationDate is -- specified, the observation period will end immediately -- preceding each Calculation Period. , lag_firstObservationDateOffset :: Maybe Period -- ^ The interval between the start of each lagDuration and the -- start of each respective calculation period. } deriving (Eq,Show) instance SchemaType Lag where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Lag a0) `apply` optional (parseSchemaType "lagDuration") `apply` optional (parseSchemaType "firstObservationDateOffset") schemaTypeToXML s x@Lag{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ lag_ID x ] [ maybe [] (schemaTypeToXML "lagDuration") $ lag_duration x , maybe [] (schemaTypeToXML "firstObservationDateOffset") $ lag_firstObservationDateOffset x ] -- | Allows a lag to reference one already defined elsewhere in -- the trade. data LagReference = LagReference { lagReference_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType LagReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (LagReference a0) schemaTypeToXML s x@LagReference{} = toXMLElement s [ toXMLAttribute "href" $ lagReference_href x ] [] instance Extension LagReference Reference where supertype v = Reference_LagReference v -- | A Market Disruption Event. data MarketDisruptionEvent = MarketDisruptionEvent Scheme MarketDisruptionEventAttributes deriving (Eq,Show) data MarketDisruptionEventAttributes = MarketDisruptionEventAttributes { marketDisrupEventAttrib_commodityMarketDisruptionScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType MarketDisruptionEvent where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityMarketDisruptionScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ MarketDisruptionEvent v (MarketDisruptionEventAttributes a0) schemaTypeToXML s (MarketDisruptionEvent bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityMarketDisruptionScheme") $ marketDisrupEventAttrib_commodityMarketDisruptionScheme at ] $ schemaTypeToXML s bt instance Extension MarketDisruptionEvent Scheme where supertype (MarketDisruptionEvent s _) = s -- | The details of a fixed payment. Can be used for a forward -- transaction or as the base for a more complex fixed leg -- component such as the fixed leg of a swap. data NonPeriodicFixedPriceLeg = NonPeriodicFixedPriceLeg { nonPeriodFixedPriceLeg_ID :: Maybe Xsd.ID , nonPeriodFixedPriceLeg_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , nonPeriodFixedPriceLeg_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , nonPeriodFixedPriceLeg_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , nonPeriodFixedPriceLeg_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , nonPeriodFixedPriceLeg_fixedPrice :: FixedPrice -- ^ Fixed price on which fixed payments are based. , nonPeriodFixedPriceLeg_totalPrice :: Maybe NonNegativeMoney -- ^ The total amount of the fixed payment for all units of the -- underlying commodity. , nonPeriodFixedPriceLeg_quantityReference :: Maybe QuantityReference -- ^ A pointer style reference to a quantity defined on another -- leg. , nonPeriodFixedPriceLeg_choice7 :: OneOf2 CommodityRelativePaymentDates ((Maybe (OneOf2 AdjustableDatesOrRelativeDateOffset Xsd.Boolean))) -- ^ Choice between: -- -- (1) The Payment Dates of the trade relative to the -- Calculation Periods. -- -- (2) unknown } deriving (Eq,Show) instance SchemaType NonPeriodicFixedPriceLeg where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (NonPeriodicFixedPriceLeg a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` parseSchemaType "fixedPrice" `apply` optional (parseSchemaType "totalPrice") `apply` optional (parseSchemaType "quantityReference") `apply` oneOf' [ ("CommodityRelativePaymentDates", fmap OneOf2 (parseSchemaType "relativePaymentDates")) , ("(Maybe (OneOf2 AdjustableDatesOrRelativeDateOffset Xsd.Boolean))", fmap TwoOf2 (optional (oneOf' [ ("AdjustableDatesOrRelativeDateOffset", fmap OneOf2 (parseSchemaType "paymentDates")) , ("Xsd.Boolean", fmap TwoOf2 (parseSchemaType "masterAgreementPaymentDates")) ]))) ] schemaTypeToXML s x@NonPeriodicFixedPriceLeg{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ nonPeriodFixedPriceLeg_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ nonPeriodFixedPriceLeg_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ nonPeriodFixedPriceLeg_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ nonPeriodFixedPriceLeg_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ nonPeriodFixedPriceLeg_receiverAccountReference x , schemaTypeToXML "fixedPrice" $ nonPeriodFixedPriceLeg_fixedPrice x , maybe [] (schemaTypeToXML "totalPrice") $ nonPeriodFixedPriceLeg_totalPrice x , maybe [] (schemaTypeToXML "quantityReference") $ nonPeriodFixedPriceLeg_quantityReference x , foldOneOf2 (schemaTypeToXML "relativePaymentDates") (maybe [] (foldOneOf2 (schemaTypeToXML "paymentDates") (schemaTypeToXML "masterAgreementPaymentDates") )) $ nonPeriodFixedPriceLeg_choice7 x ] instance Extension NonPeriodicFixedPriceLeg CommoditySwapLeg where supertype v = CommoditySwapLeg_NonPeriodicFixedPriceLeg v instance Extension NonPeriodicFixedPriceLeg Leg where supertype = (supertype :: CommoditySwapLeg -> Leg) . (supertype :: NonPeriodicFixedPriceLeg -> CommoditySwapLeg) -- | The physical delivery conditions for an oil product. data OilDelivery = OilDelivery { oilDelivery_choice0 :: (Maybe (OneOf2 OilPipelineDelivery OilTransferDelivery)) -- ^ Choice between: -- -- (1) Specified the delivery conditions where the oil product -- is to be delivered by pipeline. -- -- (2) Specified the delivery conditions where the oil product -- is to be delivered by title transfer. , oilDelivery_importerOfRecord :: Maybe PartyReference -- ^ Specifies which party is the Importer of Record for the -- purposes of paying customs duties and applicable taxes or -- costs related to the import of the oil product. , oilDelivery_choice2 :: (Maybe (OneOf2 AbsoluteTolerance PercentageTolerance)) -- ^ Choice between: -- -- (1) Specifies the allowable quantity tolerance as an -- absolute quantity. -- -- (2) Specifies the allowable quantity tolerance as a -- percentage of the quantity. } deriving (Eq,Show) instance SchemaType OilDelivery where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return OilDelivery `apply` optional (oneOf' [ ("OilPipelineDelivery", fmap OneOf2 (parseSchemaType "pipeline")) , ("OilTransferDelivery", fmap TwoOf2 (parseSchemaType "transfer")) ]) `apply` optional (parseSchemaType "importerOfRecord") `apply` optional (oneOf' [ ("AbsoluteTolerance", fmap OneOf2 (parseSchemaType "absoluteTolerance")) , ("PercentageTolerance", fmap TwoOf2 (parseSchemaType "percentageTolerance")) ]) schemaTypeToXML s x@OilDelivery{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "pipeline") (schemaTypeToXML "transfer") ) $ oilDelivery_choice0 x , maybe [] (schemaTypeToXML "importerOfRecord") $ oilDelivery_importerOfRecord x , maybe [] (foldOneOf2 (schemaTypeToXML "absoluteTolerance") (schemaTypeToXML "percentageTolerance") ) $ oilDelivery_choice2 x ] -- | Physically settled leg of a physically settled oil product -- transaction. data OilPhysicalLeg = OilPhysicalLeg { oilPhysicLeg_ID :: Maybe Xsd.ID , oilPhysicLeg_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , oilPhysicLeg_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , oilPhysicLeg_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , oilPhysicLeg_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , oilPhysicLeg_deliveryPeriods :: Maybe CommodityDeliveryPeriods -- ^ The different options for specifying the Delivery or Supply -- Periods. Unless the quantity or price is to vary -- periodically during the trade or physical delivery occurs -- on a periodic basis, periodsSchedule should be used and set -- to 1T. , oilPhysicLeg_oil :: OilProduct -- ^ The specification of the oil product to be delivered. , oilPhysicLeg_deliveryConditions :: Maybe OilDelivery -- ^ The physical delivery conditions for the transaction. , oilPhysicLeg_deliveryQuantity :: CommodityPhysicalQuantity -- ^ The different options for specifying the quantity. } deriving (Eq,Show) instance SchemaType OilPhysicalLeg where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (OilPhysicalLeg a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "deliveryPeriods") `apply` parseSchemaType "oil" `apply` optional (parseSchemaType "deliveryConditions") `apply` parseSchemaType "deliveryQuantity" schemaTypeToXML s x@OilPhysicalLeg{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ oilPhysicLeg_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ oilPhysicLeg_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ oilPhysicLeg_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ oilPhysicLeg_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ oilPhysicLeg_receiverAccountReference x , maybe [] (schemaTypeToXML "deliveryPeriods") $ oilPhysicLeg_deliveryPeriods x , schemaTypeToXML "oil" $ oilPhysicLeg_oil x , maybe [] (schemaTypeToXML "deliveryConditions") $ oilPhysicLeg_deliveryConditions x , schemaTypeToXML "deliveryQuantity" $ oilPhysicLeg_deliveryQuantity x ] instance Extension OilPhysicalLeg PhysicalSwapLeg where supertype v = PhysicalSwapLeg_OilPhysicalLeg v instance Extension OilPhysicalLeg CommoditySwapLeg where supertype = (supertype :: PhysicalSwapLeg -> CommoditySwapLeg) . (supertype :: OilPhysicalLeg -> PhysicalSwapLeg) instance Extension OilPhysicalLeg Leg where supertype = (supertype :: CommoditySwapLeg -> Leg) . (supertype :: PhysicalSwapLeg -> CommoditySwapLeg) . (supertype :: OilPhysicalLeg -> PhysicalSwapLeg) -- | The physical delivery conditions specific to an oil product -- delivered by pipeline. data OilPipelineDelivery = OilPipelineDelivery { oilPipelDeliv_pipelineName :: Maybe CommodityPipeline -- ^ The name of pipeline by which the oil product will be -- delivered. , oilPipelDeliv_withdrawalPoint :: Maybe CommodityDeliveryPoint -- ^ The location at which the transfer of the title to the -- commodity takes place. , oilPipelDeliv_entryPoint :: Maybe CommodityDeliveryPoint -- ^ The point at which the oil product will enter the pipeline. , oilPipelDeliv_deliverableByBarge :: Maybe Xsd.Boolean -- ^ Whether or not the delivery can go to barge. For trades -- documented under the ISDA Master Agreement and Oil Annex, -- this should always be set to 'false'. , oilPipelDeliv_risk :: Maybe CommodityDeliveryRisk -- ^ Specifies how the risk associated with the delivery is -- assigned. For trades documented under the ISDA Master -- Agreement and Oil Annex, this presence of this element -- indicates that the provisions of clause (b)(i) of the ISDA -- Oil Annex are being varied. , oilPipelDeliv_cycle :: [CommodityPipelineCycle] -- ^ The cycle(s) during which the oil product will be -- transported in the pipeline. } deriving (Eq,Show) instance SchemaType OilPipelineDelivery where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return OilPipelineDelivery `apply` optional (parseSchemaType "pipelineName") `apply` optional (parseSchemaType "withdrawalPoint") `apply` optional (parseSchemaType "entryPoint") `apply` optional (parseSchemaType "deliverableByBarge") `apply` optional (parseSchemaType "risk") `apply` many (parseSchemaType "cycle") schemaTypeToXML s x@OilPipelineDelivery{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "pipelineName") $ oilPipelDeliv_pipelineName x , maybe [] (schemaTypeToXML "withdrawalPoint") $ oilPipelDeliv_withdrawalPoint x , maybe [] (schemaTypeToXML "entryPoint") $ oilPipelDeliv_entryPoint x , maybe [] (schemaTypeToXML "deliverableByBarge") $ oilPipelDeliv_deliverableByBarge x , maybe [] (schemaTypeToXML "risk") $ oilPipelDeliv_risk x , concatMap (schemaTypeToXML "cycle") $ oilPipelDeliv_cycle x ] -- | The specification of the oil product to be delivered. data OilProduct = OilProduct { oilProduct_type :: OilProductType -- ^ The type of oil product to be delivered. , oilProduct_grade :: CommodityProductGrade -- ^ The grade of oil product to be delivered. } deriving (Eq,Show) instance SchemaType OilProduct where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return OilProduct `apply` parseSchemaType "type" `apply` parseSchemaType "grade" schemaTypeToXML s x@OilProduct{} = toXMLElement s [] [ schemaTypeToXML "type" $ oilProduct_type x , schemaTypeToXML "grade" $ oilProduct_grade x ] -- | The type of physical commodity product to be delivered. data OilProductType = OilProductType Scheme OilProductTypeAttributes deriving (Eq,Show) data OilProductTypeAttributes = OilProductTypeAttributes { oilProductTypeAttrib_commodityOilProductTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType OilProductType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "commodityOilProductTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ OilProductType v (OilProductTypeAttributes a0) schemaTypeToXML s (OilProductType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "commodityOilProductTypeScheme") $ oilProductTypeAttrib_commodityOilProductTypeScheme at ] $ schemaTypeToXML s bt instance Extension OilProductType Scheme where supertype (OilProductType s _) = s -- | The physical delivery conditions specific to an oil product -- delivered by title transfer. data OilTransferDelivery = OilTransferDelivery { oilTransfDeliv_applicable :: Maybe Xsd.Boolean -- ^ Indicates that the oil product will be delivered by title -- transfer. Should always be set to "true". , oilTransfDeliv_deliveryLocation :: Maybe CommodityDeliveryPoint -- ^ The location at which the transfer of the title to the -- commodity takes place. } deriving (Eq,Show) instance SchemaType OilTransferDelivery where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return OilTransferDelivery `apply` optional (parseSchemaType "applicable") `apply` optional (parseSchemaType "deliveryLocation") schemaTypeToXML s x@OilTransferDelivery{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "applicable") $ oilTransfDeliv_applicable x , maybe [] (schemaTypeToXML "deliveryLocation") $ oilTransfDeliv_deliveryLocation x ] -- | The acceptable tolerance in the delivered quantity of a -- physical commodity product in terms of a percentage of the -- agreed delivery quantity. data PercentageTolerance = PercentageTolerance { percenToler_postitive :: Maybe RestrictedPercentage -- ^ The maximum percentage amount by which the quantity -- delivered can exceed the agreed quantity. , percenToler_negative :: Maybe RestrictedPercentage -- ^ The maximum percentage amount by which the quantity -- delivered can be less than the agreed quantity. , percenToler_option :: Maybe PartyReference -- ^ Indicates whether the tolerance it at the seller's or -- buyer's option. } deriving (Eq,Show) instance SchemaType PercentageTolerance where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PercentageTolerance `apply` optional (parseSchemaType "postitive") `apply` optional (parseSchemaType "negative") `apply` optional (parseSchemaType "option") schemaTypeToXML s x@PercentageTolerance{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "postitive") $ percenToler_postitive x , maybe [] (schemaTypeToXML "negative") $ percenToler_negative x , maybe [] (schemaTypeToXML "option") $ percenToler_option x ] -- | The common components of a physically settled leg of a -- Commodity Forward. This is an abstract type and should be -- extended by commodity-specific types. data PhysicalForwardLeg = PhysicalForwardLeg_BullionPhysicalLeg BullionPhysicalLeg deriving (Eq,Show) instance SchemaType PhysicalForwardLeg where parseSchemaType s = do (fmap PhysicalForwardLeg_BullionPhysicalLeg $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of PhysicalForwardLeg,\n\ \ namely one of:\n\ \BullionPhysicalLeg" schemaTypeToXML _s (PhysicalForwardLeg_BullionPhysicalLeg x) = schemaTypeToXML "bullionPhysicalLeg" x instance Extension PhysicalForwardLeg CommodityForwardLeg where supertype v = CommodityForwardLeg_PhysicalForwardLeg v -- | The common components of a physically settled leg of a -- Commodity Swap. This is an abstract type and should be -- extended by commodity-specific types. data PhysicalSwapLeg = PhysicalSwapLeg_OilPhysicalLeg OilPhysicalLeg | PhysicalSwapLeg_GasPhysicalLeg GasPhysicalLeg | PhysicalSwapLeg_ElectricityPhysicalLeg ElectricityPhysicalLeg | PhysicalSwapLeg_CoalPhysicalLeg CoalPhysicalLeg deriving (Eq,Show) instance SchemaType PhysicalSwapLeg where parseSchemaType s = do (fmap PhysicalSwapLeg_OilPhysicalLeg $ parseSchemaType s) `onFail` (fmap PhysicalSwapLeg_GasPhysicalLeg $ parseSchemaType s) `onFail` (fmap PhysicalSwapLeg_ElectricityPhysicalLeg $ parseSchemaType s) `onFail` (fmap PhysicalSwapLeg_CoalPhysicalLeg $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of PhysicalSwapLeg,\n\ \ namely one of:\n\ \OilPhysicalLeg,GasPhysicalLeg,ElectricityPhysicalLeg,CoalPhysicalLeg" schemaTypeToXML _s (PhysicalSwapLeg_OilPhysicalLeg x) = schemaTypeToXML "oilPhysicalLeg" x schemaTypeToXML _s (PhysicalSwapLeg_GasPhysicalLeg x) = schemaTypeToXML "gasPhysicalLeg" x schemaTypeToXML _s (PhysicalSwapLeg_ElectricityPhysicalLeg x) = schemaTypeToXML "electricityPhysicalLeg" x schemaTypeToXML _s (PhysicalSwapLeg_CoalPhysicalLeg x) = schemaTypeToXML "coalPhysicalLeg" x instance Extension PhysicalSwapLeg CommoditySwapLeg where supertype v = CommoditySwapLeg_PhysicalSwapLeg v -- | A pointer tyle reference to a Quantity schedule defined -- elsewhere. data QuantityScheduleReference = QuantityScheduleReference { quantSchedRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType QuantityScheduleReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (QuantityScheduleReference a0) schemaTypeToXML s x@QuantityScheduleReference{} = toXMLElement s [ toXMLAttribute "href" $ quantSchedRef_href x ] [] instance Extension QuantityScheduleReference Reference where supertype v = Reference_QuantityScheduleReference v -- | A pointer tyle reference to a Quantity defined elsewhere. data QuantityReference = QuantityReference { quantRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType QuantityReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (QuantityReference a0) schemaTypeToXML s x@QuantityReference{} = toXMLElement s [ toXMLAttribute "href" $ quantRef_href x ] [] instance Extension QuantityReference Reference where supertype v = Reference_QuantityReference v -- | A Disruption Fallback with the sequence in which it should -- be applied relative to other Disruption Fallbacks. data SequencedDisruptionFallback = SequencedDisruptionFallback { sequenDisrupFallb_fallback :: Maybe DisruptionFallback -- ^ Disruption fallback that applies to the trade. , sequenDisrupFallb_sequence :: Maybe Xsd.PositiveInteger -- ^ Sequence in which the reference to the disruption fallback -- should be applied. } deriving (Eq,Show) instance SchemaType SequencedDisruptionFallback where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return SequencedDisruptionFallback `apply` optional (parseSchemaType "fallback") `apply` optional (parseSchemaType "sequence") schemaTypeToXML s x@SequencedDisruptionFallback{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "fallback") $ sequenDisrupFallb_fallback x , maybe [] (schemaTypeToXML "sequence") $ sequenDisrupFallb_sequence x ] -- | Specifies a set of Settlement Periods associated with an -- Electricity Transaction for delivery on an Applicable Day -- or for a series of Applicable Days. data SettlementPeriods = SettlementPeriods { settlPeriods_ID :: Maybe Xsd.ID , settlPeriods_duration :: Maybe SettlementPeriodDurationEnum -- ^ The length of each Settlement Period. , settlPeriods_applicableDay :: [DayOfWeekEnum] -- ^ Specifies the Applicable Day with respect to a range of -- Settlement Periods. This element can only be omitted if -- includesHolidays is present, in which case this range of -- Settlement Periods will apply to days that are holidays -- only. , settlPeriods_startTime :: Maybe OffsetPrevailingTime -- ^ Specifies the hour-ending Start Time with respect to a -- range of Settlement Periods. , settlPeriods_endTime :: Maybe OffsetPrevailingTime -- ^ Specifies the hour-ending End Time with respect to a range -- of Settlement Periods. If neither startTime nor endTime -- contain an offset element and endTime is earlier than -- startTime, this indicates that the time period "wraps -- around" midnight. For example, if startTime is 23:00 and -- endTime is 01:00 then Settlement Periods apply from 00:00 -- to 01:00 and 23:00 to 00:00 on each included day. , settlPeriods_choice4 :: (Maybe (OneOf2 CommodityBusinessCalendar CommodityBusinessCalendar)) -- ^ Choice between: -- -- (1) Indicates that days that are holidays according to the -- referenced commodity business calendar should be -- excluded from this range of Settlement Periods, even if -- such day is an applicable day. -- -- (2) Indicates that days that are holidays according to the -- referenced commodity business calendar should be -- included in this range of Settlement Periods, even if -- such day is not an applicable day. } deriving (Eq,Show) instance SchemaType SettlementPeriods where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (SettlementPeriods a0) `apply` optional (parseSchemaType "duration") `apply` between (Occurs (Just 0) (Just 7)) (parseSchemaType "applicableDay") `apply` optional (parseSchemaType "startTime") `apply` optional (parseSchemaType "endTime") `apply` optional (oneOf' [ ("CommodityBusinessCalendar", fmap OneOf2 (parseSchemaType "excludeHolidays")) , ("CommodityBusinessCalendar", fmap TwoOf2 (parseSchemaType "includeHolidays")) ]) schemaTypeToXML s x@SettlementPeriods{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ settlPeriods_ID x ] [ maybe [] (schemaTypeToXML "duration") $ settlPeriods_duration x , concatMap (schemaTypeToXML "applicableDay") $ settlPeriods_applicableDay x , maybe [] (schemaTypeToXML "startTime") $ settlPeriods_startTime x , maybe [] (schemaTypeToXML "endTime") $ settlPeriods_endTime x , maybe [] (foldOneOf2 (schemaTypeToXML "excludeHolidays") (schemaTypeToXML "includeHolidays") ) $ settlPeriods_choice4 x ] -- | A type defining the Fixed Price applicable to a range or -- ranges of Settlement Periods. data SettlementPeriodsFixedPrice = SettlementPeriodsFixedPrice { settlPeriodsFixedPrice_ID :: Maybe Xsd.ID , settlPeriodsFixedPrice_price :: Xsd.Decimal -- ^ The Fixed Price. , settlPeriodsFixedPrice_priceCurrency :: Currency -- ^ Currency of the fixed price. , settlPeriodsFixedPrice_priceUnit :: QuantityUnit -- ^ The unit of measure used to calculate the Fixed Price. , settlPeriodsFixedPrice_settlementPeriodsReference :: [SettlementPeriodsReference] } deriving (Eq,Show) instance SchemaType SettlementPeriodsFixedPrice where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (SettlementPeriodsFixedPrice a0) `apply` parseSchemaType "price" `apply` parseSchemaType "priceCurrency" `apply` parseSchemaType "priceUnit" `apply` many (parseSchemaType "settlementPeriodsReference") schemaTypeToXML s x@SettlementPeriodsFixedPrice{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ settlPeriodsFixedPrice_ID x ] [ schemaTypeToXML "price" $ settlPeriodsFixedPrice_price x , schemaTypeToXML "priceCurrency" $ settlPeriodsFixedPrice_priceCurrency x , schemaTypeToXML "priceUnit" $ settlPeriodsFixedPrice_priceUnit x , concatMap (schemaTypeToXML "settlementPeriodsReference") $ settlPeriodsFixedPrice_settlementPeriodsReference x ] instance Extension SettlementPeriodsFixedPrice FixedPrice where supertype (SettlementPeriodsFixedPrice a0 e0 e1 e2 e3) = FixedPrice a0 e0 e1 e2 -- | Allows a set of Settlement Periods to reference one already -- defined elsewhere in the trade. data SettlementPeriodsReference = SettlementPeriodsReference { settlPeriodsRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType SettlementPeriodsReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (SettlementPeriodsReference a0) schemaTypeToXML s x@SettlementPeriodsReference{} = toXMLElement s [ toXMLAttribute "href" $ settlPeriodsRef_href x ] [] instance Extension SettlementPeriodsReference Reference where supertype v = Reference_SettlementPeriodsReference v -- | The specification of the Settlement Periods in which the -- electricity will be delivered for a "shaped" trade i.e. -- where different Settlement Period ranges will apply to -- different periods of the trade. data SettlementPeriodsSchedule = SettlementPeriodsSchedule { settlPeriodsSched_settlementPeriodsStep :: [SettlementPeriodsStep] -- ^ The range of Settlement Periods per Calculation Period. -- There must be a range of Settlement Periods specified for -- each Calculation Period, regardless of whether the range of -- Settlement Periods changes or stays the same between -- periods. , settlPeriodsSched_choice1 :: (Maybe (OneOf2 CalculationPeriodsReference CalculationPeriodsScheduleReference)) -- ^ Choice between: -- -- (1) A pointer style reference to the Delivery Periods -- defined elsewhere. -- -- (2) A pointer style reference to the Calculation Periods -- Schedule defined elsewhere. } deriving (Eq,Show) instance SchemaType SettlementPeriodsSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return SettlementPeriodsSchedule `apply` many (parseSchemaType "settlementPeriodsStep") `apply` optional (oneOf' [ ("CalculationPeriodsReference", fmap OneOf2 (parseSchemaType "deliveryPeriodsReference")) , ("CalculationPeriodsScheduleReference", fmap TwoOf2 (parseSchemaType "deliveryPeriodsScheduleReference")) ]) schemaTypeToXML s x@SettlementPeriodsSchedule{} = toXMLElement s [] [ concatMap (schemaTypeToXML "settlementPeriodsStep") $ settlPeriodsSched_settlementPeriodsStep x , maybe [] (foldOneOf2 (schemaTypeToXML "deliveryPeriodsReference") (schemaTypeToXML "deliveryPeriodsScheduleReference") ) $ settlPeriodsSched_choice1 x ] -- | A reference to the range of Settlement Periods that applies -- to a given period of a transaction. data SettlementPeriodsStep = SettlementPeriodsStep { settlPeriodsStep_settlementPeriodsReference :: [SettlementPeriodsReference] -- ^ The specification of the Settlement Periods in which the -- electricity will be delivered. The Settlement Periods will -- apply for the duration of the appliable period. If more -- than one settlementPeriods element is present this -- indicates multiple ranges of Settlement Periods apply for -- the duration of the applicable period. } deriving (Eq,Show) instance SchemaType SettlementPeriodsStep where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return SettlementPeriodsStep `apply` many (parseSchemaType "settlementPeriodsReference") schemaTypeToXML s x@SettlementPeriodsStep{} = toXMLElement s [] [ concatMap (schemaTypeToXML "settlementPeriodsReference") $ settlPeriodsStep_settlementPeriodsReference x ] -- | A quantity and associated unit. data UnitQuantity = UnitQuantity { unitQuantity_ID :: Maybe Xsd.ID , unitQuantity_quantityUnit :: QuantityUnit -- ^ Quantity Unit is the unit of measure applicable for the -- quantity on the Transaction. , unitQuantity_quantity :: NonNegativeDecimal -- ^ Amount of commodity per quantity frequency. } deriving (Eq,Show) instance SchemaType UnitQuantity where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (UnitQuantity a0) `apply` parseSchemaType "quantityUnit" `apply` parseSchemaType "quantity" schemaTypeToXML s x@UnitQuantity{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ unitQuantity_ID x ] [ schemaTypeToXML "quantityUnit" $ unitQuantity_quantityUnit x , schemaTypeToXML "quantity" $ unitQuantity_quantity x ] -- | The physical leg of a Commodity Forward Transaction for -- which the underlyer is Bullion. elementBullionPhysicalLeg :: XMLParser BullionPhysicalLeg elementBullionPhysicalLeg = parseSchemaType "bullionPhysicalLeg" elementToXMLBullionPhysicalLeg :: BullionPhysicalLeg -> [Content ()] elementToXMLBullionPhysicalLeg = schemaTypeToXML "bullionPhysicalLeg" -- | Physically settled coal leg. elementCoalPhysicalLeg :: XMLParser CoalPhysicalLeg elementCoalPhysicalLeg = parseSchemaType "coalPhysicalLeg" elementToXMLCoalPhysicalLeg :: CoalPhysicalLeg -> [Content ()] elementToXMLCoalPhysicalLeg = schemaTypeToXML "coalPhysicalLeg" -- | Defines a commodity forward product. elementCommodityForward :: XMLParser CommodityForward elementCommodityForward = parseSchemaType "commodityForward" elementToXMLCommodityForward :: CommodityForward -> [Content ()] elementToXMLCommodityForward = schemaTypeToXML "commodityForward" -- | Defines the substitutable commodity forward leg elementCommodityForwardLeg :: XMLParser CommodityForwardLeg elementCommodityForwardLeg = fmap supertype elementBullionPhysicalLeg `onFail` fail "Parse failed when expecting an element in the substitution group for\n\ \ ,\n\ \ namely one of:\n\ \" elementToXMLCommodityForwardLeg :: CommodityForwardLeg -> [Content ()] elementToXMLCommodityForwardLeg = schemaTypeToXML "commodityForwardLeg" -- | Defines a commodity option product. elementCommodityOption :: XMLParser CommodityOption elementCommodityOption = parseSchemaType "commodityOption" elementToXMLCommodityOption :: CommodityOption -> [Content ()] elementToXMLCommodityOption = schemaTypeToXML "commodityOption" -- | Defines a commodity swap product. elementCommoditySwap :: XMLParser CommoditySwap elementCommoditySwap = parseSchemaType "commoditySwap" elementToXMLCommoditySwap :: CommoditySwap -> [Content ()] elementToXMLCommoditySwap = schemaTypeToXML "commoditySwap" -- | Defines a commodity swaption product elementCommoditySwaption :: XMLParser CommoditySwaption elementCommoditySwaption = parseSchemaType "commoditySwaption" elementToXMLCommoditySwaption :: CommoditySwaption -> [Content ()] elementToXMLCommoditySwaption = schemaTypeToXML "commoditySwaption" -- | Defines the substitutable commodity swap leg elementCommoditySwapLeg :: XMLParser CommoditySwapLeg elementCommoditySwapLeg = fmap supertype elementOilPhysicalLeg `onFail` fmap supertype elementGasPhysicalLeg `onFail` fmap supertype elementFloatingLeg `onFail` fmap supertype elementFixedLeg `onFail` fmap supertype elementElectricityPhysicalLeg `onFail` fmap supertype elementCoalPhysicalLeg `onFail` fail "Parse failed when expecting an element in the substitution group for\n\ \ ,\n\ \ namely one of:\n\ \, , , , , " elementToXMLCommoditySwapLeg :: CommoditySwapLeg -> [Content ()] elementToXMLCommoditySwapLeg = schemaTypeToXML "commoditySwapLeg" -- | Physically settled electricity leg. elementElectricityPhysicalLeg :: XMLParser ElectricityPhysicalLeg elementElectricityPhysicalLeg = parseSchemaType "electricityPhysicalLeg" elementToXMLElectricityPhysicalLeg :: ElectricityPhysicalLeg -> [Content ()] elementToXMLElectricityPhysicalLeg = schemaTypeToXML "electricityPhysicalLeg" -- | Fixed Price Leg. elementFixedLeg :: XMLParser FixedPriceLeg elementFixedLeg = parseSchemaType "fixedLeg" elementToXMLFixedLeg :: FixedPriceLeg -> [Content ()] elementToXMLFixedLeg = schemaTypeToXML "fixedLeg" -- | Floating Price leg. elementFloatingLeg :: XMLParser FloatingPriceLeg elementFloatingLeg = parseSchemaType "floatingLeg" elementToXMLFloatingLeg :: FloatingPriceLeg -> [Content ()] elementToXMLFloatingLeg = schemaTypeToXML "floatingLeg" -- | Physically settled natural gas leg. elementGasPhysicalLeg :: XMLParser GasPhysicalLeg elementGasPhysicalLeg = parseSchemaType "gasPhysicalLeg" elementToXMLGasPhysicalLeg :: GasPhysicalLeg -> [Content ()] elementToXMLGasPhysicalLeg = schemaTypeToXML "gasPhysicalLeg" -- | Physically settled oil or refined products leg. elementOilPhysicalLeg :: XMLParser OilPhysicalLeg elementOilPhysicalLeg = parseSchemaType "oilPhysicalLeg" elementToXMLOilPhysicalLeg :: OilPhysicalLeg -> [Content ()] elementToXMLOilPhysicalLeg = schemaTypeToXML "oilPhysicalLeg"