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:
Danielle McLean 2017-10-11 12:35:36 +11:00
parent efdca09b1c
commit 02fd91cb77
Signed by: 00dani
GPG key ID: 5A5D2D1AFF12EEC5
3 changed files with 29 additions and 4 deletions

View file

@ -9,6 +9,7 @@ import Yesod.AtomFeed ( atomLink )
import qualified Data.Text as T
import qualified Entry.Kind as K
import Model.Cache ( getCached )
import Widget.Entry ( entryR, hEntry )
import Widget.Feed ( hFeed )
@ -22,13 +23,13 @@ getEntriesR kind = do
$(widgetFile "entries")
getEntryR :: a -> EntryId -> Handler Html
getEntryR _ entryId = getEntry <=< fmap (Entity entryId) . runDB . get404 $ entryId
getEntryR _ = renderEntry <=< getCached
getEntryWithSlugR :: a -> EntryId -> b -> Handler Html
getEntryWithSlugR kind = const . getEntryR kind
getEntry :: (Entity Entry) -> Handler Html
getEntry entry = do
renderEntry :: (Entity Entry) -> Handler Html
renderEntry entry = do
let correctRoute = entryR entry
actualRoute <- getCurrentRoute
when (actualRoute /= Just correctRoute) $