yesod-core 1.6.9 → 1.6.10
raw patch · 5 files changed
+102/−28 lines, 5 files
Files
- ChangeLog.md +4/−0
- Yesod/Core/Handler.hs +48/−0
- Yesod/Core/TypeCache.hs +36/−23
- test/YesodCoreTest/Cache.hs +13/−4
- yesod-core.cabal +1/−1
ChangeLog.md view
@@ -1,5 +1,9 @@ # ChangeLog for yesod-core +## 1.6.10++* Adds functions to get and set values in the per-request caches. [#1573](https://github.com/yesodweb/yesod/pull/1573)+ ## 1.6.9 * Add `sendResponseNoContent` [#1565](https://github.com/yesodweb/yesod/pull/1565)
Yesod/Core/Handler.hs view
@@ -168,7 +168,11 @@ , getMessageRender -- * Per-request caching , cached+ , cacheGet+ , cacheSet , cachedBy+ , cacheByGet+ , cacheBySet -- * AJAX CSRF protection -- $ajaxCSRFOverview@@ -1134,6 +1138,27 @@ put $ gs { ghsCache = merged } return res +-- | Retrieves a value from the cache used by 'cached'.+--+-- @since 1.6.10+cacheGet :: (MonadHandler m, Typeable a)+ => m (Maybe a)+cacheGet = do+ cache <- ghsCache <$> get+ pure $ Cache.cacheGet cache++-- | Sets a value in the cache used by 'cached'.+--+-- @since 1.6.10+cacheSet :: (MonadHandler m, Typeable a)+ => a+ -> m ()+cacheSet value = do+ gs <- get+ let cache = ghsCache gs+ newCache = Cache.cacheSet value cache+ put $ gs { ghsCache = newCache }+ -- | a per-request cache. just like 'cached'. -- 'cached' can only cache a single value per type. -- 'cachedBy' stores multiple values per type by usage of a ByteString key@@ -1155,6 +1180,29 @@ let merged = newCache `HM.union` ghsCacheBy gs put $ gs { ghsCacheBy = merged } return res++-- | Retrieves a value from the cache used by 'cachedBy'.+--+-- @since 1.6.10+cacheByGet :: (MonadHandler m, Typeable a)+ => S.ByteString+ -> m (Maybe a)+cacheByGet key = do+ cache <- ghsCacheBy <$> get+ pure $ Cache.cacheByGet key cache++-- | Sets a value in the cache used by 'cachedBy'.+--+-- @since 1.6.10+cacheBySet :: (MonadHandler m, Typeable a)+ => S.ByteString+ -> a+ -> m ()+cacheBySet key value = do+ gs <- get+ let cache = ghsCacheBy gs+ newCache = Cache.cacheBySet key value cache+ put $ gs { ghsCacheBy = newCache } -- | Get the list of supported languages supplied by the user. --
Yesod/Core/TypeCache.hs view
@@ -7,7 +7,7 @@ -- Note that a TypeRep is unique to a module in a package, so types from different modules will not conflict if they have the same name. -- -- used in 'Yesod.Core.Handler.cached' and 'Yesod.Core.Handler.cachedBy'-module Yesod.Core.TypeCache (cached, cachedBy, TypeMap, KeyedTypeMap) where+module Yesod.Core.TypeCache (cached, cacheGet, cacheSet, cachedBy, cacheByGet, cacheBySet, TypeMap, KeyedTypeMap) where import Prelude hiding (lookup) import Data.Typeable (Typeable, TypeRep, typeOf)@@ -33,22 +33,30 @@ => TypeMap -> m a -- ^ cache the result of this action -> m (Either (TypeMap, a) a) -- ^ Left is a cache miss, Right is a hit-cached cache action = case clookup cache of+cached cache action = case cacheGet cache of Just val -> return $ Right val Nothing -> do val <- action- return $ Left (cinsert val cache, val)+ return $ Left (cacheSet val cache, val)++-- | Retrieves a value from the cache+--+-- @since 1.6.10+cacheGet :: Typeable a => TypeMap -> Maybe a+cacheGet cache = res where- clookup :: Typeable a => TypeMap -> Maybe a- clookup c =- res- where- res = lookup (typeOf $ fromJust res) c >>= fromDynamic- fromJust :: Maybe a -> a- fromJust = error "Yesod.Handler.cached.fromJust: Argument to typeOf was evaluated"+ res = lookup (typeOf $ fromJust res) cache >>= fromDynamic+ fromJust :: Maybe a -> a+ fromJust = error "Yesod.Handler.cached.fromJust: Argument to typeOf was evaluated" - cinsert :: Typeable a => a -> TypeMap -> TypeMap- cinsert v = insert (typeOf v) (toDyn v)+-- | Sets a value in the cache+--+-- @since 1.6.10+cacheSet :: (Typeable a)+ => a+ -> TypeMap+ -> TypeMap+cacheSet v cache = insert (typeOf v) (toDyn v) cache -- | similar to 'cached'. -- 'cached' can only cache a single value per type.@@ -65,19 +73,24 @@ -> 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-cachedBy cache k action = case clookup k cache of+cachedBy cache k action = case cacheByGet k cache of Just val -> return $ Right val Nothing -> do val <- action- return $ Left (cinsert k val cache, val)+ return $ Left (cacheBySet k val cache, val)++-- | Retrieves a value from the keyed cache+--+-- @since 1.6.10+cacheByGet :: Typeable a => ByteString -> KeyedTypeMap -> Maybe a+cacheByGet key c = res where- clookup :: Typeable a => ByteString -> KeyedTypeMap -> Maybe a- clookup key c =- res- where- res = lookup (typeOf $ fromJust res, key) c >>= fromDynamic- fromJust :: Maybe a -> a- fromJust = error "Yesod.Handler.cached.fromJust: Argument to typeOf was evaluated"+ res = lookup (typeOf $ fromJust res, key) c >>= fromDynamic+ fromJust :: Maybe a -> a+ fromJust = error "Yesod.Handler.cached.fromJust: Argument to typeOf was evaluated" - cinsert :: Typeable a => ByteString -> a -> KeyedTypeMap -> KeyedTypeMap- cinsert key v = insert (typeOf v, key) (toDyn v)+-- | Sets a value in the keyed cache+--+-- @since 1.6.10+cacheBySet :: Typeable a => ByteString -> a -> KeyedTypeMap -> KeyedTypeMap+cacheBySet key v cache = insert (typeOf v, key) (toDyn v) cache
test/YesodCoreTest/Cache.hs view
@@ -46,8 +46,12 @@ V2 v2a <- cached $ atomicModifyIORef ref $ \i -> (i + 1, V2 $ i + 1) V2 v2b <- cached $ atomicModifyIORef ref $ \i -> (i + 1, V2 $ i + 1) - return $ RepPlain $ toContent $ show [v1a, v1b, v2a, v2b]+ cacheBySet "3" (V2 3)+ Just (V2 v3a) <- cacheByGet "3"+ V2 v3b <- cachedBy "3" $ (pure $ V2 4) + return $ RepPlain $ toContent $ show [v1a, v1b, v2a, v2b, v3a, v3b]+ getKeyR :: Handler RepPlain getKeyR = do ref <- newIORef 0@@ -60,8 +64,13 @@ V2 v3a <- cachedBy "2" $ atomicModifyIORef ref $ \i -> (i + 1, V2 $ i + 1) V2 v3b <- cachedBy "2" $ atomicModifyIORef ref $ \i -> (i + 1, V2 $ i + 1) - return $ RepPlain $ toContent $ show [v1a, v1b, v2a, v2b, v3a, v3b] + cacheBySet "4" (V2 4)+ Just (V2 v4a) <- cacheByGet "4"+ V2 v4b <- cachedBy "4" $ (pure $ V2 5)++ return $ RepPlain $ toContent $ show [v1a, v1b, v2a, v2b, v3a, v3b, v4a, v4b]+ getNestedR :: Handler RepPlain getNestedR = getNested cached @@ -86,12 +95,12 @@ it "cached" $ runner $ do res <- request defaultRequest assertStatus 200 res- assertBody (L8.pack $ show [1, 1, 2, 2 :: Int]) res+ assertBody (L8.pack $ show [1, 1, 2, 2, 3, 3 :: Int]) res it "cachedBy" $ runner $ do res <- request defaultRequest { pathInfo = ["key"] } assertStatus 200 res- assertBody (L8.pack $ show [1, 1, 2, 2, 3, 3 :: Int]) res+ assertBody (L8.pack $ show [1, 1, 2, 2, 3, 3, 4, 4 :: Int]) res it "nested cached" $ runner $ do res <- request defaultRequest { pathInfo = ["nested"] }
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 1.6.9+version: 1.6.10 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>