diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs index d751976..324490c 100644 --- a/src/Vervis/Form/Ticket.hs +++ b/src/Vervis/Form/Ticket.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016, 2019, 2020 by fr33domlover . + - Written in 2016, 2019, 2020, 2022 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -14,12 +14,12 @@ -} module Vervis.Form.Ticket - ( NewTicket (..) - , newTicketForm - , editTicketContentForm - , assignTicketForm - , claimRequestForm - , ticketFilterForm + ( --NewTicket (..) + --, newTicketForm + --, editTicketContentForm + --, assignTicketForm + --, claimRequestForm + 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 diff --git a/src/Vervis/Handler/Deck.hs b/src/Vervis/Handler/Deck.hs index 81924e0..543979e 100644 --- a/src/Vervis/Handler/Deck.hs +++ b/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 - Entity jid _ <- getBy404 $ UniqueProject prj sid - let countAllTickets = count [TicketProjectLocalProject ==. jid] + _ <- get404 deckID + let countAllTickets = count [TicketDeckDeck ==. deckID] 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 diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs index 6d6e98f..073608a 100644 --- a/src/Vervis/Ticket.hs +++ b/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` tcl - `E.InnerJoin` tpl - `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s `E.LeftOuterJoin` tup) + `E.InnerJoin` td + `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` a) `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 $ tal E.?. TicketAuthorLocalId E.==. tup E.?. TicketUnderProjectAuthor - E.on $ p E.?. PersonIdent E.==. s E.?. SharerId + E.on $ E.just (t E.^. TicketId) E.==. tar E.?. TicketAuthorRemoteTicket + + 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 $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext - E.on $ t E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket - E.on $ t E.^. TicketId E.==. lt E.^. LocalTicketTicket - E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid + E.on $ E.just (t E.^. TicketId) E.==. tal E.?. TicketAuthorLocalTicket + + E.on $ t E.^. TicketId E.==. td E.^. TicketDeckTicket + + E.where_ $ td E.^. TicketDeckDeck E.==. E.val deckID E.groupBy - ( t E.^. TicketId, lt E.^. LocalTicketId - , tal E.?. TicketAuthorLocalId, s E.?. SharerId, tup E.?. TicketUnderProjectId + ( t E.^. TicketId + , 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 - , tal E.?. TicketAuthorLocalId - , s - , tup E.?. TicketUnderProjectId - , i - , ro - , ra + , td E.^. TicketDeckId + , p, a + , 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 - (Just talid, Just s, Nothing, Nothing, Nothing) -> - Left - ( entityVal s - , if isJust mtupid then Nothing else Just talid - ) + case (mp, ma, mi, mro, mra) of + (Just p, Just a, Nothing, Nothing, Nothing) -> + Left (p, entityVal a) (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. diff --git a/src/Vervis/Widget/Ticket.hs b/src/Vervis/Widget/Ticket.hs index d7f4b2c..62837fb 100644 --- a/src/Vervis/Widget/Ticket.hs +++ b/src/Vervis/Widget/Ticket.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016, 2019, 2020 by fr33domlover . + - Written in 2016, 2019, 2020, 2022 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -15,10 +15,10 @@ module Vervis.Widget.Ticket ( TicketSummary (..) - , ticketDepW + --, ticketDepW , ticketSummaryW - , ticketTreeVW - , ticketTreeDW + --, ticketTreeVW + --, 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 - , tsCreatedBy :: Either (Sharer, Maybe TicketAuthorLocalId) (Instance, RemoteObject, RemoteActor) + { tsId :: TicketDeckId + , 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 - -> PrjIdent + :: KeyHashid Deck -> TicketSummary -> Maybe (HashMap Int64 Int64) -> Widget -ticketSummaryW shr prj ts mcs = do - encodeLT <- getEncodeKeyHashid - encodeTAL <- getEncodeKeyHashid +ticketSummaryW deckHash ts mcs = do + hashTicket <- 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 = - case tsCreatedBy summary of - Left (s, Just talid) -> - SharerTicketR (sharerIdent s) (encodeTAL talid) - _ -> ProjectTicketR shr prj $ encodeLT $ tsId summary + ticketRoute' hashTicket summary = + TicketR deckHash (hashTicket $ 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") +-} diff --git a/templates/ticket/list.hamlet b/templates/ticket/list.hamlet index 2a129c8..5e13e7f 100644 --- a/templates/ticket/list.hamlet +++ b/templates/ticket/list.hamlet @@ -1,6 +1,6 @@ $# This file is part of Vervis. $# -$# Written in 2016, 2018 by fr33domlover . +$# Written in 2016, 2018, 2022 by fr33domlover . $# $# ♡ 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 $# . -

- Create new… +$#

+$# Create new… -

- View as tree… +$#

+$# View as tree… -

+ ^{filtWidget}
@@ -27,6 +27,6 @@ $# .
$forall ts <- rows - ^{ticketSummaryW shr prj ts Nothing} + ^{ticketSummaryW deckHash ts Nothing} ^{pageNav} diff --git a/templates/ticket/widget/summary.hamlet b/templates/ticket/widget/summary.hamlet index 7e2daea..43ef993 100644 --- a/templates/ticket/widget/summary.hamlet +++ b/templates/ticket/widget/summary.hamlet @@ -1,6 +1,6 @@ $# This file is part of Vervis. $# -$# Written in 2016, 2019, 2020 by fr33domlover . +$# Written in 2016, 2019, 2020, 2022 by fr33domlover . $# $# ♡ Copying is an act of love. Please copy, reuse and share. $# @@ -32,7 +32,7 @@ $# . #{showDate $ tsCreatedAt ts} - ^{sharerLinkFedW $ first fst $ tsCreatedBy ts} + ^{personLinkFedW $ tsCreatedBy ts} @@ -52,11 +52,11 @@ $# . $maybe params <- mparams - + ☝ $maybe route <- mroute ☚ $nothing - + diff --git a/vervis.cabal b/vervis.cabal index 5ee43c5..d1fa45a 100644 --- a/vervis.cabal +++ b/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