From 32ec058e6baa190f3c35987f6b4d97f61062ddde Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Mon, 8 Aug 2022 23:04:09 +0200 Subject: [PATCH] finally hopefully fixed #12 --- ibhelper.cabal | 1 + src/AppFiller.hs | 3 +- src/Chart.hs | 206 +++++++++++++++++++++++++++-------------------- src/Import.hs | 9 +++ src/Run.hs | 7 +- src/Types.hs | 42 +++++++--- 6 files changed, 165 insertions(+), 103 deletions(-) diff --git a/ibhelper.cabal b/ibhelper.cabal index 9ca103d..af4a455 100644 --- a/ibhelper.cabal +++ b/ibhelper.cabal @@ -107,6 +107,7 @@ library , dear-implot , directory , fingertree + , generic-data , gl , managed , microlens-th diff --git a/src/AppFiller.hs b/src/AppFiller.hs index 54c7085..402fc6a 100644 --- a/src/AppFiller.hs +++ b/src/AppFiller.hs @@ -73,7 +73,8 @@ handleTickPrice IB_TickPrice{..} = do case tickType of IBTickType_Last_Price -> do t <- utcTimeToSeconds <$> liftIO getCurrentTime - let cp = ChartPoint (TimePoint t) price (fromIntegral size) [] + let cp = ChartPoint (TimeInterval t t) price (fromIntegral size) [] + logInfo $ displayShow ("added point", cp) liftIO $ atomically $ modifyTVar chartVar (\c@Chart{..} -> c { chartData = chartData |> cp, chartDirty = True}) _ -> return () handleTickPrice _ = error "impossible" diff --git a/src/Chart.hs b/src/Chart.hs index fdd799c..d3b2a56 100644 --- a/src/Chart.hs +++ b/src/Chart.hs @@ -29,7 +29,7 @@ import qualified Data.List as L import qualified Data.Text as T import qualified Data.Vector.Storable as VS ---import qualified Debug.Trace as D +import qualified Debug.Trace as D data FillerException = QuitFiller deriving stock Show @@ -58,7 +58,7 @@ newChart contract = do unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err) let (unknownDates, cacheData') = partition (isNothing . fst) cacheData unless (null unknownDates) $ logError $ display $ T.pack $ show (length unknownDates) <> " files had no parsable Date." - let cacheData'' :: HashMap Day (FingerTree TimePoint ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> cacheData' + let cacheData'' :: HashMap Day (FingerTree TimeInterval ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> cacheData' logError $ displayShow $ HM.keys cacheData'' c <- liftIO $ newTVarIO $ Chart con (fromMaybe FT.empty $ cacheData'' HM.!? today) @@ -96,84 +96,40 @@ fillChart app contract cVar = runRIO app $ do liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartDirty = False }) (lUpdate, cachePoints) <- getUpdatedChartCache c Nothing liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartCache = cachePoints, lastCacheUpdate = lUpdate }) - return () threadDelay 1000000 -- sleep 5 seconds -chunkChart :: Int -> Int -> Int -> FingerTree TimePoint ChartPoint -> [(TimePoint,[ChartPoint])] -chunkChart from until range tree = go from range interval +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 where - lastItem = case FT.viewr interval of - FT.EmptyR -> until - (_ FT.:> ChartPoint{..}) -> (\(TimePoint x) -> x) timeOfDay - interval = FT.takeUntil (\(TimePoint x) -> x > until) - . FT.dropUntil (\(TimePoint x) -> x > from) + traceShowCommentId' s a = a -- traceShowCommentId s a + traceShowComment' s a b = b -- traceShowComment s a b + interval = FT.takeUntil (\(TimeInterval x y) -> x > until) + . FT.dropUntil (\(TimeInterval x y) -> x >= from || (x <= from && y <= until && y >= from)) $ tree go f i t - | f+i >= lastItem = [(TimePoint (f+i), toList t)] - | otherwise = let (a, b) = FT.split (\(TimePoint x) -> x > f+i) t - in (TimePoint (f+i),toList a) : go (f+i) i b + | f >= until = traceShowCommentId' "nosplit OverNow" [] + | otherwise = let searchpred start@(TimeInterval x y) end@(TimeInterval a b) + | start == mempty = False + | end == mempty = True + | otherwise = f <= x+i + 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) + | 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)] -toCachePoint :: (TimePoint,[ChartPoint]) -> ChartPoint -toCachePoint (t,[]) = ChartPoint t (-1) 0 [] -toCachePoint (t,as) = ChartPoint t m vol [OLHC o l h c] - where - vol = sum $ pointVolume <$> as - as' = pointValue <$> as - ms' = sum $ (\x -> pointValue x * pointVolume x) <$> as - m = ms' / vol - o = head as' - c = last as' - l = minimum as' - h = maximum as' - -getUpdatedChartCache :: Chart -> Maybe ChartCacheSettings -> RIO App (Maybe TimePoint, ChartCacheData) -getUpdatedChartCache Chart{..} chartCacheSettings' = do - let ChartCacheSettings cRes cTicks = fromMaybe chartCacheSettings chartCacheSettings' - now <- liftIO getCurrentTime - -- - recalculate cacheUpdateStart & cacheUpdateEnd - let cacheUpdateEnd = ((utcTimeToSeconds now + cRes) `div` cRes) * cRes - cacheUpdateStart = cacheUpdateEnd - (cRes * cTicks) - ChartCacheData ccData ccAxis ccRange ccFill = chartCache - chunks = case ccFill of - Nothing -> [(cacheUpdateStart, cacheUpdateEnd)] - Just (mi, ma) -> if - -- Interval mi-ma already updated. get remaining intervals - -- mi ma cUS cUE - | ma < cacheUpdateStart -> [(cacheUpdateStart, cacheUpdateEnd)] - -- mi? cUS mi? ma cUE -> [ma,cUE] + rest - | ma < cacheUpdateEnd -> [(ma,cacheUpdateEnd)] <> if - -- cUS mi ma - | mi > cacheUpdateStart -> [(cacheUpdateStart, mi)] - | otherwise -> [] - | otherwise -> [] - -- - chunk them with chunhChart - chunkedChart = L.filter (not . null . snd) $ L.concat $ for chunks $ \(start, end) -> chunkChart (min 0 start) end cRes chartData - lUpdate = cacheUpdateEnd - cRes - -- - calculate Range and need for shift - shiftNeccessary = case ccRange of - Nothing -> False - Just (_,ma) -> cacheUpdateEnd > ma - (newRange, shiftInterval) = if not shiftNeccessary && isJust ccRange then (fromJust ccRange, 0) else - let interval = cTicks `div` 20 :: Int - iTo = ((cacheUpdateEnd + cRes * interval) `div` (cRes * interval)) * (cRes * interval) - iFrom = iTo - 20 * (cRes * interval) - in ((iFrom,iTo), interval) - ccAxis' = if not shiftNeccessary && isJust ccRange then ccAxis - else VS.enumFromStepN (fromIntegral $ fst newRange) (fromIntegral cRes) cTicks - logDebug $ displayShow ("now, updateEnd, lUpdate" :: Text, utcTimeToSeconds now, cacheUpdateEnd, lUpdate) - -- create data for updates - let timePointToIndex' :: TimePoint -> Int - timePointToIndex' = timePointToIndex (Just $ ChartCacheSettings cRes cTicks) newRange - let indexToTimePoint' :: Int -> TimePoint - indexToTimePoint' = indexToTimePoint (Just $ ChartCacheSettings cRes cTicks) newRange - -- fold instead of map, so we can carry over cached calculatinos from element to element (for i.e. ema/sma) - let (!foldedData,_,_) = foldl' folder ([], ChartPoint 0 0 0 [], mempty) chunkedChart - folder :: ([(Int, ChartPoint)], ChartPoint, HM.HashMap Int [Float]) -> (TimePoint, [ChartPoint]) -> ([(Int, ChartPoint)], ChartPoint, HM.HashMap Int [Float]) - folder old (_,[]) = old - folder (acc, lastPoint, smaMap) (tp,cdata) = ((timePointToIndex' tp, cp):acc, cp, foldl' (.) id smaUpdates smaMap) +-- | converts stuff returned from chunkChart into ([1 point per chunks], last point seen in the input) +toChartData :: [ChartStudyType] -> [(TimeInterval, [ChartPoint])] -> (Maybe ChartPoint, [ChartPoint]) +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, _ , smaMap) (tp@(TimeInterval f t),cdata) = (cp:acc, Just cp, foldl' (.) id smaUpdates smaMap) where cp = ChartPoint tp m vol studies - (studies, smaUpdates) = unzip $ catMaybes $ (chartStudySettings chartSettings :: [ChartStudyType]) <&> \case + (studies, smaUpdates) = unzip $ catMaybes $ studytypes <&> \case ChartStudyTypeOpen -> Just (OLHC o l h c, id) ChartStudyTypeHigh -> Nothing ChartStudyTypeLow -> Nothing @@ -189,6 +145,59 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do c = last as' l = minimum as' h = maximum as' + +getUpdatedChartCache :: Chart -> Maybe ChartCacheSettings -> RIO App (Maybe TimePoint, ChartCacheData) +getUpdatedChartCache Chart{..} chartCacheSettings' = do + let ccs@(ChartCacheSettings cRes cTicks) = fromMaybe chartCacheSettings chartCacheSettings' + now <- liftIO getCurrentTime + let cacheUpdateEnd = ((utcTimeToSeconds now + cRes) `div` cRes) * cRes + ChartCacheData ccData ccAxis ccRange ccFill = chartCache + let traceShowCommentId' s a = a -- traceShowCommentId s a + traceShowComment' s a b = b -- traceShowComment s a b + lUpdate = utcTimeToSeconds now + -- - calculate Range and need for shift + shiftNeccessary = case ccRange of + Nothing -> False + Just (TimeInterval _ ma) -> cacheUpdateEnd > ma + (newRange, shiftInterval) = if not shiftNeccessary && isJust ccRange then (fromJust ccRange, 0) else + let interval = cTicks `div` 20 :: Int + iTo = ((cacheUpdateEnd + cRes * interval) `div` (cRes * interval)) * (cRes * interval) + iFrom = iTo - 20 * (cRes * interval) + shift = case ccRange of + Nothing -> 0 + Just (TimeInterval _ ma) -> (iTo - ma) `div` cRes + in (TimeInterval iFrom iTo, shift) + ccAxis' = if not shiftNeccessary && isJust ccRange then ccAxis + else VS.enumFromStepN (fromIntegral $ timeIntervalBegin newRange) (fromIntegral cRes) cTicks + let timePointToIndex' :: TimePoint -> Either String Int + 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) + 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 + Nothing -> [(cacheUpdateStart, cacheUpdateEnd)] + Just ((mi, ma), oldRange) -> let itp = (\(TimePoint p) -> p) . indexToTimePoint (Just ccs) oldRange in if + -- Interval mi-ma already updated. get remaining intervals + -- mi ma cUS cUE + | itp ma < cacheUpdateStart -> [(cacheUpdateStart, cacheUpdateEnd)] + -- mi? cUS mi? ma cUE -> [ma,cUE] + rest + | itp ma < cacheUpdateEnd -> (<> [(itp ma,cacheUpdateEnd)]) if + -- cUS mi ma + | itp mi > cacheUpdateStart -> [(cacheUpdateStart, itp mi)] + | otherwise -> [] + | otherwise -> [] + -- - chunk them with chunhChart + chunkedChart = L.concat $ chunks <&> \(start, end) -> chunkChart (max 0 start) end cRes chartData + let (lastDataPoint, !foldedData') = toChartData (chartStudySettings chartSettings) (traceShowCommentId' "chunkedChart" chunkedChart) + tpToTi (TimeInterval f t) = case timePointToIndex' (TimePoint (t+f) `div` 2) of + Left e -> error $ "BUG in Chart.hs. Impossible: " <> e + Right ti -> ti + -- aggregate data with index into the vectors + foldedData = (\cp@ChartPoint{..} -> (tpToTi timeOfDay, cp)) <$> (traceShowCommentId' "foldedData" foldedData') -- plan the actual work updates = chartStudySettings chartSettings <&> \cs -> -- check if thing is in hashmap @@ -196,10 +205,13 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do Nothing -> VS.replicate cTicks 0 Just a -> a -- shift if neccessary - vec' = if shiftNeccessary && cs `HM.member` ccData then + vec' = if shiftNeccessary && cs `HM.member` ccData && shiftInterval < VS.length vec then -- TODO: unsafeSlice && unsafeUpdate_ - see #16 let sliceLength = VS.length vec - shiftInterval - in VS.update_ vec (VS.enumFromN 0 sliceLength) (VS.slice shiftInterval sliceLength vec) + in VS.update_ + (VS.update_ vec (VS.enumFromN 0 sliceLength) (VS.slice shiftInterval sliceLength vec)) + (VS.enumFromN sliceLength (cTicks - sliceLength)) + (VS.replicate sliceLength 0) else vec -- NOW: @@ -218,29 +230,45 @@ 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 chartCache - -- logInfo $ displayShow (cacheUpdateStart, cacheUpdateEnd) - -- logInfo $ displayShow (newRange, chunkedChart) - let ma = timePointToIndex' $ TimePoint lUpdate - mi = fromMaybe ma $ fst <$> ccFill - return (Just $ TimePoint lUpdate, ChartCacheData ccData' ccAxis' (Just newRange) (Just $ (mi, timePointToIndex' $ TimePoint lUpdate))) + logInfo $ displayShow ccData' + let maToMi ma = max 0 $ fromMaybe ma $ (subtract shiftInterval) . fst <$> ccFill + 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 + (Nothing, Nothing) -> Nothing + -- new data, update fillRange + (mima, Just lastDP) -> let lastBlock = let d = timeOfDay lastDP in (intervalTo d + intervalFrom d) `div` 2 + in case timePointToIndex' $ lastBlock of + Left err -> error $ "impossible #1 Chart.hs - " <> err + Right ma -> if ma < cTicks + then case mima of -- check if we rotated out or have no fill-range set. + Nothing -> Just (max 0 $ ma - shiftInterval, ma) + 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 + return (Just $ TimePoint lUpdate, ChartCacheData ccData' ccAxis' (Just newRange) fillRange) getChunkedDay :: Chart -> Maybe Int -> (Maybe TimePoint, [ChartPoint]) -getChunkedDay Chart{..} chunkResolution = (lUpdate, toCachePoint <$> chunkedData) +getChunkedDay Chart{..} chunkResolution = case toChartData (chartStudySettings chartSettings) chunkedData of + (Nothing, x) -> (Nothing, x) + (Just ChartPoint{..}, x) + | timeOfDay == mempty -> (Nothing, x) + | otherwise -> (Just $ TimePoint $ timeIntervalEnd timeOfDay, x) where chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData - lUpdate = fmap fst . lastMaybe $ chunkedData -indexToTimePoint :: Maybe ChartCacheSettings -> (Int, Int) -> Int -> TimePoint -indexToTimePoint ccs (rFrom, rTo) i = TimePoint $ rFrom + i*cRes +indexToTimePoint :: Maybe ChartCacheSettings -> TimeInterval -> Int -> TimePoint +indexToTimePoint ccs (TimeInterval rFrom rTo) i = TimePoint $ rFrom + i*cRes where ChartCacheSettings cRes _ = fromMaybe defChartCacheSettings ccs -timePointToIndex :: Maybe ChartCacheSettings -> (Int, Int) -> TimePoint -> Int -timePointToIndex ccs (rFrom, rTo) (TimePoint p) = if - | p < rFrom || p > rTo -> error $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show p <> " out of range." - | result < 0 || result >= cTicks -> error $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show result <> " is invalid index" - | otherwise -> result +timePointToIndex :: Maybe ChartCacheSettings -> TimeInterval -> TimePoint -> Either String Int +timePointToIndex ccs (TimeInterval rFrom rTo) (TimePoint p) = if + | p < rFrom || p > rTo -> Left $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show p <> " out of range." + | result < 0 || result >= cTicks -> Left $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show result <> " is invalid index" + | otherwise -> Right result where ChartCacheSettings cRes cTicks = fromMaybe defChartCacheSettings ccs result = (p - rFrom) `div` cRes diff --git a/src/Import.hs b/src/Import.hs index 9c70b62..176a9a3 100644 --- a/src/Import.hs +++ b/src/Import.hs @@ -11,6 +11,8 @@ module Import , getCurrentDay , switchAccountTo , utcTimeToSeconds + , traceShowComment + , traceShowCommentId ) where import RIO @@ -26,6 +28,7 @@ import System.Directory import Data.Text as T import Data.Time.Clock import Data.Time.Calendar +import Debug.Trace as D ppShow' :: Show a => a -> Text ppShow' = T.pack . ppShow @@ -48,3 +51,9 @@ switchAccountTo a = do utcTimeToSeconds :: UTCTime -> Int utcTimeToSeconds = fromInteger . (`div` ((10 :: Integer)^(12 :: Integer))) . diffTimeToPicoseconds . utctDayTime + +traceShowComment :: Show a => String -> a -> b -> b +traceShowComment s a b = D.trace ("\ESC[1;31m" <> s <> ":\ESC[0m\n"<> show a<>"\n") b + +traceShowCommentId :: Show a => String -> a -> a +traceShowCommentId s a = D.trace ("\ESC[1;31m" <> s <> ":\ESC[0m\n"<> show a<>"\n") a diff --git a/src/Run.hs b/src/Run.hs index c6a3579..500901d 100644 --- a/src/Run.hs +++ b/src/Run.hs @@ -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') = getChunkedDay c (Just 5) + let chartData' = traceShowCommentId "chartData for saving" $ filter (\ChartPoint{..} -> 0 /= pointVolume) . snd $ getChunkedDay c (Just 5) newData = HM.toList . fmap (filter (\ChartPoint{..} -> 0 /= pointVolume)) . HM.alter (Just . maybe chartData' (<>chartData')) today @@ -232,14 +232,15 @@ renderLoop = do withPlot "Test" $ do -- TODO: set axes -- let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache - setupAxisLimits (both fromIntegral $ fromMaybe (0,86400) $ chartCacheCurrent chartCache) (-100,2500) Nothing + setupAxisLimits (both fromIntegral $ (\(TimeInterval a b) -> (a,b)) $ fromMaybe (TimeInterval 0 86400) $ chartCacheCurrent chartCache) (-100,2500) Nothing let ChartCacheSettings _ cTicks = chartCacheSettings - (f, t) = fromMaybe (0, cTicks) $ chartCacheFilledTo chartCache + (f, t) = fromMaybe (0, cTicks-1) $ chartCacheFilledTo chartCache direct = chartCacheData chartCache HM.!? ChartStudyTypeDirect x = chartCacheAxis chartCache -- t-f == 0 means there is still 1 point in it. VS.slice takes number of points as second argument. Add 1! -- dataSlice = VS.slice f (t-f+1) dataSliceLine = if t-f < 1 then VS.slice (max 0 $ f-1) 2 else VS.slice f (t-f+1) -- need at least 2 points to make a line... duh! + when (t-f < 0 || t-f >= cTicks) $ logError $ displayShow ("t/f", t-f, t, f) when (isJust direct) $ do plotLine (T.unpack symbol) (dataSliceLine x) (dataSliceLine $ fromJust direct) return () diff --git a/src/Types.hs b/src/Types.hs index 520ef2a..ef7ab09 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -17,6 +17,7 @@ import Data.Types.Injective import Data.Time import Data.FingerTree import Data.Semigroup +import Generic.Data.Microsurgery import GHC.Generics import SDL (Window) import DearImGui @@ -166,7 +167,7 @@ defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect] updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart updateChartStudySettings Chart{..} s = - let chartSettings = chartSettings { chartStudySettings = [] } + let chartSettings = chartSettings { chartStudySettings = s } chartCache = emptyChartCacheData chartCacheSettings lastCacheUpdate = Nothing in Chart{..} @@ -184,14 +185,35 @@ data ChartCacheSettings = ChartCacheSettings } deriving stock (Show, Eq) defChartCacheSettings :: ChartCacheSettings -defChartCacheSettings = ChartCacheSettings 60 1440 +--defChartCacheSettings = ChartCacheSettings 60 1440 +defChartCacheSettings = ChartCacheSettings 5 20 -- TODO: TimePointFloat? or only 1 entry per second? +data TimeInterval = TimeInterval + { timeIntervalBegin :: Int + , timeIntervalEnd :: Int + } + deriving stock (Generic, Eq) + deriving anyclass (FromJSON, ToJSON) -- TODO: write own instances with "TimeInterval [a,b]" instead of recods. + deriving (Show) via (Surgery Derecordify TimeInterval) +instance Semigroup TimeInterval where + (TimeInterval mi1 ma1) <> (TimeInterval mi2 ma2) + = TimeInterval (getMin $ Min mi1 <> Min mi2) (getMax $ Max ma1 <> Max ma2) +instance Monoid TimeInterval where + mempty = TimeInterval (getMin mempty) (getMax mempty) + + newtype TimePoint = TimePoint Int - deriving stock (Generic) - deriving newtype (Show, Eq, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON) - deriving (Semigroup, Monoid) via (Max Int) + deriving stock (Generic, Show) + deriving newtype (Eq, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON) + deriving (Semigroup, Monoid) via (Min Int) + +intervalFrom :: TimeInterval -> TimePoint +intervalFrom (TimeInterval a _) = TimePoint a + +intervalTo :: TimeInterval -> TimePoint +intervalTo (TimeInterval _ b) = TimePoint b data ChartStudies = SMA { window :: Int, value :: Float } | OLHC { olhc_open :: Float, olhc_low :: Float, olhc_high :: Float, olhc_close :: Float} @@ -200,14 +222,14 @@ data ChartStudies = SMA { window :: Int, value :: Float } deriving anyclass (FromJSON, ToJSON) data ChartPoint = ChartPoint - { timeOfDay :: TimePoint + { timeOfDay :: TimeInterval , pointValue :: Float , pointVolume :: Float , pointExtra :: [ChartStudies] } deriving stock (Show, Eq, Generic) deriving anyclass (FromJSON, ToJSON) -instance Measured TimePoint ChartPoint where +instance Measured TimeInterval ChartPoint where measure = timeOfDay -- | Tick-based data @@ -224,7 +246,7 @@ data ChartStudyType = ChartStudyTypeDirect data ChartCacheData = ChartCacheData { chartCacheData :: HashMap ChartStudyType (VS.Vector Float) , chartCacheAxis :: VS.Vector Float - , chartCacheCurrent :: Maybe (Int,Int) -- ^ in number of TimePoint, negative meaning "before today" + , chartCacheCurrent :: Maybe TimeInterval -- ^ in number of TimeInterval, negative meaning "before today" , chartCacheFilledTo :: Maybe (Int,Int) -- ^ in index into the vectors given range of "Current" } deriving stock (Show, Eq) @@ -233,8 +255,8 @@ emptyChartCacheData ChartCacheSettings{..} = ChartCacheData mempty (VS.replicate data Chart = Chart { chartContractID :: Int - , chartData :: FingerTree TimePoint ChartPoint -- ^ raw data (time & sale) - , chartHistData :: HashMap Day (FingerTree TimePoint ChartPoint) -- ^ raw data (time & sale) + , chartData :: FingerTree TimeInterval ChartPoint -- ^ raw data (time & sale) + , chartHistData :: HashMap Day (FingerTree TimeInterval ChartPoint) -- ^ raw data (time & sale) , fillerThread :: ThreadId , chartSettings :: ChartSettings , chartCacheSettings :: ChartCacheSettings