lebd/src/Handler/Entries.hs

39 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 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 _ entryId = getEntry <=< fmap (Entity entryId) . runDB . get404 $ entryId
getEntryWithSlugR :: a -> EntryId -> b -> Handler Html
getEntryWithSlugR kind = const . getEntryR kind
getEntry :: (Entity Entry) -> Handler Html
getEntry entry = do
let correctRoute = entryR entry
actualRoute <- getCurrentRoute
when (actualRoute /= Just correctRoute) $
redirectWith movedPermanently301 correctRoute
defaultLayout $ do
setTitle . toHtml . entryName . entityVal $ entry
$(widgetFile "entry")