made things work with current stackage.
This commit is contained in:
		
							
								
								
									
										2
									
								
								deps/dear-implot.hs
									
									
									
									
										vendored
									
									
								
							
							
								
								
								
								
								
							
						
						
									
										2
									
								
								deps/dear-implot.hs
									
									
									
									
										vendored
									
									
								
							 Submodule deps/dear-implot.hs updated: da2b394f82...2998707915
									
								
							| @@ -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,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 | ||||||
|   | |||||||
							
								
								
									
										15
									
								
								src/Chart.hs
									
									
									
									
									
								
							
							
						
						
									
										15
									
								
								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,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. | ||||||
|   | |||||||
| @@ -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. | ||||||
|   | |||||||
		Reference in New Issue
	
	Block a user