{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}


module Revolving
  ( RevolvingPool(..)
  , lookupAssetAvailable
  )
  where

import GHC.Generics
import Language.Haskell.TH
import Data.Aeson hiding (json)
import qualified Data.Text as T
import qualified Cashflow as CF
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Hashable
import Data.Fixed
import Data.List
import Types

import AssetClass.AssetBase


data RevolvingPool = ConstantAsset [AssetUnion]          -- ^ Assets in revolving pool stays constant after being bought
                   | StaticAsset [AssetUnion]            -- ^ Assets in revolving pool will decrease afeter being bought
                   | AssetCurve [TsPoint [AssetUnion]]   -- ^ Assets are changing by dates
                   deriving (Int -> RevolvingPool -> ShowS
[RevolvingPool] -> ShowS
RevolvingPool -> String
(Int -> RevolvingPool -> ShowS)
-> (RevolvingPool -> String)
-> ([RevolvingPool] -> ShowS)
-> Show RevolvingPool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RevolvingPool -> ShowS
showsPrec :: Int -> RevolvingPool -> ShowS
$cshow :: RevolvingPool -> String
show :: RevolvingPool -> String
$cshowList :: [RevolvingPool] -> ShowS
showList :: [RevolvingPool] -> ShowS
Show,(forall x. RevolvingPool -> Rep RevolvingPool x)
-> (forall x. Rep RevolvingPool x -> RevolvingPool)
-> Generic RevolvingPool
forall x. Rep RevolvingPool x -> RevolvingPool
forall x. RevolvingPool -> Rep RevolvingPool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RevolvingPool -> Rep RevolvingPool x
from :: forall x. RevolvingPool -> Rep RevolvingPool x
$cto :: forall x. Rep RevolvingPool x -> RevolvingPool
to :: forall x. Rep RevolvingPool x -> RevolvingPool
Generic)


lookupAssetAvailable :: RevolvingPool -> Date -> [AssetUnion]
lookupAssetAvailable :: RevolvingPool -> Date -> [AssetUnion]
lookupAssetAvailable (ConstantAsset [AssetUnion]
aus) Date
_ = [AssetUnion]
aus
lookupAssetAvailable (StaticAsset [AssetUnion]
aus) Date
_ = [AssetUnion]
aus
lookupAssetAvailable (AssetCurve [TsPoint [AssetUnion]]
ausCurve) Date
d 
  = case (TsPoint [AssetUnion] -> Bool)
-> [TsPoint [AssetUnion]] -> Maybe (TsPoint [AssetUnion])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d [AssetUnion]
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
_d) ([TsPoint [AssetUnion]] -> [TsPoint [AssetUnion]]
forall a. [a] -> [a]
reverse [TsPoint [AssetUnion]]
ausCurve)  of 
      Just (TsPoint Date
_d [AssetUnion]
v) -> [AssetUnion]
v
      Maybe (TsPoint [AssetUnion])
Nothing -> [] 



$(deriveJSON defaultOptions ''RevolvingPool)