Add "new topic" link to discussion widget
This commit is contained in:
parent
9368e68ab5
commit
66cf702203
5 changed files with 35 additions and 7 deletions
|
@ -42,8 +42,10 @@ import Vervis.Model
|
|||
import Vervis.Settings (widgetFile)
|
||||
import Vervis.Widget.Discussion
|
||||
|
||||
getDiscussion :: (Int -> Route App) -> AppDB DiscussionId -> Handler Html
|
||||
getDiscussion reply getdid = defaultLayout $ discussionW getdid reply
|
||||
getDiscussion
|
||||
:: (Int -> Route App) -> Route App -> AppDB DiscussionId -> Handler Html
|
||||
getDiscussion reply topic getdid =
|
||||
defaultLayout $ discussionW getdid topic reply
|
||||
|
||||
getMessage :: (Int -> Route App) -> AppDB DiscussionId -> Int -> Handler Html
|
||||
getMessage reply getdid num = do
|
||||
|
|
|
@ -139,6 +139,11 @@ getTicketR shar proj num = do
|
|||
else return author
|
||||
return (author, closer, ticket)
|
||||
let desc = renderSourceT Markdown $ T.filter (/= '\r') $ ticketDesc ticket
|
||||
discuss =
|
||||
discussionW
|
||||
(return $ ticketDiscuss ticket)
|
||||
(TicketTopReplyR shar proj num)
|
||||
(TicketReplyR shar proj num)
|
||||
defaultLayout $(widgetFile "ticket/one")
|
||||
|
||||
putTicketR :: Text -> Text -> Int -> Handler Html
|
||||
|
@ -196,6 +201,7 @@ getTicketDiscussionR :: Text -> Text -> Int -> Handler Html
|
|||
getTicketDiscussionR shar proj num =
|
||||
getDiscussion
|
||||
(TicketReplyR shar proj num)
|
||||
(TicketTopReplyR shar proj num)
|
||||
(selectDiscussionId shar proj num)
|
||||
|
||||
postTicketDiscussionR :: Text -> Text -> Int -> Handler Html
|
||||
|
|
|
@ -69,10 +69,10 @@ messageTreeW reply cReplies now t = go t
|
|||
^{go tree}
|
||||
|]
|
||||
|
||||
discussionW :: AppDB DiscussionId -> (Int -> Route App) -> Widget
|
||||
discussionW getdid reply = do
|
||||
discussionW :: AppDB DiscussionId -> Route App -> (Int -> Route App) -> Widget
|
||||
discussionW getdid topic reply = do
|
||||
forest <- handlerToWidget $ getDiscussionTree getdid
|
||||
cReplies <- newIdent
|
||||
now <- liftIO getCurrentTime
|
||||
toWidget $(cassiusFile "templates/discussion/widget/tree.cassius")
|
||||
traverse_ (messageTreeW reply cReplies now) forest
|
||||
let msgTree = messageTreeW reply cReplies now
|
||||
$(widgetFile "discussion/widget/tree")
|
||||
|
|
20
templates/discussion/widget/tree.hamlet
Normal file
20
templates/discussion/widget/tree.hamlet
Normal file
|
@ -0,0 +1,20 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
$#
|
||||
$# The author(s) have dedicated all copyright and related and neighboring
|
||||
$# rights to this software to the public domain worldwide. This software is
|
||||
$# distributed without any warranty.
|
||||
$#
|
||||
$# You should have received a copy of the CC0 Public Domain Dedication along
|
||||
$# with this software. If not, see
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
<div>
|
||||
<a href=@{topic}>new topic
|
||||
|
||||
<div>
|
||||
$forall tree <- forest
|
||||
^{msgTree tree}
|
|
@ -37,4 +37,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|||
|
||||
<h3>Discussion
|
||||
|
||||
^{discussionW (return $ ticketDiscuss ticket) (TicketReplyR shar proj num)}
|
||||
^{discuss}
|
||||
|
|
Loading…
Reference in a new issue