lebd/src/Handler/Entries.hs

{-# 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 $ do
        setTitle . toHtml . K.pluralise $ kind
        $(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