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
|
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{..})
|
||||||
|
12
src/Run.hs
12
src/Run.hs
@ -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'
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user