UI: Fix and re-enable deck ticket list view

src/Vervis/Form/Ticket.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -14,12 +14,12 @@
  -}
 
 module Vervis.Form.Ticket
-    ( NewTicket (..)
+    ( --NewTicket (..)
-    , newTicketForm
+    --, newTicketForm
-    , editTicketContentForm
+    --, editTicketContentForm
-    , assignTicketForm
+    --, assignTicketForm
-    , claimRequestForm
+    --, claimRequestForm
-    , ticketFilterForm
+      ticketFilterForm
     --, ticketDepForm
     )
 where
@@ -39,7 +39,6 @@ import Yesod.Persist.Core (runDB)
 
 import qualified Data.Text as T
 
-import Vervis.Field.Ticket
 import Vervis.Foundation (App, Form, Handler)
 import Vervis.Model
 import Vervis.Model.Ticket
@@ -49,6 +48,7 @@ import Vervis.TicketFilter (TicketFilter (..))
 
 --TODO use custom fields to ensure uniqueness or other constraints?
 
+{-
 data NewTicket = NewTicket
     { ntTitle   :: Text
     , ntDesc    :: Text
@@ -137,7 +137,9 @@ newTicketForm wid html = do
         <*> (fmap catMaybes $ sequenceA $ mapMaybe efield efs)
         <*> (catMaybes <$> traverse cfield cfs)
         <*> areq checkBoxField "Offer" Nothing
+-}
 
+{-
 editTicketContentAForm :: Ticket -> AForm Handler Ticket
 editTicketContentAForm ticket = Ticket
     <$> pure (ticketNumber ticket)
@@ -240,19 +242,24 @@ editTicketContentForm tid t wid html = do
             <*> traverse tEditField tfs
             <*> traverse eEditField efs
             <*> traverse cEditField cfs
+-}
 
+{-
 assignTicketAForm :: PersonId -> ProjectId -> AForm Handler PersonId
 assignTicketAForm pid jid =
     areq (selectAssigneeFromProject pid jid) "Assignee*" Nothing
 
 assignTicketForm :: PersonId -> ProjectId -> Form PersonId
 assignTicketForm pid jid = renderDivs $ assignTicketAForm pid jid
+-}
 
+{-
 claimRequestAForm :: AForm Handler Text
 claimRequestAForm = unTextarea <$> areq textareaField "Message*" Nothing
 
 claimRequestForm :: Form Text
 claimRequestForm = renderDivs claimRequestAForm
+-}
 
 ticketFilterAForm :: AForm Handler TicketFilter
 ticketFilterAForm = mk

src/Vervis/Handler/Deck.hs

@@ -57,6 +57,7 @@ import Control.Monad
 import Control.Monad.Trans.Except
 import Data.Aeson
 import Data.ByteString (ByteString)
+import Data.Default.Class
 import Data.Foldable
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
@@ -67,7 +68,7 @@ import Text.Blaze.Html (Html)
 import Yesod.Auth (requireAuth)
 import Yesod.Core
 import Yesod.Core.Handler (redirect, setMessage, lookupPostParam, notFound)
-import Yesod.Form.Functions (runFormPost)
+import Yesod.Form.Functions (runFormPost, runFormGet)
 import Yesod.Form.Types (FormResult (..))
 import Yesod.Persist.Core (runDB, get404, getBy404)
 
@@ -98,13 +99,17 @@ import Vervis.Federation.Auth
 import Vervis.Federation.Collab
 import Vervis.FedURI
 import Vervis.Form.Project
+import Vervis.Form.Ticket
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Paginate
 import Vervis.Recipient
 import Vervis.Settings
+import Vervis.Ticket
+import Vervis.TicketFilter
 import Vervis.Web.Actor
 import Vervis.Widget.Person
+import Vervis.Widget.Ticket
 
 import qualified Vervis.Client as C
 
@@ -209,7 +214,6 @@ getDeckFollowersR = getActorFollowersCollection DeckFollowersR deckActor
 
 getDeckTicketsR :: KeyHashid Deck -> Handler TypedContent
 getDeckTicketsR deckHash = selectRep $ do
-    {-
     provideRep $ do
         ((filtResult, filtWidget), filtEnctype) <- runFormGet ticketFilterForm
         let tf =
@@ -218,26 +222,26 @@ getDeckTicketsR deckHash = selectRep $ do
                     FormMissing      -> def
                     FormFailure l    ->
                         error $ "Ticket filter form failed: " ++ show l
+        deckID <- decodeKeyHashid404 deckHash
         (total, pages, mpage) <- runDB $ do
-            Entity sid _ <- getBy404 $ UniqueSharer shr
+            _ <- get404 deckID
-            Entity jid _ <- getBy404 $ UniqueProject prj sid
+            let countAllTickets = count [TicketDeckDeck ==. deckID]
-            let countAllTickets = count [TicketProjectLocalProject ==. jid]
                 selectTickets off lim =
                     getTicketSummaries
                         (filterTickets tf)
-                        (Just $ \ t -> [E.asc $ t E.^. TicketId])
+                        (Just $ \ t -> [E.desc $ t E.^. TicketId])
                         (Just (off, lim))
-                        jid
+                        deckID
             getPageAndNavCount countAllTickets selectTickets
         case mpage of
             Nothing -> redirectFirstPage here
             Just (rows, navModel) ->
                 let pageNav = navWidget navModel
                 in  defaultLayout $(widgetFile "ticket/list")
-    -}
     provideAP' $ do
         deckID <- decodeKeyHashid404 deckHash
         (total, pages, mpage) <- runDB $ do
+            _ <- get404 deckID
             let countAllTickets = count [TicketDeckDeck ==. deckID]
                 selectTickets off lim =
                     selectKeysList

src/Vervis/Ticket.hs

@@ -16,9 +16,9 @@
 
 module Vervis.Ticket
     (
-    {-
       getTicketSummaries
     --, getTicketDepEdges
+    {-
     , WorkflowFieldFilter (..)
     , WorkflowFieldSummary (..)
     , TicketTextParamValue (..)
@@ -32,7 +32,7 @@ module Vervis.Ticket
     , getTicketClasses
     -}
 
-      getTicket
+    , getTicket
     , getTicket404
 
     --, getDependencyCollection
@@ -88,43 +88,42 @@ import Vervis.Model.Ident
 import Vervis.Model.Workflow
 import Vervis.Paginate
 import Vervis.Recipient
+import Vervis.Widget.Ticket
 
-{-
 -- | Get summaries of all the tickets in the given project.
 getTicketSummaries
     :: Maybe (E.SqlExpr (Entity Ticket) -> E.SqlExpr (E.Value Bool))
     -> Maybe (E.SqlExpr (Entity Ticket) -> [E.SqlExpr E.OrderBy])
     -> Maybe (Int, Int)
-    -> ProjectId
+    -> DeckId
     -> AppDB [TicketSummary]
-getTicketSummaries mfilt morder offlim jid = do
+getTicketSummaries mfilt morder offlim deckID = do
     tickets <- E.select $ E.from $
         \ ( t
-            `E.InnerJoin` lt
+            `E.InnerJoin` td
-            `E.InnerJoin` tcl
+            `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` a)
-            `E.InnerJoin` tpl
-            `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s `E.LeftOuterJoin` tup)
             `E.LeftOuterJoin` (tar `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i)
             `E.InnerJoin` d
             `E.LeftOuterJoin` m
           ) -> do
             E.on $ E.just (d E.^. DiscussionId) E.==. m E.?. MessageRoot
-            E.on $ lt E.^. LocalTicketDiscuss E.==. d E.^. DiscussionId
+            E.on $ t E.^. TicketDiscuss E.==. d E.^. DiscussionId
+
             E.on $ ro E.?. RemoteObjectInstance E.==. i E.?. InstanceId
             E.on $ ra E.?. RemoteActorIdent E.==. ro E.?. RemoteObjectId
             E.on $ tar E.?. TicketAuthorRemoteAuthor E.==. ra E.?. RemoteActorId
-            E.on $ E.just (tcl E.^. TicketContextLocalId) E.==. tar E.?. TicketAuthorRemoteTicket
+            E.on $ E.just (t E.^. TicketId) E.==. tar E.?. TicketAuthorRemoteTicket
-            E.on $ tal E.?. TicketAuthorLocalId E.==. tup E.?. TicketUnderProjectAuthor
+
-            E.on $ p E.?. PersonIdent E.==. s E.?. SharerId
+            E.on $ p E.?. PersonActor E.==. a E.?. ActorId
             E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId
-            E.on $ E.just (lt E.^. LocalTicketId) E.==. tal E.?. TicketAuthorLocalTicket
+            E.on $ E.just (t E.^. TicketId) E.==. tal E.?. TicketAuthorLocalTicket
-            E.on $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext
+
-            E.on $ t E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket
+            E.on $ t E.^. TicketId E.==. td E.^. TicketDeckTicket
-            E.on $ t E.^. TicketId E.==. lt E.^. LocalTicketTicket
+
-            E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid
+            E.where_ $ td E.^. TicketDeckDeck E.==. E.val deckID
             E.groupBy
-                ( t E.^. TicketId, lt E.^. LocalTicketId
+                ( t E.^. TicketId
-                , tal E.?. TicketAuthorLocalId, s E.?. SharerId, tup E.?. TicketUnderProjectId
+                , tal E.?. TicketAuthorLocalId, p E.?. PersonId, a E.?. ActorId
                 , ra E.?. RemoteActorId, ro E.?. RemoteObjectId, i E.?. InstanceId
                 )
             for_ mfilt $ \ filt -> E.where_ $ filt t
@@ -132,35 +131,30 @@ getTicketSummaries mfilt morder offlim jid = do
             for_ offlim $ \ (off, lim) -> do
                 E.offset $ fromIntegral off
                 E.limit $ fromIntegral lim
+
             return
                 ( t E.^. TicketId
-                , lt E.^. LocalTicketId
+                , td E.^. TicketDeckId
-                , tal E.?. TicketAuthorLocalId
+                , p, a
-                , s
+                , i, ro, ra
-                , tup E.?. TicketUnderProjectId
-                , i
-                , ro
-                , ra
                 , t E.^. TicketCreated
                 , t E.^. TicketTitle
                 , t E.^. TicketStatus
                 , E.count $ m E.?. MessageId
                 )
+
     for tickets $
-        \ (E.Value tid, E.Value ltid, E.Value mtalid, ms, E.Value mtupid, mi, mro, mra, E.Value c, E.Value t, E.Value d, E.Value r) -> do
+        \ (E.Value tid, E.Value tdid, mp, ma, mi, mro, mra, E.Value c, E.Value t, E.Value d, E.Value r) -> do
             labels <- E.select $ E.from $ \ (tpc `E.InnerJoin` wf) -> do
                 E.on $ tpc E.^. TicketParamClassField E.==. wf E.^. WorkflowFieldId
                 E.where_ $ tpc E.^. TicketParamClassTicket E.==. E.val tid
                 return wf
             return TicketSummary
-                { tsId        = ltid
+                { tsId        = tdid
                 , tsCreatedBy =
-                    case (mtalid, ms, mi, mro, mra) of
+                    case (mp, ma, mi, mro, mra) of
-                        (Just talid, Just s, Nothing, Nothing, Nothing) ->
+                        (Just p, Just a, Nothing, Nothing, Nothing) ->
-                            Left
+                            Left (p, entityVal a)
-                                ( entityVal s
-                                , if isJust mtupid then Nothing else Just talid
-                                )
                         (Nothing, Nothing, Just i, Just ro, Just ra) ->
                             Right (entityVal i, entityVal ro, entityVal ra)
                         _ -> error "Ticket author DB invalid state"
@@ -171,6 +165,7 @@ getTicketSummaries mfilt morder offlim jid = do
                 , tsComments  = r
                 }
 
+{-
 -- | Get the child-parent ticket number pairs of all the ticket dependencies
 -- in the given project, in ascending order by child, and then ascending order
 -- by parent.

src/Vervis/Widget/Ticket.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -15,10 +15,10 @@
 
 module Vervis.Widget.Ticket
     ( TicketSummary (..)
-    , ticketDepW
+    --, ticketDepW
     , ticketSummaryW
-    , ticketTreeVW
+    --, ticketTreeVW
-    , ticketTreeDW
+    --, ticketTreeDW
     )
 where
 
@@ -45,16 +45,17 @@ import Yesod.Hashids
 
 import Vervis.Foundation
 import Vervis.Model
-import Vervis.Model.Ident
 import Vervis.Model.Ticket
 import Vervis.Settings (widgetFile)
 import Vervis.Style
 import Vervis.Time (showDate)
-import Vervis.Widget.Sharer
+import Vervis.Widget.Person
 
 data TicketSummary = TicketSummary
-    { tsId        :: LocalTicketId
+    { tsId        :: TicketDeckId
-    , tsCreatedBy :: Either (Sharer, Maybe TicketAuthorLocalId) (Instance, RemoteObject, RemoteActor)
+    , tsCreatedBy :: Either
+                        (Entity Person, Actor)
+                        (Instance, RemoteObject, RemoteActor)
     , tsCreatedAt :: UTCTime
     , tsTitle     :: Text
     , tsLabels    :: [WorkflowField]
@@ -62,6 +63,7 @@ data TicketSummary = TicketSummary
     , tsComments  :: Int
     }
 
+{-
 ticketDepW :: ShrIdent -> PrjIdent -> LocalTicketId -> Ticket -> Widget
 ticketDepW shr prj ltid ticket = do
     encodeTicketKey <- getEncodeKeyHashid
@@ -69,31 +71,28 @@ ticketDepW shr prj ltid ticket = do
     cTodo <- newIdent
     cClosed <- newIdent
     $(widgetFile "ticket/widget/dep")
+-}
 
 ticketSummaryW
-    :: ShrIdent
+    :: KeyHashid Deck
-    -> PrjIdent
     -> TicketSummary
     -> Maybe (HashMap Int64 Int64)
     -> Widget
-ticketSummaryW shr prj ts mcs = do
+ticketSummaryW deckHash ts mcs = do
-    encodeLT <- getEncodeKeyHashid
+    hashTicket <- getEncodeKeyHashid
-    encodeTAL <- getEncodeKeyHashid
     cNew <- newIdent
     cTodo <- newIdent
     cClosed <- newIdent
     let tshow = T.pack . show
         mparams = map (tshow *** tshow) . M.toList <$> mcs
-        ticketRoute = ticketRoute' encodeLT encodeTAL
+        ticketRoute = ticketRoute' hashTicket
     mroute <- getCurrentRoute
     $(widgetFile "ticket/widget/summary")
     where
-    ticketRoute' encodeLT encodeTAL summary =
+    ticketRoute' hashTicket summary =
-        case tsCreatedBy summary of
+        TicketR deckHash (hashTicket $ tsId summary)
-            Left (s, Just talid) ->
-                SharerTicketR (sharerIdent s) (encodeTAL talid)
-            _ -> ProjectTicketR shr prj $ encodeLT $ tsId summary
 
+{-
 -- I'm noticing a pattern. A problem. Some of my widget functions take data and
 -- directly represent it in HTML. Others take some other more general
 -- structures, then pick the relevant pieces and generate HTML. Others involve
@@ -121,7 +120,9 @@ ticketTreeVW shr prj cDeps t = go t
                 ^{go tree}
         |]
     go (LinkNode (ts, cs)) = summary ts (Just cs)
+-}
 
+{-
 -- | In the request's GET parameters, find ones of the form @N=M@ where N and M
 -- are integers. Return a list of pairs corresponding to those parameters.
 getParentChoices :: MonadHandler m => m [(Int64, Int64)]
@@ -144,3 +145,4 @@ ticketTreeDW shr prj summaries deps = do
         oneTree = ticketTreeVW shr prj cDeps
         forest = map oneTree $ dagViewTree nodes deps choices
     $(widgetFile "ticket/widget/tree")
+-}

templates/ticket/list.hamlet

@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2018, 2022 by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -12,13 +12,13 @@ $# 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/>.
 
-<p>
+$# <p>
-  <a href=@{ProjectTicketNewR shr prj}>Create new…
+$#   <a href=@{ProjectTicketNewR shr prj}>Create new…
 
-<p>
+$# <p>
-  <a href=@{ProjectTicketTreeR shr prj}>View as tree…
+$#   <a href=@{ProjectTicketTreeR shr prj}>View as tree…
 
-<form method=GET action=@{ProjectTicketsR shr prj} enctype=#{filtEnctype}>
+<form method=GET action=@{DeckTicketsR deckHash} enctype=#{filtEnctype}>
   ^{filtWidget}
   <div class="submit">
     <input type="submit" value="Filter">
@@ -27,6 +27,6 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 <div .container>
   $forall ts <- rows
-    ^{ticketSummaryW shr prj ts Nothing}
+    ^{ticketSummaryW deckHash ts Nothing}
 
 ^{pageNav}

templates/ticket/widget/summary.hamlet

@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -32,7 +32,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   #{showDate $ tsCreatedAt ts}
 
 <span .ticket-sharer-column>
-  ^{sharerLinkFedW $ first fst $ tsCreatedBy ts}
+  ^{personLinkFedW $ tsCreatedBy ts}
 
 <span .ticket-title-column>
   <a href=@{ticketRoute ts}>
@@ -52,11 +52,11 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 $maybe params <- mparams
   <span .ticket-node-column>
-    <a href="#node-#{keyHashidText $ encodeLT $ tsId ts}" title="Jump to subtree">
+    <a href="#node-#{keyHashidText $ hashTicket $ tsId ts}" title="Jump to subtree">
       ☝
     $maybe route <- mroute
       <a href=@?{(route, params)} title="Move subtree here">
         ☚
 $nothing
   <span .ticket-node-column>
-    <a id="node-#{keyHashidText $ encodeLT $ tsId ts}">
+    <a id="node-#{keyHashidText $ hashTicket $ tsId ts}">

vervis.cabal

@@ -166,7 +166,7 @@ library
                        Vervis.Form.Project
                        Vervis.Form.Repo
                        --Vervis.Form.Role
-                       --Vervis.Form.Ticket
+                       Vervis.Form.Ticket
                        -- Vervis.Form.Workflow
                        Vervis.Formatting
                        Vervis.Foundation
@@ -236,7 +236,7 @@ library
                        --Vervis.Widget.Project
                        Vervis.Widget.Repo
                        --Vervis.Widget.Role
-                       --Vervis.Widget.Ticket
+                       Vervis.Widget.Ticket
                        -- Vervis.Widget.Workflow
                        -- Vervis.Wiki
                        Vervis.WorkItem