further implemented #12 & tested preliminary. Should(tm) work fine now.
This commit is contained in:
parent
16b4eb83e1
commit
42183873d8
2
deps/dear-implot.hs
vendored
2
deps/dear-implot.hs
vendored
@ -1 +1 @@
|
|||||||
Subproject commit f3d5b63b541d8048568f134403838213c77177e4
|
Subproject commit 2b3810f7927a83c7cf95612497eaeceed56ca5e8
|
90
src/Chart.hs
90
src/Chart.hs
@ -3,7 +3,13 @@
|
|||||||
{-# LANGUAGE DerivingVia #-}
|
{-# LANGUAGE DerivingVia #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
module Chart (newChart, FillerException(..), getUpdatedChartCache, getChunkedDay) where
|
module Chart (newChart
|
||||||
|
, FillerException(..)
|
||||||
|
, getUpdatedChartCache
|
||||||
|
, getChunkedDay
|
||||||
|
, timePointToIndex
|
||||||
|
, indexToTimePoint
|
||||||
|
) where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
import Control.Concurrent (forkIO)
|
import Control.Concurrent (forkIO)
|
||||||
@ -40,19 +46,29 @@ 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
|
||||||
files <- liftIO $ listDirectory $ "cache" </> show con
|
ifM (fmap not $ liftIO $ doesDirectoryExist $ "cache" </> show con)
|
||||||
res <- forM files $ \cacheFileName -> do
|
(return $ (["no data-chache found for " <> show con], [])) $ do
|
||||||
let fname = "cache" </> show con </> cacheFileName
|
files <- liftIO $ listDirectory $ "cache" </> show con
|
||||||
ifM (liftIO $ doesFileExist fname)
|
res <- forM files $ \cacheFileName -> do
|
||||||
(bimap (\err -> cacheFileName <> ": "<> err) ((readMaybe $ dropExtension cacheFileName) :: Maybe Day,) <$> liftIO (eitherDecodeFileStrict' fname))
|
let fname = "cache" </> show con </> cacheFileName
|
||||||
(return $ Left $ "cachefile "<>cacheFileName<>" not found.")
|
ifM (liftIO $ doesFileExist fname)
|
||||||
return $ partitionEithers res
|
(bimap (\err -> cacheFileName <> ": "<> err) ((readMaybe $ dropExtension cacheFileName) :: Maybe Day,) <$> liftIO (eitherDecodeFileStrict' fname))
|
||||||
|
(return $ Left $ "cachefile "<>cacheFileName<>" not found.")
|
||||||
|
return $ partitionEithers res
|
||||||
unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err)
|
unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err)
|
||||||
let (unknownDates, cacheData') = partition (isNothing . fst) cacheData
|
let (unknownDates, cacheData') = partition (isNothing . fst) cacheData
|
||||||
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 defChartCacheSettings emptyChartCacheData 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{..})
|
||||||
@ -110,14 +126,14 @@ toCachePoint (t,as) = ChartPoint t m vol [OLHC o l h c]
|
|||||||
l = minimum as'
|
l = minimum as'
|
||||||
h = maximum as'
|
h = maximum as'
|
||||||
|
|
||||||
getUpdatedChartCache :: MonadIO m => Chart -> Maybe ChartCacheSettings -> m (Maybe TimePoint, ChartCacheData)
|
getUpdatedChartCache :: Chart -> Maybe ChartCacheSettings -> RIO App (Maybe TimePoint, ChartCacheData)
|
||||||
getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
||||||
let ChartCacheSettings cRes cTicks = fromMaybe chartCacheSettings chartCacheSettings'
|
let ChartCacheSettings cRes cTicks = fromMaybe chartCacheSettings chartCacheSettings'
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
-- - recalculate cacheUpdateStart & cacheUpdateEnd
|
-- - recalculate cacheUpdateStart & cacheUpdateEnd
|
||||||
let cacheUpdateEnd = (utcTimeToSeconds now + cRes) `div` cRes
|
let cacheUpdateEnd = ((utcTimeToSeconds now + cRes) `div` cRes) * cRes
|
||||||
cacheUpdateStart = cacheUpdateEnd - (cRes * cTicks)
|
cacheUpdateStart = cacheUpdateEnd - (cRes * cTicks)
|
||||||
ChartCacheData ccData ccRange ccFill = chartCache
|
ChartCacheData ccData ccAxis ccRange ccFill = chartCache
|
||||||
chunks = case ccFill of
|
chunks = case ccFill of
|
||||||
Nothing -> [(cacheUpdateStart, cacheUpdateEnd)]
|
Nothing -> [(cacheUpdateStart, cacheUpdateEnd)]
|
||||||
Just (mi, ma) -> if
|
Just (mi, ma) -> if
|
||||||
@ -131,32 +147,30 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
|||||||
| otherwise -> []
|
| otherwise -> []
|
||||||
| otherwise -> []
|
| otherwise -> []
|
||||||
-- - chunk them with chunhChart
|
-- - chunk them with chunhChart
|
||||||
chunkedChart = L.concat $ for chunks $ \(start, end) -> chunkChart (min 0 start) end cRes chartData
|
chunkedChart = L.filter (not . null . snd) $ L.concat $ for chunks $ \(start, end) -> chunkChart (min 0 start) end cRes chartData
|
||||||
lUpdate = cacheUpdateEnd - cRes
|
lUpdate = cacheUpdateEnd - cRes
|
||||||
-- - calculate Range and need for shift
|
-- - calculate Range and need for shift
|
||||||
shiftNeccessary = case ccRange of
|
shiftNeccessary = case ccRange of
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
Just (_,ma) -> cacheUpdateEnd > ma
|
Just (_,ma) -> cacheUpdateEnd > ma
|
||||||
(newRange, shiftInterval) = if not shiftNeccessary && isJust ccRange then (fromJust ccRange, 0) else
|
(newRange, shiftInterval) = if not shiftNeccessary && isJust ccRange then (fromJust ccRange, 0) else
|
||||||
let interval = (cTicks + 20) `div` 20 :: Int
|
let interval = cTicks `div` 20 :: Int
|
||||||
iTo = (cacheUpdateEnd + cRes * interval) `div` (cRes * interval)
|
iTo = ((cacheUpdateEnd + cRes * interval) `div` (cRes * interval)) * (cRes * interval)
|
||||||
iFrom = iTo - 20 * (cRes * interval)
|
iFrom = iTo - 20 * (cRes * interval)
|
||||||
in ((iFrom,iTo), 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
|
-- create data for updates
|
||||||
let timePointToIndex' :: (Int, Int) -> (Int, Int) -> TimePoint -> Int
|
let timePointToIndex' :: TimePoint -> Int
|
||||||
timePointToIndex' (cRes', cTicks') (rFrom, rTo) (TimePoint p) = let result = (p - rFrom) `div` cRes in
|
timePointToIndex' = timePointToIndex (Just $ ChartCacheSettings cRes cTicks) newRange
|
||||||
if
|
let indexToTimePoint' :: Int -> TimePoint
|
||||||
| p < rFrom || p > rTo -> error $ "timePointToIndex' " <> show ((cRes', cTicks'),(rFrom, rTo),TimePoint p) <> ": " <> show p <> " out of range."
|
indexToTimePoint' = indexToTimePoint (Just $ ChartCacheSettings cRes cTicks) newRange
|
||||||
| result < 0 || result >= cTicks' -> error $ "timePointToIndex' " <> show ((cRes', cTicks'),(rFrom, rTo),TimePoint p) <> ": " <> show result <> " is invalid index"
|
-- fold instead of map, so we can carry over cached calculatinos from element to element (for i.e. ema/sma)
|
||||||
| otherwise -> result
|
let (!foldedData,_,_) = foldl' folder ([], ChartPoint 0 0 0 [], mempty) chunkedChart
|
||||||
timePointToIndex :: TimePoint -> Int
|
|
||||||
timePointToIndex = timePointToIndex' newRange (cRes, cTicks)
|
|
||||||
-- fold instead of map, so we can carry over cached calculatinos from element to element (for i.e. ema/sma)
|
|
||||||
(!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 :: ([(Int, ChartPoint)], ChartPoint, HM.HashMap Int [Float]) -> (TimePoint, [ChartPoint]) -> ([(Int, ChartPoint)], ChartPoint, HM.HashMap Int [Float])
|
||||||
folder old (_,[]) = old
|
folder old (_,[]) = old
|
||||||
folder (acc, lastPoint, smaMap) (tp,cdata) = ((timePointToIndex tp, cp):acc, cp, foldl' (.) id smaUpdates smaMap)
|
folder (acc, lastPoint, smaMap) (tp,cdata) = ((timePointToIndex' tp, cp):acc, cp, foldl' (.) id smaUpdates smaMap)
|
||||||
where
|
where
|
||||||
cp = ChartPoint tp m vol studies
|
cp = ChartPoint tp m vol studies
|
||||||
(studies, smaUpdates) = unzip $ catMaybes $ (chartStudySettings chartSettings :: [ChartStudyType]) <&> \case
|
(studies, smaUpdates) = unzip $ catMaybes $ (chartStudySettings chartSettings :: [ChartStudyType]) <&> \case
|
||||||
@ -203,10 +217,30 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
|||||||
ChartStudyTypeClose -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,olhc_close $ findOLHC s)) <$> foldedData))
|
ChartStudyTypeClose -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,olhc_close $ findOLHC s)) <$> foldedData))
|
||||||
ChartStudyTypeSMA x -> id --TODO: implement #13
|
ChartStudyTypeSMA x -> id --TODO: implement #13
|
||||||
ChartStudyTypeVolume -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,volume $ findVolume s)) <$> foldedData))
|
ChartStudyTypeVolume -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,volume $ findVolume s)) <$> foldedData))
|
||||||
return (Just $ TimePoint lUpdate, ChartCacheData (foldl' (.) id updates ccData) (Just newRange) Nothing) -- FIXME: fillData still missing
|
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 -> Maybe Int -> (Maybe TimePoint, [ChartPoint])
|
||||||
getChunkedDay Chart{..} chunkResolution = (lUpdate, toCachePoint <$> chunkedData)
|
getChunkedDay Chart{..} chunkResolution = (lUpdate, toCachePoint <$> chunkedData)
|
||||||
where
|
where
|
||||||
chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData
|
chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData
|
||||||
lUpdate = fmap fst . lastMaybe $ chunkedData
|
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
|
||||||
|
28
src/Run.hs
28
src/Run.hs
@ -4,24 +4,24 @@
|
|||||||
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
|
||||||
|
|
||||||
@ -232,8 +232,16 @@ renderLoop = do
|
|||||||
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 ()
|
||||||
|
|
||||||
|
|
||||||
|
49
src/Types.hs
49
src/Types.hs
@ -36,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
|
||||||
@ -44,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"
|
||||||
@ -68,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
|
||||||
@ -80,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
|
||||||
@ -115,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
|
||||||
@ -132,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 newtype (Show, Eq)
|
deriving stock (Show)
|
||||||
|
deriving newtype (Eq)
|
||||||
|
|
||||||
data IBSymbolSample = IBSymbolSample
|
data IBSymbolSample = IBSymbolSample
|
||||||
{ _symbolId :: Int
|
{ _symbolId :: Int
|
||||||
@ -144,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
|
||||||
@ -155,7 +159,7 @@ data ChartSettings = ChartSettings
|
|||||||
, chartStart :: Maybe UTCTime
|
, chartStart :: Maybe UTCTime
|
||||||
, chartEnd :: Maybe UTCTime
|
, chartEnd :: Maybe UTCTime
|
||||||
, chartStudySettings :: [ChartStudyType]
|
, chartStudySettings :: [ChartStudyType]
|
||||||
} deriving (Show, Eq)
|
} deriving stock (Show, Eq)
|
||||||
|
|
||||||
defChartSettings :: ChartSettings
|
defChartSettings :: ChartSettings
|
||||||
defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
|
defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
|
||||||
@ -163,7 +167,7 @@ defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
|
|||||||
updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
|
updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
|
||||||
updateChartStudySettings Chart{..} s =
|
updateChartStudySettings Chart{..} s =
|
||||||
let chartSettings = chartSettings { chartStudySettings = [] }
|
let chartSettings = chartSettings { chartStudySettings = [] }
|
||||||
chartCache = emptyChartCacheData
|
chartCache = emptyChartCacheData chartCacheSettings
|
||||||
lastCacheUpdate = Nothing
|
lastCacheUpdate = Nothing
|
||||||
in Chart{..}
|
in Chart{..}
|
||||||
|
|
||||||
@ -171,6 +175,9 @@ updateChartStudySettings Chart{..} s =
|
|||||||
--
|
--
|
||||||
-- History and Resolution yield 1 day by default. Do not increase over 5000 as memery-consumption explodes!
|
-- History and Resolution yield 1 day by default. Do not increase over 5000 as memery-consumption explodes!
|
||||||
-- Think of it as timePlotted = candleWidth * numberOfCandles
|
-- Think of it as timePlotted = candleWidth * numberOfCandles
|
||||||
|
--
|
||||||
|
-- chartCacheHistory should be a multiple of 20 as there often is 5% buffer in various caches and this
|
||||||
|
-- fills the caches more optimally
|
||||||
data ChartCacheSettings = ChartCacheSettings
|
data ChartCacheSettings = ChartCacheSettings
|
||||||
{ chartCacheResolution :: Int
|
{ chartCacheResolution :: Int
|
||||||
, chartCacheHistory :: Int
|
, chartCacheHistory :: Int
|
||||||
@ -189,18 +196,21 @@ newtype TimePoint = TimePoint 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}
|
||||||
| Volume { volume :: Float }
|
| Volume { volume :: Float }
|
||||||
deriving (Show, Eq, Generic, FromJSON, ToJSON)
|
deriving stock (Show, Eq, Generic)
|
||||||
|
deriving anyclass (FromJSON, ToJSON)
|
||||||
|
|
||||||
data ChartPoint = ChartPoint
|
data ChartPoint = ChartPoint
|
||||||
{ timeOfDay :: TimePoint
|
{ timeOfDay :: TimePoint
|
||||||
, pointValue :: Float
|
, pointValue :: Float
|
||||||
, pointVolume :: Float
|
, 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
|
data ChartStudyType = ChartStudyTypeDirect
|
||||||
| ChartStudyTypeSMA Int
|
| ChartStudyTypeSMA Int
|
||||||
| ChartStudyTypeOpen
|
| ChartStudyTypeOpen
|
||||||
@ -212,13 +222,14 @@ data ChartStudyType = ChartStudyTypeDirect
|
|||||||
deriving anyclass (Hashable)
|
deriving anyclass (Hashable)
|
||||||
|
|
||||||
data ChartCacheData = ChartCacheData
|
data ChartCacheData = ChartCacheData
|
||||||
{ chartCacheData :: HashMap ChartStudyType (VS.Vector Float)
|
{ chartCacheData :: HashMap ChartStudyType (VS.Vector Float)
|
||||||
, chartCacheCurrent :: Maybe (Int,Int) -- ^ in number of TimePoint, negative meaning "before today"
|
, chartCacheAxis :: VS.Vector Float
|
||||||
, chartCacheFilled :: Maybe (Int,Int) -- ^ in number of TimePoint, negative meaning "before today"
|
, 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)
|
} deriving stock (Show, Eq)
|
||||||
|
|
||||||
emptyChartCacheData :: ChartCacheData
|
emptyChartCacheData :: ChartCacheSettings -> ChartCacheData
|
||||||
emptyChartCacheData = ChartCacheData mempty Nothing Nothing
|
emptyChartCacheData ChartCacheSettings{..} = ChartCacheData mempty (VS.replicate chartCacheHistory 0) Nothing Nothing
|
||||||
|
|
||||||
data Chart = Chart
|
data Chart = Chart
|
||||||
{ chartContractID :: Int
|
{ chartContractID :: Int
|
||||||
@ -230,7 +241,7 @@ data Chart = Chart
|
|||||||
, chartCache :: ChartCacheData -- ^ cache for drawing with all pointExtra filled out and sampled according to 'chartSettings'
|
, 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