diff --git a/yesod-core/Yesod/Handler.hs b/yesod-core/Yesod/Handler.hs index a0eddfa1..09b815c6 100644 --- a/yesod-core/Yesod/Handler.hs +++ b/yesod-core/Yesod/Handler.hs @@ -97,6 +97,12 @@ module Yesod.Handler , liftIOHandler -- * i18n , getMessageRender + -- * Per-request caching + , CacheKey + , mkCacheKey + , cacheLookup + , cacheInsert + , cacheDelete -- * Internal Yesod , runHandler , YesodApp (..) @@ -163,6 +169,9 @@ import Yesod.Message (RenderMessage (..)) import Text.Blaze (toHtml, preEscapedText) import Yesod.Internal.TestApi (catchIter) +import qualified Yesod.Internal.Cache as Cache +import Yesod.Internal.Cache (mkCacheKey, CacheKey) + -- | The type-safe URLs associated with a site argument. type family Route a @@ -259,6 +268,7 @@ data GHState = GHState { ghsSession :: SessionMap , ghsRBC :: Maybe RequestBodyContents , ghsIdent :: Int + , ghsCache :: Cache.Cache } type GHInner s m monad = @@ -380,7 +390,7 @@ runHandler handler mrender sroute tomr ma sa = , handlerRender = mrender , handlerToMaster = tomr } - let initSession' = GHState initSession Nothing 1 + let initSession' = GHState initSession Nothing 1 mempty (contents', finalSession, headers) <- catchIter ( fmap (\(a, b, c) -> (a, ghsSession b, c)) $ (\m -> runRWST m hd initSession') @@ -882,3 +892,16 @@ getMessageRender = do m <- getYesod l <- reqLangs `liftM` getRequest return $ renderMessage m l + +cacheLookup :: Monad mo => CacheKey a -> GGHandler sub master mo (Maybe a) +cacheLookup k = do + gs <- GHandler $ lift get + return $ Cache.lookup k $ ghsCache gs + +cacheInsert :: Monad mo => CacheKey a -> a -> GGHandler sub master mo () +cacheInsert k v = GHandler $ lift $ modify $ \gs -> + gs { ghsCache = Cache.insert k v $ ghsCache gs } + +cacheDelete :: Monad mo => CacheKey a -> GGHandler sub master mo () +cacheDelete k = GHandler $ lift $ modify $ \gs -> + gs { ghsCache = Cache.delete k $ ghsCache gs } diff --git a/yesod-core/test/YesodCoreTest.hs b/yesod-core/test/YesodCoreTest.hs index ded94770..6602ce4a 100644 --- a/yesod-core/test/YesodCoreTest.hs +++ b/yesod-core/test/YesodCoreTest.hs @@ -8,6 +8,7 @@ import YesodCoreTest.Links import YesodCoreTest.NoOverloadedStrings import YesodCoreTest.InternalRequest import YesodCoreTest.ErrorHandling +import YesodCoreTest.Cache import Test.Hspec @@ -21,4 +22,5 @@ specs = , noOverloadedTest , internalRequestTest , errorHandlingTest + , cacheTest ] diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 4131f27a..a79c4099 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -24,6 +24,7 @@ extra-source-files: test/YesodCoreTest/Links.hs test/YesodCoreTest/InternalRequest.hs test/YesodCoreTest/ErrorHandling.hs + test/YesodCoreTest/Cache.hs test.hs flag test @@ -89,6 +90,7 @@ library Yesod.Config Yesod.Internal.TestApi other-modules: Yesod.Internal + Yesod.Internal.Cache Yesod.Internal.Core Yesod.Internal.Session Yesod.Internal.Request