diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs index 8296c47..9d3c6bd 100644 --- a/src/Vervis/Handler/Person.hs +++ b/src/Vervis/Handler/Person.hs @@ -27,6 +27,8 @@ module Vervis.Handler.Person , postPersonFollowR , postPersonUnfollowR + + , postReplyR ) where @@ -417,3 +419,6 @@ postPersonFollowR _ = error "Temporarily disabled" postPersonUnfollowR :: KeyHashid Person -> Handler () postPersonUnfollowR _ = error "Temporarily disabled" + +postReplyR :: KeyHashid Message -> Handler () +postReplyR _ = error "Temporarily disabled" diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 7161fff..e02d510 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -24,6 +24,10 @@ module Vervis.Handler.Ticket , getTicketDepR + , postTicketFollowR + , postTicketUnfollowR + , postTicketReplyR + @@ -99,6 +103,7 @@ import Text.HTML.SanitizeXSS import Yesod.Auth (requireAuthId, maybeAuthId) import Yesod.Core hiding (logWarn) import Yesod.Core.Handler +import Yesod.Core.Widget import Yesod.Form.Functions (runFormGet, runFormPost) import Yesod.Form.Types (FormResult (..)) import Yesod.Persist.Core (runDB, get404, getBy404) @@ -136,7 +141,6 @@ import Vervis.Data.Actor import Vervis.Discussion import Vervis.FedURI import Vervis.Foundation -import Vervis.Handler.Discussion --import Vervis.GraphProxy (ticketDepGraph) import Vervis.Model import Vervis.Model.Ident @@ -151,6 +155,9 @@ import Vervis.Ticket import Vervis.TicketFilter (filterTickets) import Vervis.Time (showDate) import Vervis.Web.Actor +import Vervis.Web.Discussion +import Vervis.Widget.Discussion +import Vervis.Widget.Person getTicketR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent getTicketR deckHash ticketHash = do @@ -237,47 +244,51 @@ getTicketR deckHash ticketHash = do , AP.ticketAttachment = Nothing } - provideHtmlAndAP' authorHost ticketAP $ redirectToPrettyJSON here + provideHtmlAndAP' authorHost ticketAP getTicketHtml where - here = TicketR deckHash ticketHash - - {- - mpid <- maybeAuthId - ( wshr, wfl, - author, massignee, mresolved, ticket, lticket, tparams, eparams, cparams) <- - runDB $ do - (Entity sid sharer, Entity jid project, Entity tid ticket, Entity _ lticket, _etcl, _etpl, author, resolved) <- getProjectTicket404 shar proj ltkhid - tparams <- getTicketTextParams tid wid - eparams <- getTicketEnumParams tid wid - cparams <- getTicketClasses tid wid - return - ( wshr, wfl - , author', massignee, mresolved, ticket, lticket - , tparams, eparams, cparams - ) - let desc :: Widget - desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket - discuss = - discussionW - (return $ localTicketDiscuss lticket) - (ProjectTicketTopReplyR shar proj ltkhid) - (ProjectTicketReplyR shar proj ltkhid . encodeHid) - cRelevant <- newIdent - cIrrelevant <- newIdent - let relevant filt = - bool cIrrelevant cRelevant $ - case ticketStatus ticket of - TSNew -> wffNew filt - TSTodo -> wffTodo filt - TSClosed -> wffClosed filt - provideHtmlAndAP' host ticketAP $ + getTicketHtml = do + mpid <- maybeAuthId + (ticket, author, tparams, eparams, cparams) <- handlerToWidget $ runDB $ do + (_deck, _ticketdeck, Entity ticketID ticket, author, _maybe_ResolveAndEitherTrlOrTrr) <- + getTicket404 deckHash ticketHash + (ticket,,,,) + <$> bitraverse + (\ (Entity _ (TicketAuthorLocal _ personID _)) -> do + p <- getJust personID + (Entity personID p,) <$> getJust (personActor p) + ) + (\ (Entity _ (TicketAuthorRemote _ remoteActorID _)) -> do + ra <- getJust remoteActorID + ro <- getJust $ remoteActorIdent ra + i <- getJust $ remoteObjectInstance ro + return (i, ro, ra) + ) + author + <*> getTicketTextParams ticketID --wid + <*> getTicketEnumParams ticketID --wid + <*> getTicketClasses ticketID --wid + hashMessageKey <- handlerToWidget getEncodeKeyHashid + let desc :: Widget + desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket + discuss = + discussionW + (return $ ticketDiscuss ticket) + (TicketReplyR deckHash ticketHash) + (ReplyR . hashMessageKey) + cRelevant <- newIdent + cIrrelevant <- newIdent + let relevant filt = + bool cIrrelevant cRelevant $ + case ticketStatus ticket of + TSNew -> wffNew filt + TSTodo -> wffTodo filt + TSClosed -> wffClosed filt let followButton = followW - (ProjectTicketFollowR shar proj ltkhid) - (ProjectTicketUnfollowR shar proj ltkhid) - (return $ localTicketFollowers lticket) - in $(widgetFile "ticket/one") - -} + (TicketFollowR deckHash ticketHash) + (TicketUnfollowR deckHash ticketHash) + (ticketFollowers ticket) + $(widgetFile "ticket/one") getTicketDiscussionR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent @@ -408,6 +419,29 @@ getTicketDepR _ _ _ = do tdc -} +postTicketFollowR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler () +postTicketFollowR _ = error "Temporarily disabled" + +postTicketUnfollowR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler () +postTicketUnfollowR _ = error "Temporarily disabled" + +postTicketReplyR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler Html +postTicketReplyR _ _ = error "Temporarily disabled" + {- + hLocal <- getsYesod $ appInstanceHost . appSettings + postTopReply + hLocal + [ProjectR shr prj] + [ ProjectFollowersR shr prj + , ProjectTicketParticipantsR shr prj ltkhid + , ProjectTicketTeamR shr prj ltkhid + ] + (ProjectTicketR shr prj ltkhid) + (ProjectR shr prj) + (ProjectTicketDiscussionR shr prj ltkhid) + (const $ ProjectTicketR shr prj ltkhid) + -} + @@ -774,22 +808,6 @@ selectDiscussionId shr prj ltkhid = do (_es, _ej, _et, Entity _ lticket, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid return $ localTicketDiscuss lticket -postProjectTicketDiscussionR - :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html -postProjectTicketDiscussionR shr prj ltkhid = do - hLocal <- getsYesod $ appInstanceHost . appSettings - postTopReply - hLocal - [ProjectR shr prj] - [ ProjectFollowersR shr prj - , ProjectTicketParticipantsR shr prj ltkhid - , ProjectTicketTeamR shr prj ltkhid - ] - (ProjectTicketR shr prj ltkhid) - (ProjectR shr prj) - (ProjectTicketDiscussionR shr prj ltkhid) - (const $ ProjectTicketR shr prj ltkhid) - getMessageR :: ShrIdent -> KeyHashid LocalMessage -> Handler TypedContent getMessageR shr hid = do lmid <- decodeKeyHashid404 hid diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs index 073608a..36eb8c6 100644 --- a/src/Vervis/Ticket.hs +++ b/src/Vervis/Ticket.hs @@ -18,7 +18,7 @@ module Vervis.Ticket ( getTicketSummaries --, getTicketDepEdges - {- + , WorkflowFieldFilter (..) , WorkflowFieldSummary (..) , TicketTextParamValue (..) @@ -30,7 +30,7 @@ module Vervis.Ticket , getTicketEnumParams , TicketClassParam (..) , getTicketClasses - -} + , getTicket , getTicket404 @@ -165,7 +165,6 @@ getTicketSummaries mfilt morder offlim deckID = 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. @@ -265,14 +264,14 @@ toTParam _ -> error "Impossible" } -getTicketTextParams :: TicketId -> WorkflowId -> AppDB [TicketTextParam] -getTicketTextParams tid wid = fmap (map toTParam) $ +getTicketTextParams :: TicketId {--> WorkflowId-} -> AppDB [TicketTextParam] +getTicketTextParams tid {-wid-} = fmap (map toTParam) $ E.select $ E.from $ \ (p `E.RightOuterJoin` f) -> do E.on $ p E.?. TicketParamTextField E.==. E.just (f E.^. WorkflowFieldId) E.&&. p E.?. TicketParamTextTicket E.==. E.just (E.val tid) E.where_ $ - f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&. + --f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&. f E.^. WorkflowFieldType E.==. E.val WFTText E.&&. E.isNothing (f E.^. WorkflowFieldEnm) return @@ -365,14 +364,14 @@ toEParam _ -> error "Impossible" } -getTicketEnumParams :: TicketId -> WorkflowId -> AppDB [TicketEnumParam] -getTicketEnumParams tid wid = fmap (map toEParam) $ +getTicketEnumParams :: TicketId {--> WorkflowId-} -> AppDB [TicketEnumParam] +getTicketEnumParams tid {-wid-} = fmap (map toEParam) $ E.select $ E.from $ \ (p `E.InnerJoin` c `E.RightOuterJoin` f `E.InnerJoin` e) -> do E.on $ - e E.^. WorkflowEnumWorkflow E.==. E.val wid E.&&. + --e E.^. WorkflowEnumWorkflow E.==. E.val wid E.&&. f E.^. WorkflowFieldEnm E.==. E.just (e E.^. WorkflowEnumId) E.on $ - f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&. + --f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&. f E.^. WorkflowFieldType E.==. E.val WFTEnum E.&&. p E.?. TicketParamEnumField E.==. E.just (f E.^. WorkflowFieldId) E.&&. c E.?. WorkflowEnumCtorEnum E.==. f E.^. WorkflowFieldEnm @@ -438,14 +437,14 @@ toCParam , tcpValue = mp } -getTicketClasses :: TicketId -> WorkflowId -> AppDB [TicketClassParam] -getTicketClasses tid wid = fmap (map toCParam) $ +getTicketClasses :: TicketId {--> WorkflowId-} -> AppDB [TicketClassParam] +getTicketClasses tid {-wid-} = fmap (map toCParam) $ E.select $ E.from $ \ (p `E.RightOuterJoin` f) -> do E.on $ p E.?. TicketParamClassField E.==. E.just (f E.^. WorkflowFieldId) E.&&. p E.?. TicketParamClassTicket E.==. E.just (E.val tid) E.where_ $ - f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&. + --f E.^. WorkflowFieldWorkflow E.==. E.val wid E.&&. f E.^. WorkflowFieldType E.==. E.val WFTClass E.&&. E.isNothing (f E.^. WorkflowFieldEnm) return @@ -459,7 +458,6 @@ getTicketClasses tid wid = fmap (map toCParam) $ , f E.^. WorkflowFieldFilterClosed , p E.?. TicketParamClassId ) --} getTicket :: MonadIO m diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Web/Discussion.hs similarity index 99% rename from src/Vervis/Handler/Discussion.hs rename to src/Vervis/Web/Discussion.hs index 71d176b..e18848f 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Web/Discussion.hs @@ -13,7 +13,7 @@ - . -} -module Vervis.Handler.Discussion +module Vervis.Web.Discussion ( getDiscussion --, getTopReply --, postTopReply diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet index 3ec8786..9ebecff 100644 --- a/templates/ticket/one.hamlet +++ b/templates/ticket/one.hamlet @@ -1,6 +1,7 @@ $# This file is part of Vervis. $# -$# Written in 2016, 2018, 2019, 2020 by fr33domlover . +$# Written in 2016, 2018, 2019, 2020, 2022 +$# by fr33domlover . $# $# ♡ Copying is an act of love. Please copy, reuse and share. $# @@ -16,53 +17,51 @@ $# .
Created on #{showDate $ ticketCreated ticket} by - ^{sharerLinkFedW author} + ^{personLinkFedW author}
- + [🐤 Followers] - + [⤴ Dependencies] - + [⤷ Dependants] - [✋ Claim requests] - [✏ Edit] ^{followButton}
^{desc} -$if ticketStatus ticket /= TSClosed -

- $maybe (assignee, me) <- massignee - $if me - Assigned to you. - - ^{buttonW POST "Unclaim this ticket" (ProjectTicketUnclaimR shar proj ltkhid)} - $else - Assigned to ^{sharerLinkW assignee}. - - ^{buttonW POST "Unassign this ticket" (ProjectTicketUnassignR shar proj ltkhid)} - $nothing - Not assigned. - - Ask to have it assigned to you - - or - - ^{buttonW POST "Claim this ticket" (ProjectTicketClaimR shar proj ltkhid)} - - or - - Assign to someone else - . +$# $if ticketStatus ticket /= TSClosed +$#

+$# $maybe (assignee, me) <- massignee +$# $if me +$# Assigned to you. +$# +$# ^{buttonW POST "Unclaim this ticket" (ProjectTicketUnclaimR deckHash ticketHash)} +$# $else +$# Assigned to ^{sharerLinkW assignee}. +$# +$# ^{buttonW POST "Unassign this ticket" (ProjectTicketUnassignR deckHash ticketHash)} +$# $nothing +$# Not assigned. +$# +$# Ask to have it assigned to you +$# +$# or +$# +$# ^{buttonW POST "Claim this ticket" (ProjectTicketClaimR deckHash ticketHash)} +$# +$# or +$# +$# Assign to someone else +$# .

Status: # @@ -70,16 +69,16 @@ $if ticketStatus ticket /= TSClosed $of TSNew Open, new. - ^{buttonW POST "Accept this ticket" (ProjectTicketAcceptR shar proj ltkhid)} - ^{buttonW POST "Close this ticket" (ProjectTicketCloseR shar proj ltkhid)} +$# ^{buttonW POST "Accept this ticket" (ProjectTicketAcceptR deckHash ticketHash)} +$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR deckHash ticketHash)} $of TSTodo Open, to do. - ^{buttonW POST "Close this ticket" (ProjectTicketCloseR shar proj ltkhid)} +$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR deckHash ticketHash)} $of TSClosed Closed on ___ by ___. - ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR shar proj ltkhid)} +$# ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR deckHash ticketHash)}

Custom fields @@ -87,7 +86,7 @@ $if ticketStatus ticket /= TSClosed