From c942c7d398c8b781d26a5d9ad81c4ef02515cc44 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Thu, 19 May 2016 16:58:23 +0000 Subject: [PATCH] Ticket discussion and message routes --- config/models | 4 +++ config/routes | 2 ++ src/Vervis/Discussion.hs | 6 ++--- src/Vervis/Handler/Discussion.hs | 46 ++++++++++++++++++++++++++++++++ src/Vervis/Handler/Ticket.hs | 37 ++++++++++++++++++------- src/Vervis/Widget/Discussion.hs | 7 ++--- vervis.cabal | 1 + 7 files changed, 87 insertions(+), 16 deletions(-) create mode 100644 src/Vervis/Handler/Discussion.hs diff --git a/config/models b/config/models index 8bb331e..17cce1e 100644 --- a/config/models +++ b/config/models @@ -80,6 +80,7 @@ Ticket UniqueTicket project number Discussion + nextMessage Int Message author PersonId @@ -87,3 +88,6 @@ Message content Text -- Assume this is Pandoc Markdown parent MessageId Maybe root DiscussionId + number Int + + UniqueMessage root number diff --git a/config/routes b/config/routes index ec9bbfc..d448a3c 100644 --- a/config/routes +++ b/config/routes @@ -60,6 +60,8 @@ /u/#Text/p/#Text/t/!new TicketNewR GET /u/#Text/p/#Text/t/#Int TicketR GET PUT DELETE POST /u/#Text/p/#Text/t/#Int/edit TicketEditR GET +/u/#Text/p/#Text/t/#Int/d TicketDiscussionR GET +/u/#Text/p/#Text/t/#Int/d/#Int TicketCommentR GET -- /u/#Text/p/#Text/w WikiR GET -- /u/#Text/p/#Text/w/+Texts WikiPageR GET diff --git a/src/Vervis/Discussion.hs b/src/Vervis/Discussion.hs index 6e7c522..57947dc 100644 --- a/src/Vervis/Discussion.hs +++ b/src/Vervis/Discussion.hs @@ -14,7 +14,7 @@ -} module Vervis.Discussion - ( getDiscussion + ( getDiscussionTree ) where @@ -67,5 +67,5 @@ sortByTime = sortForestOn $ messageCreated . fst -- | Get the tree of messages in a given discussion, with siblings sorted from -- old to new. -getDiscussion :: DiscussionId -> Handler (Forest (Message, Sharer)) -getDiscussion did = sortByTime . discussionTree <$> getMessages did +getDiscussionTree :: DiscussionId -> Handler (Forest (Message, Sharer)) +getDiscussionTree did = sortByTime . discussionTree <$> getMessages did diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs new file mode 100644 index 0000000..ac53571 --- /dev/null +++ b/src/Vervis/Handler/Discussion.hs @@ -0,0 +1,46 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ 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 + - . + -} + +module Vervis.Handler.Discussion + ( getDiscussion + , getComment + ) +where + +import Prelude + +import Control.Monad.IO.Class (liftIO) +import Data.Time.Clock (getCurrentTime) +import Database.Persist (Entity (..)) +import Text.Blaze.Html (Html) +import Yesod.Core (defaultLayout) +import Yesod.Persist.Core (runDB, get404, getBy404) + +import Vervis.Foundation (Handler) +import Vervis.Model +import Vervis.Widget.Discussion + +getDiscussion :: DiscussionId -> Handler Html +getDiscussion did = defaultLayout $ discussionW did + +getComment :: DiscussionId -> Int -> Handler Html +getComment did num = do + (msg, shr) <- runDB $ do + Entity _mid m <- getBy404 $ UniqueMessage did num + p <- get404 $ messageAuthor m + s <- get404 $ personIdent p + return (m, s) + now <- liftIO getCurrentTime + defaultLayout $ messageW shr (messageCreated msg) now (messageContent msg) diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 7c6bd9e..12994f6 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -22,6 +22,8 @@ module Vervis.Handler.Ticket , deleteTicketR , postTicketR , getTicketEditR + , getTicketDiscussionR + , getTicketCommentR ) where @@ -39,7 +41,6 @@ import Text.Blaze.Html (Html, toHtml) import Yesod.Auth (requireAuthId) import Yesod.Core (defaultLayout) import Yesod.Core.Handler (setMessage, redirect, lookupPostParam, notFound) -import Yesod.Core.Widget (setTitle) import Yesod.Form.Functions (runFormPost) import Yesod.Form.Types (FormResult (..)) import Yesod.Persist.Core (runDB, get404, getBy404) @@ -49,6 +50,7 @@ import qualified Database.Esqueleto as E ((==.)) import Vervis.Form.Ticket import Vervis.Foundation +import Vervis.Handler.Discussion import Vervis.MediaType (MediaType (Markdown)) import Vervis.Model import Vervis.Render (renderSourceT) @@ -85,7 +87,10 @@ postTicketsR shar proj = do Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar getBy404 $ UniqueProject proj sid update pid [ProjectNextTicket +=. 1] - did <- insert Discussion + let discussion = Discussion + { discussionNextMessage = 1 + } + did <- insert discussion let ticket = Ticket { ticketProject = pid , ticketNumber = projectNextTicket project @@ -130,10 +135,7 @@ getTicketR shar proj num = do else return author return (author, closer, ticket) let desc = renderSourceT Markdown $ T.filter (/= '\r') $ ticketDesc ticket - defaultLayout $ do - setTitle $ toHtml $ T.intercalate " :: " - [shar, proj, "Tickets", T.pack ('#' : show num)] - $(widgetFile "ticket/one") + defaultLayout $(widgetFile "ticket/one") putTicketR :: Text -> Text -> Int -> Handler Html putTicketR shar proj num = do @@ -177,7 +179,22 @@ getTicketEditR shar proj num = do getBy404 $ UniqueTicket pid num user <- requireAuthId ((_result, widget), enctype) <- runFormPost $ editTicketForm ticket user - defaultLayout $ do - setTitle $ toHtml $ T.intercalate " :: " - [shar, proj, "Tickets", T.pack ('#' : show num), "Edit"] - $(widgetFile "ticket/edit") + defaultLayout $(widgetFile "ticket/edit") + +getTicketDiscussionR :: Text -> Text -> Int -> Handler Html +getTicketDiscussionR shar proj num = do + did <- runDB $ do + Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar + Entity pid _project <- getBy404 $ UniqueProject proj sid + Entity _tid ticket <- getBy404 $ UniqueTicket pid num + return $ ticketDiscuss ticket + getDiscussion did + +getTicketCommentR :: Text -> Text -> Int -> Int -> Handler Html +getTicketCommentR shar proj tnum cnum = do + did <- runDB $ do + Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar + Entity pid _project <- getBy404 $ UniqueProject proj sid + Entity _tid ticket <- getBy404 $ UniqueTicket pid tnum + return $ ticketDiscuss ticket + getComment did cnum diff --git a/src/Vervis/Widget/Discussion.hs b/src/Vervis/Widget/Discussion.hs index 50331ba..1d80d81 100644 --- a/src/Vervis/Widget/Discussion.hs +++ b/src/Vervis/Widget/Discussion.hs @@ -14,7 +14,8 @@ -} module Vervis.Widget.Discussion - ( discussionW + ( messageW + , discussionW ) where @@ -32,7 +33,7 @@ import Yesod.Core.Widget (whamlet, toWidget, handlerToWidget) import Data.EventTime.Local (intervalToEventTime, showEventTime) import Data.Time.Clock.Local () -import Vervis.Discussion (getDiscussion) +import Vervis.Discussion (getDiscussionTree) import Vervis.Foundation import Vervis.MediaType (MediaType (Markdown)) import Vervis.Model @@ -56,7 +57,7 @@ messageTreeW cReplies now t = go t discussionW :: DiscussionId -> Widget discussionW did = do - forest <- handlerToWidget $ getDiscussion did + forest <- handlerToWidget $ getDiscussionTree did cReplies <- newIdent now <- liftIO getCurrentTime toWidget $(cassiusFile "templates/discussion/widget/tree.cassius") diff --git a/vervis.cabal b/vervis.cabal index 352ea68..841a695 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -85,6 +85,7 @@ library Vervis.Git Vervis.GitOld Vervis.Handler.Common + Vervis.Handler.Discussion Vervis.Handler.Git Vervis.Handler.Home Vervis.Handler.Key