1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 23:44:51 +09:00

getTicketsR: Deduce ticket URLs correctly for JSON output

This commit is contained in:
fr33domlover 2020-02-23 13:22:32 +00:00
parent a00c45a444
commit f6903364f4

View file

@ -181,7 +181,19 @@ getTicketsR shr prj = selectRep $ do
, OffsetBy off
, LimitTo lim
]
selectKeysList [LocalTicketTicket <-. tids] [Desc LocalTicketTicket]
E.select $ E.from $ \ (lt `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s `E.LeftOuterJoin` tup)) -> do
E.on $ tal E.?. TicketAuthorLocalId E.==. tup E.?. TicketUnderProjectAuthor
E.on $ p E.?. PersonIdent E.==. s E.?. SharerId
E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId
E.on $ E.just (lt E.^. LocalTicketId) E.==. tal E.?. TicketAuthorLocalTicket
E.where_ $ lt E.^. LocalTicketTicket `E.in_` E.valList tids
E.orderBy [E.desc $ lt E.^. LocalTicketTicket]
return
( lt E.^. LocalTicketId
, tal E.?. TicketAuthorLocalId
, s E.?. SharerIdent
, tup E.?. TicketUnderProjectId
)
getPageAndNavCount countAllTickets selectTickets
encodeRouteHome <- getEncodeRouteHome
@ -189,8 +201,8 @@ getTicketsR shr prj = selectRep $ do
encodeRoutePageLocal <- getEncodeRoutePageLocal
let pageUrl = encodeRoutePageLocal here
host <- asksSite siteInstanceHost
encodeTicketKey <- getEncodeKeyHashid
let ticketUrl = TicketR shr prj . encodeTicketKey
encodeLT <- getEncodeKeyHashid
encodeTAL <- getEncodeKeyHashid
return $
case mpage of
@ -223,11 +235,18 @@ getTicketsR shr prj = selectRep $ do
else Nothing
, collectionPageStartIndex = Nothing
, collectionPageItems =
map (encodeRouteHome . ticketUrl) tickets
map (encodeRouteHome . ticketRoute encodeLT encodeTAL)
tickets
}
where
here = TicketsR shr prj
encodeStrict = BL.toStrict . encode
ticketRoute encodeLT encodeTAL (E.Value ltid, E.Value mtalid, E.Value mshr, E.Value mtupid) =
case (mtalid, mshr, mtupid) of
(Nothing, Nothing, Nothing) -> TicketR shr prj $ encodeLT ltid
(Just talid, Just shrA, Nothing) -> SharerTicketR shrA $ encodeTAL talid
(Just _, Just _, Just _) -> TicketR shr prj $ encodeLT ltid
_ -> error "Impossible"
getTicketTreeR :: ShrIdent -> PrjIdent -> Handler Html
getTicketTreeR shr prj = do