module Penny.Lincoln.PriceDb (
PriceDb,
emptyDb,
addPrice,
getPrice,
PriceDbError(FromNotFound, ToNotFound, CpuNotFound),
convertAsOf
) where
import qualified Data.Map as M
import qualified Data.Time as T
import qualified Penny.Lincoln.Bits as B
type CpuMap = M.Map T.UTCTime B.CountPerUnit
type ToMap = M.Map B.To CpuMap
newtype PriceDb = PriceDb (M.Map B.From ToMap)
emptyDb :: PriceDb
emptyDb = PriceDb M.empty
addPrice :: PriceDb -> B.PricePoint -> PriceDb
addPrice (PriceDb db) (B.PricePoint dt pr _ _ _) = PriceDb m'
where
m' = M.alter f (B.from pr) db
utc = B.toUTC dt
cpu = B.countPerUnit pr
f k = case k of
Nothing -> Just $ M.singleton (B.to pr) cpuMap
where
cpuMap = M.singleton utc cpu
Just tm -> Just tm'
where
tm' = M.alter g (B.to pr) tm
g maybeTo = case maybeTo of
Nothing -> Just $ M.singleton utc cpu
Just cpuMap -> Just $ M.insert utc cpu cpuMap
data PriceDbError = FromNotFound | ToNotFound | CpuNotFound
getPrice ::
PriceDb
-> B.From
-> B.To
-> B.DateTime
-> Either PriceDbError B.CountPerUnit
getPrice (PriceDb db) fr to dt = do
let utc = B.toUTC dt
toMap <- maybe (Left FromNotFound) Right $ M.lookup fr db
cpuMap <- maybe (Left ToNotFound) Right $ M.lookup to toMap
let (lower, exact, _) = M.splitLookup utc cpuMap
case exact of
Just c -> return c
Nothing ->
if M.null lower
then Left CpuNotFound
else return . snd . M.findMax $ lower
convertAsOf ::
B.HasQty q
=> PriceDb
-> B.DateTime
-> B.To
-> B.Amount q
-> Either PriceDbError B.Qty
convertAsOf db dt to (B.Amount qt fr)
| fr == B.unTo to = return . B.toQty $ qt
| otherwise = do
cpu <- fmap B.unCountPerUnit (getPrice db (B.From fr) to dt)
let qt' = B.mult (B.toQty cpu) (B.toQty qt)
return qt'