deps/dear-implot.hs

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

ibhelper.cabal

@@ -78,18 +78,7 @@ library
       TypeSynonymInstances
       ViewPatterns
       DuplicateRecordFields
-  ghc-options:
-    -Wall
-    -Wcompat
-    -Widentities
-    -Wincomplete-record-updates
-    -Wincomplete-uni-patterns
-    -Wpartial-fields
-    -Wredundant-constraints
-    -Wderiving-defaults
-    -Wmissing-deriving-strategies
-    -static
-    -dynamic-too
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -static -dynamic-too
   -- include-dirs:
   --     deps/dear-implot.hs/implot
   --     deps/dear-imgui.hs/imgui
@@ -120,7 +109,6 @@ 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 <- utcTimeToSeconds <$> liftIO getCurrentTime
-              let cp = ChartPoint (TimePoint t) price (fromIntegral size) []
+              t <- utctDayTime <$> liftIO getCurrentTime
+              let cp = ChartPoint (TimePoint $ fromInteger. (`div` 1000000000000) . diffTimeToPicoseconds $ t) price size []
               liftIO $ atomically $ modifyTVar chartVar (\c@Chart{..} -> c { chartData = chartData |> cp, chartDirty = True})
           _ -> return ()
 handleTickPrice _ = error "impossible"

src/Chart.hs

@@ -3,39 +3,32 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE TupleSections #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-module Chart (newChart
-             , FillerException(..)
-             , getUpdatedChartCache
-             , getChunkedDay
-             , timePointToIndex
-             , indexToTimePoint
-             ) where
+module Chart (newChart, FillerException(..), getUpdatedChartCache) where
 
 import Import
-import Control.Concurrent (forkIO)
-import Control.Monad.Extra (ifM)
 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 Data.FingerTree as FT
+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.List as L
+import qualified Data.FingerTree as FT
 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
+  deriving Show
 
 instance Exception FillerException
 
+--deriving via Integer instance Hashable Day
+
 newChart :: IBContract -> RIO App ()
 newChart contract = do
   app <- ask
@@ -46,8 +39,6 @@ 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
@@ -60,15 +51,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
-                                    defChartCacheSettings
-                                    (emptyChartCacheData defChartCacheSettings)
-                                    Nothing
-                                    False
+    c <- liftIO $ newTVarIO $ Chart con (fromMaybe FT.empty $ cacheData'' HM.!? today) (HM.delete today cacheData'') undefined defChartSettings [] Nothing False
     tid <- liftIO $ forkIO $ fillChart app contract c
     liftIO $ atomically $ do
       modifyTVar' c (\Chart{..} -> let fillerThread = tid in Chart{..})
@@ -84,7 +67,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
@@ -93,14 +76,18 @@ 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 })
-          (lUpdate, cachePoints) <- getUpdatedChartCache c Nothing
-          liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartCache = cachePoints, lastCacheUpdate = lUpdate })
+          liftIO $ atomically $ modifyTVar cVar (\c -> c { chartDirty = False })
+          let (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
+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
@@ -112,135 +99,17 @@ chunkChart from until range tree = go from range interval
                   | 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]
+          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 $ pointVolume <$> as
+              vol = sum $ volume <$> as
               as' = pointValue <$> as
-    ms' = sum $ (\x -> pointValue x * pointVolume x) <$> as
-    m = ms' / vol
+              ms' = sum $ (\x -> pointValue x * fromIntegral (volume x)) <$> as
+              m = ms' / fromIntegral 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,8 +44,7 @@ toBS (IBBool False) = "0"--BS.pack [0,0,0,0] -- bool == 32-bit int in IB
 
 newtype IBGenericMessage = IBGenericMessage
                    { fields :: [IBTypes]
-                   } deriving stock (Show)
-                     deriving newtype (Eq)
+                   } deriving (Show, Eq)
 
 instance Binary IBGenericMessage where
   put (IBGenericMessage f) = do 

src/Import.hs

@@ -10,7 +10,6 @@ module Import
   , ppShow'
   , getCurrentDay
   , switchAccountTo
-  , utcTimeToSeconds
   ) where
 
 import RIO
@@ -45,6 +44,3 @@ 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,26 +4,27 @@
 module Run (run) where
 
 import Import
-import Types
 import Chart
+import Types
 import Control.Concurrent
 import Data.Aeson (encodeFile)
 import Data.Bits
 import Data.FingerTree (ViewL(..), ViewR(..), viewl, viewr, split, FingerTree)
-import Data.Maybe (fromJust)
-import Data.Time.Clock
-import Data.Tuple.Extra
 import DearImGui
-import DearImGui.OpenGL3
 import DearImGui.Plot
+import DearImGui.OpenGL3
 import DearImGui.SDL
+import Data.Time.Clock
 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.Vector.Storable as VS
+--import qualified Data.FingerTree as FT
 
 import IBClient.Connection
+import Import (Chart(chartContractID))
 
 run :: RIO App ()
 run = do
@@ -51,13 +52,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') = getChunkedDay c (Just 5)
+    let (_, chartData') = getUpdatedChartCache c (Just $ ChartSettings 5 Nothing Nothing)
         newData = HM.toList
-                . fmap (filter (\ChartPoint{..} -> 0 /= pointVolume))
+                . fmap (filter (\ChartPoint{..} -> 0 /= volume))
                 . HM.alter (Just . maybe chartData' (<>chartData')) today
                 . fmap toList
                 $ chartHistData
@@ -164,7 +165,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
@@ -202,7 +203,7 @@ renderLoop = do
                 when mustSort $ liftIO $ pPrint sortSpecs
               tableHeadersRow
               lResult <- readTVarIO $ symbolLookupResults data'
-              forM_ lResult $ \IBSymbolSample{..} -> do
+              forM_ lResult $ \contract@IBSymbolSample{..} -> do
                 let popupName = fromString $ "SymbolAction"<>show _symbolId
                 withPopup popupName $ \isPopupOpen -> do
                   when isPopupOpen $ do
@@ -231,17 +232,9 @@ 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
-          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)
+          let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache
+          plotLine (T.unpack symbol) x y
+          return ()
         return ()
 
 

src/Types.hs

@@ -24,7 +24,6 @@ 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
 
@@ -36,8 +35,7 @@ data Options = Options
 data WindowParams = WindowParams
   { _windowWidth :: Int
   , _windowHeight :: Int
-  } deriving stock (Show, Generic)
-    deriving anyclass (FromJSON, ToJSON)
+  } deriving (Show, Generic, FromJSON, ToJSON)
 
 instance Default WindowParams where
   def = WindowParams 1024 768
@@ -45,8 +43,7 @@ instance Default WindowParams where
 data TWSConnection = TWSConnection
   { _host :: Text
   , _port :: Text
-  } deriving stock (Show, Generic)
-    deriving anyclass (FromJSON, ToJSON)
+  } deriving (Show, Generic, FromJSON, ToJSON)
 
 instance Default TWSConnection where
   def = TWSConnection "127.0.0.1" "7497"
@@ -70,8 +67,7 @@ data Settings = Settings
   { _windowParams  :: WindowParams
   , _twsConnection :: TWSConnection
   , _logLevel      :: LogLevel
-  } deriving stock (Show, Generic)
-    deriving anyclass (FromJSON, ToJSON)
+  } deriving (Show, Generic, FromJSON, ToJSON)
 
 makeLenses ''WindowParams
 makeLenses ''TWSConnection
@@ -83,7 +79,7 @@ instance Default Settings where
 data TWSConnectionStatus = TWSDisconnected
                          | TWSConnecting
                          | TWSConnected
-                         deriving stock (Show, Eq, Enum, Bounded)
+                         deriving (Show, Eq, Enum, Bounded)
 
 data TWSConnectionRefs = TWSConnectionRefs
   { twsConnectionRefsHost :: TVar Text
@@ -118,14 +114,14 @@ data IBAccount = IBAccount
                { _accountInfo       :: IBAccountInfo
                , _accountPortfolio  :: [IBPortfolioValue]
                , _accountStrategies :: [IBAccountStrategy]
-               } deriving stock (Show, Eq)
+               } deriving (Show, Eq)
 
 
 data IBAccountInfo = IBAccountInfo
                    { _accountName       :: Text
                    , _accountProperties :: HashMap Text [(Text, Text)] -- (value, currency)
                    , _accountLastUpdate :: Text
-                   } deriving stock (Show, Eq)
+                   } deriving (Show, Eq)
 
 data IBPortfolioValue = IBPortfolioValue
                       { _contract      :: IBContract
@@ -135,11 +131,10 @@ data IBPortfolioValue = IBPortfolioValue
                       , _averageCost   :: Float
                       , _unrealizedPNL :: Float
                       , _realizedPNL   :: Float
-                      } deriving stock (Show, Eq)
+                      } deriving (Show, Eq)
 
 newtype IBAccountStrategy = IBAccountStrategy [Int] -- Int -> contract-id for this strategy
-  deriving stock (Show)
-  deriving newtype (Eq)
+  deriving (Show, Eq)
 
 data IBSymbolSample = IBSymbolSample
                     { _symbolId :: Int
@@ -148,7 +143,7 @@ data IBSymbolSample = IBSymbolSample
                     , _primaryExchange :: Text
                     , _currency :: Text
                     , _derivatives :: [Text]
-                    } deriving stock (Show, Eq)
+                    } deriving (Show, Eq)
 
 makeLenses ''IBAccountStrategy
 makeLenses ''IBAccountInfo
@@ -158,90 +153,53 @@ data ChartSettings = ChartSettings
                    { chartResolution :: Int
                    , chartStart      :: Maybe UTCTime
                    , chartEnd        :: Maybe UTCTime
-                   , chartStudySettings :: [ChartStudyType]
-                   } deriving stock (Show, Eq)
+                   } deriving (Show, Eq)
 
 defChartSettings :: ChartSettings
-defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
+defChartSettings = ChartSettings 60 Nothing Nothing
 
-updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
-updateChartStudySettings Chart{..} s = 
-    let chartSettings   = chartSettings { chartStudySettings = [] }
-        chartCache      = emptyChartCacheData chartCacheSettings
-        lastCacheUpdate = Nothing
-    in Chart{..}
-
--- | Settings for Chart-cache.
+-- data TimeWindow = TimeWindow
+--                 { begin :: Int
+--                 , end :: Int
+--                 } deriving (Show, Eq)
 --
--- 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 Semigroup TimeWindow where
+--   (TimeWindow a b) <> (TimeWindow x y) = TimeWindow (min a x) (max b y)
 --
--- 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
+-- instance Monoid TimeWindow where
+--   mempty = TimeWindow 0 86400
 
 -- TODO: TimePointFloat? or only 1 entry per second?
 
 newtype TimePoint = TimePoint Int
-  deriving stock (Generic)
-  deriving newtype (Show, Eq, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON)
+  deriving (Eq, Generic)
+  deriving newtype (Show, 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 stock (Show, Eq, Generic)
-                  deriving anyclass (FromJSON, ToJSON)
+                  deriving (Show, Eq, Generic, FromJSON, ToJSON)
 
 data ChartPoint = ChartPoint
                 { timeOfDay  :: TimePoint
                 , pointValue :: Float
-                , pointVolume :: Float
+                , volume     :: Int
                 , pointExtra :: [ChartStudies]
-                } deriving stock (Show, Eq, Generic)
-                  deriving anyclass (FromJSON, ToJSON)
+                } deriving (Show, Eq, Generic, 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
-           , chartCacheSettings :: ChartCacheSettings
-           , chartCache         :: ChartCacheData -- ^ cache for drawing with all pointExtra filled out and sampled according to 'chartSettings'
+           , chartCache      :: [ChartPoint] -- ^ cache for drawing with all pointExtra filled out and sampled according to 'chartSettings'
            , lastCacheUpdate :: Maybe TimePoint
            , chartDirty      :: Bool
-           } deriving stock (Show, Eq)
+           } deriving (Show, Eq)
 
 newtype InjetiveGettable a b = InjetiveGettable
                           { gettable :: TVar a