{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Data.FpML.V53.Generic
  ( module Data.FpML.V53.Generic
  , module Data.FpML.V53.Shared
  , module Data.FpML.V53.Asset
  ) 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
import Data.FpML.V53.Asset
 
-- Some hs-boot imports are required, for fwd-declaring types.
 
-- | A product to represent an OTC derivative transaction whose 
--   economics are not fully described using an FpML schema.
elementGenericProduct :: XMLParser GenericProduct
elementGenericProduct = parseSchemaType "genericProduct"
elementToXMLGenericProduct :: GenericProduct -> [Content ()]
elementToXMLGenericProduct = schemaTypeToXML "genericProduct"
 
-- | A product to represent an OTC derivative transaction whose 
--   economics are not fully described using an FpML schema.
elementNonSchemaProduct :: XMLParser GenericProduct
elementNonSchemaProduct = parseSchemaType "nonSchemaProduct"
elementToXMLNonSchemaProduct :: GenericProduct -> [Content ()]
elementToXMLNonSchemaProduct = schemaTypeToXML "nonSchemaProduct"
 
-- | Simple product representation providing key information 
--   about a variety of different products
data GenericProduct = GenericProduct
        { genericProduct_ID :: Maybe Xsd.ID
        , genericProduct_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.
        , genericProduct_secondaryAssetClass :: [AssetClass]
          -- ^ A classification of additional risk classes of the trade, 
          --   if any. FpML defines a simple asset class categorization 
          --   using a coding scheme.
        , genericProduct_productType :: [ProductType]
          -- ^ A classification of the type of product. FpML defines a 
          --   simple product categorization using a coding scheme.
        , genericProduct_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.
        , genericProduct_multiLeg :: Maybe Xsd.Boolean
          -- ^ Indicates whether this transaction has multiple components, 
          --   not all of which may be reported.
        , genericProduct_choice5 :: (Maybe (OneOf2 ((Maybe (PartyReference)),(Maybe (AccountReference)),(Maybe (PartyReference)),(Maybe (AccountReference))) [PartyReference]))
          -- ^ Choice between:
          --   
          --   (1) Sequence of:
          --   
          --     * 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.
          --   
          --     * A reference to the account that buys this 
          --   instrument.
          --   
          --     * 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.
          --   
          --     * A reference to the account that sells this 
          --   instrument.
          --   
          --   (2) counterpartyReference
        , genericProduct_premium :: Maybe SimplePayment
        , genericProduct_effectiveDate :: Maybe AdjustableDate2
          -- ^ The earliest of all the effective dates of all constituent 
          --   streams.
        , genericProduct_expirationDate :: Maybe AdjustableDate2
          -- ^ For options, the last exercise date of the option.
        , genericProduct_terminationDate :: Maybe AdjustableDate2
          -- ^ The latest of all of the termination (accrual end) dates of 
          --   the constituent or underlying streams.
        , genericProduct_underlyer :: [TradeUnderlyer2]
          -- ^ The set of underlyers to the trade that can be used in 
          --   computing the trade's cashflows. If this information is 
          --   needed to identify the trade, all of the trade's underlyers 
          --   should be specified, whether or not they figure into the 
          --   cashflow calculation. Otherwise, only those underlyers used 
          --   to compute this particular cashflow need be supplied.
        , genericProduct_notional :: [CashflowNotional]
          -- ^ The notional or notionals in effect on the last day of the 
          --   last calculation period in each stream.
        , genericProduct_optionType :: Maybe OptionType
          -- ^ For options, what type of option it is (e.g. butterfly).
        , genericProduct_settlementCurrency :: [IdentifiedCurrency]
          -- ^ The currency or currencies in which the product can settle.
        }
        deriving (Eq,Show)
instance SchemaType GenericProduct where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (GenericProduct a0)
            `apply` optional (parseSchemaType "primaryAssetClass")
            `apply` many (parseSchemaType "secondaryAssetClass")
            `apply` many (parseSchemaType "productType")
            `apply` many (parseSchemaType "productId")
            `apply` optional (parseSchemaType "multiLeg")
            `apply` optional (oneOf' [ ("Maybe PartyReference Maybe AccountReference Maybe PartyReference Maybe AccountReference", fmap OneOf2 (return (,,,) `apply` optional (parseSchemaType "buyerPartyReference")
                                                                                                                                                             `apply` optional (parseSchemaType "buyerAccountReference")
                                                                                                                                                             `apply` optional (parseSchemaType "sellerPartyReference")
                                                                                                                                                             `apply` optional (parseSchemaType "sellerAccountReference")))
                                     , ("[PartyReference]", fmap TwoOf2 (between (Occurs (Just 1) (Just 2))
                                                                                 (parseSchemaType "counterpartyReference")))
                                     ])
            `apply` optional (parseSchemaType "premium")
            `apply` optional (parseSchemaType "effectiveDate")
            `apply` optional (parseSchemaType "expirationDate")
            `apply` optional (parseSchemaType "terminationDate")
            `apply` many (parseSchemaType "underlyer")
            `apply` many (parseSchemaType "notional")
            `apply` optional (parseSchemaType "optionType")
            `apply` many (parseSchemaType "settlementCurrency")
    schemaTypeToXML s x@GenericProduct{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ genericProduct_ID x
                       ]
            [ maybe [] (schemaTypeToXML "primaryAssetClass") $ genericProduct_primaryAssetClass x
            , concatMap (schemaTypeToXML "secondaryAssetClass") $ genericProduct_secondaryAssetClass x
            , concatMap (schemaTypeToXML "productType") $ genericProduct_productType x
            , concatMap (schemaTypeToXML "productId") $ genericProduct_productId x
            , maybe [] (schemaTypeToXML "multiLeg") $ genericProduct_multiLeg x
            , maybe [] (foldOneOf2  (\ (a,b,c,d) -> concat [ maybe [] (schemaTypeToXML "buyerPartyReference") a
                                                           , maybe [] (schemaTypeToXML "buyerAccountReference") b
                                                           , maybe [] (schemaTypeToXML "sellerPartyReference") c
                                                           , maybe [] (schemaTypeToXML "sellerAccountReference") d
                                                           ])
                                    (concatMap (schemaTypeToXML "counterpartyReference"))
                                   ) $ genericProduct_choice5 x
            , maybe [] (schemaTypeToXML "premium") $ genericProduct_premium x
            , maybe [] (schemaTypeToXML "effectiveDate") $ genericProduct_effectiveDate x
            , maybe [] (schemaTypeToXML "expirationDate") $ genericProduct_expirationDate x
            , maybe [] (schemaTypeToXML "terminationDate") $ genericProduct_terminationDate x
            , concatMap (schemaTypeToXML "underlyer") $ genericProduct_underlyer x
            , concatMap (schemaTypeToXML "notional") $ genericProduct_notional x
            , maybe [] (schemaTypeToXML "optionType") $ genericProduct_optionType x
            , concatMap (schemaTypeToXML "settlementCurrency") $ genericProduct_settlementCurrency x
            ]
instance Extension GenericProduct Product where
    supertype v = Product_GenericProduct v
 
-- | The underlying asset/index/reference price etc. whose 
--   rate/price may be observed to compute the value of the 
--   cashflow. It can be an index, fixed rate, listed security, 
--   quoted currency pair, or a reference entity (for credit 
--   derivatives).
data TradeUnderlyer2 = TradeUnderlyer2
        { tradeUnderl_ID :: Maybe Xsd.ID
        , tradeUnderl_choice0 :: (Maybe (OneOf5 FloatingRate Schedule Asset QuotedCurrencyPair LegalEntity))
          -- ^ Choice between:
          --   
          --   (1) A floating rate.
          --   
          --   (2) The fixed rate or fixed rate schedule expressed as 
          --   explicit fixed rates and dates. In the case of a 
          --   schedule, the step dates may be subject to adjustment 
          --   in accordance with any adjustments specified in 
          --   calculationPeriodDatesAdjustments.
          --   
          --   (3) Define the underlying asset, either a listed security 
          --   or other instrument.
          --   
          --   (4) Describes the composition of a rate that has been 
          --   quoted. This includes the two currencies and the 
          --   quotation relationship between the two currencies.
          --   
          --   (5) The corporate or sovereign entity on which you are 
          --   buying or selling protection and any successor that 
          --   assumes all or substantially all of its contractual and 
          --   other obligations. It is vital to use the correct legal 
          --   name of the entity and to be careful not to choose a 
          --   subsidiary if you really want to trade protection on a 
          --   parent company. Please note, Reference Entities cannot 
          --   be senior or subordinated. It is the obligations of the 
          --   Reference Entities that can be senior or subordinated. 
          --   ISDA 2003 Term: Reference Entity
        , tradeUnderl_payerPartyReference :: Maybe PartyReference
          -- ^ A reference to the party responsible for making the 
          --   payments defined by this structure.
        , tradeUnderl_payerAccountReference :: Maybe AccountReference
          -- ^ A reference to the account responsible for making the 
          --   payments defined by this structure.
        , tradeUnderl_receiverPartyReference :: Maybe PartyReference
          -- ^ A reference to the party that receives the payments 
          --   corresponding to this structure.
        , tradeUnderl_receiverAccountReference :: Maybe AccountReference
          -- ^ A reference to the account that receives the payments 
          --   corresponding to this structure.
        }
        deriving (Eq,Show)
instance SchemaType TradeUnderlyer2 where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        a0 <- optional $ getAttribute "id" e pos
        commit $ interior e $ return (TradeUnderlyer2 a0)
            `apply` optional (oneOf' [ ("FloatingRate", fmap OneOf5 (parseSchemaType "floatingRate"))
                                     , ("Schedule", fmap TwoOf5 (parseSchemaType "fixedRate"))
                                     , ("Asset", fmap ThreeOf5 (elementUnderlyingAsset))
                                     , ("QuotedCurrencyPair", fmap FourOf5 (parseSchemaType "quotedCurrencyPair"))
                                     , ("LegalEntity", fmap FiveOf5 (parseSchemaType "referenceEntity"))
                                     ])
            `apply` optional (parseSchemaType "payerPartyReference")
            `apply` optional (parseSchemaType "payerAccountReference")
            `apply` optional (parseSchemaType "receiverPartyReference")
            `apply` optional (parseSchemaType "receiverAccountReference")
    schemaTypeToXML s x@TradeUnderlyer2{} =
        toXMLElement s [ maybe [] (toXMLAttribute "id") $ tradeUnderl_ID x
                       ]
            [ maybe [] (foldOneOf5  (schemaTypeToXML "floatingRate")
                                    (schemaTypeToXML "fixedRate")
                                    (elementToXMLUnderlyingAsset)
                                    (schemaTypeToXML "quotedCurrencyPair")
                                    (schemaTypeToXML "referenceEntity")
                                   ) $ tradeUnderl_choice0 x
            , maybe [] (schemaTypeToXML "payerPartyReference") $ tradeUnderl_payerPartyReference x
            , maybe [] (schemaTypeToXML "payerAccountReference") $ tradeUnderl_payerAccountReference x
            , maybe [] (schemaTypeToXML "receiverPartyReference") $ tradeUnderl_receiverPartyReference x
            , maybe [] (schemaTypeToXML "receiverAccountReference") $ tradeUnderl_receiverAccountReference x
            ]
 
-- | A flexible description of the type or characteristics of an 
--   option or strategy, e.g. butterfly, condor, chooser.
data OptionType = OptionType Scheme OptionTypeAttributes deriving (Eq,Show)
data OptionTypeAttributes = OptionTypeAttributes
    { optionTypeAttrib_optionTypeScheme :: Maybe Xsd.AnyURI
      -- ^ The type scheme used with this option type.
    }
    deriving (Eq,Show)
instance SchemaType OptionType where
    parseSchemaType s = do
        (pos,e) <- posnElement [s]
        commit $ do
          a0 <- optional $ getAttribute "optionTypeScheme" e pos
          reparse [CElem e pos]
          v <- parseSchemaType s
          return $ OptionType v (OptionTypeAttributes a0)
    schemaTypeToXML s (OptionType bt at) =
        addXMLAttributes [ maybe [] (toXMLAttribute "optionTypeScheme") $ optionTypeAttrib_optionTypeScheme at
                         ]
            $ schemaTypeToXML s bt
instance Extension OptionType Scheme where
    supertype (OptionType s _) = s