34 lines
1.1 KiB
Haskell
34 lines
1.1 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
module Handler.Entries where
|
|
|
|
import Import
|
|
|
|
import Web.Slug ( Slug )
|
|
|
|
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]
|
|
defaultLayout $(widgetFile "entries")
|
|
|
|
checkMatching :: K.EntryKind -> Slug -> Entry -> Bool
|
|
checkMatching kind slug entry = (kind == entryKind entry) && (slug == entrySlug entry)
|
|
|
|
getEntryNoSlugR :: a -> EntryId -> Handler Html
|
|
getEntryNoSlugR _ entryId = do
|
|
entry <- fmap (Entity entryId) . runDB . get404 $ entryId
|
|
redirectWith movedPermanently301 . entryR $ entry
|
|
|
|
getEntryR :: K.EntryKind -> EntryId -> Slug -> Handler Html
|
|
getEntryR kind entryId slug = do
|
|
entry <- fmap (Entity entryId) . runDB . get404 $ entryId
|
|
if checkMatching kind slug $ entityVal entry
|
|
then defaultLayout $ do
|
|
setTitle . toHtml . entryName . entityVal $ entry
|
|
$(widgetFile "entry")
|
|
else redirectWith movedPermanently301 $ entryR entry
|