UI: In ticket/MR pages, display when and by whom the ticket was resolved
This commit is contained in:
fr33domlover
parent
58ca5e998e
commit
e638ff4117
6 changed files with 65 additions and 44 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue