{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} module Data.FpML.V53.Option.Bond ( module Data.FpML.V53.Option.Bond , module Data.FpML.V53.Shared.Option ) where import Text.XML.HaXml.Schema.Schema (SchemaType(..),SimpleType(..),Extension(..),Restricts(..)) import Text.XML.HaXml.Schema.Schema as Schema import Text.XML.HaXml.OneOfN import qualified Text.XML.HaXml.Schema.PrimitiveTypes as Xsd import Data.FpML.V53.Shared.Option -- Some hs-boot imports are required, for fwd-declaring types. -- | A Bond Option data BondOption = BondOption { bondOption_ID :: Maybe Xsd.ID , bondOption_primaryAssetClass :: Maybe AssetClass -- ^ A classification of the most important risk class of the -- trade. FpML defines a simple asset class categorization -- using a coding scheme. , bondOption_secondaryAssetClass :: [AssetClass] -- ^ A classification of additional risk classes of the trade, -- if any. FpML defines a simple asset class categorization -- using a coding scheme. , bondOption_productType :: [ProductType] -- ^ A classification of the type of product. FpML defines a -- simple product categorization using a coding scheme. , bondOption_productId :: [ProductId] -- ^ A product reference identifier. The product ID is an -- identifier that describes the key economic characteristics -- of the trade type, with the exception of concepts such as -- size (notional, quantity, number of units) and price (fixed -- rate, strike, etc.) that are negotiated for each -- transaction. It can be used to hold identifiers such as the -- "UPI" (universal product identifier) required by certain -- regulatory reporting rules. It can also be used to hold -- identifiers of benchmark products or product temnplates -- used by certain trading systems or facilities. FpML does -- not define the domain values associated with this element. -- Note that the domain values for this element are not -- strictly an enumerated list. , bondOption_buyerPartyReference :: Maybe PartyReference -- ^ A reference to the party that buys this instrument, ie. -- pays for this instrument and receives the rights defined by -- it. See 2000 ISDA definitions Article 11.1 (b). In the case -- of FRAs this the fixed rate payer. , bondOption_buyerAccountReference :: Maybe AccountReference -- ^ A reference to the account that buys this instrument. , bondOption_sellerPartyReference :: Maybe PartyReference -- ^ A reference to the party that sells ("writes") this -- instrument, i.e. that grants the rights defined by this -- instrument and in return receives a payment for it. See -- 2000 ISDA definitions Article 11.1 (a). In the case of FRAs -- this is the floating rate payer. , bondOption_sellerAccountReference :: Maybe AccountReference -- ^ A reference to the account that sells this instrument. , bondOption_optionType :: OptionTypeEnum -- ^ The type of option transaction. From a usage standpoint, -- put/call is the default option type, while payer/receiver -- indicator is used for options index credit default swaps, -- consistently with the industry practice. Straddle is used -- for the case of straddle strategy, that combine a call and -- a put with the same strike. , bondOption_premium :: Premium -- ^ The option premium payable by the buyer to the seller. , bondOption_exercise :: Exercise -- ^ An placeholder for the actual option exercise definitions. , bondOption_exerciseProcedure :: Maybe ExerciseProcedure -- ^ A set of parameters defining procedures associated with the -- exercise. , bondOption_feature :: Maybe OptionFeature -- ^ An Option feature such as quanto, asian, barrier, knock. , bondOption_choice13 :: (Maybe (OneOf2 NotionalAmountReference Money)) -- ^ A choice between an explicit representation of the notional -- amount, or a reference to a notional amount defined -- elsewhere in this document. -- -- Choice between: -- -- (1) notionalReference -- -- (2) notionalAmount , bondOption_optionEntitlement :: Maybe PositiveDecimal -- ^ The number of units of underlyer per option comprised in -- the option transaction. , bondOption_entitlementCurrency :: Maybe Currency -- ^ TODO , bondOption_numberOfOptions :: Maybe PositiveDecimal -- ^ The number of options comprised in the option transaction. , bondOption_settlementType :: Maybe SettlementTypeEnum , bondOption_settlementDate :: Maybe AdjustableOrRelativeDate , bondOption_choice19 :: (Maybe (OneOf2 Money Currency)) -- ^ Choice between: -- -- (1) Settlement Amount -- -- (2) Settlement Currency for use where the Settlement Amount -- cannot be known in advance , bondOption_strike :: BondOptionStrike -- ^ Strike of the the Bond Option. , bondOption_choice21 :: OneOf2 Bond ConvertibleBond -- ^ Choice between: -- -- (1) Identifies the underlying asset when it is a series or -- a class of bonds. -- -- (2) Identifies the underlying asset when it is a -- convertible bond. } deriving (Eq,Show) instance SchemaType BondOption where parseSchemaType s = do (pos,e) <- posnElement [s] a0 <- optional $ getAttribute "id" e pos commit $ interior e $ return (BondOption a0) `apply` optional (parseSchemaType "primaryAssetClass") `apply` many (parseSchemaType "secondaryAssetClass") `apply` many (parseSchemaType "productType") `apply` many (parseSchemaType "productId") `apply` optional (parseSchemaType "buyerPartyReference") `apply` optional (parseSchemaType "buyerAccountReference") `apply` optional (parseSchemaType "sellerPartyReference") `apply` optional (parseSchemaType "sellerAccountReference") `apply` parseSchemaType "optionType" `apply` parseSchemaType "premium" `apply` elementExercise `apply` optional (parseSchemaType "exerciseProcedure") `apply` optional (parseSchemaType "feature") `apply` optional (oneOf' [ ("NotionalAmountReference", fmap OneOf2 (parseSchemaType "notionalReference")) , ("Money", fmap TwoOf2 (parseSchemaType "notionalAmount")) ]) `apply` optional (parseSchemaType "optionEntitlement") `apply` optional (parseSchemaType "entitlementCurrency") `apply` optional (parseSchemaType "numberOfOptions") `apply` optional (parseSchemaType "settlementType") `apply` optional (parseSchemaType "settlementDate") `apply` optional (oneOf' [ ("Money", fmap OneOf2 (parseSchemaType "settlementAmount")) , ("Currency", fmap TwoOf2 (parseSchemaType "settlementCurrency")) ]) `apply` parseSchemaType "strike" `apply` oneOf' [ ("Bond", fmap OneOf2 (elementBond)) , ("ConvertibleBond", fmap TwoOf2 (elementConvertibleBond)) ] schemaTypeToXML s x@BondOption{} = toXMLElement s [ maybe [] (toXMLAttribute "id") $ bondOption_ID x ] [ maybe [] (schemaTypeToXML "primaryAssetClass") $ bondOption_primaryAssetClass x , concatMap (schemaTypeToXML "secondaryAssetClass") $ bondOption_secondaryAssetClass x , concatMap (schemaTypeToXML "productType") $ bondOption_productType x , concatMap (schemaTypeToXML "productId") $ bondOption_productId x , maybe [] (schemaTypeToXML "buyerPartyReference") $ bondOption_buyerPartyReference x , maybe [] (schemaTypeToXML "buyerAccountReference") $ bondOption_buyerAccountReference x , maybe [] (schemaTypeToXML "sellerPartyReference") $ bondOption_sellerPartyReference x , maybe [] (schemaTypeToXML "sellerAccountReference") $ bondOption_sellerAccountReference x , schemaTypeToXML "optionType" $ bondOption_optionType x , schemaTypeToXML "premium" $ bondOption_premium x , elementToXMLExercise $ bondOption_exercise x , maybe [] (schemaTypeToXML "exerciseProcedure") $ bondOption_exerciseProcedure x , maybe [] (schemaTypeToXML "feature") $ bondOption_feature x , maybe [] (foldOneOf2 (schemaTypeToXML "notionalReference") (schemaTypeToXML "notionalAmount") ) $ bondOption_choice13 x , maybe [] (schemaTypeToXML "optionEntitlement") $ bondOption_optionEntitlement x , maybe [] (schemaTypeToXML "entitlementCurrency") $ bondOption_entitlementCurrency x , maybe [] (schemaTypeToXML "numberOfOptions") $ bondOption_numberOfOptions x , maybe [] (schemaTypeToXML "settlementType") $ bondOption_settlementType x , maybe [] (schemaTypeToXML "settlementDate") $ bondOption_settlementDate x , maybe [] (foldOneOf2 (schemaTypeToXML "settlementAmount") (schemaTypeToXML "settlementCurrency") ) $ bondOption_choice19 x , schemaTypeToXML "strike" $ bondOption_strike x , foldOneOf2 (elementToXMLBond) (elementToXMLConvertibleBond) $ bondOption_choice21 x ] instance Extension BondOption OptionBaseExtended where supertype v = OptionBaseExtended_BondOption v instance Extension BondOption OptionBase where supertype = (supertype :: OptionBaseExtended -> OptionBase) . (supertype :: BondOption -> OptionBaseExtended) instance Extension BondOption Option where supertype = (supertype :: OptionBase -> Option) . (supertype :: OptionBaseExtended -> OptionBase) . (supertype :: BondOption -> OptionBaseExtended) instance Extension BondOption Product where supertype = (supertype :: Option -> Product) . (supertype :: OptionBase -> Option) . (supertype :: OptionBaseExtended -> OptionBase) . (supertype :: BondOption -> OptionBaseExtended) -- | A complex type to specify the strike of a bond or -- convertible bond option. data BondOptionStrike = BondOptionStrike { bondOptionStrike_choice0 :: (Maybe (OneOf2 ReferenceSwapCurve OptionStrike)) -- ^ Choice between: -- -- (1) The strike of an option when expressed by reference to -- a swap curve. (Typically the case for a convertible -- bond option.) -- -- (2) price } deriving (Eq,Show) instance SchemaType BondOptionStrike where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return BondOptionStrike `apply` optional (oneOf' [ ("ReferenceSwapCurve", fmap OneOf2 (parseSchemaType "referenceSwapCurve")) , ("OptionStrike", fmap TwoOf2 (parseSchemaType "price")) ]) schemaTypeToXML s x@BondOptionStrike{} = toXMLElement s [] [ maybe [] (foldOneOf2 (schemaTypeToXML "referenceSwapCurve") (schemaTypeToXML "price") ) $ bondOptionStrike_choice0 x ] -- | A complex type to specify the amount to be paid by the -- buyer of the option if the option is exercised prior to the -- Early Call Date (Typically applicable to the convertible -- bond options). data MakeWholeAmount = MakeWholeAmount { makeWholeAmount_floatingRateIndex :: FloatingRateIndex , makeWholeAmount_indexTenor :: Maybe Period -- ^ The ISDA Designated Maturity, i.e. the tenor of the -- floating rate. , makeWholeAmount_spread :: Maybe Xsd.Decimal -- ^ Spread in basis points over the floating rate index. , makeWholeAmount_side :: Maybe QuotationSideEnum -- ^ The side (bid/mid/ask) of the measure. , makeWholeAmount_interpolationMethod :: Maybe InterpolationMethod -- ^ The type of interpolation method that the calculation agent -- reserves the right to use. , makeWholeAmount_earlyCallDate :: Maybe IdentifiedDate -- ^ Date prior to which the option buyer will have to pay a -- Make Whole Amount to the option seller if he/she exercises -- the option. } deriving (Eq,Show) instance SchemaType MakeWholeAmount where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return MakeWholeAmount `apply` parseSchemaType "floatingRateIndex" `apply` optional (parseSchemaType "indexTenor") `apply` optional (parseSchemaType "spread") `apply` optional (parseSchemaType "side") `apply` optional (parseSchemaType "interpolationMethod") `apply` optional (parseSchemaType "earlyCallDate") schemaTypeToXML s x@MakeWholeAmount{} = toXMLElement s [] [ schemaTypeToXML "floatingRateIndex" $ makeWholeAmount_floatingRateIndex x , maybe [] (schemaTypeToXML "indexTenor") $ makeWholeAmount_indexTenor x , maybe [] (schemaTypeToXML "spread") $ makeWholeAmount_spread x , maybe [] (schemaTypeToXML "side") $ makeWholeAmount_side x , maybe [] (schemaTypeToXML "interpolationMethod") $ makeWholeAmount_interpolationMethod x , maybe [] (schemaTypeToXML "earlyCallDate") $ makeWholeAmount_earlyCallDate x ] instance Extension MakeWholeAmount SwapCurveValuation where supertype (MakeWholeAmount e0 e1 e2 e3 e4 e5) = SwapCurveValuation e0 e1 e2 e3 -- | A complex type used to specify the option and convertible -- bond option strike when expressed in reference to a swap -- curve. data ReferenceSwapCurve = ReferenceSwapCurve { refSwapCurve_swapUnwindValue :: Maybe SwapCurveValuation , refSwapCurve_makeWholeAmount :: Maybe MakeWholeAmount -- ^ Amount to be paid by the buyer of the option if the option -- is exercised prior to the Early Call Date. (The market -- practice in the convertible bond option space being that -- the buyer should be penalized if he/she exercises the -- option early on.) } deriving (Eq,Show) instance SchemaType ReferenceSwapCurve where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return ReferenceSwapCurve `apply` optional (parseSchemaType "swapUnwindValue") `apply` optional (parseSchemaType "makeWholeAmount") schemaTypeToXML s x@ReferenceSwapCurve{} = toXMLElement s [] [ maybe [] (schemaTypeToXML "swapUnwindValue") $ refSwapCurve_swapUnwindValue x , maybe [] (schemaTypeToXML "makeWholeAmount") $ refSwapCurve_makeWholeAmount x ] -- | A complex type to specify a valuation swap curve, which is -- used as part of the strike construct for the bond and -- convertible bond options. data SwapCurveValuation = SwapCurveValuation { swapCurveVal_floatingRateIndex :: FloatingRateIndex , swapCurveVal_indexTenor :: Maybe Period -- ^ The ISDA Designated Maturity, i.e. the tenor of the -- floating rate. , swapCurveVal_spread :: Maybe Xsd.Decimal -- ^ Spread in basis points over the floating rate index. , swapCurveVal_side :: Maybe QuotationSideEnum -- ^ The side (bid/mid/ask) of the measure. } deriving (Eq,Show) instance SchemaType SwapCurveValuation where parseSchemaType s = do (pos,e) <- posnElement [s] commit $ interior e $ return SwapCurveValuation `apply` parseSchemaType "floatingRateIndex" `apply` optional (parseSchemaType "indexTenor") `apply` optional (parseSchemaType "spread") `apply` optional (parseSchemaType "side") schemaTypeToXML s x@SwapCurveValuation{} = toXMLElement s [] [ schemaTypeToXML "floatingRateIndex" $ swapCurveVal_floatingRateIndex x , maybe [] (schemaTypeToXML "indexTenor") $ swapCurveVal_indexTenor x , maybe [] (schemaTypeToXML "spread") $ swapCurveVal_spread x , maybe [] (schemaTypeToXML "side") $ swapCurveVal_side x ] -- | A component describing a Bond Option product. elementBondOption :: XMLParser BondOption elementBondOption = parseSchemaType "bondOption" elementToXMLBondOption :: BondOption -> [Content ()] elementToXMLBondOption = schemaTypeToXML "bondOption"