{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RankNTypes, ApplicativeDo #-}

module Q.ContingentClaim where

import Control.Monad.Reader
import Control.Monad.Writer.Strict
import Q.Types
import Data.Time
import qualified Data.Map as M

-- | A cash flow is a time and amount.
data CashFlow = CashFlow {
    CashFlow -> LocalTime
cfTime :: LocalTime -- ^ The cash flow time.
  , CashFlow -> Double
cfAmount :: Double  -- ^ The cash flow amount.
} deriving (Int -> CashFlow -> ShowS
[CashFlow] -> ShowS
CashFlow -> String
(Int -> CashFlow -> ShowS)
-> (CashFlow -> String) -> ([CashFlow] -> ShowS) -> Show CashFlow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CashFlow] -> ShowS
$cshowList :: [CashFlow] -> ShowS
show :: CashFlow -> String
$cshow :: CashFlow -> String
showsPrec :: Int -> CashFlow -> ShowS
$cshowsPrec :: Int -> CashFlow -> ShowS
Show, CashFlow -> CashFlow -> Bool
(CashFlow -> CashFlow -> Bool)
-> (CashFlow -> CashFlow -> Bool) -> Eq CashFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CashFlow -> CashFlow -> Bool
$c/= :: CashFlow -> CashFlow -> Bool
== :: CashFlow -> CashFlow -> Bool
$c== :: CashFlow -> CashFlow -> Bool
Eq)

-- | Stop at time t and potentially apply n payouts up to the monitoring time.
data CCProcessor a = CCProcessor {
    CCProcessor a -> LocalTime
monitorTime :: LocalTime                   -- ^ Stopping time.
  , CCProcessor a -> [Map LocalTime a -> CashFlow]
payouts  :: [M.Map LocalTime a -> CashFlow] -- ^ list of payout functions at the stopping time.
}

-- | A claim contingent on some observable a.
newtype ContingentClaim a = ContingentClaim { ContingentClaim a -> [CCProcessor a]
unCC :: [CCProcessor a] }
-- ^ An example of an observable is a spot driven asset, such as a stock.

instance Monoid (ContingentClaim a) where
  mempty :: ContingentClaim a
mempty  = [CCProcessor a] -> ContingentClaim a
forall a. [CCProcessor a] -> ContingentClaim a
ContingentClaim []

-- | multipley a contingent claim by its notional.
multiplier :: Double -> ContingentClaim a -> ContingentClaim a
multiplier :: Double -> ContingentClaim a -> ContingentClaim a
multiplier Double
notional (ContingentClaim [CCProcessor a]
ccProcessors) = [CCProcessor a] -> ContingentClaim a
forall a. [CCProcessor a] -> ContingentClaim a
ContingentClaim ([CCProcessor a] -> ContingentClaim a)
-> [CCProcessor a] -> ContingentClaim a
forall a b. (a -> b) -> a -> b
$ (CCProcessor a -> CCProcessor a)
-> [CCProcessor a] -> [CCProcessor a]
forall a b. (a -> b) -> [a] -> [b]
map CCProcessor a -> CCProcessor a
forall a. CCProcessor a -> CCProcessor a
scale [CCProcessor a]
ccProcessors where
  scale :: CCProcessor a -> CCProcessor a
scale CCProcessor{ [Map LocalTime a -> CashFlow]
LocalTime
payouts :: [Map LocalTime a -> CashFlow]
monitorTime :: LocalTime
payouts :: forall a. CCProcessor a -> [Map LocalTime a -> CashFlow]
monitorTime :: forall a. CCProcessor a -> LocalTime
.. } = LocalTime -> [Map LocalTime a -> CashFlow] -> CCProcessor a
forall a.
LocalTime -> [Map LocalTime a -> CashFlow] -> CCProcessor a
CCProcessor LocalTime
monitorTime (((Map LocalTime a -> CashFlow) -> Map LocalTime a -> CashFlow)
-> [Map LocalTime a -> CashFlow] -> [Map LocalTime a -> CashFlow]
forall a b. (a -> b) -> [a] -> [b]
map (Map LocalTime a -> CashFlow) -> Map LocalTime a -> CashFlow
forall (f :: * -> *). Functor f => f CashFlow -> f CashFlow
scaledPayout [Map LocalTime a -> CashFlow]
payouts)
  scaledPayout :: f CashFlow -> f CashFlow
scaledPayout f CashFlow
payout = (CashFlow -> CashFlow) -> f CashFlow -> f CashFlow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (CashFlow LocalTime
t Double
v) -> LocalTime -> Double -> CashFlow
CashFlow LocalTime
t (Double
notional Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v)) f CashFlow
payout

-- | Change direction of the portfolio
short :: ContingentClaim a -> ContingentClaim a
short :: ContingentClaim a -> ContingentClaim a
short = Double -> ContingentClaim a -> ContingentClaim a
forall a. Double -> ContingentClaim a -> ContingentClaim a
multiplier (-Double
1)


instance Semigroup (ContingentClaim a) where
  ContingentClaim a
c1 <> :: ContingentClaim a -> ContingentClaim a -> ContingentClaim a
<> ContingentClaim a
c2 = [CCProcessor a] -> ContingentClaim a
forall a. [CCProcessor a] -> ContingentClaim a
ContingentClaim ([CCProcessor a] -> ContingentClaim a)
-> [CCProcessor a] -> ContingentClaim a
forall a b. (a -> b) -> a -> b
$ [CCProcessor a] -> [CCProcessor a] -> [CCProcessor a]
forall a. [CCProcessor a] -> [CCProcessor a] -> [CCProcessor a]
combine (ContingentClaim a -> [CCProcessor a]
forall a. ContingentClaim a -> [CCProcessor a]
unCC ContingentClaim a
c1) (ContingentClaim a -> [CCProcessor a]
forall a. ContingentClaim a -> [CCProcessor a]
unCC ContingentClaim a
c2)
    where combine :: [CCProcessor a] -> [CCProcessor a] -> [CCProcessor a]
combine (CCProcessor a
cc1:[CCProcessor a]
ccs1) (CCProcessor a
cc2:[CCProcessor a]
ccs2)
            | CCProcessor a -> LocalTime
forall a. CCProcessor a -> LocalTime
monitorTime CCProcessor a
cc1 LocalTime -> LocalTime -> Bool
forall a. Eq a => a -> a -> Bool
== CCProcessor a -> LocalTime
forall a. CCProcessor a -> LocalTime
monitorTime CCProcessor a
cc2 = let
                CCProcessor LocalTime
t [Map LocalTime a -> CashFlow]
mf  = CCProcessor a
cc1
                CCProcessor LocalTime
_ [Map LocalTime a -> CashFlow]
mf' = CCProcessor a
cc2 in
                LocalTime -> [Map LocalTime a -> CashFlow] -> CCProcessor a
forall a.
LocalTime -> [Map LocalTime a -> CashFlow] -> CCProcessor a
CCProcessor LocalTime
t ([Map LocalTime a -> CashFlow]
mf[Map LocalTime a -> CashFlow]
-> [Map LocalTime a -> CashFlow] -> [Map LocalTime a -> CashFlow]
forall a. [a] -> [a] -> [a]
++[Map LocalTime a -> CashFlow]
mf') CCProcessor a -> [CCProcessor a] -> [CCProcessor a]
forall a. a -> [a] -> [a]
: [CCProcessor a] -> [CCProcessor a] -> [CCProcessor a]
combine [CCProcessor a]
ccs1 [CCProcessor a]
ccs2
            | CCProcessor a -> LocalTime
forall a. CCProcessor a -> LocalTime
monitorTime CCProcessor a
cc1 LocalTime -> LocalTime -> Bool
forall a. Ord a => a -> a -> Bool
> CCProcessor a -> LocalTime
forall a. CCProcessor a -> LocalTime
monitorTime CCProcessor a
cc2 = CCProcessor a
cc2 CCProcessor a -> [CCProcessor a] -> [CCProcessor a]
forall a. a -> [a] -> [a]
: [CCProcessor a] -> [CCProcessor a] -> [CCProcessor a]
combine (CCProcessor a
cc1CCProcessor a -> [CCProcessor a] -> [CCProcessor a]
forall a. a -> [a] -> [a]
:[CCProcessor a]
ccs1) [CCProcessor a]
ccs2
            | Bool
otherwise = CCProcessor a
cc1 CCProcessor a -> [CCProcessor a] -> [CCProcessor a]
forall a. a -> [a] -> [a]
: [CCProcessor a] -> [CCProcessor a] -> [CCProcessor a]
combine [CCProcessor a]
ccs1 (CCProcessor a
cc2CCProcessor a -> [CCProcessor a] -> [CCProcessor a]
forall a. a -> [a] -> [a]
:[CCProcessor a]
ccs2)
          combine [CCProcessor a]
cs1 [CCProcessor a]
cs2 = [CCProcessor a]
cs1 [CCProcessor a] -> [CCProcessor a] -> [CCProcessor a]
forall a. [a] -> [a] -> [a]
++ [CCProcessor a]
cs2

type CCBuilder w r a =  WriterT w (Reader r) a

-- | Monitor an observable at the given time t.
monitor :: LocalTime -> CCBuilder (ContingentClaim a) (M.Map LocalTime a) a
monitor :: LocalTime -> CCBuilder (ContingentClaim a) (Map LocalTime a) a
monitor LocalTime
t = do
  ContingentClaim a
-> WriterT (ContingentClaim a) (Reader (Map LocalTime a)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (ContingentClaim a
 -> WriterT (ContingentClaim a) (Reader (Map LocalTime a)) ())
-> ContingentClaim a
-> WriterT (ContingentClaim a) (Reader (Map LocalTime a)) ()
forall a b. (a -> b) -> a -> b
$ [CCProcessor a] -> ContingentClaim a
forall a. [CCProcessor a] -> ContingentClaim a
ContingentClaim [LocalTime -> [Map LocalTime a -> CashFlow] -> CCProcessor a
forall a.
LocalTime -> [Map LocalTime a -> CashFlow] -> CCProcessor a
CCProcessor LocalTime
t []] -- This step maintains the monitoring times.
  Map LocalTime a
m <- WriterT
  (ContingentClaim a) (Reader (Map LocalTime a)) (Map LocalTime a)
forall r (m :: * -> *). MonadReader r m => m r
ask                                   -- This step gets the market data
  return $ Map LocalTime a
m Map LocalTime a -> LocalTime -> a
forall k a. Ord k => Map k a -> k -> a
M.! LocalTime
t                          -- This step evaluate the market data at time t.

-- | Pay an amount at a given time
pay :: forall a. LocalTime -> CCBuilder (ContingentClaim a) (M.Map LocalTime a) CashFlow -> ContingentClaim a
pay :: LocalTime
-> CCBuilder (ContingentClaim a) (Map LocalTime a) CashFlow
-> ContingentClaim a
pay LocalTime
t CCBuilder (ContingentClaim a) (Map LocalTime a) CashFlow
x = ContingentClaim a
stoppingTimes ContingentClaim a -> ContingentClaim a -> ContingentClaim a
forall a. Semigroup a => a -> a -> a
<> [CCProcessor a] -> ContingentClaim a
forall a. [CCProcessor a] -> ContingentClaim a
ContingentClaim [LocalTime -> [Map LocalTime a -> CashFlow] -> CCProcessor a
forall a.
LocalTime -> [Map LocalTime a -> CashFlow] -> CCProcessor a
CCProcessor LocalTime
t [Map LocalTime a -> CashFlow
payout]] where
  stoppingTimes :: ContingentClaim a
stoppingTimes = Reader (Map LocalTime a) (ContingentClaim a)
-> Map LocalTime a -> ContingentClaim a
forall r a. Reader r a -> r -> a
runReader (CCBuilder (ContingentClaim a) (Map LocalTime a) CashFlow
-> Reader (Map LocalTime a) (ContingentClaim a)
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT CCBuilder (ContingentClaim a) (Map LocalTime a) CashFlow
x) Map LocalTime a
forall k a. Map k a
M.empty
  payout :: Map LocalTime a -> CashFlow
payout = let r :: Reader (Map LocalTime a) CashFlow
r = (CashFlow, ContingentClaim a) -> CashFlow
forall a b. (a, b) -> a
fst ((CashFlow, ContingentClaim a) -> CashFlow)
-> Reader (Map LocalTime a) (CashFlow, ContingentClaim a)
-> Reader (Map LocalTime a) CashFlow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CCBuilder (ContingentClaim a) (Map LocalTime a) CashFlow
-> Reader (Map LocalTime a) (CashFlow, ContingentClaim a)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT CCBuilder (ContingentClaim a) (Map LocalTime a) CashFlow
x
           in Reader (Map LocalTime a) CashFlow -> Map LocalTime a -> CashFlow
forall r a. Reader r a -> r -> a
runReader Reader (Map LocalTime a) CashFlow
r