further implemented #12 & tested preliminary. Should(tm) work fine now.

This commit is contained in:
Nicole Dresselhaus 2022-08-08 08:37:59 +02:00
parent 16b4eb83e1
commit 42183873d8
4 changed files with 111 additions and 58 deletions

2
deps/dear-implot.hs vendored

@ -1 +1 @@
Subproject commit f3d5b63b541d8048568f134403838213c77177e4 Subproject commit 2b3810f7927a83c7cf95612497eaeceed56ca5e8

View File

@ -3,7 +3,13 @@
{-# LANGUAGE DerivingVia #-} {-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Chart (newChart, FillerException(..), getUpdatedChartCache, getChunkedDay) where module Chart (newChart
, FillerException(..)
, getUpdatedChartCache
, getChunkedDay
, timePointToIndex
, indexToTimePoint
) where
import Import import Import
import Control.Concurrent (forkIO) import Control.Concurrent (forkIO)
@ -40,19 +46,29 @@ newChart contract = do
unless (sym `HM.member` hm) $ do unless (sym `HM.member` hm) $ do
today <- liftIO getCurrentDay :: RIO App Day today <- liftIO getCurrentDay :: RIO App Day
(cacheErrors, cacheData) <- do (cacheErrors, cacheData) <- do
files <- liftIO $ listDirectory $ "cache" </> show con ifM (fmap not $ liftIO $ doesDirectoryExist $ "cache" </> show con)
res <- forM files $ \cacheFileName -> do (return $ (["no data-chache found for " <> show con], [])) $ do
let fname = "cache" </> show con </> cacheFileName files <- liftIO $ listDirectory $ "cache" </> show con
ifM (liftIO $ doesFileExist fname) res <- forM files $ \cacheFileName -> do
(bimap (\err -> cacheFileName <> ": "<> err) ((readMaybe $ dropExtension cacheFileName) :: Maybe Day,) <$> liftIO (eitherDecodeFileStrict' fname)) let fname = "cache" </> show con </> cacheFileName
(return $ Left $ "cachefile "<>cacheFileName<>" not found.") ifM (liftIO $ doesFileExist fname)
return $ partitionEithers res (bimap (\err -> cacheFileName <> ": "<> err) ((readMaybe $ dropExtension cacheFileName) :: Maybe Day,) <$> liftIO (eitherDecodeFileStrict' fname))
(return $ Left $ "cachefile "<>cacheFileName<>" not found.")
return $ partitionEithers res
unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err) unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err)
let (unknownDates, cacheData') = partition (isNothing . fst) cacheData let (unknownDates, cacheData') = partition (isNothing . fst) cacheData
unless (null unknownDates) $ logError $ display $ T.pack $ show (length unknownDates) <> " files had no parsable Date." 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 TimePoint ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> cacheData'
logError $ displayShow $ HM.keys cacheData'' logError $ displayShow $ HM.keys cacheData''
c <- liftIO $ newTVarIO $ Chart con (fromMaybe FT.empty $ cacheData'' HM.!? today) (HM.delete today cacheData'') undefined defChartSettings defChartCacheSettings emptyChartCacheData Nothing False c <- liftIO $ newTVarIO $ Chart con
(fromMaybe FT.empty $ cacheData'' HM.!? today)
(HM.delete today cacheData'')
undefined
defChartSettings
defChartCacheSettings
(emptyChartCacheData defChartCacheSettings)
Nothing
False
tid <- liftIO $ forkIO $ fillChart app contract c tid <- liftIO $ forkIO $ fillChart app contract c
liftIO $ atomically $ do liftIO $ atomically $ do
modifyTVar' c (\Chart{..} -> let fillerThread = tid in Chart{..}) modifyTVar' c (\Chart{..} -> let fillerThread = tid in Chart{..})
@ -110,14 +126,14 @@ toCachePoint (t,as) = ChartPoint t m vol [OLHC o l h c]
l = minimum as' l = minimum as'
h = maximum as' h = maximum as'
getUpdatedChartCache :: MonadIO m => Chart -> Maybe ChartCacheSettings -> m (Maybe TimePoint, ChartCacheData) getUpdatedChartCache :: Chart -> Maybe ChartCacheSettings -> RIO App (Maybe TimePoint, ChartCacheData)
getUpdatedChartCache Chart{..} chartCacheSettings' = do getUpdatedChartCache Chart{..} chartCacheSettings' = do
let ChartCacheSettings cRes cTicks = fromMaybe chartCacheSettings chartCacheSettings' let ChartCacheSettings cRes cTicks = fromMaybe chartCacheSettings chartCacheSettings'
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
-- - recalculate cacheUpdateStart & cacheUpdateEnd -- - recalculate cacheUpdateStart & cacheUpdateEnd
let cacheUpdateEnd = (utcTimeToSeconds now + cRes) `div` cRes let cacheUpdateEnd = ((utcTimeToSeconds now + cRes) `div` cRes) * cRes
cacheUpdateStart = cacheUpdateEnd - (cRes * cTicks) cacheUpdateStart = cacheUpdateEnd - (cRes * cTicks)
ChartCacheData ccData ccRange ccFill = chartCache ChartCacheData ccData ccAxis ccRange ccFill = chartCache
chunks = case ccFill of chunks = case ccFill of
Nothing -> [(cacheUpdateStart, cacheUpdateEnd)] Nothing -> [(cacheUpdateStart, cacheUpdateEnd)]
Just (mi, ma) -> if Just (mi, ma) -> if
@ -131,32 +147,30 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
| otherwise -> [] | otherwise -> []
| otherwise -> [] | otherwise -> []
-- - chunk them with chunhChart -- - chunk them with chunhChart
chunkedChart = L.concat $ for chunks $ \(start, end) -> chunkChart (min 0 start) end cRes chartData chunkedChart = L.filter (not . null . snd) $ L.concat $ for chunks $ \(start, end) -> chunkChart (min 0 start) end cRes chartData
lUpdate = cacheUpdateEnd - cRes lUpdate = cacheUpdateEnd - cRes
-- - calculate Range and need for shift -- - calculate Range and need for shift
shiftNeccessary = case ccRange of shiftNeccessary = case ccRange of
Nothing -> False Nothing -> False
Just (_,ma) -> cacheUpdateEnd > ma Just (_,ma) -> cacheUpdateEnd > ma
(newRange, shiftInterval) = if not shiftNeccessary && isJust ccRange then (fromJust ccRange, 0) else (newRange, shiftInterval) = if not shiftNeccessary && isJust ccRange then (fromJust ccRange, 0) else
let interval = (cTicks + 20) `div` 20 :: Int let interval = cTicks `div` 20 :: Int
iTo = (cacheUpdateEnd + cRes * interval) `div` (cRes * interval) iTo = ((cacheUpdateEnd + cRes * interval) `div` (cRes * interval)) * (cRes * interval)
iFrom = iTo - 20 * (cRes * interval) iFrom = iTo - 20 * (cRes * interval)
in ((iFrom,iTo), 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 -- create data for updates
let timePointToIndex' :: (Int, Int) -> (Int, Int) -> TimePoint -> Int let timePointToIndex' :: TimePoint -> Int
timePointToIndex' (cRes', cTicks') (rFrom, rTo) (TimePoint p) = let result = (p - rFrom) `div` cRes in timePointToIndex' = timePointToIndex (Just $ ChartCacheSettings cRes cTicks) newRange
if let indexToTimePoint' :: Int -> TimePoint
| p < rFrom || p > rTo -> error $ "timePointToIndex' " <> show ((cRes', cTicks'),(rFrom, rTo),TimePoint p) <> ": " <> show p <> " out of range." indexToTimePoint' = indexToTimePoint (Just $ ChartCacheSettings cRes cTicks) newRange
| result < 0 || result >= cTicks' -> error $ "timePointToIndex' " <> show ((cRes', cTicks'),(rFrom, rTo),TimePoint p) <> ": " <> show result <> " is invalid index" -- fold instead of map, so we can carry over cached calculatinos from element to element (for i.e. ema/sma)
| otherwise -> result let (!foldedData,_,_) = foldl' folder ([], ChartPoint 0 0 0 [], mempty) chunkedChart
timePointToIndex :: TimePoint -> Int
timePointToIndex = timePointToIndex' newRange (cRes, cTicks)
-- fold instead of map, so we can carry over cached calculatinos from element to element (for i.e. ema/sma)
(!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 :: ([(Int, ChartPoint)], ChartPoint, HM.HashMap Int [Float]) -> (TimePoint, [ChartPoint]) -> ([(Int, ChartPoint)], ChartPoint, HM.HashMap Int [Float])
folder old (_,[]) = old folder old (_,[]) = old
folder (acc, lastPoint, smaMap) (tp,cdata) = ((timePointToIndex tp, cp):acc, cp, foldl' (.) id smaUpdates smaMap) folder (acc, lastPoint, smaMap) (tp,cdata) = ((timePointToIndex' tp, cp):acc, cp, foldl' (.) id smaUpdates smaMap)
where where
cp = ChartPoint tp m vol studies cp = ChartPoint tp m vol studies
(studies, smaUpdates) = unzip $ catMaybes $ (chartStudySettings chartSettings :: [ChartStudyType]) <&> \case (studies, smaUpdates) = unzip $ catMaybes $ (chartStudySettings chartSettings :: [ChartStudyType]) <&> \case
@ -203,10 +217,30 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
ChartStudyTypeClose -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,olhc_close $ findOLHC s)) <$> foldedData)) ChartStudyTypeClose -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,olhc_close $ findOLHC s)) <$> foldedData))
ChartStudyTypeSMA x -> id --TODO: implement #13 ChartStudyTypeSMA x -> id --TODO: implement #13
ChartStudyTypeVolume -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,volume $ findVolume s)) <$> foldedData)) ChartStudyTypeVolume -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,volume $ findVolume s)) <$> foldedData))
return (Just $ TimePoint lUpdate, ChartCacheData (foldl' (.) id updates ccData) (Just newRange) Nothing) -- FIXME: fillData still missing 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)))
getChunkedDay :: Chart -> Maybe Int -> (Maybe TimePoint, [ChartPoint]) getChunkedDay :: Chart -> Maybe Int -> (Maybe TimePoint, [ChartPoint])
getChunkedDay Chart{..} chunkResolution = (lUpdate, toCachePoint <$> chunkedData) getChunkedDay Chart{..} chunkResolution = (lUpdate, toCachePoint <$> chunkedData)
where where
chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData
lUpdate = fmap fst . lastMaybe $ chunkedData lUpdate = fmap fst . lastMaybe $ chunkedData
indexToTimePoint :: Maybe ChartCacheSettings -> (Int, Int) -> Int -> TimePoint
indexToTimePoint ccs (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
where
ChartCacheSettings cRes cTicks = fromMaybe defChartCacheSettings ccs
result = (p - rFrom) `div` cRes

View File

@ -4,24 +4,24 @@
module Run (run) where module Run (run) where
import Import import Import
import Chart
import Types import Types
import Chart
import Control.Concurrent import Control.Concurrent
import Data.Aeson (encodeFile) import Data.Aeson (encodeFile)
import Data.Bits import Data.Bits
import Data.FingerTree (ViewL(..), ViewR(..), viewl, viewr, split, FingerTree) import Data.FingerTree (ViewL(..), ViewR(..), viewl, viewr, split, FingerTree)
import DearImGui import Data.Maybe (fromJust)
import DearImGui.Plot
import DearImGui.OpenGL3
import DearImGui.SDL
import Data.Time.Clock import Data.Time.Clock
import Data.Tuple.Extra
import DearImGui
import DearImGui.OpenGL3
import DearImGui.Plot
import DearImGui.SDL
import Graphics.GL import Graphics.GL
import SDL import SDL
--import Data.StateVar
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.List as L
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
--import qualified Data.FingerTree as FT import qualified Data.Vector.Storable as VS
import IBClient.Connection import IBClient.Connection
@ -232,8 +232,16 @@ renderLoop = do
withPlot "Test" $ do withPlot "Test" $ do
-- TODO: set axes -- TODO: set axes
-- let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache -- let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache
-- plotLine (T.unpack symbol) x y setupAxisLimits (both fromIntegral $ fromMaybe (0,86400) $ chartCacheCurrent chartCache) (-100,2500) Nothing
return () let ChartCacheSettings _ cTicks = chartCacheSettings
(f, t) = fromMaybe (0, cTicks) $ 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 (isJust direct) $ do
plotLine (T.unpack symbol) (dataSliceLine x) (dataSliceLine $ fromJust direct)
return () return ()

View File

@ -36,7 +36,8 @@ data Options = Options
data WindowParams = WindowParams data WindowParams = WindowParams
{ _windowWidth :: Int { _windowWidth :: Int
, _windowHeight :: Int , _windowHeight :: Int
} deriving (Show, Generic, FromJSON, ToJSON) } deriving stock (Show, Generic)
deriving anyclass (FromJSON, ToJSON)
instance Default WindowParams where instance Default WindowParams where
def = WindowParams 1024 768 def = WindowParams 1024 768
@ -44,7 +45,8 @@ instance Default WindowParams where
data TWSConnection = TWSConnection data TWSConnection = TWSConnection
{ _host :: Text { _host :: Text
, _port :: Text , _port :: Text
} deriving (Show, Generic, FromJSON, ToJSON) } deriving stock (Show, Generic)
deriving anyclass (FromJSON, ToJSON)
instance Default TWSConnection where instance Default TWSConnection where
def = TWSConnection "127.0.0.1" "7497" def = TWSConnection "127.0.0.1" "7497"
@ -68,7 +70,8 @@ data Settings = Settings
{ _windowParams :: WindowParams { _windowParams :: WindowParams
, _twsConnection :: TWSConnection , _twsConnection :: TWSConnection
, _logLevel :: LogLevel , _logLevel :: LogLevel
} deriving (Show, Generic, FromJSON, ToJSON) } deriving stock (Show, Generic)
deriving anyclass (FromJSON, ToJSON)
makeLenses ''WindowParams makeLenses ''WindowParams
makeLenses ''TWSConnection makeLenses ''TWSConnection
@ -80,7 +83,7 @@ instance Default Settings where
data TWSConnectionStatus = TWSDisconnected data TWSConnectionStatus = TWSDisconnected
| TWSConnecting | TWSConnecting
| TWSConnected | TWSConnected
deriving (Show, Eq, Enum, Bounded) deriving stock (Show, Eq, Enum, Bounded)
data TWSConnectionRefs = TWSConnectionRefs data TWSConnectionRefs = TWSConnectionRefs
{ twsConnectionRefsHost :: TVar Text { twsConnectionRefsHost :: TVar Text
@ -115,14 +118,14 @@ data IBAccount = IBAccount
{ _accountInfo :: IBAccountInfo { _accountInfo :: IBAccountInfo
, _accountPortfolio :: [IBPortfolioValue] , _accountPortfolio :: [IBPortfolioValue]
, _accountStrategies :: [IBAccountStrategy] , _accountStrategies :: [IBAccountStrategy]
} deriving (Show, Eq) } deriving stock (Show, Eq)
data IBAccountInfo = IBAccountInfo data IBAccountInfo = IBAccountInfo
{ _accountName :: Text { _accountName :: Text
, _accountProperties :: HashMap Text [(Text, Text)] -- (value, currency) , _accountProperties :: HashMap Text [(Text, Text)] -- (value, currency)
, _accountLastUpdate :: Text , _accountLastUpdate :: Text
} deriving (Show, Eq) } deriving stock (Show, Eq)
data IBPortfolioValue = IBPortfolioValue data IBPortfolioValue = IBPortfolioValue
{ _contract :: IBContract { _contract :: IBContract
@ -132,10 +135,11 @@ data IBPortfolioValue = IBPortfolioValue
, _averageCost :: Float , _averageCost :: Float
, _unrealizedPNL :: Float , _unrealizedPNL :: Float
, _realizedPNL :: Float , _realizedPNL :: Float
} deriving (Show, Eq) } deriving stock (Show, Eq)
newtype IBAccountStrategy = IBAccountStrategy [Int] -- Int -> contract-id for this strategy newtype IBAccountStrategy = IBAccountStrategy [Int] -- Int -> contract-id for this strategy
deriving newtype (Show, Eq) deriving stock (Show)
deriving newtype (Eq)
data IBSymbolSample = IBSymbolSample data IBSymbolSample = IBSymbolSample
{ _symbolId :: Int { _symbolId :: Int
@ -144,7 +148,7 @@ data IBSymbolSample = IBSymbolSample
, _primaryExchange :: Text , _primaryExchange :: Text
, _currency :: Text , _currency :: Text
, _derivatives :: [Text] , _derivatives :: [Text]
} deriving (Show, Eq) } deriving stock (Show, Eq)
makeLenses ''IBAccountStrategy makeLenses ''IBAccountStrategy
makeLenses ''IBAccountInfo makeLenses ''IBAccountInfo
@ -155,7 +159,7 @@ data ChartSettings = ChartSettings
, chartStart :: Maybe UTCTime , chartStart :: Maybe UTCTime
, chartEnd :: Maybe UTCTime , chartEnd :: Maybe UTCTime
, chartStudySettings :: [ChartStudyType] , chartStudySettings :: [ChartStudyType]
} deriving (Show, Eq) } deriving stock (Show, Eq)
defChartSettings :: ChartSettings defChartSettings :: ChartSettings
defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect] defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
@ -163,7 +167,7 @@ defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
updateChartStudySettings Chart{..} s = updateChartStudySettings Chart{..} s =
let chartSettings = chartSettings { chartStudySettings = [] } let chartSettings = chartSettings { chartStudySettings = [] }
chartCache = emptyChartCacheData chartCache = emptyChartCacheData chartCacheSettings
lastCacheUpdate = Nothing lastCacheUpdate = Nothing
in Chart{..} in Chart{..}
@ -171,6 +175,9 @@ updateChartStudySettings Chart{..} s =
-- --
-- History and Resolution yield 1 day by default. Do not increase over 5000 as memery-consumption explodes! -- History and Resolution yield 1 day by default. Do not increase over 5000 as memery-consumption explodes!
-- Think of it as timePlotted = candleWidth * numberOfCandles -- Think of it as timePlotted = candleWidth * numberOfCandles
--
-- chartCacheHistory should be a multiple of 20 as there often is 5% buffer in various caches and this
-- fills the caches more optimally
data ChartCacheSettings = ChartCacheSettings data ChartCacheSettings = ChartCacheSettings
{ chartCacheResolution :: Int { chartCacheResolution :: Int
, chartCacheHistory :: Int , chartCacheHistory :: Int
@ -189,18 +196,21 @@ newtype TimePoint = TimePoint Int
data ChartStudies = SMA { window :: Int, value :: Float } data ChartStudies = SMA { window :: Int, value :: Float }
| OLHC { olhc_open :: Float, olhc_low :: Float, olhc_high :: Float, olhc_close :: Float} | OLHC { olhc_open :: Float, olhc_low :: Float, olhc_high :: Float, olhc_close :: Float}
| Volume { volume :: Float } | Volume { volume :: Float }
deriving (Show, Eq, Generic, FromJSON, ToJSON) deriving stock (Show, Eq, Generic)
deriving anyclass (FromJSON, ToJSON)
data ChartPoint = ChartPoint data ChartPoint = ChartPoint
{ timeOfDay :: TimePoint { timeOfDay :: TimePoint
, pointValue :: Float , pointValue :: Float
, pointVolume :: Float , pointVolume :: Float
, pointExtra :: [ChartStudies] , pointExtra :: [ChartStudies]
} deriving (Show, Eq, Generic, FromJSON, ToJSON) } deriving stock (Show, Eq, Generic)
deriving anyclass (FromJSON, ToJSON)
instance Measured TimePoint ChartPoint where instance Measured TimePoint ChartPoint where
measure = timeOfDay measure = timeOfDay
-- | Tick-based data
data ChartStudyType = ChartStudyTypeDirect data ChartStudyType = ChartStudyTypeDirect
| ChartStudyTypeSMA Int | ChartStudyTypeSMA Int
| ChartStudyTypeOpen | ChartStudyTypeOpen
@ -212,13 +222,14 @@ data ChartStudyType = ChartStudyTypeDirect
deriving anyclass (Hashable) deriving anyclass (Hashable)
data ChartCacheData = ChartCacheData data ChartCacheData = ChartCacheData
{ chartCacheData :: HashMap ChartStudyType (VS.Vector Float) { chartCacheData :: HashMap ChartStudyType (VS.Vector Float)
, chartCacheCurrent :: Maybe (Int,Int) -- ^ in number of TimePoint, negative meaning "before today" , chartCacheAxis :: VS.Vector Float
, chartCacheFilled :: Maybe (Int,Int) -- ^ in number of TimePoint, negative meaning "before today" , chartCacheCurrent :: Maybe (Int,Int) -- ^ in number of TimePoint, negative meaning "before today"
, chartCacheFilledTo :: Maybe (Int,Int) -- ^ in index into the vectors given range of "Current"
} deriving stock (Show, Eq) } deriving stock (Show, Eq)
emptyChartCacheData :: ChartCacheData emptyChartCacheData :: ChartCacheSettings -> ChartCacheData
emptyChartCacheData = ChartCacheData mempty Nothing Nothing emptyChartCacheData ChartCacheSettings{..} = ChartCacheData mempty (VS.replicate chartCacheHistory 0) Nothing Nothing
data Chart = Chart data Chart = Chart
{ chartContractID :: Int { chartContractID :: Int
@ -230,7 +241,7 @@ data Chart = Chart
, chartCache :: ChartCacheData -- ^ cache for drawing with all pointExtra filled out and sampled according to 'chartSettings' , chartCache :: ChartCacheData -- ^ cache for drawing with all pointExtra filled out and sampled according to 'chartSettings'
, lastCacheUpdate :: Maybe TimePoint , lastCacheUpdate :: Maybe TimePoint
, chartDirty :: Bool , chartDirty :: Bool
} deriving (Show, Eq) } deriving stock (Show, Eq)
newtype InjetiveGettable a b = InjetiveGettable newtype InjetiveGettable a b = InjetiveGettable
{ gettable :: TVar a { gettable :: TVar a