forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Rename the TicketR routes to ProjectTicketR for clarity

Browse source 
Now it's much clearer when looking at the code, that these routes are about
project-hosted tickets, and it's easier to see where the author-hosted
equivalents are missing.
This commit is contained in:
fr33domlover 2020-04-09 07:36:01 +00:00
parent 4a362632be
commit f18c15f038
27 changed files with 297 additions and 294 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
config/routes
View file

@ -153,34 +153,34 @@
/tdeps/#TicketDepKeyHashid TicketDepR GET /tdeps/#TicketDepKeyHashid TicketDepR GET
/s/#ShrIdent/p/#PrjIdent/t TicketsR GET POST /s/#ShrIdent/p/#PrjIdent/t ProjectTicketsR GET POST
/s/#ShrIdent/p/#PrjIdent/t/!tree TicketTreeR GET /s/#ShrIdent/p/#PrjIdent/t/!tree ProjectTicketTreeR GET
/s/#ShrIdent/p/#PrjIdent/t/!new TicketNewR GET /s/#ShrIdent/p/#PrjIdent/t/!new ProjectTicketNewR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid TicketR GET PUT DELETE POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid ProjectTicketR GET PUT DELETE POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/edit TicketEditR GET /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/edit ProjectTicketEditR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/accept TicketAcceptR POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/accept ProjectTicketAcceptR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/close TicketCloseR POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/close ProjectTicketCloseR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/open TicketOpenR POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/open ProjectTicketOpenR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/claim TicketClaimR POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/claim ProjectTicketClaimR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/unclaim TicketUnclaimR POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/unclaim ProjectTicketUnclaimR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/assign TicketAssignR GET POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/assign ProjectTicketAssignR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/unassign TicketUnassignR POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/unassign ProjectTicketUnassignR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/follow TicketFollowR POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/follow ProjectTicketFollowR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/unfollow TicketUnfollowR POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/unfollow ProjectTicketUnfollowR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/cr ClaimRequestsTicketR GET POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/cr ClaimRequestsTicketR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/cr/new ClaimRequestNewR GET /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/cr/new ClaimRequestNewR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d TicketDiscussionR GET POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d ProjectTicketDiscussionR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d/!reply TicketTopReplyR GET /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d/!reply ProjectTicketTopReplyR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d/#MessageKeyHashid TicketMessageR POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d/#MessageKeyHashid ProjectTicketMessageR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d/#MessageKeyHashid/reply TicketReplyR GET /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d/#MessageKeyHashid/reply ProjectTicketReplyR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/deps TicketDepsR GET POST /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/deps ProjectTicketDepsR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/deps/!new TicketDepNewR GET /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/deps/!new ProjectTicketDepNewR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/deps/#LocalTicketKeyHashid TicketDepOldR POST DELETE /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/deps/#LocalTicketKeyHashid TicketDepOldR POST DELETE
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/rdeps TicketReverseDepsR GET /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/rdeps ProjectTicketReverseDepsR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/participants TicketParticipantsR GET /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/participants ProjectTicketParticipantsR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/team TicketTeamR GET /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/team ProjectTicketTeamR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/events TicketEventsR GET /s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/events ProjectTicketEventsR GET
/s/#ShrIdent/t SharerTicketsR GET /s/#ShrIdent/t SharerTicketsR GET

16
src/Vervis/API.hs
View file

@ -289,7 +289,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
Nothing -> throwE "Local context isn't a valid route" Nothing -> throwE "Local context isn't a valid route"
Just r -> return r Just r -> return r
case route of case route of
TicketR shr prj num -> return (shr, prj, num) ProjectTicketR shr prj num -> return (shr, prj, num)
_ -> throwE "Local context isn't a ticket route" _ -> throwE "Local context isn't a ticket route"
atMostSharer :: e -> (ShrIdent, LocalSharerRelatedSet) -> ExceptT e Handler (Maybe ShrIdent) atMostSharer :: e -> (ShrIdent, LocalSharerRelatedSet) -> ExceptT e Handler (Maybe ShrIdent)
@ -780,11 +780,11 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = run
lift $ forkWorker "Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp dont obiidFollow doc remotesHttp lift $ forkWorker "Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp dont obiidFollow doc remotesHttp
return obiidFollow return obiidFollow
where where
parseFollowee (SharerR shr) = Just $ FolloweeSharer shr parseFollowee (SharerR shr) = Just $ FolloweeSharer shr
parseFollowee (ProjectR shr prj) = Just $ FolloweeProject shr prj parseFollowee (ProjectR shr prj) = Just $ FolloweeProject shr prj
parseFollowee (TicketR shr prj num) = Just $ FolloweeTicket shr prj num parseFollowee (ProjectTicketR shr prj num) = Just $ FolloweeTicket shr prj num
parseFollowee (RepoR shr rp) = Just $ FolloweeRepo shr rp parseFollowee (RepoR shr rp) = Just $ FolloweeRepo shr rp
parseFollowee _ = Nothing parseFollowee _ = Nothing
followeeActor (FolloweeSharer shr) = LocalActorSharer shr followeeActor (FolloweeSharer shr) = LocalActorSharer shr
followeeActor (FolloweeProject shr prj) = LocalActorProject shr prj followeeActor (FolloweeProject shr prj) = LocalActorProject shr prj
@ -1088,7 +1088,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
<a href=@{ProjectR shrProject prjProject}> <a href=@{ProjectR shrProject prjProject}>
./s/#{shr2text shrProject}/p/#{prj2text prjProject} ./s/#{shr2text shrProject}/p/#{prj2text prjProject}
: # : #
<a href=@{TicketR shrProject prjProject ltkhid}> <a href=@{ProjectTicketR shrProject prjProject ltkhid}>
#{preEscapedToHtml $ unTextHtml $ AP.ticketSummary ticket}. #{preEscapedToHtml $ unTextHtml $ AP.ticketSummary ticket}.
|] |]
hLocal <- asksSite siteInstanceHost hLocal <- asksSite siteInstanceHost
@ -1113,7 +1113,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
{ acceptObject = ObjURI hLocal luOffer { acceptObject = ObjURI hLocal luOffer
, acceptResult = , acceptResult =
Just $ encodeRouteLocal $ Just $ encodeRouteLocal $
TicketR shrProject prjProject ltkhid ProjectTicketR shrProject prjProject ltkhid
} }
} }
update update

2
src/Vervis/ActivityPub.hs
View file

@ -142,7 +142,7 @@ parseContext uContext = do
Nothing -> throwE "Local context isn't a valid route" Nothing -> throwE "Local context isn't a valid route"
Just r -> return r Just r -> return r
case route of case route of
TicketR shr prj num -> return (shr, prj, num) ProjectTicketR shr prj num -> return (shr, prj, num)
_ -> throwE "Local context isn't a ticket route" _ -> throwE "Local context isn't a ticket route"
else return $ Right uContext else return $ Right uContext

8
src/Vervis/ActivityPub/Recipient.hs
View file

@ -113,9 +113,9 @@ parseLocalPersonCollection (ProjectTeamR shr prj) =
Just $ LocalPersonCollectionProjectTeam shr prj Just $ LocalPersonCollectionProjectTeam shr prj
parseLocalPersonCollection (ProjectFollowersR shr prj) = parseLocalPersonCollection (ProjectFollowersR shr prj) =
Just $ LocalPersonCollectionProjectFollowers shr prj Just $ LocalPersonCollectionProjectFollowers shr prj
parseLocalPersonCollection (TicketTeamR shr prj num) = parseLocalPersonCollection (ProjectTicketTeamR shr prj num) =
Just $ LocalPersonCollectionTicketTeam shr prj num Just $ LocalPersonCollectionTicketTeam shr prj num
parseLocalPersonCollection (TicketParticipantsR shr prj num) = parseLocalPersonCollection (ProjectTicketParticipantsR shr prj num) =
Just $ LocalPersonCollectionTicketFollowers shr prj num Just $ LocalPersonCollectionTicketFollowers shr prj num
parseLocalPersonCollection (RepoTeamR shr rp) = parseLocalPersonCollection (RepoTeamR shr rp) =
Just $ LocalPersonCollectionRepoTeam shr rp Just $ LocalPersonCollectionRepoTeam shr rp
@ -127,8 +127,8 @@ renderLocalPersonCollection :: LocalPersonCollection -> Route App
renderLocalPersonCollection (LocalPersonCollectionSharerFollowers shr) = SharerFollowersR shr renderLocalPersonCollection (LocalPersonCollectionSharerFollowers shr) = SharerFollowersR shr
renderLocalPersonCollection (LocalPersonCollectionProjectTeam shr prj) = ProjectTeamR shr prj renderLocalPersonCollection (LocalPersonCollectionProjectTeam shr prj) = ProjectTeamR shr prj
renderLocalPersonCollection (LocalPersonCollectionProjectFollowers shr prj) = ProjectFollowersR shr prj renderLocalPersonCollection (LocalPersonCollectionProjectFollowers shr prj) = ProjectFollowersR shr prj
renderLocalPersonCollection (LocalPersonCollectionTicketTeam shr prj ltkhid) = TicketTeamR shr prj ltkhid renderLocalPersonCollection (LocalPersonCollectionTicketTeam shr prj ltkhid) = ProjectTicketTeamR shr prj ltkhid
renderLocalPersonCollection (LocalPersonCollectionTicketFollowers shr prj ltkhid) = TicketParticipantsR shr prj ltkhid renderLocalPersonCollection (LocalPersonCollectionTicketFollowers shr prj ltkhid) = ProjectTicketParticipantsR shr prj ltkhid
renderLocalPersonCollection (LocalPersonCollectionRepoTeam shr rp) = RepoTeamR shr rp renderLocalPersonCollection (LocalPersonCollectionRepoTeam shr rp) = RepoTeamR shr rp
renderLocalPersonCollection (LocalPersonCollectionRepoFollowers shr rp) = RepoFollowersR shr rp renderLocalPersonCollection (LocalPersonCollectionRepoFollowers shr rp) = RepoFollowersR shr rp

4
src/Vervis/Client.hs
View file

@ -196,7 +196,7 @@ followTicket
=> ShrIdent -> ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Bool -> m (TextHtml, Audience URIMode, AP.Follow URIMode) => ShrIdent -> ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Bool -> m (TextHtml, Audience URIMode, AP.Follow URIMode)
followTicket shrAuthor shrObject prjObject numObject hide = do followTicket shrAuthor shrObject prjObject numObject hide = do
encodeRouteHome <- getEncodeRouteHome encodeRouteHome <- getEncodeRouteHome
let uObject = encodeRouteHome $ TicketR shrObject prjObject numObject let uObject = encodeRouteHome $ ProjectTicketR shrObject prjObject numObject
uRecip = encodeRouteHome $ ProjectR shrObject prjObject uRecip = encodeRouteHome $ ProjectR shrObject prjObject
follow shrAuthor uObject uRecip hide follow shrAuthor uObject uRecip hide
@ -401,7 +401,7 @@ undoFollowTicket
undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee = undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee =
undoFollow shrAuthor pidAuthor getFsid "project" objRoute recipRoute undoFollow shrAuthor pidAuthor getFsid "project" objRoute recipRoute
where where
objRoute = TicketR shrFollowee prjFollowee numFollowee objRoute = ProjectTicketR shrFollowee prjFollowee numFollowee
recipRoute = ProjectR shrFollowee prjFollowee recipRoute = ProjectR shrFollowee prjFollowee
getFsid = do getFsid = do
sid <- do sid <- do

2
src/Vervis/Federation.hs
View file

@ -118,7 +118,7 @@ parseTicket project luContext = do
Nothing -> throwE "Local context isn't a valid route" Nothing -> throwE "Local context isn't a valid route"
Just r -> return r Just r -> return r
case route of case route of
TicketR shr prj num -> ProjectTicketR shr prj num ->
if (shr, prj) == project if (shr, prj) == project
then return num then return num
else throwE "Local context ticket doesn't belong to the recipient project" else throwE "Local context ticket doesn't belong to the recipient project"

4
src/Vervis/Federation/Discussion.hs
View file

@ -231,10 +231,10 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
ProjectFollowersR shr prj ProjectFollowersR shr prj
| shr == shrRecip && prj == prjRecip | shr == shrRecip && prj == prjRecip
-> Just CreateNoteRecipProjectFollowers -> Just CreateNoteRecipProjectFollowers
TicketParticipantsR shr prj tkhid ProjectTicketParticipantsR shr prj tkhid
| shr == shrRecip && prj == prjRecip && tkhid == ctx | shr == shrRecip && prj == prjRecip && tkhid == ctx
-> Just CreateNoteRecipTicketParticipants -> Just CreateNoteRecipTicketParticipants
TicketTeamR shr prj tkhid ProjectTicketTeamR shr prj tkhid
| shr == shrRecip && prj == prjRecip && tkhid == ctx | shr == shrRecip && prj == prjRecip && tkhid == ctx
-> Just CreateNoteRecipTicketTeam -> Just CreateNoteRecipTicketTeam
_ -> Nothing _ -> Nothing

2
src/Vervis/Federation/Offer.hs
View file

@ -406,7 +406,7 @@ projectFollowF shr prj =
where where
objRoute (ProjectR shr' prj') objRoute (ProjectR shr' prj')
| shr == shr' && prj == prj' = Just Nothing | shr == shr' && prj == prj' = Just Nothing
objRoute (TicketR shr' prj' num) objRoute (ProjectTicketR shr' prj' num)
| shr == shr' && prj == prj' = Just $ Just num | shr == shr' && prj == prj' = Just $ Just num
objRoute _ = Nothing objRoute _ = Nothing

4
src/Vervis/Federation/Ticket.hs
View file

@ -335,7 +335,7 @@ projectOfferTicketF
<a href=@{ProjectR shrRecip prjRecip}> <a href=@{ProjectR shrRecip prjRecip}>
./s/#{shr2text shrRecip}/p/#{prj2text prjRecip} ./s/#{shr2text shrRecip}/p/#{prj2text prjRecip}
\: # \: #
<a href=@{TicketR shrRecip prjRecip ltkhid}> <a href=@{ProjectTicketR shrRecip prjRecip ltkhid}>
#{preEscapedToHtml $ unTextHtml $ AP.ticketSummary ticket}. #{preEscapedToHtml $ unTextHtml $ AP.ticketSummary ticket}.
|] |]
hLocal <- asksSite siteInstanceHost hLocal <- asksSite siteInstanceHost
@ -363,7 +363,7 @@ projectOfferTicketF
luOffer luOffer
, acceptResult = , acceptResult =
Just $ encodeRouteLocal $ Just $ encodeRouteLocal $
TicketR shrRecip prjRecip ltkhid ProjectTicketR shrRecip prjRecip ltkhid
} }
} }
update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc] update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]

130
src/Vervis/Foundation.hs
View file

@ -352,27 +352,27 @@ instance Yesod App where
(WorkflowEnumCtorNewR shr _ _ , _ ) -> personOrGroupAdmin shr (WorkflowEnumCtorNewR shr _ _ , _ ) -> personOrGroupAdmin shr
(WorkflowEnumCtorR shr _ _ _ , _ ) -> personOrGroupAdmin shr (WorkflowEnumCtorR shr _ _ _ , _ ) -> personOrGroupAdmin shr
(TicketsR s j , True) -> projOp ProjOpOpenTicket s j (ProjectTicketsR s j , True) -> projOp ProjOpOpenTicket s j
(TicketNewR s j , _ ) -> projOp ProjOpOpenTicket s j (ProjectTicketNewR s j , _ ) -> projOp ProjOpOpenTicket s j
(TicketR user _ _ , True) -> person user (ProjectTicketR user _ _ , True) -> person user
(TicketEditR user _ _ , _ ) -> person user (ProjectTicketEditR user _ _ , _ ) -> person user
(TicketAcceptR s j _ , _ ) -> projOp ProjOpAcceptTicket s j (ProjectTicketAcceptR s j _ , _ ) -> projOp ProjOpAcceptTicket s j
(TicketCloseR s j _ , _ ) -> projOp ProjOpCloseTicket s j (ProjectTicketCloseR s j _ , _ ) -> projOp ProjOpCloseTicket s j
(TicketOpenR s j _ , _ ) -> projOp ProjOpReopenTicket s j (ProjectTicketOpenR s j _ , _ ) -> projOp ProjOpReopenTicket s j
(TicketClaimR s j _ , _ ) -> projOp ProjOpClaimTicket s j (ProjectTicketClaimR s j _ , _ ) -> projOp ProjOpClaimTicket s j
(TicketUnclaimR s j _ , _ ) -> projOp ProjOpUnclaimTicket s j (ProjectTicketUnclaimR s j _ , _ ) -> projOp ProjOpUnclaimTicket s j
(TicketAssignR s j _ , _ ) -> projOp ProjOpAssignTicket s j (ProjectTicketAssignR s j _ , _ ) -> projOp ProjOpAssignTicket s j
(TicketUnassignR s j _ , _ ) -> projOp ProjOpUnassignTicket s j (ProjectTicketUnassignR s j _ , _ ) -> projOp ProjOpUnassignTicket s j
(TicketFollowR _ _ _ , True) -> personAny (ProjectTicketFollowR _ _ _ , True) -> personAny
(TicketUnfollowR _ _ _ , True) -> personAny (ProjectTicketUnfollowR _ _ _ , True) -> personAny
(ClaimRequestsTicketR s j _, True) -> projOp ProjOpRequestTicket s j (ClaimRequestsTicketR s j _, True) -> projOp ProjOpRequestTicket s j
(ClaimRequestNewR s j _ , _ ) -> projOp ProjOpRequestTicket s j (ClaimRequestNewR s j _ , _ ) -> projOp ProjOpRequestTicket s j
(TicketDiscussionR _ _ _ , True) -> personAny (ProjectTicketDiscussionR _ _ _ , True) -> personAny
(TicketMessageR _ _ _ _ , True) -> personAny (ProjectTicketMessageR _ _ _ _ , True) -> personAny
(TicketTopReplyR _ _ _ , _ ) -> personAny (ProjectTicketTopReplyR _ _ _ , _ ) -> personAny
(TicketReplyR _ _ _ _ , _ ) -> personAny (ProjectTicketReplyR _ _ _ _ , _ ) -> personAny
(TicketDepsR s j _ , True) -> projOp ProjOpAddTicketDep s j (ProjectTicketDepsR s j _ , True) -> projOp ProjOpAddTicketDep s j
(TicketDepNewR s j _ , _ ) -> projOp ProjOpAddTicketDep s j (ProjectTicketDepNewR s j _ , _ ) -> projOp ProjOpAddTicketDep s j
(TicketDepOldR s j _ _ , True) -> projOp ProjOpRemoveTicketDep s j (TicketDepOldR s j _ _ , True) -> projOp ProjOpRemoveTicketDep s j
_ -> return Authorized _ -> return Authorized
where where
@ -905,71 +905,71 @@ instance YesodBreadcrumbs App where
, Just $ SharerR shr , Just $ SharerR shr
) )
TicketsR shar proj -> ( "Tickets" ProjectTicketsR shar proj -> ( "Tickets"
, Just $ ProjectR shar proj , Just $ ProjectR shar proj
) )
TicketTreeR shr prj -> ( "Tree", Just $ TicketsR shr prj) ProjectTicketTreeR shr prj -> ( "Tree", Just $ ProjectTicketsR shr prj)
TicketNewR shar proj -> ("New", Just $ TicketsR shar proj) ProjectTicketNewR shar proj -> ("New", Just $ ProjectTicketsR shar proj)
TicketR shar proj num -> ( T.pack $ '#' : show num ProjectTicketR shar proj num -> ( T.pack $ '#' : show num
, Just $ TicketsR shar proj , Just $ ProjectTicketsR shar proj
) )
TicketEditR shar proj num -> ( "Edit" ProjectTicketEditR shar proj num -> ( "Edit"
, Just $ TicketR shar proj num , Just $ ProjectTicketR shar proj num
) )
TicketAcceptR _shr _prj _num -> ("", Nothing) ProjectTicketAcceptR _shr _prj _num -> ("", Nothing)
TicketCloseR _shar _proj _num -> ("", Nothing) ProjectTicketCloseR _shar _proj _num -> ("", Nothing)
TicketOpenR _shar _proj _num -> ("", Nothing) ProjectTicketOpenR _shar _proj _num -> ("", Nothing)
TicketClaimR _shar _proj _num -> ("", Nothing) ProjectTicketClaimR _shar _proj _num -> ("", Nothing)
TicketUnclaimR _shar _proj _num -> ("", Nothing) ProjectTicketUnclaimR _shar _proj _num -> ("", Nothing)
TicketAssignR shr prj num -> ( "Assign" ProjectTicketAssignR shr prj num -> ( "Assign"
, Just $ TicketR shr prj num , Just $ ProjectTicketR shr prj num
) )
TicketUnassignR _shr _prj _num -> ("", Nothing) ProjectTicketUnassignR _shr _prj _num -> ("", Nothing)
ClaimRequestsProjectR shr prj -> ( "Ticket Claim Requests" ClaimRequestsProjectR shr prj -> ( "Ticket Claim Requests"
, Just $ ProjectR shr prj , Just $ ProjectR shr prj
) )
ClaimRequestsTicketR shr prj num -> ( "Ticket Claim Requests" ClaimRequestsTicketR shr prj num -> ( "Ticket Claim Requests"
, Just $ TicketR shr prj num , Just $ ProjectTicketR shr prj num
) )
ClaimRequestNewR shr prj num -> ( "New" ClaimRequestNewR shr prj num -> ( "New"
, Just $ , Just $
ClaimRequestsTicketR shr prj num ClaimRequestsTicketR shr prj num
) )
TicketDiscussionR shar proj num -> ( "Discussion" ProjectTicketDiscussionR shar proj num -> ( "Discussion"
, Just $ TicketR shar proj num , Just $ ProjectTicketR shar proj num
)
ProjectTicketMessageR shr prj num mkhid -> ( "#" <> keyHashidText mkhid
, Just $
ProjectTicketDiscussionR shr prj num
)
ProjectTicketTopReplyR shar proj num -> ( "New topic"
, Just $
ProjectTicketDiscussionR shar proj num
)
ProjectTicketReplyR shar proj num cnum -> ( "Reply"
, Just $
ProjectTicketMessageR shar proj num cnum
)
ProjectTicketDepsR shr prj num -> ( "Dependencies"
, Just $ ProjectTicketR shr prj num
) )
TicketMessageR shr prj num mkhid -> ( "#" <> keyHashidText mkhid ProjectTicketDepNewR shr prj num -> ( "New dependency"
, Just $ , Just $ ProjectTicketDepsR shr prj num
TicketDiscussionR shr prj num
)
TicketTopReplyR shar proj num -> ( "New topic"
, Just $
TicketDiscussionR shar proj num
)
TicketReplyR shar proj num cnum -> ( "Reply"
, Just $
TicketMessageR shar proj num cnum
)
TicketDepsR shr prj num -> ( "Dependencies"
, Just $ TicketR shr prj num
)
TicketDepNewR shr prj num -> ( "New dependency"
, Just $ TicketDepsR shr prj num
) )
TicketDepOldR shr prj pnum cnum -> ( T.pack $ '#' : show cnum TicketDepOldR shr prj pnum cnum -> ( T.pack $ '#' : show cnum
, Just $ TicketDepsR shr prj pnum , Just $ ProjectTicketDepsR shr prj pnum
) )
TicketReverseDepsR shr prj num -> ( "Dependants" ProjectTicketReverseDepsR shr prj num -> ( "Dependants"
, Just $ TicketR shr prj num , Just $ ProjectTicketR shr prj num
)
ProjectTicketParticipantsR shr prj num -> ( "Participants"
, Just $ ProjectTicketR shr prj num
)
ProjectTicketTeamR shr prj num -> ( "Team"
, Just $ ProjectTicketR shr prj num
) )
TicketParticipantsR shr prj num -> ( "Participants" ProjectTicketEventsR shr prj num -> ( "Events"
, Just $ TicketR shr prj num , Just $ ProjectTicketR shr prj num
)
TicketTeamR shr prj num -> ( "Team"
, Just $ TicketR shr prj num
)
TicketEventsR shr prj num -> ( "Events"
, Just $ TicketR shr prj num
) )
WikiPageR shr prj _page -> ("Wiki", Just $ ProjectR shr prj) WikiPageR shr prj _page -> ("Wiki", Just $ ProjectR shr prj)

34
src/Vervis/Handler/Client.hs
View file

@ -22,18 +22,18 @@ module Vervis.Handler.Client
, postSharerFollowR , postSharerFollowR
, postProjectFollowR , postProjectFollowR
, postTicketFollowR , postProjectTicketFollowR
, postRepoFollowR , postRepoFollowR
, postSharerUnfollowR , postSharerUnfollowR
, postProjectUnfollowR , postProjectUnfollowR
, postTicketUnfollowR , postProjectTicketUnfollowR
, postRepoUnfollowR , postRepoUnfollowR
, getNotificationsR , getNotificationsR
, postNotificationsR , postNotificationsR
, postTicketsR , postProjectTicketsR
) )
where where
@ -133,10 +133,10 @@ ticketField encodeRouteLocal = checkMMap toTicket fromTicket fedUriField
Nothing -> throwE ("Not a valid route" :: Text) Nothing -> throwE ("Not a valid route" :: Text)
Just r -> return r Just r -> return r
case route of case route of
TicketR shr prj tkhid -> return (hTicket, shr, prj, tkhid) ProjectTicketR shr prj tkhid -> return (hTicket, shr, prj, tkhid)
_ -> throwE "Not a ticket route" _ -> throwE "Not a ticket route"
fromTicket (h, shr, prj, tkhid) = fromTicket (h, shr, prj, tkhid) =
ObjURI h $ encodeRouteLocal $ TicketR shr prj tkhid ObjURI h $ encodeRouteLocal $ ProjectTicketR shr prj tkhid
projectField projectField
:: (Route App -> LocalURI) -> Field Handler (Host, ShrIdent, PrjIdent) :: (Route App -> LocalURI) -> Field Handler (Host, ShrIdent, PrjIdent)
@ -328,12 +328,12 @@ postPublishR = do
let msg' = T.filter (/= '\r') msg let msg' = T.filter (/= '\r') msg
contentHtml <- ExceptT . pure $ renderPandocMarkdown msg' contentHtml <- ExceptT . pure $ renderPandocMarkdown msg'
let encodeRecipRoute = ObjURI hTicket . encodeRouteLocal let encodeRecipRoute = ObjURI hTicket . encodeRouteLocal
uTicket = encodeRecipRoute $ TicketR shrTicket prj num uTicket = encodeRecipRoute $ ProjectTicketR shrTicket prj num
ObjURI hLocal luAuthor = encodeRouteFed $ SharerR shrAuthor ObjURI hLocal luAuthor = encodeRouteFed $ SharerR shrAuthor
collections = collections =
[ ProjectFollowersR shrTicket prj [ ProjectFollowersR shrTicket prj
, TicketParticipantsR shrTicket prj num , ProjectTicketParticipantsR shrTicket prj num
, TicketTeamR shrTicket prj num , ProjectTicketTeamR shrTicket prj num
] ]
recips = ProjectR shrTicket prj : collections recips = ProjectR shrTicket prj : collections
note = Note note = Note
@ -493,13 +493,13 @@ postProjectFollowR shrObject prjObject = do
setFollowMessage shrAuthor eid setFollowMessage shrAuthor eid
redirect $ ProjectR shrObject prjObject redirect $ ProjectR shrObject prjObject
postTicketFollowR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler () postProjectTicketFollowR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler ()
postTicketFollowR shrObject prjObject tkhidObject = do postProjectTicketFollowR shrObject prjObject tkhidObject = do
shrAuthor <- getUserShrIdent shrAuthor <- getUserShrIdent
(summary, audience, follow) <- followTicket shrAuthor shrObject prjObject tkhidObject False (summary, audience, follow) <- followTicket shrAuthor shrObject prjObject tkhidObject False
eid <- followC shrAuthor summary audience follow eid <- followC shrAuthor summary audience follow
setFollowMessage shrAuthor eid setFollowMessage shrAuthor eid
redirect $ TicketR shrObject prjObject tkhidObject redirect $ ProjectTicketR shrObject prjObject tkhidObject
postRepoFollowR :: ShrIdent -> RpIdent -> Handler () postRepoFollowR :: ShrIdent -> RpIdent -> Handler ()
postRepoFollowR shrObject rpObject = do postRepoFollowR shrObject rpObject = do
@ -540,15 +540,15 @@ postProjectUnfollowR shrFollowee prjFollowee = do
setUnfollowMessage shrAuthor eid setUnfollowMessage shrAuthor eid
redirect $ ProjectR shrFollowee prjFollowee redirect $ ProjectR shrFollowee prjFollowee
postTicketUnfollowR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler () postProjectTicketUnfollowR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler ()
postTicketUnfollowR shrFollowee prjFollowee tkhidFollowee = do postProjectTicketUnfollowR shrFollowee prjFollowee tkhidFollowee = do
(shrAuthor, pidAuthor) <- getUser (shrAuthor, pidAuthor) <- getUser
eid <- runExceptT $ do eid <- runExceptT $ do
(summary, audience, undo) <- (summary, audience, undo) <-
ExceptT $ undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee tkhidFollowee ExceptT $ undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee tkhidFollowee
ExceptT $ undoC shrAuthor summary audience undo ExceptT $ undoC shrAuthor summary audience undo
setUnfollowMessage shrAuthor eid setUnfollowMessage shrAuthor eid
redirect $ TicketR shrFollowee prjFollowee tkhidFollowee redirect $ ProjectTicketR shrFollowee prjFollowee tkhidFollowee
postRepoUnfollowR :: ShrIdent -> RpIdent -> Handler () postRepoUnfollowR :: ShrIdent -> RpIdent -> Handler ()
postRepoUnfollowR shrFollowee rpFollowee = do postRepoUnfollowR shrFollowee rpFollowee = do
@ -700,8 +700,8 @@ postNotificationsR shr = do
Left b -> liftIO $ throwIO $ userError $ if b then t else f Left b -> liftIO $ throwIO $ userError $ if b then t else f
Right exy -> return exy Right exy -> return exy
postTicketsR :: ShrIdent -> PrjIdent -> Handler Html postProjectTicketsR :: ShrIdent -> PrjIdent -> Handler Html
postTicketsR shr prj = do postProjectTicketsR shr prj = do
wid <- runDB $ do wid <- runDB $ do
sid <- getKeyBy404 $ UniqueSharer shr sid <- getKeyBy404 $ UniqueSharer shr
j <- getValBy404 $ UniqueProject prj sid j <- getValBy404 $ UniqueProject prj sid
@ -776,4 +776,4 @@ postTicketsR shr prj = do
case eobiidFollow of case eobiidFollow of
Left e -> setMessage $ toHtml $ "Ticket created, but following it failed: " <> e Left e -> setMessage $ toHtml $ "Ticket created, but following it failed: " <> e
Right _ -> setMessage "Ticket created." Right _ -> setMessage "Ticket created."
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid

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

@ -145,7 +145,7 @@ getDiscussionMessage shr lmid = do
let shr = sharerIdent s let shr = sharerIdent s
prj = projectIdent j prj = projectIdent j
ltkhid <- encodeKeyHashid ltid ltkhid <- encodeKeyHashid ltid
return $ route2fed $ TicketR shr prj ltkhid return $ route2fed $ ProjectTicketR shr prj ltkhid
(Nothing, Just rd) -> do (Nothing, Just rd) -> do
ro <- getJust $ remoteDiscussionIdent rd ro <- getJust $ remoteDiscussionIdent rd
i <- getJust $ remoteObjectInstance ro i <- getJust $ remoteObjectInstance ro

2
src/Vervis/Handler/Sharer.hs
View file

@ -165,7 +165,7 @@ getSharerFollowingR shr = do
) )
encodeHid <- getEncodeKeyHashid encodeHid <- getEncodeKeyHashid
return $ return $
map (\ (E.Value shr, E.Value prj, E.Value tid) -> TicketR shr prj $ encodeHid tid) map (\ (E.Value shr, E.Value prj, E.Value tid) -> ProjectTicketR shr prj $ encodeHid tid)
triples triples
getRepos fsids = do getRepos fsids = do
rids <- selectKeysList [RepoFollowers <-. fsids] [] rids <- selectKeysList [RepoFollowers <-. fsids] []

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

@ -14,43 +14,43 @@
-} -}
module Vervis.Handler.Ticket module Vervis.Handler.Ticket
( getTicketsR ( getProjectTicketsR
, getTicketTreeR , getProjectTicketTreeR
, getTicketNewR , getProjectTicketNewR
, getTicketR , getProjectTicketR
, putTicketR , putProjectTicketR
, deleteTicketR , deleteProjectTicketR
, postTicketR , postProjectTicketR
, getTicketEditR , getProjectTicketEditR
, postTicketAcceptR , postProjectTicketAcceptR
, postTicketCloseR , postProjectTicketCloseR
, postTicketOpenR , postProjectTicketOpenR
, postTicketClaimR , postProjectTicketClaimR
, postTicketUnclaimR , postProjectTicketUnclaimR
, getTicketAssignR , getProjectTicketAssignR
, postTicketAssignR , postProjectTicketAssignR
, postTicketUnassignR , postProjectTicketUnassignR
, getClaimRequestsPersonR , getClaimRequestsPersonR
, getClaimRequestsProjectR , getClaimRequestsProjectR
, getClaimRequestsTicketR , getClaimRequestsTicketR
, postClaimRequestsTicketR , postClaimRequestsTicketR
, getClaimRequestNewR , getClaimRequestNewR
, getTicketDiscussionR , getProjectTicketDiscussionR
, postTicketDiscussionR , postProjectTicketDiscussionR
, getMessageR , getMessageR
, postTicketMessageR , postProjectTicketMessageR
, getTicketTopReplyR , getProjectTicketTopReplyR
, getTicketReplyR , getProjectTicketReplyR
, getTicketDepsR , getProjectTicketDepsR
, postTicketDepsR , postProjectTicketDepsR
, getTicketDepNewR , getProjectTicketDepNewR
, postTicketDepOldR , postTicketDepOldR
, deleteTicketDepOldR , deleteTicketDepOldR
, getTicketReverseDepsR , getProjectTicketReverseDepsR
, getTicketDepR , getTicketDepR
, getTicketParticipantsR , getProjectTicketParticipantsR
, getTicketTeamR , getProjectTicketTeamR
, getTicketEventsR , getProjectTicketEventsR
, getSharerTicketsR , getSharerTicketsR
, getSharerTicketR , getSharerTicketR
@ -141,8 +141,8 @@ import Vervis.Widget.Discussion (discussionW)
import Vervis.Widget.Sharer import Vervis.Widget.Sharer
import Vervis.Widget.Ticket import Vervis.Widget.Ticket
getTicketsR :: ShrIdent -> PrjIdent -> Handler TypedContent getProjectTicketsR :: ShrIdent -> PrjIdent -> Handler TypedContent
getTicketsR shr prj = selectRep $ do getProjectTicketsR shr prj = selectRep $ do
provideRep $ do provideRep $ do
((filtResult, filtWidget), filtEnctype) <- runFormGet ticketFilterForm ((filtResult, filtWidget), filtEnctype) <- runFormGet ticketFilterForm
let tf = let tf =
@ -239,17 +239,17 @@ getTicketsR shr prj = selectRep $ do
tickets tickets
} }
where where
here = TicketsR shr prj here = ProjectTicketsR shr prj
encodeStrict = BL.toStrict . encode encodeStrict = BL.toStrict . encode
ticketRoute encodeLT encodeTAL (E.Value ltid, E.Value mtalid, E.Value mshr, E.Value mtupid) = ticketRoute encodeLT encodeTAL (E.Value ltid, E.Value mtalid, E.Value mshr, E.Value mtupid) =
case (mtalid, mshr, mtupid) of case (mtalid, mshr, mtupid) of
(Nothing, Nothing, Nothing) -> TicketR shr prj $ encodeLT ltid (Nothing, Nothing, Nothing) -> ProjectTicketR shr prj $ encodeLT ltid
(Just talid, Just shrA, Nothing) -> SharerTicketR shrA $ encodeTAL talid (Just talid, Just shrA, Nothing) -> SharerTicketR shrA $ encodeTAL talid
(Just _, Just _, Just _) -> TicketR shr prj $ encodeLT ltid (Just _, Just _, Just _) -> ProjectTicketR shr prj $ encodeLT ltid
_ -> error "Impossible" _ -> error "Impossible"
getTicketTreeR :: ShrIdent -> PrjIdent -> Handler Html getProjectTicketTreeR :: ShrIdent -> PrjIdent -> Handler Html
getTicketTreeR shr prj = do getProjectTicketTreeR shr prj = do
(summaries, deps) <- runDB $ do (summaries, deps) <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid Entity jid _ <- getBy404 $ UniqueProject prj sid
@ -257,8 +257,8 @@ getTicketTreeR shr prj = do
<*> getTicketDepEdges jid <*> getTicketDepEdges jid
defaultLayout $ ticketTreeDW shr prj summaries deps defaultLayout $ ticketTreeDW shr prj summaries deps
getTicketNewR :: ShrIdent -> PrjIdent -> Handler Html getProjectTicketNewR :: ShrIdent -> PrjIdent -> Handler Html
getTicketNewR shr prj = do getProjectTicketNewR shr prj = do
wid <- runDB $ do wid <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr Entity sid _ <- getBy404 $ UniqueSharer shr
Entity _ j <- getBy404 $ UniqueProject prj sid Entity _ j <- getBy404 $ UniqueProject prj sid
@ -291,8 +291,8 @@ getProjectTicket shr prj ltkhid = do
"Ticket has both local and remote author" "Ticket has both local and remote author"
return (es, ej, Entity tid t, Entity ltid lt, etpl, author) return (es, ej, Entity tid t, Entity ltid lt, etpl, author)
getTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent getProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketR shar proj ltkhid = do getProjectTicketR shar proj ltkhid = do
mpid <- maybeAuthId mpid <- maybeAuthId
( wshr, wfl, ( wshr, wfl,
author, massignee, mcloser, ticket, lticket, tparams, eparams, cparams, author, massignee, mcloser, ticket, lticket, tparams, eparams, cparams,
@ -361,8 +361,8 @@ getTicketR shar proj ltkhid = do
discuss = discuss =
discussionW discussionW
(return $ localTicketDiscuss lticket) (return $ localTicketDiscuss lticket)
(TicketTopReplyR shar proj ltkhid) (ProjectTicketTopReplyR shar proj ltkhid)
(TicketReplyR shar proj ltkhid . encodeHid) (ProjectTicketReplyR shar proj ltkhid . encodeHid)
cRelevant <- newIdent cRelevant <- newIdent
cIrrelevant <- newIdent cIrrelevant <- newIdent
let relevant filt = let relevant filt =
@ -383,19 +383,19 @@ getTicketR shar proj ltkhid = do
( hLocal ( hLocal
, AP.TicketLocal , AP.TicketLocal
{ AP.ticketId = { AP.ticketId =
encodeRouteLocal $ TicketR shar proj ltkhid encodeRouteLocal $ ProjectTicketR shar proj ltkhid
, AP.ticketReplies = , AP.ticketReplies =
encodeRouteLocal $ TicketDiscussionR shar proj ltkhid encodeRouteLocal $ ProjectTicketDiscussionR shar proj ltkhid
, AP.ticketParticipants = , AP.ticketParticipants =
encodeRouteLocal $ TicketParticipantsR shar proj ltkhid encodeRouteLocal $ ProjectTicketParticipantsR shar proj ltkhid
, AP.ticketTeam = , AP.ticketTeam =
encodeRouteLocal $ TicketTeamR shar proj ltkhid encodeRouteLocal $ ProjectTicketTeamR shar proj ltkhid
, AP.ticketEvents = , AP.ticketEvents =
encodeRouteLocal $ TicketEventsR shar proj ltkhid encodeRouteLocal $ ProjectTicketEventsR shar proj ltkhid
, AP.ticketDeps = , AP.ticketDeps =
encodeRouteLocal $ TicketDepsR shar proj ltkhid encodeRouteLocal $ ProjectTicketDepsR shar proj ltkhid
, AP.ticketReverseDeps = , AP.ticketReverseDeps =
encodeRouteLocal $ TicketReverseDepsR shar proj ltkhid encodeRouteLocal $ ProjectTicketReverseDepsR shar proj ltkhid
} }
) )
@ -420,13 +420,13 @@ getTicketR shar proj ltkhid = do
provideHtmlAndAP' host ticketAP $ provideHtmlAndAP' host ticketAP $
let followButton = let followButton =
followW followW
(TicketFollowR shar proj ltkhid) (ProjectTicketFollowR shar proj ltkhid)
(TicketUnfollowR shar proj ltkhid) (ProjectTicketUnfollowR shar proj ltkhid)
(return $ localTicketFollowers lticket) (return $ localTicketFollowers lticket)
in $(widgetFile "ticket/one") in $(widgetFile "ticket/one")
putTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html putProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
putTicketR shr prj ltkhid = do putProjectTicketR shr prj ltkhid = do
(tid, ticket, wid) <- runDB $ do (tid, ticket, wid) <- runDB $ do
(_es, Entity _ project, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid (_es, Entity _ project, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid
return (tid, ticket, projectWorkflow project) return (tid, ticket, projectWorkflow project)
@ -438,7 +438,7 @@ putTicketR shr prj ltkhid = do
case renderPandocMarkdown $ ticketSource ticket' of case renderPandocMarkdown $ ticketSource ticket' of
Left err -> do Left err -> do
setMessage $ toHtml err setMessage $ toHtml err
redirect $ TicketEditR shr prj ltkhid redirect $ ProjectTicketEditR shr prj ltkhid
Right t -> return t Right t -> return t
let ticket'' = ticket' { ticketDescription = newDescHtml } let ticket'' = ticket' { ticketDescription = newDescHtml }
runDB $ do runDB $ do
@ -477,7 +477,7 @@ putTicketR shr prj ltkhid = do
} }
insertMany_ $ map mkcparam cins insertMany_ $ map mkcparam cins
setMessage "Ticket updated." setMessage "Ticket updated."
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
FormMissing -> do FormMissing -> do
setMessage "Field(s) missing." setMessage "Field(s) missing."
defaultLayout $(widgetFile "ticket/edit") defaultLayout $(widgetFile "ticket/edit")
@ -485,22 +485,22 @@ putTicketR shr prj ltkhid = do
setMessage "Ticket update failed, see errors below." setMessage "Ticket update failed, see errors below."
defaultLayout $(widgetFile "ticket/edit") defaultLayout $(widgetFile "ticket/edit")
deleteTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html deleteProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
deleteTicketR _shr _prj _ltkhid = deleteProjectTicketR _shr _prj _ltkhid =
--TODO: I can easily implement this, but should it even be possible to --TODO: I can easily implement this, but should it even be possible to
--delete tickets? --delete tickets?
error "Not implemented" error "Not implemented"
postTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html postProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketR shr prj ltkhid = do postProjectTicketR shr prj ltkhid = do
mmethod <- lookupPostParam "_method" mmethod <- lookupPostParam "_method"
case mmethod of case mmethod of
Just "PUT" -> putTicketR shr prj ltkhid Just "PUT" -> putProjectTicketR shr prj ltkhid
Just "DELETE" -> deleteTicketR shr prj ltkhid Just "DELETE" -> deleteProjectTicketR shr prj ltkhid
_ -> notFound _ -> notFound
getTicketEditR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html getProjectTicketEditR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getTicketEditR shr prj ltkhid = do getProjectTicketEditR shr prj ltkhid = do
(tid, ticket, wid) <- runDB $ do (tid, ticket, wid) <- runDB $ do
(_es, Entity _ project, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid (_es, Entity _ project, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid
return (tid, ticket, projectWorkflow project) return (tid, ticket, projectWorkflow project)
@ -508,9 +508,9 @@ getTicketEditR shr prj ltkhid = do
runFormPost $ editTicketContentForm tid ticket wid runFormPost $ editTicketContentForm tid ticket wid
defaultLayout $(widgetFile "ticket/edit") defaultLayout $(widgetFile "ticket/edit")
postTicketAcceptR postProjectTicketAcceptR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketAcceptR shr prj ltkhid = do postProjectTicketAcceptR shr prj ltkhid = do
succ <- runDB $ do succ <- runDB $ do
(_es, _ej, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid (_es, _ej, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid
case ticketStatus ticket of case ticketStatus ticket of
@ -522,11 +522,11 @@ postTicketAcceptR shr prj ltkhid = do
if succ if succ
then "Ticket accepted." then "Ticket accepted."
else "Ticket is already accepted." else "Ticket is already accepted."
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
postTicketCloseR postProjectTicketCloseR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketCloseR shr prj ltkhid = do postProjectTicketCloseR shr prj ltkhid = do
pid <- requireAuthId pid <- requireAuthId
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
succ <- runDB $ do succ <- runDB $ do
@ -545,11 +545,11 @@ postTicketCloseR shr prj ltkhid = do
if succ if succ
then "Ticket closed." then "Ticket closed."
else "Ticket is already closed." else "Ticket is already closed."
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
postTicketOpenR postProjectTicketOpenR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketOpenR shr prj ltkhid = do postProjectTicketOpenR shr prj ltkhid = do
pid <- requireAuthId pid <- requireAuthId
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
succ <- runDB $ do succ <- runDB $ do
@ -566,11 +566,11 @@ postTicketOpenR shr prj ltkhid = do
if succ if succ
then "Ticket reopened" then "Ticket reopened"
else "Ticket is already open." else "Ticket is already open."
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
postTicketClaimR postProjectTicketClaimR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketClaimR shr prj ltkhid = do postProjectTicketClaimR shr prj ltkhid = do
pid <- requireAuthId pid <- requireAuthId
mmsg <- runDB $ do mmsg <- runDB $ do
(_es, _ej, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid (_es, _ej, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid
@ -588,11 +588,11 @@ postTicketClaimR shr prj ltkhid = do
update tid [TicketAssignee =. Just pid] update tid [TicketAssignee =. Just pid]
return Nothing return Nothing
setMessage $ fromMaybe "The ticket is now assigned to you." mmsg setMessage $ fromMaybe "The ticket is now assigned to you." mmsg
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
postTicketUnclaimR postProjectTicketUnclaimR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketUnclaimR shr prj ltkhid = do postProjectTicketUnclaimR shr prj ltkhid = do
pid <- requireAuthId pid <- requireAuthId
mmsg <- runDB $ do mmsg <- runDB $ do
(_es, _ej, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid (_es, _ej, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid
@ -613,16 +613,16 @@ postTicketUnclaimR shr prj ltkhid = do
update tid [TicketAssignee =. Nothing] update tid [TicketAssignee =. Nothing]
return Nothing return Nothing
setMessage $ fromMaybe "The ticket is now unassigned." mmsg setMessage $ fromMaybe "The ticket is now unassigned." mmsg
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
getTicketAssignR getProjectTicketAssignR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getTicketAssignR shr prj ltkhid = do getProjectTicketAssignR shr prj ltkhid = do
vpid <- requireAuthId vpid <- requireAuthId
(_es, Entity jid _, Entity tid ticket, _elt, _etpl, _author) <- runDB $ getProjectTicket shr prj ltkhid (_es, Entity jid _, Entity tid ticket, _elt, _etpl, _author) <- runDB $ getProjectTicket shr prj ltkhid
let msg t = do let msg t = do
setMessage t setMessage t
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
case (ticketStatus ticket, ticketAssignee ticket) of case (ticketStatus ticket, ticketAssignee ticket) of
(TSNew, _) -> msg "The ticket isn’t accepted yet. Can’t assign it." (TSNew, _) -> msg "The ticket isn’t accepted yet. Can’t assign it."
(TSClosed, _) -> msg "The ticket is closed. Can’t assign it." (TSClosed, _) -> msg "The ticket is closed. Can’t assign it."
@ -632,14 +632,14 @@ getTicketAssignR shr prj ltkhid = do
runFormPost $ assignTicketForm vpid jid runFormPost $ assignTicketForm vpid jid
defaultLayout $(widgetFile "ticket/assign") defaultLayout $(widgetFile "ticket/assign")
postTicketAssignR postProjectTicketAssignR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketAssignR shr prj ltkhid = do postProjectTicketAssignR shr prj ltkhid = do
vpid <- requireAuthId vpid <- requireAuthId
(_es, Entity jid _, Entity tid ticket, _elt, _etpl, _author) <- runDB $ getProjectTicket shr prj ltkhid (_es, Entity jid _, Entity tid ticket, _elt, _etpl, _author) <- runDB $ getProjectTicket shr prj ltkhid
let msg t = do let msg t = do
setMessage t setMessage t
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
case (ticketStatus ticket, ticketAssignee ticket) of case (ticketStatus ticket, ticketAssignee ticket) of
(TSNew, _) -> msg "The ticket isn’t accepted yet. Can’t assign it." (TSNew, _) -> msg "The ticket isn’t accepted yet. Can’t assign it."
(TSClosed, _) -> msg "The ticket is closed. Can’t assign it." (TSClosed, _) -> msg "The ticket is closed. Can’t assign it."
@ -663,9 +663,9 @@ postTicketAssignR shr prj ltkhid = do
setMessage "Ticket assignment failed, see errors below." setMessage "Ticket assignment failed, see errors below."
defaultLayout $(widgetFile "ticket/assign") defaultLayout $(widgetFile "ticket/assign")
postTicketUnassignR postProjectTicketUnassignR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketUnassignR shr prj ltkhid = do postProjectTicketUnassignR shr prj ltkhid = do
pid <- requireAuthId pid <- requireAuthId
mmsg <- runDB $ do mmsg <- runDB $ do
(_es, _ej, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid (_es, _ej, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid
@ -686,7 +686,7 @@ postTicketUnassignR shr prj ltkhid = do
update tid [TicketAssignee =. Nothing] update tid [TicketAssignee =. Nothing]
return Nothing return Nothing
setMessage $ fromMaybe "The ticket is now unassigned." mmsg setMessage $ fromMaybe "The ticket is now unassigned." mmsg
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
-- | The logged-in user gets a list of the ticket claim requests they have -- | The logged-in user gets a list of the ticket claim requests they have
-- opened, in any project. -- opened, in any project.
@ -780,7 +780,7 @@ postClaimRequestsTicketR shr prj ltkhid = do
} }
insert_ cr insert_ cr
setMessage "Ticket claim request opened." setMessage "Ticket claim request opened."
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
FormMissing -> do FormMissing -> do
setMessage "Field(s) missing." setMessage "Field(s) missing."
defaultLayout $(widgetFile "ticket/claim-request/new") defaultLayout $(widgetFile "ticket/claim-request/new")
@ -794,43 +794,43 @@ selectDiscussionId shr prj ltkhid = do
(_es, _ej, _et, Entity _ lticket, _etpl, _author) <- getProjectTicket shr prj ltkhid (_es, _ej, _et, Entity _ lticket, _etpl, _author) <- getProjectTicket shr prj ltkhid
return $ localTicketDiscuss lticket return $ localTicketDiscuss lticket
getTicketDiscussionR getProjectTicketDiscussionR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getTicketDiscussionR shar proj ltkhid = do getProjectTicketDiscussionR shar proj ltkhid = do
encodeHid <- getEncodeKeyHashid encodeHid <- getEncodeKeyHashid
getDiscussion getDiscussion
(TicketReplyR shar proj ltkhid . encodeHid) (ProjectTicketReplyR shar proj ltkhid . encodeHid)
(TicketTopReplyR shar proj ltkhid) (ProjectTicketTopReplyR shar proj ltkhid)
(selectDiscussionId shar proj ltkhid) (selectDiscussionId shar proj ltkhid)
postTicketDiscussionR postProjectTicketDiscussionR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketDiscussionR shr prj ltkhid = do postProjectTicketDiscussionR shr prj ltkhid = do
hLocal <- getsYesod $ appInstanceHost . appSettings hLocal <- getsYesod $ appInstanceHost . appSettings
postTopReply postTopReply
hLocal hLocal
[ProjectR shr prj] [ProjectR shr prj]
[ ProjectFollowersR shr prj [ ProjectFollowersR shr prj
, TicketParticipantsR shr prj ltkhid , ProjectTicketParticipantsR shr prj ltkhid
, TicketTeamR shr prj ltkhid , ProjectTicketTeamR shr prj ltkhid
] ]
(TicketR shr prj ltkhid) (ProjectTicketR shr prj ltkhid)
(ProjectR shr prj) (ProjectR shr prj)
(TicketDiscussionR shr prj ltkhid) (ProjectTicketDiscussionR shr prj ltkhid)
(const $ TicketR shr prj ltkhid) (const $ ProjectTicketR shr prj ltkhid)
getMessageR :: ShrIdent -> KeyHashid LocalMessage -> Handler TypedContent getMessageR :: ShrIdent -> KeyHashid LocalMessage -> Handler TypedContent
getMessageR shr hid = do getMessageR shr hid = do
lmid <- decodeKeyHashid404 hid lmid <- decodeKeyHashid404 hid
getDiscussionMessage shr lmid getDiscussionMessage shr lmid
postTicketMessageR postProjectTicketMessageR
:: ShrIdent :: ShrIdent
-> PrjIdent -> PrjIdent
-> KeyHashid LocalTicket -> KeyHashid LocalTicket
-> KeyHashid Message -> KeyHashid Message
-> Handler Html -> Handler Html
postTicketMessageR shr prj ltkhid mkhid = do postProjectTicketMessageR shr prj ltkhid mkhid = do
encodeHid <- getEncodeKeyHashid encodeHid <- getEncodeKeyHashid
mid <- decodeKeyHashid404 mkhid mid <- decodeKeyHashid404 mkhid
hLocal <- getsYesod $ appInstanceHost . appSettings hLocal <- getsYesod $ appInstanceHost . appSettings
@ -838,30 +838,30 @@ postTicketMessageR shr prj ltkhid mkhid = do
hLocal hLocal
[ProjectR shr prj] [ProjectR shr prj]
[ ProjectFollowersR shr prj [ ProjectFollowersR shr prj
, TicketParticipantsR shr prj ltkhid , ProjectTicketParticipantsR shr prj ltkhid
, TicketTeamR shr prj ltkhid , ProjectTicketTeamR shr prj ltkhid
] ]
(TicketR shr prj ltkhid) (ProjectTicketR shr prj ltkhid)
(ProjectR shr prj) (ProjectR shr prj)
(TicketReplyR shr prj ltkhid . encodeHid) (ProjectTicketReplyR shr prj ltkhid . encodeHid)
(TicketMessageR shr prj ltkhid . encodeHid) (ProjectTicketMessageR shr prj ltkhid . encodeHid)
(const $ TicketR shr prj ltkhid) (const $ ProjectTicketR shr prj ltkhid)
(selectDiscussionId shr prj ltkhid) (selectDiscussionId shr prj ltkhid)
mid mid
getTicketTopReplyR getProjectTicketTopReplyR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getTicketTopReplyR shr prj ltkhid = getProjectTicketTopReplyR shr prj ltkhid =
getTopReply $ TicketDiscussionR shr prj ltkhid getTopReply $ ProjectTicketDiscussionR shr prj ltkhid
getTicketReplyR getProjectTicketReplyR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> KeyHashid Message -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> KeyHashid Message -> Handler Html
getTicketReplyR shr prj ltkhid mkhid = do getProjectTicketReplyR shr prj ltkhid mkhid = do
encodeHid <- getEncodeKeyHashid encodeHid <- getEncodeKeyHashid
mid <- decodeKeyHashid404 mkhid mid <- decodeKeyHashid404 mkhid
getReply getReply
(TicketReplyR shr prj ltkhid . encodeHid) (ProjectTicketReplyR shr prj ltkhid . encodeHid)
(TicketMessageR shr prj ltkhid . encodeHid) (ProjectTicketMessageR shr prj ltkhid . encodeHid)
(selectDiscussionId shr prj ltkhid) (selectDiscussionId shr prj ltkhid)
mid mid
@ -928,7 +928,10 @@ getTicketDeps forward shr prj ltkhid = do
encodeRouteHome <- getEncodeRouteHome encodeRouteHome <- getEncodeRouteHome
encodeKeyHashid <- getEncodeKeyHashid encodeKeyHashid <- getEncodeKeyHashid
let here = let here =
let route = if forward then TicketDepsR else TicketReverseDepsR let route =
if forward
then ProjectTicketDepsR
else ProjectTicketReverseDepsR
in route shr prj ltkhid in route shr prj ltkhid
return Collection return Collection
{ collectionId = encodeRouteLocal here { collectionId = encodeRouteLocal here
@ -941,13 +944,13 @@ getTicketDeps forward shr prj ltkhid = do
map (encodeRouteHome . TicketDepR . encodeKeyHashid) tdids map (encodeRouteHome . TicketDepR . encodeKeyHashid) tdids
} }
getTicketDepsR getProjectTicketDepsR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketDepsR = getTicketDeps True getProjectTicketDepsR = getTicketDeps True
postTicketDepsR postProjectTicketDepsR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketDepsR shr prj ltkhid = do postProjectTicketDepsR shr prj ltkhid = do
(_es, Entity jid _, Entity tid _, _elt, _etpl, _author) <- runDB $ getProjectTicket shr prj ltkhid (_es, Entity jid _, Entity tid _, _elt, _etpl, _author) <- runDB $ getProjectTicket shr prj ltkhid
((result, widget), enctype) <- runFormPost $ ticketDepForm jid tid ((result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
case result of case result of
@ -965,7 +968,7 @@ postTicketDepsR shr prj ltkhid = do
insert_ td insert_ td
trrFix td ticketDepGraph trrFix td ticketDepGraph
setMessage "Ticket dependency added." setMessage "Ticket dependency added."
redirect $ TicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
FormMissing -> do FormMissing -> do
setMessage "Field(s) missing." setMessage "Field(s) missing."
defaultLayout $(widgetFile "ticket/dep/new") defaultLayout $(widgetFile "ticket/dep/new")
@ -973,9 +976,9 @@ postTicketDepsR shr prj ltkhid = do
setMessage "Submission failed, see errors below." setMessage "Submission failed, see errors below."
defaultLayout $(widgetFile "ticket/dep/new") defaultLayout $(widgetFile "ticket/dep/new")
getTicketDepNewR getProjectTicketDepNewR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getTicketDepNewR shr prj ltkhid = do getProjectTicketDepNewR shr prj ltkhid = do
(_es, Entity jid _, Entity tid _, _elt, _etpl, _author) <- runDB $ getProjectTicket shr prj ltkhid (_es, Entity jid _, Entity tid _, _elt, _etpl, _author) <- runDB $ getProjectTicket shr prj ltkhid
((_result, widget), enctype) <- runFormPost $ ticketDepForm jid tid ((_result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
defaultLayout $(widgetFile "ticket/dep/new") defaultLayout $(widgetFile "ticket/dep/new")
@ -1003,11 +1006,11 @@ deleteTicketDepOldR shr prj pnum cnum = do
Entity tdid _ <- getBy404 $ UniqueTicketDependency ptid ctid Entity tdid _ <- getBy404 $ UniqueTicketDependency ptid ctid
delete tdid delete tdid
setMessage "Ticket dependency removed." setMessage "Ticket dependency removed."
redirect $ TicketDepsR shr prj pnum redirect $ ProjectTicketDepsR shr prj pnum
getTicketReverseDepsR getProjectTicketReverseDepsR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketReverseDepsR = getTicketDeps False getProjectTicketReverseDepsR = getTicketDeps False
getTicketDepR :: KeyHashid TicketDependency -> Handler TypedContent getTicketDepR :: KeyHashid TicketDependency -> Handler TypedContent
getTicketDepR tdkhid = do getTicketDepR tdkhid = do
@ -1027,7 +1030,7 @@ getTicketDepR tdkhid = do
encodeRouteHome <- getEncodeRouteHome encodeRouteHome <- getEncodeRouteHome
encodeHid <- getEncodeKeyHashid encodeHid <- getEncodeKeyHashid
let ticketRoute s j lt = let ticketRoute s j lt =
TicketR (sharerIdent s) (projectIdent j) (encodeHid lt) ProjectTicketR (sharerIdent s) (projectIdent j) (encodeHid lt)
here = TicketDepR tdkhid here = TicketDepR tdkhid
tdepAP = AP.TicketDependency tdepAP = AP.TicketDependency
{ ticketDepId = Just $ encodeRouteHome here { ticketDepId = Just $ encodeRouteHome here
@ -1063,18 +1066,18 @@ getTicketDepR tdkhid = do
s <- getJust $ personIdent p s <- getJust $ personIdent p
return (s, p) return (s, p)
getTicketParticipantsR getProjectTicketParticipantsR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketParticipantsR shr prj ltkhid = getFollowersCollection here getFsid getProjectTicketParticipantsR shr prj ltkhid = getFollowersCollection here getFsid
where where
here = TicketParticipantsR shr prj ltkhid here = ProjectTicketParticipantsR shr prj ltkhid
getFsid = do getFsid = do
(_es, _ej, _et, Entity _ lt, _etpl, _author) <- getProjectTicket shr prj ltkhid (_es, _ej, _et, Entity _ lt, _etpl, _author) <- getProjectTicket shr prj ltkhid
return $ localTicketFollowers lt return $ localTicketFollowers lt
getTicketTeamR getProjectTicketTeamR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketTeamR shr prj ltkhid = do getProjectTicketTeamR shr prj ltkhid = do
memberShrs <- runDB $ do memberShrs <- runDB $ do
(Entity sid _, _ej, _et, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid (Entity sid _, _ej, _et, _elt, _etpl, _author) <- getProjectTicket shr prj ltkhid
id_ <- id_ <-
@ -1095,7 +1098,7 @@ getTicketTeamR shr prj ltkhid = do
map (sharerIdent . entityVal) <$> map (sharerIdent . entityVal) <$>
selectList [SharerId <-. sids] [] selectList [SharerId <-. sids] []
let here = TicketTeamR shr prj ltkhid let here = ProjectTicketTeamR shr prj ltkhid
encodeRouteLocal <- getEncodeRouteLocal encodeRouteLocal <- getEncodeRouteLocal
encodeRouteHome <- getEncodeRouteHome encodeRouteHome <- getEncodeRouteHome
@ -1110,9 +1113,9 @@ getTicketTeamR shr prj ltkhid = do
} }
provideHtmlAndAP team $ redirectToPrettyJSON here provideHtmlAndAP team $ redirectToPrettyJSON here
getTicketEventsR getProjectTicketEventsR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketEventsR _shr _prj _ltkhid = error "TODO not implemented" getProjectTicketEventsR _shr _prj _ltkhid = error "TODO not implemented"
getSharerTicket getSharerTicket
:: ShrIdent :: ShrIdent

4
src/Vervis/Migration.hs
View file

@ -932,7 +932,7 @@ changes hLocal ctx =
<a href=@{ProjectR shrProject prj}> <a href=@{ProjectR shrProject prj}>
./s/#{shr2text shrProject}/p/#{prj2text prj} ./s/#{shr2text shrProject}/p/#{prj2text prj}
: # : #
<a href=@{TicketR shrProject prj $ encodeHid $ toSqlKey $ fromSqlKey tid}> <a href=@{ProjectTicketR shrProject prj $ encodeHid $ toSqlKey $ fromSqlKey tid}>
#{preEscapedToHtml $ ticket20190624Title ticket}. #{preEscapedToHtml $ ticket20190624Title ticket}.
|] |]
doc mluAct = Doc hLocal Activity doc mluAct = Doc hLocal Activity
@ -946,7 +946,7 @@ changes hLocal ctx =
{ acceptObject = encodeRouteHome offerR { acceptObject = encodeRouteHome offerR
, acceptResult = , acceptResult =
Just $ encodeRouteLocal $ Just $ encodeRouteLocal $
TicketR shrProject prj $ encodeHid $ toSqlKey $ fromSqlKey tid ProjectTicketR shrProject prj $ encodeHid $ toSqlKey $ fromSqlKey tid
} }
} }
obiidNew <- insert OutboxItem20190624 obiidNew <- insert OutboxItem20190624

2
src/Vervis/Widget/Ticket.hs
View file

@ -92,7 +92,7 @@ ticketSummaryW shr prj ts mcs = do
case tsCreatedBy summary of case tsCreatedBy summary of
Left (s, Just talid) -> Left (s, Just talid) ->
SharerTicketR (sharerIdent s) (encodeTAL talid) SharerTicketR (sharerIdent s) (encodeTAL talid)
_ -> TicketR shr prj $ encodeLT $ tsId summary _ -> ProjectTicketR shr prj $ encodeLT $ tsId summary
-- I'm noticing a pattern. A problem. Some of my widget functions take data and -- 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 -- directly represent it in HTML. Others take some other more general

4
templates/person/claim-requests.hamlet
View file

@ -25,8 +25,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
/ /
<a href=@{ProjectR shr prj}>#{prj2text prj} <a href=@{ProjectR shr prj}>#{prj2text prj}
<td> <td>
<a href=@{TicketR shr prj $ encodeHid tid}>### <a href=@{ProjectTicketR shr prj $ encodeHid tid}>###
<td> <td>
<a href=@{TicketR shr prj $ encodeHid tid}>#{title} <a href=@{ProjectTicketR shr prj $ encodeHid tid}>#{title}
<td> <td>
#{showDate time} #{showDate time}

4
templates/project/claim-request/list.hamlet
View file

@ -25,6 +25,6 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<td> <td>
^{sharerLinkW sharer} ^{sharerLinkW sharer}
<td> <td>
<a href=@{TicketR shr prj $ encodeHid tid}>### <a href=@{ProjectTicketR shr prj $ encodeHid tid}>###
<td> <td>
<a href=@{TicketR shr prj $ encodeHid tid}>#{title} <a href=@{ProjectTicketR shr prj $ encodeHid tid}>#{title}

2
templates/project/widget/nav.hamlet
View file

@ -31,7 +31,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<a href=@{ProjectDevsR shar proj}> <a href=@{ProjectDevsR shar proj}>
[🤝 Collaborators] [🤝 Collaborators]
<span> <span>
<a href=@{TicketsR shar proj}> <a href=@{ProjectTicketsR shar proj}>
[🐛 Tickets] [🐛 Tickets]
<span> <span>
<a href=@{ClaimRequestsProjectR shar proj}> <a href=@{ClaimRequestsProjectR shar proj}>

2
templates/ticket/assign.hamlet
View file

@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see $# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>. $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<form method=POST action=@{TicketAssignR shr prj ltkhid} enctype=#{enctype}> <form method=POST action=@{ProjectTicketAssignR shr prj ltkhid} enctype=#{enctype}>
^{widget} ^{widget}
<div class="submit"> <div class="submit">
<input type="submit"> <input type="submit">

6
templates/ticket/dep/list.hamlet
View file

@ -23,11 +23,11 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
$forall (tid, author, title, status) <- rows $forall (tid, author, title, status) <- rows
<tr> <tr>
<td> <td>
<a href=@{TicketR shr prj $ encodeHid tid}>### <a href=@{ProjectTicketR shr prj $ encodeHid tid}>###
<td> <td>
^{sharerLinkFedW author} ^{sharerLinkFedW author}
<td> <td>
<a href=@{TicketR shr prj $ encodeHid tid}>#{title} <a href=@{ProjectTicketR shr prj $ encodeHid tid}>#{title}
<td> <td>
#{show status} #{show status}
$if forward $if forward
@ -36,5 +36,5 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
$if forward $if forward
<p> <p>
<a href=@{TicketDepNewR shr prj ltkhid}> <a href=@{ProjectTicketDepNewR shr prj ltkhid}>
Add new… Add new…

2
templates/ticket/dep/new.hamlet
View file

@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see $# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>. $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<form method=POST action=@{TicketDepsR shr prj ltkhid} enctype=#{enctype}> <form method=POST action=@{ProjectTicketDepsR shr prj ltkhid} enctype=#{enctype}>
^{widget} ^{widget}
<div class="submit"> <div class="submit">
<input type="submit"> <input type="submit">

2
templates/ticket/edit.hamlet
View file

@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see $# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>. $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<form method=POST action=@{TicketR shr prj ltkhid} enctype=#{enctype}> <form method=POST action=@{ProjectTicketR shr prj ltkhid} enctype=#{enctype}>
<input type=hidden name=_method value=PUT> <input type=hidden name=_method value=PUT>
^{widget} ^{widget}
<div class="submit"> <div class="submit">

6
templates/ticket/list.hamlet
View file

@ -13,12 +13,12 @@ $# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>. $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<p> <p>
<a href=@{TicketNewR shr prj}>Create new… <a href=@{ProjectTicketNewR shr prj}>Create new…
<p> <p>
<a href=@{TicketTreeR shr prj}>View as tree… <a href=@{ProjectTicketTreeR shr prj}>View as tree…
<form method=GET action=@{TicketsR shr prj} enctype=#{filtEnctype}> <form method=GET action=@{ProjectTicketsR shr prj} enctype=#{filtEnctype}>
^{filtWidget} ^{filtWidget}
<div class="submit"> <div class="submit">
<input type="submit" value="Filter"> <input type="submit" value="Filter">

2
templates/ticket/new.hamlet
View file

@ -14,7 +14,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
Enter the details and click "Submit" to create a new ticket. Enter the details and click "Submit" to create a new ticket.
<form method=POST action=@{TicketsR shr prj} enctype=#{enctype}> <form method=POST action=@{ProjectTicketsR shr prj} enctype=#{enctype}>
^{widget} ^{widget}
<div class="submit"> <div class="submit">
<input type="submit"> <input type="submit">

26
templates/ticket/one.hamlet
View file

@ -20,19 +20,19 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<div> <div>
<span> <span>
<a href=@{TicketParticipantsR shar proj ltkhid}> <a href=@{ProjectTicketParticipantsR shar proj ltkhid}>
[🐤 Followers] [🐤 Followers]
<span> <span>
<a href=@{TicketDepsR shar proj ltkhid}> <a href=@{ProjectTicketDepsR shar proj ltkhid}>
[⤴ Dependencies] [⤴ Dependencies]
<span> <span>
<a href=@{TicketReverseDepsR shar proj ltkhid}> <a href=@{ProjectTicketReverseDepsR shar proj ltkhid}>
[⤷ Dependants] [⤷ Dependants]
<span> <span>
<a href=@{ClaimRequestsTicketR shar proj ltkhid}> <a href=@{ClaimRequestsTicketR shar proj ltkhid}>
[✋ Claim requests] [✋ Claim requests]
<span> <span>
<a href=@{TicketEditR shar proj ltkhid}> <a href=@{ProjectTicketEditR shar proj ltkhid}>
[✏ Edit] [✏ Edit]
^{followButton} ^{followButton}
@ -67,11 +67,11 @@ $if ticketStatus ticket /= TSClosed
$if me $if me
Assigned to you. Assigned to you.
^{buttonW POST "Unclaim this ticket" (TicketUnclaimR shar proj ltkhid)} ^{buttonW POST "Unclaim this ticket" (ProjectTicketUnclaimR shar proj ltkhid)}
$else $else
Assigned to ^{sharerLinkW assignee}. Assigned to ^{sharerLinkW assignee}.
^{buttonW POST "Unassign this ticket" (TicketUnassignR shar proj ltkhid)} ^{buttonW POST "Unassign this ticket" (ProjectTicketUnassignR shar proj ltkhid)}
$nothing $nothing
Not assigned. Not assigned.
@ -79,11 +79,11 @@ $if ticketStatus ticket /= TSClosed
or or
^{buttonW POST "Claim this ticket" (TicketClaimR shar proj ltkhid)} ^{buttonW POST "Claim this ticket" (ProjectTicketClaimR shar proj ltkhid)}
or or
<a href=@{TicketAssignR shar proj ltkhid}>Assign to someone else <a href=@{ProjectTicketAssignR shar proj ltkhid}>Assign to someone else
. .
<p> <p>
@ -92,18 +92,18 @@ $if ticketStatus ticket /= TSClosed
$of TSNew $of TSNew
Open, new. Open, new.
^{buttonW POST "Accept this ticket" (TicketAcceptR shar proj ltkhid)} ^{buttonW POST "Accept this ticket" (ProjectTicketAcceptR shar proj ltkhid)}
^{buttonW POST "Close this ticket" (TicketCloseR shar proj ltkhid)} ^{buttonW POST "Close this ticket" (ProjectTicketCloseR shar proj ltkhid)}
$of TSTodo $of TSTodo
Open, to do. Open, to do.
^{buttonW POST "Close this ticket" (TicketCloseR shar proj ltkhid)} ^{buttonW POST "Close this ticket" (ProjectTicketCloseR shar proj ltkhid)}
$of TSClosed $of TSClosed
Closed on #{showDate $ ticketClosed ticket} Closed on #{showDate $ ticketClosed ticket}
$maybe closer <- mcloser $maybe closer <- mcloser
by ^{sharerLinkW closer}. by ^{sharerLinkW closer}.
^{buttonW POST "Reopen this ticket" (TicketOpenR shar proj ltkhid)} ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR shar proj ltkhid)}
<h3>Custom fields <h3>Custom fields
@ -145,7 +145,7 @@ $if ticketStatus ticket /= TSClosed
No No
<p> <p>
^{buttonW DELETE "Delete this ticket" (TicketR shar proj ltkhid)} ^{buttonW DELETE "Delete this ticket" (ProjectTicketR shar proj ltkhid)}
<h3>Discussion <h3>Discussion

2
templates/ticket/widget/dep.hamlet
View file

@ -22,5 +22,5 @@ $case ticketStatus ticket
$of TSClosed $of TSClosed
<span .#{cClosed}> <span .#{cClosed}>
☒ ☒
<a href=@{TicketR shr prj $ encodeTicketKey ltid}> <a href=@{ProjectTicketR shr prj $ encodeTicketKey ltid}>
#{ticketTitle ticket} #{ticketTitle ticket}