Ticket discussion and message routes

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

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

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

src/Vervis/Handler/Discussion.hs

@@ -0,0 +1,46 @@
+{- 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/>.
+ -}
+
+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)

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

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")

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