2017-10-08 17:51:42 -04:00
|
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
2017-10-08 22:50:26 -04:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2017-10-08 01:51:48 -04:00
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Handler.Entries where
|
|
|
|
|
|
|
|
import Import
|
|
|
|
|
2017-10-08 22:32:13 -04:00
|
|
|
import Yesod.AtomFeed ( atomLink )
|
2017-10-08 17:51:42 -04:00
|
|
|
|
2017-10-10 21:35:36 -04:00
|
|
|
import Model.Cache ( getCached )
|
2017-10-11 08:34:36 -04:00
|
|
|
import Model.Entry ( entryTitle )
|
2017-10-08 18:02:42 -04:00
|
|
|
import Widget.Entry ( entryR, hEntry )
|
2017-10-08 01:51:48 -04:00
|
|
|
import Widget.Feed ( hFeed )
|
|
|
|
|
2017-10-10 21:44:33 -04:00
|
|
|
import qualified Data.Text as T
|
|
|
|
import qualified Model.Entry.Kind as K
|
|
|
|
|
2017-10-08 01:51:48 -04:00
|
|
|
getEntriesR :: K.EntryKind -> Handler Html
|
|
|
|
getEntriesR kind = do
|
|
|
|
entries <- runDB $ selectList [EntryKind ==. kind] [Desc EntryPublished]
|
2017-10-08 22:50:26 -04:00
|
|
|
title <- asks $ siteTitle . appSettings
|
2017-10-08 19:08:23 -04:00
|
|
|
defaultLayout $ do
|
|
|
|
setTitle . toHtml . K.pluralise $ kind
|
2017-10-08 22:50:26 -04:00
|
|
|
atomLink (FeedKindR kind) $ T.concat [K.pluralise kind, " ~ ", title]
|
2017-10-08 19:08:23 -04:00
|
|
|
$(widgetFile "entries")
|
2017-10-08 17:51:42 -04:00
|
|
|
|
2017-10-10 19:33:29 -04:00
|
|
|
getEntryR :: a -> EntryId -> Handler Html
|
2017-10-10 21:35:36 -04:00
|
|
|
getEntryR _ = renderEntry <=< getCached
|
2017-10-08 17:51:42 -04:00
|
|
|
|
2017-10-10 19:33:29 -04:00
|
|
|
getEntryWithSlugR :: a -> EntryId -> b -> Handler Html
|
|
|
|
getEntryWithSlugR kind = const . getEntryR kind
|
2017-10-08 17:51:42 -04:00
|
|
|
|
2017-10-10 21:35:36 -04:00
|
|
|
renderEntry :: (Entity Entry) -> Handler Html
|
|
|
|
renderEntry entry = do
|
2017-10-10 19:33:29 -04:00
|
|
|
let correctRoute = entryR entry
|
|
|
|
actualRoute <- getCurrentRoute
|
|
|
|
when (actualRoute /= Just correctRoute) $
|
|
|
|
redirectWith movedPermanently301 correctRoute
|
|
|
|
defaultLayout $ do
|
2017-10-11 08:34:36 -04:00
|
|
|
setTitle . toHtml . entryTitle . entityVal $ entry
|
2017-10-10 19:33:29 -04:00
|
|
|
$(widgetFile "entry")
|