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

getProjectTicketsR: In AS2, list remote tickets too

Browse source
This commit is contained in:
fr33domlover 2020-05-14 11:13:04 +00:00
parent d29ba23bfb
commit cac4edc8eb
1 changed files with 37 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -74,6 +74,7 @@ import Data.Bitraversable
import Data.Bool (bool)
import Data.Default.Class (def)
import Data.Foldable (traverse_)
import Data.Function
import Data.Maybe
import Data.Monoid ((<>))
import Data.Text (Text)
@ -94,6 +95,7 @@ import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404)
import qualified Data.ByteString.Lazy as BL
import qualified Data.List.Ordered as LO
import qualified Data.Text as T (filter, intercalate, pack)
import qualified Data.Text.Lazy as TL
import qualified Database.Esqueleto as E
@ -181,7 +183,7 @@ getProjectTicketsR shr prj = selectRep $ do
, OffsetBy off
, LimitTo lim
]
E.select $ E.from $ \ (lt `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s `E.LeftOuterJoin` tup)) -> do
locals <- 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
@ -189,11 +191,32 @@ getProjectTicketsR shr prj = selectRep $ do
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
( lt E.^. LocalTicketTicket
, ( lt E.^. LocalTicketId
, tal E.?. TicketAuthorLocalId
, s E.?. SharerIdent
, tup E.?. TicketUnderProjectId
)
)
remotes <- E.select $ E.from $ \ (tpl `E.InnerJoin` tar `E.InnerJoin` rt `E.InnerJoin` ro `E.InnerJoin` i) -> do
E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
E.on $ rt E.^. RemoteTicketIdent E.==. ro E.^. RemoteObjectId
E.on $ tar E.^. TicketAuthorRemoteId E.==. rt E.^. RemoteTicketTicket
E.on $ tpl E.^. TicketProjectLocalId E.==. tar E.^. TicketAuthorRemoteTicket
E.where_ $ tpl E.^. TicketProjectLocalTicket `E.in_` E.valList tids
E.orderBy [E.desc $ tpl E.^. TicketProjectLocalTicket]
return
( tpl E.^. TicketProjectLocalTicket
, ( i E.^. InstanceHost
, ro E.^. RemoteObjectIdent
)
)
return $
map snd $
LO.mergeBy
(flip compare `on` fst)
(map (second Left) locals)
(map (second Right) remotes)
getPageAndNavCount countAllTickets selectTickets
encodeRouteHome <- getEncodeRouteHome
@ -235,18 +258,20 @@ getProjectTicketsR shr prj = selectRep $ do
else Nothing
, collectionPageStartIndex = Nothing
, collectionPageItems =
map (encodeRouteHome . ticketRoute encodeLT encodeTAL)
map (ticketRoute encodeRouteHome encodeLT encodeTAL)
tickets
}
where
here = ProjectTicketsR 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) -> ProjectTicketR shr prj $ encodeLT ltid
(Just talid, Just shrA, Nothing) -> SharerTicketR shrA $ encodeTAL talid
(Just _, Just _, Just _) -> ProjectTicketR shr prj $ encodeLT ltid
_ -> error "Impossible"
ticketRoute encodeRoute encodeLT encodeTAL (Left (E.Value ltid, E.Value mtalid, E.Value mshr, E.Value mtupid)) =
encodeRoute $
case (mtalid, mshr, mtupid) of
(Nothing, Nothing, Nothing) -> ProjectTicketR shr prj $ encodeLT ltid
(Just talid, Just shrA, Nothing) -> SharerTicketR shrA $ encodeTAL talid
(Just _, Just _, Just _) -> ProjectTicketR shr prj $ encodeLT ltid
_ -> error "Impossible"
ticketRoute _ _ _ (Right (E.Value h, E.Value lu)) = ObjURI h lu
getProjectTicketTreeR :: ShrIdent -> PrjIdent -> Handler Html
getProjectTicketTreeR shr prj = do