minor refactoring
This commit is contained in:
parent
30a1fb33ff
commit
8869cc2e82
10
src/Chart.hs
10
src/Chart.hs
@ -42,14 +42,16 @@ newChart contract = do
|
||||
files <- liftIO $ listDirectory $ "cache" </> show con
|
||||
res <- forM files $ \cacheFileName -> do
|
||||
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))
|
||||
(return $ Left $ "cachefile "<>cacheFileName<>" not found.")
|
||||
return $ partitionEithers res
|
||||
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
|
||||
let (unknownDates, cacheData') = partition (isNothing . fst) cacheData
|
||||
unless (null unknownDates) $ logError $ display $ T.pack $ show (length unknownDates) <> " files had no parsable Date."
|
||||
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
|
||||
liftIO $ atomically $ do
|
||||
modifyTVar' c (\Chart{..} -> let fillerThread = tid in Chart{..})
|
||||
|
12
src/Run.hs
12
src/Run.hs
@ -57,12 +57,12 @@ shutdownApp = do
|
||||
today <- liftIO $ utctDay <$> getCurrentTime
|
||||
liftIO $ unlessM (doesDirectoryExist $ "cache/" <> show chartContractID) $ createDirectory $ "cache/" <> show chartContractID
|
||||
let (_, chartData') = getUpdatedChartCache c (Just $ ChartSettings 5 Nothing Nothing)
|
||||
merge a b = a <> b --TODO: merge duplicates!
|
||||
newData = HM.alter (\case
|
||||
Just t -> Just (merge t chartData')
|
||||
Nothing -> Just chartData') today (toList <$> chartHistData)
|
||||
newData' = filter (\ChartPoint{..} -> 0 /= volume) <$> newData
|
||||
forM_ (HM.toList newData') $ \(day, dat) -> do
|
||||
newData = HM.toList
|
||||
. fmap (filter (\ChartPoint{..} -> 0 /= volume))
|
||||
. HM.alter (Just . maybe chartData' (<>chartData')) today
|
||||
. fmap toList
|
||||
$ chartHistData
|
||||
forM_ newData $ \(day, dat) -> do
|
||||
liftIO $ encodeFile ("cache/" <> show chartContractID <> "/" <> show day <> ".json") dat
|
||||
logInfo $ display $ ppShow' settings'
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user