made things work with current stackage.

ibhelper.cabal

@@ -99,7 +99,7 @@ library
   build-depends:
       StateVar
     , aeson
-    , base >=4.11 && <10
+    , base >=4.11
     , binary
     , bytestring
     , data-default
@@ -107,6 +107,7 @@ library
     , dear-implot
     , directory
     , fingertree
+    , generic-data
     , gl
     , managed
     , microlens-th
@@ -175,7 +176,7 @@ executable ibhelper-exe
   build-depends:
       StateVar
     , aeson
-    , base >=4.11 && <10
+    , base >=4.11
     , binary
     , bytestring
     , data-default
@@ -256,7 +257,7 @@ test-suite ibhelper-test
   build-depends:
       StateVar
     , aeson
-    , base >=4.11 && <10
+    , base >=4.11
     , binary
     , bytestring
     , data-default

src/AppFiller.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 module AppFiller where
 
 import Import
@@ -46,10 +46,9 @@ appFiller app = runRIO app $ withRunInIO $ \run -> do
       --   let action = HM.update (\ai -> Just $ ai & accountInfo . accountLastUpdate %~ const t) n
       --   atomically $ modifyTVar' (Types.accounts currentAppData) action
       (Msg_IB_IN (IB_PortfolioValue c p mp mv ac u r n)) -> do
-        let cid = conId :: IBContract -> Int
-            updateAction (a@IBPortfolioValue{..}:as)
-             | cid _contract == cid c = IBPortfolioValue c p mp mv ac u r:as
-             | otherwise              = a:updateAction as
+        let updateAction (a:as)
+             | a._contract.conId == c.conId = IBPortfolioValue c p mp mv ac u r:as
+             | otherwise                    = a:updateAction as
             updateAction [] = [IBPortfolioValue c p mp mv ac u r]
             action = HM.update (\ai -> Just $ ai & accountPortfolio %~ updateAction) n
         atomically $ modifyTVar' (Types.accounts currentAppData) action
@@ -73,7 +72,8 @@ handleTickPrice IB_TickPrice{..} = do
         case tickType of
           IBTickType_Last_Price -> do
               t <- utcTimeToSeconds <$> liftIO getCurrentTime
-              let cp = ChartPoint (TimePoint t) price (fromIntegral size) []
+              let cp = ChartPoint (TimeInterval t t) price (fromIntegral size) []
+              logDebug $ displayShow ("added point", cp)
               liftIO $ atomically $ modifyTVar chartVar (\c@Chart{..} -> c { chartData = chartData |> cp, chartDirty = True})
           _ -> return ()
 handleTickPrice _ = error "impossible"

src/Chart.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE TupleSections #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
@@ -29,7 +30,7 @@ import qualified Data.List as L
 import qualified Data.Text as T
 import qualified Data.Vector.Storable as VS
 
---import qualified Debug.Trace as D
+-- import qualified Debug.Trace as D
 
 data FillerException = QuitFiller
   deriving stock Show
@@ -39,15 +40,15 @@ instance Exception FillerException
 newChart :: IBContract -> RIO App ()
 newChart contract = do
   app <- ask
-  let sym = (symbol :: IBContract -> Text) contract
-      con = (conId :: IBContract -> Int) contract
+  let sym = contract.symbol
+      con = contract.conId
       hmVar = appCharts . appRefs $ app
   hm <- liftIO . readTVarIO $ hmVar
   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
+            (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
@@ -58,8 +59,9 @@ newChart contract = do
     unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err)
     let (unknownDates, cacheData') = partition (isNothing . fst) cacheData
     unless (null unknownDates) $ logError $ display $ T.pack $ show (length unknownDates) <> " files had no parsable Date."
-    let cacheData'' :: HashMap Day (FingerTree TimePoint ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> cacheData'
+    let cacheData'' :: HashMap Day (FingerTree TimeInterval ChartPoint) = HM.fromList $ bimap (fromMaybe today) (FT.fromList . L.sortOn (intervalFrom . timeOfDay)) <$> cacheData'
     logError $ displayShow $ HM.keys cacheData''
+    logInfo $ displayShow(fromMaybe FT.empty $ cacheData'' HM.!? today)
     c <- liftIO $ newTVarIO $ Chart con
                                     (fromMaybe FT.empty $ cacheData'' HM.!? today)
                                     (HM.delete today cacheData'')
@@ -76,8 +78,8 @@ newChart contract = do
 
 fillChart :: App -> IBContract -> TVar Chart -> IO ()
 fillChart app contract cVar = runRIO app $ do
-  let sym = (symbol :: IBContract -> Text) contract
-  (tickerMapVar :: TVar (HashMap Int Text)) <- tickerIdToSymbol. appRefs <$> ask
+  let sym = contract.symbol
+  (tickerMapVar :: TVar (HashMap Int Text)) <- tickerIdToSymbol . appRefs <$> ask
   alreadyAdded <- (sym `elem`) . HM.elems <$> liftIO (readTVarIO tickerMapVar)
   unless alreadyAdded $ do
     tickerId <- (+1) . foldl' max 1000 . HM.keys <$> liftIO (readTVarIO tickerMapVar)
@@ -96,84 +98,58 @@ fillChart app contract cVar = runRIO app $ do
           liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartDirty = False })
           (lUpdate, cachePoints) <- getUpdatedChartCache c Nothing
           liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartCache = cachePoints, lastCacheUpdate = lUpdate })
-          return ()
         threadDelay 1000000 -- sleep 5 seconds
 
-chunkChart :: Int -> Int -> Int -> FingerTree TimePoint ChartPoint -> [(TimePoint,[ChartPoint])]
-chunkChart from until range tree = go from range interval
+chunkChart :: Int -> Int -> Int -> FingerTree TimeInterval ChartPoint -> [(TimeInterval,[ChartPoint])]
+chunkChart from until ticks tree = go from ticks interval
     where
-      lastItem = case FT.viewr interval of
-                  FT.EmptyR -> until
-                  (_ FT.:> ChartPoint{..}) -> (\(TimePoint x) -> x) timeOfDay
-      interval = FT.takeUntil (\(TimePoint x) -> x > until)
-               . FT.dropUntil (\(TimePoint x) -> x > from)
+      traceShowCommentId' s a   = a -- traceShowCommentId s a
+      traceShowComment'   s a b = b -- traceShowComment s a b
+      interval = FT.takeUntil (\(TimeInterval x y) -> x > until)
+               . FT.dropUntil (\(TimeInterval x y) -> x >= from || (x <= from && y <= until && y >= from))
                $ tree
       go f i t
-        | f+i >= lastItem = [(TimePoint (f+i), toList t)]
-        | otherwise       = let (a, b) = FT.split (\(TimePoint x) -> x > f+i) t
-                            in (TimePoint (f+i),toList a) : go (f+i) i b
+        | f >= until = traceShowCommentId' "nosplit OverNow" []
+        | otherwise       = let searchpred start@(TimeInterval x y) end@(TimeInterval a b)
+                                              | start == mempty = False
+                                              | end == mempty = True
+                                              | otherwise = traceShowComment' "search" (f, x, start, end) $ f+i <= x || f+2*i <= y
+                            in case FT.search searchpred t
+                            of pos@(FT.Position l x@(ChartPoint{..}) r) 
+                                    | l == mempty && r == mempty && (timeIntervalBegin timeOfDay) < f+i-1 -> (traceShowCommentId' "only 1 left" $ (TimeInterval f (f+i-1), [x])) : go (f+i) i mempty
+                                    | l == mempty -> (traceShowComment' ("empty (" <> show f <> "," <> show (f+i) <> ")") x (TimeInterval f (f+i-1), [])) : go (f+i) i (x FT.<| r)
+                                    | otherwise -> (traceShowComment' ("split (" <> show f <> "," <> show (f+i) <> ")") pos (FT.measure l,toList l)) : traceShowComment' "recursive call with " (f+i, i, x FT.<| r) (go (f+i) i (x FT.<| r))
+                               x -> if FT.measure t == mempty then (TimeInterval f (f+i-1), []) : go (f+i) i t else traceShowCommentId' ("nosplit EndOfTree - "<> show x) [(FT.measure t, toList t)]
 
-toCachePoint :: (TimePoint,[ChartPoint]) -> ChartPoint
-toCachePoint (t,[]) = ChartPoint t (-1) 0 []
-toCachePoint (t,as) = ChartPoint t m vol [OLHC o l h c]
-  where
-    vol = sum $ pointVolume <$> as
-    as' = pointValue <$> as
-    ms' = sum $ (\x -> pointValue x * pointVolume x) <$> as
-    m = ms' / vol
-    o = head as'
-    c = last as'
-    l = minimum as'
-    h = maximum as'
-
-getUpdatedChartCache :: Chart -> Maybe ChartCacheSettings -> RIO App (Maybe TimePoint, ChartCacheData)
-getUpdatedChartCache Chart{..} chartCacheSettings' = do
-    let ChartCacheSettings cRes cTicks = fromMaybe chartCacheSettings chartCacheSettings'
-    now <- liftIO getCurrentTime
-    -- - recalculate cacheUpdateStart & cacheUpdateEnd
-    let cacheUpdateEnd   = ((utcTimeToSeconds now + cRes) `div` cRes) * cRes
-        cacheUpdateStart = cacheUpdateEnd - (cRes * cTicks)
-        ChartCacheData ccData ccAxis ccRange ccFill = chartCache
-        chunks = case ccFill of
-                  Nothing -> [(cacheUpdateStart, cacheUpdateEnd)]
-                  Just (mi, ma) -> if
-                        -- Interval mi-ma already updated. get remaining intervals
-                        -- mi  ma  cUS cUE
-                      | ma < cacheUpdateStart -> [(cacheUpdateStart, cacheUpdateEnd)]
-                        -- mi?  cUS  mi?  ma  cUE -> [ma,cUE] + rest
-                      | ma < cacheUpdateEnd -> [(ma,cacheUpdateEnd)] <> if
-                          -- cUS  mi  ma
-                          | mi > cacheUpdateStart -> [(cacheUpdateStart, mi)]
-                          | otherwise -> []
-                      | otherwise -> []
-        -- - chunk them with chunhChart
-        chunkedChart = L.filter (not . null . snd) $ L.concat $ for chunks $ \(start, end) -> chunkChart (min 0 start) end cRes chartData
-        lUpdate = cacheUpdateEnd - cRes
-        -- - calculate Range and need for shift
-        shiftNeccessary = case ccRange of
-                            Nothing     -> False
-                            Just (_,ma) -> cacheUpdateEnd > ma
-        (newRange, shiftInterval) = if not shiftNeccessary && isJust ccRange then (fromJust ccRange, 0) else 
-                      let interval = cTicks `div` 20 :: Int
-                          iTo = ((cacheUpdateEnd + cRes * interval) `div` (cRes * interval)) * (cRes * interval)
-                          iFrom = iTo - 20 * (cRes * interval)
-                      in ((iFrom,iTo), interval)
-        ccAxis' = if not shiftNeccessary && isJust ccRange then ccAxis
-                  else VS.enumFromStepN (fromIntegral $ fst newRange) (fromIntegral cRes) cTicks
-    logDebug $ displayShow ("now, updateEnd, lUpdate" :: Text, utcTimeToSeconds now, cacheUpdateEnd, lUpdate)
-    -- create data for updates
-    let timePointToIndex' :: TimePoint -> Int
-        timePointToIndex' = timePointToIndex (Just $ ChartCacheSettings cRes cTicks) newRange
-    let indexToTimePoint' :: Int -> TimePoint
-        indexToTimePoint' = indexToTimePoint (Just $ ChartCacheSettings cRes cTicks) newRange
-    -- fold instead of map, so we can carry over cached calculatinos from element to element (for i.e. ema/sma)
-    let (!foldedData,_,_) = foldl' folder ([], ChartPoint 0 0 0 [], mempty) chunkedChart
-        folder :: ([(Int, ChartPoint)], ChartPoint, HM.HashMap Int [Float]) -> (TimePoint, [ChartPoint]) -> ([(Int, ChartPoint)], ChartPoint, HM.HashMap Int [Float])
-        folder old (_,[]) = old
-        folder (acc, lastPoint, smaMap) (tp,cdata) = ((timePointToIndex' tp, cp):acc, cp, foldl' (.) id smaUpdates smaMap)
+-- | converts stuff returned from chunkChart into ([1 point per chunks], last point seen in the input)
+toChartData :: [ChartStudyType] -> [(TimeInterval, [ChartPoint])] -> (Maybe ChartPoint, [ChartPoint])
+toChartData studytypes chunkedChart = (lastDataPoint, foldedData)
+    where (!foldedData,lastDataPoint,_) = foldl' folder ([], Nothing, mempty) chunkedChart
+          folder :: ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float]) -> (TimeInterval, [ChartPoint]) -> ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float])
+          folder (acc, Nothing       , smaMap) (tp                   , [])   = (ChartPoint tp 0 0 studies:acc, Nothing, smaMap)
+            where
+              studies = catMaybes $ studytypes <&> \case
+                  ChartStudyTypeOpen   -> Just $ OLHC 0 0 0 0
+                  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 0
+          folder (acc, Just lastPoint, smaMap) (tp                   , [])   = (lastPoint{ timeOfDay = tp, pointVolume = 0}:acc, Just lastPoint, foldl' (.) id smaUpdates smaMap)
+            where
+              (studies, smaUpdates) = unzip $ catMaybes $ studytypes <&> \case
+                  ChartStudyTypeOpen   -> fmap (\OLHC{..} -> (OLHC olhc_close olhc_close olhc_close olhc_close, id)) . L.find (\case OLHC{..} -> True; _ -> False) . pointExtra $ lastPoint
+                  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 0,id)
+          folder (acc, _             , smaMap) (tp@(TimeInterval f t),cdata) = (cp:acc, Just cp, foldl' (.) id smaUpdates smaMap)
             where
               cp = ChartPoint tp m vol studies
-              (studies, smaUpdates) = unzip $ catMaybes $ (chartStudySettings chartSettings :: [ChartStudyType]) <&> \case
+              (studies, smaUpdates) = unzip $ catMaybes $ studytypes <&> \case
                   ChartStudyTypeOpen   -> Just (OLHC o l h c, id)
                   ChartStudyTypeHigh   -> Nothing
                   ChartStudyTypeLow    -> Nothing
@@ -189,6 +165,59 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
               c = last as'
               l = minimum as'
               h = maximum as'
+
+getUpdatedChartCache :: Chart -> Maybe ChartCacheSettings -> RIO App (Maybe TimePoint, ChartCacheData)
+getUpdatedChartCache Chart{..} chartCacheSettings' = do
+    let ccs@(ChartCacheSettings cRes cTicks) = fromMaybe chartCacheSettings chartCacheSettings'
+    now <- liftIO getCurrentTime
+    let cacheUpdateEnd   = ((utcTimeToSeconds now + cRes) `div` cRes) * cRes
+        ChartCacheData ccData ccAxis ccRange ccFill = chartCache
+    let traceShowCommentId' s a   = a -- traceShowCommentId s a
+        traceShowComment'   s a b = b -- traceShowComment s a b
+        lUpdate = utcTimeToSeconds now
+        -- - calculate Range and need for shift
+        shiftNeccessary = case ccRange of
+                            Nothing     -> False
+                            Just (TimeInterval _ ma) -> cacheUpdateEnd > ma
+        (newRange, shiftInterval) = if not shiftNeccessary && isJust ccRange then (fromJust ccRange, 0) else 
+                      let interval = cTicks `div` 20 :: Int
+                          iTo = ((cacheUpdateEnd + cRes * interval) `div` (cRes * interval)) * (cRes * interval)
+                          iFrom = iTo - 20 * (cRes * interval)
+                          shift = case ccRange of
+                                  Nothing -> 0
+                                  Just (TimeInterval _ ma) -> (iTo - ma) `div` cRes
+                      in (TimeInterval iFrom iTo, shift)
+        ccAxis' = if not shiftNeccessary && isJust ccRange then ccAxis
+                  else VS.enumFromStepN (fromIntegral $ timeIntervalBegin newRange) (fromIntegral cRes) cTicks
+    let timePointToIndex' :: TimePoint -> Either String Int
+        timePointToIndex' = timePointToIndex (Just $ ChartCacheSettings cRes cTicks) newRange
+    let indexToTimePoint' :: Int -> TimePoint
+        indexToTimePoint' = indexToTimePoint (Just $ ChartCacheSettings cRes cTicks) newRange
+    when (Just newRange /= ccRange) $ logDebug $ displayShow ("range changed:", newRange, ccRange)
+    logDebug $ displayShow ("shift?" :: Text, shiftNeccessary, shiftInterval)
+    logDebug $ displayShow ("now, updateEnd, lUpdate" :: Text, utcTimeToSeconds now, cacheUpdateEnd, lUpdate)
+    let cacheUpdateStart = max (timeIntervalBegin newRange) (cacheUpdateEnd - (cRes * (cTicks+1))) -- 1 more to get history running inside the chunk-fold for fallbacks in cache if we get no data.
+    -- create data for updates
+    let chunks = case (,) <$> ccFill <*> ccRange of
+                  Nothing -> [(cacheUpdateStart, cacheUpdateEnd)]
+                  Just ((mi, ma), oldRange) -> let itp = (\(TimePoint p) -> p) . indexToTimePoint (Just ccs) oldRange in if
+                        -- Interval mi-ma already updated. get remaining intervals
+                        -- mi  ma  cUS cUE
+                      | itp ma < cacheUpdateStart -> [(cacheUpdateStart, cacheUpdateEnd)]
+                        -- mi?  cUS  mi?  ma  cUE -> [ma,cUE] + rest
+                      | itp ma < cacheUpdateEnd -> (<> [(itp ma,cacheUpdateEnd)]) if
+                          -- cUS  mi  ma
+                          | itp mi > cacheUpdateStart -> [(cacheUpdateStart, itp mi)]
+                          | otherwise -> []
+                      | otherwise -> []
+        -- - chunk them with chunhChart
+        chunkedChart = L.concat $ chunks <&> \(start, end) -> chunkChart (max 0 start) end cRes chartData
+    let (lastDataPoint, !foldedData') = toChartData (chartStudySettings chartSettings) (traceShowCommentId' "chunkedChart" chunkedChart)
+        tpToTi (TimeInterval f t) = case timePointToIndex' (TimePoint (t+f) `div` 2) of
+                                       Left e   -> error $ "BUG in Chart.hs. Impossible: " <> e
+                                       Right ti -> ti
+        -- aggregate data with index into the vectors
+        foldedData = (\cp@ChartPoint{..} -> (tpToTi timeOfDay, cp)) <$> (traceShowCommentId' "foldedData" foldedData')
         -- plan the actual work
         updates = chartStudySettings chartSettings <&> \cs ->
             -- check if thing is in hashmap
@@ -196,10 +225,13 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
                     Nothing -> VS.replicate cTicks 0
                     Just a  -> a
                 -- shift if neccessary
-                vec' = if shiftNeccessary && cs `HM.member` ccData then
+                vec' = if shiftNeccessary && cs `HM.member` ccData && shiftInterval < VS.length vec then
                           -- TODO: unsafeSlice && unsafeUpdate_ - see #16
                           let sliceLength = VS.length vec - shiftInterval
-                          in VS.update_ vec (VS.enumFromN 0 sliceLength) (VS.slice shiftInterval sliceLength vec)
+                          in VS.update_
+                                (VS.update_ vec (VS.enumFromN 0 sliceLength) (VS.slice shiftInterval sliceLength vec))
+                                (VS.enumFromN sliceLength (cTicks - sliceLength))
+                                (VS.replicate sliceLength 0)
                        else
                         vec
             -- NOW:
@@ -218,29 +250,44 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
               ChartStudyTypeSMA x  -> id --TODO: implement #13
               ChartStudyTypeVolume -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,volume $ findVolume s))   <$> foldedData))
     let ccData' = foldl' (.) id updates ccData
-    -- logInfo $ displayShow chartCache
-    -- logInfo $ displayShow (cacheUpdateStart, cacheUpdateEnd)
-    -- logInfo $ displayShow (newRange, chunkedChart)
-    let ma = timePointToIndex' $ TimePoint lUpdate
-        mi = fromMaybe ma $ fst <$> ccFill
-    return (Just $ TimePoint lUpdate, ChartCacheData ccData' ccAxis' (Just newRange) (Just $ (mi, timePointToIndex' $ TimePoint lUpdate)))
+    logDebug $ displayShow ccData'
+    let fillRange = case traceShowCommentId' "(ccFill, lastDataPoint)" (ccFill,lastDataPoint) of
+                                          -- no new data, but different range. shift along.
+                (Just (mi,ma), Nothing) -> if ma - shiftInterval < 0 then Nothing else Just (max 0 $ mi - shiftInterval, ma - shiftInterval)
+                                          -- no data saved yet
+                (Nothing, Nothing)      -> Nothing
+                                          -- new data, update fillRange
+                (mima, Just lastDP)     -> let lastBlock = let d = timeOfDay lastDP in (intervalTo d + intervalFrom d) `div` 2
+                               in case timePointToIndex' lastBlock of
+                                    Left err -> error $ "impossible #1 Chart.hs - " <> err
+                                    Right ma -> if ma < cTicks
+                                      then case mima of  -- check if we rotated out or have no fill-range set.
+                                                Nothing        ->                                 Just (max 0 $ ma - shiftInterval, ma)
+                                                Just (mi, ma') -> if ma' - shiftInterval < 0 then Just (max 0 $ ma - shiftInterval, ma)
+                                                                                             else Just (max 0 $ mi - shiftInterval, ma)
+                                      else error $ "impossible #2 Chart.hs - " <> show ma <> ">=" <> show cTicks
+    logDebug $ displayShow fillRange
+    return (Just $ TimePoint lUpdate, ChartCacheData ccData' ccAxis' (Just newRange) fillRange)
 
 getChunkedDay :: Chart -> Maybe Int -> (Maybe TimePoint, [ChartPoint])
-getChunkedDay Chart{..} chunkResolution = (lUpdate, toCachePoint <$> chunkedData)
+getChunkedDay Chart{..} chunkResolution = case toChartData [] chunkedData of
+                                            (Nothing, x) -> (Nothing, x)
+                                            (Just ChartPoint{..}, x)
+                                              | timeOfDay == mempty -> (Nothing, x)
+                                              | otherwise -> (Just $ TimePoint $ timeIntervalEnd timeOfDay, x)
     where
-        chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData
-        lUpdate     = fmap fst . lastMaybe $ chunkedData
+        chunkedData = filter (not . null . snd) $ chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData
 
-indexToTimePoint :: Maybe ChartCacheSettings -> (Int, Int) -> Int -> TimePoint
-indexToTimePoint ccs (rFrom, rTo) i = TimePoint $ rFrom + i*cRes
+indexToTimePoint :: Maybe ChartCacheSettings -> TimeInterval -> Int -> TimePoint
+indexToTimePoint ccs (TimeInterval rFrom rTo) i = TimePoint $ rFrom + i*cRes
   where
     ChartCacheSettings cRes _ = fromMaybe defChartCacheSettings ccs
 
-timePointToIndex :: Maybe ChartCacheSettings -> (Int, Int) -> TimePoint -> Int
-timePointToIndex ccs (rFrom, rTo) (TimePoint p) = if
-    | p < rFrom || p > rTo           -> error $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show p <> " out of range."
-    | result < 0 || result >= cTicks -> error $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show result <> " is invalid index"
-    | otherwise                      -> result
+timePointToIndex :: Maybe ChartCacheSettings -> TimeInterval -> TimePoint -> Either String Int
+timePointToIndex ccs (TimeInterval rFrom rTo) (TimePoint p) = if
+    | p < rFrom || p > rTo           -> Left $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show p <> " out of range."
+    | result < 0 || result >= cTicks -> Left $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show result <> " is invalid index"
+    | otherwise                      -> Right result
   where
     ChartCacheSettings cRes cTicks = fromMaybe defChartCacheSettings ccs
     result = (p - rFrom) `div` cRes

src/Import.hs

@@ -11,6 +11,8 @@ module Import
   , getCurrentDay
   , switchAccountTo
   , utcTimeToSeconds
+  , traceShowComment
+  , traceShowCommentId
   ) where
 
 import RIO
@@ -26,6 +28,7 @@ import System.Directory
 import Data.Text as T
 import Data.Time.Clock
 import Data.Time.Calendar
+import Debug.Trace as D
 
 ppShow' :: Show a => a -> Text
 ppShow' = T.pack . ppShow
@@ -48,3 +51,9 @@ switchAccountTo a = do
 
 utcTimeToSeconds :: UTCTime -> Int
 utcTimeToSeconds = fromInteger . (`div` ((10 :: Integer)^(12 :: Integer))) . diffTimeToPicoseconds . utctDayTime
+
+traceShowComment :: Show a => String -> a -> b -> b
+traceShowComment s a b = D.trace ("\ESC[1;31m" <> s <> ":\ESC[0m\n"<> show a<>"\n") b
+
+traceShowCommentId :: Show a => String -> a -> a
+traceShowCommentId s a = D.trace ("\ESC[1;31m" <> s <> ":\ESC[0m\n"<> show a<>"\n") a

src/Run.hs

@@ -55,14 +55,14 @@ shutdownApp = do
     c@Chart{..} <- liftIO . readTVarIO $ tc
     today <- liftIO $ utctDay <$> getCurrentTime
     liftIO $ unlessM (doesDirectoryExist $ "cache/" <> show chartContractID) $ createDirectory $ "cache/" <> show chartContractID
-    let (_, chartData') = getChunkedDay c (Just 5)
+    let chartData' = filter (\ChartPoint{..} -> 0 /= pointVolume) . snd $ getChunkedDay c (Just 5)
         newData = HM.toList
                 . fmap (filter (\ChartPoint{..} -> 0 /= pointVolume))
-                . HM.alter (Just . maybe chartData' (<>chartData')) today
+                . HM.alter (traceShowCommentId "todays data for saving" . Just . maybe chartData' (<>chartData')) today
                 . fmap toList
                 $ chartHistData
     forM_ newData $ \(day, dat) -> do
-        liftIO $ encodeFile ("cache/" <> show chartContractID <> "/" <> show day <> ".json") dat
+        liftIO $ encodeFile ("cache/" <> show chartContractID <> "/" <> show day <> ".json") $ traceShowCommentId ("data for "<> show day) dat
   logInfo $ display $ ppShow' settings'
 
 renderLoop :: RIO App ()
@@ -232,24 +232,24 @@ renderLoop = do
         withPlot "Test" $ do
           -- TODO: set axes
           -- let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache
-          setupAxisLimits (both fromIntegral $ fromMaybe (0,86400) $ chartCacheCurrent chartCache) (-100,2500) Nothing
+          setupAxisLimits (both fromIntegral $ (\(TimeInterval a b) -> (a,b)) $ fromMaybe (TimeInterval 0 86400) $ chartCacheCurrent chartCache) (-100,2500) Nothing
           let ChartCacheSettings _ cTicks = chartCacheSettings
-              (f, t) = fromMaybe (0, cTicks) $ chartCacheFilledTo chartCache
+              (f, t) = fromMaybe (0, cTicks-1) $ chartCacheFilledTo chartCache
               direct = chartCacheData chartCache HM.!? ChartStudyTypeDirect
               x = chartCacheAxis chartCache
               -- t-f == 0 means there is still 1 point in it. VS.slice takes number of points as second argument. Add 1!
               -- dataSlice     = VS.slice f (t-f+1)
               dataSliceLine = if t-f < 1 then VS.slice (max 0 $ f-1) 2 else VS.slice f (t-f+1) -- need at least 2 points to make a line... duh!
+          when (t-f < 0 || t-f >= cTicks) $ logError $ displayShow ("t/f", t-f, t, f)
           when (isJust direct) $ do
-            plotLine (T.unpack symbol) (dataSliceLine x) (dataSliceLine $ fromJust direct)
-        return ()
+              plotLine (T.unpack symbol) (dataSliceLine x) (dataSliceLine $ fromJust direct)
 
 
-    -- Show the ImGui demo window
-    showDemoWindow
-
-    -- Show the ImPlot demo window
-    showPlotDemoWindow
+    -- -- Show the ImGui demo window
+    -- showDemoWindow
+    --
+    -- -- Show the ImPlot demo window
+    -- showPlotDemoWindow
 
     -- Render
     liftIO $ glClear GL_COLOR_BUFFER_BIT

src/Types.hs

@@ -17,6 +17,7 @@ import Data.Types.Injective
 import Data.Time
 import Data.FingerTree
 import Data.Semigroup
+import Generic.Data.Microsurgery
 import GHC.Generics
 import SDL (Window)
 import DearImGui
@@ -162,11 +163,11 @@ data ChartSettings = ChartSettings
                    } deriving stock (Show, Eq)
 
 defChartSettings :: ChartSettings
-defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
+defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect, ChartStudyTypeVolume, ChartStudyTypeOpen]
 
 updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
 updateChartStudySettings Chart{..} s = 
-    let chartSettings   = chartSettings { chartStudySettings = [] }
+    let chartSettings   = chartSettings { chartStudySettings = s }
         chartCache      = emptyChartCacheData chartCacheSettings
         lastCacheUpdate = Nothing
     in Chart{..}
@@ -185,13 +186,34 @@ data ChartCacheSettings = ChartCacheSettings
 
 defChartCacheSettings :: ChartCacheSettings
 defChartCacheSettings = ChartCacheSettings 60 1440
+--defChartCacheSettings = ChartCacheSettings 5 20 -- for testing 
 
 -- TODO: TimePointFloat? or only 1 entry per second?
 
+data TimeInterval = TimeInterval
+                  { timeIntervalBegin :: Int
+                  , timeIntervalEnd   :: Int
+                  }
+  deriving stock (Generic, Eq)
+  deriving anyclass (FromJSON, ToJSON) -- TODO: write own instances with "TimeInterval [a,b]" instead of recods.
+  deriving (Show) via (Surgery Derecordify TimeInterval)
+instance Semigroup TimeInterval where
+  (TimeInterval mi1 ma1) <> (TimeInterval mi2 ma2)
+    = TimeInterval (getMin $ Min mi1 <> Min mi2) (getMax $ Max ma1 <> Max ma2)
+instance Monoid TimeInterval where
+  mempty = TimeInterval (getMin mempty) (getMax mempty)
+
+
 newtype TimePoint = TimePoint Int
-  deriving stock (Generic)
-  deriving newtype (Show, Eq, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON)
-  deriving (Semigroup, Monoid) via (Max Int)
+   deriving stock (Generic, Show)
+   deriving newtype (Eq, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON)
+   deriving (Semigroup, Monoid) via (Min Int)
+
+intervalFrom :: TimeInterval -> TimePoint
+intervalFrom (TimeInterval a _) = TimePoint a
+
+intervalTo :: TimeInterval -> TimePoint
+intervalTo (TimeInterval _ b) = TimePoint b
 
 data ChartStudies = SMA { window :: Int, value :: Float }
                   | OLHC { olhc_open :: Float, olhc_low :: Float, olhc_high :: Float, olhc_close :: Float}
@@ -200,14 +222,14 @@ data ChartStudies = SMA { window :: Int, value :: Float }
                   deriving anyclass (FromJSON, ToJSON)
 
 data ChartPoint = ChartPoint
-                { timeOfDay   :: TimePoint
+                { timeOfDay   :: TimeInterval
                 , pointValue  :: Float
                 , pointVolume :: Float
                 , pointExtra  :: [ChartStudies]
                 } deriving stock (Show, Eq, Generic)
                   deriving anyclass (FromJSON, ToJSON)
 
-instance Measured TimePoint ChartPoint where
+instance Measured TimeInterval ChartPoint where
   measure = timeOfDay
 
 -- | Tick-based data
@@ -224,7 +246,7 @@ data ChartStudyType = ChartStudyTypeDirect
 data ChartCacheData = ChartCacheData
                     { chartCacheData     :: HashMap ChartStudyType (VS.Vector Float)
                     , chartCacheAxis     :: VS.Vector Float
-                    , chartCacheCurrent  :: Maybe (Int,Int) -- ^ in number of TimePoint, negative meaning "before today"
+                    , chartCacheCurrent  :: Maybe TimeInterval -- ^ in number of TimeInterval, negative meaning "before today"
                     , chartCacheFilledTo :: Maybe (Int,Int) -- ^ in index into the vectors given range of "Current"
                     } deriving stock (Show, Eq)
 
@@ -233,8 +255,8 @@ emptyChartCacheData ChartCacheSettings{..} = ChartCacheData mempty (VS.replicate
 
 data Chart = Chart
            { chartContractID    :: Int
-           , chartData          :: FingerTree TimePoint ChartPoint -- ^ raw data (time & sale)
-           , chartHistData      :: HashMap Day (FingerTree TimePoint ChartPoint) -- ^ raw data (time & sale)
+           , chartData          :: FingerTree TimeInterval ChartPoint -- ^ raw data (time & sale)
+           , chartHistData      :: HashMap Day (FingerTree TimeInterval ChartPoint) -- ^ raw data (time & sale)
            , fillerThread       :: ThreadId
            , chartSettings      :: ChartSettings
            , chartCacheSettings :: ChartCacheSettings

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-18.24
+resolver: lts-21.2
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.