From 1e2b3d2006a14695e1288bc8f2c6933f7524d056 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sat, 17 Sep 2022 19:17:11 +0000 Subject: [PATCH] UI: HTML version for getLoomClothsR, copied from getDeckTicketsR --- src/Vervis/Handler/Loom.hs | 23 ++++---- src/Vervis/Ticket.hs | 75 ++++++++++++++++++++++++++ src/Vervis/Widget/Ticket.hs | 33 ++++++++++++ templates/cloth/list.cassius | 4 ++ templates/cloth/list.hamlet | 32 +++++++++++ templates/cloth/widget/summary.cassius | 57 ++++++++++++++++++++ templates/cloth/widget/summary.hamlet | 62 +++++++++++++++++++++ 7 files changed, 276 insertions(+), 10 deletions(-) create mode 100644 templates/cloth/list.cassius create mode 100644 templates/cloth/list.hamlet create mode 100644 templates/cloth/widget/summary.cassius create mode 100644 templates/cloth/widget/summary.hamlet diff --git a/src/Vervis/Handler/Loom.hs b/src/Vervis/Handler/Loom.hs index b16ca7b..c2a32ed 100644 --- a/src/Vervis/Handler/Loom.hs +++ b/src/Vervis/Handler/Loom.hs @@ -34,6 +34,7 @@ import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Data.Aeson import Data.ByteString (ByteString) +import Data.Default.Class import Data.Foldable import Data.Maybe import Data.Text (Text) @@ -44,7 +45,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) @@ -74,12 +75,16 @@ 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.Ticket import qualified Vervis.Client as C @@ -152,7 +157,6 @@ getLoomFollowersR = getActorFollowersCollection LoomFollowersR loomActor getLoomClothsR :: KeyHashid Loom -> Handler TypedContent getLoomClothsR loomHash = selectRep $ do - {- provideRep $ do ((filtResult, filtWidget), filtEnctype) <- runFormGet ticketFilterForm let tf = @@ -161,23 +165,22 @@ getLoomClothsR loomHash = selectRep $ do FormMissing -> def FormFailure l -> error $ "Ticket filter form failed: " ++ show l + loomID <- decodeKeyHashid404 loomHash (total, pages, mpage) <- runDB $ do - Entity sid _ <- getBy404 $ UniqueSharer shr - Entity jid _ <- getBy404 $ UniqueProject prj sid - let countAllTickets = count [TicketProjectLocalProject ==. jid] + _ <- get404 loomID + let countAllTickets = count [TicketLoomLoom ==. loomID] selectTickets off lim = - getTicketSummaries + getClothSummaries (filterTickets tf) - (Just $ \ t -> [E.asc $ t E.^. TicketId]) + (Just $ \ t -> [E.desc $ t E.^. TicketId]) (Just (off, lim)) - jid + loomID getPageAndNavCount countAllTickets selectTickets case mpage of Nothing -> redirectFirstPage here Just (rows, navModel) -> let pageNav = navWidget navModel - in defaultLayout $(widgetFile "ticket/list") - -} + in defaultLayout $(widgetFile "cloth/list") AP.provideAP' $ do loomID <- decodeKeyHashid404 loomHash (total, pages, mpage) <- runDB $ do diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs index 36eb8c6..89a5dee 100644 --- a/src/Vervis/Ticket.hs +++ b/src/Vervis/Ticket.hs @@ -17,6 +17,7 @@ module Vervis.Ticket ( getTicketSummaries + , getClothSummaries --, getTicketDepEdges , WorkflowFieldFilter (..) @@ -165,6 +166,80 @@ getTicketSummaries mfilt morder offlim deckID = do , tsComments = r } +getClothSummaries + :: Maybe (E.SqlExpr (Entity Ticket) -> E.SqlExpr (E.Value Bool)) + -> Maybe (E.SqlExpr (Entity Ticket) -> [E.SqlExpr E.OrderBy]) + -> Maybe (Int, Int) + -> LoomId + -> AppDB [ClothSummary] +getClothSummaries mfilt morder offlim loomID = do + tickets <- E.select $ E.from $ + \ ( t + `E.InnerJoin` tl + `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 $ 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 (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 (t E.^. TicketId) E.==. tal E.?. TicketAuthorLocalTicket + + E.on $ t E.^. TicketId E.==. tl E.^. TicketLoomTicket + + E.where_ $ tl E.^. TicketLoomLoom E.==. E.val loomID + E.groupBy + ( 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 + for_ morder $ \ order -> E.orderBy $ order t + for_ offlim $ \ (off, lim) -> do + E.offset $ fromIntegral off + E.limit $ fromIntegral lim + + return + ( t E.^. TicketId + , tl E.^. TicketLoomId + , 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 tlid, 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 ClothSummary + { csId = tlid + , csCreatedBy = + 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" + , csCreatedAt = c + , csTitle = t + , csLabels = map entityVal labels + , csStatus = d + , csComments = 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 62837fb..d75d1cd 100644 --- a/src/Vervis/Widget/Ticket.hs +++ b/src/Vervis/Widget/Ticket.hs @@ -15,8 +15,10 @@ module Vervis.Widget.Ticket ( TicketSummary (..) + , ClothSummary (..) --, ticketDepW , ticketSummaryW + , clothSummaryW --, ticketTreeVW --, ticketTreeDW ) @@ -63,6 +65,18 @@ data TicketSummary = TicketSummary , tsComments :: Int } +data ClothSummary = ClothSummary + { csId :: TicketLoomId + , csCreatedBy :: Either + (Entity Person, Actor) + (Instance, RemoteObject, RemoteActor) + , csCreatedAt :: UTCTime + , csTitle :: Text + , csLabels :: [WorkflowField] + , csStatus :: TicketStatus + , csComments :: Int + } + {- ticketDepW :: ShrIdent -> PrjIdent -> LocalTicketId -> Ticket -> Widget ticketDepW shr prj ltid ticket = do @@ -92,6 +106,25 @@ ticketSummaryW deckHash ts mcs = do ticketRoute' hashTicket summary = TicketR deckHash (hashTicket $ tsId summary) +clothSummaryW + :: KeyHashid Loom + -> ClothSummary + -> Maybe (HashMap Int64 Int64) + -> Widget +clothSummaryW loomHash cs mcs = do + hashTicket <- getEncodeKeyHashid + cNew <- newIdent + cTodo <- newIdent + cClosed <- newIdent + let tshow = T.pack . show + mparams = map (tshow *** tshow) . M.toList <$> mcs + ticketRoute = ticketRoute' hashTicket + mroute <- getCurrentRoute + $(widgetFile "cloth/widget/summary") + where + ticketRoute' hashTicket summary = + ClothR loomHash (hashTicket $ csId 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 diff --git a/templates/cloth/list.cassius b/templates/cloth/list.cassius new file mode 100644 index 0000000..9e11ff1 --- /dev/null +++ b/templates/cloth/list.cassius @@ -0,0 +1,4 @@ +.container + display: grid + grid-template-columns: 1rem 1rem 2fr 2fr 8fr 1rem 1rem + grid-column-gap: 1rem diff --git a/templates/cloth/list.hamlet b/templates/cloth/list.hamlet new file mode 100644 index 0000000..957835e --- /dev/null +++ b/templates/cloth/list.hamlet @@ -0,0 +1,32 @@ +$# This file is part of Vervis. +$# +$# Written in 2016, 2018, 2022 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 +$# . + +$#

+$# Create new… + +$#

+$# View as tree… + +

+ ^{filtWidget} +
+ + +^{pageNav} + +
+ $forall cs <- rows + ^{clothSummaryW loomHash cs Nothing} + +^{pageNav} diff --git a/templates/cloth/widget/summary.cassius b/templates/cloth/widget/summary.cassius new file mode 100644 index 0000000..5d63e55 --- /dev/null +++ b/templates/cloth/widget/summary.cassius @@ -0,0 +1,57 @@ +/* This file is part of Vervis. + * + * Written in 2016, 2020 by fr33domlover , + * 2019 by Jason Harrer . + * + * ♡ 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 + * . + */ + +.#{cNew} + color: #{dark yellow} + +.#{cTodo} + color: #{dark red} + +.#{cClosed} + color: #{dark green} + +.ticket-status-column + grid-column: 1 / 1 + +.ticket-number-column + grid-column: 2 / 2 + +.ticket-date-column + grid-column: 3 / 3 + +.ticket-sharer-column + grid-column: 4 / 4 + +.ticket-title-column + grid-column: 5 / 5 + +.ticket-tree-column + grid-column: 6 / 6 + +.ticket-node-column + grid-column: 7 / 7 + +.label1 + color: #{light red} + +.label2 + color: #{light green} + +.label3 + color: #{light yellow} + +.label4 + color: #{light blue} diff --git a/templates/cloth/widget/summary.hamlet b/templates/cloth/widget/summary.hamlet new file mode 100644 index 0000000..8b33269 --- /dev/null +++ b/templates/cloth/widget/summary.hamlet @@ -0,0 +1,62 @@ +$# This file is part of Vervis. +$# +$# Written in 2016, 2019, 2020, 2022 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 +$# . + + + $case csStatus cs + $of TSNew + + ⬚ + $of TSTodo + + ☐ + $of TSClosed + + ☒ + + + + ### + + + #{showDate $ csCreatedAt cs} + + + ^{personLinkFedW $ csCreatedBy cs} + + + + #{preEscapedToHtml $ csTitle cs} + $forall wf <- csLabels cs + $maybe wfcol <- workflowFieldColor wf + + [#{workflowFieldName wf}] + $nothing + + [#{workflowFieldName wf}] + + + $if csComments cs > 0 + 💬 + #{csComments cs} + +$maybe params <- mparams + + + ☝ + $maybe route <- mroute + + ☚ +$nothing + +