Add per-request entity caching support
Different areas of the app need access to entities - for example both the entry handler needs the entry itself to render it, but the breadcrumbs also need the entry to decide what to label its breadcrumb. Previously this was achieved by fetching entities from the database twice. This sucks, so now it's implemented by fetching entities once and caching them using Yesod's per-request cache.
This commit is contained in:
parent
efdca09b1c
commit
02fd91cb77
3 changed files with 29 additions and 4 deletions
23
src/Model/Cache.hs
Normal file
23
src/Model/Cache.hs
Normal file
|
@ -0,0 +1,23 @@
|
|||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Model.Cache ( getCached ) where
|
||||
|
||||
import Data.Typeable ( Typeable )
|
||||
import Database.Persist ( Entity (..), Key (..), PersistStore, PersistRecordBackend, keyToValues )
|
||||
import Yesod ( MonadHandler, HandlerSite, YesodPersist, YesodPersistBackend, cachedBy, get404, liftHandlerT, runDB )
|
||||
|
||||
import qualified Data.ByteString.Char8 as C
|
||||
|
||||
newtype CachedEntity t = CachedEntity { unCachedEntity :: Entity t } deriving Typeable
|
||||
|
||||
getCached :: ( MonadHandler m
|
||||
, YesodPersist (HandlerSite m)
|
||||
, PersistStore (YesodPersistBackend (HandlerSite m))
|
||||
, PersistRecordBackend entity (YesodPersistBackend (HandlerSite m))
|
||||
, Typeable entity
|
||||
) => Key entity -> m (Entity entity)
|
||||
getCached entId = liftHandlerT . cached . runDB . withId . get404 $ entId
|
||||
where key = C.pack . show . keyToValues $ entId
|
||||
withId = fmap $ Entity entId
|
||||
cached = fmap unCachedEntity . cachedBy key . fmap CachedEntity
|
Loading…
Add table
Add a link
Reference in a new issue