Add basic support for h-entry categories, which are actually more like tags than categories really
This commit is contained in:
parent
dfafe33e06
commit
474ed3cf28
5 changed files with 35 additions and 0 deletions
|
@ -37,3 +37,12 @@ Syndication
|
|||
entryId EntryId
|
||||
profileId ProfileId
|
||||
url Text sqltype=varchar(255)
|
||||
|
||||
Category
|
||||
tag Slug sqltype=varchar(190)
|
||||
UniqueTag tag
|
||||
|
||||
EntryCategory
|
||||
entryId EntryId
|
||||
categoryId CategoryId
|
||||
UniqueEntryCategory entryId categoryId
|
||||
|
|
|
@ -8,6 +8,8 @@
|
|||
|
||||
/ HomeR GET
|
||||
/avatars/#UserId AvatarR GET
|
||||
/categories/#Slug CategoryR GET
|
||||
|
||||
/feed FeedR GET
|
||||
!/#EntryKind/feed FeedKindR GET
|
||||
|
||||
|
|
|
@ -50,6 +50,7 @@ import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
|
|||
-- Don't forget to add new modules to your cabal file!
|
||||
import Handler.Avatars
|
||||
import Handler.Common
|
||||
import Handler.Categories
|
||||
import Handler.Entries
|
||||
import Handler.Feed
|
||||
import Handler.Home
|
||||
|
|
22
src/Handler/Categories.hs
Normal file
22
src/Handler/Categories.hs
Normal file
|
@ -0,0 +1,22 @@
|
|||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Handler.Categories where
|
||||
|
||||
import Import hiding ( on, (==.) )
|
||||
|
||||
import Database.Esqueleto
|
||||
import Web.Slug ( Slug, unSlug )
|
||||
import Widget.Feed ( hFeed )
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
getCategoryR :: Slug -> Handler Html
|
||||
getCategoryR tag = do
|
||||
entries <- runDB . select . from $ \(category `InnerJoin` ec `InnerJoin` entry) -> do
|
||||
on $ entry ^. EntryId ==. ec ^. EntryCategoryEntryId
|
||||
on $ category ^. CategoryId ==. ec ^. EntryCategoryCategoryId
|
||||
where_ $ category ^. CategoryTag ==. val tag
|
||||
return entry
|
||||
defaultLayout $ do
|
||||
setTitle . toHtml . T.cons '#' . unSlug $ tag
|
||||
hFeed entries
|
|
@ -11,6 +11,7 @@ module Model where
|
|||
|
||||
import ClassyPrelude.Yesod
|
||||
import Database.Persist.Quasi
|
||||
import Web.Slug ( Slug )
|
||||
import Yesod.Auth.HashDB ( HashDBUser(..) )
|
||||
import Text.Mustache ( (~>) )
|
||||
import qualified Text.Mustache as M
|
||||
|
|
Loading…
Reference in a new issue