sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 16:34:52 +09:00
Code Issues Activity

Ticket claim request submission

Browse source
This commit is contained in:
fr33domlover 2016-06-08 01:28:18 +00:00
parent 5557e65f66
commit 55945e30f9
7 changed files with 75 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
config/routes
View file

@ -103,7 +103,8 @@
/s/#ShrIdent/p/#PrjIdent/t/#Int/assign TicketAssignR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/unassign TicketUnassignR POST
/s/#ShrIdent/p/#PrjIdent/tcr ClaimRequestsProjectR GET
/s/#ShrIdent/p/#PrjIdent/t/#Int/cr ClaimRequestsTicketR GET
/s/#ShrIdent/p/#PrjIdent/t/#Int/cr ClaimRequestsTicketR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/cr/new ClaimRequestNewR GET
/s/#ShrIdent/p/#PrjIdent/t/#Int/d TicketDiscussionR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/d/#Int TicketMessageR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/d/!reply TicketTopReplyR GET

7
src/Vervis/Form/Ticket.hs
View file

@ -18,6 +18,7 @@ module Vervis.Form.Ticket
, newTicketForm
, editTicketContentForm
, assignTicketForm
, claimRequestForm
, ticketFilterForm
)
where
@ -88,6 +89,12 @@ assignTicketAForm pid jid =
assignTicketForm :: PersonId -> ProjectId -> Form PersonId
assignTicketForm pid jid = renderDivs $ assignTicketAForm pid jid
claimRequestAForm :: AForm Handler Text
claimRequestAForm = unTextarea <$> areq textareaField "Message*" Nothing
claimRequestForm :: Form Text
claimRequestForm = renderDivs claimRequestAForm
ticketFilterAForm :: AForm Handler TicketFilter
ticketFilterAForm = TicketFilter
<$> areq (selectFieldList status) "Status*" (Just Nothing)

7
src/Vervis/Foundation.hs
View file

@ -170,6 +170,9 @@ instance Yesod App where
(TicketUnclaimR s j _ , _ ) -> projOp ProjOpUnclaimTicket s j
(TicketAssignR s j _ , _ ) -> projOp ProjOpAssignTicket s j
(TicketUnassignR s j _ , _ ) -> projOp ProjOpUnassignTicket s j
(ClaimRequestsTicketR s j _, True) -> projOp ProjOpRequestTicket s j
(ClaimRequestNewR s j _ , _ ) -> projOp ProjOpRequestTicket s j
(TicketUnassignR s j _ , _ ) -> projOp ProjOpUnassignTicket s j
(TicketDiscussionR _ _ _ , True) -> personAny
(TicketMessageR _ _ _ _ , True) -> personAny
(TicketTopReplyR _ _ _ , _ ) -> personAny
@ -460,6 +463,10 @@ instance YesodBreadcrumbs App where
ClaimRequestsTicketR shr prj num -> ( "Ticket Claim Requests"
, Just $ TicketR shr prj num
)
ClaimRequestNewR shr prj num -> ( "New"
, Just $
ClaimRequestsTicketR shr prj num
)
TicketDiscussionR shar proj num -> ( "Discussion"
, Just $ TicketR shar proj num
)

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

@ -32,6 +32,8 @@ module Vervis.Handler.Ticket
, getClaimRequestsPersonR
, getClaimRequestsProjectR
, getClaimRequestsTicketR
, postClaimRequestsTicketR
, getClaimRequestNewR
, getTicketDiscussionR
, postTicketDiscussionR
, getTicketMessageR
@ -450,6 +452,40 @@ getClaimRequestsTicketR shr prj num = do
return (sharer, tcr)
defaultLayout $(widgetFile "ticket/claim-request/list")
getClaimRequestNewR :: ShrIdent -> PrjIdent -> Int -> Handler Html
getClaimRequestNewR shr prj num = do
((_result, widget), etype) <- runFormPost claimRequestForm
defaultLayout $(widgetFile "ticket/claim-request/new")
postClaimRequestsTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
postClaimRequestsTicketR shr prj num = do
((result, widget), etype) <- runFormPost claimRequestForm
case result of
FormSuccess msg -> do
now <- liftIO getCurrentTime
pid <- requireAuthId
runDB $ do
tid <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity j _ <- getBy404 $ UniqueProject prj s
Entity t _ <- getBy404 $ UniqueTicket j num
return t
let cr = TicketClaimRequest
{ ticketClaimRequestPerson = pid
, ticketClaimRequestTicket = tid
, ticketClaimRequestMessage = msg
, ticketClaimRequestCreated = now
}
insert_ cr
setMessage "Ticket claim request opened."
redirect $ TicketR shr prj num
FormMissing -> do
setMessage "Field(s) missing."
defaultLayout $(widgetFile "ticket/claim-request/new")
FormFailure _l -> do
setMessage "Submission failed, see errors below."
defaultLayout $(widgetFile "ticket/claim-request/new")
selectDiscussionId :: ShrIdent -> PrjIdent -> Int -> AppDB DiscussionId
selectDiscussionId shar proj tnum = do
Entity sid _sharer <- getBy404 $ UniqueSharer shar

3
src/Vervis/Model/Role.hs
View file

@ -28,7 +28,8 @@ data RepoOperation = RepoOpPush deriving (Eq, Show, Read, Enum, Bounded)
derivePersistField "RepoOperation"
data ProjectOperation
= ProjOpClaimTicket
= ProjOpRequestTicket
| ProjOpClaimTicket
| ProjOpUnclaimTicket
| ProjOpAssignTicket
| ProjOpUnassignTicket

17
templates/ticket/claim-request/new.hamlet Normal file
View file

@ -0,0 +1,17 @@
$# 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/>.
<form method=POST action=@{ClaimRequestsTicketR shr prj num} enctype=#{etype}>
^{widget}
<input type=submit>

4
templates/ticket/one.hamlet
View file

@ -39,6 +39,10 @@ $if not $ ticketDone ticket
$nothing
Not assigned.
<a href=@{ClaimRequestNewR shar proj num}>Ask to have it assigned to you
or
<form method=POST action=@{TicketClaimR shar proj num}>
<input type=submit value="Claim this ticket">