From 16b4eb83e189d63dc180a744476457c4212afbd7 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Thu, 4 Aug 2022 05:25:46 +0200 Subject: [PATCH] #12 compiles, but untested --- ibhelper.cabal | 14 +++- src/AppFiller.hs | 8 +- src/Chart.hs | 191 +++++++++++++++++++++++++++++++----------- src/IBClient/Types.hs | 3 +- src/Import.hs | 4 + src/Run.hs | 15 ++-- src/Types.hs | 87 ++++++++++++------- 7 files changed, 233 insertions(+), 89 deletions(-) diff --git a/ibhelper.cabal b/ibhelper.cabal index bbc0d95..9ca103d 100644 --- a/ibhelper.cabal +++ b/ibhelper.cabal @@ -78,7 +78,18 @@ library TypeSynonymInstances ViewPatterns DuplicateRecordFields - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -static -dynamic-too + ghc-options: + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wpartial-fields + -Wredundant-constraints + -Wderiving-defaults + -Wmissing-deriving-strategies + -static + -dynamic-too -- include-dirs: -- deps/dear-implot.hs/implot -- deps/dear-imgui.hs/imgui @@ -109,6 +120,7 @@ library , time , type-iso , unordered-containers + , vector default-language: Haskell2010 executable ibhelper-exe diff --git a/src/AppFiller.hs b/src/AppFiller.hs index c217979..54c7085 100644 --- a/src/AppFiller.hs +++ b/src/AppFiller.hs @@ -37,11 +37,11 @@ appFiller app = runRIO app $ withRunInIO $ \run -> do $ unless (L.null as) $ switchAccountTo $ L.head as (Msg_IB_IN (IB_NextValidID i)) -> atomically $ modifyTVar' (nextValidID currentAppData) (const (Just i)) - (Msg_IB_IN (IB_ErrorMsg i c m)) -> debugMsg "IB_ErrorMsg not implemented" + (Msg_IB_IN (IB_ErrorMsg _i _c _m)) -> debugMsg "IB_ErrorMsg not implemented" (Msg_IB_IN (IB_AccountValue k v c n)) -> do let action = HM.update (\ai -> Just $ ai & accountInfo . accountProperties %~ HM.alter (\old -> Just $ (v,c):filter ((/=c) . snd) (fromMaybe [] old)) k) n atomically $ modifyTVar' (Types.accounts currentAppData) action - (Msg_IB_IN (IB_AccountUpdateTime t)) -> debugMsg "IB_AccountUpdateTime not implemented" + (Msg_IB_IN (IB_AccountUpdateTime _t)) -> debugMsg "IB_AccountUpdateTime not implemented" -- (Msg_IB_IN (IB_AccountUpdateTime t)) -> do -- let action = HM.update (\ai -> Just $ ai & accountInfo . accountLastUpdate %~ const t) n -- atomically $ modifyTVar' (Types.accounts currentAppData) action @@ -72,8 +72,8 @@ handleTickPrice IB_TickPrice{..} = do chartVar <- (HM.!s) <$> liftIO (readTVarIO charts) case tickType of IBTickType_Last_Price -> do - t <- utctDayTime <$> liftIO getCurrentTime - let cp = ChartPoint (TimePoint $ fromInteger. (`div` 1000000000000) . diffTimeToPicoseconds $ t) price size [] + t <- utcTimeToSeconds <$> liftIO getCurrentTime + let cp = ChartPoint (TimePoint t) price (fromIntegral size) [] 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 4abdee9..cac3d2c 100644 --- a/src/Chart.hs +++ b/src/Chart.hs @@ -3,32 +3,33 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -module Chart (newChart, FillerException(..), getUpdatedChartCache) where +module Chart (newChart, FillerException(..), getUpdatedChartCache, getChunkedDay) where import Import -import Data.Aeson (eitherDecodeFileStrict') -import RIO.List -import RIO.List.Partial -import RIO.FilePath -import Data.Time.Calendar (Day(..)) -import Data.FingerTree (FingerTree) import Control.Concurrent (forkIO) import Control.Monad.Extra (ifM) -import qualified RIO.ByteString as BS --- import Control.Exception -import qualified Data.HashMap.Strict as HM -import qualified Data.FingerTree as FT -import qualified Data.Text as T +import Data.Aeson (eitherDecodeFileStrict') +import Data.FingerTree (FingerTree) +import Data.Time.Calendar (Day(..)) +import Data.Time.Clock +import Data.Maybe (fromJust) +import RIO.FilePath +import RIO.List +import RIO.List.Partial -import qualified Debug.Trace as D +import qualified Data.FingerTree as FT +import qualified Data.HashMap.Strict as HM +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 data FillerException = QuitFiller - deriving Show + deriving stock Show instance Exception FillerException ---deriving via Integer instance Hashable Day - newChart :: IBContract -> RIO App () newChart contract = do app <- ask @@ -51,7 +52,7 @@ newChart contract = do 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' logError $ displayShow $ HM.keys cacheData'' - c <- liftIO $ newTVarIO $ Chart con (fromMaybe FT.empty $ cacheData'' HM.!? today) (HM.delete today cacheData'') undefined defChartSettings [] Nothing False + c <- liftIO $ newTVarIO $ Chart con (fromMaybe FT.empty $ cacheData'' HM.!? today) (HM.delete today cacheData'') undefined defChartSettings defChartCacheSettings emptyChartCacheData Nothing False tid <- liftIO $ forkIO $ fillChart app contract c liftIO $ atomically $ do modifyTVar' c (\Chart{..} -> let fillerThread = tid in Chart{..}) @@ -67,7 +68,7 @@ fillChart app contract cVar = runRIO app $ do let cancelSubscription = liftIO $ atomically $ do modifyTVar tickerMapVar (HM.delete tickerId) -- TODO: send cancel-request - let sendQ = twsConnectionSend $ twsConnectionRefs $ appRefs $ app + let sendQ = twsConnectionSend . twsConnectionRefs . appRefs $ app liftIO $ atomically $ do modifyTVar tickerMapVar (HM.insert tickerId sym) writeTQueue sendQ $ Msg_IB_OUT $ IB_RequestMktData tickerId contract "233" False False @@ -76,40 +77,136 @@ fillChart app contract cVar = runRIO app $ do -- chart dirty? set clean & begin work c <- liftIO (readTVarIO cVar) when (chartDirty c) $ do - liftIO $ atomically $ modifyTVar cVar (\c -> c { chartDirty = False }) - let (lUpdate, cachePoints) = getUpdatedChartCache c Nothing - liftIO $ atomically $ modifyTVar cVar (\c -> c { chartCache = cachePoints, lastCacheUpdate = lUpdate }) + 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 -getUpdatedChartCache :: Chart -> Maybe ChartSettings -> (Maybe TimePoint, [ChartPoint]) -getUpdatedChartCache Chart{..} chartSettings' = (lUpdate, takeWhile (\ChartPoint{..} -> (\(TimePoint x) -> x < cacheUpdateStart) timeOfDay) chartCache <> map toCachePoint chunkedChart) - where (TimePoint cacheUpdateStart) = fromMaybe (TimePoint 0) Nothing -- TODO: lastCacheUpdate - cacheUpdateEnd = 86400 - chunkChart :: Int -> Int -> Int -> FingerTree TimePoint ChartPoint -> [(TimePoint,[ChartPoint])] - chunkChart from until range tree = go from range 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) - $ 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 - chunkedChart = chunkChart cacheUpdateStart cacheUpdateEnd (chartResolution $ fromMaybe chartSettings chartSettings') chartData - lUpdate = fmap fst . lastMaybe $ chunkedChart - toCachePoint :: (TimePoint,[ChartPoint]) -> ChartPoint - toCachePoint (t,[]) = ChartPoint t (-1) 0 [] - toCachePoint (t,as) = ChartPoint t m vol [OLHC o l h c] +chunkChart :: Int -> Int -> Int -> FingerTree TimePoint ChartPoint -> [(TimePoint,[ChartPoint])] +chunkChart from until range tree = go from range 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) + $ 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 + +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 :: MonadIO m => Chart -> Maybe ChartCacheSettings -> m (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 + cacheUpdateStart = cacheUpdateEnd - (cRes * cTicks) + ChartCacheData ccData 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.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 + 20) `div` 20 :: Int + iTo = (cacheUpdateEnd + cRes * interval) `div` (cRes * interval) + iFrom = iTo - 20 * (cRes * interval) + in ((iFrom,iTo), interval) + + -- create data for updates + let timePointToIndex' :: (Int, Int) -> (Int, Int) -> TimePoint -> Int + timePointToIndex' (cRes', cTicks') (rFrom, rTo) (TimePoint p) = let result = (p - rFrom) `div` cRes in + 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 :: 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 old (_,[]) = old + folder (acc, lastPoint, smaMap) (tp,cdata) = ((timePointToIndex tp, cp):acc, cp, foldl' (.) id smaUpdates smaMap) where - vol = sum $ volume <$> as - as' = pointValue <$> as - ms' = sum $ (\x -> pointValue x * fromIntegral (volume x)) <$> as - m = ms' / fromIntegral vol + cp = ChartPoint tp m vol studies + (studies, smaUpdates) = unzip $ catMaybes $ (chartStudySettings chartSettings :: [ChartStudyType]) <&> \case + ChartStudyTypeOpen -> Just (OLHC o l h c, id) + 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 vol, id) + vol = sum $ pointVolume <$> cdata + as' = pointValue <$> cdata + ms' = sum $ (\x -> pointValue x * pointVolume x) <$> cdata + m = ms' / vol o = head as' c = last as' l = minimum as' h = maximum as' + -- plan the actual work + updates = chartStudySettings chartSettings <&> \cs -> + -- check if thing is in hashmap + let vec = case ccData HM.!? cs of + Nothing -> VS.replicate cTicks 0 + Just a -> a + -- shift if neccessary + vec' = if shiftNeccessary && cs `HM.member` ccData 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) + else + vec + -- NOW: + -- newRange is (rangeFrom, rangeTo) in seconds with 0 being last midnight + -- vec' has that range mapped to indices [0,cTicks-1] with every cRes being one time-slice + -- everything in the chunkedChart-list has to be inserted if in range using the same time-notation like the range + -- (hint: chunkedChart is (time, [data]), with time being the point at the end of each contained interval) + findOLHC as = fromJust $ find (\case OLHC{} -> True; _ -> False) as + findVolume as = fromJust $ find (\case Volume{} -> True; _ -> False) as + in case cs of + ChartStudyTypeDirect -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ x _ _) -> (i,x)) <$> foldedData)) + ChartStudyTypeOpen -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,olhc_open $ findOLHC s)) <$> foldedData)) + ChartStudyTypeLow -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,olhc_low $ findOLHC s)) <$> foldedData)) + ChartStudyTypeHigh -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,olhc_high $ findOLHC s)) <$> foldedData)) + ChartStudyTypeClose -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,olhc_close $ findOLHC s)) <$> foldedData)) + ChartStudyTypeSMA x -> id --TODO: implement #13 + 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 + +getChunkedDay :: Chart -> Maybe Int -> (Maybe TimePoint, [ChartPoint]) +getChunkedDay Chart{..} chunkResolution = (lUpdate, toCachePoint <$> chunkedData) + where + chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData + lUpdate = fmap fst . lastMaybe $ chunkedData diff --git a/src/IBClient/Types.hs b/src/IBClient/Types.hs index ef4ea47..0718679 100644 --- a/src/IBClient/Types.hs +++ b/src/IBClient/Types.hs @@ -44,7 +44,8 @@ toBS (IBBool False) = "0"--BS.pack [0,0,0,0] -- bool == 32-bit int in IB newtype IBGenericMessage = IBGenericMessage { fields :: [IBTypes] - } deriving (Show, Eq) + } deriving stock (Show) + deriving newtype (Eq) instance Binary IBGenericMessage where put (IBGenericMessage f) = do diff --git a/src/Import.hs b/src/Import.hs index 724ca09..9c70b62 100644 --- a/src/Import.hs +++ b/src/Import.hs @@ -10,6 +10,7 @@ module Import , ppShow' , getCurrentDay , switchAccountTo + , utcTimeToSeconds ) where import RIO @@ -44,3 +45,6 @@ switchAccountTo a = do liftIO $ atomically $ writeTQueue sendQ $ Msg_IB_OUT $ IB_RequestAccountData True a -- finally change liftIO $ atomically $ modifyTVar' (currentAccount refs') (const $ Just a) + +utcTimeToSeconds :: UTCTime -> Int +utcTimeToSeconds = fromInteger . (`div` ((10 :: Integer)^(12 :: Integer))) . diffTimeToPicoseconds . utctDayTime diff --git a/src/Run.hs b/src/Run.hs index 4288a59..e07154d 100644 --- a/src/Run.hs +++ b/src/Run.hs @@ -24,7 +24,6 @@ import qualified Data.HashMap.Strict as HM --import qualified Data.FingerTree as FT import IBClient.Connection -import Import (Chart(chartContractID)) run :: RIO App () run = do @@ -52,13 +51,13 @@ shutdownApp = do -- save cached data liftIO $ unlessM (doesDirectoryExist "cache") $ createDirectory "cache" charts <- liftIO . readTVarIO . appCharts $ refs - forM_ (HM.toList charts) $ \(symbol,tc) -> do + forM_ (HM.toList charts) $ \(_symbol,tc) -> do c@Chart{..} <- liftIO . readTVarIO $ tc today <- liftIO $ utctDay <$> getCurrentTime liftIO $ unlessM (doesDirectoryExist $ "cache/" <> show chartContractID) $ createDirectory $ "cache/" <> show chartContractID - let (_, chartData') = getUpdatedChartCache c (Just $ ChartSettings 5 Nothing Nothing) + let (_, chartData') = getChunkedDay c (Just 5) newData = HM.toList - . fmap (filter (\ChartPoint{..} -> 0 /= volume)) + . fmap (filter (\ChartPoint{..} -> 0 /= pointVolume)) . HM.alter (Just . maybe chartData' (<>chartData')) today . fmap toList $ chartHistData @@ -165,7 +164,7 @@ renderLoop = do tableSetupColumn "AVG" tableSetupColumn "Market Value" tableHeadersRow - forM_ ((accs HM.! aid) ^.. accountPortfolio . traverse) $ \(IBPortfolioValue c p mp mv ac up rp) -> + forM_ ((accs HM.! aid) ^.. accountPortfolio . traverse) $ \(IBPortfolioValue c p mp mv _ac up rp) -> do tableNextRow tableNextColumn $ text $ localSymbol c @@ -203,7 +202,7 @@ renderLoop = do when mustSort $ liftIO $ pPrint sortSpecs tableHeadersRow lResult <- readTVarIO $ symbolLookupResults data' - forM_ lResult $ \contract@IBSymbolSample{..} -> do + forM_ lResult $ \IBSymbolSample{..} -> do let popupName = fromString $ "SymbolAction"<>show _symbolId withPopup popupName $ \isPopupOpen -> do when isPopupOpen $ do @@ -232,8 +231,8 @@ renderLoop = do (_ :> ChartPoint{..}) -> text $ fromString $ "Last: " <> show pointValue <> "\nTime: " <> show timeOfDay withPlot "Test" $ do -- TODO: set axes - let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache - plotLine (T.unpack symbol) x y + -- let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache + -- plotLine (T.unpack symbol) x y return () return () diff --git a/src/Types.hs b/src/Types.hs index daeda8e..81d18e3 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -24,6 +24,7 @@ import RIO import RIO.Process import Lens.Micro.TH import qualified Data.Text as T +import qualified Data.Vector.Storable as VS import IBClient.Types @@ -134,7 +135,7 @@ data IBPortfolioValue = IBPortfolioValue } deriving (Show, Eq) newtype IBAccountStrategy = IBAccountStrategy [Int] -- Int -> contract-id for this strategy - deriving (Show, Eq) + deriving newtype (Show, Eq) data IBSymbolSample = IBSymbolSample { _symbolId :: Int @@ -150,55 +151,85 @@ makeLenses ''IBAccountInfo makeLenses ''IBAccount data ChartSettings = ChartSettings - { chartResolution :: Int - , chartStart :: Maybe UTCTime - , chartEnd :: Maybe UTCTime + { chartResolution :: Int + , chartStart :: Maybe UTCTime + , chartEnd :: Maybe UTCTime + , chartStudySettings :: [ChartStudyType] } deriving (Show, Eq) defChartSettings :: ChartSettings -defChartSettings = ChartSettings 60 Nothing Nothing +defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect] --- data TimeWindow = TimeWindow --- { begin :: Int --- , end :: Int --- } deriving (Show, Eq) +updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart +updateChartStudySettings Chart{..} s = + let chartSettings = chartSettings { chartStudySettings = [] } + chartCache = emptyChartCacheData + lastCacheUpdate = Nothing + in Chart{..} + +-- | Settings for Chart-cache. -- --- instance Semigroup TimeWindow where --- (TimeWindow a b) <> (TimeWindow x y) = TimeWindow (min a x) (max b y) --- --- instance Monoid TimeWindow where --- mempty = TimeWindow 0 86400 +-- History and Resolution yield 1 day by default. Do not increase over 5000 as memery-consumption explodes! +-- Think of it as timePlotted = candleWidth * numberOfCandles +data ChartCacheSettings = ChartCacheSettings + { chartCacheResolution :: Int + , chartCacheHistory :: Int + } deriving stock (Show, Eq) + +defChartCacheSettings :: ChartCacheSettings +defChartCacheSettings = ChartCacheSettings 60 1440 -- TODO: TimePointFloat? or only 1 entry per second? newtype TimePoint = TimePoint Int - deriving (Eq, Generic) - deriving newtype (Show, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON) + deriving stock (Generic) + deriving newtype (Show, Eq, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON) deriving (Semigroup, Monoid) via (Max Int) data ChartStudies = SMA { window :: Int, value :: Float } | OLHC { olhc_open :: Float, olhc_low :: Float, olhc_high :: Float, olhc_close :: Float} + | Volume { volume :: Float } deriving (Show, Eq, Generic, FromJSON, ToJSON) data ChartPoint = ChartPoint - { timeOfDay :: TimePoint - , pointValue :: Float - , volume :: Int - , pointExtra :: [ChartStudies] + { timeOfDay :: TimePoint + , pointValue :: Float + , pointVolume :: Float + , pointExtra :: [ChartStudies] } deriving (Show, Eq, Generic, FromJSON, ToJSON) instance Measured TimePoint ChartPoint where measure = timeOfDay +data ChartStudyType = ChartStudyTypeDirect + | ChartStudyTypeSMA Int + | ChartStudyTypeOpen + | ChartStudyTypeLow + | ChartStudyTypeHigh + | ChartStudyTypeClose + | ChartStudyTypeVolume + deriving stock (Show, Eq, Generic) + deriving anyclass (Hashable) + +data ChartCacheData = ChartCacheData + { chartCacheData :: HashMap ChartStudyType (VS.Vector Float) + , chartCacheCurrent :: Maybe (Int,Int) -- ^ in number of TimePoint, negative meaning "before today" + , chartCacheFilled :: Maybe (Int,Int) -- ^ in number of TimePoint, negative meaning "before today" + } deriving stock (Show, Eq) + +emptyChartCacheData :: ChartCacheData +emptyChartCacheData = ChartCacheData mempty Nothing Nothing + data Chart = Chart - { chartContractID :: Int - , chartData :: FingerTree TimePoint ChartPoint -- ^ raw data (time & sale) - , chartHistData :: HashMap Day (FingerTree TimePoint ChartPoint) -- ^ raw data (time & sale) - , fillerThread :: ThreadId - , chartSettings :: ChartSettings - , chartCache :: [ChartPoint] -- ^ cache for drawing with all pointExtra filled out and sampled according to 'chartSettings' - , lastCacheUpdate :: Maybe TimePoint - , chartDirty :: Bool + { chartContractID :: Int + , chartData :: FingerTree TimePoint ChartPoint -- ^ raw data (time & sale) + , chartHistData :: HashMap Day (FingerTree TimePoint ChartPoint) -- ^ raw data (time & sale) + , fillerThread :: ThreadId + , chartSettings :: ChartSettings + , chartCacheSettings :: ChartCacheSettings + , chartCache :: ChartCacheData -- ^ cache for drawing with all pointExtra filled out and sampled according to 'chartSettings' + , lastCacheUpdate :: Maybe TimePoint + , chartDirty :: Bool } deriving (Show, Eq) newtype InjetiveGettable a b = InjetiveGettable