forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Provide AP Collection representations for ticket deps/rdeps pages

Browse source
This commit is contained in:
fr33domlover 2019-07-23 18:15:51 +00:00
parent 8fc5c80dd6
commit 655a2ebe18
1 changed files with 45 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -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