mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fix(users/Profpatsch/openlab-tools): really deepseq cache content

Browse source 
Okay, so I guess you also have to seq the cache and everything in
between the IORef and the data.

Change-Id: I4c79c99afbd09e83e9d7a01d58b31b36862e4d11
Reviewed-on: https://cl.tvl.fyi/c/depot/+/9807
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
This commit is contained in:
Profpatsch 2023-10-20 14:09:53 +02:00 • committed by clbot
parent 3dba987de4
commit 640f6fdfe4
1 changed files with 5 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
users/Profpatsch/openlab-tools/src/OpenlabTools.hs
View file

@ -251,8 +251,8 @@ assertM span f v = case f v of
Left err -> appThrowTree span err Left err -> appThrowTree span err
data Cache a = Cache data Cache a = Cache
{ until :: UTCTime, { until :: !UTCTime,
result :: a result :: !a
} }
newCache :: a -> IO (IORef (Cache a)) newCache :: a -> IO (IORef (Cache a))
@ -262,10 +262,10 @@ newCache result = do
updateCache :: (NFData a) => IORef (Cache a) -> a -> IO () updateCache :: (NFData a) => IORef (Cache a) -> a -> IO ()
updateCache cache result' = do updateCache cache result' = do
-- make sure we don’t hold onto the world by deepseq-ing -- make sure we don’t hold onto the world by deepseq-ing and evaluating to WHNF
let result = deepseq result' result' let !result = deepseq result' result'
until <- getCurrentTime <&> ((5 * 60) `addUTCTime`) until <- getCurrentTime <&> ((5 * 60) `addUTCTime`)
_ <- writeIORef cache Cache {..} _ <- writeIORef cache $! Cache {..}
pure () pure ()
updateCacheIfNewer :: (MonadUnliftIO m, NFData b) => IORef (Cache b) -> m b -> m b updateCacheIfNewer :: (MonadUnliftIO m, NFData b) => IORef (Cache b) -> m b -> m b