minor refactoring

This commit is contained in:
Nicole Dresselhaus 2022-07-21 22:33:59 +02:00
parent 30a1fb33ff
commit 8869cc2e82
2 changed files with 12 additions and 10 deletions

View File

@ -42,14 +42,16 @@ newChart contract = 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
ifM (liftIO $ doesFileExist $ fname) ifM (liftIO $ doesFileExist fname)
(bimap (\err -> cacheFileName <> ": "<> err) ((readMaybe $ dropExtension cacheFileName) :: Maybe Day,) <$> liftIO (eitherDecodeFileStrict' 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.")
return $ partitionEithers res return $ partitionEithers res
unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err) unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err)
let cacheData' :: HashMap Day (FingerTree TimePoint ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> cacheData let (unknownDates, cacheData') = partition (isNothing . fst) cacheData
logError $ displayShow $ HM.keys cacheData' unless (null unknownDates) $ logError $ display $ T.pack $ show (length unknownDates) <> " files had no parsable Date."
c <- liftIO $ newTVarIO $ Chart con (fromMaybe FT.empty $ cacheData' HM.!? today) (HM.delete today cacheData') undefined defChartSettings [] Nothing False 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{..})

View File

@ -57,12 +57,12 @@ shutdownApp = do
today <- liftIO $ utctDay <$> getCurrentTime today <- liftIO $ utctDay <$> getCurrentTime
liftIO $ unlessM (doesDirectoryExist $ "cache/" <> show chartContractID) $ createDirectory $ "cache/" <> show chartContractID 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! newData = HM.toList
newData = HM.alter (\case . fmap (filter (\ChartPoint{..} -> 0 /= volume))
Just t -> Just (merge t chartData') . HM.alter (Just . maybe chartData' (<>chartData')) today
Nothing -> Just chartData') today (toList <$> chartHistData) . fmap toList
newData' = filter (\ChartPoint{..} -> 0 /= volume) <$> newData $ chartHistData
forM_ (HM.toList newData') $ \(day, dat) -> do forM_ newData $ \(day, dat) -> do
liftIO $ encodeFile ("cache/" <> show chartContractID <> "/" <> show day <> ".json") dat liftIO $ encodeFile ("cache/" <> show chartContractID <> "/" <> show day <> ".json") dat
logInfo $ display $ ppShow' settings' logInfo $ display $ ppShow' settings'