Compare commits
2 Commits
fcf8c26137
...
42183873d8
Author | SHA1 | Date | |
---|---|---|---|
42183873d8 | |||
16b4eb83e1 |
2
deps/dear-implot.hs
vendored
2
deps/dear-implot.hs
vendored
@ -1 +1 @@
|
|||||||
Subproject commit f3d5b63b541d8048568f134403838213c77177e4
|
Subproject commit 2b3810f7927a83c7cf95612497eaeceed56ca5e8
|
@ -78,7 +78,18 @@ library
|
|||||||
TypeSynonymInstances
|
TypeSynonymInstances
|
||||||
ViewPatterns
|
ViewPatterns
|
||||||
DuplicateRecordFields
|
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:
|
-- include-dirs:
|
||||||
-- deps/dear-implot.hs/implot
|
-- deps/dear-implot.hs/implot
|
||||||
-- deps/dear-imgui.hs/imgui
|
-- deps/dear-imgui.hs/imgui
|
||||||
@ -109,6 +120,7 @@ library
|
|||||||
, time
|
, time
|
||||||
, type-iso
|
, type-iso
|
||||||
, unordered-containers
|
, unordered-containers
|
||||||
|
, vector
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable ibhelper-exe
|
executable ibhelper-exe
|
||||||
|
@ -37,11 +37,11 @@ appFiller app = runRIO app $ withRunInIO $ \run -> do
|
|||||||
$ unless (L.null as)
|
$ unless (L.null as)
|
||||||
$ switchAccountTo $ L.head as
|
$ switchAccountTo $ L.head as
|
||||||
(Msg_IB_IN (IB_NextValidID i)) -> atomically $ modifyTVar' (nextValidID currentAppData) (const (Just i))
|
(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
|
(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
|
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
|
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
|
-- (Msg_IB_IN (IB_AccountUpdateTime t)) -> do
|
||||||
-- let action = HM.update (\ai -> Just $ ai & accountInfo . accountLastUpdate %~ const t) n
|
-- let action = HM.update (\ai -> Just $ ai & accountInfo . accountLastUpdate %~ const t) n
|
||||||
-- atomically $ modifyTVar' (Types.accounts currentAppData) action
|
-- atomically $ modifyTVar' (Types.accounts currentAppData) action
|
||||||
@ -72,8 +72,8 @@ handleTickPrice IB_TickPrice{..} = do
|
|||||||
chartVar <- (HM.!s) <$> liftIO (readTVarIO charts)
|
chartVar <- (HM.!s) <$> liftIO (readTVarIO charts)
|
||||||
case tickType of
|
case tickType of
|
||||||
IBTickType_Last_Price -> do
|
IBTickType_Last_Price -> do
|
||||||
t <- utctDayTime <$> liftIO getCurrentTime
|
t <- utcTimeToSeconds <$> liftIO getCurrentTime
|
||||||
let cp = ChartPoint (TimePoint $ fromInteger. (`div` 1000000000000) . diffTimeToPicoseconds $ t) price size []
|
let cp = ChartPoint (TimePoint t) price (fromIntegral size) []
|
||||||
liftIO $ atomically $ modifyTVar chartVar (\c@Chart{..} -> c { chartData = chartData |> cp, chartDirty = True})
|
liftIO $ atomically $ modifyTVar chartVar (\c@Chart{..} -> c { chartData = chartData |> cp, chartDirty = True})
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
handleTickPrice _ = error "impossible"
|
handleTickPrice _ = error "impossible"
|
||||||
|
201
src/Chart.hs
201
src/Chart.hs
@ -3,32 +3,39 @@
|
|||||||
{-# LANGUAGE DerivingVia #-}
|
{-# LANGUAGE DerivingVia #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
module Chart (newChart, FillerException(..), getUpdatedChartCache) where
|
module Chart (newChart
|
||||||
|
, FillerException(..)
|
||||||
|
, getUpdatedChartCache
|
||||||
|
, getChunkedDay
|
||||||
|
, timePointToIndex
|
||||||
|
, indexToTimePoint
|
||||||
|
) where
|
||||||
|
|
||||||
import Import
|
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.Concurrent (forkIO)
|
||||||
import Control.Monad.Extra (ifM)
|
import Control.Monad.Extra (ifM)
|
||||||
import qualified RIO.ByteString as BS
|
import Data.Aeson (eitherDecodeFileStrict')
|
||||||
-- import Control.Exception
|
import Data.FingerTree (FingerTree)
|
||||||
import qualified Data.HashMap.Strict as HM
|
import Data.Time.Calendar (Day(..))
|
||||||
import qualified Data.FingerTree as FT
|
import Data.Time.Clock
|
||||||
import qualified Data.Text as T
|
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
|
data FillerException = QuitFiller
|
||||||
deriving Show
|
deriving stock Show
|
||||||
|
|
||||||
instance Exception FillerException
|
instance Exception FillerException
|
||||||
|
|
||||||
--deriving via Integer instance Hashable Day
|
|
||||||
|
|
||||||
newChart :: IBContract -> RIO App ()
|
newChart :: IBContract -> RIO App ()
|
||||||
newChart contract = do
|
newChart contract = do
|
||||||
app <- ask
|
app <- ask
|
||||||
@ -39,6 +46,8 @@ newChart contract = do
|
|||||||
unless (sym `HM.member` hm) $ do
|
unless (sym `HM.member` hm) $ do
|
||||||
today <- liftIO getCurrentDay :: RIO App Day
|
today <- liftIO getCurrentDay :: RIO App Day
|
||||||
(cacheErrors, cacheData) <- do
|
(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
|
files <- liftIO $ listDirectory $ "cache" </> show con
|
||||||
res <- forM files $ \cacheFileName -> do
|
res <- forM files $ \cacheFileName -> do
|
||||||
let fname = "cache" </> show con </> cacheFileName
|
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."
|
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 TimePoint ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> cacheData'
|
||||||
logError $ displayShow $ HM.keys 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
|
tid <- liftIO $ forkIO $ fillChart app contract c
|
||||||
liftIO $ atomically $ do
|
liftIO $ atomically $ do
|
||||||
modifyTVar' c (\Chart{..} -> let fillerThread = tid in Chart{..})
|
modifyTVar' c (\Chart{..} -> let fillerThread = tid in Chart{..})
|
||||||
@ -67,7 +84,7 @@ fillChart app contract cVar = runRIO app $ do
|
|||||||
let cancelSubscription = liftIO $ atomically $ do
|
let cancelSubscription = liftIO $ atomically $ do
|
||||||
modifyTVar tickerMapVar (HM.delete tickerId)
|
modifyTVar tickerMapVar (HM.delete tickerId)
|
||||||
-- TODO: send cancel-request
|
-- TODO: send cancel-request
|
||||||
let sendQ = twsConnectionSend $ twsConnectionRefs $ appRefs $ app
|
let sendQ = twsConnectionSend . twsConnectionRefs . appRefs $ app
|
||||||
liftIO $ atomically $ do
|
liftIO $ atomically $ do
|
||||||
modifyTVar tickerMapVar (HM.insert tickerId sym)
|
modifyTVar tickerMapVar (HM.insert tickerId sym)
|
||||||
writeTQueue sendQ $ Msg_IB_OUT $ IB_RequestMktData tickerId contract "233" False False
|
writeTQueue sendQ $ Msg_IB_OUT $ IB_RequestMktData tickerId contract "233" False False
|
||||||
@ -76,18 +93,14 @@ fillChart app contract cVar = runRIO app $ do
|
|||||||
-- chart dirty? set clean & begin work
|
-- chart dirty? set clean & begin work
|
||||||
c <- liftIO (readTVarIO cVar)
|
c <- liftIO (readTVarIO cVar)
|
||||||
when (chartDirty c) $ do
|
when (chartDirty c) $ do
|
||||||
liftIO $ atomically $ modifyTVar cVar (\c -> c { chartDirty = False })
|
liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartDirty = False })
|
||||||
let (lUpdate, cachePoints) = getUpdatedChartCache c Nothing
|
(lUpdate, cachePoints) <- getUpdatedChartCache c Nothing
|
||||||
liftIO $ atomically $ modifyTVar cVar (\c -> c { chartCache = cachePoints, lastCacheUpdate = lUpdate })
|
liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartCache = cachePoints, lastCacheUpdate = lUpdate })
|
||||||
return ()
|
return ()
|
||||||
threadDelay 1000000 -- sleep 5 seconds
|
threadDelay 1000000 -- sleep 5 seconds
|
||||||
|
|
||||||
getUpdatedChartCache :: Chart -> Maybe ChartSettings -> (Maybe TimePoint, [ChartPoint])
|
chunkChart :: Int -> Int -> Int -> FingerTree TimePoint ChartPoint -> [(TimePoint,[ChartPoint])]
|
||||||
getUpdatedChartCache Chart{..} chartSettings' = (lUpdate, takeWhile (\ChartPoint{..} -> (\(TimePoint x) -> x < cacheUpdateStart) timeOfDay) chartCache <> map toCachePoint chunkedChart)
|
chunkChart from until range tree = go from range interval
|
||||||
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
|
where
|
||||||
lastItem = case FT.viewr interval of
|
lastItem = case FT.viewr interval of
|
||||||
FT.EmptyR -> until
|
FT.EmptyR -> until
|
||||||
@ -99,17 +112,135 @@ getUpdatedChartCache Chart{..} chartSettings' = (lUpdate, takeWhile (\ChartPoint
|
|||||||
| f+i >= lastItem = [(TimePoint (f+i), toList t)]
|
| f+i >= lastItem = [(TimePoint (f+i), toList t)]
|
||||||
| otherwise = let (a, b) = FT.split (\(TimePoint x) -> x > f+i) t
|
| otherwise = let (a, b) = FT.split (\(TimePoint x) -> x > f+i) t
|
||||||
in (TimePoint (f+i),toList a) : go (f+i) i b
|
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 :: (TimePoint,[ChartPoint]) -> ChartPoint
|
toCachePoint (t,[]) = ChartPoint t (-1) 0 []
|
||||||
toCachePoint (t,[]) = ChartPoint t (-1) 0 []
|
toCachePoint (t,as) = ChartPoint t m vol [OLHC o l h c]
|
||||||
toCachePoint (t,as) = ChartPoint t m vol [OLHC o l h c]
|
|
||||||
where
|
where
|
||||||
vol = sum $ volume <$> as
|
vol = sum $ pointVolume <$> as
|
||||||
as' = pointValue <$> as
|
as' = pointValue <$> as
|
||||||
ms' = sum $ (\x -> pointValue x * fromIntegral (volume x)) <$> as
|
ms' = sum $ (\x -> pointValue x * pointVolume x) <$> as
|
||||||
m = ms' / fromIntegral vol
|
m = ms' / vol
|
||||||
o = head as'
|
o = head as'
|
||||||
c = last as'
|
c = last as'
|
||||||
l = minimum as'
|
l = minimum as'
|
||||||
h = maximum 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
|
||||||
|
@ -44,7 +44,8 @@ toBS (IBBool False) = "0"--BS.pack [0,0,0,0] -- bool == 32-bit int in IB
|
|||||||
|
|
||||||
newtype IBGenericMessage = IBGenericMessage
|
newtype IBGenericMessage = IBGenericMessage
|
||||||
{ fields :: [IBTypes]
|
{ fields :: [IBTypes]
|
||||||
} deriving (Show, Eq)
|
} deriving stock (Show)
|
||||||
|
deriving newtype (Eq)
|
||||||
|
|
||||||
instance Binary IBGenericMessage where
|
instance Binary IBGenericMessage where
|
||||||
put (IBGenericMessage f) = do
|
put (IBGenericMessage f) = do
|
||||||
|
@ -10,6 +10,7 @@ module Import
|
|||||||
, ppShow'
|
, ppShow'
|
||||||
, getCurrentDay
|
, getCurrentDay
|
||||||
, switchAccountTo
|
, switchAccountTo
|
||||||
|
, utcTimeToSeconds
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import RIO
|
import RIO
|
||||||
@ -44,3 +45,6 @@ switchAccountTo a = do
|
|||||||
liftIO $ atomically $ writeTQueue sendQ $ Msg_IB_OUT $ IB_RequestAccountData True a
|
liftIO $ atomically $ writeTQueue sendQ $ Msg_IB_OUT $ IB_RequestAccountData True a
|
||||||
-- finally change
|
-- finally change
|
||||||
liftIO $ atomically $ modifyTVar' (currentAccount refs') (const $ Just a)
|
liftIO $ atomically $ modifyTVar' (currentAccount refs') (const $ Just a)
|
||||||
|
|
||||||
|
utcTimeToSeconds :: UTCTime -> Int
|
||||||
|
utcTimeToSeconds = fromInteger . (`div` ((10 :: Integer)^(12 :: Integer))) . diffTimeToPicoseconds . utctDayTime
|
||||||
|
41
src/Run.hs
41
src/Run.hs
@ -4,27 +4,26 @@
|
|||||||
module Run (run) where
|
module Run (run) where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
import Chart
|
|
||||||
import Types
|
import Types
|
||||||
|
import Chart
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Data.Aeson (encodeFile)
|
import Data.Aeson (encodeFile)
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
import Data.FingerTree (ViewL(..), ViewR(..), viewl, viewr, split, FingerTree)
|
import Data.FingerTree (ViewL(..), ViewR(..), viewl, viewr, split, FingerTree)
|
||||||
import DearImGui
|
import Data.Maybe (fromJust)
|
||||||
import DearImGui.Plot
|
|
||||||
import DearImGui.OpenGL3
|
|
||||||
import DearImGui.SDL
|
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
|
import Data.Tuple.Extra
|
||||||
|
import DearImGui
|
||||||
|
import DearImGui.OpenGL3
|
||||||
|
import DearImGui.Plot
|
||||||
|
import DearImGui.SDL
|
||||||
import Graphics.GL
|
import Graphics.GL
|
||||||
import SDL
|
import SDL
|
||||||
--import Data.StateVar
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.List as L
|
|
||||||
import qualified Data.HashMap.Strict as HM
|
import qualified Data.HashMap.Strict as HM
|
||||||
--import qualified Data.FingerTree as FT
|
import qualified Data.Vector.Storable as VS
|
||||||
|
|
||||||
import IBClient.Connection
|
import IBClient.Connection
|
||||||
import Import (Chart(chartContractID))
|
|
||||||
|
|
||||||
run :: RIO App ()
|
run :: RIO App ()
|
||||||
run = do
|
run = do
|
||||||
@ -52,13 +51,13 @@ shutdownApp = do
|
|||||||
-- save cached data
|
-- save cached data
|
||||||
liftIO $ unlessM (doesDirectoryExist "cache") $ createDirectory "cache"
|
liftIO $ unlessM (doesDirectoryExist "cache") $ createDirectory "cache"
|
||||||
charts <- liftIO . readTVarIO . appCharts $ refs
|
charts <- liftIO . readTVarIO . appCharts $ refs
|
||||||
forM_ (HM.toList charts) $ \(symbol,tc) -> do
|
forM_ (HM.toList charts) $ \(_symbol,tc) -> do
|
||||||
c@Chart{..} <- liftIO . readTVarIO $ tc
|
c@Chart{..} <- liftIO . readTVarIO $ tc
|
||||||
today <- liftIO $ utctDay <$> getCurrentTime
|
today <- liftIO $ utctDay <$> getCurrentTime
|
||||||
liftIO $ unlessM (doesDirectoryExist $ "cache/" <> show chartContractID) $ createDirectory $ "cache/" <> show chartContractID
|
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
|
newData = HM.toList
|
||||||
. fmap (filter (\ChartPoint{..} -> 0 /= volume))
|
. fmap (filter (\ChartPoint{..} -> 0 /= pointVolume))
|
||||||
. HM.alter (Just . maybe chartData' (<>chartData')) today
|
. HM.alter (Just . maybe chartData' (<>chartData')) today
|
||||||
. fmap toList
|
. fmap toList
|
||||||
$ chartHistData
|
$ chartHistData
|
||||||
@ -165,7 +164,7 @@ renderLoop = do
|
|||||||
tableSetupColumn "AVG"
|
tableSetupColumn "AVG"
|
||||||
tableSetupColumn "Market Value"
|
tableSetupColumn "Market Value"
|
||||||
tableHeadersRow
|
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
|
do
|
||||||
tableNextRow
|
tableNextRow
|
||||||
tableNextColumn $ text $ localSymbol c
|
tableNextColumn $ text $ localSymbol c
|
||||||
@ -203,7 +202,7 @@ renderLoop = do
|
|||||||
when mustSort $ liftIO $ pPrint sortSpecs
|
when mustSort $ liftIO $ pPrint sortSpecs
|
||||||
tableHeadersRow
|
tableHeadersRow
|
||||||
lResult <- readTVarIO $ symbolLookupResults data'
|
lResult <- readTVarIO $ symbolLookupResults data'
|
||||||
forM_ lResult $ \contract@IBSymbolSample{..} -> do
|
forM_ lResult $ \IBSymbolSample{..} -> do
|
||||||
let popupName = fromString $ "SymbolAction"<>show _symbolId
|
let popupName = fromString $ "SymbolAction"<>show _symbolId
|
||||||
withPopup popupName $ \isPopupOpen -> do
|
withPopup popupName $ \isPopupOpen -> do
|
||||||
when isPopupOpen $ do
|
when isPopupOpen $ do
|
||||||
@ -232,9 +231,17 @@ renderLoop = do
|
|||||||
(_ :> ChartPoint{..}) -> text $ fromString $ "Last: " <> show pointValue <> "\nTime: " <> show timeOfDay
|
(_ :> ChartPoint{..}) -> text $ fromString $ "Last: " <> show pointValue <> "\nTime: " <> show timeOfDay
|
||||||
withPlot "Test" $ do
|
withPlot "Test" $ do
|
||||||
-- TODO: set axes
|
-- TODO: set axes
|
||||||
let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache
|
-- let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache
|
||||||
plotLine (T.unpack symbol) x y
|
setupAxisLimits (both fromIntegral $ fromMaybe (0,86400) $ chartCacheCurrent chartCache) (-100,2500) Nothing
|
||||||
return ()
|
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 ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
|
94
src/Types.hs
94
src/Types.hs
@ -24,6 +24,7 @@ import RIO
|
|||||||
import RIO.Process
|
import RIO.Process
|
||||||
import Lens.Micro.TH
|
import Lens.Micro.TH
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Vector.Storable as VS
|
||||||
|
|
||||||
import IBClient.Types
|
import IBClient.Types
|
||||||
|
|
||||||
@ -35,7 +36,8 @@ data Options = Options
|
|||||||
data WindowParams = WindowParams
|
data WindowParams = WindowParams
|
||||||
{ _windowWidth :: Int
|
{ _windowWidth :: Int
|
||||||
, _windowHeight :: Int
|
, _windowHeight :: Int
|
||||||
} deriving (Show, Generic, FromJSON, ToJSON)
|
} deriving stock (Show, Generic)
|
||||||
|
deriving anyclass (FromJSON, ToJSON)
|
||||||
|
|
||||||
instance Default WindowParams where
|
instance Default WindowParams where
|
||||||
def = WindowParams 1024 768
|
def = WindowParams 1024 768
|
||||||
@ -43,7 +45,8 @@ instance Default WindowParams where
|
|||||||
data TWSConnection = TWSConnection
|
data TWSConnection = TWSConnection
|
||||||
{ _host :: Text
|
{ _host :: Text
|
||||||
, _port :: Text
|
, _port :: Text
|
||||||
} deriving (Show, Generic, FromJSON, ToJSON)
|
} deriving stock (Show, Generic)
|
||||||
|
deriving anyclass (FromJSON, ToJSON)
|
||||||
|
|
||||||
instance Default TWSConnection where
|
instance Default TWSConnection where
|
||||||
def = TWSConnection "127.0.0.1" "7497"
|
def = TWSConnection "127.0.0.1" "7497"
|
||||||
@ -67,7 +70,8 @@ data Settings = Settings
|
|||||||
{ _windowParams :: WindowParams
|
{ _windowParams :: WindowParams
|
||||||
, _twsConnection :: TWSConnection
|
, _twsConnection :: TWSConnection
|
||||||
, _logLevel :: LogLevel
|
, _logLevel :: LogLevel
|
||||||
} deriving (Show, Generic, FromJSON, ToJSON)
|
} deriving stock (Show, Generic)
|
||||||
|
deriving anyclass (FromJSON, ToJSON)
|
||||||
|
|
||||||
makeLenses ''WindowParams
|
makeLenses ''WindowParams
|
||||||
makeLenses ''TWSConnection
|
makeLenses ''TWSConnection
|
||||||
@ -79,7 +83,7 @@ instance Default Settings where
|
|||||||
data TWSConnectionStatus = TWSDisconnected
|
data TWSConnectionStatus = TWSDisconnected
|
||||||
| TWSConnecting
|
| TWSConnecting
|
||||||
| TWSConnected
|
| TWSConnected
|
||||||
deriving (Show, Eq, Enum, Bounded)
|
deriving stock (Show, Eq, Enum, Bounded)
|
||||||
|
|
||||||
data TWSConnectionRefs = TWSConnectionRefs
|
data TWSConnectionRefs = TWSConnectionRefs
|
||||||
{ twsConnectionRefsHost :: TVar Text
|
{ twsConnectionRefsHost :: TVar Text
|
||||||
@ -114,14 +118,14 @@ data IBAccount = IBAccount
|
|||||||
{ _accountInfo :: IBAccountInfo
|
{ _accountInfo :: IBAccountInfo
|
||||||
, _accountPortfolio :: [IBPortfolioValue]
|
, _accountPortfolio :: [IBPortfolioValue]
|
||||||
, _accountStrategies :: [IBAccountStrategy]
|
, _accountStrategies :: [IBAccountStrategy]
|
||||||
} deriving (Show, Eq)
|
} deriving stock (Show, Eq)
|
||||||
|
|
||||||
|
|
||||||
data IBAccountInfo = IBAccountInfo
|
data IBAccountInfo = IBAccountInfo
|
||||||
{ _accountName :: Text
|
{ _accountName :: Text
|
||||||
, _accountProperties :: HashMap Text [(Text, Text)] -- (value, currency)
|
, _accountProperties :: HashMap Text [(Text, Text)] -- (value, currency)
|
||||||
, _accountLastUpdate :: Text
|
, _accountLastUpdate :: Text
|
||||||
} deriving (Show, Eq)
|
} deriving stock (Show, Eq)
|
||||||
|
|
||||||
data IBPortfolioValue = IBPortfolioValue
|
data IBPortfolioValue = IBPortfolioValue
|
||||||
{ _contract :: IBContract
|
{ _contract :: IBContract
|
||||||
@ -131,10 +135,11 @@ data IBPortfolioValue = IBPortfolioValue
|
|||||||
, _averageCost :: Float
|
, _averageCost :: Float
|
||||||
, _unrealizedPNL :: Float
|
, _unrealizedPNL :: Float
|
||||||
, _realizedPNL :: Float
|
, _realizedPNL :: Float
|
||||||
} deriving (Show, Eq)
|
} deriving stock (Show, Eq)
|
||||||
|
|
||||||
newtype IBAccountStrategy = IBAccountStrategy [Int] -- Int -> contract-id for this strategy
|
newtype IBAccountStrategy = IBAccountStrategy [Int] -- Int -> contract-id for this strategy
|
||||||
deriving (Show, Eq)
|
deriving stock (Show)
|
||||||
|
deriving newtype (Eq)
|
||||||
|
|
||||||
data IBSymbolSample = IBSymbolSample
|
data IBSymbolSample = IBSymbolSample
|
||||||
{ _symbolId :: Int
|
{ _symbolId :: Int
|
||||||
@ -143,7 +148,7 @@ data IBSymbolSample = IBSymbolSample
|
|||||||
, _primaryExchange :: Text
|
, _primaryExchange :: Text
|
||||||
, _currency :: Text
|
, _currency :: Text
|
||||||
, _derivatives :: [Text]
|
, _derivatives :: [Text]
|
||||||
} deriving (Show, Eq)
|
} deriving stock (Show, Eq)
|
||||||
|
|
||||||
makeLenses ''IBAccountStrategy
|
makeLenses ''IBAccountStrategy
|
||||||
makeLenses ''IBAccountInfo
|
makeLenses ''IBAccountInfo
|
||||||
@ -153,53 +158,90 @@ data ChartSettings = ChartSettings
|
|||||||
{ chartResolution :: Int
|
{ chartResolution :: Int
|
||||||
, chartStart :: Maybe UTCTime
|
, chartStart :: Maybe UTCTime
|
||||||
, chartEnd :: Maybe UTCTime
|
, chartEnd :: Maybe UTCTime
|
||||||
} deriving (Show, Eq)
|
, chartStudySettings :: [ChartStudyType]
|
||||||
|
} deriving stock (Show, Eq)
|
||||||
|
|
||||||
defChartSettings :: ChartSettings
|
defChartSettings :: ChartSettings
|
||||||
defChartSettings = ChartSettings 60 Nothing Nothing
|
defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
|
||||||
|
|
||||||
-- data TimeWindow = TimeWindow
|
updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
|
||||||
-- { begin :: Int
|
updateChartStudySettings Chart{..} s =
|
||||||
-- , end :: Int
|
let chartSettings = chartSettings { chartStudySettings = [] }
|
||||||
-- } deriving (Show, Eq)
|
chartCache = emptyChartCacheData chartCacheSettings
|
||||||
|
lastCacheUpdate = Nothing
|
||||||
|
in Chart{..}
|
||||||
|
|
||||||
|
-- | Settings for Chart-cache.
|
||||||
--
|
--
|
||||||
-- instance Semigroup TimeWindow where
|
-- History and Resolution yield 1 day by default. Do not increase over 5000 as memery-consumption explodes!
|
||||||
-- (TimeWindow a b) <> (TimeWindow x y) = TimeWindow (min a x) (max b y)
|
-- Think of it as timePlotted = candleWidth * numberOfCandles
|
||||||
--
|
--
|
||||||
-- instance Monoid TimeWindow where
|
-- chartCacheHistory should be a multiple of 20 as there often is 5% buffer in various caches and this
|
||||||
-- mempty = TimeWindow 0 86400
|
-- 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?
|
-- TODO: TimePointFloat? or only 1 entry per second?
|
||||||
|
|
||||||
newtype TimePoint = TimePoint Int
|
newtype TimePoint = TimePoint Int
|
||||||
deriving (Eq, Generic)
|
deriving stock (Generic)
|
||||||
deriving newtype (Show, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON)
|
deriving newtype (Show, Eq, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON)
|
||||||
deriving (Semigroup, Monoid) via (Max Int)
|
deriving (Semigroup, Monoid) via (Max Int)
|
||||||
|
|
||||||
data ChartStudies = SMA { window :: Int, value :: Float }
|
data ChartStudies = SMA { window :: Int, value :: Float }
|
||||||
| OLHC { olhc_open :: Float, olhc_low :: Float, olhc_high :: Float, olhc_close :: 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
|
data ChartPoint = ChartPoint
|
||||||
{ timeOfDay :: TimePoint
|
{ timeOfDay :: TimePoint
|
||||||
, pointValue :: Float
|
, pointValue :: Float
|
||||||
, volume :: Int
|
, pointVolume :: Float
|
||||||
, pointExtra :: [ChartStudies]
|
, pointExtra :: [ChartStudies]
|
||||||
} deriving (Show, Eq, Generic, FromJSON, ToJSON)
|
} deriving stock (Show, Eq, Generic)
|
||||||
|
deriving anyclass (FromJSON, ToJSON)
|
||||||
|
|
||||||
instance Measured TimePoint ChartPoint where
|
instance Measured TimePoint ChartPoint where
|
||||||
measure = timeOfDay
|
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
|
data Chart = Chart
|
||||||
{ chartContractID :: Int
|
{ chartContractID :: Int
|
||||||
, chartData :: FingerTree TimePoint ChartPoint -- ^ raw data (time & sale)
|
, chartData :: FingerTree TimePoint ChartPoint -- ^ raw data (time & sale)
|
||||||
, chartHistData :: HashMap Day (FingerTree TimePoint ChartPoint) -- ^ raw data (time & sale)
|
, chartHistData :: HashMap Day (FingerTree TimePoint ChartPoint) -- ^ raw data (time & sale)
|
||||||
, fillerThread :: ThreadId
|
, fillerThread :: ThreadId
|
||||||
, chartSettings :: ChartSettings
|
, 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
|
, lastCacheUpdate :: Maybe TimePoint
|
||||||
, chartDirty :: Bool
|
, chartDirty :: Bool
|
||||||
} deriving (Show, Eq)
|
} deriving stock (Show, Eq)
|
||||||
|
|
||||||
newtype InjetiveGettable a b = InjetiveGettable
|
newtype InjetiveGettable a b = InjetiveGettable
|
||||||
{ gettable :: TVar a
|
{ gettable :: TVar a
|
||||||
|
Loading…
Reference in New Issue
Block a user