about summary refs log tree commit diff
path: root/users/Profpatsch
diff options
context:
space:
mode:
Diffstat (limited to 'users/Profpatsch')
-rw-r--r--users/Profpatsch/openlab-tools/default.nix1
-rw-r--r--users/Profpatsch/openlab-tools/openlab-tools.cabal1
-rw-r--r--users/Profpatsch/openlab-tools/src/OpenlabTools.hs10
3 files changed, 9 insertions, 3 deletions
diff --git a/users/Profpatsch/openlab-tools/default.nix b/users/Profpatsch/openlab-tools/default.nix
index 1966c62a7c..9c1e48af9e 100644
--- a/users/Profpatsch/openlab-tools/default.nix
+++ b/users/Profpatsch/openlab-tools/default.nix
@@ -25,6 +25,7 @@ let
       pkgs.haskellPackages.pa-run-command
       pkgs.haskellPackages.aeson-better-errors
       pkgs.haskellPackages.blaze-html
+      pkgs.haskellPackages.deepseq
       pkgs.haskellPackages.hs-opentelemetry-sdk
       pkgs.haskellPackages.http-conduit
       pkgs.haskellPackages.http-types
diff --git a/users/Profpatsch/openlab-tools/openlab-tools.cabal b/users/Profpatsch/openlab-tools/openlab-tools.cabal
index 369a1cabb8..621c8a5c42 100644
--- a/users/Profpatsch/openlab-tools/openlab-tools.cabal
+++ b/users/Profpatsch/openlab-tools/openlab-tools.cabal
@@ -76,6 +76,7 @@ library
         blaze-html,
         bytestring,
         containers,
+        deepseq,
         unordered-containers,
         exceptions,
         filepath,
diff --git a/users/Profpatsch/openlab-tools/src/OpenlabTools.hs b/users/Profpatsch/openlab-tools/src/OpenlabTools.hs
index 056d2a5d22..b63b6a6012 100644
--- a/users/Profpatsch/openlab-tools/src/OpenlabTools.hs
+++ b/users/Profpatsch/openlab-tools/src/OpenlabTools.hs
@@ -5,6 +5,7 @@
 
 module OpenlabTools where
 
+import Control.DeepSeq (NFData, deepseq)
 import Control.Monad.Logger qualified as Logger
 import Control.Monad.Logger.CallStack
 import Control.Monad.Reader
@@ -259,13 +260,15 @@ newCache result = do
   until <- getCurrentTime
   newIORef Cache {..}
 
-updateCache :: IORef (Cache a) -> a -> IO ()
-updateCache cache result = do
+updateCache :: (NFData a) => IORef (Cache a) -> a -> IO ()
+updateCache cache result' = do
+  -- make sure we don’t hold onto the world by deepseq-ing
+  let result = deepseq result' result'
   until <- getCurrentTime <&> ((5 * 60) `addUTCTime`)
   _ <- writeIORef cache Cache {..}
   pure ()
 
-updateCacheIfNewer :: (MonadUnliftIO m) => IORef (Cache b) -> m b -> m b
+updateCacheIfNewer :: (MonadUnliftIO m, NFData b) => IORef (Cache b) -> m b -> m b
 updateCacheIfNewer cache act = withRunInIO $ \runInIO -> do
   old <- readIORef cache
   now <- getCurrentTime
@@ -273,6 +276,7 @@ updateCacheIfNewer cache act = withRunInIO $ \runInIO -> do
     then do
       res <- runInIO act
       updateCache cache res
+
       pure res
     else pure old.result