Provide AP Collection representations for ticket deps/rdeps pages
This commit is contained in:
parent
8fc5c80dd6
commit
655a2ebe18
1 changed files with 45 additions and 22 deletions
|
@ -828,13 +828,17 @@ getTicketReplyR shar proj tnum hid = do
|
||||||
(selectDiscussionId shar proj tnum)
|
(selectDiscussionId shar proj tnum)
|
||||||
mid
|
mid
|
||||||
|
|
||||||
getTicketDeps :: Bool -> ShrIdent -> PrjIdent -> Int -> Handler Html
|
getTicketDeps :: Bool -> ShrIdent -> PrjIdent -> Int -> Handler TypedContent
|
||||||
getTicketDeps forward shr prj num = do
|
getTicketDeps forward shr prj num = do
|
||||||
let from' =
|
(deps, rows) <- unzip <$> runDB getDepsFromDB
|
||||||
if forward then TicketDependencyParent else TicketDependencyChild
|
depsAP <- makeDepsCollection deps
|
||||||
to' =
|
provideHtmlAndAP depsAP $(widgetFile "ticket/dep/list")
|
||||||
if forward then TicketDependencyChild else TicketDependencyParent
|
where
|
||||||
rows <- runDB $ do
|
getDepsFromDB = do
|
||||||
|
let from' =
|
||||||
|
if forward then TicketDependencyParent else TicketDependencyChild
|
||||||
|
to' =
|
||||||
|
if forward then TicketDependencyChild else TicketDependencyParent
|
||||||
Entity sid _ <- getBy404 $ UniqueSharer shr
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
Entity jid _ <- getBy404 $ UniqueProject prj sid
|
Entity jid _ <- getBy404 $ UniqueProject prj sid
|
||||||
Entity tid _ <- getBy404 $ UniqueTicket jid num
|
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.where_ $ td E.^. from' E.==. E.val tid
|
||||||
E.orderBy [E.asc $ t E.^. TicketNumber]
|
E.orderBy [E.asc $ t E.^. TicketNumber]
|
||||||
return
|
return
|
||||||
( t E.^. TicketNumber
|
( td E.^. TicketDependencyId
|
||||||
|
, t E.^. TicketNumber
|
||||||
, s
|
, s
|
||||||
, i
|
, i
|
||||||
, ra
|
, ra
|
||||||
, t E.^. TicketTitle
|
, t E.^. TicketTitle
|
||||||
, t E.^. TicketStatus
|
, t E.^. TicketStatus
|
||||||
)
|
)
|
||||||
defaultLayout $(widgetFile "ticket/dep/list")
|
where
|
||||||
where
|
toRow (E.Value dep, E.Value number, ms, mi, mra, E.Value title, E.Value status) =
|
||||||
toRow (E.Value number, ms, mi, mra, E.Value title, E.Value status) =
|
( dep
|
||||||
( number
|
, ( number
|
||||||
, case (ms, mi, mra) of
|
, case (ms, mi, mra) of
|
||||||
(Just s, Nothing, Nothing) ->
|
(Just s, Nothing, Nothing) ->
|
||||||
Left $ entityVal s
|
Left $ entityVal s
|
||||||
(Nothing, Just i, Just ra) ->
|
(Nothing, Just i, Just ra) ->
|
||||||
Right (entityVal i, entityVal ra)
|
Right (entityVal i, entityVal ra)
|
||||||
_ -> error "Ticket author DB invalid state"
|
_ -> error "Ticket author DB invalid state"
|
||||||
, title
|
, title
|
||||||
, status
|
, 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
|
getTicketDepsR = getTicketDeps True
|
||||||
|
|
||||||
postTicketDepsR :: ShrIdent -> PrjIdent -> Int -> Handler Html
|
postTicketDepsR :: ShrIdent -> PrjIdent -> Int -> Handler Html
|
||||||
|
@ -938,7 +961,7 @@ deleteTicketDepOldR shr prj pnum cnum = do
|
||||||
setMessage "Ticket dependency removed."
|
setMessage "Ticket dependency removed."
|
||||||
redirect $ TicketDepsR shr prj pnum
|
redirect $ TicketDepsR shr prj pnum
|
||||||
|
|
||||||
getTicketReverseDepsR :: ShrIdent -> PrjIdent -> Int -> Handler Html
|
getTicketReverseDepsR :: ShrIdent -> PrjIdent -> Int -> Handler TypedContent
|
||||||
getTicketReverseDepsR = getTicketDeps False
|
getTicketReverseDepsR = getTicketDeps False
|
||||||
|
|
||||||
getTicketDepR :: KeyHashid TicketDependency -> Handler TypedContent
|
getTicketDepR :: KeyHashid TicketDependency -> Handler TypedContent
|
||||||
|
|
Loading…
Reference in a new issue