getTicketsR: Deduce ticket URL correctly for HTML output too
This commit is contained in:
fr33domlover
parent
ca0c7124c1
commit
bf4a0e4c95
3 changed files with 30 additions and 14 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -25,17 +25,17 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|||
☒
|
||||
|
||||
<span .ticket-number-column>
|
||||
<a href=@{TicketR shr prj $ encodeTicketKey $ tsId ts}>
|
||||
<a href=@{ticketRoute ts}>
|
||||
###
|
||||
|
||||
<span .ticket-date-column>
|
||||
#{showDate $ tsCreatedAt ts}
|
||||
|
||||
<span .ticket-sharer-column>
|
||||
^{sharerLinkFedW $ tsCreatedBy ts}
|
||||
^{sharerLinkFedW $ first fst $ tsCreatedBy ts}
|
||||
|
||||
<span .ticket-title-column>
|
||||
<a href=@{TicketR shr prj $ encodeTicketKey $ tsId ts}>
|
||||
<a href=@{ticketRoute ts}>
|
||||
#{preEscapedToHtml $ tsTitle ts}
|
||||
$forall wf <- tsLabels ts
|
||||
$maybe wfcol <- workflowFieldColor wf
|
||||
|
|
@ -52,11 +52,11 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|||
|
||||
$maybe params <- mparams
|
||||
<span .ticket-node-column>
|
||||
<a href="#node-#{keyHashidText $ encodeTicketKey $ tsId ts}" title="Jump to subtree">
|
||||
<a href="#node-#{keyHashidText $ encodeLT $ tsId ts}" title="Jump to subtree">
|
||||
☝
|
||||
$maybe route <- mroute
|
||||
<a href=@?{(route, params)} title="Move subtree here">
|
||||
☚
|
||||
$nothing
|
||||
<span .ticket-node-column>
|
||||
<a id="node-#{keyHashidText $ encodeTicketKey $ tsId ts}">
|
||||
<a id="node-#{keyHashidText $ encodeLT $ tsId ts}">
|
||||
|
|
|
|||
Loading…
Reference in a new issue