Per-ticket list of claim requests with full info

config/models

@@ -135,7 +135,7 @@ Ticket
 TicketClaimRequest
     person  PersonId
     ticket  TicketId
-    message Text
+    message Text     -- Assume this is Pandoc Markdown
     created UTCTime
 
     UniqueTicketClaimRequest person ticket

config/routes

@@ -50,7 +50,7 @@
 /k/!new                                      KeyNewR              GET
 /k/#KyIdent                                  KeyR                 GET DELETE POST
 
-/cr                                          ClaimRequestsR    GET
+/cr                                          ClaimRequestsPersonR GET
 
 /s/#ShrIdent/rr                              RepoRolesR           GET POST
 /s/#ShrIdent/rr/!new                         RepoRoleNewR         GET
@@ -102,7 +102,8 @@
 /s/#ShrIdent/p/#PrjIdent/t/#Int/unclaim      TicketUnclaimR        POST
 /s/#ShrIdent/p/#PrjIdent/t/#Int/assign       TicketAssignR         GET POST
 /s/#ShrIdent/p/#PrjIdent/t/#Int/unassign     TicketUnassignR       POST
-/s/#ShrIdent/p/#PrjIdent/tcr                 TicketClaimRequestsR GET
+/s/#ShrIdent/p/#PrjIdent/tcr                 ClaimRequestsProjectR GET
+/s/#ShrIdent/p/#PrjIdent/t/#Int/cr           ClaimRequestsTicketR  GET
 /s/#ShrIdent/p/#PrjIdent/t/#Int/d            TicketDiscussionR     GET POST
 /s/#ShrIdent/p/#PrjIdent/t/#Int/d/#Int       TicketMessageR        GET POST
 /s/#ShrIdent/p/#PrjIdent/t/#Int/d/!reply     TicketTopReplyR       GET

src/Vervis/Foundation.hs

@@ -130,7 +130,7 @@ instance Yesod App where
         (KeyR _key                 , _   ) -> personAny
         (KeyNewR                   , _   ) -> personAny
 
-        (ClaimRequestsR            , _   ) -> personAny
+        (ClaimRequestsPersonR      , _   ) -> personAny
 
         (RepoRolesR shr            , _   ) -> personOrGroupAdmin shr
         (RepoRoleNewR shr          , _   ) -> personOrGroupAdmin shr
@@ -368,7 +368,7 @@ instance YesodBreadcrumbs App where
         KeyNewR                          -> ("New", Just KeysR)
         KeyR key                         -> (ky2text key, Just KeysR)
 
-        ClaimRequestsR                   -> ( "Ticket Claim Requests"
+        ClaimRequestsPersonR             -> ( "Ticket Claim Requests"
                                             , Just HomeR
                                             )
 
@@ -454,9 +454,12 @@ instance YesodBreadcrumbs App where
                                             , Just $ TicketR shr prj num
                                             )
         TicketUnassignR _shr _prj _num   -> ("", Nothing)
-        TicketClaimRequestsR shr prj     -> ( "Ticket Claim Requests"
+        ClaimRequestsProjectR shr prj    -> ( "Ticket Claim Requests"
                                             , Just $ ProjectR shr prj
                                             )
+        ClaimRequestsTicketR shr prj num -> ( "Ticket Claim Requests"
+                                            , Just $ TicketR shr prj num
+                                            )
         TicketDiscussionR shar proj num  -> ( "Discussion"
                                             , Just $ TicketR shar proj num
                                             )

src/Vervis/Handler/Ticket.hs

@@ -29,8 +29,9 @@ module Vervis.Handler.Ticket
     , getTicketAssignR
     , postTicketAssignR
     , postTicketUnassignR
-    , getClaimRequestsR
+    , getClaimRequestsPersonR
-    , getTicketClaimRequestsR
+    , getClaimRequestsProjectR
+    , getClaimRequestsTicketR
     , getTicketDiscussionR
     , postTicketDiscussionR
     , getTicketMessageR
@@ -389,8 +390,8 @@ postTicketUnassignR shr prj num = do
 
 -- | The logged-in user gets a list of the ticket claim requests they have
 -- opened, in any project.
-getClaimRequestsR :: Handler Html
+getClaimRequestsPersonR :: Handler Html
-getClaimRequestsR = do
+getClaimRequestsPersonR = do
     pid <- requireAuthId
     rqs <- runDB $ select $ from $
         \ (tcr `InnerJoin` ticket `InnerJoin` project `InnerJoin` sharer) -> do
@@ -409,8 +410,8 @@ getClaimRequestsR = do
     defaultLayout $(widgetFile "person/claim-requests")
 
 -- | Get a list of ticket claim requests for a given project.
-getTicketClaimRequestsR :: ShrIdent -> PrjIdent -> Handler Html
+getClaimRequestsProjectR :: ShrIdent -> PrjIdent -> Handler Html
-getTicketClaimRequestsR shr prj = do
+getClaimRequestsProjectR shr prj = do
     rqs <- runDB $ do
         Entity sid _ <- getBy404 $ UniqueSharer shr
         Entity jid _ <- getBy404 $ UniqueProject prj sid
@@ -431,6 +432,21 @@ getTicketClaimRequestsR shr prj = do
                     , ticket ^. TicketTitle
                     , tcr ^. TicketClaimRequestCreated
                     )
+    defaultLayout $(widgetFile "project/claim-request/list")
+
+-- | Get a list of ticket claim requests for a given ticket.
+getClaimRequestsTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
+getClaimRequestsTicketR shr prj num = do
+    rqs <- runDB $ do
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        Entity jid _ <- getBy404 $ UniqueProject prj sid
+        Entity tid _ <- getBy404 $ UniqueTicket jid num
+        select $ from $ \ (tcr `InnerJoin` person `InnerJoin` sharer) -> do
+                on $ person ^. PersonIdent E.==. sharer ^. SharerId
+                on $ tcr ^. TicketClaimRequestPerson E.==. person ^. PersonId
+                where_ $ tcr ^. TicketClaimRequestTicket E.==. val tid
+                orderBy [desc $ tcr ^. TicketClaimRequestCreated]
+                return (sharer, tcr)
     defaultLayout $(widgetFile "ticket/claim-request/list")
 
 selectDiscussionId :: ShrIdent -> PrjIdent -> Int -> AppDB DiscussionId

templates/personal-overview.hamlet

@@ -44,4 +44,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 <h2>Ticket claim requests
 
 <p>
-  <a href=@{ClaimRequestsR}>Ticket claim requests
+  <a href=@{ClaimRequestsPersonR}>Ticket claim requests

templates/project/claim-request/list.hamlet

@@ -0,0 +1,30 @@
+$# 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/>.
+
+<table>
+  <tr>
+    <th>Opened on
+    <th>Opened by
+    <th># 
+    <th>Title
+  $forall (Entity _ sharer, Value num, Value title, Value time) <- rqs
+    <tr>
+      <td>
+        #{showDate time}
+      <td>
+        ^{personLinkW sharer}
+      <td>
+        <a href=@{TicketR shr prj num}>#{num}
+      <td>
+        <a href=@{TicketR shr prj num}>#{title}

templates/project/one.hamlet

@@ -27,7 +27,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   <li>
     <a href=@{TicketsR shar proj}>Tickets
   <li>
-    <a href=@{TicketClaimRequestsR shar proj}>Ticket claim requests
+    <a href=@{ClaimRequestsProjectR shar proj}>Ticket claim requests
 
 <h2>Collaborators
 

templates/ticket/claim-request/list.hamlet

@@ -16,15 +16,12 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   <tr>
     <th>Opened on
     <th>Opened by
-    <th># 
+    <th>Message
-    <th>Title
+  $forall (Entity _ sharer, Entity _ tcr) <- rqs
-  $forall (Entity _ sharer, Value num, Value title, Value time) <- rqs
     <tr>
       <td>
-        #{showDate time}
+        #{showDate $ ticketClaimRequestCreated tcr}
       <td>
         ^{personLinkW sharer}
       <td>
-        <a href=@{TicketR shr prj num}>#{num}
+        ^{renderSourceT Markdown $ ticketClaimRequestMessage tcr}
-      <td>
-        <a href=@{TicketR shr prj num}>#{title}

templates/ticket/one.hamlet

@@ -47,6 +47,9 @@ $if not $ ticketDone ticket
       <a href=@{TicketAssignR shar proj num}>Assign to someone else
       .
 
+<p>
+  <a href=@{ClaimRequestsTicketR shar proj num}>Claim requests
+
 <p>
   Status: #
   $if ticketDone ticket