diff options
Diffstat (limited to 'users/Profpatsch')
-rw-r--r-- | users/Profpatsch/openlab-tools/default.nix | 1 | ||||
-rw-r--r-- | users/Profpatsch/openlab-tools/openlab-tools.cabal | 1 | ||||
-rw-r--r-- | users/Profpatsch/openlab-tools/src/OpenlabTools.hs | 10 |
3 files changed, 9 insertions, 3 deletions
diff --git a/users/Profpatsch/openlab-tools/default.nix b/users/Profpatsch/openlab-tools/default.nix index 1966c62a7c16..9c1e48af9ece 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 369a1cabb82a..621c8a5c4213 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 056d2a5d221d..b63b6a601200 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 |