made things work with current stackage.

This commit is contained in:
Nicole Dresselhaus 2023-07-18 01:20:57 +02:00
parent 783d47e190
commit 7a337d0a6a
6 changed files with 18 additions and 18 deletions

2
deps/dear-implot.hs vendored

@ -1 +1 @@
Subproject commit da2b394f827c001cc3b51e0188be1007f40fa3d9 Subproject commit 29987079151199d22d23b99f9d461ccedf573b0c

View File

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

View File

@ -1,5 +1,5 @@
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedRecordDot #-}
module AppFiller where module AppFiller where
import Import import Import
@ -46,10 +46,9 @@ appFiller app = runRIO app $ withRunInIO $ \run -> do
-- let action = HM.update (\ai -> Just $ ai & accountInfo . accountLastUpdate %~ const t) n -- 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
atomically $ modifyTVar' (Types.accounts currentAppData) action atomically $ modifyTVar' (Types.accounts currentAppData) action

View File

@ -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,8 +78,8 @@ 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
tickerId <- (+1) . foldl' max 1000 . HM.keys <$> liftIO (readTVarIO tickerMapVar) tickerId <- (+1) . foldl' max 1000 . HM.keys <$> liftIO (readTVarIO tickerMapVar)
@ -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.

View File

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

View File

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