{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} module Data.FpML.V53.Shared ( module Data.FpML.V53.Shared , module Data.FpML.V53.Enum ) 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.Enum -- Some hs-boot imports are required, for fwd-declaring types. import {-# SOURCE #-} Data.FpML.V53.FX ( FxEuropeanExercise ) import {-# SOURCE #-} Data.FpML.V53.FX ( FxDigitalAmericanExercise ) import {-# SOURCE #-} Data.FpML.V53.Com ( CommodityPhysicalEuropeanExercise ) import {-# SOURCE #-} Data.FpML.V53.Com ( CommodityPhysicalAmericanExercise ) import {-# SOURCE #-} Data.FpML.V53.Com ( CommodityEuropeanExercise ) import {-# SOURCE #-} Data.FpML.V53.Com ( CommodityAmericanExercise ) import {-# SOURCE #-} Data.FpML.V53.Eqd ( EquityEuropeanExercise ) import {-# SOURCE #-} Data.FpML.V53.IRD ( InterestRateStream ) import {-# SOURCE #-} Data.FpML.V53.FX ( FxSwapLeg ) import {-# SOURCE #-} Data.FpML.V53.Shared.EQ ( DirectionalLeg ) import {-# SOURCE #-} Data.FpML.V53.Com ( CommoditySwapLeg ) import {-# SOURCE #-} Data.FpML.V53.Com ( CommodityForwardLeg ) import {-# SOURCE #-} Data.FpML.V53.CD ( FeeLeg ) import {-# SOURCE #-} Data.FpML.V53.Asset ( PendingPayment ) import {-# SOURCE #-} Data.FpML.V53.Shared.Option ( FeaturePayment ) import {-# SOURCE #-} Data.FpML.V53.IRD ( PaymentCalculationPeriod ) import {-# SOURCE #-} Data.FpML.V53.Shared.EQ ( ReturnSwapAdditionalPayment ) import {-# SOURCE #-} Data.FpML.V53.Shared.EQ ( EquityPremium ) import {-# SOURCE #-} Data.FpML.V53.Doc ( PaymentDetail ) import {-# SOURCE #-} Data.FpML.V53.Swaps.Dividend ( FixedPaymentAmount ) import {-# SOURCE #-} Data.FpML.V53.CD ( SinglePayment ) import {-# SOURCE #-} Data.FpML.V53.CD ( PeriodicPayment ) import {-# SOURCE #-} Data.FpML.V53.CD ( InitialPayment ) import {-# SOURCE #-} Data.FpML.V53.Eqd ( PrePayment ) import {-# SOURCE #-} Data.FpML.V53.Mktenv ( YieldCurve ) import {-# SOURCE #-} Data.FpML.V53.Mktenv ( VolatilityRepresentation ) import {-# SOURCE #-} Data.FpML.V53.Mktenv ( FxCurve ) import {-# SOURCE #-} Data.FpML.V53.Mktenv ( CreditCurve ) import {-# SOURCE #-} Data.FpML.V53.Standard ( StandardProduct ) import {-# SOURCE #-} Data.FpML.V53.Shared.Option ( Option ) import {-# SOURCE #-} Data.FpML.V53.IRD ( Swaption ) import {-# SOURCE #-} Data.FpML.V53.IRD ( Swap ) import {-# SOURCE #-} Data.FpML.V53.IRD ( Fra ) import {-# SOURCE #-} Data.FpML.V53.IRD ( CapFloor ) import {-# SOURCE #-} Data.FpML.V53.IRD ( BulletPayment ) import {-# SOURCE #-} Data.FpML.V53.Generic ( GenericProduct ) import {-# SOURCE #-} Data.FpML.V53.FX ( TermDeposit ) import {-# SOURCE #-} Data.FpML.V53.FX ( FxSwap ) import {-# SOURCE #-} Data.FpML.V53.FX ( FxSingleLeg ) import {-# SOURCE #-} Data.FpML.V53.Shared.EQ ( ReturnSwapBase ) import {-# SOURCE #-} Data.FpML.V53.Shared.EQ ( NettedSwapBase ) import {-# SOURCE #-} Data.FpML.V53.Doc ( Strategy ) import {-# SOURCE #-} Data.FpML.V53.Doc ( InstrumentTradeDetails ) import {-# SOURCE #-} Data.FpML.V53.Swaps.Dividend ( DividendSwapTransactionSupplement ) import {-# SOURCE #-} Data.FpML.V53.Com ( CommoditySwaption ) import {-# SOURCE #-} Data.FpML.V53.Com ( CommoditySwap ) import {-# SOURCE #-} Data.FpML.V53.Com ( CommodityOption ) import {-# SOURCE #-} Data.FpML.V53.Com ( CommodityForward ) import {-# SOURCE #-} Data.FpML.V53.CD ( CreditDefaultSwap ) import {-# SOURCE #-} Data.FpML.V53.Eqd ( EquityDerivativeBase ) import {-# SOURCE #-} Data.FpML.V53.Swaps.Variance ( VarianceSwapTransactionSupplement ) import {-# SOURCE #-} Data.FpML.V53.Asset ( AssetReference ) import {-# SOURCE #-} Data.FpML.V53.Asset ( AnyAssetReference ) import {-# SOURCE #-} Data.FpML.V53.Shared.Option ( CreditEventsReference ) import {-# SOURCE #-} Data.FpML.V53.IRD ( ValuationDatesReference ) import {-# SOURCE #-} Data.FpML.V53.IRD ( ResetDatesReference ) import {-# SOURCE #-} Data.FpML.V53.IRD ( RelevantUnderlyingDateReference ) import {-# SOURCE #-} Data.FpML.V53.IRD ( PaymentDatesReference ) import {-# SOURCE #-} Data.FpML.V53.IRD ( InterestRateStreamReference ) import {-# SOURCE #-} Data.FpML.V53.IRD ( CalculationPeriodDatesReference ) import {-# SOURCE #-} Data.FpML.V53.FX ( MoneyReference ) import {-# SOURCE #-} Data.FpML.V53.Shared.EQ ( InterestLegCalculationPeriodDatesReference ) import {-# SOURCE #-} Data.FpML.V53.Shared.EQ ( FloatingRateCalculationReference ) import {-# SOURCE #-} Data.FpML.V53.Com ( SettlementPeriodsReference ) import {-# SOURCE #-} Data.FpML.V53.Com ( QuantityReference ) import {-# SOURCE #-} Data.FpML.V53.Com ( QuantityScheduleReference ) import {-# SOURCE #-} Data.FpML.V53.Com ( LagReference ) import {-# SOURCE #-} Data.FpML.V53.Com ( CalculationPeriodsScheduleReference ) import {-# SOURCE #-} Data.FpML.V53.Com ( CalculationPeriodsReference ) import {-# SOURCE #-} Data.FpML.V53.Com ( CalculationPeriodsDatesReference ) import {-# SOURCE #-} Data.FpML.V53.CD ( SettlementTermsReference ) import {-# SOURCE #-} Data.FpML.V53.CD ( ProtectionTermsReference ) import {-# SOURCE #-} Data.FpML.V53.CD ( FixedRateReference ) import {-# SOURCE #-} Data.FpML.V53.Riskdef ( ValuationScenarioReference ) import {-# SOURCE #-} Data.FpML.V53.Riskdef ( ValuationReference ) import {-# SOURCE #-} Data.FpML.V53.Riskdef ( SensitivitySetDefinitionReference ) import {-# SOURCE #-} Data.FpML.V53.Riskdef ( PricingParameterDerivativeReference ) import {-# SOURCE #-} Data.FpML.V53.Riskdef ( PricingDataPointCoordinateReference ) import {-# SOURCE #-} Data.FpML.V53.Riskdef ( MarketReference ) import {-# SOURCE #-} Data.FpML.V53.Riskdef ( AssetOrTermPointOrPricingStructureReference ) import {-# SOURCE #-} Data.FpML.V53.Standard ( elementStandardProduct, elementToXMLStandardProduct ) import {-# SOURCE #-} Data.FpML.V53.IRD ( elementSwaption, elementToXMLSwaption ) import {-# SOURCE #-} Data.FpML.V53.IRD ( elementSwap, elementToXMLSwap ) import {-# SOURCE #-} Data.FpML.V53.IRD ( elementFra, elementToXMLFra ) import {-# SOURCE #-} Data.FpML.V53.IRD ( elementCapFloor, elementToXMLCapFloor ) import {-# SOURCE #-} Data.FpML.V53.IRD ( elementBulletPayment, elementToXMLBulletPayment ) import {-# SOURCE #-} Data.FpML.V53.Generic ( elementNonSchemaProduct, elementToXMLNonSchemaProduct ) import {-# SOURCE #-} Data.FpML.V53.Generic ( elementGenericProduct, elementToXMLGenericProduct ) import {-# SOURCE #-} Data.FpML.V53.FX ( elementTermDeposit, elementToXMLTermDeposit ) import {-# SOURCE #-} Data.FpML.V53.FX ( elementFxDigitalOption, elementToXMLFxDigitalOption ) import {-# SOURCE #-} Data.FpML.V53.FX ( elementFxOption, elementToXMLFxOption ) import {-# SOURCE #-} Data.FpML.V53.FX ( elementFxSwap, elementToXMLFxSwap ) import {-# SOURCE #-} Data.FpML.V53.FX ( elementFxSingleLeg, elementToXMLFxSingleLeg ) import {-# SOURCE #-} Data.FpML.V53.Shared.EQ ( elementReturnSwap, elementToXMLReturnSwap ) import {-# SOURCE #-} Data.FpML.V53.Doc ( elementStrategy, elementToXMLStrategy ) import {-# SOURCE #-} Data.FpML.V53.Doc ( elementInstrumentTradeDetails, elementToXMLInstrumentTradeDetails ) import {-# SOURCE #-} Data.FpML.V53.Swaps.Dividend ( elementDividendSwapTransactionSupplement, elementToXMLDividendSwapTransactionSupplement ) import {-# SOURCE #-} Data.FpML.V53.Swaps.Correlation ( elementCorrelationSwap, elementToXMLCorrelationSwap ) import {-# SOURCE #-} Data.FpML.V53.Com ( elementCommoditySwaption, elementToXMLCommoditySwaption ) import {-# SOURCE #-} Data.FpML.V53.Com ( elementCommoditySwap, elementToXMLCommoditySwap ) import {-# SOURCE #-} Data.FpML.V53.Com ( elementCommodityOption, elementToXMLCommodityOption ) import {-# SOURCE #-} Data.FpML.V53.Com ( elementCommodityForward, elementToXMLCommodityForward ) import {-# SOURCE #-} Data.FpML.V53.CD ( elementCreditDefaultSwapOption, elementToXMLCreditDefaultSwapOption ) import {-# SOURCE #-} Data.FpML.V53.CD ( elementCreditDefaultSwap, elementToXMLCreditDefaultSwap ) import {-# SOURCE #-} Data.FpML.V53.Option.Bond ( elementBondOption, elementToXMLBondOption ) import {-# SOURCE #-} Data.FpML.V53.Swaps.Return ( elementEquitySwapTransactionSupplement, elementToXMLEquitySwapTransactionSupplement ) import {-# SOURCE #-} Data.FpML.V53.Eqd ( elementEquityOptionTransactionSupplement, elementToXMLEquityOptionTransactionSupplement ) import {-# SOURCE #-} Data.FpML.V53.Eqd ( elementEquityOption, elementToXMLEquityOption ) import {-# SOURCE #-} Data.FpML.V53.Eqd ( elementEquityForward, elementToXMLEquityForward ) import {-# SOURCE #-} Data.FpML.V53.Eqd ( elementBrokerEquityOption, elementToXMLBrokerEquityOption ) import {-# SOURCE #-} Data.FpML.V53.Swaps.Variance ( elementVarianceSwapTransactionSupplement, elementToXMLVarianceSwapTransactionSupplement ) import {-# SOURCE #-} Data.FpML.V53.Swaps.Variance ( elementVarianceSwap, elementToXMLVarianceSwap ) import {-# SOURCE #-} Data.FpML.V53.Swaps.Variance ( elementVarianceOptionTransactionSupplement, elementToXMLVarianceOptionTransactionSupplement ) -- | A type defining a number specified as a decimal between -1 -- and 1 inclusive. newtype CorrelationValue = CorrelationValue Xsd.Decimal deriving (Eq,Show) instance Restricts CorrelationValue Xsd.Decimal where restricts (CorrelationValue x) = x instance SchemaType CorrelationValue where parseSchemaType s = do e <- element [s] commit $ interior e $ parseSimpleType schemaTypeToXML s (CorrelationValue x) = toXMLElement s [] [toXMLText (simpleTypeText x)] instance SimpleType CorrelationValue where acceptingParser = fmap CorrelationValue acceptingParser -- XXX should enforce the restrictions somehow? -- The restrictions are: -- (RangeR (Occurs (Just (-1)) (Just 1))) simpleTypeText (CorrelationValue x) = simpleTypeText x -- | A type defining a time specified in hh:mm:ss format where -- the second component must be '00', e.g. 11am would be -- represented as 11:00:00. newtype HourMinuteTime = HourMinuteTime Xsd.Time deriving (Eq,Show) instance Restricts HourMinuteTime Xsd.Time where restricts (HourMinuteTime x) = x instance SchemaType HourMinuteTime where parseSchemaType s = do e <- element [s] commit $ interior e $ parseSimpleType schemaTypeToXML s (HourMinuteTime x) = toXMLElement s [] [toXMLText (simpleTypeText x)] instance SimpleType HourMinuteTime where acceptingParser = fmap HourMinuteTime acceptingParser -- XXX should enforce the restrictions somehow? -- The restrictions are: -- (Pattern [0-2][0-9]:[0-5][0-9]:00) simpleTypeText (HourMinuteTime x) = simpleTypeText x -- | A type defining a number specified as non negative decimal -- greater than 0 inclusive. newtype NonNegativeDecimal = NonNegativeDecimal Xsd.Decimal deriving (Eq,Show) instance Restricts NonNegativeDecimal Xsd.Decimal where restricts (NonNegativeDecimal x) = x instance SchemaType NonNegativeDecimal where parseSchemaType s = do e <- element [s] commit $ interior e $ parseSimpleType schemaTypeToXML s (NonNegativeDecimal x) = toXMLElement s [] [toXMLText (simpleTypeText x)] instance SimpleType NonNegativeDecimal where acceptingParser = fmap NonNegativeDecimal acceptingParser -- XXX should enforce the restrictions somehow? -- The restrictions are: -- (RangeR (Occurs (Just 0) Nothing)) simpleTypeText (NonNegativeDecimal x) = simpleTypeText x -- | A type defining a number specified as positive decimal -- greater than 0 exclusive. newtype PositiveDecimal = PositiveDecimal Xsd.Decimal deriving (Eq,Show) instance Restricts PositiveDecimal Xsd.Decimal where restricts (PositiveDecimal x) = x instance SchemaType PositiveDecimal where parseSchemaType s = do e <- element [s] commit $ interior e $ parseSimpleType schemaTypeToXML s (PositiveDecimal x) = toXMLElement s [] [toXMLText (simpleTypeText x)] instance SimpleType PositiveDecimal where acceptingParser = fmap PositiveDecimal acceptingParser -- XXX should enforce the restrictions somehow? -- The restrictions are: -- (RangeR (Occurs (Just 1) Nothing)) simpleTypeText (PositiveDecimal x) = simpleTypeText x -- | A type defining a percentage specified as decimal from 0 to -- 1. A percentage of 5% would be represented as 0.05. newtype RestrictedPercentage = RestrictedPercentage Xsd.Decimal deriving (Eq,Show) instance Restricts RestrictedPercentage Xsd.Decimal where restricts (RestrictedPercentage x) = x instance SchemaType RestrictedPercentage where parseSchemaType s = do e <- element [s] commit $ interior e $ parseSimpleType schemaTypeToXML s (RestrictedPercentage x) = toXMLElement s [] [toXMLText (simpleTypeText x)] instance SimpleType RestrictedPercentage where acceptingParser = fmap RestrictedPercentage acceptingParser -- XXX should enforce the restrictions somehow? -- The restrictions are: -- (RangeR (Occurs (Just 0) (Just 1))) simpleTypeText (RestrictedPercentage x) = simpleTypeText x -- | The base class for all types which define coding schemes. newtype Scheme = Scheme Xsd.NormalizedString deriving (Eq,Show) instance Restricts Scheme Xsd.NormalizedString where restricts (Scheme x) = x instance SchemaType Scheme where parseSchemaType s = do e <- element [s] commit $ interior e $ parseSimpleType schemaTypeToXML s (Scheme x) = toXMLElement s [] [toXMLText (simpleTypeText x)] instance SimpleType Scheme where acceptingParser = fmap Scheme acceptingParser -- XXX should enforce the restrictions somehow? -- The restrictions are: -- (StrLength (Occurs Nothing (Just 255))) simpleTypeText (Scheme x) = simpleTypeText x -- | A type defining a token of length between 1 and 60 -- characters inclusive. newtype Token60 = Token60 Xsd.Token deriving (Eq,Show) instance Restricts Token60 Xsd.Token where restricts (Token60 x) = x instance SchemaType Token60 where parseSchemaType s = do e <- element [s] commit $ interior e $ parseSimpleType schemaTypeToXML s (Token60 x) = toXMLElement s [] [toXMLText (simpleTypeText x)] instance SimpleType Token60 where acceptingParser = fmap Token60 acceptingParser -- XXX should enforce the restrictions somehow? -- The restrictions are: -- (StrLength (Occurs (Just 1) (Just 60))) simpleTypeText (Token60 x) = simpleTypeText x -- | A generic account that represents any party's account at -- another party. Parties may be identified by the account at -- another party. data Account = Account { account_ID :: Xsd.ID -- ^ The unique identifier for the account within the document. , account_id :: Maybe AccountId -- ^ An account identifier. For example an Account number. , account_name :: Maybe AccountName -- ^ The name by which the account is known. , account_beneficiary :: Maybe PartyReference -- ^ A reference to the party beneficiary of the account. , account_servicingParty :: Maybe PartyReference -- ^ A reference to the party that services/supports the -- account. } deriving (Eq,Show) instance SchemaType Account where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "id" e pos commit $ interior e $ return (Account a0) `apply` optional (parseSchemaType "accountId") `apply` optional (parseSchemaType "accountName") `apply` optional (parseSchemaType "accountBeneficiary") `apply` optional (parseSchemaType "servicingParty") schemaTypeToXML s x@Account{} = toXMLElement s [ toXMLAttribute "id" $ account_ID x ] [ maybe [] (schemaTypeToXML "accountId") $ account_id x , maybe [] (schemaTypeToXML "accountName") $ account_name x , maybe [] (schemaTypeToXML "accountBeneficiary") $ account_beneficiary x , maybe [] (schemaTypeToXML "servicingParty") $ account_servicingParty x ] -- | The data type used for account identifiers. data AccountId = AccountId Scheme AccountIdAttributes deriving (Eq,Show) data AccountIdAttributes = AccountIdAttributes { accountIdAttrib_accountIdScheme :: Maybe Xsd.AnyURI -- ^ The identifier scheme used with this accountId. A unique -- URI to determine the authoritative issuer of these -- identifiers. } deriving (Eq,Show) instance SchemaType AccountId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "accountIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ AccountId v (AccountIdAttributes a0) schemaTypeToXML s (AccountId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "accountIdScheme") $ accountIdAttrib_accountIdScheme at ] $ schemaTypeToXML s bt instance Extension AccountId Scheme where supertype (AccountId s _) = s -- | The data type used for the name of the account. data AccountName = AccountName Scheme AccountNameAttributes deriving (Eq,Show) data AccountNameAttributes = AccountNameAttributes { accountNameAttrib_accountNameScheme :: Maybe Xsd.AnyURI -- ^ The identifier scheme used with this accountName. A unique -- URI to determine the source of the account name. } deriving (Eq,Show) instance SchemaType AccountName where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "accountNameScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ AccountName v (AccountNameAttributes a0) schemaTypeToXML s (AccountName bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "accountNameScheme") $ accountNameAttrib_accountNameScheme at ] $ schemaTypeToXML s bt instance Extension AccountName Scheme where supertype (AccountName s _) = s -- | Reference to an account. data AccountReference = AccountReference { accountRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType AccountReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (AccountReference a0) schemaTypeToXML s x@AccountReference{} = toXMLElement s [ toXMLAttribute "href" $ accountRef_href x ] [] instance Extension AccountReference Reference where supertype v = Reference_AccountReference v -- | A type that represents a physical postal address. data Address = Address { address_streetAddress :: Maybe StreetAddress -- ^ The set of street and building number information that -- identifies a postal address within a city. , address_city :: Maybe Xsd.XsdString -- ^ The city component of a postal address. , address_state :: Maybe Xsd.XsdString -- ^ A country subdivision used in postal addresses in some -- countries. For example, US states, Canadian provinces, -- Swiss cantons. , address_country :: Maybe CountryCode -- ^ The ISO 3166 standard code for the country within which the -- postal address is located. , address_postalCode :: Maybe Xsd.XsdString -- ^ The code, required for computerised mail sorting systems, -- that is allocated to a physical address by a national -- postal authority. } deriving (Eq,Show) instance SchemaType Address where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Address `apply` optional (parseSchemaType "streetAddress") `apply` optional (parseSchemaType "city") `apply` optional (parseSchemaType "state") `apply` optional (parseSchemaType "country") `apply` optional (parseSchemaType "postalCode") schemaTypeToXML s x@Address{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "streetAddress") $ address_streetAddress x , maybe [] (schemaTypeToXML "city") $ address_city x , maybe [] (schemaTypeToXML "state") $ address_state x , maybe [] (schemaTypeToXML "country") $ address_country x , maybe [] (schemaTypeToXML "postalCode") $ address_postalCode x ] -- | A type that represents information about a unit within an -- organization. data BusinessUnit = BusinessUnit { businessUnit_ID :: Maybe Xsd.ID , businessUnit_name :: Maybe Xsd.XsdString -- ^ A name used to describe the organization unit , businessUnit_id :: Maybe Unit -- ^ An identifier used to uniquely identify organization unit , businessUnit_contactInfo :: Maybe ContactInformation -- ^ Information on how to contact the unit using various means. , businessUnit_country :: Maybe CountryCode -- ^ The ISO 3166 standard code for the country where the -- individual works. } deriving (Eq,Show) instance SchemaType BusinessUnit where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (BusinessUnit a0) `apply` optional (parseSchemaType "name") `apply` optional (parseSchemaType "businessUnitId") `apply` optional (parseSchemaType "contactInfo") `apply` optional (parseSchemaType "country") schemaTypeToXML s x@BusinessUnit{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ businessUnit_ID x ] [ maybe [] (schemaTypeToXML "name") $ businessUnit_name x , maybe [] (schemaTypeToXML "businessUnitId") $ businessUnit_id x , maybe [] (schemaTypeToXML "contactInfo") $ businessUnit_contactInfo x , maybe [] (schemaTypeToXML "country") $ businessUnit_country x ] -- | A type that represents information about a person connected -- with a trade or business process. data Person = Person { person_ID :: Maybe Xsd.ID , person_honorific :: Maybe Xsd.NormalizedString -- ^ An honorific title, such as Mr., Ms., Dr. etc. , person_firstName :: Maybe Xsd.NormalizedString -- ^ Given name, such as John or Mary. , person_choice2 :: (Maybe (OneOf2 [Xsd.NormalizedString] [Initial])) -- ^ Choice between: -- -- (1) middleName -- -- (2) initial , person_surname :: Maybe Xsd.NormalizedString -- ^ Family name, such as Smith or Jones. , person_suffix :: Maybe Xsd.NormalizedString -- ^ Name suffix, such as Jr., III, etc. , person_id :: [PersonId] -- ^ An identifier assigned by a system for uniquely identifying -- the individual , person_businessUnitReference :: Maybe BusinessUnitReference -- ^ The unit for which the indvidual works. , person_contactInfo :: Maybe ContactInformation -- ^ Information on how to contact the individual using various -- means. , person_country :: Maybe CountryCode -- ^ The ISO 3166 standard code for the country where the -- individual works. } deriving (Eq,Show) instance SchemaType Person where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Person a0) `apply` optional (parseSchemaType "honorific") `apply` optional (parseSchemaType "firstName") `apply` optional (oneOf' [ ("[Xsd.NormalizedString]", fmap OneOf2 (many1 (parseSchemaType "middleName"))) , ("[Initial]", fmap TwoOf2 (many1 (parseSchemaType "initial"))) ]) `apply` optional (parseSchemaType "surname") `apply` optional (parseSchemaType "suffix") `apply` many (parseSchemaType "personId") `apply` optional (parseSchemaType "businessUnitReference") `apply` optional (parseSchemaType "contactInfo") `apply` optional (parseSchemaType "country") schemaTypeToXML s x@Person{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ person_ID x ] [ maybe [] (schemaTypeToXML "honorific") $ person_honorific x , maybe [] (schemaTypeToXML "firstName") $ person_firstName x , maybe [] (foldOneOf2 (concatMap (schemaTypeToXML "middleName")) (concatMap (schemaTypeToXML "initial")) ) $ person_choice2 x , maybe [] (schemaTypeToXML "surname") $ person_surname x , maybe [] (schemaTypeToXML "suffix") $ person_suffix x , concatMap (schemaTypeToXML "personId") $ person_id x , maybe [] (schemaTypeToXML "businessUnitReference") $ person_businessUnitReference x , maybe [] (schemaTypeToXML "contactInfo") $ person_contactInfo x , maybe [] (schemaTypeToXML "country") $ person_country x ] newtype Initial = Initial Xsd.NormalizedString deriving (Eq,Show) instance Restricts Initial Xsd.NormalizedString where restricts (Initial x) = x instance SchemaType Initial where parseSchemaType s = do e <- element [s] commit $ interior e $ parseSimpleType schemaTypeToXML s (Initial x) = toXMLElement s [] [toXMLText (simpleTypeText x)] instance SimpleType Initial where acceptingParser = fmap Initial acceptingParser -- XXX should enforce the restrictions somehow? -- The restrictions are: -- (StrLength (Occurs (Just 1) (Just 1))) simpleTypeText (Initial x) = simpleTypeText x -- | An identifier used to identify an individual person. data PersonId = PersonId Scheme PersonIdAttributes deriving (Eq,Show) data PersonIdAttributes = PersonIdAttributes { personIdAttrib_personIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType PersonId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "personIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ PersonId v (PersonIdAttributes a0) schemaTypeToXML s (PersonId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "personIdScheme") $ personIdAttrib_personIdScheme at ] $ schemaTypeToXML s bt instance Extension PersonId Scheme where supertype (PersonId s _) = s -- | A type used to record information about a unit, -- subdivision, desk, or other similar business entity. data Unit = Unit Scheme UnitAttributes deriving (Eq,Show) data UnitAttributes = UnitAttributes { unitAttrib_unitScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType Unit where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "unitScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ Unit v (UnitAttributes a0) schemaTypeToXML s (Unit bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "unitScheme") $ unitAttrib_unitScheme at ] $ schemaTypeToXML s bt instance Extension Unit Scheme where supertype (Unit s _) = s -- | A type that represents how to contact an individual or -- organization. data ContactInformation = ContactInformation { contactInfo_telephone :: [TelephoneNumber] -- ^ A telephonic contact. , contactInfo_email :: [Xsd.NormalizedString] -- ^ An address on an electronic mail or messaging sysem . , contactInfo_address :: Maybe Address -- ^ A postal or street address. } deriving (Eq,Show) instance SchemaType ContactInformation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ContactInformation `apply` many (parseSchemaType "telephone") `apply` many (parseSchemaType "email") `apply` optional (parseSchemaType "address") schemaTypeToXML s x@ContactInformation{} = toXMLElement s [] [ concatMap (schemaTypeToXML "telephone") $ contactInfo_telephone x , concatMap (schemaTypeToXML "email") $ contactInfo_email x , maybe [] (schemaTypeToXML "address") $ contactInfo_address x ] -- | A type that represents a telephonic contact. data TelephoneNumber = TelephoneNumber { telephNumber_type :: Maybe TelephoneTypeEnum -- ^ The type of telephone number (work, personal, mobile). , telephNumber_number :: Maybe Xsd.XsdString -- ^ A telephonic contact. } deriving (Eq,Show) instance SchemaType TelephoneNumber where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return TelephoneNumber `apply` optional (parseSchemaType "type") `apply` optional (parseSchemaType "number") schemaTypeToXML s x@TelephoneNumber{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "type") $ telephNumber_type x , maybe [] (schemaTypeToXML "number") $ telephNumber_number x ] -- | A type for defining a date that shall be subject to -- adjustment if it would otherwise fall on a day that is not -- a business day in the specified business centers, together -- with the convention for adjusting the date. data AdjustableDate = AdjustableDate { adjustDate_ID :: Maybe Xsd.ID , adjustDate_unadjustedDate :: IdentifiedDate -- ^ A date subject to adjustment. , adjustDate_dateAdjustments :: Maybe BusinessDayAdjustments -- ^ The business day convention and financial business centers -- used for adjusting the date if it would otherwise fall on a -- day that is not a business date in the specified business -- centers. , adjustDate_adjustedDate :: Maybe IdentifiedDate -- ^ The date once the adjustment has been performed. (Note that -- this date may change if the business center holidays -- change). } deriving (Eq,Show) instance SchemaType AdjustableDate where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AdjustableDate a0) `apply` parseSchemaType "unadjustedDate" `apply` optional (parseSchemaType "dateAdjustments") `apply` optional (parseSchemaType "adjustedDate") schemaTypeToXML s x@AdjustableDate{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ adjustDate_ID x ] [ schemaTypeToXML "unadjustedDate" $ adjustDate_unadjustedDate x , maybe [] (schemaTypeToXML "dateAdjustments") $ adjustDate_dateAdjustments x , maybe [] (schemaTypeToXML "adjustedDate") $ adjustDate_adjustedDate x ] -- | A type that is different from AdjustableDate in two -- regards. First, date adjustments can be specified with -- either a dateAdjustments element or a reference to an -- existing dateAdjustments element. Second, it does not -- require the specification of date adjustments. data AdjustableDate2 = AdjustableDate2 { adjustDate2_ID :: Maybe Xsd.ID , adjustDate2_unadjustedDate :: IdentifiedDate -- ^ A date subject to adjustment. , adjustDate2_choice1 :: (Maybe (OneOf2 BusinessDayAdjustments BusinessDayAdjustmentsReference)) -- ^ Choice between: -- -- (1) The business day convention and financial business -- centers used for adjusting the date if it would -- otherwise fall on a day that is not a business dat in -- the specified business centers. -- -- (2) A pointer style reference to date adjustments defined -- elsewhere in the document. , adjustDate2_adjustedDate :: Maybe IdentifiedDate -- ^ The date once the adjustment has been performed. (Note that -- this date may change if the business center holidays -- change). } deriving (Eq,Show) instance SchemaType AdjustableDate2 where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AdjustableDate2 a0) `apply` parseSchemaType "unadjustedDate" `apply` optional (oneOf' [ ("BusinessDayAdjustments", fmap OneOf2 (parseSchemaType "dateAdjustments")) , ("BusinessDayAdjustmentsReference", fmap TwoOf2 (parseSchemaType "dateAdjustmentsReference")) ]) `apply` optional (parseSchemaType "adjustedDate") schemaTypeToXML s x@AdjustableDate2{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ adjustDate2_ID x ] [ schemaTypeToXML "unadjustedDate" $ adjustDate2_unadjustedDate x , maybe [] (foldOneOf2 (schemaTypeToXML "dateAdjustments") (schemaTypeToXML "dateAdjustmentsReference") ) $ adjustDate2_choice1 x , maybe [] (schemaTypeToXML "adjustedDate") $ adjustDate2_adjustedDate x ] -- | A type for defining a series of dates that shall be subject -- to adjustment if they would otherwise fall on a day that is -- not a business day in the specified business centers, -- together with the convention for adjusting the dates. data AdjustableDates = AdjustableDates { adjustDates_ID :: Maybe Xsd.ID , adjustDates_unadjustedDate :: [IdentifiedDate] -- ^ A date subject to adjustment. , adjustDates_dateAdjustments :: Maybe BusinessDayAdjustments -- ^ The business day convention and financial business centers -- used for adjusting the date if it would otherwise fall on a -- day that is not a business dat in the specified business -- centers. , adjustDates_adjustedDate :: [IdentifiedDate] -- ^ The date once the adjustment has been performed. (Note that -- this date may change if the business center holidays -- change). } deriving (Eq,Show) instance SchemaType AdjustableDates where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AdjustableDates a0) `apply` many (parseSchemaType "unadjustedDate") `apply` optional (parseSchemaType "dateAdjustments") `apply` many (parseSchemaType "adjustedDate") schemaTypeToXML s x@AdjustableDates{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ adjustDates_ID x ] [ concatMap (schemaTypeToXML "unadjustedDate") $ adjustDates_unadjustedDate x , maybe [] (schemaTypeToXML "dateAdjustments") $ adjustDates_dateAdjustments x , concatMap (schemaTypeToXML "adjustedDate") $ adjustDates_adjustedDate x ] -- | A type for defining a series of dates, either as a list of -- adjustable dates, or a as a repeating sequence from a base -- date data AdjustableDatesOrRelativeDateOffset = AdjustableDatesOrRelativeDateOffset { adordo_choice0 :: (Maybe (OneOf2 AdjustableDates RelativeDateOffset)) -- ^ Choice between: -- -- (1) A series of adjustable dates -- -- (2) A series of dates specified as a repeating sequence -- from a base date. } deriving (Eq,Show) instance SchemaType AdjustableDatesOrRelativeDateOffset where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return AdjustableDatesOrRelativeDateOffset `apply` optional (oneOf' [ ("AdjustableDates", fmap OneOf2 (parseSchemaType "adjustableDates")) , ("RelativeDateOffset", fmap TwoOf2 (parseSchemaType "relativeDate")) ]) schemaTypeToXML s x@AdjustableDatesOrRelativeDateOffset{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "adjustableDates") (schemaTypeToXML "relativeDate") ) $ adordo_choice0 x ] -- | A type for defining a date that shall be subject to -- adjustment if it would otherwise fall on a day that is not -- a business day in the specified business centers, together -- with the convention for adjusting the date. data AdjustableOrAdjustedDate = AdjustableOrAdjustedDate { adjustOrAdjustDate_ID :: Maybe Xsd.ID , adjustOrAdjustDate_choice0 :: OneOf2 (IdentifiedDate,(Maybe (BusinessDayAdjustments)),(Maybe (IdentifiedDate))) IdentifiedDate -- ^ Choice between: -- -- (1) Sequence of: -- -- * A date subject to adjustment. -- -- * The business day convention and financial business -- centers used for adjusting the date if it would -- otherwise fall on a day that is not a business date -- in the specified business centers. -- -- * The date once the adjustment has been performed. -- (Note that this date may change if the business -- center holidays change). -- -- (2) The date once the adjustment has been performed. (Note -- that this date may change if the business center -- holidays change). } deriving (Eq,Show) instance SchemaType AdjustableOrAdjustedDate where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AdjustableOrAdjustedDate a0) `apply` oneOf' [ ("IdentifiedDate Maybe BusinessDayAdjustments Maybe IdentifiedDate", fmap OneOf2 (return (,,) `apply` parseSchemaType "unadjustedDate" `apply` optional (parseSchemaType "dateAdjustments") `apply` optional (parseSchemaType "adjustedDate"))) , ("IdentifiedDate", fmap TwoOf2 (parseSchemaType "adjustedDate")) ] schemaTypeToXML s x@AdjustableOrAdjustedDate{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ adjustOrAdjustDate_ID x ] [ foldOneOf2 (\ (a,b,c) -> concat [ schemaTypeToXML "unadjustedDate" a , maybe [] (schemaTypeToXML "dateAdjustments") b , maybe [] (schemaTypeToXML "adjustedDate") c ]) (schemaTypeToXML "adjustedDate") $ adjustOrAdjustDate_choice0 x ] -- | A type giving the choice between defining a date as an -- explicit date together with applicable adjustments or as -- relative to some other (anchor) date. data AdjustableOrRelativeDate = AdjustableOrRelativeDate { adjustOrRelatDate_ID :: Maybe Xsd.ID , adjustOrRelatDate_choice0 :: (Maybe (OneOf2 AdjustableDate RelativeDateOffset)) -- ^ Choice between: -- -- (1) A date that shall be subject to adjustment if it would -- otherwise fall on a day that is not a business day in -- the specified business centers, together with the -- convention for adjusting the date. -- -- (2) A date specified as some offset to another date (the -- anchor date). } deriving (Eq,Show) instance SchemaType AdjustableOrRelativeDate where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AdjustableOrRelativeDate a0) `apply` optional (oneOf' [ ("AdjustableDate", fmap OneOf2 (parseSchemaType "adjustableDate")) , ("RelativeDateOffset", fmap TwoOf2 (parseSchemaType "relativeDate")) ]) schemaTypeToXML s x@AdjustableOrRelativeDate{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ adjustOrRelatDate_ID x ] [ maybe [] (foldOneOf2 (schemaTypeToXML "adjustableDate") (schemaTypeToXML "relativeDate") ) $ adjustOrRelatDate_choice0 x ] -- | A type giving the choice between defining a series of dates -- as an explicit list of dates together with applicable -- adjustments or as relative to some other series of (anchor) -- dates. data AdjustableOrRelativeDates = AdjustableOrRelativeDates { adjustOrRelatDates_ID :: Maybe Xsd.ID , adjustOrRelatDates_choice0 :: (Maybe (OneOf2 AdjustableDates RelativeDates)) -- ^ Choice between: -- -- (1) A series of dates that shall be subject to adjustment -- if they would otherwise fall on a day that is not a -- business day in the specified business centers, -- together with the convention for adjusting the date. -- -- (2) A series of dates specified as some offset to another -- series of dates (the anchor dates). } deriving (Eq,Show) instance SchemaType AdjustableOrRelativeDates where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AdjustableOrRelativeDates a0) `apply` optional (oneOf' [ ("AdjustableDates", fmap OneOf2 (parseSchemaType "adjustableDates")) , ("RelativeDates", fmap TwoOf2 (parseSchemaType "relativeDates")) ]) schemaTypeToXML s x@AdjustableOrRelativeDates{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ adjustOrRelatDates_ID x ] [ maybe [] (foldOneOf2 (schemaTypeToXML "adjustableDates") (schemaTypeToXML "relativeDates") ) $ adjustOrRelatDates_choice0 x ] data AdjustableRelativeOrPeriodicDates = AdjustableRelativeOrPeriodicDates { adjustRelatOrPeriodDates_ID :: Maybe Xsd.ID , adjustRelatOrPeriodDates_choice0 :: (Maybe (OneOf3 AdjustableDates RelativeDateSequence PeriodicDates)) -- ^ Choice between: -- -- (1) A series of dates that shall be subject to adjustment -- if they would otherwise fall on a day that is not a -- business day in the specified business centers, -- together with the convention for adjusting the date. -- -- (2) A series of dates specified as some offset to other -- dates (the anchor dates) which can -- -- (3) periodicDates } deriving (Eq,Show) instance SchemaType AdjustableRelativeOrPeriodicDates where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AdjustableRelativeOrPeriodicDates a0) `apply` optional (oneOf' [ ("AdjustableDates", fmap OneOf3 (parseSchemaType "adjustableDates")) , ("RelativeDateSequence", fmap TwoOf3 (parseSchemaType "relativeDateSequence")) , ("PeriodicDates", fmap ThreeOf3 (parseSchemaType "periodicDates")) ]) schemaTypeToXML s x@AdjustableRelativeOrPeriodicDates{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ adjustRelatOrPeriodDates_ID x ] [ maybe [] (foldOneOf3 (schemaTypeToXML "adjustableDates") (schemaTypeToXML "relativeDateSequence") (schemaTypeToXML "periodicDates") ) $ adjustRelatOrPeriodDates_choice0 x ] -- | A type giving the choice between defining a series of dates -- as an explicit list of dates together with applicable -- adjustments, or as relative to some other series of -- (anchor) dates, or as a set of factors to specify periodic -- occurences. data AdjustableRelativeOrPeriodicDates2 = AdjustableRelativeOrPeriodicDates2 { adjustRelatOrPeriodDates2_ID :: Maybe Xsd.ID , adjustRelatOrPeriodDates2_choice0 :: (Maybe (OneOf3 AdjustableDates RelativeDates PeriodicDates)) -- ^ Choice between: -- -- (1) A series of dates that shall be subject to adjustment -- if they would otherwise fall on a day that is not a -- business day in the specified business centers, -- together with the convention for adjusting the date. -- -- (2) A series of dates specified as some offset to another -- series of dates (the anchor dates). -- -- (3) periodicDates } deriving (Eq,Show) instance SchemaType AdjustableRelativeOrPeriodicDates2 where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AdjustableRelativeOrPeriodicDates2 a0) `apply` optional (oneOf' [ ("AdjustableDates", fmap OneOf3 (parseSchemaType "adjustableDates")) , ("RelativeDates", fmap TwoOf3 (parseSchemaType "relativeDates")) , ("PeriodicDates", fmap ThreeOf3 (parseSchemaType "periodicDates")) ]) schemaTypeToXML s x@AdjustableRelativeOrPeriodicDates2{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ adjustRelatOrPeriodDates2_ID x ] [ maybe [] (foldOneOf3 (schemaTypeToXML "adjustableDates") (schemaTypeToXML "relativeDates") (schemaTypeToXML "periodicDates") ) $ adjustRelatOrPeriodDates2_choice0 x ] -- | A type defining a date (referred to as the derived date) as -- a relative offset from another date (referred to as the -- anchor date) plus optional date adjustments. data AdjustedRelativeDateOffset = AdjustedRelativeDateOffset { adjustRelatDateOffset_ID :: Maybe Xsd.ID , adjustRelatDateOffset_periodMultiplier :: Xsd.Integer -- ^ A time period multiplier, e.g. 1, 2 or 3 etc. A negative -- value can be used when specifying an offset relative to -- another date, e.g. -2 days. , adjustRelatDateOffset_period :: PeriodEnum -- ^ A time period, e.g. a day, week, month or year of the -- stream. If the periodMultiplier value is 0 (zero) then -- period must contain the value D (day). , adjustRelatDateOffset_dayType :: Maybe DayTypeEnum -- ^ In the case of an offset specified as a number of days, -- this element defines whether consideration is given as to -- whether a day is a good business day or not. If a day type -- of business days is specified then non-business days are -- ignored when calculating the offset. The financial business -- centers to use for determination of business days are -- implied by the context in which this element is used. This -- element must only be included when the offset is specified -- as a number of days. If the offset is zero days then the -- dayType element should not be included. , adjustRelatDateOffset_businessDayConvention :: Maybe BusinessDayConventionEnum -- ^ The convention for adjusting a date if it would otherwise -- fall on a day that is not a business day. , adjustRelatDateOffset_choice4 :: (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 , adjustRelatDateOffset_dateRelativeTo :: Maybe DateReference -- ^ Specifies the anchor as an href attribute. The href -- attribute value is a pointer style reference to the element -- or component elsewhere in the document where the anchor -- date is defined. , adjustRelatDateOffset_adjustedDate :: Maybe IdentifiedDate -- ^ The date once the adjustment has been performed. (Note that -- this date may change if the business center holidays -- change). , adjustRelatDateOffset_relativeDateAdjustments :: Maybe BusinessDayAdjustments -- ^ The business day convention and financial business centers -- used for adjusting the relative date if it would otherwise -- fall on a day that is not a business date in the specified -- business centers. } deriving (Eq,Show) instance SchemaType AdjustedRelativeDateOffset where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AdjustedRelativeDateOffset a0) `apply` parseSchemaType "periodMultiplier" `apply` parseSchemaType "period" `apply` optional (parseSchemaType "dayType") `apply` optional (parseSchemaType "businessDayConvention") `apply` optional (oneOf' [ ("BusinessCentersReference", fmap OneOf2 (parseSchemaType "businessCentersReference")) , ("BusinessCenters", fmap TwoOf2 (parseSchemaType "businessCenters")) ]) `apply` optional (parseSchemaType "dateRelativeTo") `apply` optional (parseSchemaType "adjustedDate") `apply` optional (parseSchemaType "relativeDateAdjustments") schemaTypeToXML s x@AdjustedRelativeDateOffset{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ adjustRelatDateOffset_ID x ] [ schemaTypeToXML "periodMultiplier" $ adjustRelatDateOffset_periodMultiplier x , schemaTypeToXML "period" $ adjustRelatDateOffset_period x , maybe [] (schemaTypeToXML "dayType") $ adjustRelatDateOffset_dayType x , maybe [] (schemaTypeToXML "businessDayConvention") $ adjustRelatDateOffset_businessDayConvention x , maybe [] (foldOneOf2 (schemaTypeToXML "businessCentersReference") (schemaTypeToXML "businessCenters") ) $ adjustRelatDateOffset_choice4 x , maybe [] (schemaTypeToXML "dateRelativeTo") $ adjustRelatDateOffset_dateRelativeTo x , maybe [] (schemaTypeToXML "adjustedDate") $ adjustRelatDateOffset_adjustedDate x , maybe [] (schemaTypeToXML "relativeDateAdjustments") $ adjustRelatDateOffset_relativeDateAdjustments x ] instance Extension AdjustedRelativeDateOffset RelativeDateOffset where supertype (AdjustedRelativeDateOffset a0 e0 e1 e2 e3 e4 e5 e6 e7) = RelativeDateOffset a0 e0 e1 e2 e3 e4 e5 e6 instance Extension AdjustedRelativeDateOffset Offset where supertype = (supertype :: RelativeDateOffset -> Offset) . (supertype :: AdjustedRelativeDateOffset -> RelativeDateOffset) instance Extension AdjustedRelativeDateOffset Period where supertype = (supertype :: Offset -> Period) . (supertype :: RelativeDateOffset -> Offset) . (supertype :: AdjustedRelativeDateOffset -> RelativeDateOffset) data AgreementType = AgreementType Scheme AgreementTypeAttributes deriving (Eq,Show) data AgreementTypeAttributes = AgreementTypeAttributes { agreemTypeAttrib_agreementTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType AgreementType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "agreementTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ AgreementType v (AgreementTypeAttributes a0) schemaTypeToXML s (AgreementType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "agreementTypeScheme") $ agreemTypeAttrib_agreementTypeScheme at ] $ schemaTypeToXML s bt instance Extension AgreementType Scheme where supertype (AgreementType s _) = s data AgreementVersion = AgreementVersion Scheme AgreementVersionAttributes deriving (Eq,Show) data AgreementVersionAttributes = AgreementVersionAttributes { agreemVersionAttrib_agreementVersionScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType AgreementVersion where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "agreementVersionScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ AgreementVersion v (AgreementVersionAttributes a0) schemaTypeToXML s (AgreementVersion bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "agreementVersionScheme") $ agreemVersionAttrib_agreementVersionScheme at ] $ schemaTypeToXML s bt instance Extension AgreementVersion Scheme where supertype (AgreementVersion s _) = s -- | A type defining the exercise period for an American style -- option together with any rules governing the notional -- amount of the underlying which can be exercised on any -- given exercise date and any associated exercise fees. data AmericanExercise = AmericanExercise { americExerc_ID :: Maybe Xsd.ID , americExerc_commencementDate :: Maybe AdjustableOrRelativeDate -- ^ The first day of the exercise period for an American style -- option. , americExerc_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. , americExerc_relevantUnderlyingDate :: Maybe AdjustableOrRelativeDates -- ^ The date on the underlying set by the exercise of an -- option. What this date is depends on the option (e.g. in a -- swaption it is the swap effective date, in an -- extendible/cancelable provision it is the swap termination -- date). , americExerc_earliestExerciseTime :: Maybe BusinessCenterTime -- ^ The earliest time at which notice of exercise can be given -- by the buyer to the seller (or seller's agent) i) on the -- expriation date, in the case of a European style option, -- (ii) on each bermuda option exercise date and the -- expiration date, in the case of a Bermuda style option the -- commencement date to, and including, the expiration date , -- in the case of an American option. , americExerc_latestExerciseTime :: Maybe BusinessCenterTime -- ^ 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. , americExerc_expirationTime :: Maybe BusinessCenterTime -- ^ The latest time for exercise on expirationDate. , americExerc_multipleExercise :: Maybe MultipleExercise -- ^ As defined in the 2000 ISDA Definitions, Section 12.4. -- Multiple Exercise, the buyer of the option has the right to -- exercise all or less than all the unexercised notional -- amount of the underlying swap on one or more days in the -- exercise period, but on any such day may not exercise less -- than the minimum notional amount or more that the maximum -- notional amount, and if an integral multiple amount is -- specified, the notional amount exercised must be equal to, -- or be an intergral multiple of, the integral multiple -- amount. , americExerc_exerciseFeeSchedule :: Maybe ExerciseFeeSchedule -- ^ The fees associated with an exercise date. The fees are -- conditional on the exercise occuring. The fees can be -- specified as actual currency amounts or as percentages of -- the notional amount being exercised. } deriving (Eq,Show) instance SchemaType AmericanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AmericanExercise a0) `apply` optional (parseSchemaType "commencementDate") `apply` optional (parseSchemaType "expirationDate") `apply` optional (parseSchemaType "relevantUnderlyingDate") `apply` optional (parseSchemaType "earliestExerciseTime") `apply` optional (parseSchemaType "latestExerciseTime") `apply` optional (parseSchemaType "expirationTime") `apply` optional (parseSchemaType "multipleExercise") `apply` optional (parseSchemaType "exerciseFeeSchedule") schemaTypeToXML s x@AmericanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ americExerc_ID x ] [ maybe [] (schemaTypeToXML "commencementDate") $ americExerc_commencementDate x , maybe [] (schemaTypeToXML "expirationDate") $ americExerc_expirationDate x , maybe [] (schemaTypeToXML "relevantUnderlyingDate") $ americExerc_relevantUnderlyingDate x , maybe [] (schemaTypeToXML "earliestExerciseTime") $ americExerc_earliestExerciseTime x , maybe [] (schemaTypeToXML "latestExerciseTime") $ americExerc_latestExerciseTime x , maybe [] (schemaTypeToXML "expirationTime") $ americExerc_expirationTime x , maybe [] (schemaTypeToXML "multipleExercise") $ americExerc_multipleExercise x , maybe [] (schemaTypeToXML "exerciseFeeSchedule") $ americExerc_exerciseFeeSchedule x ] instance Extension AmericanExercise Exercise where supertype v = Exercise_AmericanExercise v -- | Specifies a reference to a monetary amount. data AmountReference = AmountReference { amountRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType AmountReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (AmountReference a0) schemaTypeToXML s x@AmountReference{} = toXMLElement s [ toXMLAttribute "href" $ amountRef_href x ] [] instance Extension AmountReference Reference where supertype v = Reference_AmountReference v -- | A type defining a currency amount or a currency amount -- schedule. data AmountSchedule = AmountSchedule { amountSched_ID :: Maybe Xsd.ID , amountSched_initialValue :: Xsd.Decimal -- ^ The initial rate or amount, as the case may be. An initial -- rate of 5% would be represented as 0.05. , amountSched_step :: [Step] -- ^ The schedule of step date and value pairs. On each step -- date the associated step value becomes effective A list of -- steps may be ordered in the document by ascending step -- date. An FpML document containing an unordered list of -- steps is still regarded as a conformant document. , amountSched_currency :: Maybe Currency -- ^ The currency in which an amount is denominated. } deriving (Eq,Show) instance SchemaType AmountSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (AmountSchedule a0) `apply` parseSchemaType "initialValue" `apply` many (parseSchemaType "step") `apply` optional (parseSchemaType "currency") schemaTypeToXML s x@AmountSchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ amountSched_ID x ] [ schemaTypeToXML "initialValue" $ amountSched_initialValue x , concatMap (schemaTypeToXML "step") $ amountSched_step x , maybe [] (schemaTypeToXML "currency") $ amountSched_currency x ] instance Extension AmountSchedule Schedule where supertype (AmountSchedule a0 e0 e1 e2) = Schedule a0 e0 e1 data AssetClass = AssetClass Scheme AssetClassAttributes deriving (Eq,Show) data AssetClassAttributes = AssetClassAttributes { assetClassAttrib_assetClassScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType AssetClass where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "assetClassScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ AssetClass v (AssetClassAttributes a0) schemaTypeToXML s (AssetClass bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "assetClassScheme") $ assetClassAttrib_assetClassScheme at ] $ schemaTypeToXML s bt instance Extension AssetClass Scheme where supertype (AssetClass s _) = s -- | A type to define automatic exercise of a swaption. With -- automatic exercise the option is deemed to have exercised -- if it is in the money by more than the threshold amount on -- the exercise date. data AutomaticExercise = AutomaticExercise { automExerc_thresholdRate :: Maybe Xsd.Decimal -- ^ A threshold rate. The threshold of 0.10% would be -- represented as 0.001 } deriving (Eq,Show) instance SchemaType AutomaticExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return AutomaticExercise `apply` optional (parseSchemaType "thresholdRate") schemaTypeToXML s x@AutomaticExercise{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "thresholdRate") $ automExerc_thresholdRate x ] -- | To indicate the limitation percentage and limitation -- period. data AverageDailyTradingVolumeLimit = AverageDailyTradingVolumeLimit { averageDailyTradingVolumeLimit_limitationPercentage :: Maybe RestrictedPercentage -- ^ Specifies the limitation percentage in Average Daily -- trading volume. , averageDailyTradingVolumeLimit_limitationPeriod :: Maybe Xsd.NonNegativeInteger -- ^ Specifies the limitation period for Average Daily trading -- volume in number of days. } deriving (Eq,Show) instance SchemaType AverageDailyTradingVolumeLimit where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return AverageDailyTradingVolumeLimit `apply` optional (parseSchemaType "limitationPercentage") `apply` optional (parseSchemaType "limitationPeriod") schemaTypeToXML s x@AverageDailyTradingVolumeLimit{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "limitationPercentage") $ averageDailyTradingVolumeLimit_limitationPercentage x , maybe [] (schemaTypeToXML "limitationPeriod") $ averageDailyTradingVolumeLimit_limitationPeriod x ] -- | A type defining the beneficiary of the funds. data Beneficiary = Beneficiary { beneficiary_choice0 :: (Maybe (OneOf3 RoutingIds RoutingExplicitDetails RoutingIdsAndExplicitDetails)) -- ^ Choice between: -- -- (1) A set of unique identifiers for a party, eachone -- identifying the party within a payment system. The -- assumption is that each party will not have more than -- one identifier within the same payment system. -- -- (2) A set of details that is used to identify a party -- involved in the routing of a payment when the party -- does not have a code that identifies it within one of -- the recognized payment systems. -- -- (3) A combination of coded payment system identifiers and -- details for physical addressing for a party involved in -- the routing of a payment. , beneficiary_partyReference :: Maybe PartyReference -- ^ Link to the party acting as beneficiary. This element can -- only appear within the beneficiary container element. } deriving (Eq,Show) instance SchemaType Beneficiary where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Beneficiary `apply` optional (oneOf' [ ("RoutingIds", fmap OneOf3 (parseSchemaType "routingIds")) , ("RoutingExplicitDetails", fmap TwoOf3 (parseSchemaType "routingExplicitDetails")) , ("RoutingIdsAndExplicitDetails", fmap ThreeOf3 (parseSchemaType "routingIdsAndExplicitDetails")) ]) `apply` optional (parseSchemaType "beneficiaryPartyReference") schemaTypeToXML s x@Beneficiary{} = toXMLElement s [] [ maybe [] (foldOneOf3 (schemaTypeToXML "routingIds") (schemaTypeToXML "routingExplicitDetails") (schemaTypeToXML "routingIdsAndExplicitDetails") ) $ beneficiary_choice0 x , maybe [] (schemaTypeToXML "beneficiaryPartyReference") $ beneficiary_partyReference x ] -- | A type defining the Bermuda option exercise dates and the -- expiration date together with any rules govenerning the -- notional amount of the underlying which can be exercised on -- any given exercise date and any associated exercise fee. data BermudaExercise = BermudaExercise { bermudaExerc_ID :: Maybe Xsd.ID , bermudaExercise_dates :: Maybe AdjustableOrRelativeDates -- ^ The dates the define the Bermuda option exercise dates and -- the expiration date. The last specified date is assumed to -- be the expiration date. The dates can either be specified -- as a series of explicit dates and associated adjustments or -- as a series of dates defined relative to another schedule -- of dates, for example, the calculation period start dates. -- Where a relative series of dates are defined the first and -- last possible exercise dates can be separately specified. , bermudaExerc_relevantUnderlyingDate :: Maybe AdjustableOrRelativeDates -- ^ The date on the underlying set by the exercise of an -- option. What this date is depends on the option (e.g. in a -- swaption it is the swap effective date, in an -- extendible/cancelable provision it is the swap termination -- date). , bermudaExerc_earliestExerciseTime :: Maybe BusinessCenterTime -- ^ The earliest time at which notice of exercise can be given -- by the buyer to the seller (or seller's agent) i) on the -- expriation date, in the case of a European style option, -- (ii) on each bermuda option exercise date and the -- expiration date, in the case of a Bermuda style option the -- commencement date to, and including, the expiration date , -- in the case of an American option. , bermudaExerc_latestExerciseTime :: Maybe BusinessCenterTime -- ^ 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. , bermudaExerc_expirationTime :: Maybe BusinessCenterTime -- ^ The latest time for exercise on expirationDate. , bermudaExerc_multipleExercise :: Maybe MultipleExercise -- ^ As defined in the 2000 ISDA Definitions, Section 12.4. -- Multiple Exercise, the buyer of the option has the right to -- exercise all or less than all the unexercised notional -- amount of the underlying swap on one or more days in the -- exercise period, but on any such day may not exercise less -- than the minimum notional amount or more that the maximum -- notional amount, and if an integral multiple amount is -- specified, the notional amount exercised must be equal to, -- or be an intergral multiple of, the integral multiple -- amount. , bermudaExerc_exerciseFeeSchedule :: Maybe ExerciseFeeSchedule -- ^ The fees associated with an exercise date. The fees are -- conditional on the exercise occuring. The fees can be -- specified as actual currency amounts or as percentages of -- the notional amount being exercised. } deriving (Eq,Show) instance SchemaType BermudaExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (BermudaExercise a0) `apply` optional (parseSchemaType "bermudaExerciseDates") `apply` optional (parseSchemaType "relevantUnderlyingDate") `apply` optional (parseSchemaType "earliestExerciseTime") `apply` optional (parseSchemaType "latestExerciseTime") `apply` optional (parseSchemaType "expirationTime") `apply` optional (parseSchemaType "multipleExercise") `apply` optional (parseSchemaType "exerciseFeeSchedule") schemaTypeToXML s x@BermudaExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ bermudaExerc_ID x ] [ maybe [] (schemaTypeToXML "bermudaExerciseDates") $ bermudaExercise_dates x , maybe [] (schemaTypeToXML "relevantUnderlyingDate") $ bermudaExerc_relevantUnderlyingDate x , maybe [] (schemaTypeToXML "earliestExerciseTime") $ bermudaExerc_earliestExerciseTime x , maybe [] (schemaTypeToXML "latestExerciseTime") $ bermudaExerc_latestExerciseTime x , maybe [] (schemaTypeToXML "expirationTime") $ bermudaExerc_expirationTime x , maybe [] (schemaTypeToXML "multipleExercise") $ bermudaExerc_multipleExercise x , maybe [] (schemaTypeToXML "exerciseFeeSchedule") $ bermudaExerc_exerciseFeeSchedule x ] instance Extension BermudaExercise Exercise where supertype v = Exercise_BermudaExercise v -- | Identifies the market sector in which the trade has been -- arranged. data BrokerConfirmation = BrokerConfirmation { brokerConfirmation_type :: Maybe BrokerConfirmationType -- ^ The type of broker confirmation executed between the -- parties. } deriving (Eq,Show) instance SchemaType BrokerConfirmation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return BrokerConfirmation `apply` optional (parseSchemaType "brokerConfirmationType") schemaTypeToXML s x@BrokerConfirmation{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "brokerConfirmationType") $ brokerConfirmation_type x ] -- | Identifies the market sector in which the trade has been -- arranged. data BrokerConfirmationType = BrokerConfirmationType Scheme BrokerConfirmationTypeAttributes deriving (Eq,Show) data BrokerConfirmationTypeAttributes = BrokerConfirmationTypeAttributes { brokerConfirTypeAttrib_brokerConfirmationTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType BrokerConfirmationType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "brokerConfirmationTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ BrokerConfirmationType v (BrokerConfirmationTypeAttributes a0) schemaTypeToXML s (BrokerConfirmationType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "brokerConfirmationTypeScheme") $ brokerConfirTypeAttrib_brokerConfirmationTypeScheme at ] $ schemaTypeToXML s bt instance Extension BrokerConfirmationType Scheme where supertype (BrokerConfirmationType s _) = s -- | A code identifying a business day calendar location. A -- business day calendar location is drawn from the list -- identified by the business day calendar location scheme. data BusinessCenter = BusinessCenter Scheme BusinessCenterAttributes deriving (Eq,Show) data BusinessCenterAttributes = BusinessCenterAttributes { busCenterAttrib_businessCenterScheme :: Maybe Xsd.AnyURI , busCenterAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType BusinessCenter where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "businessCenterScheme" e pos a1 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ BusinessCenter v (BusinessCenterAttributes a0 a1) schemaTypeToXML s (BusinessCenter bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "businessCenterScheme") $ busCenterAttrib_businessCenterScheme at , maybe [] (toXMLAttribute "id") $ busCenterAttrib_ID at ] $ schemaTypeToXML s bt instance Extension BusinessCenter Scheme where supertype (BusinessCenter s _) = s -- | A type for defining business day calendar used in -- determining whether a day is a business day or not. A list -- of business day calendar locations may be ordered in the -- document alphabetically based on business day calendar -- location code. An FpML document containing an unordered -- business day calendar location list is still regarded as a -- conformant document. data BusinessCenters = BusinessCenters { busCenters_ID :: Maybe Xsd.ID , busCenters_businessCenter :: [BusinessCenter] } deriving (Eq,Show) instance SchemaType BusinessCenters where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (BusinessCenters a0) `apply` many (parseSchemaType "businessCenter") schemaTypeToXML s x@BusinessCenters{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ busCenters_ID x ] [ concatMap (schemaTypeToXML "businessCenter") $ busCenters_businessCenter x ] -- | A pointer style reference to a set of business day calendar -- defined elsewhere in the document. data BusinessCentersReference = BusinessCentersReference { busCentersRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType BusinessCentersReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (BusinessCentersReference a0) schemaTypeToXML s x@BusinessCentersReference{} = toXMLElement s [ toXMLAttribute "href" $ busCentersRef_href x ] [] instance Extension BusinessCentersReference Reference where supertype v = Reference_BusinessCentersReference v -- | A type for defining a time with respect to a business day -- calendar location. For example, 11:00am London time. data BusinessCenterTime = BusinessCenterTime { busCenterTime_hourMinuteTime :: Maybe HourMinuteTime -- ^ A time specified in hh:mm:ss format where the second -- component must be '00', e.g. 11am would be represented as -- 11:00:00. , busCenterTime_businessCenter :: Maybe BusinessCenter } deriving (Eq,Show) instance SchemaType BusinessCenterTime where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return BusinessCenterTime `apply` optional (parseSchemaType "hourMinuteTime") `apply` optional (parseSchemaType "businessCenter") schemaTypeToXML s x@BusinessCenterTime{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "hourMinuteTime") $ busCenterTime_hourMinuteTime x , maybe [] (schemaTypeToXML "businessCenter") $ busCenterTime_businessCenter x ] -- | A type defining a range of contiguous business days by -- defining an unadjusted first date, an unadjusted last date -- and a business day convention and business centers for -- adjusting the first and last dates if they would otherwise -- fall on a non business day in the specified business -- centers. The days between the first and last date must also -- be good business days in the specified centers to be -- counted in the range. data BusinessDateRange = BusinessDateRange { busDateRange_unadjustedFirstDate :: Maybe Xsd.Date -- ^ The first date of a date range. , busDateRange_unadjustedLastDate :: Maybe Xsd.Date -- ^ The last date of a date range. , busDateRange_businessDayConvention :: Maybe BusinessDayConventionEnum -- ^ The convention for adjusting a date if it would otherwise -- fall on a day that is not a business day. , busDateRange_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 BusinessDateRange where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return BusinessDateRange `apply` optional (parseSchemaType "unadjustedFirstDate") `apply` optional (parseSchemaType "unadjustedLastDate") `apply` optional (parseSchemaType "businessDayConvention") `apply` optional (oneOf' [ ("BusinessCentersReference", fmap OneOf2 (parseSchemaType "businessCentersReference")) , ("BusinessCenters", fmap TwoOf2 (parseSchemaType "businessCenters")) ]) schemaTypeToXML s x@BusinessDateRange{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "unadjustedFirstDate") $ busDateRange_unadjustedFirstDate x , maybe [] (schemaTypeToXML "unadjustedLastDate") $ busDateRange_unadjustedLastDate x , maybe [] (schemaTypeToXML "businessDayConvention") $ busDateRange_businessDayConvention x , maybe [] (foldOneOf2 (schemaTypeToXML "businessCentersReference") (schemaTypeToXML "businessCenters") ) $ busDateRange_choice3 x ] instance Extension BusinessDateRange DateRange where supertype (BusinessDateRange e0 e1 e2 e3) = DateRange e0 e1 -- | A type defining the business day convention and financial -- business centers used for adjusting any relevant date if it -- would otherwise fall on a day that is not a business day in -- the specified business centers. data BusinessDayAdjustments = BusinessDayAdjustments { busDayAdjust_ID :: Maybe Xsd.ID , busDayAdjust_businessDayConvention :: Maybe BusinessDayConventionEnum -- ^ The convention for adjusting a date if it would otherwise -- fall on a day that is not a business day. , busDayAdjust_choice1 :: (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 BusinessDayAdjustments where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (BusinessDayAdjustments a0) `apply` optional (parseSchemaType "businessDayConvention") `apply` optional (oneOf' [ ("BusinessCentersReference", fmap OneOf2 (parseSchemaType "businessCentersReference")) , ("BusinessCenters", fmap TwoOf2 (parseSchemaType "businessCenters")) ]) schemaTypeToXML s x@BusinessDayAdjustments{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ busDayAdjust_ID x ] [ maybe [] (schemaTypeToXML "businessDayConvention") $ busDayAdjust_businessDayConvention x , maybe [] (foldOneOf2 (schemaTypeToXML "businessCentersReference") (schemaTypeToXML "businessCenters") ) $ busDayAdjust_choice1 x ] -- | Reference to a business day adjustments structure. data BusinessDayAdjustmentsReference = BusinessDayAdjustmentsReference { busDayAdjustRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType BusinessDayAdjustmentsReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (BusinessDayAdjustmentsReference a0) schemaTypeToXML s x@BusinessDayAdjustmentsReference{} = toXMLElement s [ toXMLAttribute "href" $ busDayAdjustRef_href x ] [] instance Extension BusinessDayAdjustmentsReference Reference where supertype v = Reference_BusinessDayAdjustmentsReference v -- | A type defining the ISDA calculation agent responsible for -- performing duties as defined in the applicable product -- definitions. data CalculationAgent = CalculationAgent { calcAgent_choice0 :: (Maybe (OneOf2 [PartyReference] CalculationAgentPartyEnum)) -- ^ Choice between: -- -- (1) A pointer style reference to a party identifier defined -- elsewhere in the document. The party referenced is the -- ISDA Calculation Agent for the trade. If more than one -- party is referenced then the parties are assumed to be -- co-calculation agents, i.e. they have joint -- responsibility. -- -- (2) The ISDA calculation agent responsible for performing -- duties as defined in the applicable product -- definitions. For example, the Calculation Agent may be -- defined as being the Non-exercising Party. } deriving (Eq,Show) instance SchemaType CalculationAgent where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CalculationAgent `apply` optional (oneOf' [ ("[PartyReference]", fmap OneOf2 (many1 (parseSchemaType "calculationAgentPartyReference"))) , ("CalculationAgentPartyEnum", fmap TwoOf2 (parseSchemaType "calculationAgentParty")) ]) schemaTypeToXML s x@CalculationAgent{} = toXMLElement s [] [ maybe [] (foldOneOf2 (concatMap (schemaTypeToXML "calculationAgentPartyReference")) (schemaTypeToXML "calculationAgentParty") ) $ calcAgent_choice0 x ] -- | A type defining the frequency at which calculation period -- end dates occur within the regular part of the calculation -- period schedule and thier roll date convention. In case the -- calculation frequency is of value T (term), the period is -- defined by the -- swap\swapStream\calculationPerioDates\effectiveDate and the -- swap\swapStream\calculationPerioDates\terminationDate. data CalculationPeriodFrequency = CalculationPeriodFrequency { calcPeriodFrequ_ID :: Maybe Xsd.ID , calcPeriodFrequ_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. , calcPeriodFrequ_period :: Maybe PeriodExtendedEnum -- ^ A time period, e.g. a day, week, month, year or term of the -- stream. , calcPeriodFrequ_rollConvention :: Maybe RollConventionEnum -- ^ Used in conjunction with a frequency and the regular period -- start date of a calculation period, determines each -- calculation period end date within the regular part of a -- calculation period schedule. } deriving (Eq,Show) instance SchemaType CalculationPeriodFrequency where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CalculationPeriodFrequency a0) `apply` optional (parseSchemaType "periodMultiplier") `apply` optional (parseSchemaType "period") `apply` optional (parseSchemaType "rollConvention") schemaTypeToXML s x@CalculationPeriodFrequency{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ calcPeriodFrequ_ID x ] [ maybe [] (schemaTypeToXML "periodMultiplier") $ calcPeriodFrequ_periodMultiplier x , maybe [] (schemaTypeToXML "period") $ calcPeriodFrequ_period x , maybe [] (schemaTypeToXML "rollConvention") $ calcPeriodFrequ_rollConvention x ] instance Extension CalculationPeriodFrequency Frequency where supertype (CalculationPeriodFrequency a0 e0 e1 e2) = Frequency a0 e0 e1 -- | An identifier used to identify a single component cashflow. data CashflowId = CashflowId Scheme CashflowIdAttributes deriving (Eq,Show) data CashflowIdAttributes = CashflowIdAttributes { cashflIdAttrib_cashflowIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CashflowId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "cashflowIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CashflowId v (CashflowIdAttributes a0) schemaTypeToXML s (CashflowId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "cashflowIdScheme") $ cashflIdAttrib_cashflowIdScheme at ] $ schemaTypeToXML s bt instance Extension CashflowId Scheme where supertype (CashflowId s _) = s -- | The notional/principal value/quantity/volume used to -- compute the cashflow. data CashflowNotional = CashflowNotional { cashflNotion_ID :: Maybe Xsd.ID , cashflNotion_choice0 :: (Maybe (OneOf2 Currency Xsd.NormalizedString)) -- ^ Choice between: -- -- (1) The currency in which an amount is denominated. -- -- (2) The units in which an amount (not monetary) is -- denominated. , cashflNotion_amount :: Xsd.Decimal -- ^ The quantity of notional (in currency or other units). } deriving (Eq,Show) instance SchemaType CashflowNotional where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CashflowNotional a0) `apply` optional (oneOf' [ ("Currency", fmap OneOf2 (parseSchemaType "currency")) , ("Xsd.NormalizedString", fmap TwoOf2 (parseSchemaType "units")) ]) `apply` parseSchemaType "amount" schemaTypeToXML s x@CashflowNotional{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ cashflNotion_ID x ] [ maybe [] (foldOneOf2 (schemaTypeToXML "currency") (schemaTypeToXML "units") ) $ cashflNotion_choice0 x , schemaTypeToXML "amount" $ cashflNotion_amount x ] -- | A coding scheme used to describe the type or purpose of a -- cash flow or cash flow component. data CashflowType = CashflowType Scheme CashflowTypeAttributes deriving (Eq,Show) data CashflowTypeAttributes = CashflowTypeAttributes { cashflTypeAttrib_cashflowTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CashflowType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "cashflowTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CashflowType v (CashflowTypeAttributes a0) schemaTypeToXML s (CashflowType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "cashflowTypeScheme") $ cashflTypeAttrib_cashflowTypeScheme at ] $ schemaTypeToXML s bt instance Extension CashflowType Scheme where supertype (CashflowType s _) = s -- | A type defining the list of reference institutions polled -- for relevant rates or prices when determining the cash -- settlement amount for a product where cash settlement is -- applicable. data CashSettlementReferenceBanks = CashSettlementReferenceBanks { cashSettlRefBanks_ID :: Maybe Xsd.ID , cashSettlRefBanks_referenceBank :: [ReferenceBank] -- ^ An institution (party) identified by means of a coding -- scheme and an optional name. } deriving (Eq,Show) instance SchemaType CashSettlementReferenceBanks where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (CashSettlementReferenceBanks a0) `apply` many (parseSchemaType "referenceBank") schemaTypeToXML s x@CashSettlementReferenceBanks{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ cashSettlRefBanks_ID x ] [ concatMap (schemaTypeToXML "referenceBank") $ cashSettlRefBanks_referenceBank x ] -- | Unless otherwise specified, the principal clearance system -- customarily used for settling trades in the relevant -- underlying. data ClearanceSystem = ClearanceSystem Scheme ClearanceSystemAttributes deriving (Eq,Show) data ClearanceSystemAttributes = ClearanceSystemAttributes { clearSystemAttrib_clearanceSystemScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ClearanceSystem where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "clearanceSystemScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ClearanceSystem v (ClearanceSystemAttributes a0) schemaTypeToXML s (ClearanceSystem bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "clearanceSystemScheme") $ clearSystemAttrib_clearanceSystemScheme at ] $ schemaTypeToXML s bt instance Extension ClearanceSystem Scheme where supertype (ClearanceSystem s _) = s -- | The definitions, such as those published by ISDA, that will -- define the terms of the trade. data ContractualDefinitions = ContractualDefinitions Scheme ContractualDefinitionsAttributes deriving (Eq,Show) data ContractualDefinitionsAttributes = ContractualDefinitionsAttributes { contrDefinAttrib_contractualDefinitionsScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ContractualDefinitions where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "contractualDefinitionsScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ContractualDefinitions v (ContractualDefinitionsAttributes a0) schemaTypeToXML s (ContractualDefinitions bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "contractualDefinitionsScheme") $ contrDefinAttrib_contractualDefinitionsScheme at ] $ schemaTypeToXML s bt instance Extension ContractualDefinitions Scheme where supertype (ContractualDefinitions s _) = s data ContractualMatrix = ContractualMatrix { contrMatrix_matrixType :: Maybe MatrixType -- ^ Identifies the form of applicable matrix. , contrMatrix_publicationDate :: Maybe Xsd.Date -- ^ Specifies the publication date of the applicable version of -- the matrix. When this element is omitted, the ISDA -- supplemental language for incorporation of the relevant -- matrix will generally define rules for which version of the -- matrix is applicable. , contrMatrix_matrixTerm :: Maybe MatrixTerm -- ^ Defines any applicable key into the relevant matrix. For -- example, the Transaction Type would be the single term -- required for the Credit Derivatives Physical Settlement -- Matrix. This element should be omitted in the case of the -- 2000 ISDA Definitions Settlement Matrix for Early -- Termination and Swaptions. } deriving (Eq,Show) instance SchemaType ContractualMatrix where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ContractualMatrix `apply` optional (parseSchemaType "matrixType") `apply` optional (parseSchemaType "publicationDate") `apply` optional (parseSchemaType "matrixTerm") schemaTypeToXML s x@ContractualMatrix{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "matrixType") $ contrMatrix_matrixType x , maybe [] (schemaTypeToXML "publicationDate") $ contrMatrix_publicationDate x , maybe [] (schemaTypeToXML "matrixTerm") $ contrMatrix_matrixTerm x ] -- | A contractual supplement (such as those published by ISDA) -- that will apply to the trade. data ContractualSupplement = ContractualSupplement Scheme ContractualSupplementAttributes deriving (Eq,Show) data ContractualSupplementAttributes = ContractualSupplementAttributes { contrSupplAttrib_contractualSupplementScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ContractualSupplement where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "contractualSupplementScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ContractualSupplement v (ContractualSupplementAttributes a0) schemaTypeToXML s (ContractualSupplement bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "contractualSupplementScheme") $ contrSupplAttrib_contractualSupplementScheme at ] $ schemaTypeToXML s bt instance Extension ContractualSupplement Scheme where supertype (ContractualSupplement s _) = s -- | A contractual supplement (such as those published by ISDA) -- and its publication date that will apply to the trade. data ContractualTermsSupplement = ContractualTermsSupplement { contrTermsSuppl_type :: Maybe ContractualSupplement -- ^ Identifies the form of applicable contractual supplement. , contrTermsSuppl_publicationDate :: Maybe Xsd.Date -- ^ Specifies the publication date of the applicable version of -- the contractual supplement. } deriving (Eq,Show) instance SchemaType ContractualTermsSupplement where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ContractualTermsSupplement `apply` optional (parseSchemaType "type") `apply` optional (parseSchemaType "publicationDate") schemaTypeToXML s x@ContractualTermsSupplement{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "type") $ contrTermsSuppl_type x , maybe [] (schemaTypeToXML "publicationDate") $ contrTermsSuppl_publicationDate x ] -- | A type that describes the information to identify a -- correspondent bank that will make delivery of the funds on -- the paying bank's behalf in the country where the payment -- is to be made. data CorrespondentInformation = CorrespondentInformation { corresInfo_choice0 :: (Maybe (OneOf3 RoutingIds RoutingExplicitDetails RoutingIdsAndExplicitDetails)) -- ^ Choice between: -- -- (1) A set of unique identifiers for a party, eachone -- identifying the party within a payment system. The -- assumption is that each party will not have more than -- one identifier within the same payment system. -- -- (2) A set of details that is used to identify a party -- involved in the routing of a payment when the party -- does not have a code that identifies it within one of -- the recognized payment systems. -- -- (3) A combination of coded payment system identifiers and -- details for physical addressing for a party involved in -- the routing of a payment. , corresInfo_correspondentPartyReference :: Maybe PartyReference -- ^ Link to the party acting as correspondent. This element can -- only appear within the correspondentInformation container -- element. } deriving (Eq,Show) instance SchemaType CorrespondentInformation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CorrespondentInformation `apply` optional (oneOf' [ ("RoutingIds", fmap OneOf3 (parseSchemaType "routingIds")) , ("RoutingExplicitDetails", fmap TwoOf3 (parseSchemaType "routingExplicitDetails")) , ("RoutingIdsAndExplicitDetails", fmap ThreeOf3 (parseSchemaType "routingIdsAndExplicitDetails")) ]) `apply` optional (parseSchemaType "correspondentPartyReference") schemaTypeToXML s x@CorrespondentInformation{} = toXMLElement s [] [ maybe [] (foldOneOf3 (schemaTypeToXML "routingIds") (schemaTypeToXML "routingExplicitDetails") (schemaTypeToXML "routingIdsAndExplicitDetails") ) $ corresInfo_choice0 x , maybe [] (schemaTypeToXML "correspondentPartyReference") $ corresInfo_correspondentPartyReference x ] -- | The code representation of a country or an area of special -- sovereignty. By default it is a valid 2 character country -- code as defined by the ISO standard 3166-1 alpha-2 - Codes -- for representation of countries -- http://www.niso.org/standards/resources/3166.html. data CountryCode = CountryCode Xsd.Token CountryCodeAttributes deriving (Eq,Show) data CountryCodeAttributes = CountryCodeAttributes { countryCodeAttrib_countryScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CountryCode where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "countryScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CountryCode v (CountryCodeAttributes a0) schemaTypeToXML s (CountryCode bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "countryScheme") $ countryCodeAttrib_countryScheme at ] $ schemaTypeToXML s bt instance Extension CountryCode Xsd.Token where supertype (CountryCode s _) = s -- | The repayment precedence of a debt instrument. data CreditSeniority = CreditSeniority Scheme CreditSeniorityAttributes deriving (Eq,Show) data CreditSeniorityAttributes = CreditSeniorityAttributes { creditSeniorAttrib_creditSeniorityScheme :: Maybe Xsd.AnyURI -- ^ creditSeniorityTradingScheme overrides -- creditSeniorityScheme when the underlyer defines the -- reference obligation used in a single name credit default -- swap trade. } deriving (Eq,Show) instance SchemaType CreditSeniority where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "creditSeniorityScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CreditSeniority v (CreditSeniorityAttributes a0) schemaTypeToXML s (CreditSeniority bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "creditSeniorityScheme") $ creditSeniorAttrib_creditSeniorityScheme at ] $ schemaTypeToXML s bt instance Extension CreditSeniority Scheme where supertype (CreditSeniority s _) = s -- | The agreement executed between the parties and intended to -- govern collateral arrangement for all OTC derivatives -- transactions between those parties. data CreditSupportAgreement = CreditSupportAgreement { creditSupportAgreem_type :: Maybe CreditSupportAgreementType -- ^ The type of ISDA Credit Support Agreement , creditSupportAgreem_date :: Maybe Xsd.Date -- ^ The date of the agreement executed between the parties and -- intended to govern collateral arrangements for all OTC -- derivatives transactions between those parties. , creditSupportAgreem_identifier :: Maybe CreditSupportAgreementIdentifier -- ^ An identifier used to uniquely identify the CSA } deriving (Eq,Show) instance SchemaType CreditSupportAgreement where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return CreditSupportAgreement `apply` optional (parseSchemaType "type") `apply` optional (parseSchemaType "date") `apply` optional (parseSchemaType "identifier") schemaTypeToXML s x@CreditSupportAgreement{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "type") $ creditSupportAgreem_type x , maybe [] (schemaTypeToXML "date") $ creditSupportAgreem_date x , maybe [] (schemaTypeToXML "identifier") $ creditSupportAgreem_identifier x ] data CreditSupportAgreementIdentifier = CreditSupportAgreementIdentifier Scheme CreditSupportAgreementIdentifierAttributes deriving (Eq,Show) data CreditSupportAgreementIdentifierAttributes = CreditSupportAgreementIdentifierAttributes { csaia_creditSupportAgreementIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CreditSupportAgreementIdentifier where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "creditSupportAgreementIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CreditSupportAgreementIdentifier v (CreditSupportAgreementIdentifierAttributes a0) schemaTypeToXML s (CreditSupportAgreementIdentifier bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "creditSupportAgreementIdScheme") $ csaia_creditSupportAgreementIdScheme at ] $ schemaTypeToXML s bt instance Extension CreditSupportAgreementIdentifier Scheme where supertype (CreditSupportAgreementIdentifier s _) = s data CreditSupportAgreementType = CreditSupportAgreementType Scheme CreditSupportAgreementTypeAttributes deriving (Eq,Show) data CreditSupportAgreementTypeAttributes = CreditSupportAgreementTypeAttributes { csata_creditSupportAgreementTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CreditSupportAgreementType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "creditSupportAgreementTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CreditSupportAgreementType v (CreditSupportAgreementTypeAttributes a0) schemaTypeToXML s (CreditSupportAgreementType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "creditSupportAgreementTypeScheme") $ csata_creditSupportAgreementTypeScheme at ] $ schemaTypeToXML s bt instance Extension CreditSupportAgreementType Scheme where supertype (CreditSupportAgreementType s _) = s -- | A party's credit rating. data CreditRating = CreditRating Scheme CreditRatingAttributes deriving (Eq,Show) data CreditRatingAttributes = CreditRatingAttributes { creditRatingAttrib_creditRatingScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType CreditRating where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "creditRatingScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ CreditRating v (CreditRatingAttributes a0) schemaTypeToXML s (CreditRating bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "creditRatingScheme") $ creditRatingAttrib_creditRatingScheme at ] $ schemaTypeToXML s bt instance Extension CreditRating Scheme where supertype (CreditRating s _) = s -- | The code representation of a currency or fund. By default -- it is a valid currency code as defined by the ISO standard -- 4217 - Codes for representation of currencies and funds -- http://www.iso.org/iso/en/prods-services/popstds/currencycodeslist.html. data Currency = Currency Scheme CurrencyAttributes deriving (Eq,Show) data CurrencyAttributes = CurrencyAttributes { currenAttrib_currencyScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType Currency where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "currencyScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ Currency v (CurrencyAttributes a0) schemaTypeToXML s (Currency bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "currencyScheme") $ currenAttrib_currencyScheme at ] $ schemaTypeToXML s bt instance Extension Currency Scheme where supertype (Currency s _) = s -- | List of Dates data DateList = DateList { dateList_date :: [Xsd.Date] } deriving (Eq,Show) instance SchemaType DateList where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return DateList `apply` many (parseSchemaType "date") schemaTypeToXML s x@DateList{} = toXMLElement s [] [ concatMap (schemaTypeToXML "date") $ dateList_date x ] -- | A type defining an offset used in calculating a date when -- this date is defined in reference to another date through a -- date offset. The type includes the convention for adjusting -- the date and an optional sequence element to indicate the -- order in a sequence of multiple date offsets. data DateOffset = DateOffset { dateOffset_ID :: Maybe Xsd.ID , dateOffset_periodMultiplier :: Xsd.Integer -- ^ A time period multiplier, e.g. 1, 2 or 3 etc. A negative -- value can be used when specifying an offset relative to -- another date, e.g. -2 days. , dateOffset_period :: PeriodEnum -- ^ A time period, e.g. a day, week, month or year of the -- stream. If the periodMultiplier value is 0 (zero) then -- period must contain the value D (day). , dateOffset_dayType :: Maybe DayTypeEnum -- ^ In the case of an offset specified as a number of days, -- this element defines whether consideration is given as to -- whether a day is a good business day or not. If a day type -- of business days is specified then non-business days are -- ignored when calculating the offset. The financial business -- centers to use for determination of business days are -- implied by the context in which this element is used. This -- element must only be included when the offset is specified -- as a number of days. If the offset is zero days then the -- dayType element should not be included. , dateOffset_businessDayConvention :: Maybe BusinessDayConventionEnum -- ^ The convention for adjusting a date if it would otherwise -- fall on a day that is not a business day. } deriving (Eq,Show) instance SchemaType DateOffset where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (DateOffset a0) `apply` parseSchemaType "periodMultiplier" `apply` parseSchemaType "period" `apply` optional (parseSchemaType "dayType") `apply` optional (parseSchemaType "businessDayConvention") schemaTypeToXML s x@DateOffset{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ dateOffset_ID x ] [ schemaTypeToXML "periodMultiplier" $ dateOffset_periodMultiplier x , schemaTypeToXML "period" $ dateOffset_period x , maybe [] (schemaTypeToXML "dayType") $ dateOffset_dayType x , maybe [] (schemaTypeToXML "businessDayConvention") $ dateOffset_businessDayConvention x ] instance Extension DateOffset Offset where supertype (DateOffset a0 e0 e1 e2 e3) = Offset a0 e0 e1 e2 instance Extension DateOffset Period where supertype = (supertype :: Offset -> Period) . (supertype :: DateOffset -> Offset) -- | A type defining a contiguous series of calendar dates. The -- date range is defined as all the dates between and -- including the first and the last date. The first date must -- fall before the last date. data DateRange = DateRange { dateRange_unadjustedFirstDate :: Maybe Xsd.Date -- ^ The first date of a date range. , dateRange_unadjustedLastDate :: Maybe Xsd.Date -- ^ The last date of a date range. } deriving (Eq,Show) instance SchemaType DateRange where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return DateRange `apply` optional (parseSchemaType "unadjustedFirstDate") `apply` optional (parseSchemaType "unadjustedLastDate") schemaTypeToXML s x@DateRange{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "unadjustedFirstDate") $ dateRange_unadjustedFirstDate x , maybe [] (schemaTypeToXML "unadjustedLastDate") $ dateRange_unadjustedLastDate x ] -- | Reference to an identified date or a complex date -- structure. data DateReference = DateReference { dateRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType DateReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (DateReference a0) schemaTypeToXML s x@DateReference{} = toXMLElement s [ toXMLAttribute "href" $ dateRef_href x ] [] instance Extension DateReference Reference where supertype v = Reference_DateReference v -- | List of DateTimes data DateTimeList = DateTimeList { dateTimeList_dateTime :: [Xsd.DateTime] } deriving (Eq,Show) instance SchemaType DateTimeList where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return DateTimeList `apply` many (parseSchemaType "dateTime") schemaTypeToXML s x@DateTimeList{} = toXMLElement s [] [ concatMap (schemaTypeToXML "dateTime") $ dateTimeList_dateTime x ] -- | The specification for how the number of days between two -- dates is calculated for purposes of calculation of a fixed -- or floating payment amount and the basis for how many days -- are assumed to be in a year. Day Count Fraction is an ISDA -- term. The equivalent AFB (Association Francaise de Banques) -- term is Calculation Basis. data DayCountFraction = DayCountFraction Scheme DayCountFractionAttributes deriving (Eq,Show) data DayCountFractionAttributes = DayCountFractionAttributes { dayCountFractAttrib_dayCountFractionScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType DayCountFraction where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "dayCountFractionScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ DayCountFraction v (DayCountFractionAttributes a0) schemaTypeToXML s (DayCountFraction bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "dayCountFractionScheme") $ dayCountFractAttrib_dayCountFractionScheme at ] $ schemaTypeToXML s bt instance Extension DayCountFraction Scheme where supertype (DayCountFraction s _) = s -- | Coding scheme that specifies the method according to which -- an amount or a date is determined. data DeterminationMethod = DeterminationMethod Scheme DeterminationMethodAttributes deriving (Eq,Show) data DeterminationMethodAttributes = DeterminationMethodAttributes { determMethodAttrib_determinationMethodScheme :: Maybe Xsd.AnyURI , determMethodAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType DeterminationMethod where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "determinationMethodScheme" e pos a1 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ DeterminationMethod v (DeterminationMethodAttributes a0 a1) schemaTypeToXML s (DeterminationMethod bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "determinationMethodScheme") $ determMethodAttrib_determinationMethodScheme at , maybe [] (toXMLAttribute "id") $ determMethodAttrib_ID at ] $ schemaTypeToXML s bt instance Extension DeterminationMethod Scheme where supertype (DeterminationMethod s _) = s -- | A reference to the return swap notional determination -- method. data DeterminationMethodReference = DeterminationMethodReference { determMethodRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType DeterminationMethodReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (DeterminationMethodReference a0) schemaTypeToXML s x@DeterminationMethodReference{} = toXMLElement s [ toXMLAttribute "href" $ determMethodRef_href x ] [] instance Extension DeterminationMethodReference Reference where supertype v = Reference_DeterminationMethodReference v -- | An entity for defining the definitions that govern the -- document and should include the year and type of -- definitions referenced, along with any relevant -- documentation (such as master agreement) and the date it -- was signed. data Documentation = Documentation { docum_masterAgreement :: Maybe MasterAgreement -- ^ The agreement executed between the parties and intended to -- govern all OTC derivatives transactions between those -- parties. , docum_choice1 :: (Maybe (OneOf2 MasterConfirmation BrokerConfirmation)) -- ^ Choice between: -- -- (1) The agreement executed between the parties and intended -- to govern all OTC derivatives transactions between -- those parties. -- -- (2) Specifies the deails for a broker confirm. , docum_contractualDefinitions :: [ContractualDefinitions] -- ^ The definitions such as those published by ISDA that will -- define the terms of the trade. , docum_contractualTermsSupplement :: [ContractualTermsSupplement] -- ^ A contractual supplement (such as those published by ISDA) -- that will apply to the trade. , docum_contractualMatrix :: [ContractualMatrix] -- ^ A reference to a contractual matrix of elected terms/values -- (such as those published by ISDA) that shall be deemed to -- apply to the trade. The applicable matrix is identified by -- reference to a name and optionally a publication date. -- Depending on the structure of the matrix, an additional -- term (specified in the matrixTerm element) may be required -- to further identify a subset of applicable terms/values -- within the matrix. , docum_creditSupportAgreement :: Maybe CreditSupportAgreement -- ^ The agreement executed between the parties and intended to -- govern collateral arrangement for all OTC derivatives -- transactions between those parties. , docum_attachment :: [Resource] -- ^ A human readable document related to this transaction, for -- example a confirmation. } deriving (Eq,Show) instance SchemaType Documentation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Documentation `apply` optional (parseSchemaType "masterAgreement") `apply` optional (oneOf' [ ("MasterConfirmation", fmap OneOf2 (parseSchemaType "masterConfirmation")) , ("BrokerConfirmation", fmap TwoOf2 (parseSchemaType "brokerConfirmation")) ]) `apply` many (parseSchemaType "contractualDefinitions") `apply` many (parseSchemaType "contractualTermsSupplement") `apply` many (parseSchemaType "contractualMatrix") `apply` optional (parseSchemaType "creditSupportAgreement") `apply` many (parseSchemaType "attachment") schemaTypeToXML s x@Documentation{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "masterAgreement") $ docum_masterAgreement x , maybe [] (foldOneOf2 (schemaTypeToXML "masterConfirmation") (schemaTypeToXML "brokerConfirmation") ) $ docum_choice1 x , concatMap (schemaTypeToXML "contractualDefinitions") $ docum_contractualDefinitions x , concatMap (schemaTypeToXML "contractualTermsSupplement") $ docum_contractualTermsSupplement x , concatMap (schemaTypeToXML "contractualMatrix") $ docum_contractualMatrix x , maybe [] (schemaTypeToXML "creditSupportAgreement") $ docum_creditSupportAgreement x , concatMap (schemaTypeToXML "attachment") $ docum_attachment x ] -- | A for holding information about documents external to the -- FpML. data ExternalDocument = ExternalDocument { externDocum_mimeType :: Maybe MimeType -- ^ Indicates the type of media used to store the content. -- mimeType is used to determine the software product(s) that -- can read the content. MIME Types are described in RFC 2046. , externDocum_choice1 :: (Maybe (OneOf5 Xsd.XsdString Xsd.HexBinary Xsd.Base64Binary Xsd.AnyURI HTTPAttachmentReference)) -- ^ Choice between: -- -- (1) Provides extra information as string. In case the extra -- information is in XML format, a CDATA section must be -- placed around the source message to prevent its -- interpretation as XML content. -- -- (2) Provides extra information as binary contents coded in -- hexadecimal. -- -- (3) Provides extra information as binary contents coded in -- base64. -- -- (4) Provides extra information as URL that references the -- information on a web server accessible to the message -- recipient. -- -- (5) Provides a place to put a reference to an attachment on -- an HTTP message, such as is used by SOAP with -- Attachments and ebXML. } deriving (Eq,Show) instance SchemaType ExternalDocument where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ExternalDocument `apply` optional (parseSchemaType "mimeType") `apply` optional (oneOf' [ ("Xsd.XsdString", fmap OneOf5 (parseSchemaType "string")) , ("Xsd.HexBinary", fmap TwoOf5 (parseSchemaType "hexadecimalBinary")) , ("Xsd.Base64Binary", fmap ThreeOf5 (parseSchemaType "base64Binary")) , ("Xsd.AnyURI", fmap FourOf5 (parseSchemaType "url")) , ("HTTPAttachmentReference", fmap FiveOf5 (parseSchemaType "attachmentReference")) ]) schemaTypeToXML s x@ExternalDocument{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "mimeType") $ externDocum_mimeType x , maybe [] (foldOneOf5 (schemaTypeToXML "string") (schemaTypeToXML "hexadecimalBinary") (schemaTypeToXML "base64Binary") (schemaTypeToXML "url") (schemaTypeToXML "attachmentReference") ) $ externDocum_choice1 x ] -- | A special type that allows references to HTTP attachments -- identified with an HTTP "Content-ID" header, as is done -- with SOAP with Attachments -- (http://www.w3.org/TR/SOAP-attachments). Unlike with a -- normal FpML @href, the type is not IDREF, as the target is -- not identified by an XML @id attribute. data HTTPAttachmentReference = HTTPAttachmentReference { hTTPAttachRef_href :: Xsd.XsdString } deriving (Eq,Show) instance SchemaType HTTPAttachmentReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (HTTPAttachmentReference a0) schemaTypeToXML s x@HTTPAttachmentReference{} = toXMLElement s [ toXMLAttribute "href" $ hTTPAttachRef_href x ] [] instance Extension HTTPAttachmentReference Reference where supertype v = Reference_HTTPAttachmentReference v -- | A special type meant to be used for elements with no -- content and no attributes. data Empty = Empty deriving (Eq,Show) instance SchemaType Empty where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Empty schemaTypeToXML s x@Empty{} = toXMLElement s [] [] -- | A legal entity identifier (e.g. RED entity code). data EntityId = EntityId Scheme EntityIdAttributes deriving (Eq,Show) data EntityIdAttributes = EntityIdAttributes { entityIdAttrib_entityIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType EntityId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "entityIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ EntityId v (EntityIdAttributes a0) schemaTypeToXML s (EntityId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "entityIdScheme") $ entityIdAttrib_entityIdScheme at ] $ schemaTypeToXML s bt instance Extension EntityId Scheme where supertype (EntityId s _) = s -- | The name of the reference entity. A free format string. -- FpML does not define usage rules for this element. data EntityName = EntityName Scheme EntityNameAttributes deriving (Eq,Show) data EntityNameAttributes = EntityNameAttributes { entityNameAttrib_entityNameScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType EntityName where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "entityNameScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ EntityName v (EntityNameAttributes a0) schemaTypeToXML s (EntityName bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "entityNameScheme") $ entityNameAttrib_entityNameScheme at ] $ schemaTypeToXML s bt instance Extension EntityName Scheme where supertype (EntityName s _) = s -- | A type defining the exercise period for a European style -- option together with any rules governing the notional -- amount of the underlying which can be exercised on any -- given exercise date and any associated exercise fees. data EuropeanExercise = EuropeanExercise { europExerc_ID :: Maybe Xsd.ID , europExerc_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. , europExerc_relevantUnderlyingDate :: Maybe AdjustableOrRelativeDates -- ^ The date on the underlying set by the exercise of an -- option. What this date is depends on the option (e.g. in a -- swaption it is the swap effective date, in an -- extendible/cancelable provision it is the swap termination -- date). , europExerc_earliestExerciseTime :: Maybe BusinessCenterTime -- ^ The earliest time at which notice of exercise can be given -- by the buyer to the seller (or seller's agent) i) on the -- expriation date, in the case of a European style option, -- (ii) on each bermuda option exercise date and the -- expiration date, in the case of a Bermuda style option the -- commencement date to, and including, the expiration date , -- in the case of an American option. , europExerc_expirationTime :: Maybe BusinessCenterTime -- ^ The latest time for exercise on expirationDate. , europExerc_partialExercise :: Maybe PartialExercise -- ^ As defined in the 2000 ISDA Definitions, Section 12.3. -- Partial Exercise, the buyer of the option has the right to -- exercise all or less than all the notional amount of the -- underlying swap on the expiration date, but may not -- exercise less than the minimum notional amount, and if an -- integral multiple amount is specified, the notional amount -- exercised must be equal to, or be an integral multiple of, -- the integral multiple amount. , europExerc_exerciseFee :: Maybe ExerciseFee -- ^ A fee to be paid on exercise. This could be represented as -- an amount or a rate and notional reference on which to -- apply the rate. } deriving (Eq,Show) instance SchemaType EuropeanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (EuropeanExercise a0) `apply` parseSchemaType "expirationDate" `apply` optional (parseSchemaType "relevantUnderlyingDate") `apply` optional (parseSchemaType "earliestExerciseTime") `apply` optional (parseSchemaType "expirationTime") `apply` optional (parseSchemaType "partialExercise") `apply` optional (parseSchemaType "exerciseFee") schemaTypeToXML s x@EuropeanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ europExerc_ID x ] [ schemaTypeToXML "expirationDate" $ europExerc_expirationDate x , maybe [] (schemaTypeToXML "relevantUnderlyingDate") $ europExerc_relevantUnderlyingDate x , maybe [] (schemaTypeToXML "earliestExerciseTime") $ europExerc_earliestExerciseTime x , maybe [] (schemaTypeToXML "expirationTime") $ europExerc_expirationTime x , maybe [] (schemaTypeToXML "partialExercise") $ europExerc_partialExercise x , maybe [] (schemaTypeToXML "exerciseFee") $ europExerc_exerciseFee x ] instance Extension EuropeanExercise Exercise where supertype v = Exercise_EuropeanExercise v -- | A short form unique identifier for an exchange. If the -- element is not present then the exchange shall be the -- primary exchange on which the underlying is listed. The -- term "Exchange" is assumed to have the meaning as defined -- in the ISDA 2002 Equity Derivatives Definitions. data ExchangeId = ExchangeId Scheme ExchangeIdAttributes deriving (Eq,Show) data ExchangeIdAttributes = ExchangeIdAttributes { exchIdAttrib_exchangeIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ExchangeId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "exchangeIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ExchangeId v (ExchangeIdAttributes a0) schemaTypeToXML s (ExchangeId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "exchangeIdScheme") $ exchIdAttrib_exchangeIdScheme at ] $ schemaTypeToXML s bt instance Extension ExchangeId Scheme where supertype (ExchangeId s _) = s -- | The abstract base class for all types which define way in -- which options may be exercised. data Exercise = Exercise_SharedAmericanExercise SharedAmericanExercise | Exercise_EuropeanExercise EuropeanExercise | Exercise_BermudaExercise BermudaExercise | Exercise_AmericanExercise AmericanExercise | Exercise_FxEuropeanExercise FxEuropeanExercise | Exercise_FxDigitalAmericanExercise FxDigitalAmericanExercise | Exercise_CommodityPhysicalEuropeanExercise CommodityPhysicalEuropeanExercise | Exercise_CommodityPhysicalAmericanExercise CommodityPhysicalAmericanExercise | Exercise_CommodityEuropeanExercise CommodityEuropeanExercise | Exercise_CommodityAmericanExercise CommodityAmericanExercise | Exercise_EquityEuropeanExercise EquityEuropeanExercise deriving (Eq,Show) instance SchemaType Exercise where parseSchemaType s = do (fmap Exercise_SharedAmericanExercise $ parseSchemaType s) `onFail` (fmap Exercise_EuropeanExercise $ parseSchemaType s) `onFail` (fmap Exercise_BermudaExercise $ parseSchemaType s) `onFail` (fmap Exercise_AmericanExercise $ parseSchemaType s) `onFail` (fmap Exercise_FxEuropeanExercise $ parseSchemaType s) `onFail` (fmap Exercise_FxDigitalAmericanExercise $ parseSchemaType s) `onFail` (fmap Exercise_CommodityPhysicalEuropeanExercise $ parseSchemaType s) `onFail` (fmap Exercise_CommodityPhysicalAmericanExercise $ parseSchemaType s) `onFail` (fmap Exercise_CommodityEuropeanExercise $ parseSchemaType s) `onFail` (fmap Exercise_CommodityAmericanExercise $ parseSchemaType s) `onFail` (fmap Exercise_EquityEuropeanExercise $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of Exercise,\n\ \ namely one of:\n\ \SharedAmericanExercise,EuropeanExercise,BermudaExercise,AmericanExercise,FxEuropeanExercise,FxDigitalAmericanExercise,CommodityPhysicalEuropeanExercise,CommodityPhysicalAmericanExercise,CommodityEuropeanExercise,CommodityAmericanExercise,EquityEuropeanExercise" schemaTypeToXML _s (Exercise_SharedAmericanExercise x) = schemaTypeToXML "sharedAmericanExercise" x schemaTypeToXML _s (Exercise_EuropeanExercise x) = schemaTypeToXML "europeanExercise" x schemaTypeToXML _s (Exercise_BermudaExercise x) = schemaTypeToXML "bermudaExercise" x schemaTypeToXML _s (Exercise_AmericanExercise x) = schemaTypeToXML "americanExercise" x schemaTypeToXML _s (Exercise_FxEuropeanExercise x) = schemaTypeToXML "fxEuropeanExercise" x schemaTypeToXML _s (Exercise_FxDigitalAmericanExercise x) = schemaTypeToXML "fxDigitalAmericanExercise" x schemaTypeToXML _s (Exercise_CommodityPhysicalEuropeanExercise x) = schemaTypeToXML "commodityPhysicalEuropeanExercise" x schemaTypeToXML _s (Exercise_CommodityPhysicalAmericanExercise x) = schemaTypeToXML "commodityPhysicalAmericanExercise" x schemaTypeToXML _s (Exercise_CommodityEuropeanExercise x) = schemaTypeToXML "commodityEuropeanExercise" x schemaTypeToXML _s (Exercise_CommodityAmericanExercise x) = schemaTypeToXML "commodityAmericanExercise" x schemaTypeToXML _s (Exercise_EquityEuropeanExercise x) = schemaTypeToXML "equityEuropeanExercise" x -- | A type defining the fee payable on exercise of an option. -- This fee may be defined as an amount or a percentage of the -- notional exercised. data ExerciseFee = ExerciseFee { exerciseFee_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , exerciseFee_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , exerciseFee_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , exerciseFee_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , exerciseFee_notionalReference :: Maybe NotionalReference -- ^ A pointer style reference to the associated notional -- schedule defined elsewhere in the document. , exerciseFee_choice5 :: (Maybe (OneOf2 Xsd.Decimal Xsd.Decimal)) -- ^ Choice between: -- -- (1) The amount of fee to be paid on exercise. The fee -- currency is that of the referenced notional. -- -- (2) A fee represented as a percentage of some referenced -- notional. A percentage of 5% would be represented as -- 0.05. , exerciseFee_feePaymentDate :: Maybe RelativeDateOffset -- ^ The date on which exercise fee(s) will be paid. It is -- specified as a relative date. } deriving (Eq,Show) instance SchemaType ExerciseFee where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ExerciseFee `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "notionalReference") `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "feeAmount")) , ("Xsd.Decimal", fmap TwoOf2 (parseSchemaType "feeRate")) ]) `apply` optional (parseSchemaType "feePaymentDate") schemaTypeToXML s x@ExerciseFee{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "payerPartyReference") $ exerciseFee_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ exerciseFee_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ exerciseFee_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ exerciseFee_receiverAccountReference x , maybe [] (schemaTypeToXML "notionalReference") $ exerciseFee_notionalReference x , maybe [] (foldOneOf2 (schemaTypeToXML "feeAmount") (schemaTypeToXML "feeRate") ) $ exerciseFee_choice5 x , maybe [] (schemaTypeToXML "feePaymentDate") $ exerciseFee_feePaymentDate x ] -- | A type to define a fee or schedule of fees to be payable on -- the exercise of an option. This fee may be defined as an -- amount or a percentage of the notional exercised. data ExerciseFeeSchedule = ExerciseFeeSchedule { exercFeeSched_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , exercFeeSched_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , exercFeeSched_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , exercFeeSched_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , exercFeeSched_notionalReference :: Maybe ScheduleReference -- ^ A pointer style reference to the associated notional -- schedule defined elsewhere in the document. , exercFeeSched_choice5 :: (Maybe (OneOf2 AmountSchedule Schedule)) -- ^ Choice between: -- -- (1) The exercise fee amount schedule. The fees are -- expressed as currency amounts. The currency of the fee -- is assumed to be that of the notional schedule -- referenced. -- -- (2) The exercise free rate schedule. The fees are expressed -- as percentage rates of the notional being exercised. -- The currency of the fee is assumed to be that of the -- notional schedule referenced. , exercFeeSched_feePaymentDate :: Maybe RelativeDateOffset -- ^ The date on which exercise fee(s) will be paid. It is -- specified as a relative date. } deriving (Eq,Show) instance SchemaType ExerciseFeeSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ExerciseFeeSchedule `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "notionalReference") `apply` optional (oneOf' [ ("AmountSchedule", fmap OneOf2 (parseSchemaType "feeAmountSchedule")) , ("Schedule", fmap TwoOf2 (parseSchemaType "feeRateSchedule")) ]) `apply` optional (parseSchemaType "feePaymentDate") schemaTypeToXML s x@ExerciseFeeSchedule{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "payerPartyReference") $ exercFeeSched_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ exercFeeSched_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ exercFeeSched_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ exercFeeSched_receiverAccountReference x , maybe [] (schemaTypeToXML "notionalReference") $ exercFeeSched_notionalReference x , maybe [] (foldOneOf2 (schemaTypeToXML "feeAmountSchedule") (schemaTypeToXML "feeRateSchedule") ) $ exercFeeSched_choice5 x , maybe [] (schemaTypeToXML "feePaymentDate") $ exercFeeSched_feePaymentDate x ] -- | A type defining to whom and where notice of execution -- should be given. The partyReference refers to one of the -- principal parties of the trade. If present the -- exerciseNoticePartyReference refers to a party, other than -- the principal party, to whome notice should be given. data ExerciseNotice = ExerciseNotice { exercNotice_partyReference :: Maybe PartyReference -- ^ The party referenced has allocated the trade identifier. , exerciseNotice_partyReference :: Maybe PartyReference -- ^ The party referenced is the party to which notice of -- exercise should be given by the buyer. , exercNotice_businessCenter :: Maybe BusinessCenter } deriving (Eq,Show) instance SchemaType ExerciseNotice where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ExerciseNotice `apply` optional (parseSchemaType "partyReference") `apply` optional (parseSchemaType "exerciseNoticePartyReference") `apply` optional (parseSchemaType "businessCenter") schemaTypeToXML s x@ExerciseNotice{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "partyReference") $ exercNotice_partyReference x , maybe [] (schemaTypeToXML "exerciseNoticePartyReference") $ exerciseNotice_partyReference x , maybe [] (schemaTypeToXML "businessCenter") $ exercNotice_businessCenter x ] -- | A type describing how notice of exercise should be given. -- This can be either manual or automatic. data ExerciseProcedure = ExerciseProcedure { exercProced_choice0 :: (Maybe (OneOf2 ManualExercise AutomaticExercise)) -- ^ Choice between: -- -- (1) Specifies that the notice of exercise must be given by -- the buyer to the seller or seller's agent. -- -- (2) If automatic is specified then the notional amount of -- the underlying swap, not previously exercised under the -- swaption will be automatically exercised at the -- expriration time on the expiration date if at such time -- the buyer is in-the-money, provided that the difference -- between the settlement rate and the fixed rate under -- the relevant underlying swap is not less than the -- specified threshold rate. The term in-the-money is -- assumed to have the meaning defining in the 2000 ISDA -- Definitions, Section 17.4 In-the-money. , exercProced_followUpConfirmation :: Maybe Xsd.Boolean -- ^ A flag to indicate whether follow-up confirmation of -- exercise (written or electronic) is required following -- telephonic notice by the buyer to the seller or seller's -- agent. , exercProced_limitedRightToConfirm :: Maybe Xsd.Boolean -- ^ Has the meaning defined as part of the 1997 ISDA Government -- Bond Option Definitions, section 4.5 Limited Right to -- Confirm Exercise. If present, (i) the Seller may request -- the Buyer to confirm its intent if not done on or before -- the expiration time on the Expiration date (ii) specific -- rules will apply in relation to the settlement mode. , exercProced_splitTicket :: Maybe Xsd.Boolean -- ^ Typically applicable to the physical settlement of bond and -- convertible bond options. If present, means that the Party -- required to deliver the bonds will divide those to be -- delivered as notifying party desires to facilitate delivery -- obligations. } deriving (Eq,Show) instance SchemaType ExerciseProcedure where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ExerciseProcedure `apply` optional (oneOf' [ ("ManualExercise", fmap OneOf2 (parseSchemaType "manualExercise")) , ("AutomaticExercise", fmap TwoOf2 (parseSchemaType "automaticExercise")) ]) `apply` optional (parseSchemaType "followUpConfirmation") `apply` optional (parseSchemaType "limitedRightToConfirm") `apply` optional (parseSchemaType "splitTicket") schemaTypeToXML s x@ExerciseProcedure{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "manualExercise") (schemaTypeToXML "automaticExercise") ) $ exercProced_choice0 x , maybe [] (schemaTypeToXML "followUpConfirmation") $ exercProced_followUpConfirmation x , maybe [] (schemaTypeToXML "limitedRightToConfirm") $ exercProced_limitedRightToConfirm x , maybe [] (schemaTypeToXML "splitTicket") $ exercProced_splitTicket x ] -- | A type describing how notice of exercise should be given. -- This can be either manual or automatic. data ExerciseProcedureOption = ExerciseProcedureOption { exercProcedOption_choice0 :: OneOf2 Empty Empty -- ^ Choice between: -- -- (1) Specifies that the notice of exercise must be given by -- the buyer to the seller or seller's agent. -- -- (2) If automatic is specified then the notional amount of -- the underlying swap, not previously exercised under the -- swaption will be automatically exercised at the -- expriration time on the expiration date if at such time -- the buyer is in-the-money, provided that the difference -- between the settlement rate and the fixed rate under -- the relevant underlying swap is not less than the -- specified threshold rate. The term in-the-money is -- assumed to have the meaning defining in the 2000 ISDA -- Definitions, Section 17.4 In-the-money. } deriving (Eq,Show) instance SchemaType ExerciseProcedureOption where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ExerciseProcedureOption `apply` oneOf' [ ("Empty", fmap OneOf2 (parseSchemaType "manualExercise")) , ("Empty", fmap TwoOf2 (parseSchemaType "automaticExercise")) ] schemaTypeToXML s x@ExerciseProcedureOption{} = toXMLElement s [] [ foldOneOf2 (schemaTypeToXML "manualExercise") (schemaTypeToXML "automaticExercise") $ exercProcedOption_choice0 x ] -- | A type defining a floating rate. data FloatingRate = FloatingRate { floatingRate_ID :: Maybe Xsd.ID , floatingRate_index :: FloatingRateIndex , floatingRate_indexTenor :: Maybe Period -- ^ The ISDA Designated Maturity, i.e. the tenor of the -- floating rate. , floatingRate_multiplierSchedule :: Maybe Schedule -- ^ A rate multiplier or multiplier schedule to apply to the -- floating rate. A multiplier schedule is expressed as -- explicit multipliers and dates. In the case of a schedule, -- the step dates may be subject to adjustment in accordance -- with any adjustments specified in the -- calculationPeriodDatesAdjustments. The multiplier can be a -- positive or negative decimal. This element should only be -- included if the multiplier is not equal to 1 (one) for the -- term of the stream. , floatingRate_spreadSchedule :: [SpreadSchedule] -- ^ The ISDA Spread or a Spread schedule expressed as explicit -- spreads and dates. In the case of a schedule, the step -- dates may be subject to adjustment in accordance with any -- adjustments specified in calculationPeriodDatesAdjustments. -- The spread is a per annum rate, expressed as a decimal. For -- purposes of determining a calculation period amount, if -- positive the spread will be added to the floating rate and -- if negative the spread will be subtracted from the floating -- rate. A positive 10 basis point (0.1%) spread would be -- represented as 0.001. , floatingRate_rateTreatment :: Maybe RateTreatmentEnum -- ^ The specification of any rate conversion which needs to be -- applied to the observed rate before being used in any -- calculations. The two common conversions are for securities -- quoted on a bank discount basis which will need to be -- converted to either a Money Market Yield or Bond Equivalent -- Yield. See the Annex to the 2000 ISDA Definitions, Section -- 7.3. Certain General Definitions Relating to Floating Rate -- Options, paragraphs (g) and (h) for definitions of these -- terms. , floatingRate_capRateSchedule :: [StrikeSchedule] -- ^ The cap rate or cap rate schedule, if any, which applies to -- the floating rate. The cap rate (strike) is only required -- where the floating rate on a swap stream is capped at a -- certain level. A cap rate schedule is expressed as explicit -- cap rates and dates and the step dates may be subject to -- adjustment in accordance with any adjustments specified in -- calculationPeriodDatesAdjustments. The cap rate is assumed -- to be exclusive of any spread and is a per annum rate, -- expressed as a decimal. A cap rate of 5% would be -- represented as 0.05. , floatingRate_floorRateSchedule :: [StrikeSchedule] -- ^ The floor rate or floor rate schedule, if any, which -- applies to the floating rate. The floor rate (strike) is -- only required where the floating rate on a swap stream is -- floored at a certain strike level. A floor rate schedule is -- expressed as explicit floor rates and dates and the step -- dates may be subject to adjustment in accordance with any -- adjustments specified in calculationPeriodDatesAdjustments. -- The floor rate is assumed to be exclusive of any spread and -- is a per annum rate, expressed as a decimal. A floor rate -- of 5% would be represented as 0.05. } deriving (Eq,Show) instance SchemaType FloatingRate where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FloatingRate a0) `apply` parseSchemaType "floatingRateIndex" `apply` optional (parseSchemaType "indexTenor") `apply` optional (parseSchemaType "floatingRateMultiplierSchedule") `apply` many (parseSchemaType "spreadSchedule") `apply` optional (parseSchemaType "rateTreatment") `apply` many (parseSchemaType "capRateSchedule") `apply` many (parseSchemaType "floorRateSchedule") schemaTypeToXML s x@FloatingRate{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ floatingRate_ID x ] [ schemaTypeToXML "floatingRateIndex" $ floatingRate_index x , maybe [] (schemaTypeToXML "indexTenor") $ floatingRate_indexTenor x , maybe [] (schemaTypeToXML "floatingRateMultiplierSchedule") $ floatingRate_multiplierSchedule x , concatMap (schemaTypeToXML "spreadSchedule") $ floatingRate_spreadSchedule x , maybe [] (schemaTypeToXML "rateTreatment") $ floatingRate_rateTreatment x , concatMap (schemaTypeToXML "capRateSchedule") $ floatingRate_capRateSchedule x , concatMap (schemaTypeToXML "floorRateSchedule") $ floatingRate_floorRateSchedule x ] instance Extension FloatingRate Rate where supertype v = Rate_FloatingRate v -- | A type defining the floating rate and definitions relating -- to the calculation of floating rate amounts. data FloatingRateCalculation = FloatingRateCalculation { floatRateCalc_ID :: Maybe Xsd.ID , floatRateCalc_floatingRateIndex :: FloatingRateIndex , floatRateCalc_indexTenor :: Maybe Period -- ^ The ISDA Designated Maturity, i.e. the tenor of the -- floating rate. , floatRateCalc_floatingRateMultiplierSchedule :: Maybe Schedule -- ^ A rate multiplier or multiplier schedule to apply to the -- floating rate. A multiplier schedule is expressed as -- explicit multipliers and dates. In the case of a schedule, -- the step dates may be subject to adjustment in accordance -- with any adjustments specified in the -- calculationPeriodDatesAdjustments. The multiplier can be a -- positive or negative decimal. This element should only be -- included if the multiplier is not equal to 1 (one) for the -- term of the stream. , floatRateCalc_spreadSchedule :: [SpreadSchedule] -- ^ The ISDA Spread or a Spread schedule expressed as explicit -- spreads and dates. In the case of a schedule, the step -- dates may be subject to adjustment in accordance with any -- adjustments specified in calculationPeriodDatesAdjustments. -- The spread is a per annum rate, expressed as a decimal. For -- purposes of determining a calculation period amount, if -- positive the spread will be added to the floating rate and -- if negative the spread will be subtracted from the floating -- rate. A positive 10 basis point (0.1%) spread would be -- represented as 0.001. , floatRateCalc_rateTreatment :: Maybe RateTreatmentEnum -- ^ The specification of any rate conversion which needs to be -- applied to the observed rate before being used in any -- calculations. The two common conversions are for securities -- quoted on a bank discount basis which will need to be -- converted to either a Money Market Yield or Bond Equivalent -- Yield. See the Annex to the 2000 ISDA Definitions, Section -- 7.3. Certain General Definitions Relating to Floating Rate -- Options, paragraphs (g) and (h) for definitions of these -- terms. , floatRateCalc_capRateSchedule :: [StrikeSchedule] -- ^ The cap rate or cap rate schedule, if any, which applies to -- the floating rate. The cap rate (strike) is only required -- where the floating rate on a swap stream is capped at a -- certain level. A cap rate schedule is expressed as explicit -- cap rates and dates and the step dates may be subject to -- adjustment in accordance with any adjustments specified in -- calculationPeriodDatesAdjustments. The cap rate is assumed -- to be exclusive of any spread and is a per annum rate, -- expressed as a decimal. A cap rate of 5% would be -- represented as 0.05. , floatRateCalc_floorRateSchedule :: [StrikeSchedule] -- ^ The floor rate or floor rate schedule, if any, which -- applies to the floating rate. The floor rate (strike) is -- only required where the floating rate on a swap stream is -- floored at a certain strike level. A floor rate schedule is -- expressed as explicit floor rates and dates and the step -- dates may be subject to adjustment in accordance with any -- adjustments specified in calculationPeriodDatesAdjustments. -- The floor rate is assumed to be exclusive of any spread and -- is a per annum rate, expressed as a decimal. A floor rate -- of 5% would be represented as 0.05. , floatRateCalc_initialRate :: Maybe Xsd.Decimal -- ^ The initial floating rate reset agreed between the -- principal parties involved in the trade. This is assumed to -- be the first required reset rate for the first regular -- calculation period. It should only be included when the -- rate is not equal to the rate published on the source -- implied by the floating rate index. An initial rate of 5% -- would be represented as 0.05. , floatRateCalc_finalRateRounding :: Maybe Rounding -- ^ The rounding convention to apply to the final rate used in -- determination of a calculation period amount. , floatRateCalc_averagingMethod :: Maybe AveragingMethodEnum -- ^ If averaging is applicable, this component specifies -- whether a weighted or unweighted average method of -- calculation is to be used. The component must only be -- included when averaging applies. , floatRateCalc_negativeInterestRateTreatment :: Maybe NegativeInterestRateTreatmentEnum -- ^ The specification of any provisions for calculating payment -- obligations when a floating rate is negative (either due to -- a quoted negative floating rate or by operation of a spread -- that is subtracted from the floating rate). } deriving (Eq,Show) instance SchemaType FloatingRateCalculation where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FloatingRateCalculation a0) `apply` parseSchemaType "floatingRateIndex" `apply` optional (parseSchemaType "indexTenor") `apply` optional (parseSchemaType "floatingRateMultiplierSchedule") `apply` many (parseSchemaType "spreadSchedule") `apply` optional (parseSchemaType "rateTreatment") `apply` many (parseSchemaType "capRateSchedule") `apply` many (parseSchemaType "floorRateSchedule") `apply` optional (parseSchemaType "initialRate") `apply` optional (parseSchemaType "finalRateRounding") `apply` optional (parseSchemaType "averagingMethod") `apply` optional (parseSchemaType "negativeInterestRateTreatment") schemaTypeToXML s x@FloatingRateCalculation{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ floatRateCalc_ID x ] [ schemaTypeToXML "floatingRateIndex" $ floatRateCalc_floatingRateIndex x , maybe [] (schemaTypeToXML "indexTenor") $ floatRateCalc_indexTenor x , maybe [] (schemaTypeToXML "floatingRateMultiplierSchedule") $ floatRateCalc_floatingRateMultiplierSchedule x , concatMap (schemaTypeToXML "spreadSchedule") $ floatRateCalc_spreadSchedule x , maybe [] (schemaTypeToXML "rateTreatment") $ floatRateCalc_rateTreatment x , concatMap (schemaTypeToXML "capRateSchedule") $ floatRateCalc_capRateSchedule x , concatMap (schemaTypeToXML "floorRateSchedule") $ floatRateCalc_floorRateSchedule x , maybe [] (schemaTypeToXML "initialRate") $ floatRateCalc_initialRate x , maybe [] (schemaTypeToXML "finalRateRounding") $ floatRateCalc_finalRateRounding x , maybe [] (schemaTypeToXML "averagingMethod") $ floatRateCalc_averagingMethod x , maybe [] (schemaTypeToXML "negativeInterestRateTreatment") $ floatRateCalc_negativeInterestRateTreatment x ] instance Extension FloatingRateCalculation FloatingRate where supertype (FloatingRateCalculation a0 e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10) = FloatingRate a0 e0 e1 e2 e3 e4 e5 e6 instance Extension FloatingRateCalculation Rate where supertype = (supertype :: FloatingRate -> Rate) . (supertype :: FloatingRateCalculation -> FloatingRate) -- | The ISDA Floating Rate Option, i.e. the floating rate -- index. data FloatingRateIndex = FloatingRateIndex Scheme FloatingRateIndexAttributes deriving (Eq,Show) data FloatingRateIndexAttributes = FloatingRateIndexAttributes { floatRateIndexAttrib_floatingRateIndexScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType FloatingRateIndex where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "floatingRateIndexScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ FloatingRateIndex v (FloatingRateIndexAttributes a0) schemaTypeToXML s (FloatingRateIndex bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "floatingRateIndexScheme") $ floatRateIndexAttrib_floatingRateIndexScheme at ] $ schemaTypeToXML s bt instance Extension FloatingRateIndex Scheme where supertype (FloatingRateIndex s _) = s -- | A type defining a rate index. data ForecastRateIndex = ForecastRateIndex { forecRateIndex_floatingRateIndex :: Maybe FloatingRateIndex -- ^ The ISDA Floating Rate Option, i.e. the floating rate -- index. , forecRateIndex_indexTenor :: Maybe Period -- ^ The ISDA Designated Maturity, i.e. the tenor of the -- floating rate. } deriving (Eq,Show) instance SchemaType ForecastRateIndex where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ForecastRateIndex `apply` optional (parseSchemaType "floatingRateIndex") `apply` optional (parseSchemaType "indexTenor") schemaTypeToXML s x@ForecastRateIndex{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "floatingRateIndex") $ forecRateIndex_floatingRateIndex x , maybe [] (schemaTypeToXML "indexTenor") $ forecRateIndex_indexTenor x ] -- | A type describing a financial formula, with its description -- and components. data Formula = Formula { formula_description :: Maybe Xsd.XsdString -- ^ Text description of the formula , formula_math :: Maybe Math -- ^ An element for containing an XML representation of the -- formula. Defined using xsd:any currently for flexibility in -- choice of language (MathML, OpenMath) , formula_component :: [FormulaComponent] -- ^ Elements describing the components of the formula. The name -- attribute points to a value used in the math element. The -- href attribute points to a value elsewhere in the document } deriving (Eq,Show) instance SchemaType Formula where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Formula `apply` optional (parseSchemaType "formulaDescription") `apply` optional (parseSchemaType "math") `apply` many (parseSchemaType "formulaComponent") schemaTypeToXML s x@Formula{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "formulaDescription") $ formula_description x , maybe [] (schemaTypeToXML "math") $ formula_math x , concatMap (schemaTypeToXML "formulaComponent") $ formula_component x ] -- | Elements describing the components of the formula. The name -- attribute points to a value used in the math element. The -- href attribute points to a numeric value defined elsewhere -- in the document that is used by the formula component. data FormulaComponent = FormulaComponent { formulaCompon_name :: Maybe Xsd.NormalizedString , formulaCompon_componentDescription :: Maybe Xsd.XsdString -- ^ Text description of the component , formulaCompon_formula :: Maybe Formula -- ^ Additional formulas required to describe this component } deriving (Eq,Show) instance SchemaType FormulaComponent where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "name" e pos commit $ interior e $ return (FormulaComponent a0) `apply` optional (parseSchemaType "componentDescription") `apply` optional (parseSchemaType "formula") schemaTypeToXML s x@FormulaComponent{} = toXMLElement s [ maybe [] (toXMLAttribute "name") $ formulaCompon_name x ] [ maybe [] (schemaTypeToXML "componentDescription") $ formulaCompon_componentDescription x , maybe [] (schemaTypeToXML "formula") $ formulaCompon_formula x ] -- | A type defining a time frequency, e.g. one day, three -- months. Used for specifying payment or calculation -- frequencies at which the value T (Term) is applicable. data Frequency = Frequency { frequency_ID :: Maybe Xsd.ID , frequency_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. , frequency_period :: Maybe PeriodExtendedEnum -- ^ A time period, e.g. a day, week, month, year or term of the -- stream. } deriving (Eq,Show) instance SchemaType Frequency where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Frequency a0) `apply` optional (parseSchemaType "periodMultiplier") `apply` optional (parseSchemaType "period") schemaTypeToXML s x@Frequency{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ frequency_ID x ] [ maybe [] (schemaTypeToXML "periodMultiplier") $ frequency_periodMultiplier x , maybe [] (schemaTypeToXML "period") $ frequency_period x ] -- | A type defining a currency amount as at a future value -- date. data FutureValueAmount = FutureValueAmount { futureValueAmount_ID :: Maybe Xsd.ID , futureValueAmount_currency :: Currency -- ^ The currency in which an amount is denominated. , futureValueAmount_amount :: NonNegativeDecimal -- ^ The non negative monetary quantity in currency units. , futureValueAmount_calculationPeriodNumberOfDays :: Maybe Xsd.PositiveInteger -- ^ The number of days from the adjusted calculation period -- start date to the adjusted value date, calculated in -- accordance with the applicable day count fraction. , futureValueAmount_valueDate :: Maybe Xsd.Date -- ^ Adjusted value date of the future value amount. } deriving (Eq,Show) instance SchemaType FutureValueAmount where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (FutureValueAmount a0) `apply` parseSchemaType "currency" `apply` parseSchemaType "amount" `apply` optional (parseSchemaType "calculationPeriodNumberOfDays") `apply` optional (parseSchemaType "valueDate") schemaTypeToXML s x@FutureValueAmount{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ futureValueAmount_ID x ] [ schemaTypeToXML "currency" $ futureValueAmount_currency x , schemaTypeToXML "amount" $ futureValueAmount_amount x , maybe [] (schemaTypeToXML "calculationPeriodNumberOfDays") $ futureValueAmount_calculationPeriodNumberOfDays x , maybe [] (schemaTypeToXML "valueDate") $ futureValueAmount_valueDate x ] instance Extension FutureValueAmount NonNegativeMoney where supertype (FutureValueAmount a0 e0 e1 e2 e3) = NonNegativeMoney a0 e0 e1 instance Extension FutureValueAmount MoneyBase where supertype = (supertype :: NonNegativeMoney -> MoneyBase) . (supertype :: FutureValueAmount -> NonNegativeMoney) -- | A type that specifies the source for and timing of a fixing -- of an exchange rate. This is used in the agreement of -- non-deliverable forward trades as well as various types of -- FX OTC options that require observations against a -- particular rate. data FxFixing = FxFixing { fxFixing_quotedCurrencyPair :: Maybe QuotedCurrencyPair -- ^ Defines the two currencies for an FX trade and the -- quotation relationship between the two currencies. , fxFixing_fixingDate :: Maybe Xsd.Date -- ^ Describes the specific date when a non-deliverable forward -- or cash-settled option will "fix" against a particular -- rate, which will be used to compute the ultimate cash -- settlement. This element should be omitted where a single, -- discrete fixing date cannot be identified e.g. on an -- american option, where fixing may occur at any date on a -- continuous range. , fxFixing_fxSpotRateSource :: Maybe FxSpotRateSource -- ^ Specifies the methodology (reference source and, -- optionally, fixing time) to be used for determining a -- currency conversion rate. } deriving (Eq,Show) instance SchemaType FxFixing where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxFixing `apply` optional (parseSchemaType "quotedCurrencyPair") `apply` optional (parseSchemaType "fixingDate") `apply` optional (parseSchemaType "fxSpotRateSource") schemaTypeToXML s x@FxFixing{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "quotedCurrencyPair") $ fxFixing_quotedCurrencyPair x , maybe [] (schemaTypeToXML "fixingDate") $ fxFixing_fixingDate x , maybe [] (schemaTypeToXML "fxSpotRateSource") $ fxFixing_fxSpotRateSource x ] -- | A type that is used for describing cash settlement of an -- option / non deliverable forward. It includes the currency -- to settle into together with the fixings required to -- calculate the currency amount. data FxCashSettlement = FxCashSettlement { fxCashSettl_settlementCurrency :: Maybe Currency -- ^ The currency in which cash settlement occurs for -- non-deliverable forwards and cash-settled options -- (non-deliverable or otherwise). , fxCashSettl_fixing :: [FxFixing] -- ^ Specifies the source for and timing of a fixing of an -- exchange rate. This is used in the agreement of -- non-deliverable forward trades as well as various types of -- FX OTC options that require observations against a -- particular rate. This element is optional, permitting it to -- be omitted where fixing details are unavailable at the -- point of message creation. It has multiple occurrence to -- support the case where fixing details must be specified for -- more than one currency pair e.g. on an option settled into -- a third currency (that is not one of the option -- currencies). } deriving (Eq,Show) instance SchemaType FxCashSettlement where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxCashSettlement `apply` optional (parseSchemaType "settlementCurrency") `apply` many (parseSchemaType "fixing") schemaTypeToXML s x@FxCashSettlement{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "settlementCurrency") $ fxCashSettl_settlementCurrency x , concatMap (schemaTypeToXML "fixing") $ fxCashSettl_fixing x ] -- | A type describing the rate of a currency conversion: pair -- of currency, quotation mode and exchange rate. data FxRate = FxRate { fxRate_quotedCurrencyPair :: Maybe QuotedCurrencyPair -- ^ Defines the two currencies for an FX trade and the -- quotation relationship between the two currencies. , fxRate_rate :: Maybe Xsd.Decimal -- ^ The rate of exchange between the two currencies of the leg -- of a deal. Must be specified with a quote basis. } deriving (Eq,Show) instance SchemaType FxRate where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxRate `apply` optional (parseSchemaType "quotedCurrencyPair") `apply` optional (parseSchemaType "rate") schemaTypeToXML s x@FxRate{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "quotedCurrencyPair") $ fxRate_quotedCurrencyPair x , maybe [] (schemaTypeToXML "rate") $ fxRate_rate x ] -- | A type defining the source and time for an fx rate. data FxSpotRateSource = FxSpotRateSource { fxSpotRateSource_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. , fxSpotRateSource_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. , fxSpotRateSource_fixingTime :: Maybe BusinessCenterTime -- ^ The time at which the spot currency exchange rate will be -- observed. It is specified as a time in a business day -- calendar location, e.g. 11:00am London time. } deriving (Eq,Show) instance SchemaType FxSpotRateSource where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return FxSpotRateSource `apply` optional (parseSchemaType "primaryRateSource") `apply` optional (parseSchemaType "secondaryRateSource") `apply` optional (parseSchemaType "fixingTime") schemaTypeToXML s x@FxSpotRateSource{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "primaryRateSource") $ fxSpotRateSource_primaryRateSource x , maybe [] (schemaTypeToXML "secondaryRateSource") $ fxSpotRateSource_secondaryRateSource x , maybe [] (schemaTypeToXML "fixingTime") $ fxSpotRateSource_fixingTime x ] -- | An entity for defining a generic agreement executed between -- two parties for any purpose. data GenericAgreement = GenericAgreement { genericAgreem_type :: Maybe AgreementType -- ^ The type of agreement executed between the parties. , genericAgreem_version :: Maybe AgreementVersion -- ^ The version of the agreement. , genericAgreem_date :: Maybe Xsd.Date -- ^ The date on which the agreement was signed. , genericAgreem_amendmentDate :: [Xsd.Date] -- ^ A date on which the agreement was amended. , genericAgreem_governingLaw :: Maybe GoverningLaw -- ^ Identification of the law governing the agreement. } deriving (Eq,Show) instance SchemaType GenericAgreement where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return GenericAgreement `apply` optional (parseSchemaType "type") `apply` optional (parseSchemaType "version") `apply` optional (parseSchemaType "date") `apply` many (parseSchemaType "amendmentDate") `apply` optional (parseSchemaType "governingLaw") schemaTypeToXML s x@GenericAgreement{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "type") $ genericAgreem_type x , maybe [] (schemaTypeToXML "version") $ genericAgreem_version x , maybe [] (schemaTypeToXML "date") $ genericAgreem_date x , concatMap (schemaTypeToXML "amendmentDate") $ genericAgreem_amendmentDate x , maybe [] (schemaTypeToXML "governingLaw") $ genericAgreem_governingLaw x ] -- | Identification of the law governing the transaction. data GoverningLaw = GoverningLaw Scheme GoverningLawAttributes deriving (Eq,Show) data GoverningLawAttributes = GoverningLawAttributes { governLawAttrib_governingLawScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType GoverningLaw where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "governingLawScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ GoverningLaw v (GoverningLawAttributes a0) schemaTypeToXML s (GoverningLaw bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "governingLawScheme") $ governLawAttrib_governingLawScheme at ] $ schemaTypeToXML s bt instance Extension GoverningLaw Scheme where supertype (GoverningLaw s _) = s -- | A payment component owed from one party to the other for -- the cash flow date. This payment component should by of -- only a single type, e.g. a fee or a cashflow from a -- cashflow stream. data GrossCashflow = GrossCashflow { grossCashfl_cashflowId :: Maybe CashflowId -- ^ Unique identifier for a cash flow. , grossCashfl_partyTradeIdentifierReference :: Maybe PartyTradeIdentifierReference -- ^ Pointer-style reference to the partyTradeIdentifier block -- within the tradeIdentifyingItems collection, which -- identifies the parent trade for this cashflow. , grossCashfl_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , grossCashfl_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , grossCashfl_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , grossCashfl_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , grossCashfl_cashflowAmount :: Maybe Money -- ^ Cash flow amount in a given currency to be paid/received. , grossCashfl_cashflowType :: Maybe CashflowType -- ^ Defines the type of cash flow. For instance, a type of fee, -- premium, principal exchange, leg fee. } deriving (Eq,Show) instance SchemaType GrossCashflow where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return GrossCashflow `apply` optional (parseSchemaType "cashflowId") `apply` optional (parseSchemaType "partyTradeIdentifierReference") `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "cashflowAmount") `apply` optional (parseSchemaType "cashflowType") schemaTypeToXML s x@GrossCashflow{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "cashflowId") $ grossCashfl_cashflowId x , maybe [] (schemaTypeToXML "partyTradeIdentifierReference") $ grossCashfl_partyTradeIdentifierReference x , maybe [] (schemaTypeToXML "payerPartyReference") $ grossCashfl_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ grossCashfl_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ grossCashfl_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ grossCashfl_receiverAccountReference x , maybe [] (schemaTypeToXML "cashflowAmount") $ grossCashfl_cashflowAmount x , maybe [] (schemaTypeToXML "cashflowType") $ grossCashfl_cashflowType x ] -- | Specifies Currency with ID attribute. data IdentifiedCurrency = IdentifiedCurrency Currency IdentifiedCurrencyAttributes deriving (Eq,Show) data IdentifiedCurrencyAttributes = IdentifiedCurrencyAttributes { identCurrenAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType IdentifiedCurrency where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ IdentifiedCurrency v (IdentifiedCurrencyAttributes a0) schemaTypeToXML s (IdentifiedCurrency bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "id") $ identCurrenAttrib_ID at ] $ schemaTypeToXML s bt instance Extension IdentifiedCurrency Currency where supertype (IdentifiedCurrency s _) = s -- | Reference to a currency with ID attribute data IdentifiedCurrencyReference = IdentifiedCurrencyReference { identCurrenRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType IdentifiedCurrencyReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (IdentifiedCurrencyReference a0) schemaTypeToXML s x@IdentifiedCurrencyReference{} = toXMLElement s [ toXMLAttribute "href" $ identCurrenRef_href x ] [] instance Extension IdentifiedCurrencyReference Reference where supertype v = Reference_IdentifiedCurrencyReference v -- | A date which can be referenced elsewhere. data IdentifiedDate = IdentifiedDate Xsd.Date IdentifiedDateAttributes deriving (Eq,Show) data IdentifiedDateAttributes = IdentifiedDateAttributes { identDateAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType IdentifiedDate where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ IdentifiedDate v (IdentifiedDateAttributes a0) schemaTypeToXML s (IdentifiedDate bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "id") $ identDateAttrib_ID at ] $ schemaTypeToXML s bt instance Extension IdentifiedDate Xsd.Date where supertype (IdentifiedDate s _) = s -- | A type extending the PayerReceiverEnum type wih an id -- attribute. data IdentifiedPayerReceiver = IdentifiedPayerReceiver PayerReceiverEnum IdentifiedPayerReceiverAttributes deriving (Eq,Show) data IdentifiedPayerReceiverAttributes = IdentifiedPayerReceiverAttributes { identPayerReceivAttrib_ID :: Maybe Xsd.ID } deriving (Eq,Show) instance SchemaType IdentifiedPayerReceiver where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ IdentifiedPayerReceiver v (IdentifiedPayerReceiverAttributes a0) schemaTypeToXML s (IdentifiedPayerReceiver bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "id") $ identPayerReceivAttrib_ID at ] $ schemaTypeToXML s bt instance Extension IdentifiedPayerReceiver PayerReceiverEnum where supertype (IdentifiedPayerReceiver s _) = s -- | A party's industry sector classification. data IndustryClassification = IndustryClassification Scheme IndustryClassificationAttributes deriving (Eq,Show) data IndustryClassificationAttributes = IndustryClassificationAttributes { industClassAttrib_industryClassificationScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType IndustryClassification where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "industryClassificationScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ IndustryClassification v (IndustryClassificationAttributes a0) schemaTypeToXML s (IndustryClassification bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "industryClassificationScheme") $ industClassAttrib_industryClassificationScheme at ] $ schemaTypeToXML s bt instance Extension IndustryClassification Scheme where supertype (IndustryClassification s _) = s data InformationProvider = InformationProvider Scheme InformationProviderAttributes deriving (Eq,Show) data InformationProviderAttributes = InformationProviderAttributes { infoProvidAttrib_informationProviderScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType InformationProvider where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "informationProviderScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ InformationProvider v (InformationProviderAttributes a0) schemaTypeToXML s (InformationProvider bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "informationProviderScheme") $ infoProvidAttrib_informationProviderScheme at ] $ schemaTypeToXML s bt instance Extension InformationProvider Scheme where supertype (InformationProvider s _) = s -- | A type defining the source for a piece of information (e.g. -- a rate refix or an fx fixing). data InformationSource = InformationSource { infoSource_rateSource :: Maybe InformationProvider -- ^ An information source for obtaining a market rate. For -- example Bloomberg, Reuters, Telerate etc. , infoSource_rateSourcePage :: Maybe RateSourcePage -- ^ A specific page for the rate source for obtaining a market -- rate. , infoSource_rateSourcePageHeading :: Maybe Xsd.XsdString -- ^ The heading for the rate source on a given rate source -- page. } deriving (Eq,Show) instance SchemaType InformationSource where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return InformationSource `apply` optional (parseSchemaType "rateSource") `apply` optional (parseSchemaType "rateSourcePage") `apply` optional (parseSchemaType "rateSourcePageHeading") schemaTypeToXML s x@InformationSource{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "rateSource") $ infoSource_rateSource x , maybe [] (schemaTypeToXML "rateSourcePage") $ infoSource_rateSourcePage x , maybe [] (schemaTypeToXML "rateSourcePageHeading") $ infoSource_rateSourcePageHeading x ] -- | A short form unique identifier for a security. data InstrumentId = InstrumentId Scheme InstrumentIdAttributes deriving (Eq,Show) data InstrumentIdAttributes = InstrumentIdAttributes { instrIdAttrib_instrumentIdScheme :: Xsd.AnyURI } deriving (Eq,Show) instance SchemaType InstrumentId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- getAttribute "instrumentIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ InstrumentId v (InstrumentIdAttributes a0) schemaTypeToXML s (InstrumentId bt at) = addXMLAttributes [ toXMLAttribute "instrumentIdScheme" $ instrIdAttrib_instrumentIdScheme at ] $ schemaTypeToXML s bt instance Extension InstrumentId Scheme where supertype (InstrumentId s _) = s -- | A type defining the way in which interests are accrued: the -- applicable rate (fixed or floating reference) and the -- compounding method. data InterestAccrualsCompoundingMethod = InterestAccrualsCompoundingMethod { interAccruCompoMethod_choice0 :: OneOf2 FloatingRateCalculation Xsd.Decimal -- ^ Choice between: -- -- (1) The floating rate calculation definitions -- -- (2) The calculation period fixed rate. A per annum rate, -- expressed as a decimal. A fixed rate of 5% would be -- represented as 0.05. , interAccruCompoMethod_compoundingMethod :: Maybe CompoundingMethodEnum -- ^ If more that one calculation period contributes to a single -- payment amount this element specifies whether compounding -- is applicable, and if so, what compounding method is to be -- used. This element must only be included when more that one -- calculation period contributes to a single payment amount. } deriving (Eq,Show) instance SchemaType InterestAccrualsCompoundingMethod where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return InterestAccrualsCompoundingMethod `apply` oneOf' [ ("FloatingRateCalculation", fmap OneOf2 (parseSchemaType "floatingRateCalculation")) , ("Xsd.Decimal", fmap TwoOf2 (parseSchemaType "fixedRate")) ] `apply` optional (parseSchemaType "compoundingMethod") schemaTypeToXML s x@InterestAccrualsCompoundingMethod{} = toXMLElement s [] [ foldOneOf2 (schemaTypeToXML "floatingRateCalculation") (schemaTypeToXML "fixedRate") $ interAccruCompoMethod_choice0 x , maybe [] (schemaTypeToXML "compoundingMethod") $ interAccruCompoMethod_compoundingMethod x ] instance Extension InterestAccrualsCompoundingMethod InterestAccrualsMethod where supertype (InterestAccrualsCompoundingMethod e0 e1) = InterestAccrualsMethod e0 -- | A type describing the method for accruing interests on -- dividends. Can be either a fixed rate reference or a -- floating rate reference. data InterestAccrualsMethod = InterestAccrualsMethod { interAccruMethod_choice0 :: OneOf2 FloatingRateCalculation Xsd.Decimal -- ^ Choice between: -- -- (1) The floating rate calculation definitions -- -- (2) The calculation period fixed rate. A per annum rate, -- expressed as a decimal. A fixed rate of 5% would be -- represented as 0.05. } deriving (Eq,Show) instance SchemaType InterestAccrualsMethod where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return InterestAccrualsMethod `apply` oneOf' [ ("FloatingRateCalculation", fmap OneOf2 (parseSchemaType "floatingRateCalculation")) , ("Xsd.Decimal", fmap TwoOf2 (parseSchemaType "fixedRate")) ] schemaTypeToXML s x@InterestAccrualsMethod{} = toXMLElement s [] [ foldOneOf2 (schemaTypeToXML "floatingRateCalculation") (schemaTypeToXML "fixedRate") $ interAccruMethod_choice0 x ] -- | A type that describes the information to identify an -- intermediary through which payment will be made by the -- correspondent bank to the ultimate beneficiary of the -- funds. data IntermediaryInformation = IntermediaryInformation { intermInfo_choice0 :: (Maybe (OneOf3 RoutingIds RoutingExplicitDetails RoutingIdsAndExplicitDetails)) -- ^ Choice between: -- -- (1) A set of unique identifiers for a party, eachone -- identifying the party within a payment system. The -- assumption is that each party will not have more than -- one identifier within the same payment system. -- -- (2) A set of details that is used to identify a party -- involved in the routing of a payment when the party -- does not have a code that identifies it within one of -- the recognized payment systems. -- -- (3) A combination of coded payment system identifiers and -- details for physical addressing for a party involved in -- the routing of a payment. , intermInfo_intermediarySequenceNumber :: Maybe Xsd.PositiveInteger -- ^ A sequence number that gives the position of the current -- intermediary in the chain of payment intermediaries. The -- assumed domain value set is an ascending sequence of -- integers starting from 1. , intermInfo_intermediaryPartyReference :: Maybe PartyReference -- ^ Reference to the party acting as intermediary. } deriving (Eq,Show) instance SchemaType IntermediaryInformation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return IntermediaryInformation `apply` optional (oneOf' [ ("RoutingIds", fmap OneOf3 (parseSchemaType "routingIds")) , ("RoutingExplicitDetails", fmap TwoOf3 (parseSchemaType "routingExplicitDetails")) , ("RoutingIdsAndExplicitDetails", fmap ThreeOf3 (parseSchemaType "routingIdsAndExplicitDetails")) ]) `apply` optional (parseSchemaType "intermediarySequenceNumber") `apply` optional (parseSchemaType "intermediaryPartyReference") schemaTypeToXML s x@IntermediaryInformation{} = toXMLElement s [] [ maybe [] (foldOneOf3 (schemaTypeToXML "routingIds") (schemaTypeToXML "routingExplicitDetails") (schemaTypeToXML "routingIdsAndExplicitDetails") ) $ intermInfo_choice0 x , maybe [] (schemaTypeToXML "intermediarySequenceNumber") $ intermInfo_intermediarySequenceNumber x , maybe [] (schemaTypeToXML "intermediaryPartyReference") $ intermInfo_intermediaryPartyReference x ] -- | The type of interpolation used. data InterpolationMethod = InterpolationMethod Scheme InterpolationMethodAttributes deriving (Eq,Show) data InterpolationMethodAttributes = InterpolationMethodAttributes { interpMethodAttrib_interpolationMethodScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType InterpolationMethod where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "interpolationMethodScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ InterpolationMethod v (InterpolationMethodAttributes a0) schemaTypeToXML s (InterpolationMethod bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "interpolationMethodScheme") $ interpMethodAttrib_interpolationMethodScheme at ] $ schemaTypeToXML s bt instance Extension InterpolationMethod Scheme where supertype (InterpolationMethod s _) = s -- | The data type used for indicating the language of the -- resource, described using the ISO 639-2/T Code. data Language = Language Scheme LanguageAttributes deriving (Eq,Show) data LanguageAttributes = LanguageAttributes { languAttrib_languageScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType Language where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "languageScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ Language v (LanguageAttributes a0) schemaTypeToXML s (Language bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "languageScheme") $ languAttrib_languageScheme at ] $ schemaTypeToXML s bt instance Extension Language Scheme where supertype (Language s _) = s -- | A supertype of leg. All swap legs extend this type. data Leg = Leg_InterestRateStream InterestRateStream | Leg_FxSwapLeg FxSwapLeg | Leg_DirectionalLeg DirectionalLeg | Leg_CommoditySwapLeg CommoditySwapLeg | Leg_CommodityForwardLeg CommodityForwardLeg | Leg_FeeLeg FeeLeg deriving (Eq,Show) instance SchemaType Leg where parseSchemaType s = do (fmap Leg_InterestRateStream $ parseSchemaType s) `onFail` (fmap Leg_FxSwapLeg $ parseSchemaType s) `onFail` (fmap Leg_DirectionalLeg $ parseSchemaType s) `onFail` (fmap Leg_CommoditySwapLeg $ parseSchemaType s) `onFail` (fmap Leg_CommodityForwardLeg $ parseSchemaType s) `onFail` (fmap Leg_FeeLeg $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of Leg,\n\ \ namely one of:\n\ \InterestRateStream,FxSwapLeg,DirectionalLeg,CommoditySwapLeg,CommodityForwardLeg,FeeLeg" schemaTypeToXML _s (Leg_InterestRateStream x) = schemaTypeToXML "interestRateStream" x schemaTypeToXML _s (Leg_FxSwapLeg x) = schemaTypeToXML "fxSwapLeg" x schemaTypeToXML _s (Leg_DirectionalLeg x) = schemaTypeToXML "directionalLeg" x schemaTypeToXML _s (Leg_CommoditySwapLeg x) = schemaTypeToXML "commoditySwapLeg" x schemaTypeToXML _s (Leg_CommodityForwardLeg x) = schemaTypeToXML "commodityForwardLeg" x schemaTypeToXML _s (Leg_FeeLeg x) = schemaTypeToXML "feeLeg" x -- | A type defining a legal entity. data LegalEntity = LegalEntity { legalEntity_ID :: Maybe Xsd.ID , legalEntity_choice0 :: (Maybe (OneOf1 ((Maybe (EntityName)),[EntityId]))) -- ^ Choice between: -- -- (1) Sequence of: -- -- * The name of the reference entity. A free format -- string. FpML does not define usage rules for this -- element. -- -- * A legal entity identifier (e.g. RED entity code). } deriving (Eq,Show) instance SchemaType LegalEntity where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (LegalEntity a0) `apply` optional (oneOf' [ ("Maybe EntityName [EntityId]", fmap OneOf1 (return (,) `apply` optional (parseSchemaType "entityName") `apply` many (parseSchemaType "entityId"))) ]) schemaTypeToXML s x@LegalEntity{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ legalEntity_ID x ] [ maybe [] (foldOneOf1 (\ (a,b) -> concat [ maybe [] (schemaTypeToXML "entityName") a , concatMap (schemaTypeToXML "entityId") b ]) ) $ legalEntity_choice0 x ] -- | References a credit entity defined elsewhere in the -- document. data LegalEntityReference = LegalEntityReference { legalEntityRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType LegalEntityReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (LegalEntityReference a0) schemaTypeToXML s x@LegalEntityReference{} = toXMLElement s [ toXMLAttribute "href" $ legalEntityRef_href x ] [] instance Extension LegalEntityReference Reference where supertype v = Reference_LegalEntityReference v -- | A type to define the main publication source. data MainPublication = MainPublication Scheme MainPublicationAttributes deriving (Eq,Show) data MainPublicationAttributes = MainPublicationAttributes { mainPublicAttrib_mainPublicationScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType MainPublication where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "mainPublicationScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ MainPublication v (MainPublicationAttributes a0) schemaTypeToXML s (MainPublication bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "mainPublicationScheme") $ mainPublicAttrib_mainPublicationScheme at ] $ schemaTypeToXML s bt instance Extension MainPublication Scheme where supertype (MainPublication s _) = s -- | A type defining manual exercise, i.e. that the option buyer -- counterparty must give notice to the option seller of -- exercise. data ManualExercise = ManualExercise { manualExerc_exerciseNotice :: Maybe ExerciseNotice -- ^ Definition of the party to whom notice of exercise should -- be given. , manualExerc_fallbackExercise :: Maybe Xsd.Boolean -- ^ If fallback exercise is specified then the notional amount -- of the underlying swap, not previously exercised under the -- swaption, will be automatically exercised at the expiration -- time on the expiration date if at such time the buyer is -- in-the-money, provided that the difference between the -- settlement rate and the fixed rate under the relevant -- underlying swap is not less than one tenth of a percentage -- point (0.10% or 0.001). The term in-the-money is assumed to -- have the meaning defined in the 2000 ISDA Definitions, -- Section 17.4. In-the-money. } deriving (Eq,Show) instance SchemaType ManualExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ManualExercise `apply` optional (parseSchemaType "exerciseNotice") `apply` optional (parseSchemaType "fallbackExercise") schemaTypeToXML s x@ManualExercise{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "exerciseNotice") $ manualExerc_exerciseNotice x , maybe [] (schemaTypeToXML "fallbackExercise") $ manualExerc_fallbackExercise x ] -- | An entity for defining the agreement executed between the -- parties and intended to govern all OTC derivatives -- transactions between those parties. data MasterAgreement = MasterAgreement { masterAgreement_type :: Maybe MasterAgreementType -- ^ The agreement executed between the parties and intended to -- govern product-specific derivatives transactions between -- those parties. , masterAgreement_version :: Maybe MasterAgreementVersion -- ^ The version of the master agreement. , masterAgreement_date :: Maybe Xsd.Date -- ^ The date on which the master agreement was signed. } deriving (Eq,Show) instance SchemaType MasterAgreement where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return MasterAgreement `apply` optional (parseSchemaType "masterAgreementType") `apply` optional (parseSchemaType "masterAgreementVersion") `apply` optional (parseSchemaType "masterAgreementDate") schemaTypeToXML s x@MasterAgreement{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "masterAgreementType") $ masterAgreement_type x , maybe [] (schemaTypeToXML "masterAgreementVersion") $ masterAgreement_version x , maybe [] (schemaTypeToXML "masterAgreementDate") $ masterAgreement_date x ] data MasterAgreementType = MasterAgreementType Scheme MasterAgreementTypeAttributes deriving (Eq,Show) data MasterAgreementTypeAttributes = MasterAgreementTypeAttributes { masterAgreemTypeAttrib_masterAgreementTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType MasterAgreementType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "masterAgreementTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ MasterAgreementType v (MasterAgreementTypeAttributes a0) schemaTypeToXML s (MasterAgreementType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "masterAgreementTypeScheme") $ masterAgreemTypeAttrib_masterAgreementTypeScheme at ] $ schemaTypeToXML s bt instance Extension MasterAgreementType Scheme where supertype (MasterAgreementType s _) = s data MasterAgreementVersion = MasterAgreementVersion Scheme MasterAgreementVersionAttributes deriving (Eq,Show) data MasterAgreementVersionAttributes = MasterAgreementVersionAttributes { masterAgreemVersionAttrib_masterAgreementVersionScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType MasterAgreementVersion where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "masterAgreementVersionScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ MasterAgreementVersion v (MasterAgreementVersionAttributes a0) schemaTypeToXML s (MasterAgreementVersion bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "masterAgreementVersionScheme") $ masterAgreemVersionAttrib_masterAgreementVersionScheme at ] $ schemaTypeToXML s bt instance Extension MasterAgreementVersion Scheme where supertype (MasterAgreementVersion s _) = s -- | An entity for defining the master confirmation agreement -- executed between the parties. data MasterConfirmation = MasterConfirmation { masterConfirmation_type :: Maybe MasterConfirmationType -- ^ The type of master confirmation executed between the -- parties. , masterConfirmation_date :: Maybe Xsd.Date -- ^ The date of the confirmation executed between the parties -- and intended to govern all relevant transactions between -- those parties. , masterConfirmation_annexDate :: Maybe Xsd.Date -- ^ The date that an annex to the master confirmation was -- executed between the parties. , masterConfirmation_annexType :: Maybe MasterConfirmationAnnexType -- ^ The type of master confirmation annex executed between the -- parties. } deriving (Eq,Show) instance SchemaType MasterConfirmation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return MasterConfirmation `apply` optional (parseSchemaType "masterConfirmationType") `apply` optional (parseSchemaType "masterConfirmationDate") `apply` optional (parseSchemaType "masterConfirmationAnnexDate") `apply` optional (parseSchemaType "masterConfirmationAnnexType") schemaTypeToXML s x@MasterConfirmation{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "masterConfirmationType") $ masterConfirmation_type x , maybe [] (schemaTypeToXML "masterConfirmationDate") $ masterConfirmation_date x , maybe [] (schemaTypeToXML "masterConfirmationAnnexDate") $ masterConfirmation_annexDate x , maybe [] (schemaTypeToXML "masterConfirmationAnnexType") $ masterConfirmation_annexType x ] data MasterConfirmationAnnexType = MasterConfirmationAnnexType Scheme MasterConfirmationAnnexTypeAttributes deriving (Eq,Show) data MasterConfirmationAnnexTypeAttributes = MasterConfirmationAnnexTypeAttributes { mcata_masterConfirmationAnnexTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType MasterConfirmationAnnexType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "masterConfirmationAnnexTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ MasterConfirmationAnnexType v (MasterConfirmationAnnexTypeAttributes a0) schemaTypeToXML s (MasterConfirmationAnnexType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "masterConfirmationAnnexTypeScheme") $ mcata_masterConfirmationAnnexTypeScheme at ] $ schemaTypeToXML s bt instance Extension MasterConfirmationAnnexType Scheme where supertype (MasterConfirmationAnnexType s _) = s data MasterConfirmationType = MasterConfirmationType Scheme MasterConfirmationTypeAttributes deriving (Eq,Show) data MasterConfirmationTypeAttributes = MasterConfirmationTypeAttributes { masterConfirTypeAttrib_masterConfirmationTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType MasterConfirmationType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "masterConfirmationTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ MasterConfirmationType v (MasterConfirmationTypeAttributes a0) schemaTypeToXML s (MasterConfirmationType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "masterConfirmationTypeScheme") $ masterConfirTypeAttrib_masterConfirmationTypeScheme at ] $ schemaTypeToXML s bt instance Extension MasterConfirmationType Scheme where supertype (MasterConfirmationType s _) = s -- | An identifier used to identify matched cashflows. data MatchId = MatchId Scheme MatchIdAttributes deriving (Eq,Show) data MatchIdAttributes = MatchIdAttributes { matchIdAttrib_matchIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType MatchId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "matchIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ MatchId v (MatchIdAttributes a0) schemaTypeToXML s (MatchId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "matchIdScheme") $ matchIdAttrib_matchIdScheme at ] $ schemaTypeToXML s bt instance Extension MatchId Scheme where supertype (MatchId s _) = s -- | A type defining a mathematical expression. data Math = Math { math_text0 :: String , math_any1 :: [AnyElement] , math_text2 :: String } deriving (Eq,Show) instance SchemaType Math where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Math `apply` parseText `apply` many1 (parseAnyElement) `apply` parseText schemaTypeToXML s x@Math{} = toXMLElement s [] [ toXMLText $ math_text0 x , concatMap (toXMLAnyElement) $ math_any1 x , toXMLText $ math_text2 x ] data MatrixType = MatrixType Scheme MatrixTypeAttributes deriving (Eq,Show) data MatrixTypeAttributes = MatrixTypeAttributes { matrixTypeAttrib_matrixTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType MatrixType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "matrixTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ MatrixType v (MatrixTypeAttributes a0) schemaTypeToXML s (MatrixType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "matrixTypeScheme") $ matrixTypeAttrib_matrixTypeScheme at ] $ schemaTypeToXML s bt instance Extension MatrixType Scheme where supertype (MatrixType s _) = s data MatrixTerm = MatrixTerm Scheme MatrixTermAttributes deriving (Eq,Show) data MatrixTermAttributes = MatrixTermAttributes { matrixTermAttrib_matrixTermScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType MatrixTerm where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "matrixTermScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ MatrixTerm v (MatrixTermAttributes a0) schemaTypeToXML s (MatrixTerm bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "matrixTermScheme") $ matrixTermAttrib_matrixTermScheme at ] $ schemaTypeToXML s bt instance Extension MatrixTerm Scheme where supertype (MatrixTerm s _) = s -- | The type that indicates the type of media used to store the -- content. MimeType is used to determine the software -- product(s) that can read the content. MIME types are -- described in RFC 2046. data MimeType = MimeType Scheme MimeTypeAttributes deriving (Eq,Show) data MimeTypeAttributes = MimeTypeAttributes { mimeTypeAttrib_mimeTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType MimeType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "mimeTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ MimeType v (MimeTypeAttributes a0) schemaTypeToXML s (MimeType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "mimeTypeScheme") $ mimeTypeAttrib_mimeTypeScheme at ] $ schemaTypeToXML s bt instance Extension MimeType Scheme where supertype (MimeType s _) = s -- | A type defining a currency amount. data Money = Money { money_ID :: Maybe Xsd.ID , money_currency :: Currency -- ^ The currency in which an amount is denominated. , money_amount :: Xsd.Decimal -- ^ The monetary quantity in currency units. } deriving (Eq,Show) instance SchemaType Money where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Money a0) `apply` parseSchemaType "currency" `apply` parseSchemaType "amount" schemaTypeToXML s x@Money{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ money_ID x ] [ schemaTypeToXML "currency" $ money_currency x , schemaTypeToXML "amount" $ money_amount x ] instance Extension Money MoneyBase where supertype v = MoneyBase_Money v -- | Abstract base class for all money types. data MoneyBase = MoneyBase_PositiveMoney PositiveMoney | MoneyBase_NonNegativeMoney NonNegativeMoney | MoneyBase_Money Money deriving (Eq,Show) instance SchemaType MoneyBase where parseSchemaType s = do (fmap MoneyBase_PositiveMoney $ parseSchemaType s) `onFail` (fmap MoneyBase_NonNegativeMoney $ parseSchemaType s) `onFail` (fmap MoneyBase_Money $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of MoneyBase,\n\ \ namely one of:\n\ \PositiveMoney,NonNegativeMoney,Money" schemaTypeToXML _s (MoneyBase_PositiveMoney x) = schemaTypeToXML "positiveMoney" x schemaTypeToXML _s (MoneyBase_NonNegativeMoney x) = schemaTypeToXML "nonNegativeMoney" x schemaTypeToXML _s (MoneyBase_Money x) = schemaTypeToXML "money" x -- | A type defining multiple exercises. As defining in the 2000 -- ISDA Definitions, Section 12.4. Multiple Exercise, the -- buyer of the option has the right to exercise all or less -- than all the unexercised notional amount of the underlying -- swap on one or more days in the exercise period, but on any -- such day may not exercise less than the minimum notional -- amount or more than the maximum notional amount, and if an -- integral multiple amount is specified, the notional -- exercised must be equal to or, be an integral multiple of, -- the integral multiple amount. data MultipleExercise = MultipleExercise { multiExerc_notionalReference :: [NotionalReference] -- ^ A pointer style reference to the associated notional -- schedule defined elsewhere in the document. This element -- has been made optional as part of its integration in the -- OptionBaseExtended, because not required for the options on -- securities. , multiExerc_integralMultipleAmount :: Maybe Xsd.Decimal -- ^ A notional amount which restricts the amount of notional -- that can be exercised when partial exercise or multiple -- exercise is applicable. The integral multiple amount -- defines a lower limit of notional that can be exercised and -- also defines a unit multiple of notional that can be -- exercised, i.e. only integer multiples of this amount can -- be exercised. , multiExerc_choice2 :: (Maybe (OneOf2 Xsd.Decimal Xsd.NonNegativeInteger)) -- ^ Choice between: -- -- (1) The minimum notional amount that can be exercised on a -- given exercise date. See multipleExercise. -- -- (2) The minimum number of options that can be exercised on -- a given exercise date. , multiExerc_choice3 :: (Maybe (OneOf2 Xsd.Decimal NonNegativeDecimal)) -- ^ Choice between: -- -- (1) The maximum notional amount that can be exercised on a -- given exercise date. -- -- (2) The maximum number of options that can be exercised on -- a given exercise date. If the number is not specified, -- it means that the maximum number of options corresponds -- to the remaining unexercised options. } deriving (Eq,Show) instance SchemaType MultipleExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return MultipleExercise `apply` many (parseSchemaType "notionalReference") `apply` optional (parseSchemaType "integralMultipleAmount") `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "minimumNotionalAmount")) , ("Xsd.NonNegativeInteger", fmap TwoOf2 (parseSchemaType "minimumNumberOfOptions")) ]) `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "maximumNotionalAmount")) , ("NonNegativeDecimal", fmap TwoOf2 (parseSchemaType "maximumNumberOfOptions")) ]) schemaTypeToXML s x@MultipleExercise{} = toXMLElement s [] [ concatMap (schemaTypeToXML "notionalReference") $ multiExerc_notionalReference x , maybe [] (schemaTypeToXML "integralMultipleAmount") $ multiExerc_integralMultipleAmount x , maybe [] (foldOneOf2 (schemaTypeToXML "minimumNotionalAmount") (schemaTypeToXML "minimumNumberOfOptions") ) $ multiExerc_choice2 x , maybe [] (foldOneOf2 (schemaTypeToXML "maximumNotionalAmount") (schemaTypeToXML "maximumNumberOfOptions") ) $ multiExerc_choice3 x ] -- | A type defining a currency amount or a currency amount -- schedule. data NonNegativeAmountSchedule = NonNegativeAmountSchedule { nonNegatAmountSched_ID :: Maybe Xsd.ID , nonNegatAmountSched_initialValue :: NonNegativeDecimal -- ^ The non-negative initial rate or amount, as the case may -- be. An initial rate of 5% would be represented as 0.05. , nonNegatAmountSched_step :: [NonNegativeStep] -- ^ The schedule of step date and non-negative value pairs. On -- each step date the associated step value becomes effective. -- A list of steps may be ordered in the document by ascending -- step date. An FpML document containing an unordered list of -- steps is still regarded as a conformant document. , nonNegatAmountSched_currency :: Maybe Currency -- ^ The currency in which an amount is denominated. } deriving (Eq,Show) instance SchemaType NonNegativeAmountSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (NonNegativeAmountSchedule a0) `apply` parseSchemaType "initialValue" `apply` many (parseSchemaType "step") `apply` optional (parseSchemaType "currency") schemaTypeToXML s x@NonNegativeAmountSchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ nonNegatAmountSched_ID x ] [ schemaTypeToXML "initialValue" $ nonNegatAmountSched_initialValue x , concatMap (schemaTypeToXML "step") $ nonNegatAmountSched_step x , maybe [] (schemaTypeToXML "currency") $ nonNegatAmountSched_currency x ] instance Extension NonNegativeAmountSchedule NonNegativeSchedule where supertype (NonNegativeAmountSchedule a0 e0 e1 e2) = NonNegativeSchedule a0 e0 e1 -- | A type defining a non negative money amount. data NonNegativeMoney = NonNegativeMoney { nonNegatMoney_ID :: Maybe Xsd.ID , nonNegatMoney_currency :: Currency -- ^ The currency in which an amount is denominated. , nonNegatMoney_amount :: NonNegativeDecimal -- ^ The non negative monetary quantity in currency units. } deriving (Eq,Show) instance SchemaType NonNegativeMoney where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (NonNegativeMoney a0) `apply` parseSchemaType "currency" `apply` parseSchemaType "amount" schemaTypeToXML s x@NonNegativeMoney{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ nonNegatMoney_ID x ] [ schemaTypeToXML "currency" $ nonNegatMoney_currency x , schemaTypeToXML "amount" $ nonNegatMoney_amount x ] instance Extension NonNegativeMoney MoneyBase where supertype v = MoneyBase_NonNegativeMoney v -- | A complex type to specify non negative payments. data NonNegativePayment = NonNegativePayment { nonNegatPayment_ID :: Maybe Xsd.ID , nonNegatPayment_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , nonNegatPayment_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , nonNegatPayment_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , nonNegatPayment_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , nonNegatPayment_paymentDate :: Maybe AdjustableOrRelativeDate -- ^ The payment date, which can be expressed as either an -- adjustable or relative date. , nonNegatPayment_paymentAmount :: Maybe NonNegativeMoney -- ^ Non negative payment amount. } deriving (Eq,Show) instance SchemaType NonNegativePayment where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (NonNegativePayment 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") schemaTypeToXML s x@NonNegativePayment{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ nonNegatPayment_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ nonNegatPayment_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ nonNegatPayment_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ nonNegatPayment_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ nonNegatPayment_receiverAccountReference x , maybe [] (schemaTypeToXML "paymentDate") $ nonNegatPayment_paymentDate x , maybe [] (schemaTypeToXML "paymentAmount") $ nonNegatPayment_paymentAmount x ] instance Extension NonNegativePayment PaymentBaseExtended where supertype v = PaymentBaseExtended_NonNegativePayment v instance Extension NonNegativePayment PaymentBase where supertype = (supertype :: PaymentBaseExtended -> PaymentBase) . (supertype :: NonNegativePayment -> PaymentBaseExtended) -- | A type defining a schedule of non-negative rates or amounts -- in terms of an initial value and then a series of step date -- and value pairs. On each step date the rate or amount -- changes to the new step value. The series of step date and -- value pairs are optional. If not specified, this implies -- that the initial value remains unchanged over time. data NonNegativeSchedule = NonNegativeSchedule { nonNegatSched_ID :: Maybe Xsd.ID , nonNegatSched_initialValue :: NonNegativeDecimal -- ^ The non-negative initial rate or amount, as the case may -- be. An initial rate of 5% would be represented as 0.05. , nonNegatSched_step :: [NonNegativeStep] -- ^ The schedule of step date and non-negative value pairs. On -- each step date the associated step value becomes effective. -- A list of steps may be ordered in the document by ascending -- step date. An FpML document containing an unordered list of -- steps is still regarded as a conformant document. } deriving (Eq,Show) instance SchemaType NonNegativeSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (NonNegativeSchedule a0) `apply` parseSchemaType "initialValue" `apply` many (parseSchemaType "step") schemaTypeToXML s x@NonNegativeSchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ nonNegatSched_ID x ] [ schemaTypeToXML "initialValue" $ nonNegatSched_initialValue x , concatMap (schemaTypeToXML "step") $ nonNegatSched_step x ] -- | A type defining a step date and non-negative step value -- pair. This step definitions are used to define varying rate -- or amount schedules, e.g. a notional amortization or a -- step-up coupon schedule. data NonNegativeStep = NonNegativeStep { nonNegatStep_ID :: Maybe Xsd.ID , nonNegatStep_stepDate :: Maybe Xsd.Date -- ^ The date on which the associated stepValue becomes -- effective. This day may be subject to adjustment in -- accordance with a business day convention. , nonNegatStep_stepValue :: Maybe NonNegativeDecimal -- ^ The non-negative rate or amount which becomes effective on -- the associated stepDate. A rate of 5% would be represented -- as 0.05. } deriving (Eq,Show) instance SchemaType NonNegativeStep where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (NonNegativeStep a0) `apply` optional (parseSchemaType "stepDate") `apply` optional (parseSchemaType "stepValue") schemaTypeToXML s x@NonNegativeStep{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ nonNegatStep_ID x ] [ maybe [] (schemaTypeToXML "stepDate") $ nonNegatStep_stepDate x , maybe [] (schemaTypeToXML "stepValue") $ nonNegatStep_stepValue x ] instance Extension NonNegativeStep StepBase where supertype v = StepBase_NonNegativeStep v -- | A complex type to specify the notional amount. data NotionalAmount = NotionalAmount { notionAmount_ID :: Maybe Xsd.ID , notionAmount_currency :: Currency -- ^ The currency in which an amount is denominated. , notionAmount_amount :: NonNegativeDecimal -- ^ The non negative monetary quantity in currency units. } deriving (Eq,Show) instance SchemaType NotionalAmount where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (NotionalAmount a0) `apply` parseSchemaType "currency" `apply` parseSchemaType "amount" schemaTypeToXML s x@NotionalAmount{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ notionAmount_ID x ] [ schemaTypeToXML "currency" $ notionAmount_currency x , schemaTypeToXML "amount" $ notionAmount_amount x ] instance Extension NotionalAmount NonNegativeMoney where supertype (NotionalAmount a0 e0 e1) = NonNegativeMoney a0 e0 e1 instance Extension NotionalAmount MoneyBase where supertype = (supertype :: NonNegativeMoney -> MoneyBase) . (supertype :: NotionalAmount -> NonNegativeMoney) -- | A reference to the notional amount. data NotionalAmountReference = NotionalAmountReference { notionAmountRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType NotionalAmountReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (NotionalAmountReference a0) schemaTypeToXML s x@NotionalAmountReference{} = toXMLElement s [ toXMLAttribute "href" $ notionAmountRef_href x ] [] instance Extension NotionalAmountReference Reference where supertype v = Reference_NotionalAmountReference v -- | A reference to the notional amount. data NotionalReference = NotionalReference { notionRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType NotionalReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (NotionalReference a0) schemaTypeToXML s x@NotionalReference{} = toXMLElement s [ toXMLAttribute "href" $ notionRef_href x ] [] instance Extension NotionalReference Reference where supertype v = Reference_NotionalReference v -- | A type defining an offset used in calculating a new date -- relative to a reference date. Currently, the only offsets -- defined are expected to be expressed as either calendar or -- business day offsets. data Offset = Offset { offset_ID :: Maybe Xsd.ID , offset_periodMultiplier :: Xsd.Integer -- ^ A time period multiplier, e.g. 1, 2 or 3 etc. A negative -- value can be used when specifying an offset relative to -- another date, e.g. -2 days. , offset_period :: PeriodEnum -- ^ A time period, e.g. a day, week, month or year of the -- stream. If the periodMultiplier value is 0 (zero) then -- period must contain the value D (day). , offset_dayType :: Maybe DayTypeEnum -- ^ In the case of an offset specified as a number of days, -- this element defines whether consideration is given as to -- whether a day is a good business day or not. If a day type -- of business days is specified then non-business days are -- ignored when calculating the offset. The financial business -- centers to use for determination of business days are -- implied by the context in which this element is used. This -- element must only be included when the offset is specified -- as a number of days. If the offset is zero days then the -- dayType element should not be included. } deriving (Eq,Show) instance SchemaType Offset where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Offset a0) `apply` parseSchemaType "periodMultiplier" `apply` parseSchemaType "period" `apply` optional (parseSchemaType "dayType") schemaTypeToXML s x@Offset{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ offset_ID x ] [ schemaTypeToXML "periodMultiplier" $ offset_periodMultiplier x , schemaTypeToXML "period" $ offset_period x , maybe [] (schemaTypeToXML "dayType") $ offset_dayType x ] instance Extension Offset Period where supertype (Offset a0 e0 e1 e2) = Period a0 e0 e1 -- | Allows the specification of a time that may be on a day -- prior or subsequent to the day in question. This type is -- intended for use with a day of the week (i.e. where no -- actual date is specified) as part of, for example, a period -- that runs from 23:00-07:00 on a series of days and where -- holidays on the actual days would affect the entire time -- period. data OffsetPrevailingTime = OffsetPrevailingTime { offsetPrevaTime_time :: Maybe PrevailingTime , offsetPrevaTime_offset :: Maybe Offset -- ^ Indicates whether time applies to the actual day specified -- (in which case this element should be omitted) the day -- prior to that day (in which case periodMultiplier should be -- -1 and period should be Day) or the day subsequent to that -- day (in which case periodMultiplier should be 1 and period -- should be Day). } deriving (Eq,Show) instance SchemaType OffsetPrevailingTime where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return OffsetPrevailingTime `apply` optional (parseSchemaType "time") `apply` optional (parseSchemaType "offset") schemaTypeToXML s x@OffsetPrevailingTime{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "time") $ offsetPrevaTime_time x , maybe [] (schemaTypeToXML "offset") $ offsetPrevaTime_offset x ] data OnBehalfOf = OnBehalfOf { onBehalfOf_partyReference :: Maybe PartyReference -- ^ The party for which the message reciever should work. , onBehalfOf_accountReference :: [AccountReference] -- ^ Identifies the account(s) related to the party when they -- can be determined from the party alone, for example in a -- inter-book trade. } deriving (Eq,Show) instance SchemaType OnBehalfOf where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return OnBehalfOf `apply` optional (parseSchemaType "partyReference") `apply` many (parseSchemaType "accountReference") schemaTypeToXML s x@OnBehalfOf{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "partyReference") $ onBehalfOf_partyReference x , concatMap (schemaTypeToXML "accountReference") $ onBehalfOf_accountReference x ] data OriginatingEvent = OriginatingEvent Scheme OriginatingEventAttributes deriving (Eq,Show) data OriginatingEventAttributes = OriginatingEventAttributes { originEventAttrib_originatingEventScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType OriginatingEvent where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "originatingEventScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ OriginatingEvent v (OriginatingEventAttributes a0) schemaTypeToXML s (OriginatingEvent bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "originatingEventScheme") $ originEventAttrib_originatingEventScheme at ] $ schemaTypeToXML s bt instance Extension OriginatingEvent Scheme where supertype (OriginatingEvent s _) = s -- | A type defining partial exercise. As defined in the 2000 -- ISDA Definitions, Section 12.3 Partial Exercise, the buyer -- of the option may exercise all or less than all the -- notional amount of the underlying swap but may not be less -- than the minimum notional amount (if specified) and must be -- an integral multiple of the integral multiple amount if -- specified. data PartialExercise = PartialExercise { partialExerc_notionalReference :: [NotionalReference] -- ^ A pointer style reference to the associated notional -- schedule defined elsewhere in the document. This element -- has been made optional as part of its integration in the -- OptionBaseExtended, because not required for the options on -- securities. , partialExerc_integralMultipleAmount :: Maybe Xsd.Decimal -- ^ A notional amount which restricts the amount of notional -- that can be exercised when partial exercise or multiple -- exercise is applicable. The integral multiple amount -- defines a lower limit of notional that can be exercised and -- also defines a unit multiple of notional that can be -- exercised, i.e. only integer multiples of this amount can -- be exercised. , partialExerc_choice2 :: (Maybe (OneOf2 Xsd.Decimal Xsd.NonNegativeInteger)) -- ^ Choice between: -- -- (1) The minimum notional amount that can be exercised on a -- given exercise date. See multipleExercise. -- -- (2) The minimum number of options that can be exercised on -- a given exercise date. } deriving (Eq,Show) instance SchemaType PartialExercise where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PartialExercise `apply` many (parseSchemaType "notionalReference") `apply` optional (parseSchemaType "integralMultipleAmount") `apply` optional (oneOf' [ ("Xsd.Decimal", fmap OneOf2 (parseSchemaType "minimumNotionalAmount")) , ("Xsd.NonNegativeInteger", fmap TwoOf2 (parseSchemaType "minimumNumberOfOptions")) ]) schemaTypeToXML s x@PartialExercise{} = toXMLElement s [] [ concatMap (schemaTypeToXML "notionalReference") $ partialExerc_notionalReference x , maybe [] (schemaTypeToXML "integralMultipleAmount") $ partialExerc_integralMultipleAmount x , maybe [] (foldOneOf2 (schemaTypeToXML "minimumNotionalAmount") (schemaTypeToXML "minimumNumberOfOptions") ) $ partialExerc_choice2 x ] data Party = Party { party_ID :: Xsd.ID -- ^ The id uniquely identifying the Party within the document. , party_id :: [PartyId] -- ^ A party identifier, e.g. a S.W.I.F.T. bank identifier code -- (BIC). , party_name :: Maybe PartyName -- ^ The legal name of the organization. A free format string. -- FpML does not define usage rules for this element. , party_classification :: [IndustryClassification] -- ^ The party's industry sector classification. , party_creditRating :: [CreditRating] -- ^ The party's credit rating. , party_country :: Maybe CountryCode -- ^ The country where the party is domiciled. , party_jurisdiction :: [GoverningLaw] -- ^ The legal jurisdiction of the entity's registration. , party_organizationType :: Maybe OrganizationType -- ^ The country where the party is domiciled. , party_contactInfo :: Maybe ContactInformation -- ^ Information on how to contact the party using various -- means. , party_businessUnit :: [BusinessUnit] -- ^ Optional organization unit information used to describe the -- organization units (e.g. trading desks) involved in a -- transaction or business process . , party_person :: [Person] -- ^ Optional information about people involved in a transaction -- or busines process. (These are eomployees of the party). } deriving (Eq,Show) instance SchemaType Party where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "id" e pos commit $ interior e $ return (Party a0) `apply` many (parseSchemaType "partyId") `apply` optional (parseSchemaType "partyName") `apply` many (parseSchemaType "classification") `apply` many (parseSchemaType "creditRating") `apply` optional (parseSchemaType "country") `apply` many (parseSchemaType "jurisdiction") `apply` optional (parseSchemaType "organizationType") `apply` optional (parseSchemaType "contactInfo") `apply` many (parseSchemaType "businessUnit") `apply` many (parseSchemaType "person") schemaTypeToXML s x@Party{} = toXMLElement s [ toXMLAttribute "id" $ party_ID x ] [ concatMap (schemaTypeToXML "partyId") $ party_id x , maybe [] (schemaTypeToXML "partyName") $ party_name x , concatMap (schemaTypeToXML "classification") $ party_classification x , concatMap (schemaTypeToXML "creditRating") $ party_creditRating x , maybe [] (schemaTypeToXML "country") $ party_country x , concatMap (schemaTypeToXML "jurisdiction") $ party_jurisdiction x , maybe [] (schemaTypeToXML "organizationType") $ party_organizationType x , maybe [] (schemaTypeToXML "contactInfo") $ party_contactInfo x , concatMap (schemaTypeToXML "businessUnit") $ party_businessUnit x , concatMap (schemaTypeToXML "person") $ party_person x ] -- | The data type used for party identifiers. data PartyId = PartyId Scheme PartyIdAttributes deriving (Eq,Show) data PartyIdAttributes = PartyIdAttributes { partyIdAttrib_partyIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType PartyId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "partyIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ PartyId v (PartyIdAttributes a0) schemaTypeToXML s (PartyId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "partyIdScheme") $ partyIdAttrib_partyIdScheme at ] $ schemaTypeToXML s bt instance Extension PartyId Scheme where supertype (PartyId s _) = s -- | The data type used for the legal name of an organization. data PartyName = PartyName Scheme PartyNameAttributes deriving (Eq,Show) data PartyNameAttributes = PartyNameAttributes { partyNameAttrib_partyNameScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType PartyName where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "partyNameScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ PartyName v (PartyNameAttributes a0) schemaTypeToXML s (PartyName bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "partyNameScheme") $ partyNameAttrib_partyNameScheme at ] $ schemaTypeToXML s bt instance Extension PartyName Scheme where supertype (PartyName s _) = s -- | Reference to a party. data PartyReference = PartyReference { partyRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType PartyReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (PartyReference a0) schemaTypeToXML s x@PartyReference{} = toXMLElement s [ toXMLAttribute "href" $ partyRef_href x ] [] instance Extension PartyReference Reference where supertype v = Reference_PartyReference v data PartyRelationship = PartyRelationship { partyRelat_partyReference :: PartyReference -- ^ Reference to a party. , partyRelat_accountReference :: Maybe AccountReference -- ^ Reference to an account. , partyRelat_role :: Maybe PartyRole -- ^ The category of the relationship. The related party -- performs the role specified in this field for the base -- party. For example, if the role is "Guarantor", the related -- party acts as a guarantor for the base party. , partyRelat_type :: Maybe PartyRoleType -- ^ Additional definition refining the type of relationship. -- For example, if the "role" is Guarantor, this element may -- be used to specify whether all positions are guaranteed, or -- only a subset of them. , partyRelat_effectiveDate :: Maybe Xsd.Date -- ^ The date on which the relationship begins or began. , partyRelat_terminationDate :: Maybe Xsd.Date -- ^ The date on which the relationship ends or ended. , partyRelat_documentation :: Maybe PartyRelationshipDocumentation -- ^ Describes the agreements that define the party -- relationship. } deriving (Eq,Show) instance SchemaType PartyRelationship where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PartyRelationship `apply` parseSchemaType "partyReference" `apply` optional (parseSchemaType "accountReference") `apply` optional (parseSchemaType "role") `apply` optional (parseSchemaType "type") `apply` optional (parseSchemaType "effectiveDate") `apply` optional (parseSchemaType "terminationDate") `apply` optional (parseSchemaType "documentation") schemaTypeToXML s x@PartyRelationship{} = toXMLElement s [] [ schemaTypeToXML "partyReference" $ partyRelat_partyReference x , maybe [] (schemaTypeToXML "accountReference") $ partyRelat_accountReference x , maybe [] (schemaTypeToXML "role") $ partyRelat_role x , maybe [] (schemaTypeToXML "type") $ partyRelat_type x , maybe [] (schemaTypeToXML "effectiveDate") $ partyRelat_effectiveDate x , maybe [] (schemaTypeToXML "terminationDate") $ partyRelat_terminationDate x , maybe [] (schemaTypeToXML "documentation") $ partyRelat_documentation x ] -- | A description of the legal agreement(s) and definitions -- that document a party's relationships with other parties data PartyRelationshipDocumentation = PartyRelationshipDocumentation { partyRelatDocum_choice0 :: [OneOf3 MasterAgreement CreditSupportAgreement GenericAgreement] -- ^ Choice between: -- -- (1) A agreement executed between two parties that includes -- or references the related party. -- -- (2) An agreement executed between two parties intended to -- govern collateral arrangement for OTC derivatives -- transactions between those parties, and that references -- the related party. -- -- (3) An agrement that references the related party. } deriving (Eq,Show) instance SchemaType PartyRelationshipDocumentation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PartyRelationshipDocumentation `apply` many (oneOf' [ ("MasterAgreement", fmap OneOf3 (parseSchemaType "masterAgreement")) , ("CreditSupportAgreement", fmap TwoOf3 (parseSchemaType "creditSupportAgreement")) , ("GenericAgreement", fmap ThreeOf3 (parseSchemaType "agreement")) ]) schemaTypeToXML s x@PartyRelationshipDocumentation{} = toXMLElement s [] [ concatMap (foldOneOf3 (schemaTypeToXML "masterAgreement") (schemaTypeToXML "creditSupportAgreement") (schemaTypeToXML "agreement") ) $ partyRelatDocum_choice0 x ] -- | A type describing a role played by a party in one or more -- transactions. Examples include roles such as guarantor, -- custodian, confirmation service provider, etc. This can be -- extended to provide custom roles. data PartyRole = PartyRole Scheme PartyRoleAttributes deriving (Eq,Show) data PartyRoleAttributes = PartyRoleAttributes { partyRoleAttrib_partyRoleScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType PartyRole where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "partyRoleScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ PartyRole v (PartyRoleAttributes a0) schemaTypeToXML s (PartyRole bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "partyRoleScheme") $ partyRoleAttrib_partyRoleScheme at ] $ schemaTypeToXML s bt instance Extension PartyRole Scheme where supertype (PartyRole s _) = s -- | A type refining the role a role played by a party in one or -- more transactions. Examples include "AllPositions" and -- "SomePositions" for Guarantor. This can be extended to -- provide custom types. data PartyRoleType = PartyRoleType Scheme PartyRoleTypeAttributes deriving (Eq,Show) data PartyRoleTypeAttributes = PartyRoleTypeAttributes { partyRoleTypeAttrib_partyRoleTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType PartyRoleType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "partyRoleTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ PartyRoleType v (PartyRoleTypeAttributes a0) schemaTypeToXML s (PartyRoleType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "partyRoleTypeScheme") $ partyRoleTypeAttrib_partyRoleTypeScheme at ] $ schemaTypeToXML s bt instance Extension PartyRoleType Scheme where supertype (PartyRoleType s _) = s -- | Reference to an organizational unit. data BusinessUnitReference = BusinessUnitReference { busUnitRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType BusinessUnitReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (BusinessUnitReference a0) schemaTypeToXML s x@BusinessUnitReference{} = toXMLElement s [ toXMLAttribute "href" $ busUnitRef_href x ] [] instance Extension BusinessUnitReference Reference where supertype v = Reference_BusinessUnitReference v -- | Reference to an individual. data PersonReference = PersonReference { personRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType PersonReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (PersonReference a0) schemaTypeToXML s x@PersonReference{} = toXMLElement s [ toXMLAttribute "href" $ personRef_href x ] [] instance Extension PersonReference Reference where supertype v = Reference_PersonReference v -- | A reference to a partyTradeIdentifier object. data PartyTradeIdentifierReference = PartyTradeIdentifierReference { partyTradeIdentRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType PartyTradeIdentifierReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (PartyTradeIdentifierReference a0) schemaTypeToXML s x@PartyTradeIdentifierReference{} = toXMLElement s [ toXMLAttribute "href" $ partyTradeIdentRef_href x ] [] instance Extension PartyTradeIdentifierReference Reference where supertype v = Reference_PartyTradeIdentifierReference v -- | A type for defining payments data Payment = Payment { payment_ID :: Maybe Xsd.ID , payment_href :: Maybe Xsd.IDREF -- ^ Can be used to reference the yield curve used to estimate -- the discount factor , payment_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , payment_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , payment_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , payment_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , payment_amount :: NonNegativeMoney -- ^ The currency amount of the payment. , payment_date :: Maybe AdjustableOrAdjustedDate -- ^ The payment date. This date is subject to adjustment in -- accordance with any applicable business day convention. , payment_type :: Maybe PaymentType -- ^ A classification of the type of fee or additional payment, -- e.g. brokerage, upfront fee etc. FpML does not define -- domain values for this element. , payment_settlementInformation :: Maybe SettlementInformation -- ^ The information required to settle a currency payment that -- results from a trade. , payment_discountFactor :: Maybe Xsd.Decimal -- ^ The value representing the discount factor used to -- calculate the present value of the cash flow. , payment_presentValueAmount :: Maybe Money -- ^ The amount representing the present value of the forecast -- payment. } deriving (Eq,Show) instance SchemaType Payment where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos a1 <- optional $ getAttribute "href" e pos commit $ interior e $ return (Payment a0 a1) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` parseSchemaType "paymentAmount" `apply` optional (parseSchemaType "paymentDate") `apply` optional (parseSchemaType "paymentType") `apply` optional (parseSchemaType "settlementInformation") `apply` optional (parseSchemaType "discountFactor") `apply` optional (parseSchemaType "presentValueAmount") schemaTypeToXML s x@Payment{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ payment_ID x , maybe [] (toXMLAttribute "href") $ payment_href x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ payment_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ payment_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ payment_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ payment_receiverAccountReference x , schemaTypeToXML "paymentAmount" $ payment_amount x , maybe [] (schemaTypeToXML "paymentDate") $ payment_date x , maybe [] (schemaTypeToXML "paymentType") $ payment_type x , maybe [] (schemaTypeToXML "settlementInformation") $ payment_settlementInformation x , maybe [] (schemaTypeToXML "discountFactor") $ payment_discountFactor x , maybe [] (schemaTypeToXML "presentValueAmount") $ payment_presentValueAmount x ] instance Extension Payment PaymentBase where supertype v = PaymentBase_Payment v -- | An abstract base class for payment types. data PaymentBase = PaymentBase_SimplePayment SimplePayment | PaymentBase_PaymentBaseExtended PaymentBaseExtended | PaymentBase_Payment Payment | PaymentBase_PendingPayment PendingPayment | PaymentBase_FeaturePayment FeaturePayment | PaymentBase_PaymentCalculationPeriod PaymentCalculationPeriod | PaymentBase_ReturnSwapAdditionalPayment ReturnSwapAdditionalPayment | PaymentBase_EquityPremium EquityPremium | PaymentBase_PaymentDetail PaymentDetail | PaymentBase_FixedPaymentAmount FixedPaymentAmount | PaymentBase_SinglePayment SinglePayment | PaymentBase_PeriodicPayment PeriodicPayment | PaymentBase_InitialPayment InitialPayment | PaymentBase_PrePayment PrePayment deriving (Eq,Show) instance SchemaType PaymentBase where parseSchemaType s = do (fmap PaymentBase_SimplePayment $ parseSchemaType s) `onFail` (fmap PaymentBase_PaymentBaseExtended $ parseSchemaType s) `onFail` (fmap PaymentBase_Payment $ parseSchemaType s) `onFail` (fmap PaymentBase_PendingPayment $ parseSchemaType s) `onFail` (fmap PaymentBase_FeaturePayment $ parseSchemaType s) `onFail` (fmap PaymentBase_PaymentCalculationPeriod $ parseSchemaType s) `onFail` (fmap PaymentBase_ReturnSwapAdditionalPayment $ parseSchemaType s) `onFail` (fmap PaymentBase_EquityPremium $ parseSchemaType s) `onFail` (fmap PaymentBase_PaymentDetail $ parseSchemaType s) `onFail` (fmap PaymentBase_FixedPaymentAmount $ parseSchemaType s) `onFail` (fmap PaymentBase_SinglePayment $ parseSchemaType s) `onFail` (fmap PaymentBase_PeriodicPayment $ parseSchemaType s) `onFail` (fmap PaymentBase_InitialPayment $ parseSchemaType s) `onFail` (fmap PaymentBase_PrePayment $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of PaymentBase,\n\ \ namely one of:\n\ \SimplePayment,PaymentBaseExtended,Payment,PendingPayment,FeaturePayment,PaymentCalculationPeriod,ReturnSwapAdditionalPayment,EquityPremium,PaymentDetail,FixedPaymentAmount,SinglePayment,PeriodicPayment,InitialPayment,PrePayment" schemaTypeToXML _s (PaymentBase_SimplePayment x) = schemaTypeToXML "simplePayment" x schemaTypeToXML _s (PaymentBase_PaymentBaseExtended x) = schemaTypeToXML "paymentBaseExtended" x schemaTypeToXML _s (PaymentBase_Payment x) = schemaTypeToXML "payment" x schemaTypeToXML _s (PaymentBase_PendingPayment x) = schemaTypeToXML "pendingPayment" x schemaTypeToXML _s (PaymentBase_FeaturePayment x) = schemaTypeToXML "featurePayment" x schemaTypeToXML _s (PaymentBase_PaymentCalculationPeriod x) = schemaTypeToXML "paymentCalculationPeriod" x schemaTypeToXML _s (PaymentBase_ReturnSwapAdditionalPayment x) = schemaTypeToXML "returnSwapAdditionalPayment" x schemaTypeToXML _s (PaymentBase_EquityPremium x) = schemaTypeToXML "equityPremium" x schemaTypeToXML _s (PaymentBase_PaymentDetail x) = schemaTypeToXML "paymentDetail" x schemaTypeToXML _s (PaymentBase_FixedPaymentAmount x) = schemaTypeToXML "fixedPaymentAmount" x schemaTypeToXML _s (PaymentBase_SinglePayment x) = schemaTypeToXML "singlePayment" x schemaTypeToXML _s (PaymentBase_PeriodicPayment x) = schemaTypeToXML "periodicPayment" x schemaTypeToXML _s (PaymentBase_InitialPayment x) = schemaTypeToXML "initialPayment" x schemaTypeToXML _s (PaymentBase_PrePayment x) = schemaTypeToXML "prePayment" x -- | Base type for payments. data PaymentBaseExtended = PaymentBaseExtended_PositivePayment PositivePayment | PaymentBaseExtended_NonNegativePayment NonNegativePayment deriving (Eq,Show) instance SchemaType PaymentBaseExtended where parseSchemaType s = do (fmap PaymentBaseExtended_PositivePayment $ parseSchemaType s) `onFail` (fmap PaymentBaseExtended_NonNegativePayment $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of PaymentBaseExtended,\n\ \ namely one of:\n\ \PositivePayment,NonNegativePayment" schemaTypeToXML _s (PaymentBaseExtended_PositivePayment x) = schemaTypeToXML "positivePayment" x schemaTypeToXML _s (PaymentBaseExtended_NonNegativePayment x) = schemaTypeToXML "nonNegativePayment" x instance Extension PaymentBaseExtended PaymentBase where supertype v = PaymentBase_PaymentBaseExtended v -- | Details on the referenced payment. e.g. Its cashflow -- components, settlement details. data PaymentDetails = PaymentDetails { paymentDetails_paymentReference :: Maybe PaymentReference -- ^ The reference to the identified payment strucutre. , paymentDetails_grossCashflow :: [GrossCashflow] -- ^ Payment details of this cash flow component, including -- currency, amount and payer/payee. , paymentDetails_settlementInformation :: Maybe SettlementInformation -- ^ The information required to settle a currency payment. } deriving (Eq,Show) instance SchemaType PaymentDetails where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PaymentDetails `apply` optional (parseSchemaType "paymentReference") `apply` many (parseSchemaType "grossCashflow") `apply` optional (parseSchemaType "settlementInformation") schemaTypeToXML s x@PaymentDetails{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "paymentReference") $ paymentDetails_paymentReference x , concatMap (schemaTypeToXML "grossCashflow") $ paymentDetails_grossCashflow x , maybe [] (schemaTypeToXML "settlementInformation") $ paymentDetails_settlementInformation x ] -- | An identifier used to identify a matchable payment. data PaymentId = PaymentId Scheme PaymentIdAttributes deriving (Eq,Show) data PaymentIdAttributes = PaymentIdAttributes { paymentIdAttrib_paymentIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType PaymentId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "paymentIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ PaymentId v (PaymentIdAttributes a0) schemaTypeToXML s (PaymentId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "paymentIdScheme") $ paymentIdAttrib_paymentIdScheme at ] $ schemaTypeToXML s bt instance Extension PaymentId Scheme where supertype (PaymentId s _) = s -- | Reference to a payment. data PaymentReference = PaymentReference { paymentRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType PaymentReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (PaymentReference a0) schemaTypeToXML s x@PaymentReference{} = toXMLElement s [ toXMLAttribute "href" $ paymentRef_href x ] [] instance Extension PaymentReference Reference where supertype v = Reference_PaymentReference v data PaymentType = PaymentType Scheme PaymentTypeAttributes deriving (Eq,Show) data PaymentTypeAttributes = PaymentTypeAttributes { paymentTypeAttrib_paymentTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType PaymentType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "paymentTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ PaymentType v (PaymentTypeAttributes a0) schemaTypeToXML s (PaymentType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "paymentTypeScheme") $ paymentTypeAttrib_paymentTypeScheme at ] $ schemaTypeToXML s bt instance Extension PaymentType Scheme where supertype (PaymentType s _) = s -- | A type to define recurring periods or time offsets. data Period = Period { period_ID :: Maybe Xsd.ID , period_multiplier :: Xsd.Integer -- ^ A time period multiplier, e.g. 1, 2 or 3 etc. A negative -- value can be used when specifying an offset relative to -- another date, e.g. -2 days. , period :: PeriodEnum -- ^ A time period, e.g. a day, week, month or year of the -- stream. If the periodMultiplier value is 0 (zero) then -- period must contain the value D (day). } deriving (Eq,Show) instance SchemaType Period where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Period a0) `apply` parseSchemaType "periodMultiplier" `apply` parseSchemaType "period" schemaTypeToXML s x@Period{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ period_ID x ] [ schemaTypeToXML "periodMultiplier" $ period_multiplier x , schemaTypeToXML "period" $ period x ] data PeriodicDates = PeriodicDates { periodDates_calculationStartDate :: Maybe AdjustableOrRelativeDate , periodDates_calculationEndDate :: Maybe AdjustableOrRelativeDate , periodDates_calculationPeriodFrequency :: Maybe CalculationPeriodFrequency -- ^ The frequency at which calculation period end dates occur -- with the regular part of the calculation period schedule -- and their roll date convention. , periodDates_calculationPeriodDatesAdjustments :: Maybe BusinessDayAdjustments -- ^ The business day convention to apply to each calculation -- period end date if it would otherwise fall on a day that is -- not a business day in the specified financial business -- centers. } deriving (Eq,Show) instance SchemaType PeriodicDates where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PeriodicDates `apply` optional (parseSchemaType "calculationStartDate") `apply` optional (parseSchemaType "calculationEndDate") `apply` optional (parseSchemaType "calculationPeriodFrequency") `apply` optional (parseSchemaType "calculationPeriodDatesAdjustments") schemaTypeToXML s x@PeriodicDates{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "calculationStartDate") $ periodDates_calculationStartDate x , maybe [] (schemaTypeToXML "calculationEndDate") $ periodDates_calculationEndDate x , maybe [] (schemaTypeToXML "calculationPeriodFrequency") $ periodDates_calculationPeriodFrequency x , maybe [] (schemaTypeToXML "calculationPeriodDatesAdjustments") $ periodDates_calculationPeriodDatesAdjustments x ] -- | A type defining a currency amount or a currency amount -- schedule. data PositiveAmountSchedule = PositiveAmountSchedule { positAmountSched_ID :: Maybe Xsd.ID , positAmountSched_initialValue :: PositiveDecimal -- ^ The strictly-positive initial rate or amount, as the case -- may be. An initial rate of 5% would be represented as 0.05. , positAmountSched_step :: [PositiveStep] -- ^ The schedule of step date and strictly-positive value -- pairs. On each step date the associated step value becomes -- effective. A list of steps may be ordered in the document -- by ascending step date. An FpML document containing an -- unordered list of steps is still regarded as a conformant -- document. , positAmountSched_currency :: Maybe Currency -- ^ The currency in which an amount is denominated. } deriving (Eq,Show) instance SchemaType PositiveAmountSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (PositiveAmountSchedule a0) `apply` parseSchemaType "initialValue" `apply` many (parseSchemaType "step") `apply` optional (parseSchemaType "currency") schemaTypeToXML s x@PositiveAmountSchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ positAmountSched_ID x ] [ schemaTypeToXML "initialValue" $ positAmountSched_initialValue x , concatMap (schemaTypeToXML "step") $ positAmountSched_step x , maybe [] (schemaTypeToXML "currency") $ positAmountSched_currency x ] instance Extension PositiveAmountSchedule PositiveSchedule where supertype (PositiveAmountSchedule a0 e0 e1 e2) = PositiveSchedule a0 e0 e1 -- | A type defining a positive money amount data PositiveMoney = PositiveMoney { positMoney_ID :: Maybe Xsd.ID , positMoney_currency :: Currency -- ^ The currency in which an amount is denominated. , positMoney_amount :: Maybe PositiveDecimal -- ^ The positive monetary quantity in currency units. } deriving (Eq,Show) instance SchemaType PositiveMoney where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (PositiveMoney a0) `apply` parseSchemaType "currency" `apply` optional (parseSchemaType "amount") schemaTypeToXML s x@PositiveMoney{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ positMoney_ID x ] [ schemaTypeToXML "currency" $ positMoney_currency x , maybe [] (schemaTypeToXML "amount") $ positMoney_amount x ] instance Extension PositiveMoney MoneyBase where supertype v = MoneyBase_PositiveMoney v -- | A complex type to specify positive payments. data PositivePayment = PositivePayment { positPayment_ID :: Maybe Xsd.ID , positPayment_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , positPayment_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , positPayment_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , positPayment_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , positPayment_paymentDate :: Maybe AdjustableOrRelativeDate -- ^ The payment date, which can be expressed as either an -- adjustable or relative date. , positPayment_paymentAmount :: Maybe PositiveMoney -- ^ Positive payment amount. } deriving (Eq,Show) instance SchemaType PositivePayment where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (PositivePayment 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") schemaTypeToXML s x@PositivePayment{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ positPayment_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ positPayment_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ positPayment_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ positPayment_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ positPayment_receiverAccountReference x , maybe [] (schemaTypeToXML "paymentDate") $ positPayment_paymentDate x , maybe [] (schemaTypeToXML "paymentAmount") $ positPayment_paymentAmount x ] instance Extension PositivePayment PaymentBaseExtended where supertype v = PaymentBaseExtended_PositivePayment v instance Extension PositivePayment PaymentBase where supertype = (supertype :: PaymentBaseExtended -> PaymentBase) . (supertype :: PositivePayment -> PaymentBaseExtended) -- | A type defining a schedule of strictly-postive rates or -- amounts in terms of an initial value and then a series of -- step date and value pairs. On each step date the rate or -- amount changes to the new step value. The series of step -- date and value pairs are optional. If not specified, this -- implies that the initial value remains unchanged over time. data PositiveSchedule = PositiveSchedule { positSched_ID :: Maybe Xsd.ID , positSched_initialValue :: PositiveDecimal -- ^ The strictly-positive initial rate or amount, as the case -- may be. An initial rate of 5% would be represented as 0.05. , positSched_step :: [PositiveStep] -- ^ The schedule of step date and strictly-positive value -- pairs. On each step date the associated step value becomes -- effective. A list of steps may be ordered in the document -- by ascending step date. An FpML document containing an -- unordered list of steps is still regarded as a conformant -- document. } deriving (Eq,Show) instance SchemaType PositiveSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (PositiveSchedule a0) `apply` parseSchemaType "initialValue" `apply` many (parseSchemaType "step") schemaTypeToXML s x@PositiveSchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ positSched_ID x ] [ schemaTypeToXML "initialValue" $ positSched_initialValue x , concatMap (schemaTypeToXML "step") $ positSched_step x ] -- | A type defining a step date and strictly-positive step -- value pair. This step definitions are used to define -- varying rate or amount schedules, e.g. a notional -- amortization or a step-up coupon schedule. data PositiveStep = PositiveStep { positiveStep_ID :: Maybe Xsd.ID , positiveStep_stepDate :: Maybe Xsd.Date -- ^ The date on which the associated stepValue becomes -- effective. This day may be subject to adjustment in -- accordance with a business day convention. , positiveStep_stepValue :: Maybe PositiveDecimal -- ^ The strictly positive rate or amount which becomes -- effective on the associated stepDate. A rate of 5% would be -- represented as 0.05. } deriving (Eq,Show) instance SchemaType PositiveStep where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (PositiveStep a0) `apply` optional (parseSchemaType "stepDate") `apply` optional (parseSchemaType "stepValue") schemaTypeToXML s x@PositiveStep{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ positiveStep_ID x ] [ maybe [] (schemaTypeToXML "stepDate") $ positiveStep_stepDate x , maybe [] (schemaTypeToXML "stepValue") $ positiveStep_stepValue x ] instance Extension PositiveStep StepBase where supertype v = StepBase_PositiveStep v -- | A type for defining a time with respect to a geographic -- location, for example 11:00 Phoenix, USA. This type should -- be used where a wider range of locations than those -- available as business centres is required. data PrevailingTime = PrevailingTime { prevaTime_hourMinuteTime :: Maybe HourMinuteTime -- ^ A time specified in hh:mm:ss format where the second -- component must be '00', e.g. 11am would be represented as -- 11:00:00. , prevaTime_location :: Maybe TimezoneLocation -- ^ The geographic location to which the hourMinuteTime -- applies. The time takes into account any current day light -- saving changes or other adjustments i.e. it is the -- prevaling time at the location. } deriving (Eq,Show) instance SchemaType PrevailingTime where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return PrevailingTime `apply` optional (parseSchemaType "hourMinuteTime") `apply` optional (parseSchemaType "location") schemaTypeToXML s x@PrevailingTime{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "hourMinuteTime") $ prevaTime_hourMinuteTime x , maybe [] (schemaTypeToXML "location") $ prevaTime_location x ] -- | An abstract pricing structure base type. Used as a base for -- structures such as yield curves and volatility matrices. data PricingStructure = PricingStructure_YieldCurve YieldCurve | PricingStructure_VolatilityRepresentation VolatilityRepresentation | PricingStructure_FxCurve FxCurve | PricingStructure_CreditCurve CreditCurve deriving (Eq,Show) instance SchemaType PricingStructure where parseSchemaType s = do (fmap PricingStructure_YieldCurve $ parseSchemaType s) `onFail` (fmap PricingStructure_VolatilityRepresentation $ parseSchemaType s) `onFail` (fmap PricingStructure_FxCurve $ parseSchemaType s) `onFail` (fmap PricingStructure_CreditCurve $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of PricingStructure,\n\ \ namely one of:\n\ \YieldCurve,VolatilityRepresentation,FxCurve,CreditCurve" schemaTypeToXML _s (PricingStructure_YieldCurve x) = schemaTypeToXML "yieldCurve" x schemaTypeToXML _s (PricingStructure_VolatilityRepresentation x) = schemaTypeToXML "volatilityRepresentation" x schemaTypeToXML _s (PricingStructure_FxCurve x) = schemaTypeToXML "fxCurve" x schemaTypeToXML _s (PricingStructure_CreditCurve x) = schemaTypeToXML "creditCurve" x -- | Reference to a pricing structure or any derived components -- (i.e. yield curve). data PricingStructureReference = PricingStructureReference { pricingStructRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType PricingStructureReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (PricingStructureReference a0) schemaTypeToXML s x@PricingStructureReference{} = toXMLElement s [ toXMLAttribute "href" $ pricingStructRef_href x ] [] instance Extension PricingStructureReference Reference where supertype v = Reference_PricingStructureReference v -- | A type defining which principal exchanges occur for the -- stream. data PrincipalExchanges = PrincipalExchanges { princExchan_ID :: Maybe Xsd.ID , princExchan_initialExchange :: Maybe Xsd.Boolean -- ^ A true/false flag to indicate whether there is an initial -- exchange of principal on the effective date. , princExchan_finalExchange :: Maybe Xsd.Boolean -- ^ A true/false flag to indicate whether there is a final -- exchange of principal on the termination date. , princExchan_intermediateExchange :: Maybe Xsd.Boolean -- ^ A true/false flag to indicate whether there are -- intermediate or interim exchanges of principal during the -- term of the swap. } deriving (Eq,Show) instance SchemaType PrincipalExchanges where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (PrincipalExchanges a0) `apply` optional (parseSchemaType "initialExchange") `apply` optional (parseSchemaType "finalExchange") `apply` optional (parseSchemaType "intermediateExchange") schemaTypeToXML s x@PrincipalExchanges{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ princExchan_ID x ] [ maybe [] (schemaTypeToXML "initialExchange") $ princExchan_initialExchange x , maybe [] (schemaTypeToXML "finalExchange") $ princExchan_finalExchange x , maybe [] (schemaTypeToXML "intermediateExchange") $ princExchan_intermediateExchange x ] -- | The base type which all FpML products extend. data Product = Product_StandardProduct StandardProduct | Product_Option Option | Product_Swaption Swaption | Product_Swap Swap | Product_Fra Fra | Product_CapFloor CapFloor | Product_BulletPayment BulletPayment | Product_GenericProduct GenericProduct | Product_TermDeposit TermDeposit | Product_FxSwap FxSwap | Product_FxSingleLeg FxSingleLeg | Product_ReturnSwapBase ReturnSwapBase | Product_NettedSwapBase NettedSwapBase | Product_Strategy Strategy | Product_InstrumentTradeDetails InstrumentTradeDetails | Product_DividendSwapTransactionSupplement DividendSwapTransactionSupplement | Product_CommoditySwaption CommoditySwaption | Product_CommoditySwap CommoditySwap | Product_CommodityOption CommodityOption | Product_CommodityForward CommodityForward | Product_CreditDefaultSwap CreditDefaultSwap | Product_EquityDerivativeBase EquityDerivativeBase | Product_VarianceSwapTransactionSupplement VarianceSwapTransactionSupplement deriving (Eq,Show) instance SchemaType Product where parseSchemaType s = do (fmap Product_StandardProduct $ parseSchemaType s) `onFail` (fmap Product_Option $ parseSchemaType s) `onFail` (fmap Product_Swaption $ parseSchemaType s) `onFail` (fmap Product_Swap $ parseSchemaType s) `onFail` (fmap Product_Fra $ parseSchemaType s) `onFail` (fmap Product_CapFloor $ parseSchemaType s) `onFail` (fmap Product_BulletPayment $ parseSchemaType s) `onFail` (fmap Product_GenericProduct $ parseSchemaType s) `onFail` (fmap Product_TermDeposit $ parseSchemaType s) `onFail` (fmap Product_FxSwap $ parseSchemaType s) `onFail` (fmap Product_FxSingleLeg $ parseSchemaType s) `onFail` (fmap Product_ReturnSwapBase $ parseSchemaType s) `onFail` (fmap Product_NettedSwapBase $ parseSchemaType s) `onFail` (fmap Product_Strategy $ parseSchemaType s) `onFail` (fmap Product_InstrumentTradeDetails $ parseSchemaType s) `onFail` (fmap Product_DividendSwapTransactionSupplement $ parseSchemaType s) `onFail` (fmap Product_CommoditySwaption $ parseSchemaType s) `onFail` (fmap Product_CommoditySwap $ parseSchemaType s) `onFail` (fmap Product_CommodityOption $ parseSchemaType s) `onFail` (fmap Product_CommodityForward $ parseSchemaType s) `onFail` (fmap Product_CreditDefaultSwap $ parseSchemaType s) `onFail` (fmap Product_EquityDerivativeBase $ parseSchemaType s) `onFail` (fmap Product_VarianceSwapTransactionSupplement $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of Product,\n\ \ namely one of:\n\ \StandardProduct,Option,Swaption,Swap,Fra,CapFloor,BulletPayment,GenericProduct,TermDeposit,FxSwap,FxSingleLeg,ReturnSwapBase,NettedSwapBase,Strategy,InstrumentTradeDetails,DividendSwapTransactionSupplement,CommoditySwaption,CommoditySwap,CommodityOption,CommodityForward,CreditDefaultSwap,EquityDerivativeBase,VarianceSwapTransactionSupplement" schemaTypeToXML _s (Product_StandardProduct x) = schemaTypeToXML "standardProduct" x schemaTypeToXML _s (Product_Option x) = schemaTypeToXML "option" x schemaTypeToXML _s (Product_Swaption x) = schemaTypeToXML "swaption" x schemaTypeToXML _s (Product_Swap x) = schemaTypeToXML "swap" x schemaTypeToXML _s (Product_Fra x) = schemaTypeToXML "fra" x schemaTypeToXML _s (Product_CapFloor x) = schemaTypeToXML "capFloor" x schemaTypeToXML _s (Product_BulletPayment x) = schemaTypeToXML "bulletPayment" x schemaTypeToXML _s (Product_GenericProduct x) = schemaTypeToXML "genericProduct" x schemaTypeToXML _s (Product_TermDeposit x) = schemaTypeToXML "termDeposit" x schemaTypeToXML _s (Product_FxSwap x) = schemaTypeToXML "fxSwap" x schemaTypeToXML _s (Product_FxSingleLeg x) = schemaTypeToXML "fxSingleLeg" x schemaTypeToXML _s (Product_ReturnSwapBase x) = schemaTypeToXML "returnSwapBase" x schemaTypeToXML _s (Product_NettedSwapBase x) = schemaTypeToXML "nettedSwapBase" x schemaTypeToXML _s (Product_Strategy x) = schemaTypeToXML "strategy" x schemaTypeToXML _s (Product_InstrumentTradeDetails x) = schemaTypeToXML "instrumentTradeDetails" x schemaTypeToXML _s (Product_DividendSwapTransactionSupplement x) = schemaTypeToXML "dividendSwapTransactionSupplement" x schemaTypeToXML _s (Product_CommoditySwaption x) = schemaTypeToXML "commoditySwaption" x schemaTypeToXML _s (Product_CommoditySwap x) = schemaTypeToXML "commoditySwap" x schemaTypeToXML _s (Product_CommodityOption x) = schemaTypeToXML "commodityOption" x schemaTypeToXML _s (Product_CommodityForward x) = schemaTypeToXML "commodityForward" x schemaTypeToXML _s (Product_CreditDefaultSwap x) = schemaTypeToXML "creditDefaultSwap" x schemaTypeToXML _s (Product_EquityDerivativeBase x) = schemaTypeToXML "equityDerivativeBase" x schemaTypeToXML _s (Product_VarianceSwapTransactionSupplement x) = schemaTypeToXML "varianceSwapTransactionSupplement" x data ProductId = ProductId Scheme ProductIdAttributes deriving (Eq,Show) data ProductIdAttributes = ProductIdAttributes { productIdAttrib_productIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ProductId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "productIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ProductId v (ProductIdAttributes a0) schemaTypeToXML s (ProductId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "productIdScheme") $ productIdAttrib_productIdScheme at ] $ schemaTypeToXML s bt instance Extension ProductId Scheme where supertype (ProductId s _) = s -- | Reference to a full FpML product. data ProductReference = ProductReference { productRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType ProductReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (ProductReference a0) schemaTypeToXML s x@ProductReference{} = toXMLElement s [ toXMLAttribute "href" $ productRef_href x ] [] instance Extension ProductReference Reference where supertype v = Reference_ProductReference v data ProductType = ProductType Scheme ProductTypeAttributes deriving (Eq,Show) data ProductTypeAttributes = ProductTypeAttributes { productTypeAttrib_productTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ProductType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "productTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ProductType v (ProductTypeAttributes a0) schemaTypeToXML s (ProductType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "productTypeScheme") $ productTypeAttrib_productTypeScheme at ] $ schemaTypeToXML s bt instance Extension ProductType Scheme where supertype (ProductType s _) = s -- | A type that describes the composition of a rate that has -- been quoted or is to be quoted. This includes the two -- currencies and the quotation relationship between the two -- currencies and is used as a building block throughout the -- FX specification. data QuotedCurrencyPair = QuotedCurrencyPair { quotedCurrenPair_currency1 :: Maybe Currency -- ^ The first currency specified when a pair of currencies is -- to be evaluated. , quotedCurrenPair_currency2 :: Maybe Currency -- ^ The second currency specified when a pair of currencies is -- to be evaluated. , quotedCurrenPair_quoteBasis :: Maybe QuoteBasisEnum -- ^ The method by which the exchange rate is quoted. } deriving (Eq,Show) instance SchemaType QuotedCurrencyPair where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return QuotedCurrencyPair `apply` optional (parseSchemaType "currency1") `apply` optional (parseSchemaType "currency2") `apply` optional (parseSchemaType "quoteBasis") schemaTypeToXML s x@QuotedCurrencyPair{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "currency1") $ quotedCurrenPair_currency1 x , maybe [] (schemaTypeToXML "currency2") $ quotedCurrenPair_currency2 x , maybe [] (schemaTypeToXML "quoteBasis") $ quotedCurrenPair_quoteBasis x ] -- | The abstract base class for all types which define interest -- rate streams. data Rate = Rate_FloatingRate FloatingRate deriving (Eq,Show) instance SchemaType Rate where parseSchemaType s = do (fmap Rate_FloatingRate $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of Rate,\n\ \ namely one of:\n\ \FloatingRate" schemaTypeToXML _s (Rate_FloatingRate x) = schemaTypeToXML "floatingRate" x -- | Reference to any rate (floating, inflation) derived from -- the abstract Rate component. data RateReference = RateReference { rateRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType RateReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (RateReference a0) schemaTypeToXML s x@RateReference{} = toXMLElement s [ toXMLAttribute "href" $ rateRef_href x ] [] -- | A type defining parameters associated with an individual -- observation or fixing. This type forms part of the cashflow -- representation of a stream. data RateObservation = RateObservation { rateObserv_ID :: Maybe Xsd.ID , rateObserv_resetDate :: Maybe Xsd.Date -- ^ The reset date. , rateObserv_adjustedFixingDate :: Maybe Xsd.Date -- ^ The adjusted fixing date, i.e. the actual date the rate is -- observed. The date should already be adjusted for any -- applicable business day convention. , rateObserv_observedRate :: Maybe Xsd.Decimal -- ^ The actual observed rate before any required rate treatment -- is applied, e.g. before converting a rate quoted on a -- discount basis to an equivalent yield. An observed rate of -- 5% would be represented as 0.05. , rateObserv_treatedRate :: Maybe Xsd.Decimal -- ^ The observed rate after any required rate treatment is -- applied. A treated rate of 5% would be represented as 0.05. , rateObserv_observationWeight :: Maybe Xsd.PositiveInteger -- ^ The number of days weighting to be associated with the rate -- observation, i.e. the number of days such rate is in -- effect. This is applicable in the case of a weighted -- average method of calculation where more than one reset -- date is established for a single calculation period. , rateObserv_rateReference :: Maybe RateReference -- ^ A pointer style reference to a floating rate component -- defined as part of a stub calculation period amount -- component. It is only required when it is necessary to -- distinguish two rate observations for the same fixing date -- which could occur when linear interpolation of two -- different rates occurs for a stub calculation period. , rateObserv_forecastRate :: Maybe Xsd.Decimal -- ^ The value representing the forecast rate used to calculate -- the forecast future value of the accrual period.A value of -- 1% should be represented as 0.01 , rateObserv_treatedForecastRate :: Maybe Xsd.Decimal -- ^ The value representing the forecast rate after applying -- rate treatment rules. A value of 1% should be represented -- as 0.01 } deriving (Eq,Show) instance SchemaType RateObservation where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (RateObservation a0) `apply` optional (parseSchemaType "resetDate") `apply` optional (parseSchemaType "adjustedFixingDate") `apply` optional (parseSchemaType "observedRate") `apply` optional (parseSchemaType "treatedRate") `apply` optional (parseSchemaType "observationWeight") `apply` optional (parseSchemaType "rateReference") `apply` optional (parseSchemaType "forecastRate") `apply` optional (parseSchemaType "treatedForecastRate") schemaTypeToXML s x@RateObservation{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ rateObserv_ID x ] [ maybe [] (schemaTypeToXML "resetDate") $ rateObserv_resetDate x , maybe [] (schemaTypeToXML "adjustedFixingDate") $ rateObserv_adjustedFixingDate x , maybe [] (schemaTypeToXML "observedRate") $ rateObserv_observedRate x , maybe [] (schemaTypeToXML "treatedRate") $ rateObserv_treatedRate x , maybe [] (schemaTypeToXML "observationWeight") $ rateObserv_observationWeight x , maybe [] (schemaTypeToXML "rateReference") $ rateObserv_rateReference x , maybe [] (schemaTypeToXML "forecastRate") $ rateObserv_forecastRate x , maybe [] (schemaTypeToXML "treatedForecastRate") $ rateObserv_treatedForecastRate x ] data RateSourcePage = RateSourcePage Scheme RateSourcePageAttributes deriving (Eq,Show) data RateSourcePageAttributes = RateSourcePageAttributes { rateSourcePageAttrib_rateSourcePageScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType RateSourcePage where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "rateSourcePageScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ RateSourcePage v (RateSourcePageAttributes a0) schemaTypeToXML s (RateSourcePage bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "rateSourcePageScheme") $ rateSourcePageAttrib_rateSourcePageScheme at ] $ schemaTypeToXML s bt instance Extension RateSourcePage Scheme where supertype (RateSourcePage s _) = s -- | The abstract base class for all types which define -- intra-document pointers. data Reference = Reference_SpreadScheduleReference SpreadScheduleReference | Reference_ScheduleReference ScheduleReference | Reference_ReturnSwapNotionalAmountReference ReturnSwapNotionalAmountReference | Reference_ProductReference ProductReference | Reference_PricingStructureReference PricingStructureReference | Reference_PaymentReference PaymentReference | Reference_PartyTradeIdentifierReference PartyTradeIdentifierReference | Reference_PersonReference PersonReference | Reference_BusinessUnitReference BusinessUnitReference | Reference_PartyReference PartyReference | Reference_NotionalReference NotionalReference | Reference_NotionalAmountReference NotionalAmountReference | Reference_LegalEntityReference LegalEntityReference | Reference_IdentifiedCurrencyReference IdentifiedCurrencyReference | Reference_HTTPAttachmentReference HTTPAttachmentReference | Reference_DeterminationMethodReference DeterminationMethodReference | Reference_DateReference DateReference | Reference_BusinessDayAdjustmentsReference BusinessDayAdjustmentsReference | Reference_BusinessCentersReference BusinessCentersReference | Reference_AmountReference AmountReference | Reference_AccountReference AccountReference | Reference_AssetReference AssetReference | Reference_AnyAssetReference AnyAssetReference | Reference_CreditEventsReference CreditEventsReference | Reference_ValuationDatesReference ValuationDatesReference | Reference_ResetDatesReference ResetDatesReference | Reference_RelevantUnderlyingDateReference RelevantUnderlyingDateReference | Reference_PaymentDatesReference PaymentDatesReference | Reference_InterestRateStreamReference InterestRateStreamReference | Reference_CalculationPeriodDatesReference CalculationPeriodDatesReference | Reference_MoneyReference MoneyReference | Reference_InterestLegCalculationPeriodDatesReference InterestLegCalculationPeriodDatesReference | Reference_FloatingRateCalculationReference FloatingRateCalculationReference | Reference_SettlementPeriodsReference SettlementPeriodsReference | Reference_QuantityReference QuantityReference | Reference_QuantityScheduleReference QuantityScheduleReference | Reference_LagReference LagReference | Reference_CalculationPeriodsScheduleReference CalculationPeriodsScheduleReference | Reference_CalculationPeriodsReference CalculationPeriodsReference | Reference_CalculationPeriodsDatesReference CalculationPeriodsDatesReference | Reference_SettlementTermsReference SettlementTermsReference | Reference_ProtectionTermsReference ProtectionTermsReference | Reference_FixedRateReference FixedRateReference | Reference_ValuationScenarioReference ValuationScenarioReference | Reference_ValuationReference ValuationReference | Reference_SensitivitySetDefinitionReference SensitivitySetDefinitionReference | Reference_PricingParameterDerivativeReference PricingParameterDerivativeReference | Reference_PricingDataPointCoordinateReference PricingDataPointCoordinateReference | Reference_MarketReference MarketReference | Reference_AssetOrTermPointOrPricingStructureReference AssetOrTermPointOrPricingStructureReference deriving (Eq,Show) instance SchemaType Reference where parseSchemaType s = do (fmap Reference_SpreadScheduleReference $ parseSchemaType s) `onFail` (fmap Reference_ScheduleReference $ parseSchemaType s) `onFail` (fmap Reference_ReturnSwapNotionalAmountReference $ parseSchemaType s) `onFail` (fmap Reference_ProductReference $ parseSchemaType s) `onFail` (fmap Reference_PricingStructureReference $ parseSchemaType s) `onFail` (fmap Reference_PaymentReference $ parseSchemaType s) `onFail` (fmap Reference_PartyTradeIdentifierReference $ parseSchemaType s) `onFail` (fmap Reference_PersonReference $ parseSchemaType s) `onFail` (fmap Reference_BusinessUnitReference $ parseSchemaType s) `onFail` (fmap Reference_PartyReference $ parseSchemaType s) `onFail` (fmap Reference_NotionalReference $ parseSchemaType s) `onFail` (fmap Reference_NotionalAmountReference $ parseSchemaType s) `onFail` (fmap Reference_LegalEntityReference $ parseSchemaType s) `onFail` (fmap Reference_IdentifiedCurrencyReference $ parseSchemaType s) `onFail` (fmap Reference_HTTPAttachmentReference $ parseSchemaType s) `onFail` (fmap Reference_DeterminationMethodReference $ parseSchemaType s) `onFail` (fmap Reference_DateReference $ parseSchemaType s) `onFail` (fmap Reference_BusinessDayAdjustmentsReference $ parseSchemaType s) `onFail` (fmap Reference_BusinessCentersReference $ parseSchemaType s) `onFail` (fmap Reference_AmountReference $ parseSchemaType s) `onFail` (fmap Reference_AccountReference $ parseSchemaType s) `onFail` (fmap Reference_AssetReference $ parseSchemaType s) `onFail` (fmap Reference_AnyAssetReference $ parseSchemaType s) `onFail` (fmap Reference_CreditEventsReference $ parseSchemaType s) `onFail` (fmap Reference_ValuationDatesReference $ parseSchemaType s) `onFail` (fmap Reference_ResetDatesReference $ parseSchemaType s) `onFail` (fmap Reference_RelevantUnderlyingDateReference $ parseSchemaType s) `onFail` (fmap Reference_PaymentDatesReference $ parseSchemaType s) `onFail` (fmap Reference_InterestRateStreamReference $ parseSchemaType s) `onFail` (fmap Reference_CalculationPeriodDatesReference $ parseSchemaType s) `onFail` (fmap Reference_MoneyReference $ parseSchemaType s) `onFail` (fmap Reference_InterestLegCalculationPeriodDatesReference $ parseSchemaType s) `onFail` (fmap Reference_FloatingRateCalculationReference $ parseSchemaType s) `onFail` (fmap Reference_SettlementPeriodsReference $ parseSchemaType s) `onFail` (fmap Reference_QuantityReference $ parseSchemaType s) `onFail` (fmap Reference_QuantityScheduleReference $ parseSchemaType s) `onFail` (fmap Reference_LagReference $ parseSchemaType s) `onFail` (fmap Reference_CalculationPeriodsScheduleReference $ parseSchemaType s) `onFail` (fmap Reference_CalculationPeriodsReference $ parseSchemaType s) `onFail` (fmap Reference_CalculationPeriodsDatesReference $ parseSchemaType s) `onFail` (fmap Reference_SettlementTermsReference $ parseSchemaType s) `onFail` (fmap Reference_ProtectionTermsReference $ parseSchemaType s) `onFail` (fmap Reference_FixedRateReference $ parseSchemaType s) `onFail` (fmap Reference_ValuationScenarioReference $ parseSchemaType s) `onFail` (fmap Reference_ValuationReference $ parseSchemaType s) `onFail` (fmap Reference_SensitivitySetDefinitionReference $ parseSchemaType s) `onFail` (fmap Reference_PricingParameterDerivativeReference $ parseSchemaType s) `onFail` (fmap Reference_PricingDataPointCoordinateReference $ parseSchemaType s) `onFail` (fmap Reference_MarketReference $ parseSchemaType s) `onFail` (fmap Reference_AssetOrTermPointOrPricingStructureReference $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of Reference,\n\ \ namely one of:\n\ \SpreadScheduleReference,ScheduleReference,ReturnSwapNotionalAmountReference,ProductReference,PricingStructureReference,PaymentReference,PartyTradeIdentifierReference,PersonReference,BusinessUnitReference,PartyReference,NotionalReference,NotionalAmountReference,LegalEntityReference,IdentifiedCurrencyReference,HTTPAttachmentReference,DeterminationMethodReference,DateReference,BusinessDayAdjustmentsReference,BusinessCentersReference,AmountReference,AccountReference,AssetReference,AnyAssetReference,CreditEventsReference,ValuationDatesReference,ResetDatesReference,RelevantUnderlyingDateReference,PaymentDatesReference,InterestRateStreamReference,CalculationPeriodDatesReference,MoneyReference,InterestLegCalculationPeriodDatesReference,FloatingRateCalculationReference,SettlementPeriodsReference,QuantityReference,QuantityScheduleReference,LagReference,CalculationPeriodsScheduleReference,CalculationPeriodsReference,CalculationPeriodsDatesReference,SettlementTermsReference,ProtectionTermsReference,FixedRateReference,ValuationScenarioReference,ValuationReference,SensitivitySetDefinitionReference,PricingParameterDerivativeReference,PricingDataPointCoordinateReference,MarketReference,AssetOrTermPointOrPricingStructureReference" schemaTypeToXML _s (Reference_SpreadScheduleReference x) = schemaTypeToXML "spreadScheduleReference" x schemaTypeToXML _s (Reference_ScheduleReference x) = schemaTypeToXML "scheduleReference" x schemaTypeToXML _s (Reference_ReturnSwapNotionalAmountReference x) = schemaTypeToXML "returnSwapNotionalAmountReference" x schemaTypeToXML _s (Reference_ProductReference x) = schemaTypeToXML "productReference" x schemaTypeToXML _s (Reference_PricingStructureReference x) = schemaTypeToXML "pricingStructureReference" x schemaTypeToXML _s (Reference_PaymentReference x) = schemaTypeToXML "paymentReference" x schemaTypeToXML _s (Reference_PartyTradeIdentifierReference x) = schemaTypeToXML "partyTradeIdentifierReference" x schemaTypeToXML _s (Reference_PersonReference x) = schemaTypeToXML "personReference" x schemaTypeToXML _s (Reference_BusinessUnitReference x) = schemaTypeToXML "businessUnitReference" x schemaTypeToXML _s (Reference_PartyReference x) = schemaTypeToXML "partyReference" x schemaTypeToXML _s (Reference_NotionalReference x) = schemaTypeToXML "notionalReference" x schemaTypeToXML _s (Reference_NotionalAmountReference x) = schemaTypeToXML "notionalAmountReference" x schemaTypeToXML _s (Reference_LegalEntityReference x) = schemaTypeToXML "legalEntityReference" x schemaTypeToXML _s (Reference_IdentifiedCurrencyReference x) = schemaTypeToXML "identifiedCurrencyReference" x schemaTypeToXML _s (Reference_HTTPAttachmentReference x) = schemaTypeToXML "hTTPAttachmentReference" x schemaTypeToXML _s (Reference_DeterminationMethodReference x) = schemaTypeToXML "determinationMethodReference" x schemaTypeToXML _s (Reference_DateReference x) = schemaTypeToXML "dateReference" x schemaTypeToXML _s (Reference_BusinessDayAdjustmentsReference x) = schemaTypeToXML "businessDayAdjustmentsReference" x schemaTypeToXML _s (Reference_BusinessCentersReference x) = schemaTypeToXML "businessCentersReference" x schemaTypeToXML _s (Reference_AmountReference x) = schemaTypeToXML "amountReference" x schemaTypeToXML _s (Reference_AccountReference x) = schemaTypeToXML "accountReference" x schemaTypeToXML _s (Reference_AssetReference x) = schemaTypeToXML "assetReference" x schemaTypeToXML _s (Reference_AnyAssetReference x) = schemaTypeToXML "anyAssetReference" x schemaTypeToXML _s (Reference_CreditEventsReference x) = schemaTypeToXML "creditEventsReference" x schemaTypeToXML _s (Reference_ValuationDatesReference x) = schemaTypeToXML "valuationDatesReference" x schemaTypeToXML _s (Reference_ResetDatesReference x) = schemaTypeToXML "resetDatesReference" x schemaTypeToXML _s (Reference_RelevantUnderlyingDateReference x) = schemaTypeToXML "relevantUnderlyingDateReference" x schemaTypeToXML _s (Reference_PaymentDatesReference x) = schemaTypeToXML "paymentDatesReference" x schemaTypeToXML _s (Reference_InterestRateStreamReference x) = schemaTypeToXML "interestRateStreamReference" x schemaTypeToXML _s (Reference_CalculationPeriodDatesReference x) = schemaTypeToXML "calculationPeriodDatesReference" x schemaTypeToXML _s (Reference_MoneyReference x) = schemaTypeToXML "moneyReference" x schemaTypeToXML _s (Reference_InterestLegCalculationPeriodDatesReference x) = schemaTypeToXML "interestLegCalculationPeriodDatesReference" x schemaTypeToXML _s (Reference_FloatingRateCalculationReference x) = schemaTypeToXML "floatingRateCalculationReference" x schemaTypeToXML _s (Reference_SettlementPeriodsReference x) = schemaTypeToXML "settlementPeriodsReference" x schemaTypeToXML _s (Reference_QuantityReference x) = schemaTypeToXML "quantityReference" x schemaTypeToXML _s (Reference_QuantityScheduleReference x) = schemaTypeToXML "quantityScheduleReference" x schemaTypeToXML _s (Reference_LagReference x) = schemaTypeToXML "lagReference" x schemaTypeToXML _s (Reference_CalculationPeriodsScheduleReference x) = schemaTypeToXML "calculationPeriodsScheduleReference" x schemaTypeToXML _s (Reference_CalculationPeriodsReference x) = schemaTypeToXML "calculationPeriodsReference" x schemaTypeToXML _s (Reference_CalculationPeriodsDatesReference x) = schemaTypeToXML "calculationPeriodsDatesReference" x schemaTypeToXML _s (Reference_SettlementTermsReference x) = schemaTypeToXML "settlementTermsReference" x schemaTypeToXML _s (Reference_ProtectionTermsReference x) = schemaTypeToXML "protectionTermsReference" x schemaTypeToXML _s (Reference_FixedRateReference x) = schemaTypeToXML "fixedRateReference" x schemaTypeToXML _s (Reference_ValuationScenarioReference x) = schemaTypeToXML "valuationScenarioReference" x schemaTypeToXML _s (Reference_ValuationReference x) = schemaTypeToXML "valuationReference" x schemaTypeToXML _s (Reference_SensitivitySetDefinitionReference x) = schemaTypeToXML "sensitivitySetDefinitionReference" x schemaTypeToXML _s (Reference_PricingParameterDerivativeReference x) = schemaTypeToXML "pricingParameterDerivativeReference" x schemaTypeToXML _s (Reference_PricingDataPointCoordinateReference x) = schemaTypeToXML "pricingDataPointCoordinateReference" x schemaTypeToXML _s (Reference_MarketReference x) = schemaTypeToXML "marketReference" x schemaTypeToXML _s (Reference_AssetOrTermPointOrPricingStructureReference x) = schemaTypeToXML "assetOrTermPointOrPricingStructureReference" x -- | Specifies the reference amount using a scheme. data ReferenceAmount = ReferenceAmount Scheme ReferenceAmountAttributes deriving (Eq,Show) data ReferenceAmountAttributes = ReferenceAmountAttributes { refAmountAttrib_referenceAmountScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ReferenceAmount where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "referenceAmountScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ReferenceAmount v (ReferenceAmountAttributes a0) schemaTypeToXML s (ReferenceAmount bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "referenceAmountScheme") $ refAmountAttrib_referenceAmountScheme at ] $ schemaTypeToXML s bt instance Extension ReferenceAmount Scheme where supertype (ReferenceAmount s _) = s -- | A type to describe an institution (party) identified by -- means of a coding scheme and an optional name. data ReferenceBank = ReferenceBank { referenceBank_id :: Maybe ReferenceBankId -- ^ An institution (party) identifier, e.g. a bank identifier -- code (BIC). , referenceBank_name :: Maybe Xsd.XsdString -- ^ The name of the institution (party). A free format string. -- FpML does not define usage rules for the element. } deriving (Eq,Show) instance SchemaType ReferenceBank where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ReferenceBank `apply` optional (parseSchemaType "referenceBankId") `apply` optional (parseSchemaType "referenceBankName") schemaTypeToXML s x@ReferenceBank{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "referenceBankId") $ referenceBank_id x , maybe [] (schemaTypeToXML "referenceBankName") $ referenceBank_name x ] data ReferenceBankId = ReferenceBankId Scheme ReferenceBankIdAttributes deriving (Eq,Show) data ReferenceBankIdAttributes = ReferenceBankIdAttributes { refBankIdAttrib_referenceBankIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ReferenceBankId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "referenceBankIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ReferenceBankId v (ReferenceBankIdAttributes a0) schemaTypeToXML s (ReferenceBankId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "referenceBankIdScheme") $ refBankIdAttrib_referenceBankIdScheme at ] $ schemaTypeToXML s bt instance Extension ReferenceBankId Scheme where supertype (ReferenceBankId s _) = s data RelatedBusinessUnit = RelatedBusinessUnit { relatedBusUnit_businessUnitReference :: BusinessUnitReference -- ^ The unit that is related to this. , relatedBusUnit_role :: BusinessUnitRole -- ^ The category of the relationship. The related unit performs -- the role specified in this field for the base party. For -- example, if the role is "Trader", the related unit acts -- acts or acted as the base party's trading unit. } deriving (Eq,Show) instance SchemaType RelatedBusinessUnit where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return RelatedBusinessUnit `apply` parseSchemaType "businessUnitReference" `apply` parseSchemaType "role" schemaTypeToXML s x@RelatedBusinessUnit{} = toXMLElement s [] [ schemaTypeToXML "businessUnitReference" $ relatedBusUnit_businessUnitReference x , schemaTypeToXML "role" $ relatedBusUnit_role x ] data RelatedParty = RelatedParty { relatedParty_partyReference :: PartyReference -- ^ Reference to a party. , relatedParty_accountReference :: Maybe AccountReference -- ^ Reference to an account. , relatedParty_role :: PartyRole -- ^ The category of the relationship. The related party -- performs the role specified in this field for the base -- party. For example, if the role is "Guarantor", the related -- party acts as a guarantor for the base party. , relatedParty_type :: Maybe PartyRoleType -- ^ Additional definition refining the type of relationship. -- For example, if the "role" is Guarantor, this element may -- be used to specify whether all positions are guaranteed, or -- only a subset of them. } deriving (Eq,Show) instance SchemaType RelatedParty where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return RelatedParty `apply` parseSchemaType "partyReference" `apply` optional (parseSchemaType "accountReference") `apply` parseSchemaType "role" `apply` optional (parseSchemaType "type") schemaTypeToXML s x@RelatedParty{} = toXMLElement s [] [ schemaTypeToXML "partyReference" $ relatedParty_partyReference x , maybe [] (schemaTypeToXML "accountReference") $ relatedParty_accountReference x , schemaTypeToXML "role" $ relatedParty_role x , maybe [] (schemaTypeToXML "type") $ relatedParty_type x ] data RelatedPerson = RelatedPerson { relatedPerson_personReference :: PersonReference -- ^ The individual person that is related to this. , relatedPerson_role :: PersonRole -- ^ The category of the relationship. The related individual -- performs the role specified in this field for the base -- party. For example, if the role is "Trader", the related -- person acts acts or acted as the base party's trader. } deriving (Eq,Show) instance SchemaType RelatedPerson where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return RelatedPerson `apply` parseSchemaType "personReference" `apply` parseSchemaType "role" schemaTypeToXML s x@RelatedPerson{} = toXMLElement s [] [ schemaTypeToXML "personReference" $ relatedPerson_personReference x , schemaTypeToXML "role" $ relatedPerson_role x ] -- | A type describing a role played by a unit in one or more -- transactions. Examples include roles such as Trader, -- Collateral, Confirmation, Settlement, etc. This can be -- extended to provide custom roles. data BusinessUnitRole = BusinessUnitRole Scheme BusinessUnitRoleAttributes deriving (Eq,Show) data BusinessUnitRoleAttributes = BusinessUnitRoleAttributes { busUnitRoleAttrib_unitRoleScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType BusinessUnitRole where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "unitRoleScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ BusinessUnitRole v (BusinessUnitRoleAttributes a0) schemaTypeToXML s (BusinessUnitRole bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "unitRoleScheme") $ busUnitRoleAttrib_unitRoleScheme at ] $ schemaTypeToXML s bt instance Extension BusinessUnitRole Scheme where supertype (BusinessUnitRole s _) = s -- | A type describing a role played by a person in one or more -- transactions. Examples include roles such as Trader, -- Broker, MiddleOffice, Legal, etc. This can be extended to -- provide custom roles. data PersonRole = PersonRole Scheme PersonRoleAttributes deriving (Eq,Show) data PersonRoleAttributes = PersonRoleAttributes { personRoleAttrib_personRoleScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType PersonRole where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "personRoleScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ PersonRole v (PersonRoleAttributes a0) schemaTypeToXML s (PersonRole bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "personRoleScheme") $ personRoleAttrib_personRoleScheme at ] $ schemaTypeToXML s bt instance Extension PersonRole Scheme where supertype (PersonRole s _) = s -- | A type defining a date (referred to as the derived date) as -- a relative offset from another date (referred to as the -- anchor date). If the anchor date is itself an adjustable -- date then the offset is assumed to be calculated from the -- adjusted anchor date. A number of different scenarios can -- be supported, namely; 1) the derived date may simply be a -- number of calendar periods (days, weeks, months or years) -- preceding or following the anchor date; 2) the unadjusted -- derived date may be a number of calendar periods (days, -- weeks, months or years) preceding or following the anchor -- date with the resulting unadjusted derived date subject to -- adjustment in accordance with a specified business day -- convention, i.e. the derived date must fall on a good -- business day; 3) the derived date may be a number of -- business days preceding or following the anchor date. Note -- that the businessDayConvention specifies any required -- adjustment to the unadjusted derived date. A negative or -- positive value in the periodMultiplier indicates whether -- the unadjusted derived precedes or follows the anchor date. -- The businessDayConvention should contain a value NONE if -- the day type element contains a value of Business (since -- specifying a negative or positive business days offset -- would already guarantee that the derived date would fall on -- a good business day in the specified business centers). data RelativeDateOffset = RelativeDateOffset { relatDateOffset_ID :: Maybe Xsd.ID , relatDateOffset_periodMultiplier :: Xsd.Integer -- ^ A time period multiplier, e.g. 1, 2 or 3 etc. A negative -- value can be used when specifying an offset relative to -- another date, e.g. -2 days. , relatDateOffset_period :: PeriodEnum -- ^ A time period, e.g. a day, week, month or year of the -- stream. If the periodMultiplier value is 0 (zero) then -- period must contain the value D (day). , relatDateOffset_dayType :: Maybe DayTypeEnum -- ^ In the case of an offset specified as a number of days, -- this element defines whether consideration is given as to -- whether a day is a good business day or not. If a day type -- of business days is specified then non-business days are -- ignored when calculating the offset. The financial business -- centers to use for determination of business days are -- implied by the context in which this element is used. This -- element must only be included when the offset is specified -- as a number of days. If the offset is zero days then the -- dayType element should not be included. , relatDateOffset_businessDayConvention :: Maybe BusinessDayConventionEnum -- ^ The convention for adjusting a date if it would otherwise -- fall on a day that is not a business day. , relatDateOffset_choice4 :: (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 , relatDateOffset_dateRelativeTo :: Maybe DateReference -- ^ Specifies the anchor as an href attribute. The href -- attribute value is a pointer style reference to the element -- or component elsewhere in the document where the anchor -- date is defined. , relatDateOffset_adjustedDate :: Maybe IdentifiedDate -- ^ The date once the adjustment has been performed. (Note that -- this date may change if the business center holidays -- change). } deriving (Eq,Show) instance SchemaType RelativeDateOffset where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (RelativeDateOffset a0) `apply` parseSchemaType "periodMultiplier" `apply` parseSchemaType "period" `apply` optional (parseSchemaType "dayType") `apply` optional (parseSchemaType "businessDayConvention") `apply` optional (oneOf' [ ("BusinessCentersReference", fmap OneOf2 (parseSchemaType "businessCentersReference")) , ("BusinessCenters", fmap TwoOf2 (parseSchemaType "businessCenters")) ]) `apply` optional (parseSchemaType "dateRelativeTo") `apply` optional (parseSchemaType "adjustedDate") schemaTypeToXML s x@RelativeDateOffset{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ relatDateOffset_ID x ] [ schemaTypeToXML "periodMultiplier" $ relatDateOffset_periodMultiplier x , schemaTypeToXML "period" $ relatDateOffset_period x , maybe [] (schemaTypeToXML "dayType") $ relatDateOffset_dayType x , maybe [] (schemaTypeToXML "businessDayConvention") $ relatDateOffset_businessDayConvention x , maybe [] (foldOneOf2 (schemaTypeToXML "businessCentersReference") (schemaTypeToXML "businessCenters") ) $ relatDateOffset_choice4 x , maybe [] (schemaTypeToXML "dateRelativeTo") $ relatDateOffset_dateRelativeTo x , maybe [] (schemaTypeToXML "adjustedDate") $ relatDateOffset_adjustedDate x ] instance Extension RelativeDateOffset Offset where supertype (RelativeDateOffset a0 e0 e1 e2 e3 e4 e5 e6) = Offset a0 e0 e1 e2 instance Extension RelativeDateOffset Period where supertype = (supertype :: Offset -> Period) . (supertype :: RelativeDateOffset -> Offset) -- | A type describing a set of dates defined as relative to -- another set of dates. data RelativeDates = RelativeDates { relatDates_ID :: Maybe Xsd.ID , relatDates_periodMultiplier :: Xsd.Integer -- ^ A time period multiplier, e.g. 1, 2 or 3 etc. A negative -- value can be used when specifying an offset relative to -- another date, e.g. -2 days. , relatDates_period :: PeriodEnum -- ^ A time period, e.g. a day, week, month or year of the -- stream. If the periodMultiplier value is 0 (zero) then -- period must contain the value D (day). , relatDates_dayType :: Maybe DayTypeEnum -- ^ In the case of an offset specified as a number of days, -- this element defines whether consideration is given as to -- whether a day is a good business day or not. If a day type -- of business days is specified then non-business days are -- ignored when calculating the offset. The financial business -- centers to use for determination of business days are -- implied by the context in which this element is used. This -- element must only be included when the offset is specified -- as a number of days. If the offset is zero days then the -- dayType element should not be included. , relatDates_businessDayConvention :: Maybe BusinessDayConventionEnum -- ^ The convention for adjusting a date if it would otherwise -- fall on a day that is not a business day. , relatDates_choice4 :: (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 , relatDates_dateRelativeTo :: Maybe DateReference -- ^ Specifies the anchor as an href attribute. The href -- attribute value is a pointer style reference to the element -- or component elsewhere in the document where the anchor -- date is defined. , relatDates_adjustedDate :: Maybe IdentifiedDate -- ^ The date once the adjustment has been performed. (Note that -- this date may change if the business center holidays -- change). , relatDates_periodSkip :: Maybe Xsd.PositiveInteger -- ^ The number of periods in the referenced date schedule that -- are between each date in the relative date schedule. Thus a -- skip of 2 would mean that dates are relative to every -- second date in the referenced schedule. If present this -- should have a value greater than 1. , relatDates_scheduleBounds :: Maybe DateRange -- ^ The first and last dates of a schedule. This can be used to -- restrict the range of values in a reference series of -- dates. } deriving (Eq,Show) instance SchemaType RelativeDates where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (RelativeDates a0) `apply` parseSchemaType "periodMultiplier" `apply` parseSchemaType "period" `apply` optional (parseSchemaType "dayType") `apply` optional (parseSchemaType "businessDayConvention") `apply` optional (oneOf' [ ("BusinessCentersReference", fmap OneOf2 (parseSchemaType "businessCentersReference")) , ("BusinessCenters", fmap TwoOf2 (parseSchemaType "businessCenters")) ]) `apply` optional (parseSchemaType "dateRelativeTo") `apply` optional (parseSchemaType "adjustedDate") `apply` optional (parseSchemaType "periodSkip") `apply` optional (parseSchemaType "scheduleBounds") schemaTypeToXML s x@RelativeDates{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ relatDates_ID x ] [ schemaTypeToXML "periodMultiplier" $ relatDates_periodMultiplier x , schemaTypeToXML "period" $ relatDates_period x , maybe [] (schemaTypeToXML "dayType") $ relatDates_dayType x , maybe [] (schemaTypeToXML "businessDayConvention") $ relatDates_businessDayConvention x , maybe [] (foldOneOf2 (schemaTypeToXML "businessCentersReference") (schemaTypeToXML "businessCenters") ) $ relatDates_choice4 x , maybe [] (schemaTypeToXML "dateRelativeTo") $ relatDates_dateRelativeTo x , maybe [] (schemaTypeToXML "adjustedDate") $ relatDates_adjustedDate x , maybe [] (schemaTypeToXML "periodSkip") $ relatDates_periodSkip x , maybe [] (schemaTypeToXML "scheduleBounds") $ relatDates_scheduleBounds x ] instance Extension RelativeDates RelativeDateOffset where supertype (RelativeDates a0 e0 e1 e2 e3 e4 e5 e6 e7 e8) = RelativeDateOffset a0 e0 e1 e2 e3 e4 e5 e6 instance Extension RelativeDates Offset where supertype = (supertype :: RelativeDateOffset -> Offset) . (supertype :: RelativeDates -> RelativeDateOffset) instance Extension RelativeDates Period where supertype = (supertype :: Offset -> Period) . (supertype :: RelativeDateOffset -> Offset) . (supertype :: RelativeDates -> RelativeDateOffset) -- | A type describing a date when this date is defined in -- reference to another date through one or several date -- offsets. data RelativeDateSequence = RelativeDateSequence { relatDateSequen_dateRelativeTo :: Maybe DateReference -- ^ Specifies the anchor as an href attribute. The href -- attribute value is a pointer style reference to the element -- or component elsewhere in the document where the anchor -- date is defined. , relatDateSequen_dateOffset :: [DateOffset] , relatDateSequen_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 RelativeDateSequence where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return RelativeDateSequence `apply` optional (parseSchemaType "dateRelativeTo") `apply` many (parseSchemaType "dateOffset") `apply` optional (oneOf' [ ("BusinessCentersReference", fmap OneOf2 (parseSchemaType "businessCentersReference")) , ("BusinessCenters", fmap TwoOf2 (parseSchemaType "businessCenters")) ]) schemaTypeToXML s x@RelativeDateSequence{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "dateRelativeTo") $ relatDateSequen_dateRelativeTo x , concatMap (schemaTypeToXML "dateOffset") $ relatDateSequen_dateOffset x , maybe [] (foldOneOf2 (schemaTypeToXML "businessCentersReference") (schemaTypeToXML "businessCenters") ) $ relatDateSequen_choice2 x ] -- | A date with a required identifier which can be referenced -- elsewhere. data RequiredIdentifierDate = RequiredIdentifierDate Xsd.Date RequiredIdentifierDateAttributes deriving (Eq,Show) data RequiredIdentifierDateAttributes = RequiredIdentifierDateAttributes { requirIdentDateAttrib_ID :: Xsd.ID } deriving (Eq,Show) instance SchemaType RequiredIdentifierDate where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- getAttribute "id" e pos reparse [CElem e pos] v <- parseSchemaType s return $ RequiredIdentifierDate v (RequiredIdentifierDateAttributes a0) schemaTypeToXML s (RequiredIdentifierDate bt at) = addXMLAttributes [ toXMLAttribute "id" $ requirIdentDateAttrib_ID at ] $ schemaTypeToXML s bt instance Extension RequiredIdentifierDate Xsd.Date where supertype (RequiredIdentifierDate s _) = s -- | A type defining the reset frequency. In the case of a -- weekly reset, also specifies the day of the week that the -- reset occurs. If the reset frequency is greater than the -- calculation period frequency the this implies that more or -- more reset dates is established for each calculation period -- and some form of rate averaginhg is applicable. The -- specific averaging method of calculation is specified in -- FloatingRateCalculation. In case the reset frequency is of -- value T (term), the period is defined by the -- swap\swapStream\calculationPerioDates\effectiveDate and the -- swap\swapStream\calculationPerioDates\terminationDate. data ResetFrequency = ResetFrequency { resetFrequ_ID :: Maybe Xsd.ID , resetFrequ_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. , resetFrequ_period :: Maybe PeriodExtendedEnum -- ^ A time period, e.g. a day, week, month, year or term of the -- stream. , resetFrequ_weeklyRollConvention :: Maybe WeeklyRollConventionEnum -- ^ The day of the week on which a weekly reset date occurs. -- This element must be included if the reset frequency is -- defined as weekly and not otherwise. } deriving (Eq,Show) instance SchemaType ResetFrequency where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (ResetFrequency a0) `apply` optional (parseSchemaType "periodMultiplier") `apply` optional (parseSchemaType "period") `apply` optional (parseSchemaType "weeklyRollConvention") schemaTypeToXML s x@ResetFrequency{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ resetFrequ_ID x ] [ maybe [] (schemaTypeToXML "periodMultiplier") $ resetFrequ_periodMultiplier x , maybe [] (schemaTypeToXML "period") $ resetFrequ_period x , maybe [] (schemaTypeToXML "weeklyRollConvention") $ resetFrequ_weeklyRollConvention x ] instance Extension ResetFrequency Frequency where supertype (ResetFrequency a0 e0 e1 e2) = Frequency a0 e0 e1 data RequestedAction = RequestedAction Scheme RequestedActionAttributes deriving (Eq,Show) data RequestedActionAttributes = RequestedActionAttributes { requesActionAttrib_requestedActionScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType RequestedAction where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "requestedActionScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ RequestedAction v (RequestedActionAttributes a0) schemaTypeToXML s (RequestedAction bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "requestedActionScheme") $ requesActionAttrib_requestedActionScheme at ] $ schemaTypeToXML s bt instance Extension RequestedAction Scheme where supertype (RequestedAction s _) = s -- | Describes the resource that contains the media -- representation of a business event (i.e used for stating -- the Publicly Available Information). For example, can -- describe a file or a URL that represents the event. This -- type is an extended version of a type defined by RIXML -- (www.rixml.org). data Resource = Resource { resource_id :: Maybe ResourceId -- ^ The unique identifier of the resource within the event. , resource_type :: Maybe ResourceType -- ^ A description of the type of the resource, e.g. a -- confirmation. , resource_language :: Maybe Language -- ^ Indicates the language of the resource, described using the -- ISO 639-2/T Code. , resource_sizeInBytes :: Maybe Xsd.Decimal -- ^ Indicates the size of the resource in bytes. It could be -- used by the end user to estimate the download time and -- storage needs. , resource_length :: Maybe ResourceLength -- ^ Indicates the length of the resource. For example, if the -- resource were a PDF file, the length would be in pages. , resource_mimeType :: Maybe MimeType -- ^ Indicates the type of media used to store the content. -- mimeType is used to determine the software product(s) that -- can read the content. MIME Types are described in RFC 2046. , resource_name :: Maybe Xsd.NormalizedString -- ^ The name of the resource. , resource_comments :: Maybe Xsd.XsdString -- ^ Any additional comments that are deemed necessary. For -- example, which software version is required to open the -- document? Or, how does this resource relate to the others -- for this event? , resource_choice8 :: (Maybe (OneOf4 Xsd.XsdString Xsd.HexBinary Xsd.Base64Binary Xsd.AnyURI)) -- ^ Choice between: -- -- (1) Provides extra information as string. In case the extra -- information is in XML format, a CDATA section must be -- placed around the source message to prevent its -- interpretation as XML content. -- -- (2) Provides extra information as binary contents coded in -- hexadecimal. -- -- (3) Provides extra information as binary contents coded in -- base64. -- -- (4) Indicates where the resource can be found, as a URL -- that references the information on a web server -- accessible to the message recipient. } deriving (Eq,Show) instance SchemaType Resource where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Resource `apply` optional (parseSchemaType "resourceId") `apply` optional (parseSchemaType "resourceType") `apply` optional (parseSchemaType "language") `apply` optional (parseSchemaType "sizeInBytes") `apply` optional (parseSchemaType "length") `apply` optional (parseSchemaType "mimeType") `apply` optional (parseSchemaType "name") `apply` optional (parseSchemaType "comments") `apply` optional (oneOf' [ ("Xsd.XsdString", fmap OneOf4 (parseSchemaType "string")) , ("Xsd.HexBinary", fmap TwoOf4 (parseSchemaType "hexadecimalBinary")) , ("Xsd.Base64Binary", fmap ThreeOf4 (parseSchemaType "base64Binary")) , ("Xsd.AnyURI", fmap FourOf4 (parseSchemaType "url")) ]) schemaTypeToXML s x@Resource{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "resourceId") $ resource_id x , maybe [] (schemaTypeToXML "resourceType") $ resource_type x , maybe [] (schemaTypeToXML "language") $ resource_language x , maybe [] (schemaTypeToXML "sizeInBytes") $ resource_sizeInBytes x , maybe [] (schemaTypeToXML "length") $ resource_length x , maybe [] (schemaTypeToXML "mimeType") $ resource_mimeType x , maybe [] (schemaTypeToXML "name") $ resource_name x , maybe [] (schemaTypeToXML "comments") $ resource_comments x , maybe [] (foldOneOf4 (schemaTypeToXML "string") (schemaTypeToXML "hexadecimalBinary") (schemaTypeToXML "base64Binary") (schemaTypeToXML "url") ) $ resource_choice8 x ] -- | The data type used for resource identifiers. data ResourceId = ResourceId Scheme ResourceIdAttributes deriving (Eq,Show) data ResourceIdAttributes = ResourceIdAttributes { resourIdAttrib_resourceIdScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ResourceId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "resourceIdScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ResourceId v (ResourceIdAttributes a0) schemaTypeToXML s (ResourceId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "resourceIdScheme") $ resourIdAttrib_resourceIdScheme at ] $ schemaTypeToXML s bt instance Extension ResourceId Scheme where supertype (ResourceId s _) = s -- | The type that indicates the length of the resource. data ResourceLength = ResourceLength { resourLength_lengthUnit :: Maybe LengthUnitEnum -- ^ The length unit of the resource. For example, pages (pdf, -- text documents) or time (audio, video files). , resourLength_lengthValue :: Maybe Xsd.Decimal -- ^ The length value of the resource. } deriving (Eq,Show) instance SchemaType ResourceLength where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ResourceLength `apply` optional (parseSchemaType "lengthUnit") `apply` optional (parseSchemaType "lengthValue") schemaTypeToXML s x@ResourceLength{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "lengthUnit") $ resourLength_lengthUnit x , maybe [] (schemaTypeToXML "lengthValue") $ resourLength_lengthValue x ] -- | The data type used for describing the type or purpose of a -- resource, e.g. "Confirmation". data ResourceType = ResourceType Scheme ResourceTypeAttributes deriving (Eq,Show) data ResourceTypeAttributes = ResourceTypeAttributes { resourTypeAttrib_resourceTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType ResourceType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "resourceTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ ResourceType v (ResourceTypeAttributes a0) schemaTypeToXML s (ResourceType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "resourceTypeScheme") $ resourTypeAttrib_resourceTypeScheme at ] $ schemaTypeToXML s bt instance Extension ResourceType Scheme where supertype (ResourceType s _) = s -- | A reference to the return swap notional amount. data ReturnSwapNotionalAmountReference = ReturnSwapNotionalAmountReference { returnSwapNotionAmountRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType ReturnSwapNotionalAmountReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (ReturnSwapNotionalAmountReference a0) schemaTypeToXML s x@ReturnSwapNotionalAmountReference{} = toXMLElement s [ toXMLAttribute "href" $ returnSwapNotionAmountRef_href x ] [] instance Extension ReturnSwapNotionalAmountReference Reference where supertype v = Reference_ReturnSwapNotionalAmountReference v -- | A type defining a rounding direction and precision to be -- used in the rounding of a rate. data Rounding = Rounding { rounding_direction :: Maybe RoundingDirectionEnum -- ^ Specifies the rounding direction. , rounding_precision :: Maybe Xsd.NonNegativeInteger -- ^ Specifies the rounding precision in terms of a number of -- decimal places. Note how a percentage rate rounding of 5 -- decimal places is expressed as a rounding precision of 7 in -- the FpML document since the percentage is expressed as a -- decimal, e.g. 9.876543% (or 0.09876543) being rounded to -- the nearest 5 decimal places is 9.87654% (or 0.0987654). } deriving (Eq,Show) instance SchemaType Rounding where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Rounding `apply` optional (parseSchemaType "roundingDirection") `apply` optional (parseSchemaType "precision") schemaTypeToXML s x@Rounding{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "roundingDirection") $ rounding_direction x , maybe [] (schemaTypeToXML "precision") $ rounding_precision x ] -- | A type that provides three alternative ways of identifying -- a party involved in the routing of a payment. The -- identification may use payment system identifiers only; -- actual name, address and other reference information; or a -- combination of both. data Routing = Routing { routing_choice0 :: (Maybe (OneOf3 RoutingIds RoutingExplicitDetails RoutingIdsAndExplicitDetails)) -- ^ Choice between: -- -- (1) A set of unique identifiers for a party, eachone -- identifying the party within a payment system. The -- assumption is that each party will not have more than -- one identifier within the same payment system. -- -- (2) A set of details that is used to identify a party -- involved in the routing of a payment when the party -- does not have a code that identifies it within one of -- the recognized payment systems. -- -- (3) A combination of coded payment system identifiers and -- details for physical addressing for a party involved in -- the routing of a payment. } deriving (Eq,Show) instance SchemaType Routing where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Routing `apply` optional (oneOf' [ ("RoutingIds", fmap OneOf3 (parseSchemaType "routingIds")) , ("RoutingExplicitDetails", fmap TwoOf3 (parseSchemaType "routingExplicitDetails")) , ("RoutingIdsAndExplicitDetails", fmap ThreeOf3 (parseSchemaType "routingIdsAndExplicitDetails")) ]) schemaTypeToXML s x@Routing{} = toXMLElement s [] [ maybe [] (foldOneOf3 (schemaTypeToXML "routingIds") (schemaTypeToXML "routingExplicitDetails") (schemaTypeToXML "routingIdsAndExplicitDetails") ) $ routing_choice0 x ] -- | A type that models name, address and supplementary textual -- information for the purposes of identifying a party -- involved in the routing of a payment. data RoutingExplicitDetails = RoutingExplicitDetails { routingExplicDetails_routingName :: Maybe Xsd.XsdString -- ^ A real name that is used to identify a party involved in -- the routing of a payment. , routingExplicDetails_routingAddress :: Maybe Address -- ^ A physical postal address via which a payment can be -- routed. , routingExplicDetails_routingAccountNumber :: Maybe Xsd.XsdString -- ^ An account number via which a payment can be routed. , routingExplicDetails_routingReferenceText :: [Xsd.XsdString] -- ^ A piece of free-format text used to assist the -- identification of a party involved in the routing of a -- payment. } deriving (Eq,Show) instance SchemaType RoutingExplicitDetails where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return RoutingExplicitDetails `apply` optional (parseSchemaType "routingName") `apply` optional (parseSchemaType "routingAddress") `apply` optional (parseSchemaType "routingAccountNumber") `apply` many (parseSchemaType "routingReferenceText") schemaTypeToXML s x@RoutingExplicitDetails{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "routingName") $ routingExplicDetails_routingName x , maybe [] (schemaTypeToXML "routingAddress") $ routingExplicDetails_routingAddress x , maybe [] (schemaTypeToXML "routingAccountNumber") $ routingExplicDetails_routingAccountNumber x , concatMap (schemaTypeToXML "routingReferenceText") $ routingExplicDetails_routingReferenceText x ] data RoutingId = RoutingId Scheme RoutingIdAttributes deriving (Eq,Show) data RoutingIdAttributes = RoutingIdAttributes { routingIdAttrib_routingIdCodeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType RoutingId where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "routingIdCodeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ RoutingId v (RoutingIdAttributes a0) schemaTypeToXML s (RoutingId bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "routingIdCodeScheme") $ routingIdAttrib_routingIdCodeScheme at ] $ schemaTypeToXML s bt instance Extension RoutingId Scheme where supertype (RoutingId s _) = s -- | A type that provides for identifying a party involved in -- the routing of a payment by means of one or more standard -- identification codes. For example, both a SWIFT BIC code -- and a national bank identifier may be required. data RoutingIds = RoutingIds { routingIds_routingId :: [RoutingId] -- ^ A unique identifier for party that is a participant in a -- recognized payment system. } deriving (Eq,Show) instance SchemaType RoutingIds where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return RoutingIds `apply` many (parseSchemaType "routingId") schemaTypeToXML s x@RoutingIds{} = toXMLElement s [] [ concatMap (schemaTypeToXML "routingId") $ routingIds_routingId x ] -- | A type that provides a combination of payment system -- identification codes with physical postal address details, -- for the purposes of identifying a party involved in the -- routing of a payment. data RoutingIdsAndExplicitDetails = RoutingIdsAndExplicitDetails { routingIdsAndExplicDetails_routingIds :: [RoutingIds] -- ^ A set of unique identifiers for a party, eachone -- identifying the party within a payment system. The -- assumption is that each party will not have more than one -- identifier within the same payment system. , routingIdsAndExplicDetails_routingName :: Maybe Xsd.XsdString -- ^ A real name that is used to identify a party involved in -- the routing of a payment. , routingIdsAndExplicDetails_routingAddress :: Maybe Address -- ^ A physical postal address via which a payment can be -- routed. , routingIdsAndExplicDetails_routingAccountNumber :: Maybe Xsd.XsdString -- ^ An account number via which a payment can be routed. , routingIdsAndExplicDetails_routingReferenceText :: [Xsd.XsdString] -- ^ A piece of free-format text used to assist the -- identification of a party involved in the routing of a -- payment. } deriving (Eq,Show) instance SchemaType RoutingIdsAndExplicitDetails where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return RoutingIdsAndExplicitDetails `apply` many (parseSchemaType "routingIds") `apply` optional (parseSchemaType "routingName") `apply` optional (parseSchemaType "routingAddress") `apply` optional (parseSchemaType "routingAccountNumber") `apply` many (parseSchemaType "routingReferenceText") schemaTypeToXML s x@RoutingIdsAndExplicitDetails{} = toXMLElement s [] [ concatMap (schemaTypeToXML "routingIds") $ routingIdsAndExplicDetails_routingIds x , maybe [] (schemaTypeToXML "routingName") $ routingIdsAndExplicDetails_routingName x , maybe [] (schemaTypeToXML "routingAddress") $ routingIdsAndExplicDetails_routingAddress x , maybe [] (schemaTypeToXML "routingAccountNumber") $ routingIdsAndExplicDetails_routingAccountNumber x , concatMap (schemaTypeToXML "routingReferenceText") $ routingIdsAndExplicDetails_routingReferenceText x ] -- | A type defining a schedule of rates or amounts in terms of -- an initial value and then a series of step date and value -- pairs. On each step date the rate or amount changes to the -- new step value. The series of step date and value pairs are -- optional. If not specified, this implies that the initial -- value remains unchanged over time. data Schedule = Schedule { schedule_ID :: Maybe Xsd.ID , schedule_initialValue :: Xsd.Decimal -- ^ The initial rate or amount, as the case may be. An initial -- rate of 5% would be represented as 0.05. , schedule_step :: [Step] -- ^ The schedule of step date and value pairs. On each step -- date the associated step value becomes effective A list of -- steps may be ordered in the document by ascending step -- date. An FpML document containing an unordered list of -- steps is still regarded as a conformant document. } deriving (Eq,Show) instance SchemaType Schedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Schedule a0) `apply` parseSchemaType "initialValue" `apply` many (parseSchemaType "step") schemaTypeToXML s x@Schedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ schedule_ID x ] [ schemaTypeToXML "initialValue" $ schedule_initialValue x , concatMap (schemaTypeToXML "step") $ schedule_step x ] -- | Reference to a schedule of rates or amounts. data ScheduleReference = ScheduleReference { schedRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType ScheduleReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (ScheduleReference a0) schemaTypeToXML s x@ScheduleReference{} = toXMLElement s [ toXMLAttribute "href" $ schedRef_href x ] [] instance Extension ScheduleReference Reference where supertype v = Reference_ScheduleReference v -- | A type that represents the choice of methods for settling a -- potential currency payment resulting from a trade: by means -- of a standard settlement instruction, by netting it out -- with other payments, or with an explicit settlement -- instruction. data SettlementInformation = SettlementInformation { settlInfo_choice0 :: (Maybe (OneOf2 StandardSettlementStyleEnum SettlementInstruction)) -- ^ Choice between: -- -- (1) An optional element used to describe how a trade will -- settle. This defines a scheme and is used for -- identifying trades that are identified as settling -- standard and/or flagged for settlement netting. -- -- (2) An explicit specification of how a currency payment is -- to be made, when the payment is not netted and the -- route is other than the recipient's standard settlement -- instruction. } deriving (Eq,Show) instance SchemaType SettlementInformation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return SettlementInformation `apply` optional (oneOf' [ ("StandardSettlementStyleEnum", fmap OneOf2 (parseSchemaType "standardSettlementStyle")) , ("SettlementInstruction", fmap TwoOf2 (parseSchemaType "settlementInstruction")) ]) schemaTypeToXML s x@SettlementInformation{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "standardSettlementStyle") (schemaTypeToXML "settlementInstruction") ) $ settlInfo_choice0 x ] -- | A type that models a complete instruction for settling a -- currency payment, including the settlement method to be -- used, the correspondent bank, any intermediary banks and -- the ultimate beneficary. data SettlementInstruction = SettlementInstruction { settlInstr_settlementMethod :: Maybe SettlementMethod -- ^ The mechanism by which settlement is to be made. The scheme -- of domain values will include standard mechanisms such as -- CLS, Fedwire, Chips ABA, Chips UID, SWIFT, CHAPS and DDA. , settlInstr_correspondentInformation :: Maybe CorrespondentInformation -- ^ The information required to identify the correspondent bank -- that will make delivery of the funds on the paying bank's -- behalf in the country where the payment is to be made , settlInstr_intermediaryInformation :: [IntermediaryInformation] -- ^ Information to identify an intermediary through which -- payment will be made by the correspondent bank to the -- ultimate beneficiary of the funds. , settlInstr_beneficiaryBank :: Maybe Beneficiary -- ^ The bank that acts for the ultimate beneficiary of the -- funds in receiving payments. , settlInstr_beneficiary :: Maybe Beneficiary -- ^ The ultimate beneficiary of the funds. The beneficiary can -- be identified either by an account at the beneficiaryBank -- (qv) or by explicit routingInformation. This element -- provides for the latter. , settlInstr_depositoryPartyReference :: Maybe PartyReference -- ^ Reference to the depository of the settlement. , settlInstr_splitSettlement :: [SplitSettlement] -- ^ The set of individual payments that are to be made when a -- currency payment settling a trade needs to be split between -- a number of ultimate beneficiaries. Each split payment may -- need to have its own routing information. } deriving (Eq,Show) instance SchemaType SettlementInstruction where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return SettlementInstruction `apply` optional (parseSchemaType "settlementMethod") `apply` optional (parseSchemaType "correspondentInformation") `apply` many (parseSchemaType "intermediaryInformation") `apply` optional (parseSchemaType "beneficiaryBank") `apply` optional (parseSchemaType "beneficiary") `apply` optional (parseSchemaType "depositoryPartyReference") `apply` many (parseSchemaType "splitSettlement") schemaTypeToXML s x@SettlementInstruction{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "settlementMethod") $ settlInstr_settlementMethod x , maybe [] (schemaTypeToXML "correspondentInformation") $ settlInstr_correspondentInformation x , concatMap (schemaTypeToXML "intermediaryInformation") $ settlInstr_intermediaryInformation x , maybe [] (schemaTypeToXML "beneficiaryBank") $ settlInstr_beneficiaryBank x , maybe [] (schemaTypeToXML "beneficiary") $ settlInstr_beneficiary x , maybe [] (schemaTypeToXML "depositoryPartyReference") $ settlInstr_depositoryPartyReference x , concatMap (schemaTypeToXML "splitSettlement") $ settlInstr_splitSettlement x ] data SettlementMethod = SettlementMethod Scheme SettlementMethodAttributes deriving (Eq,Show) data SettlementMethodAttributes = SettlementMethodAttributes { settlMethodAttrib_settlementMethodScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType SettlementMethod where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "settlementMethodScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ SettlementMethod v (SettlementMethodAttributes a0) schemaTypeToXML s (SettlementMethod bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "settlementMethodScheme") $ settlMethodAttrib_settlementMethodScheme at ] $ schemaTypeToXML s bt instance Extension SettlementMethod Scheme where supertype (SettlementMethod s _) = s -- | Coding scheme that specifies the settlement price default -- election. data SettlementPriceDefaultElection = SettlementPriceDefaultElection Scheme SettlementPriceDefaultElectionAttributes deriving (Eq,Show) data SettlementPriceDefaultElectionAttributes = SettlementPriceDefaultElectionAttributes { spdea_settlementPriceDefaultElectionScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType SettlementPriceDefaultElection where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "settlementPriceDefaultElectionScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ SettlementPriceDefaultElection v (SettlementPriceDefaultElectionAttributes a0) schemaTypeToXML s (SettlementPriceDefaultElection bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "settlementPriceDefaultElectionScheme") $ spdea_settlementPriceDefaultElectionScheme at ] $ schemaTypeToXML s bt instance Extension SettlementPriceDefaultElection Scheme where supertype (SettlementPriceDefaultElection s _) = s -- | The source from which the settlement price is to be -- obtained, e.g. a Reuters page, Prezzo di Riferimento, etc. data SettlementPriceSource = SettlementPriceSource Scheme SettlementPriceSourceAttributes deriving (Eq,Show) data SettlementPriceSourceAttributes = SettlementPriceSourceAttributes { settlPriceSourceAttrib_settlementPriceSourceScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType SettlementPriceSource where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "settlementPriceSourceScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ SettlementPriceSource v (SettlementPriceSourceAttributes a0) schemaTypeToXML s (SettlementPriceSource bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "settlementPriceSourceScheme") $ settlPriceSourceAttrib_settlementPriceSourceScheme at ] $ schemaTypeToXML s bt instance Extension SettlementPriceSource Scheme where supertype (SettlementPriceSource s _) = s -- | A type describing the method for obtaining a settlement -- rate. data SettlementRateSource = SettlementRateSource { settlRateSource_choice0 :: (Maybe (OneOf2 InformationSource CashSettlementReferenceBanks)) -- ^ Choice between: -- -- (1) The information source where a published or displayed -- market rate will be obtained, e.g. Telerate Page 3750. -- -- (2) A container for a set of reference institutions. These -- reference institutions may be called upon to provide -- rate quotations as part of the method to determine the -- applicable cash settlement amount. If institutions are -- not specified, it is assumed that reference -- institutions will be agreed between the parties on the -- exercise date, or in the case of swap transaction to -- which mandatory early termination is applicable, the -- cash settlement valuation date. } deriving (Eq,Show) instance SchemaType SettlementRateSource where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return SettlementRateSource `apply` optional (oneOf' [ ("InformationSource", fmap OneOf2 (parseSchemaType "informationSource")) , ("CashSettlementReferenceBanks", fmap TwoOf2 (parseSchemaType "cashSettlementReferenceBanks")) ]) schemaTypeToXML s x@SettlementRateSource{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "informationSource") (schemaTypeToXML "cashSettlementReferenceBanks") ) $ settlRateSource_choice0 x ] -- | TBA data SharedAmericanExercise = SharedAmericanExercise { sharedAmericExerc_ID :: Maybe Xsd.ID , sharedAmericExerc_commencementDate :: Maybe AdjustableOrRelativeDate -- ^ The first day of the exercise period for an American style -- option. , sharedAmericExerc_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. , sharedAmericExerc_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. } deriving (Eq,Show) instance SchemaType SharedAmericanExercise where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (SharedAmericanExercise a0) `apply` optional (parseSchemaType "commencementDate") `apply` optional (parseSchemaType "expirationDate") `apply` optional (oneOf' [ ("BusinessCenterTime", fmap OneOf2 (parseSchemaType "latestExerciseTime")) , ("DeterminationMethod", fmap TwoOf2 (parseSchemaType "latestExerciseTimeDetermination")) ]) schemaTypeToXML s x@SharedAmericanExercise{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ sharedAmericExerc_ID x ] [ maybe [] (schemaTypeToXML "commencementDate") $ sharedAmericExerc_commencementDate x , maybe [] (schemaTypeToXML "expirationDate") $ sharedAmericExerc_expirationDate x , maybe [] (foldOneOf2 (schemaTypeToXML "latestExerciseTime") (schemaTypeToXML "latestExerciseTimeDetermination") ) $ sharedAmericExerc_choice2 x ] instance Extension SharedAmericanExercise Exercise where supertype v = Exercise_SharedAmericanExercise v -- | A complex type to specified payments in a simpler fashion -- than the Payment type. This construct should be used from -- the version 4.3 onwards. data SimplePayment = SimplePayment { simplePayment_ID :: Maybe Xsd.ID , simplePayment_payerPartyReference :: Maybe PartyReference -- ^ A reference to the party responsible for making the -- payments defined by this structure. , simplePayment_payerAccountReference :: Maybe AccountReference -- ^ A reference to the account responsible for making the -- payments defined by this structure. , simplePayment_receiverPartyReference :: Maybe PartyReference -- ^ A reference to the party that receives the payments -- corresponding to this structure. , simplePayment_receiverAccountReference :: Maybe AccountReference -- ^ A reference to the account that receives the payments -- corresponding to this structure. , simplePayment_paymentAmount :: Maybe NonNegativeMoney , simplePayment_paymentDate :: Maybe AdjustableOrRelativeDate -- ^ The payment date. This date is subject to adjustment in -- accordance with any applicable business day convention. } deriving (Eq,Show) instance SchemaType SimplePayment where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (SimplePayment a0) `apply` optional (parseSchemaType "payerPartyReference") `apply` optional (parseSchemaType "payerAccountReference") `apply` optional (parseSchemaType "receiverPartyReference") `apply` optional (parseSchemaType "receiverAccountReference") `apply` optional (parseSchemaType "paymentAmount") `apply` optional (parseSchemaType "paymentDate") schemaTypeToXML s x@SimplePayment{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ simplePayment_ID x ] [ maybe [] (schemaTypeToXML "payerPartyReference") $ simplePayment_payerPartyReference x , maybe [] (schemaTypeToXML "payerAccountReference") $ simplePayment_payerAccountReference x , maybe [] (schemaTypeToXML "receiverPartyReference") $ simplePayment_receiverPartyReference x , maybe [] (schemaTypeToXML "receiverAccountReference") $ simplePayment_receiverAccountReference x , maybe [] (schemaTypeToXML "paymentAmount") $ simplePayment_paymentAmount x , maybe [] (schemaTypeToXML "paymentDate") $ simplePayment_paymentDate x ] instance Extension SimplePayment PaymentBase where supertype v = PaymentBase_SimplePayment v -- | A type that supports the division of a gross settlement -- amount into a number of split settlements, each requiring -- its own settlement instruction. data SplitSettlement = SplitSettlement { splitSettlement_amount :: Maybe Money -- ^ One of the monetary amounts in a split settlement payment. , splitSettl_beneficiaryBank :: Maybe Routing -- ^ The bank that acts for the ultimate beneficiary of the -- funds in receiving payments. , splitSettl_beneficiary :: Maybe Routing -- ^ The ultimate beneficiary of the funds. The beneficiary can -- be identified either by an account at the beneficiaryBank -- (qv) or by explicit routingInformation. This element -- provides for the latter. } deriving (Eq,Show) instance SchemaType SplitSettlement where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return SplitSettlement `apply` optional (parseSchemaType "splitSettlementAmount") `apply` optional (parseSchemaType "beneficiaryBank") `apply` optional (parseSchemaType "beneficiary") schemaTypeToXML s x@SplitSettlement{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "splitSettlementAmount") $ splitSettlement_amount x , maybe [] (schemaTypeToXML "beneficiaryBank") $ splitSettl_beneficiaryBank x , maybe [] (schemaTypeToXML "beneficiary") $ splitSettl_beneficiary x ] -- | Adds an optional spread type element to the Schedule to -- identify a long or short spread value. data SpreadSchedule = SpreadSchedule { spreadSched_ID :: Maybe Xsd.ID , spreadSched_initialValue :: Xsd.Decimal -- ^ The initial rate or amount, as the case may be. An initial -- rate of 5% would be represented as 0.05. , spreadSched_step :: [Step] -- ^ The schedule of step date and value pairs. On each step -- date the associated step value becomes effective A list of -- steps may be ordered in the document by ascending step -- date. An FpML document containing an unordered list of -- steps is still regarded as a conformant document. , spreadSched_type :: Maybe SpreadScheduleType } deriving (Eq,Show) instance SchemaType SpreadSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (SpreadSchedule a0) `apply` parseSchemaType "initialValue" `apply` many (parseSchemaType "step") `apply` optional (parseSchemaType "type") schemaTypeToXML s x@SpreadSchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ spreadSched_ID x ] [ schemaTypeToXML "initialValue" $ spreadSched_initialValue x , concatMap (schemaTypeToXML "step") $ spreadSched_step x , maybe [] (schemaTypeToXML "type") $ spreadSched_type x ] instance Extension SpreadSchedule Schedule where supertype (SpreadSchedule a0 e0 e1 e2) = Schedule a0 e0 e1 -- | Provides a reference to a spread schedule. data SpreadScheduleReference = SpreadScheduleReference { spreadSchedRef_href :: Xsd.IDREF } deriving (Eq,Show) instance SchemaType SpreadScheduleReference where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- getAttribute "href" e pos commit $ interior e $ return (SpreadScheduleReference a0) schemaTypeToXML s x@SpreadScheduleReference{} = toXMLElement s [ toXMLAttribute "href" $ spreadSchedRef_href x ] [] instance Extension SpreadScheduleReference Reference where supertype v = Reference_SpreadScheduleReference v -- | Defines a Spread Type Scheme to identify a long or short -- spread value. data SpreadScheduleType = SpreadScheduleType Scheme SpreadScheduleTypeAttributes deriving (Eq,Show) data SpreadScheduleTypeAttributes = SpreadScheduleTypeAttributes { spreadSchedTypeAttrib_spreadScheduleTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType SpreadScheduleType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "spreadScheduleTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ SpreadScheduleType v (SpreadScheduleTypeAttributes a0) schemaTypeToXML s (SpreadScheduleType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "spreadScheduleTypeScheme") $ spreadSchedTypeAttrib_spreadScheduleTypeScheme at ] $ schemaTypeToXML s bt instance Extension SpreadScheduleType Scheme where supertype (SpreadScheduleType s _) = s -- | A type defining a step date and step value pair. This step -- definitions are used to define varying rate or amount -- schedules, e.g. a notional amortization or a step-up coupon -- schedule. data Step = Step { step_ID :: Maybe Xsd.ID , step_date :: Maybe Xsd.Date -- ^ The date on which the associated stepValue becomes -- effective. This day may be subject to adjustment in -- accordance with a business day convention. , step_value :: Maybe Xsd.Decimal -- ^ The rate or amount which becomes effective on the -- associated stepDate. A rate of 5% would be represented as -- 0.05. } deriving (Eq,Show) instance SchemaType Step where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Step a0) `apply` optional (parseSchemaType "stepDate") `apply` optional (parseSchemaType "stepValue") schemaTypeToXML s x@Step{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ step_ID x ] [ maybe [] (schemaTypeToXML "stepDate") $ step_date x , maybe [] (schemaTypeToXML "stepValue") $ step_value x ] instance Extension Step StepBase where supertype v = StepBase_Step v -- | A type defining a step date and step value pair. This step -- definitions are used to define varying rate or amount -- schedules, e.g. a notional amortization or a step-up coupon -- schedule. data StepBase = StepBase_Step Step | StepBase_PositiveStep PositiveStep | StepBase_NonNegativeStep NonNegativeStep deriving (Eq,Show) instance SchemaType StepBase where parseSchemaType s = do (fmap StepBase_Step $ parseSchemaType s) `onFail` (fmap StepBase_PositiveStep $ parseSchemaType s) `onFail` (fmap StepBase_NonNegativeStep $ parseSchemaType s) `onFail` fail "Parse failed when expecting an extension type of StepBase,\n\ \ namely one of:\n\ \Step,PositiveStep,NonNegativeStep" schemaTypeToXML _s (StepBase_Step x) = schemaTypeToXML "step" x schemaTypeToXML _s (StepBase_PositiveStep x) = schemaTypeToXML "positiveStep" x schemaTypeToXML _s (StepBase_NonNegativeStep x) = schemaTypeToXML "nonNegativeStep" x -- | A type that describes the set of street and building number -- information that identifies a postal address within a city. data StreetAddress = StreetAddress { streetAddress_streetLine :: [Xsd.XsdString] -- ^ An individual line of street and building number -- information, forming part of a postal address. } deriving (Eq,Show) instance SchemaType StreetAddress where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return StreetAddress `apply` many (parseSchemaType "streetLine") schemaTypeToXML s x@StreetAddress{} = toXMLElement s [] [ concatMap (schemaTypeToXML "streetLine") $ streetAddress_streetLine x ] -- | A type describing a single cap or floor rate. data Strike = Strike { strike_ID :: Maybe Xsd.ID , strike_rate :: Maybe Xsd.Decimal -- ^ The rate for a cap or floor. , strike_buyer :: Maybe IdentifiedPayerReceiver -- ^ The buyer of the option , strike_seller :: Maybe IdentifiedPayerReceiver -- ^ The party that has sold. } deriving (Eq,Show) instance SchemaType Strike where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (Strike a0) `apply` optional (parseSchemaType "strikeRate") `apply` optional (parseSchemaType "buyer") `apply` optional (parseSchemaType "seller") schemaTypeToXML s x@Strike{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ strike_ID x ] [ maybe [] (schemaTypeToXML "strikeRate") $ strike_rate x , maybe [] (schemaTypeToXML "buyer") $ strike_buyer x , maybe [] (schemaTypeToXML "seller") $ strike_seller x ] -- | A type describing a schedule of cap or floor rates. data StrikeSchedule = StrikeSchedule { strikeSched_ID :: Maybe Xsd.ID , strikeSched_initialValue :: Xsd.Decimal -- ^ The initial rate or amount, as the case may be. An initial -- rate of 5% would be represented as 0.05. , strikeSched_step :: [Step] -- ^ The schedule of step date and value pairs. On each step -- date the associated step value becomes effective A list of -- steps may be ordered in the document by ascending step -- date. An FpML document containing an unordered list of -- steps is still regarded as a conformant document. , strikeSched_buyer :: Maybe IdentifiedPayerReceiver -- ^ The buyer of the option , strikeSched_seller :: Maybe IdentifiedPayerReceiver -- ^ The party that has sold. } deriving (Eq,Show) instance SchemaType StrikeSchedule where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (StrikeSchedule a0) `apply` parseSchemaType "initialValue" `apply` many (parseSchemaType "step") `apply` optional (parseSchemaType "buyer") `apply` optional (parseSchemaType "seller") schemaTypeToXML s x@StrikeSchedule{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ strikeSched_ID x ] [ schemaTypeToXML "initialValue" $ strikeSched_initialValue x , concatMap (schemaTypeToXML "step") $ strikeSched_step x , maybe [] (schemaTypeToXML "buyer") $ strikeSched_buyer x , maybe [] (schemaTypeToXML "seller") $ strikeSched_seller x ] instance Extension StrikeSchedule Schedule where supertype (StrikeSchedule a0 e0 e1 e2 e3) = Schedule a0 e0 e1 -- | A type defining how a stub calculation period amount is -- calculated and the start and end date of the stub. A single -- floating rate tenor different to that used for the regular -- part of the calculation periods schedule may be specified, -- or two floating rate tenors many be specified. If two -- floating rate tenors are specified then Linear -- Interpolation (in accordance with the 2000 ISDA -- Definitions, Section 8.3 Interpolation) is assumed to -- apply. Alternatively, an actual known stub rate or stub -- amount may be specified. data Stub = Stub { stub_choice0 :: (Maybe (OneOf3 [FloatingRate] Xsd.Decimal Money)) -- ^ Choice between: -- -- (1) The rates to be applied to the initial or final stub -- may be the linear interpolation of two different rates. -- While the majority of the time, the rate indices will -- be the same as that specified in the stream and only -- the tenor itself will be different, it is possible to -- specift two different rates. For example, a 2 month -- stub period may use the linear interpolation of a 1 -- month and 3 month rate. The different rates would be -- specified in this component. Note that a maximum of two -- rates can be specified. If a stub period uses the same -- floating rate index, including tenor, as the regular -- calculation periods then this should not be specified -- again within this component, i.e. the stub calculation -- period amount component may not need to be specified -- even if there is an initial or final stub period. If a -- stub period uses a different floating rate index -- compared to the regular calculation periods then this -- should be specified within this component. If specified -- here, they are likely to have id attributes, allowing -- them to be referenced from within the cashflows -- component. -- -- (2) An actual rate to apply for the initial or final stub -- period may have been agreed between the principal -- parties (in a similar way to how an initial rate may -- have been agreed for the first regular period). If an -- actual stub rate has been agreed then it would be -- included in this component. It will be a per annum -- rate, expressed as a decimal. A stub rate of 5% would -- be represented as 0.05. -- -- (3) An actual amount to apply for the initial or final stub -- period may have been agreed between th two parties. If -- an actual stub amount has been agreed then it would be -- included in this component. , stub_startDate :: Maybe AdjustableOrRelativeDate -- ^ Start date of stub period. This was created to support use -- of the InterestRateStream within the Equity Derivative -- sphere, and this element is not expected to be produced in -- the representation of Interest Rate products. , stub_endDate :: Maybe AdjustableOrRelativeDate -- ^ End date of stub period. This was created to support use of -- the InterestRateStream within the Equity Derivative sphere, -- and this element is not expected to be produced in the -- representation of Interest Rate products. } deriving (Eq,Show) instance SchemaType Stub where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return Stub `apply` optional (oneOf' [ ("[FloatingRate]", fmap OneOf3 (between (Occurs (Just 1) (Just 2)) (parseSchemaType "floatingRate"))) , ("Xsd.Decimal", fmap TwoOf3 (parseSchemaType "stubRate")) , ("Money", fmap ThreeOf3 (parseSchemaType "stubAmount")) ]) `apply` optional (parseSchemaType "stubStartDate") `apply` optional (parseSchemaType "stubEndDate") schemaTypeToXML s x@Stub{} = toXMLElement s [] [ maybe [] (foldOneOf3 (concatMap (schemaTypeToXML "floatingRate")) (schemaTypeToXML "stubRate") (schemaTypeToXML "stubAmount") ) $ stub_choice0 x , maybe [] (schemaTypeToXML "stubStartDate") $ stub_startDate x , maybe [] (schemaTypeToXML "stubEndDate") $ stub_endDate x ] instance Extension Stub StubValue where supertype (Stub e0 e1 e2) = StubValue e0 -- | A type defining how a stub calculation period amount is -- calculated. A single floating rate tenor different to that -- used for the regular part of the calculation periods -- schedule may be specified, or two floating rate tenors many -- be specified. If two floating rate tenors are specified -- then Linear Interpolation (in accordance with the 2000 ISDA -- Definitions, Section 8.3 Interpolation) is assumed to -- apply. Alternatively, an actual known stub rate or stub -- amount may be specified. data StubValue = StubValue { stubValue_choice0 :: (Maybe (OneOf3 [FloatingRate] Xsd.Decimal Money)) -- ^ Choice between: -- -- (1) The rates to be applied to the initial or final stub -- may be the linear interpolation of two different rates. -- While the majority of the time, the rate indices will -- be the same as that specified in the stream and only -- the tenor itself will be different, it is possible to -- specift two different rates. For example, a 2 month -- stub period may use the linear interpolation of a 1 -- month and 3 month rate. The different rates would be -- specified in this component. Note that a maximum of two -- rates can be specified. If a stub period uses the same -- floating rate index, including tenor, as the regular -- calculation periods then this should not be specified -- again within this component, i.e. the stub calculation -- period amount component may not need to be specified -- even if there is an initial or final stub period. If a -- stub period uses a different floating rate index -- compared to the regular calculation periods then this -- should be specified within this component. If specified -- here, they are likely to have id attributes, allowing -- them to be referenced from within the cashflows -- component. -- -- (2) An actual rate to apply for the initial or final stub -- period may have been agreed between the principal -- parties (in a similar way to how an initial rate may -- have been agreed for the first regular period). If an -- actual stub rate has been agreed then it would be -- included in this component. It will be a per annum -- rate, expressed as a decimal. A stub rate of 5% would -- be represented as 0.05. -- -- (3) An actual amount to apply for the initial or final stub -- period may have been agreed between th two parties. If -- an actual stub amount has been agreed then it would be -- included in this component. } deriving (Eq,Show) instance SchemaType StubValue where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return StubValue `apply` optional (oneOf' [ ("[FloatingRate]", fmap OneOf3 (between (Occurs (Just 1) (Just 2)) (parseSchemaType "floatingRate"))) , ("Xsd.Decimal", fmap TwoOf3 (parseSchemaType "stubRate")) , ("Money", fmap ThreeOf3 (parseSchemaType "stubAmount")) ]) schemaTypeToXML s x@StubValue{} = toXMLElement s [] [ maybe [] (foldOneOf3 (concatMap (schemaTypeToXML "floatingRate")) (schemaTypeToXML "stubRate") (schemaTypeToXML "stubAmount") ) $ stubValue_choice0 x ] -- | A geophraphic location for the purposes of defining a -- prevailing time according to the tz database. data TimezoneLocation = TimezoneLocation Scheme TimezoneLocationAttributes deriving (Eq,Show) data TimezoneLocationAttributes = TimezoneLocationAttributes { timezLocatAttrib_timezoneLocationScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType TimezoneLocation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "timezoneLocationScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ TimezoneLocation v (TimezoneLocationAttributes a0) schemaTypeToXML s (TimezoneLocation bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "timezoneLocationScheme") $ timezLocatAttrib_timezoneLocationScheme at ] $ schemaTypeToXML s bt instance Extension TimezoneLocation Scheme where supertype (TimezoneLocation s _) = s -- | The parameters for defining the exercise period for an -- American style option together with any rules governing the -- notional amount of the underlying which can be exercised on -- any given exercise date and any associated exercise fees. elementAmericanExercise :: XMLParser AmericanExercise elementAmericanExercise = parseSchemaType "americanExercise" elementToXMLAmericanExercise :: AmericanExercise -> [Content ()] elementToXMLAmericanExercise = schemaTypeToXML "americanExercise" -- | The parameters for defining the exercise period for a -- Bermuda style option together with any rules governing the -- notional amount of the underlying which can be exercised on -- any given exercise date and any associated exercise fees. elementBermudaExercise :: XMLParser BermudaExercise elementBermudaExercise = parseSchemaType "bermudaExercise" elementToXMLBermudaExercise :: BermudaExercise -> [Content ()] elementToXMLBermudaExercise = schemaTypeToXML "bermudaExercise" -- | The parameters for defining the exercise period for a -- European style option together with any rules governing the -- notional amount of the underlying which can be exercised on -- any given exercise date and any associated exercise fees. elementEuropeanExercise :: XMLParser EuropeanExercise elementEuropeanExercise = parseSchemaType "europeanExercise" elementToXMLEuropeanExercise :: EuropeanExercise -> [Content ()] elementToXMLEuropeanExercise = schemaTypeToXML "europeanExercise" -- | An placeholder for the actual option exercise definitions. elementExercise :: XMLParser Exercise elementExercise = fmap supertype elementEuropeanExercise `onFail` fmap supertype elementBermudaExercise `onFail` fmap supertype elementAmericanExercise `onFail` fail "Parse failed when expecting an element in the substitution group for\n\ \ ,\n\ \ namely one of:\n\ \, , " elementToXMLExercise :: Exercise -> [Content ()] elementToXMLExercise = schemaTypeToXML "exercise" -- | An abstract element used as a place holder for the -- substituting product elements. elementProduct :: XMLParser Product elementProduct = fmap supertype elementStandardProduct -- FIXME: element is forward-declared `onFail` fmap supertype elementSwaption -- FIXME: element is forward-declared `onFail` fmap supertype elementSwap -- FIXME: element is forward-declared `onFail` fmap supertype elementFra -- FIXME: element is forward-declared `onFail` fmap supertype elementCapFloor -- FIXME: element is forward-declared `onFail` fmap supertype elementBulletPayment -- FIXME: element is forward-declared `onFail` fmap supertype elementNonSchemaProduct -- FIXME: element is forward-declared `onFail` fmap supertype elementGenericProduct -- FIXME: element is forward-declared `onFail` fmap supertype elementTermDeposit -- FIXME: element is forward-declared `onFail` fmap supertype elementFxDigitalOption -- FIXME: element is forward-declared `onFail` fmap supertype elementFxOption -- FIXME: element is forward-declared `onFail` fmap supertype elementFxSwap -- FIXME: element is forward-declared `onFail` fmap supertype elementFxSingleLeg -- FIXME: element is forward-declared `onFail` fmap supertype elementReturnSwap -- FIXME: element is forward-declared `onFail` fmap supertype elementStrategy -- FIXME: element is forward-declared `onFail` fmap supertype elementInstrumentTradeDetails -- FIXME: element is forward-declared `onFail` fmap supertype elementDividendSwapTransactionSupplement -- FIXME: element is forward-declared `onFail` fmap supertype elementCorrelationSwap -- FIXME: element is forward-declared `onFail` fmap supertype elementCommoditySwaption -- FIXME: element is forward-declared `onFail` fmap supertype elementCommoditySwap -- FIXME: element is forward-declared `onFail` fmap supertype elementCommodityOption -- FIXME: element is forward-declared `onFail` fmap supertype elementCommodityForward -- FIXME: element is forward-declared `onFail` fmap supertype elementCreditDefaultSwapOption -- FIXME: element is forward-declared `onFail` fmap supertype elementCreditDefaultSwap -- FIXME: element is forward-declared `onFail` fmap supertype elementBondOption -- FIXME: element is forward-declared `onFail` fmap supertype elementEquitySwapTransactionSupplement -- FIXME: element is forward-declared `onFail` fmap supertype elementEquityOptionTransactionSupplement -- FIXME: element is forward-declared `onFail` fmap supertype elementEquityOption -- FIXME: element is forward-declared `onFail` fmap supertype elementEquityForward -- FIXME: element is forward-declared `onFail` fmap supertype elementBrokerEquityOption -- FIXME: element is forward-declared `onFail` fmap supertype elementVarianceSwapTransactionSupplement -- FIXME: element is forward-declared `onFail` fmap supertype elementVarianceSwap -- FIXME: element is forward-declared `onFail` fmap supertype elementVarianceOptionTransactionSupplement -- FIXME: element is forward-declared `onFail` fail "Parse failed when expecting an element in the substitution group for\n\ \ ,\n\ \ namely one of:\n\ \, , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , " elementToXMLProduct :: Product -> [Content ()] elementToXMLProduct = schemaTypeToXML "product" -- | A code that describes what type of role an organization -- plays, for example a SwapsDealer, a Major Swaps -- Participant, or Other data OrganizationType = OrganizationType Xsd.Token OrganizationTypeAttributes deriving (Eq,Show) data OrganizationTypeAttributes = OrganizationTypeAttributes { organTypeAttrib_organizationTypeScheme :: Maybe Xsd.AnyURI } deriving (Eq,Show) instance SchemaType OrganizationType where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ do a0 <- optional $ getAttribute "organizationTypeScheme" e pos reparse [CElem e pos] v <- parseSchemaType s return $ OrganizationType v (OrganizationTypeAttributes a0) schemaTypeToXML s (OrganizationType bt at) = addXMLAttributes [ maybe [] (toXMLAttribute "organizationTypeScheme") $ organTypeAttrib_organizationTypeScheme at ] $ schemaTypeToXML s bt instance Extension OrganizationType Xsd.Token where supertype (OrganizationType s _) = s