forge/Vervis
1
0
Fork 0
Code Pull requests Activity

UI: Re-enable ticket page, some pieces still missing, mostly buttons

Browse source
This commit is contained in:
fr33domlover 2022-09-17 17:42:04 +00:00
parent e69d775f3f
commit 1db56ced39
7 changed files with 139 additions and 117 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/Vervis/Handler/Person.hs
View file

@ -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"

128
src/Vervis/Handler/Ticket.hs
View file

@ -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

26
src/Vervis/Ticket.hs
View file

@ -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

2
src/Vervis/Handler/Discussion.hs → src/Vervis/Web/Discussion.hs
View file

@ -13,7 +13,7 @@
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
module Vervis.Handler.Discussion
module Vervis.Web.Discussion
( getDiscussion
--, getTopReply
--, postTopReply

85
templates/ticket/one.hamlet
View file

@ -1,6 +1,7 @@
$# This file is part of Vervis.
$#
$# Written in 2016, 2018, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
$# Written in 2016, 2018, 2019, 2020, 2022
$# by fr33domlover <fr33domlover@riseup.net>.
$#
$# ♡ Copying is an act of love. Please copy, reuse and share.
$#
@ -16,53 +17,51 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<div>
Created on #{showDate $ ticketCreated ticket} by
^{sharerLinkFedW author}
^{personLinkFedW author}
<div>
<span>
<a href=@{ProjectTicketParticipantsR shar proj ltkhid}>
<a href=@{TicketFollowersR deckHash ticketHash}>
[🐤 Followers]
<span>
<a href=@{ProjectTicketDepsR shar proj ltkhid}>
<a href=@{TicketDepsR deckHash ticketHash}>
[⤴ Dependencies]
<span>
<a href=@{ProjectTicketReverseDepsR shar proj ltkhid}>
<a href=@{TicketReverseDepsR deckHash ticketHash}>
[⤷ Dependants]
<span>
<a href=@{ClaimRequestsTicketR shar proj ltkhid}>
[✋ Claim requests]
<span>
<a href=@{ProjectTicketEditR shar proj ltkhid}>
[✏ Edit]
^{followButton}
<div>^{desc}
$if ticketStatus ticket /= TSClosed
<p>
$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.
<a href=@{ClaimRequestNewR shar proj ltkhid}>Ask to have it assigned to you
or
^{buttonW POST "Claim this ticket" (ProjectTicketClaimR shar proj ltkhid)}
or
<a href=@{ProjectTicketAssignR shar proj ltkhid}>Assign to someone else
.
$# $if ticketStatus ticket /= TSClosed
$# <p>
$# $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.
$#
$# <a href=@{ClaimRequestNewR deckHash ticketHash}>Ask to have it assigned to you
$#
$# or
$#
$# ^{buttonW POST "Claim this ticket" (ProjectTicketClaimR deckHash ticketHash)}
$#
$# or
$#
$# <a href=@{ProjectTicketAssignR deckHash ticketHash}>Assign to someone else
$# .
<p>
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)}
<h3>Custom fields
@ -87,7 +86,7 @@ $if ticketStatus ticket /= TSClosed
<ul>
$forall TicketTextParam field mvalue <- tparams
<li .#{relevant $ wfsFilter field}>
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
$# <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field}
:
$maybe value <- mvalue
@ -99,11 +98,11 @@ $if ticketStatus ticket /= TSClosed
(none)
$forall TicketEnumParam field enum mvalue <- eparams
<li .#{relevant $ wfsFilter field}>
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field}
$# <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field}
:
$maybe value <- mvalue
<a href=@{WorkflowEnumCtorsR wshr wfl $ wesIdent enum}>
$# <a href=@{WorkflowEnumCtorsR wshr wfl $ wesIdent enum}>
#{tepvName value}
$nothing
$if wfsRequired field
@ -112,16 +111,16 @@ $if ticketStatus ticket /= TSClosed
(none)
$forall TicketClassParam field mvalue <- cparams
<li .#{relevant $ wfsFilter field}>
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field}
$# <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field}
:
$maybe _tpcid <- mvalue
Yes
$nothing
No
<p>
^{buttonW DELETE "Delete this ticket" (ProjectTicketR shar proj ltkhid)}
$# <p>
$# ^{buttonW DELETE "Delete this ticket" (ProjectTicketR deckHash ticketHash)}
<h3>Discussion

8
th/routes
View file

@ -146,6 +146,8 @@
/people/#PersonKeyHashid/follow PersonFollowR POST
/people/#PersonKeyHashid/unfollow PersonUnfollowR POST
/reply/#MessageKeyHashid ReplyR POST
---- Group ------------------------------------------------------------------
/groups/#GroupKeyHashid GroupR GET
@ -218,9 +220,9 @@
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unclaim TicketUnclaimR POST
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/assign TicketAssignR GET POST
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unassign TicketUnassignR POST
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/follow TicketFollowR POST
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unfollow TicketUnfollowR POST
-- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/reply TicketTopReplyR GET POST
/decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/follow TicketFollowR POST
/decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unfollow TicketUnfollowR POST
/decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/reply TicketReplyR POST
---- Ticket Dependency -------------------------------------------------------

2
vervis.cabal
View file

@ -176,7 +176,6 @@ library
Vervis.Handler.Cloth
Vervis.Handler.Common
Vervis.Handler.Deck
Vervis.Handler.Discussion
-- Vervis.Handler.Git
Vervis.Handler.Group
--Vervis.Handler.Inbox
@ -227,6 +226,7 @@ library
Vervis.Web.Actor
Vervis.Web.Darcs
Vervis.Web.Discussion
Vervis.Web.Git
Vervis.Web.Repo