diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs
index bb783dd..6599ae1 100644
--- a/src/Vervis/Ticket.hs
+++ b/src/Vervis/Ticket.hs
@@ -33,6 +33,7 @@ where
import Control.Arrow ((***))
import Data.Foldable (for_)
import Data.Int
+import Data.Maybe (isJust)
import Data.Text (Text)
import Data.Traversable
import Database.Esqueleto
@@ -55,7 +56,7 @@ getTicketSummaries mfilt morder offlim jid = do
\ ( t
`InnerJoin` lt
`InnerJoin` tpl
- `LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s)
+ `LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s `LeftOuterJoin` tup)
`LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` ro `InnerJoin` i)
`InnerJoin` d
`LeftOuterJoin` m
@@ -66,6 +67,7 @@ getTicketSummaries mfilt morder offlim jid = do
on $ ra ?. RemoteActorIdent ==. ro ?. RemoteObjectId
on $ tar ?. TicketAuthorRemoteAuthor ==. ra ?. RemoteActorId
on $ just (tpl ^. TicketProjectLocalId) ==. tar ?. TicketAuthorRemoteTicket
+ on $ tal ?. TicketAuthorLocalId ==. tup ?. TicketUnderProjectAuthor
on $ p ?. PersonIdent ==. s ?. SharerId
on $ tal ?. TicketAuthorLocalAuthor ==. p ?. PersonId
on $ just (lt ^. LocalTicketId) ==. tal ?. TicketAuthorLocalTicket
@@ -74,7 +76,7 @@ getTicketSummaries mfilt morder offlim jid = do
where_ $ tpl ^. TicketProjectLocalProject ==. val jid
groupBy
( t ^. TicketId, lt ^. LocalTicketId
- , s ?. SharerId
+ , tal ?. TicketAuthorLocalId, s ?. SharerId, tup ?. TicketUnderProjectId
, ra ?. RemoteActorId, ro ?. RemoteObjectId, i ?. InstanceId
)
for_ mfilt $ \ filt -> where_ $ filt t
@@ -85,7 +87,9 @@ getTicketSummaries mfilt morder offlim jid = do
return
( t ^. TicketId
, lt ^. LocalTicketId
+ , tal ?. TicketAuthorLocalId
, s
+ , tup ?. TicketUnderProjectId
, i
, ro
, ra
@@ -95,7 +99,7 @@ getTicketSummaries mfilt morder offlim jid = do
, count $ m ?. MessageId
)
for tickets $
- \ (Value tid, Value ltid, ms, mi, mro, mra, Value c, Value t, Value d, Value r) -> do
+ \ (Value tid, Value ltid, Value mtalid, ms, Value mtupid, mi, mro, mra, Value c, Value t, Value d, Value r) -> do
labels <- select $ from $ \ (tpc `InnerJoin` wf) -> do
on $ tpc ^. TicketParamClassField ==. wf ^. WorkflowFieldId
where_ $ tpc ^. TicketParamClassTicket ==. val tid
@@ -103,10 +107,13 @@ getTicketSummaries mfilt morder offlim jid = do
return TicketSummary
{ tsId = ltid
, tsCreatedBy =
- case (ms, mi, mro, mra) of
- (Just s, Nothing, Nothing, Nothing) ->
- Left $ entityVal s
- (Nothing, Just i, Just ro, Just ra) ->
+ case (mtalid, ms, mi, mro, mra) of
+ (Just talid, Just s, Nothing, Nothing, Nothing) ->
+ Left
+ ( entityVal s
+ , if isJust mtupid then Nothing else Just talid
+ )
+ (Nothing, Nothing, Just i, Just ro, Just ra) ->
Right (entityVal i, entityVal ro, entityVal ra)
_ -> error "Ticket author DB invalid state"
, tsCreatedAt = c
diff --git a/src/Vervis/Widget/Ticket.hs b/src/Vervis/Widget/Ticket.hs
index 4d177ff..6051cf7 100644
--- a/src/Vervis/Widget/Ticket.hs
+++ b/src/Vervis/Widget/Ticket.hs
@@ -23,6 +23,7 @@ module Vervis.Widget.Ticket
where
import Control.Arrow ((&&&), (***))
+import Data.Bifunctor
import Data.HashMap.Lazy (HashMap)
import Data.Int
import Data.Maybe (mapMaybe)
@@ -53,7 +54,7 @@ import Vervis.Widget.Sharer
data TicketSummary = TicketSummary
{ tsId :: LocalTicketId
- , tsCreatedBy :: Either Sharer (Instance, RemoteObject, RemoteActor)
+ , tsCreatedBy :: Either (Sharer, Maybe TicketAuthorLocalId) (Instance, RemoteObject, RemoteActor)
, tsCreatedAt :: UTCTime
, tsTitle :: Text
, tsLabels :: [WorkflowField]
@@ -76,14 +77,22 @@ ticketSummaryW
-> Maybe (HashMap Int64 Int64)
-> Widget
ticketSummaryW shr prj ts mcs = do
- encodeTicketKey <- getEncodeKeyHashid
+ encodeLT <- getEncodeKeyHashid
+ encodeTAL <- getEncodeKeyHashid
cNew <- newIdent
cTodo <- newIdent
cClosed <- newIdent
let tshow = T.pack . show
mparams = map (tshow *** tshow) . M.toList <$> mcs
+ ticketRoute = ticketRoute' encodeLT encodeTAL
mroute <- getCurrentRoute
$(widgetFile "ticket/widget/summary")
+ where
+ ticketRoute' encodeLT encodeTAL summary =
+ case tsCreatedBy summary of
+ Left (s, Just talid) ->
+ SharerTicketR (sharerIdent s) (encodeTAL talid)
+ _ -> TicketR shr prj $ encodeLT $ tsId summary
-- 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
diff --git a/templates/ticket/widget/summary.hamlet b/templates/ticket/widget/summary.hamlet
index a6332b7..7e2daea 100644
--- a/templates/ticket/widget/summary.hamlet
+++ b/templates/ticket/widget/summary.hamlet
@@ -25,17 +25,17 @@ $# .
☒
-
+
###
#{showDate $ tsCreatedAt ts}
- ^{sharerLinkFedW $ tsCreatedBy ts}
+ ^{sharerLinkFedW $ first fst $ tsCreatedBy ts}
-
+
#{preEscapedToHtml $ tsTitle ts}
$forall wf <- tsLabels ts
$maybe wfcol <- workflowFieldColor wf
@@ -52,11 +52,11 @@ $# .
$maybe params <- mparams
-
+
☝
$maybe route <- mroute
☚
$nothing
-
+