Danielle McLean
02fd91cb77
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.
40 lines
1.2 KiB
Haskell
40 lines
1.2 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
module Handler.Entries where
|
|
|
|
import Import
|
|
|
|
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 )
|
|
|
|
getEntriesR :: K.EntryKind -> Handler Html
|
|
getEntriesR kind = do
|
|
entries <- runDB $ selectList [EntryKind ==. kind] [Desc EntryPublished]
|
|
title <- asks $ siteTitle . appSettings
|
|
defaultLayout $ do
|
|
setTitle . toHtml . K.pluralise $ kind
|
|
atomLink (FeedKindR kind) $ T.concat [K.pluralise kind, " ~ ", title]
|
|
$(widgetFile "entries")
|
|
|
|
getEntryR :: a -> EntryId -> Handler Html
|
|
getEntryR _ = renderEntry <=< getCached
|
|
|
|
getEntryWithSlugR :: a -> EntryId -> b -> Handler Html
|
|
getEntryWithSlugR kind = const . getEntryR kind
|
|
|
|
renderEntry :: (Entity Entry) -> Handler Html
|
|
renderEntry entry = do
|
|
let correctRoute = entryR entry
|
|
actualRoute <- getCurrentRoute
|
|
when (actualRoute /= Just correctRoute) $
|
|
redirectWith movedPermanently301 correctRoute
|
|
defaultLayout $ do
|
|
setTitle . toHtml . entryName . entityVal $ entry
|
|
$(widgetFile "entry")
|