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

deps/dear-implot.hs

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

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

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"

src/Chart.hs

@@ -3,32 +3,39 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE TupleSections #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-module Chart (newChart, FillerException(..), getUpdatedChartCache) where
+module Chart (newChart
+             , FillerException(..)
+             , getUpdatedChartCache
+             , getChunkedDay
+             , timePointToIndex
+             , indexToTimePoint
+             ) 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
@@ -39,6 +46,8 @@ newChart contract = do
   unless (sym `HM.member` hm) $ do
     today <- liftIO getCurrentDay :: RIO App Day
     (cacheErrors, cacheData) <- do
+        ifM (fmap not $ liftIO $ doesDirectoryExist $ "cache" </> show con)
+            (return $ (["no data-chache found for " <> show con], [])) $ do
                 files <- liftIO $ listDirectory $ "cache" </> show con
                 res <- forM files $ \cacheFileName -> do
                   let fname = "cache" </> show con </> cacheFileName
@@ -51,7 +60,15 @@ 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 defChartCacheSettings)
+                                    Nothing
+                                    False
     tid <- liftIO $ forkIO $ fillChart app contract c
     liftIO $ atomically $ do
       modifyTVar' c (\Chart{..} -> let fillerThread = tid in Chart{..})
@@ -67,7 +84,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,16 +93,12 @@ 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
@@ -99,17 +112,135 @@ getUpdatedChartCache Chart{..} chartSettings' = (lUpdate, takeWhile (\ChartPoint
         | 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]
   where
-              vol = sum $ volume <$> as
+    vol = sum $ pointVolume <$> as
     as' = pointValue <$> as
-              ms' = sum $ (\x -> pointValue x * fromIntegral (volume x)) <$> as
-              m = ms' / fromIntegral vol
+    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)
+            where
+              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))
+    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{..} chunkResolution = (lUpdate, toCachePoint <$> chunkedData)
+    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
+  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

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 

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

src/Run.hs

@@ -4,27 +4,26 @@
 module Run (run) where
 
 import Import
-import Chart
 import Types
+import Chart
 import Control.Concurrent
 import Data.Aeson (encodeFile)
 import Data.Bits
 import Data.FingerTree (ViewL(..), ViewR(..), viewl, viewr, split, FingerTree)
-import DearImGui
-import DearImGui.Plot
-import DearImGui.OpenGL3
-import DearImGui.SDL
+import Data.Maybe (fromJust)
 import Data.Time.Clock
+import Data.Tuple.Extra
+import DearImGui
+import DearImGui.OpenGL3
+import DearImGui.Plot
+import DearImGui.SDL
 import Graphics.GL
 import SDL
---import Data.StateVar
 import qualified Data.Text as T
-import qualified Data.List as L
 import qualified Data.HashMap.Strict as HM
---import qualified Data.FingerTree as FT
+import qualified Data.Vector.Storable as VS
 
 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,9 +231,17 @@ 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
-          return ()
+          -- let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache
+          setupAxisLimits (both fromIntegral $ fromMaybe (0,86400) $ chartCacheCurrent chartCache) (-100,2500) Nothing
+          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 ()
 
 

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
 
@@ -35,7 +36,8 @@ data Options = Options
 data WindowParams = WindowParams
   { _windowWidth :: Int
   , _windowHeight :: Int
-  } deriving (Show, Generic, FromJSON, ToJSON)
+  } deriving stock (Show, Generic)
+    deriving anyclass (FromJSON, ToJSON)
 
 instance Default WindowParams where
   def = WindowParams 1024 768
@@ -43,7 +45,8 @@ instance Default WindowParams where
 data TWSConnection = TWSConnection
   { _host :: Text
   , _port :: Text
-  } deriving (Show, Generic, FromJSON, ToJSON)
+  } deriving stock (Show, Generic)
+    deriving anyclass (FromJSON, ToJSON)
 
 instance Default TWSConnection where
   def = TWSConnection "127.0.0.1" "7497"
@@ -67,7 +70,8 @@ data Settings = Settings
   { _windowParams  :: WindowParams
   , _twsConnection :: TWSConnection
   , _logLevel      :: LogLevel
-  } deriving (Show, Generic, FromJSON, ToJSON)
+  } deriving stock (Show, Generic)
+    deriving anyclass (FromJSON, ToJSON)
 
 makeLenses ''WindowParams
 makeLenses ''TWSConnection
@@ -79,7 +83,7 @@ instance Default Settings where
 data TWSConnectionStatus = TWSDisconnected
                          | TWSConnecting
                          | TWSConnected
-                         deriving (Show, Eq, Enum, Bounded)
+                         deriving stock (Show, Eq, Enum, Bounded)
 
 data TWSConnectionRefs = TWSConnectionRefs
   { twsConnectionRefsHost :: TVar Text
@@ -114,14 +118,14 @@ data IBAccount = IBAccount
                { _accountInfo       :: IBAccountInfo
                , _accountPortfolio  :: [IBPortfolioValue]
                , _accountStrategies :: [IBAccountStrategy]
-               } deriving (Show, Eq)
+               } deriving stock (Show, Eq)
 
 
 data IBAccountInfo = IBAccountInfo
                    { _accountName       :: Text
                    , _accountProperties :: HashMap Text [(Text, Text)] -- (value, currency)
                    , _accountLastUpdate :: Text
-                   } deriving (Show, Eq)
+                   } deriving stock (Show, Eq)
 
 data IBPortfolioValue = IBPortfolioValue
                       { _contract      :: IBContract
@@ -131,10 +135,11 @@ data IBPortfolioValue = IBPortfolioValue
                       , _averageCost   :: Float
                       , _unrealizedPNL :: Float
                       , _realizedPNL   :: Float
-                      } deriving (Show, Eq)
+                      } deriving stock (Show, Eq)
 
 newtype IBAccountStrategy = IBAccountStrategy [Int] -- Int -> contract-id for this strategy
-  deriving (Show, Eq)
+  deriving stock (Show)
+  deriving newtype (Eq)
 
 data IBSymbolSample = IBSymbolSample
                     { _symbolId :: Int
@@ -143,7 +148,7 @@ data IBSymbolSample = IBSymbolSample
                     , _primaryExchange :: Text
                     , _currency :: Text
                     , _derivatives :: [Text]
-                    } deriving (Show, Eq)
+                    } deriving stock (Show, Eq)
 
 makeLenses ''IBAccountStrategy
 makeLenses ''IBAccountInfo
@@ -153,53 +158,90 @@ data ChartSettings = ChartSettings
                    { chartResolution    :: Int
                    , chartStart         :: Maybe UTCTime
                    , chartEnd           :: Maybe UTCTime
-                   } deriving (Show, Eq)
+                   , chartStudySettings :: [ChartStudyType]
+                   } deriving stock (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 chartCacheSettings
+        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)
+-- History and Resolution yield 1 day by default. Do not increase over 5000 as memery-consumption explodes!
+-- Think of it as timePlotted = candleWidth * numberOfCandles
 --
--- instance Monoid TimeWindow where
---   mempty = TimeWindow 0 86400
+-- 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
+                        { 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}
-                  deriving (Show, Eq, Generic, FromJSON, ToJSON)
+                  | Volume { volume :: Float }
+                  deriving stock (Show, Eq, Generic)
+                  deriving anyclass (FromJSON, ToJSON)
 
 data ChartPoint = ChartPoint
                 { timeOfDay   :: TimePoint
                 , pointValue  :: Float
-                , volume     :: Int
+                , pointVolume :: Float
                 , pointExtra  :: [ChartStudies]
-                } deriving (Show, Eq, Generic, FromJSON, ToJSON)
+                } deriving stock (Show, Eq, Generic)
+                  deriving anyclass (FromJSON, ToJSON)
 
 instance Measured TimePoint ChartPoint where
   measure = timeOfDay
 
+-- | Tick-based data
+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)
+                    , chartCacheAxis     :: VS.Vector Float
+                    , 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)
+
+emptyChartCacheData :: ChartCacheSettings -> ChartCacheData
+emptyChartCacheData ChartCacheSettings{..} = ChartCacheData mempty (VS.replicate chartCacheHistory 0) 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'
+           , 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)
+           } deriving stock (Show, Eq)
 
 newtype InjetiveGettable a b = InjetiveGettable
                           { gettable :: TVar a