module Penny.Lincoln.PriceDb (
PriceDb,
emptyDb,
addPrice,
getPrice,
PriceDbError(FromNotFound, ToNotFound, CpuNotFound),
convert
) where
import qualified Control.Monad.Exception.Synchronous as Ex
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
-> Ex.Exceptional PriceDbError B.CountPerUnit
getPrice (PriceDb db) fr to dt = do
let utc = B.toUTC dt
toMap <- Ex.fromMaybe FromNotFound $ M.lookup fr db
cpuMap <- Ex.fromMaybe ToNotFound $ M.lookup to toMap
let (lower, exact, _) = M.splitLookup utc cpuMap
case exact of
Just c -> return c
Nothing ->
if M.null lower
then Ex.throw CpuNotFound
else return . snd . M.findMax $ lower
convert ::
PriceDb
-> B.DateTime
-> B.To
-> B.Amount
-> Ex.Exceptional PriceDbError B.Qty
convert db dt to (B.Amount qt fr _ _)
| fr == B.unTo to = return qt
| otherwise = do
cpu <- fmap B.unCountPerUnit (getPrice db (B.From fr) to dt)
let qt' = B.mult cpu qt
return qt'