#12 now finally done? ... 😅
This commit is contained in:
parent
32ec058e6b
commit
caf588201c
@ -74,7 +74,7 @@ handleTickPrice IB_TickPrice{..} = do
|
||||
IBTickType_Last_Price -> do
|
||||
t <- utcTimeToSeconds <$> liftIO getCurrentTime
|
||||
let cp = ChartPoint (TimeInterval t t) price (fromIntegral size) []
|
||||
logInfo $ displayShow ("added point", cp)
|
||||
logDebug $ displayShow ("added point", cp)
|
||||
liftIO $ atomically $ modifyTVar chartVar (\c@Chart{..} -> c { chartData = chartData |> cp, chartDirty = True})
|
||||
_ -> return ()
|
||||
handleTickPrice _ = error "impossible"
|
||||
|
||||
34
src/Chart.hs
34
src/Chart.hs
@ -99,7 +99,7 @@ fillChart app contract cVar = runRIO app $ do
|
||||
threadDelay 1000000 -- sleep 5 seconds
|
||||
|
||||
chunkChart :: Int -> Int -> Int -> FingerTree TimeInterval ChartPoint -> [(TimeInterval,[ChartPoint])]
|
||||
chunkChart from until ticks tree = D.trace ("chunking from "<> show from <> " to " <> show until) $ go from ticks interval
|
||||
chunkChart from until ticks tree = go from ticks interval
|
||||
where
|
||||
traceShowCommentId' s a = a -- traceShowCommentId s a
|
||||
traceShowComment' s a b = b -- traceShowComment s a b
|
||||
@ -111,11 +111,11 @@ chunkChart from until ticks tree = D.trace ("chunking from "<> show from <> " to
|
||||
| otherwise = let searchpred start@(TimeInterval x y) end@(TimeInterval a b)
|
||||
| start == mempty = False
|
||||
| end == mempty = True
|
||||
| otherwise = f <= x+i
|
||||
| otherwise = traceShowComment' "search" (f, x, start, end) $ f+i <= x || f+2*i <= y
|
||||
in case FT.search searchpred t
|
||||
of pos@(FT.Position l x@(ChartPoint{..}) r)
|
||||
| l == mempty && r == mempty && (timeIntervalBegin timeOfDay) < f+i-1 -> (traceShowCommentId' "only 1 left" $ (TimeInterval f (f+i-1), [x])) : go (f+i) i mempty
|
||||
| l == mempty -> (traceShowCommentId' "empty" (TimeInterval f (f+i-1), [])) : go (f+i) i (x FT.<| r)
|
||||
| l == mempty -> (traceShowComment' ("empty (" <> show f <> "," <> show (f+i) <> ")") x (TimeInterval f (f+i-1), [])) : go (f+i) i (x FT.<| r)
|
||||
| otherwise -> (traceShowComment' ("split (" <> show f <> "," <> show (f+i) <> ")") pos (FT.measure l,toList l)) : traceShowComment' "recursive call with " (f+i, i, x FT.<| r) (go (f+i) i (x FT.<| r))
|
||||
x -> if FT.measure t == mempty then (TimeInterval f (f+i-1), []) : go (f+i) i t else traceShowCommentId' ("nosplit EndOfTree - "<> show x) [(FT.measure t, toList t)]
|
||||
|
||||
@ -124,8 +124,17 @@ toChartData :: [ChartStudyType] -> [(TimeInterval, [ChartPoint])] -> (Maybe Char
|
||||
toChartData studytypes chunkedChart = (lastDataPoint, foldedData)
|
||||
where (!foldedData,lastDataPoint,_) = foldl' folder ([], Nothing, mempty) chunkedChart
|
||||
folder :: ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float]) -> (TimeInterval, [ChartPoint]) -> ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float])
|
||||
folder (acc, Nothing , smaMap) (tp, []) = (ChartPoint tp 0 0 []:acc, Nothing, smaMap)
|
||||
folder (acc, Just lastPoint, smaMap) (tp, []) = (lastPoint{ timeOfDay = tp, pointVolume = 0}:acc, Just lastPoint, smaMap)
|
||||
folder (acc, Nothing , smaMap) (tp , []) = (ChartPoint tp 0 0 []:acc, Nothing, smaMap)
|
||||
folder (acc, Just lastPoint, smaMap) (tp , []) = (lastPoint{ timeOfDay = tp, pointVolume = 0}:acc, Just lastPoint, foldl' (.) id smaUpdates smaMap)
|
||||
where
|
||||
(studies, smaUpdates) = unzip $ catMaybes $ studytypes <&> \case
|
||||
ChartStudyTypeOpen -> fmap (\OLHC{..} -> (OLHC olhc_close olhc_close olhc_close olhc_close, id)) . L.find (\case OLHC{..} -> True; _ -> False) . pointExtra $ lastPoint
|
||||
ChartStudyTypeHigh -> Nothing
|
||||
ChartStudyTypeLow -> Nothing
|
||||
ChartStudyTypeClose -> Nothing
|
||||
ChartStudyTypeDirect -> Nothing
|
||||
ChartStudyTypeSMA w -> Nothing --TODO: fixme #13, do the calculation & use data inside smaMap and return (SMA x y, smaUpdate)
|
||||
ChartStudyTypeVolume -> Just (Volume 0,id)
|
||||
folder (acc, _ , smaMap) (tp@(TimeInterval f t),cdata) = (cp:acc, Just cp, foldl' (.) id smaUpdates smaMap)
|
||||
where
|
||||
cp = ChartPoint tp m vol studies
|
||||
@ -173,9 +182,9 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
||||
timePointToIndex' = timePointToIndex (Just $ ChartCacheSettings cRes cTicks) newRange
|
||||
let indexToTimePoint' :: Int -> TimePoint
|
||||
indexToTimePoint' = indexToTimePoint (Just $ ChartCacheSettings cRes cTicks) newRange
|
||||
when (Just newRange /= ccRange) $ logInfo $ displayShow ("range changed:", newRange, ccRange)
|
||||
logInfo $ displayShow ("shift?" :: Text, shiftNeccessary, shiftInterval)
|
||||
logInfo $ displayShow ("now, updateEnd, lUpdate" :: Text, utcTimeToSeconds now, cacheUpdateEnd, lUpdate)
|
||||
when (Just newRange /= ccRange) $ logDebug $ displayShow ("range changed:", newRange, ccRange)
|
||||
logDebug $ displayShow ("shift?" :: Text, shiftNeccessary, shiftInterval)
|
||||
logDebug $ displayShow ("now, updateEnd, lUpdate" :: Text, utcTimeToSeconds now, cacheUpdateEnd, lUpdate)
|
||||
let cacheUpdateStart = max (timeIntervalBegin newRange) (cacheUpdateEnd - (cRes * (cTicks+1))) -- 1 more to get history running inside the chunk-fold for fallbacks in cache if we get no data.
|
||||
-- create data for updates
|
||||
let chunks = case (,) <$> ccFill <*> ccRange of
|
||||
@ -230,9 +239,8 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
||||
ChartStudyTypeSMA x -> id --TODO: implement #13
|
||||
ChartStudyTypeVolume -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,volume $ findVolume s)) <$> foldedData))
|
||||
let ccData' = foldl' (.) id updates ccData
|
||||
logInfo $ displayShow ccData'
|
||||
let maToMi ma = max 0 $ fromMaybe ma $ (subtract shiftInterval) . fst <$> ccFill
|
||||
fillRange = case traceShowCommentId' "(ccFill, lastDataPoint)" (ccFill,lastDataPoint) of
|
||||
logDebug $ displayShow ccData'
|
||||
let fillRange = case traceShowCommentId' "(ccFill, lastDataPoint)" (ccFill,lastDataPoint) of
|
||||
-- no new data, but different range. shift along.
|
||||
(Just (mi,ma), Nothing) -> if ma - shiftInterval < 0 then Nothing else Just (max 0 $ mi - shiftInterval, ma - shiftInterval)
|
||||
-- no data saved yet
|
||||
@ -247,7 +255,7 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
||||
Just (mi, ma') -> if ma' - shiftInterval < 0 then Just (max 0 $ ma - shiftInterval, ma)
|
||||
else Just (max 0 $ mi - shiftInterval, ma)
|
||||
else error $ "impossible #2 Chart.hs - " <> show ma <> ">=" <> show cTicks
|
||||
logInfo $ displayShow fillRange
|
||||
logDebug $ displayShow fillRange
|
||||
return (Just $ TimePoint lUpdate, ChartCacheData ccData' ccAxis' (Just newRange) fillRange)
|
||||
|
||||
getChunkedDay :: Chart -> Maybe Int -> (Maybe TimePoint, [ChartPoint])
|
||||
@ -257,7 +265,7 @@ getChunkedDay Chart{..} chunkResolution = case toChartData (chartStudySettings c
|
||||
| timeOfDay == mempty -> (Nothing, x)
|
||||
| otherwise -> (Just $ TimePoint $ timeIntervalEnd timeOfDay, x)
|
||||
where
|
||||
chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData
|
||||
chunkedData = filter (not . null . snd) $ chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData
|
||||
|
||||
indexToTimePoint :: Maybe ChartCacheSettings -> TimeInterval -> Int -> TimePoint
|
||||
indexToTimePoint ccs (TimeInterval rFrom rTo) i = TimePoint $ rFrom + i*cRes
|
||||
|
||||
@ -55,7 +55,7 @@ shutdownApp = do
|
||||
c@Chart{..} <- liftIO . readTVarIO $ tc
|
||||
today <- liftIO $ utctDay <$> getCurrentTime
|
||||
liftIO $ unlessM (doesDirectoryExist $ "cache/" <> show chartContractID) $ createDirectory $ "cache/" <> show chartContractID
|
||||
let chartData' = traceShowCommentId "chartData for saving" $ filter (\ChartPoint{..} -> 0 /= pointVolume) . snd $ getChunkedDay c (Just 5)
|
||||
let chartData' = filter (\ChartPoint{..} -> 0 /= pointVolume) . snd $ getChunkedDay c (Just 5)
|
||||
newData = HM.toList
|
||||
. fmap (filter (\ChartPoint{..} -> 0 /= pointVolume))
|
||||
. HM.alter (Just . maybe chartData' (<>chartData')) today
|
||||
|
||||
@ -185,8 +185,8 @@ data ChartCacheSettings = ChartCacheSettings
|
||||
} deriving stock (Show, Eq)
|
||||
|
||||
defChartCacheSettings :: ChartCacheSettings
|
||||
--defChartCacheSettings = ChartCacheSettings 60 1440
|
||||
defChartCacheSettings = ChartCacheSettings 5 20
|
||||
defChartCacheSettings = ChartCacheSettings 60 1440
|
||||
--defChartCacheSettings = ChartCacheSettings 5 20 -- for testing
|
||||
|
||||
-- TODO: TimePointFloat? or only 1 entry per second?
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user