Drezil/ibhelper
1
1
Fork 0
Code Issues 12 Pull Requests Projects Releases Wiki Activity

cache now is not monolithic, but 1 file per day.

Browse Source
This commit is contained in:
Nicole Dresselhaus 2022-07-21 18:59:13 +02:00
parent 971f9d1651
commit 30a1fb33ff
2 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/Chart.hs
View File

@ -1,13 +1,15 @@
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DerivingVia #-} {-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Chart (newChart, FillerException(..), getUpdatedChartCache) where module Chart (newChart, FillerException(..), getUpdatedChartCache) where
import Import import Import
import Data.Aeson (eitherDecodeFileStrict') import Data.Aeson (eitherDecodeFileStrict')
import RIO.List import RIO.List
import RIO.List.Partial import RIO.List.Partial
import RIO.FilePath
import Data.Time.Calendar (Day(..)) import Data.Time.Calendar (Day(..))
import Data.FingerTree (FingerTree) import Data.FingerTree (FingerTree)
import Control.Concurrent (forkIO) import Control.Concurrent (forkIO)
@ -35,16 +37,19 @@ newChart contract = do
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
let cacheFileName = "cache/"<> show con <>".json" today <- liftIO getCurrentDay :: RIO App Day
today <- liftIO getCurrentDay (cacheErrors, cacheData) <- do
cacheData <- liftIO $ ifM (doesFileExist cacheFileName) files <- liftIO $ listDirectory $ "cache" </> show con
(eitherDecodeFileStrict' cacheFileName) res <- forM files $ \cacheFileName -> do
(return $ Left $ "cachefile "<>cacheFileName<>" not found.") let fname = "cache" </> show con </> cacheFileName
(cacheData' :: HashMap Day (FingerTree TimePoint ChartPoint)) <- case cacheData of ifM (liftIO $ doesFileExist $ fname)
Left err -> logError (display (T.pack $ "Error opening "<>cacheFileName<>".\n") <> displayShow err) (bimap (\err -> cacheFileName <> ": "<> err) ((readMaybe $ dropExtension cacheFileName) :: Maybe Day,) <$> liftIO (eitherDecodeFileStrict' fname))
>> return HM.empty (return $ Left $ "cachefile "<>cacheFileName<>" not found.")
Right (d :: HashMap Day [ChartPoint]) -> return $ FT.fromList <$> d return $ partitionEithers res
c <- liftIO $ newTVarIO $ Chart con (fromMaybe FT.empty $ cacheData' HM.!? today) mempty undefined defChartSettings [] Nothing False unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err)
let cacheData' :: HashMap Day (FingerTree TimePoint ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> 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
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{..})

4
src/Run.hs
View File

@ -55,13 +55,15 @@ shutdownApp = do
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
let (_, chartData') = getUpdatedChartCache c (Just $ ChartSettings 5 Nothing Nothing) let (_, chartData') = getUpdatedChartCache c (Just $ ChartSettings 5 Nothing Nothing)
merge a b = a <> b --TODO: merge duplicates! merge a b = a <> b --TODO: merge duplicates!
newData = HM.alter (\case newData = HM.alter (\case
Just t -> Just (merge t chartData') Just t -> Just (merge t chartData')
Nothing -> Just chartData') today (toList <$> chartHistData) Nothing -> Just chartData') today (toList <$> chartHistData)
newData' = filter (\ChartPoint{..} -> 0 /= volume) <$> newData newData' = filter (\ChartPoint{..} -> 0 /= volume) <$> newData
liftIO $ encodeFile ("cache/"<> show chartContractID <>".json") newData' forM_ (HM.toList newData') $ \(day, dat) -> do
liftIO $ encodeFile ("cache/" <> show chartContractID <> "/" <> show day <> ".json") dat
logInfo $ display $ ppShow' settings' logInfo $ display $ ppShow' settings'
renderLoop :: RIO App () renderLoop :: RIO App ()