Ticket tree view page
This commit is contained in:
parent
b5014a0f5f
commit
dc54a89503
7 changed files with 92 additions and 2 deletions
|
@ -93,6 +93,7 @@
|
||||||
/s/#ShrIdent/p/#PrjIdent/d/#ShrIdent ProjectDevR GET DELETE POST
|
/s/#ShrIdent/p/#PrjIdent/d/#ShrIdent ProjectDevR GET DELETE POST
|
||||||
|
|
||||||
/s/#ShrIdent/p/#PrjIdent/t TicketsR GET POST
|
/s/#ShrIdent/p/#PrjIdent/t TicketsR GET POST
|
||||||
|
/s/#ShrIdent/p/#PrjIdent/t/!tree TicketTreeR GET
|
||||||
/s/#ShrIdent/p/#PrjIdent/t/!new TicketNewR GET
|
/s/#ShrIdent/p/#PrjIdent/t/!new TicketNewR GET
|
||||||
/s/#ShrIdent/p/#PrjIdent/t/#Int TicketR GET PUT DELETE POST
|
/s/#ShrIdent/p/#PrjIdent/t/#Int TicketR GET PUT DELETE POST
|
||||||
/s/#ShrIdent/p/#PrjIdent/t/#Int/edit TicketEditR GET
|
/s/#ShrIdent/p/#PrjIdent/t/#Int/edit TicketEditR GET
|
||||||
|
|
|
@ -87,8 +87,8 @@ edgeView
|
||||||
-- ^ New edge label. For a full edge, 'Nothing'. For a link edge, 'Just' an
|
-- ^ New edge label. For a full edge, 'Nothing'. For a link edge, 'Just' an
|
||||||
-- updated choice map that chooses this edge as the new full edge for the
|
-- updated choice map that chooses this edge as the new full edge for the
|
||||||
-- child.
|
-- child.
|
||||||
edgeView _ (_, _, False) = Nothing
|
edgeView _ (_, _, True) = Nothing
|
||||||
edgeView choices (child, parent, True) = Just $ M.insert child parent choices
|
edgeView choices (child, parent, False) = Just $ M.insert child parent choices
|
||||||
|
|
||||||
reverseEdge :: (n, n, a) -> (n, n, a)
|
reverseEdge :: (n, n, a) -> (n, n, a)
|
||||||
reverseEdge (x, y, l) = (y, x, l)
|
reverseEdge (x, y, l) = (y, x, l)
|
||||||
|
|
|
@ -455,6 +455,7 @@ instance YesodBreadcrumbs App where
|
||||||
TicketsR shar proj -> ( "Tickets"
|
TicketsR shar proj -> ( "Tickets"
|
||||||
, Just $ ProjectR shar proj
|
, Just $ ProjectR shar proj
|
||||||
)
|
)
|
||||||
|
TicketTreeR shr prj -> ( "Tree", Just $ TicketsR shr prj)
|
||||||
TicketNewR shar proj -> ("New", Just $ TicketsR shar proj)
|
TicketNewR shar proj -> ("New", Just $ TicketsR shar proj)
|
||||||
TicketR shar proj num -> ( T.pack $ '#' : show num
|
TicketR shar proj num -> ( T.pack $ '#' : show num
|
||||||
, Just $ TicketsR shar proj
|
, Just $ TicketsR shar proj
|
||||||
|
|
|
@ -16,6 +16,7 @@
|
||||||
module Vervis.Handler.Ticket
|
module Vervis.Handler.Ticket
|
||||||
( getTicketsR
|
( getTicketsR
|
||||||
, postTicketsR
|
, postTicketsR
|
||||||
|
, getTicketTreeR
|
||||||
, getTicketNewR
|
, getTicketNewR
|
||||||
, getTicketR
|
, getTicketR
|
||||||
, putTicketR
|
, putTicketR
|
||||||
|
@ -51,6 +52,7 @@ where
|
||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
|
import Control.Applicative (liftA2)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger (logWarn)
|
import Control.Monad.Logger (logWarn)
|
||||||
import Data.Default.Class (def)
|
import Data.Default.Class (def)
|
||||||
|
@ -84,6 +86,7 @@ import Vervis.Model
|
||||||
import Vervis.Model.Ident
|
import Vervis.Model.Ident
|
||||||
import Vervis.Render (renderSourceT)
|
import Vervis.Render (renderSourceT)
|
||||||
import Vervis.Settings (widgetFile)
|
import Vervis.Settings (widgetFile)
|
||||||
|
import Vervis.Ticket
|
||||||
import Vervis.TicketFilter (filterTickets)
|
import Vervis.TicketFilter (filterTickets)
|
||||||
import Vervis.Time (showDate)
|
import Vervis.Time (showDate)
|
||||||
import Vervis.Widget.Discussion (discussionW)
|
import Vervis.Widget.Discussion (discussionW)
|
||||||
|
@ -154,6 +157,16 @@ postTicketsR shar proj = do
|
||||||
setMessage "Ticket creation failed, see errors below."
|
setMessage "Ticket creation failed, see errors below."
|
||||||
defaultLayout $(widgetFile "ticket/new")
|
defaultLayout $(widgetFile "ticket/new")
|
||||||
|
|
||||||
|
getTicketTreeR :: ShrIdent -> PrjIdent -> Handler Html
|
||||||
|
getTicketTreeR shr prj = do
|
||||||
|
(summaries, deps) <- runDB $ do
|
||||||
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
|
Entity jid _ <- getBy404 $ UniqueProject prj sid
|
||||||
|
liftA2 (,)
|
||||||
|
(getTicketSummaries jid)
|
||||||
|
(getTicketDepEdges jid)
|
||||||
|
defaultLayout $ ticketTreeDW shr prj summaries deps
|
||||||
|
|
||||||
getTicketNewR :: ShrIdent -> PrjIdent -> Handler Html
|
getTicketNewR :: ShrIdent -> PrjIdent -> Handler Html
|
||||||
getTicketNewR shar proj = do
|
getTicketNewR shar proj = do
|
||||||
((_result, widget), enctype) <- runFormPost newTicketForm
|
((_result, widget), enctype) <- runFormPost newTicketForm
|
||||||
|
|
71
src/Vervis/Ticket.hs
Normal file
71
src/Vervis/Ticket.hs
Normal file
|
@ -0,0 +1,71 @@
|
||||||
|
{- This file is part of Vervis.
|
||||||
|
-
|
||||||
|
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
|
-
|
||||||
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
|
-
|
||||||
|
- The author(s) have dedicated all copyright and related and neighboring
|
||||||
|
- rights to this software to the public domain worldwide. This software is
|
||||||
|
- distributed without any warranty.
|
||||||
|
-
|
||||||
|
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
|
- with this software. If not, see
|
||||||
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Vervis.Ticket
|
||||||
|
( getTicketSummaries
|
||||||
|
, getTicketDepEdges
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Control.Arrow ((***))
|
||||||
|
import Database.Esqueleto
|
||||||
|
|
||||||
|
import Vervis.Foundation (AppDB)
|
||||||
|
import Vervis.Model
|
||||||
|
import Vervis.Widget.Ticket (TicketSummary (..))
|
||||||
|
|
||||||
|
-- | Get summaries of all the tickets in the given project.
|
||||||
|
getTicketSummaries :: ProjectId -> AppDB [TicketSummary]
|
||||||
|
getTicketSummaries jid = do
|
||||||
|
let toSummary (Value n, Entity _ s, Value c, Value t, Value d, Value r) =
|
||||||
|
TicketSummary
|
||||||
|
{ tsNumber = n
|
||||||
|
, tsCreatedBy = s
|
||||||
|
, tsCreatedAt = c
|
||||||
|
, tsTitle = t
|
||||||
|
, tsDone = d
|
||||||
|
, tsComments = r
|
||||||
|
}
|
||||||
|
fmap (map toSummary) $ select $ from $
|
||||||
|
\ (t `InnerJoin` p `InnerJoin` s `InnerJoin` d) -> do
|
||||||
|
on $ t ^. TicketDiscuss ==. d ^. DiscussionId
|
||||||
|
on $ p ^. PersonIdent ==. s ^. SharerId
|
||||||
|
on $ t ^. TicketCreator ==. p ^. PersonId
|
||||||
|
where_ $ t ^. TicketProject ==. val jid
|
||||||
|
return
|
||||||
|
( t ^. TicketNumber
|
||||||
|
, s
|
||||||
|
, t ^. TicketCreated
|
||||||
|
, t ^. TicketTitle
|
||||||
|
, t ^. TicketDone
|
||||||
|
, d ^. DiscussionNextMessage -. val 1
|
||||||
|
)
|
||||||
|
|
||||||
|
-- | Get the child-parent ticket number pairs of all the ticket dependencies
|
||||||
|
-- in the given project, in ascending order by child, and then ascending order
|
||||||
|
-- by parent.
|
||||||
|
getTicketDepEdges :: ProjectId -> AppDB [(Int, Int)]
|
||||||
|
getTicketDepEdges jid =
|
||||||
|
fmap (map $ unValue *** unValue) $
|
||||||
|
select $ from $ \ (t1 `InnerJoin` td `InnerJoin` t2) -> do
|
||||||
|
on $ t2 ^. TicketId ==. td ^. TicketDependencyParent
|
||||||
|
on $ t1 ^. TicketId ==. td ^. TicketDependencyChild
|
||||||
|
where_ $
|
||||||
|
t1 ^. TicketProject ==. val jid &&.
|
||||||
|
t2 ^. TicketProject ==. val jid
|
||||||
|
orderBy [asc $ t1 ^. TicketNumber, asc $ t2 ^. TicketNumber]
|
||||||
|
return (t1 ^. TicketNumber, t2 ^. TicketNumber)
|
|
@ -15,6 +15,9 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
<p>
|
<p>
|
||||||
<a href=@{TicketNewR shar proj}>Create new…
|
<a href=@{TicketNewR shar proj}>Create new…
|
||||||
|
|
||||||
|
<p>
|
||||||
|
<a href=@{TicketTreeR shar proj}>View as tree…
|
||||||
|
|
||||||
<form method=GET action=@{TicketsR shar proj} enctype=#{filtEnctype}>
|
<form method=GET action=@{TicketsR shar proj} enctype=#{filtEnctype}>
|
||||||
^{filtWidget}
|
^{filtWidget}
|
||||||
<input type="submit" value="Filter">
|
<input type="submit" value="Filter">
|
||||||
|
|
|
@ -156,6 +156,7 @@ library
|
||||||
Vervis.SourceTree
|
Vervis.SourceTree
|
||||||
Vervis.Ssh
|
Vervis.Ssh
|
||||||
Vervis.Style
|
Vervis.Style
|
||||||
|
Vervis.Ticket
|
||||||
Vervis.TicketFilter
|
Vervis.TicketFilter
|
||||||
Vervis.Time
|
Vervis.Time
|
||||||
Vervis.Widget
|
Vervis.Widget
|
||||||
|
|
Loading…
Reference in a new issue