made things work with current stackage.
This commit is contained in:
parent
783d47e190
commit
7a337d0a6a
2
deps/dear-implot.hs
vendored
2
deps/dear-implot.hs
vendored
@ -1 +1 @@
|
|||||||
Subproject commit da2b394f827c001cc3b51e0188be1007f40fa3d9
|
Subproject commit 29987079151199d22d23b99f9d461ccedf573b0c
|
@ -99,7 +99,7 @@ library
|
|||||||
build-depends:
|
build-depends:
|
||||||
StateVar
|
StateVar
|
||||||
, aeson
|
, aeson
|
||||||
, base >=4.11 && <10
|
, base >=4.11
|
||||||
, binary
|
, binary
|
||||||
, bytestring
|
, bytestring
|
||||||
, data-default
|
, data-default
|
||||||
@ -176,7 +176,7 @@ executable ibhelper-exe
|
|||||||
build-depends:
|
build-depends:
|
||||||
StateVar
|
StateVar
|
||||||
, aeson
|
, aeson
|
||||||
, base >=4.11 && <10
|
, base >=4.11
|
||||||
, binary
|
, binary
|
||||||
, bytestring
|
, bytestring
|
||||||
, data-default
|
, data-default
|
||||||
@ -257,7 +257,7 @@ test-suite ibhelper-test
|
|||||||
build-depends:
|
build-depends:
|
||||||
StateVar
|
StateVar
|
||||||
, aeson
|
, aeson
|
||||||
, base >=4.11 && <10
|
, base >=4.11
|
||||||
, binary
|
, binary
|
||||||
, bytestring
|
, bytestring
|
||||||
, data-default
|
, data-default
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE OverloadedRecordDot #-}
|
||||||
module AppFiller where
|
module AppFiller where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
@ -46,9 +46,8 @@ appFiller app = runRIO app $ withRunInIO $ \run -> 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
|
||||||
(Msg_IB_IN (IB_PortfolioValue c p mp mv ac u r n)) -> do
|
(Msg_IB_IN (IB_PortfolioValue c p mp mv ac u r n)) -> do
|
||||||
let cid = conId :: IBContract -> Int
|
let updateAction (a:as)
|
||||||
updateAction (a@IBPortfolioValue{..}:as)
|
| a._contract.conId == c.conId = IBPortfolioValue c p mp mv ac u r:as
|
||||||
| cid _contract == cid c = IBPortfolioValue c p mp mv ac u r:as
|
|
||||||
| otherwise = a:updateAction as
|
| otherwise = a:updateAction as
|
||||||
updateAction [] = [IBPortfolioValue c p mp mv ac u r]
|
updateAction [] = [IBPortfolioValue c p mp mv ac u r]
|
||||||
action = HM.update (\ai -> Just $ ai & accountPortfolio %~ updateAction) n
|
action = HM.update (\ai -> Just $ ai & accountPortfolio %~ updateAction) n
|
||||||
|
13
src/Chart.hs
13
src/Chart.hs
@ -1,5 +1,6 @@
|
|||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE OverloadedRecordDot #-}
|
||||||
{-# LANGUAGE DerivingVia #-}
|
{-# LANGUAGE DerivingVia #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
@ -29,7 +30,7 @@ import qualified Data.List as L
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Vector.Storable as VS
|
import qualified Data.Vector.Storable as VS
|
||||||
|
|
||||||
import qualified Debug.Trace as D
|
-- import qualified Debug.Trace as D
|
||||||
|
|
||||||
data FillerException = QuitFiller
|
data FillerException = QuitFiller
|
||||||
deriving stock Show
|
deriving stock Show
|
||||||
@ -39,15 +40,15 @@ instance Exception FillerException
|
|||||||
newChart :: IBContract -> RIO App ()
|
newChart :: IBContract -> RIO App ()
|
||||||
newChart contract = do
|
newChart contract = do
|
||||||
app <- ask
|
app <- ask
|
||||||
let sym = (symbol :: IBContract -> Text) contract
|
let sym = contract.symbol
|
||||||
con = (conId :: IBContract -> Int) contract
|
con = contract.conId
|
||||||
hmVar = appCharts . appRefs $ app
|
hmVar = appCharts . appRefs $ app
|
||||||
hm <- liftIO . readTVarIO $ hmVar
|
hm <- liftIO . readTVarIO $ hmVar
|
||||||
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)
|
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
|
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
|
||||||
@ -77,7 +78,7 @@ newChart contract = do
|
|||||||
|
|
||||||
fillChart :: App -> IBContract -> TVar Chart -> IO ()
|
fillChart :: App -> IBContract -> TVar Chart -> IO ()
|
||||||
fillChart app contract cVar = runRIO app $ do
|
fillChart app contract cVar = runRIO app $ do
|
||||||
let sym = (symbol :: IBContract -> Text) contract
|
let sym = contract.symbol
|
||||||
(tickerMapVar :: TVar (HashMap Int Text)) <- tickerIdToSymbol . appRefs <$> ask
|
(tickerMapVar :: TVar (HashMap Int Text)) <- tickerIdToSymbol . appRefs <$> ask
|
||||||
alreadyAdded <- (sym `elem`) . HM.elems <$> liftIO (readTVarIO tickerMapVar)
|
alreadyAdded <- (sym `elem`) . HM.elems <$> liftIO (readTVarIO tickerMapVar)
|
||||||
unless alreadyAdded $ do
|
unless alreadyAdded $ do
|
||||||
@ -257,7 +258,7 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
|||||||
(Nothing, Nothing) -> Nothing
|
(Nothing, Nothing) -> Nothing
|
||||||
-- new data, update fillRange
|
-- new data, update fillRange
|
||||||
(mima, Just lastDP) -> let lastBlock = let d = timeOfDay lastDP in (intervalTo d + intervalFrom d) `div` 2
|
(mima, Just lastDP) -> let lastBlock = let d = timeOfDay lastDP in (intervalTo d + intervalFrom d) `div` 2
|
||||||
in case timePointToIndex' $ lastBlock of
|
in case timePointToIndex' lastBlock of
|
||||||
Left err -> error $ "impossible #1 Chart.hs - " <> err
|
Left err -> error $ "impossible #1 Chart.hs - " <> err
|
||||||
Right ma -> if ma < cTicks
|
Right ma -> if ma < cTicks
|
||||||
then case mima of -- check if we rotated out or have no fill-range set.
|
then case mima of -- check if we rotated out or have no fill-range set.
|
||||||
|
@ -163,7 +163,7 @@ data ChartSettings = ChartSettings
|
|||||||
} deriving stock (Show, Eq)
|
} deriving stock (Show, Eq)
|
||||||
|
|
||||||
defChartSettings :: ChartSettings
|
defChartSettings :: ChartSettings
|
||||||
defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
|
defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect, ChartStudyTypeVolume, ChartStudyTypeOpen]
|
||||||
|
|
||||||
updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
|
updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
|
||||||
updateChartStudySettings Chart{..} s =
|
updateChartStudySettings Chart{..} s =
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
#
|
#
|
||||||
# resolver: ./custom-snapshot.yaml
|
# resolver: ./custom-snapshot.yaml
|
||||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||||
resolver: lts-18.24
|
resolver: lts-21.2
|
||||||
|
|
||||||
# User packages to be built.
|
# User packages to be built.
|
||||||
# Various formats can be used as shown in the example below.
|
# Various formats can be used as shown in the example below.
|
||||||
|
Loading…
Reference in New Issue
Block a user