Drezil/ibhelper
1
1
Fork 0
Code Issues 12 Pull Requests Projects Releases Wiki Activity

finally hopefully fixed #12

Browse Source
This commit is contained in:
Nicole Dresselhaus 2022-08-08 23:04:09 +02:00
parent 42183873d8
commit 32ec058e6b
6 changed files with 165 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ibhelper.cabal
View File

@ -107,6 +107,7 @@ library
, dear-implot
, directory
, fingertree
, generic-data
, gl
, managed
, microlens-th

3
src/AppFiller.hs
View File

@ -73,7 +73,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) []
logInfo $ displayShow ("added point", cp)
liftIO $ atomically $ modifyTVar chartVar (\c@Chart{..} -> c { chartData = chartData |> cp, chartDirty = True})
_ -> return ()
handleTickPrice _ = error "impossible"

206
src/Chart.hs
View File

@ -29,7 +29,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
@ -58,7 +58,7 @@ 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 <$> cacheData'
logError $ displayShow $ HM.keys cacheData''
c <- liftIO $ newTVarIO $ Chart con
(fromMaybe FT.empty $ cacheData'' HM.!? today)
@ -96,84 +96,40 @@ 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 = D.trace ("chunking from "<> show from <> " to " <> show until) $ 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 = f <= x+i
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 -> (traceShowCommentId' "empty" (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 []:acc, Nothing, smaMap)
folder (acc, Just lastPoint, smaMap) (tp, []) = (lastPoint{ timeOfDay = tp, pointVolume = 0}:acc, Just lastPoint, smaMap)
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 +145,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) $ logInfo $ displayShow ("range changed:", newRange, ccRange)
logInfo $ displayShow ("shift?" :: Text, shiftNeccessary, shiftInterval)
logInfo $ 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 +205,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 +230,45 @@ 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)))
logInfo $ displayShow ccData'
let maToMi ma = max 0 $ fromMaybe ma $ (subtract shiftInterval) . fst <$> ccFill
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
logInfo $ 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 (chartStudySettings chartSettings) 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
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

9
src/Import.hs
View File

@ -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

7
src/Run.hs
View File

@ -55,7 +55,7 @@ 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' = traceShowCommentId "chartData for saving" $ filter (\ChartPoint{..} -> 0 /= pointVolume) . snd $ getChunkedDay c (Just 5)
newData = HM.toList
. fmap (filter (\ChartPoint{..} -> 0 /= pointVolume))
. HM.alter (Just . maybe chartData' (<>chartData')) today
@ -232,14 +232,15 @@ 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 ()

42
src/Types.hs
View File

@ -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
@ -166,7 +167,7 @@ defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
updateChartStudySettings Chart{..} s =
let chartSettings = chartSettings { chartStudySettings = [] }
let chartSettings = chartSettings { chartStudySettings = s }
chartCache = emptyChartCacheData chartCacheSettings
lastCacheUpdate = Nothing
in Chart{..}
@ -184,14 +185,35 @@ data ChartCacheSettings = ChartCacheSettings
} deriving stock (Show, Eq)
defChartCacheSettings :: ChartCacheSettings
defChartCacheSettings = ChartCacheSettings 60 1440
--defChartCacheSettings = ChartCacheSettings 60 1440
defChartCacheSettings = ChartCacheSettings 5 20
-- 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