diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index f05a595..f2cffb7 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -828,13 +828,17 @@ getTicketReplyR shar proj tnum hid = do (selectDiscussionId shar proj tnum) mid -getTicketDeps :: Bool -> ShrIdent -> PrjIdent -> Int -> Handler Html +getTicketDeps :: Bool -> ShrIdent -> PrjIdent -> Int -> Handler TypedContent getTicketDeps forward shr prj num = do - let from' = - if forward then TicketDependencyParent else TicketDependencyChild - to' = - if forward then TicketDependencyChild else TicketDependencyParent - rows <- runDB $ do + (deps, rows) <- unzip <$> runDB getDepsFromDB + depsAP <- makeDepsCollection deps + provideHtmlAndAP depsAP $(widgetFile "ticket/dep/list") + where + getDepsFromDB = do + let from' = + if forward then TicketDependencyParent else TicketDependencyChild + to' = + if forward then TicketDependencyChild else TicketDependencyParent Entity sid _ <- getBy404 $ UniqueSharer shr Entity jid _ <- getBy404 $ UniqueProject prj sid Entity tid _ <- getBy404 $ UniqueTicket jid num @@ -854,28 +858,47 @@ getTicketDeps forward shr prj num = do E.where_ $ td E.^. from' E.==. E.val tid E.orderBy [E.asc $ t E.^. TicketNumber] return - ( t E.^. TicketNumber + ( td E.^. TicketDependencyId + , t E.^. TicketNumber , s , i , ra , t E.^. TicketTitle , t E.^. TicketStatus ) - defaultLayout $(widgetFile "ticket/dep/list") - where - toRow (E.Value number, ms, mi, mra, E.Value title, E.Value status) = - ( number - , case (ms, mi, mra) of - (Just s, Nothing, Nothing) -> - Left $ entityVal s - (Nothing, Just i, Just ra) -> - Right (entityVal i, entityVal ra) - _ -> error "Ticket author DB invalid state" - , title - , status - ) + where + toRow (E.Value dep, E.Value number, ms, mi, mra, E.Value title, E.Value status) = + ( dep + , ( number + , case (ms, mi, mra) of + (Just s, Nothing, Nothing) -> + Left $ entityVal s + (Nothing, Just i, Just ra) -> + Right (entityVal i, entityVal ra) + _ -> error "Ticket author DB invalid state" + , title + , status + ) + ) + makeDepsCollection tdids = do + encodeRouteLocal <- getEncodeRouteLocal + encodeRouteHome <- getEncodeRouteHome + encodeKeyHashid <- getEncodeKeyHashid + let here = + let route = if forward then TicketDepsR else TicketReverseDepsR + in route shr prj num + return Collection + { collectionId = encodeRouteLocal here + , collectionType = CollectionTypeUnordered + , collectionTotalItems = Just $ length tdids + , collectionCurrent = Nothing + , collectionFirst = Nothing + , collectionLast = Nothing + , collectionItems = + map (encodeRouteHome . TicketDepR . encodeKeyHashid) tdids + } -getTicketDepsR :: ShrIdent -> PrjIdent -> Int -> Handler Html +getTicketDepsR :: ShrIdent -> PrjIdent -> Int -> Handler TypedContent getTicketDepsR = getTicketDeps True postTicketDepsR :: ShrIdent -> PrjIdent -> Int -> Handler Html @@ -938,7 +961,7 @@ deleteTicketDepOldR shr prj pnum cnum = do setMessage "Ticket dependency removed." redirect $ TicketDepsR shr prj pnum -getTicketReverseDepsR :: ShrIdent -> PrjIdent -> Int -> Handler Html +getTicketReverseDepsR :: ShrIdent -> PrjIdent -> Int -> Handler TypedContent getTicketReverseDepsR = getTicketDeps False getTicketDepR :: KeyHashid TicketDependency -> Handler TypedContent