Improve per-request-cache performance

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
 

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
+cacheBySet key v cache = insert (typeOf v, key) (toDyn v) cache