sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 16:14:51 +09:00
Code Issues Activity

UI: In ticket/MR pages, display when and by whom the ticket was resolved

Browse source
This commit is contained in:
fr33domlover 2022-10-16 22:25:21 +00:00
parent 58ca5e998e
commit e638ff4117
6 changed files with 65 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
src/Vervis/Handler/Cloth.hs
View file

@ -284,10 +284,10 @@ getClothR loomHash clothHash = do
where
getClothHtml = do
mpid <- maybeAuthId
(ticket, targetRepo, author, tparams, eparams, cparams, moriginRepo, mbundle) <- handlerToWidget $ runDB $ do
(Entity _ loom, Entity _ cloth, Entity ticketID ticket, author, _maybe_ResolveAndEitherTrlOrTrr, proposal) <-
(ticket, targetRepo, author, tparams, eparams, cparams, resolved, moriginRepo, mbundle) <- handlerToWidget $ runDB $ do
(Entity _ loom, Entity _ cloth, Entity ticketID ticket, author, maybeResolve, proposal) <-
getCloth404 loomHash clothHash
(ticket,,,,,,,)
(ticket,,,,,,,,)
<$> getLocalRepo' (loomRepo loom) (ticketLoomBranch cloth)
<*> bitraverse
(\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
@ -304,6 +304,7 @@ getClothR loomHash clothHash = do
<*> getTicketTextParams ticketID --wid
<*> getTicketEnumParams ticketID --wid
<*> getTicketClasses ticketID --wid
<*> traverse getTicketResolve maybeResolve
<*> traverse
(bitraverse
(\ (Entity _(MergeOriginLocal _ originRepoID maybeBranch)) ->
@ -327,9 +328,9 @@ getClothR loomHash clothHash = do
diffs = NE.map (patchContent . entityVal) $ NE.reverse patches
(repoID, _, _, maybeBranch) = targetRepo
maybeErrorOrCanApply <-
case ticketStatus ticket of
TSClosed -> pure Nothing
_ -> Just <$> runExceptT (canApplyPatches repoID maybeBranch diffs)
case resolved of
Just _ -> pure Nothing
Nothing -> Just <$> runExceptT (canApplyPatches repoID maybeBranch diffs)
return (bundleID, patchIDs, maybeErrorOrCanApply)
hashMessageKey <- handlerToWidget getEncodeKeyHashid
let desc :: Widget

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

@ -251,10 +251,10 @@ getTicketR deckHash ticketHash = do
where
getTicketHtml = do
mpid <- maybeAuthId
(ticket, author, tparams, eparams, cparams) <- handlerToWidget $ runDB $ do
(_deck, _ticketdeck, Entity ticketID ticket, author, _maybe_ResolveAndEitherTrlOrTrr) <-
(ticket, author, tparams, eparams, cparams, resolved) <- handlerToWidget $ runDB $ do
(_deck, _ticketdeck, Entity ticketID ticket, author, maybeResolve) <-
getTicket404 deckHash ticketHash
(ticket,,,,)
(ticket,,,,,)
<$> bitraverse
(\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
p <- getJust personID
@ -270,6 +270,7 @@ getTicketR deckHash ticketHash = do
<*> getTicketTextParams ticketID --wid
<*> getTicketEnumParams ticketID --wid
<*> getTicketClasses ticketID --wid
<*> traverse getTicketResolve maybeResolve
hashMessageKey <- handlerToWidget getEncodeKeyHashid
let desc :: Widget
desc = toWidget $ markupHTML $ ticketDescription ticket

18
src/Vervis/Persist/Actor.hs
View file

@ -15,6 +15,7 @@
module Vervis.Persist.Actor
( getLocalActor
, getLocalActorEnt
, getLocalActorEntity
, verifyLocalActivityExistsInDB
, getRemoteActorURI
@ -30,6 +31,7 @@ import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader
import Data.Barbie
import Data.Text (Text)
import Data.Traversable
import Database.Persist
@ -60,12 +62,16 @@ import Vervis.Settings
getLocalActor
:: MonadIO m => ActorId -> ReaderT SqlBackend m (LocalActorBy Key)
getLocalActor actorID = do
mp <- getKeyBy $ UniquePersonActor actorID
mg <- getKeyBy $ UniqueGroupActor actorID
mr <- getKeyBy $ UniqueRepoActor actorID
md <- getKeyBy $ UniqueDeckActor actorID
ml <- getKeyBy $ UniqueLoomActor actorID
getLocalActor = fmap (bmap entityKey) . getLocalActorEnt
getLocalActorEnt
:: MonadIO m => ActorId -> ReaderT SqlBackend m (LocalActorBy Entity)
getLocalActorEnt actorID = do
mp <- getBy $ UniquePersonActor actorID
mg <- getBy $ UniqueGroupActor actorID
mr <- getBy $ UniqueRepoActor actorID
md <- getBy $ UniqueDeckActor actorID
ml <- getBy $ UniqueLoomActor actorID
return $
case (mp, mg, mr, md, ml) of
(Nothing, Nothing, Nothing, Nothing, Nothing) -> error "Unused ActorId"

30
src/Vervis/Ticket.hs
View file

@ -47,6 +47,8 @@ module Vervis.Ticket
, parseProposalBundle
, checkDepAndTarget
, getTicketResolve
)
where
@ -56,6 +58,7 @@ import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Data.Bitraversable
import Data.Either
import Data.Foldable (for_)
import Data.Maybe
@ -88,6 +91,7 @@ import Vervis.Model
import Vervis.Model.Ident
import Vervis.Model.Workflow
import Vervis.Paginate
import Vervis.Persist.Actor
import Vervis.Recipient
import Vervis.Widget.Ticket
@ -786,3 +790,29 @@ checkDepAndTarget
checkParentAndTarget (Left _) (Right _) = throwE "Local parent but remote target"
checkParentAndTarget (Right _) (Left _) = throwE "Local target but remote parent"
checkParentAndTarget (Right _) (Right _) = return ()
getTicketResolve (Entity _ tr, resolve) = do
time <- outboxItemPublished <$> getJust (ticketResolveAccept tr)
closer <- bitraverse getCloserLocal getCloserRemote resolve
return (time, closer)
where
getCloserLocal (Entity _ trl) = do
outboxID <-
outboxItemOutbox <$>
getJust (ticketResolveLocalActivity trl)
Entity actorID actor <- do
maybeActor <- getBy $ UniqueActorOutbox outboxID
case maybeActor of
Nothing -> error "No actor for outbox"
Just a -> pure a
actorByEntity <- getLocalActorEnt actorID
person <-
case actorByEntity of
LocalActorPerson p -> pure p
_ -> error "Surprise! Ticket closer isn't a Person"
return (person, actor)
getCloserRemote (Entity _ trr) = do
ra <- getJust $ ticketResolveRemoteActor trr
ro <- getJust $ remoteActorIdent ra
i <- getJust $ remoteObjectInstance ro
return (i, ro, ra)

20
templates/cloth/one.hamlet
View file

@ -130,20 +130,12 @@ $# .
<p>
Status: #
$case ticketStatus ticket
$of TSNew
Open, new.
$# ^{buttonW POST "Accept this ticket" (ProjectTicketAcceptR loomHash clothHash)}
$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR loomHash clothHash)}
$of TSTodo
Open, to do.
$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR loomHash clothHash)}
$of TSClosed
Closed on ___ by ___.
$# ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR loomHash clothHash)}
$maybe (closed, closer) <- resolved
Closed on #{showDate closed} by ^{personLinkFedW closer}
$# ^{buttonW POST "Reopen this MR" (ProjectTicketOpenR loomHash clothHash)}
$nothing
Open
$# ^{buttonW POST "Close this MR" (ProjectTicketCloseR loomHash clothHash)}
<h3>Custom fields

21
templates/ticket/one.hamlet
View file

@ -65,21 +65,12 @@ $# .
<p>
Status: #
$case ticketStatus ticket
$of TSNew
Open, new.
$# ^{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 deckHash ticketHash)}
$of TSClosed
Closed on ___ by ___.
$# ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR deckHash ticketHash)}
$maybe (closed, closer) <- resolved
Closed on #{showDate closed} by ^{personLinkFedW closer}
$# ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR deckHash ticketHash)}
$nothing
Open
$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR deckHash ticketHash)}
<h3>Custom fields