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

25
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
let fname = "cache" </> show con </> cacheFileName
ifM (liftIO $ doesFileExist $ fname)
(bimap (\err -> cacheFileName <> ": "<> err) ((readMaybe $ dropExtension cacheFileName) :: Maybe Day,) <$> liftIO (eitherDecodeFileStrict' fname))
(return $ Left $ "cachefile "<>cacheFileName<>" not found.") (return $ Left $ "cachefile "<>cacheFileName<>" not found.")
(cacheData' :: HashMap Day (FingerTree TimePoint ChartPoint)) <- case cacheData of return $ partitionEithers res
Left err -> logError (display (T.pack $ "Error opening "<>cacheFileName<>".\n") <> displayShow err) unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err)
>> return HM.empty let cacheData' :: HashMap Day (FingerTree TimePoint ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> cacheData
Right (d :: HashMap Day [ChartPoint]) -> return $ FT.fromList <$> d logError $ displayShow $ HM.keys cacheData'
c <- liftIO $ newTVarIO $ Chart con (fromMaybe FT.empty $ cacheData' HM.!? today) mempty undefined defChartSettings [] Nothing False 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 ()