sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 15:04: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

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

@ -74,6 +74,7 @@ import Data.Bitraversable
import Data.Bool (bool) import Data.Bool (bool)
import Data.Default.Class (def) import Data.Default.Class (def)
import Data.Foldable (traverse_) import Data.Foldable (traverse_)
import Data.Function
import Data.Maybe import Data.Maybe
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Text (Text) import Data.Text (Text)
@ -94,6 +95,7 @@ import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404) import Yesod.Persist.Core (runDB, get404, getBy404)
import qualified Data.ByteString.Lazy as BL 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 as T (filter, intercalate, pack)
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
@ -181,7 +183,7 @@ getProjectTicketsR shr prj = selectRep $ do
, OffsetBy off , OffsetBy off
, LimitTo lim , 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 $ tal E.?. TicketAuthorLocalId E.==. tup E.?. TicketUnderProjectAuthor
E.on $ p E.?. PersonIdent E.==. s E.?. SharerId E.on $ p E.?. PersonIdent E.==. s E.?. SharerId
E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId 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.where_ $ lt E.^. LocalTicketTicket `E.in_` E.valList tids
E.orderBy [E.desc $ lt E.^. LocalTicketTicket] E.orderBy [E.desc $ lt E.^. LocalTicketTicket]
return return
( lt E.^. LocalTicketId ( lt E.^. LocalTicketTicket
, ( lt E.^. LocalTicketId
, tal E.?. TicketAuthorLocalId , tal E.?. TicketAuthorLocalId
, s E.?. SharerIdent , s E.?. SharerIdent
, tup E.?. TicketUnderProjectId , 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 getPageAndNavCount countAllTickets selectTickets
encodeRouteHome <- getEncodeRouteHome encodeRouteHome <- getEncodeRouteHome
@ -235,18 +258,20 @@ getProjectTicketsR shr prj = selectRep $ do
else Nothing else Nothing
, collectionPageStartIndex = Nothing , collectionPageStartIndex = Nothing
, collectionPageItems = , collectionPageItems =
map (encodeRouteHome . ticketRoute encodeLT encodeTAL) map (ticketRoute encodeRouteHome encodeLT encodeTAL)
tickets tickets
} }
where where
here = ProjectTicketsR shr prj here = ProjectTicketsR shr prj
encodeStrict = BL.toStrict . encode encodeStrict = BL.toStrict . encode
ticketRoute encodeLT encodeTAL (E.Value ltid, E.Value mtalid, E.Value mshr, E.Value mtupid) = ticketRoute encodeRoute encodeLT encodeTAL (Left (E.Value ltid, E.Value mtalid, E.Value mshr, E.Value mtupid)) =
encodeRoute $
case (mtalid, mshr, mtupid) of case (mtalid, mshr, mtupid) of
(Nothing, Nothing, Nothing) -> ProjectTicketR shr prj $ encodeLT ltid (Nothing, Nothing, Nothing) -> ProjectTicketR shr prj $ encodeLT ltid
(Just talid, Just shrA, Nothing) -> SharerTicketR shrA $ encodeTAL talid (Just talid, Just shrA, Nothing) -> SharerTicketR shrA $ encodeTAL talid
(Just _, Just _, Just _) -> ProjectTicketR shr prj $ encodeLT ltid (Just _, Just _, Just _) -> ProjectTicketR shr prj $ encodeLT ltid
_ -> error "Impossible" _ -> error "Impossible"
ticketRoute _ _ _ (Right (E.Value h, E.Value lu)) = ObjURI h lu
getProjectTicketTreeR :: ShrIdent -> PrjIdent -> Handler Html getProjectTicketTreeR :: ShrIdent -> PrjIdent -> Handler Html
getProjectTicketTreeR shr prj = do getProjectTicketTreeR shr prj = do