From 85cbc004191087fae0eb59e18370f79df5f0afc0 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Thu, 25 Mar 2021 15:33:31 +0100
Subject: [PATCH] Improve per-request-cache performance

---
 yesod-core/src/Yesod/Core/Handler.hs   |  8 ++++----
 yesod-core/src/Yesod/Core/TypeCache.hs | 10 +++++-----
 2 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/yesod-core/src/Yesod/Core/Handler.hs b/yesod-core/src/Yesod/Core/Handler.hs
index 063ad1f9..9e9c3823 100644
--- a/yesod-core/src/Yesod/Core/Handler.hs
+++ b/yesod-core/src/Yesod/Core/Handler.hs
@@ -1149,9 +1149,9 @@ cached action = do
     eres <- Cache.cached cache action
     case eres of
       Right res -> return res
-      Left (newCache, res) -> do
+      Left (updateCache, res) -> do
           gs <- get
-          let merged = newCache `HM.union` ghsCache gs
+          let merged = updateCache $ ghsCache gs
           put $ gs { ghsCache = merged }
           return res
 
@@ -1192,9 +1192,9 @@ cachedBy k action = do
     eres <- Cache.cachedBy cache k action
     case eres of
       Right res -> return res
-      Left (newCache, res) -> do
+      Left (updateCache, res) -> do
           gs <- get
-          let merged = newCache `HM.union` ghsCacheBy gs
+          let merged = updateCache $ ghsCacheBy gs
           put $ gs { ghsCacheBy = merged }
           return res
 
diff --git a/yesod-core/src/Yesod/Core/TypeCache.hs b/yesod-core/src/Yesod/Core/TypeCache.hs
index 78bbe0a2..0454a670 100644
--- a/yesod-core/src/Yesod/Core/TypeCache.hs
+++ b/yesod-core/src/Yesod/Core/TypeCache.hs
@@ -32,12 +32,12 @@ type KeyedTypeMap = HashMap (TypeRep, ByteString) Dynamic
 cached :: (Monad m, Typeable a)
        => TypeMap
        -> m a                       -- ^ cache the result of this action
-       -> m (Either (TypeMap, a) a) -- ^ Left is a cache miss, Right is a hit
+       -> m (Either (TypeMap -> TypeMap, a) a) -- ^ Left is a cache miss, Right is a hit
 cached cache action = case cacheGet cache of
     Just val -> return $ Right val
     Nothing -> do
         val <- action
-        return $ Left (cacheSet val cache, val)
+        return $ Left (cacheSet val, val)
 
 -- | Retrieves a value from the cache
 --
@@ -72,12 +72,12 @@ cachedBy :: (Monad m, Typeable a)
          => KeyedTypeMap
          -> ByteString                     -- ^ a cache key
          -> m a                            -- ^ cache the result of this action
-         -> m (Either (KeyedTypeMap, a) a) -- ^ Left is a cache miss, Right is a hit
+         -> m (Either (KeyedTypeMap -> KeyedTypeMap, a) a) -- ^ Left is a cache miss, Right is a hit
 cachedBy cache k action = case cacheByGet k cache of
     Just val -> return $ Right val
     Nothing -> do
         val <- action
-        return $ Left (cacheBySet k val cache, val)
+        return $ Left (cacheBySet k val, val)
 
 -- | Retrieves a value from the keyed cache
 --
@@ -93,4 +93,4 @@ cacheByGet key c = res
 --
 -- @since 1.6.10
 cacheBySet :: Typeable a => ByteString -> a -> KeyedTypeMap -> KeyedTypeMap
-cacheBySet key v cache = insert (typeOf v, key) (toDyn v) cache
\ No newline at end of file
+cacheBySet key v cache = insert (typeOf v, key) (toDyn v) cache