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.Foldable as Fdbl
import qualified Data.Map as M
import qualified Data.Time as T
import qualified Penny.Lincoln.NestedMap as NM
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 (NM.NestedMap B.SubCommodity ToMap)
emptyDb :: PriceDb
emptyDb = PriceDb NM.empty
addPrice :: PriceDb -> B.PricePoint -> PriceDb
addPrice (PriceDb db) pp@(B.PricePoint _ pr _) =
PriceDb $ NM.relabel db ls where
ls = firsts ++ [lst]
cmdtyList = Fdbl.toList . B.unCommodity . B.unFrom . B.from $ pr
firsts = map toFst (init cmdtyList) where
toFst cty = (cty, f)
f maybeL = case maybeL of
Nothing -> M.empty
Just m -> m
lst = (last cmdtyList, insertIntoToMap pp)
insertIntoToMap ::
B.PricePoint
-> Maybe ToMap
-> ToMap
insertIntoToMap (B.PricePoint dt pr _) =
let toCmdty = B.to pr
newToMap oldMap = M.alter alterTo toCmdty oldMap
alterTo mayCpuMap =
let newKey = dateTimeToUTC dt
newVal = B.countPerUnit pr
in Just $ case mayCpuMap of
Nothing -> M.singleton newKey newVal
Just m -> M.insert newKey newVal m
relabeler maybeToMap =
newToMap (maybe M.empty id maybeToMap)
in relabeler
dateTimeToUTC :: B.DateTime -> T.UTCTime
dateTimeToUTC dt = T.localTimeToUTC tz lt where
tz = T.minutesToTimeZone . B.offsetToMins $ tzo
lt = B.localTime dt
tzo = B.timeZone dt
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 = dateTimeToUTC dt
subs = Fdbl.toList . B.unCommodity . B.unFrom $ fr
toMap <- case NM.descend subs db of
[] -> Ex.throw FromNotFound
xs -> return . snd . last $ xs
cpuMap <- case M.lookup to toMap of
Nothing -> Ex.throw ToNotFound
Just m -> return m
let (lower, exact, _) = M.splitLookup utc cpuMap
cpu <- case exact of
Just c -> return c
Nothing ->
if M.null lower
then Ex.throw CpuNotFound
else return . snd . M.findMax $ lower
return cpu
convert ::
PriceDb
-> B.DateTime
-> B.To
-> B.Amount
-> Ex.Exceptional PriceDbError B.Amount
convert db dt to (B.Amount qt fr) = do
cpu <- fmap B.unCountPerUnit (getPrice db (B.From fr) to dt)
let qt' = B.mult cpu qt
return $ B.Amount qt' (B.unTo to)