forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Ticket un/assign (like un/claim but for other people)

Browse source
This commit is contained in:
fr33domlover 2016-06-07 07:33:19 +00:00
parent eb6fa307b3
commit ae83a5f3ad
10 changed files with 173 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
config/routes
View file

@ -98,6 +98,8 @@
/s/#ShrIdent/p/#PrjIdent/t/#Int/open TicketOpenR POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/claim TicketClaimR POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/unclaim TicketUnclaimR POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/assign TicketAssignR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/unassign TicketUnassignR POST
/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

46
src/Vervis/Field/Ticket.hs Normal file
View file

@ -0,0 +1,46 @@
{- 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.Field.Ticket
( selectAssigneeFromProject
)
where
import Prelude
import Control.Arrow ((***))
import Database.Esqueleto
import Yesod.Form.Fields (selectField, optionsPairs)
import Yesod.Form.Types (Field)
import Yesod.Persist.Core (runDB)
import Vervis.Foundation (Handler)
import Vervis.Model
import Vervis.Model.Ident (shr2text)
-- | Select an assignee for a ticket, from the list of collaborators of
-- the project it belongs to. It can be any collaborator of the project, except
-- for the person doing the assignment.
selectAssigneeFromProject :: PersonId -> ProjectId -> Field Handler PersonId
selectAssigneeFromProject pid jid = selectField $ do
l <- runDB $ select $ from $
\ (pcollab `InnerJoin` person `InnerJoin` sharer) -> do
on $ person ^. PersonIdent ==. sharer ^. SharerId
on $ pcollab ^. ProjectCollabPerson ==. person ^. PersonId
where_ $
pcollab ^. ProjectCollabProject ==. val jid &&.
person ^. PersonId !=. val pid
return (sharer ^. SharerIdent, person ^. PersonId)
optionsPairs $ map (shr2text . unValue *** unValue) l

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

@ -17,6 +17,7 @@ module Vervis.Form.Ticket
( NewTicket (..)
, newTicketForm
, editTicketContentForm
, assignTicketForm
, ticketFilterForm
)
where
@ -30,6 +31,7 @@ import Data.Time.Calendar (Day (..))
import Data.Time.Clock (getCurrentTime, UTCTime (..))
import Yesod.Form
import Vervis.Field.Ticket
import Vervis.Foundation (Form, Handler)
import Vervis.Model
import Vervis.TicketFilter (TicketFilter (..))
@ -79,6 +81,13 @@ editTicketContentAForm ticket = Ticket
editTicketContentForm :: Ticket -> Form Ticket
editTicketContentForm t = renderDivs $ editTicketContentAForm t
assignTicketAForm :: PersonId -> ProjectId -> AForm Handler PersonId
assignTicketAForm pid jid =
areq (selectAssigneeFromProject pid jid) "Assignee*" Nothing
assignTicketForm :: PersonId -> ProjectId -> Form PersonId
assignTicketForm pid jid = renderDivs $ assignTicketAForm pid jid
ticketFilterAForm :: AForm Handler TicketFilter
ticketFilterAForm = TicketFilter
<$> areq (selectFieldList status) "Status*" (Just Nothing)

9
src/Vervis/Foundation.hs
View file

@ -166,12 +166,17 @@ instance Yesod App where
(TicketOpenR user _ _ , _ ) -> person user
(TicketClaimR s j _ , _ ) -> projOp ProjOpClaimTicket s j
(TicketUnclaimR s j _ , _ ) -> projOp ProjOpUnclaimTicket s j
(TicketAssignR s j _ , _ ) -> projOp ProjOpAssignTicket s j
(TicketUnassignR s j _ , _ ) -> projOp ProjOpUnassignTicket s j
(TicketDiscussionR _ _ _ , True) -> personAny
(TicketMessageR _ _ _ _ , True) -> personAny
(TicketTopReplyR _ _ _ , _ ) -> personAny
(TicketReplyR _ _ _ _ , _ ) -> personAny
_ -> return Authorized
where
nobody :: Handler AuthResult
nobody = return $ Unauthorized "This operation is currently disabled"
personAnd
:: (Entity Person -> Handler AuthResult) -> Handler AuthResult
personAnd f = do
@ -439,6 +444,10 @@ instance YesodBreadcrumbs App where
TicketOpenR _shar _proj _num -> ("", Nothing)
TicketClaimR _shar _proj _num -> ("", Nothing)
TicketUnclaimR _shar _proj _num -> ("", Nothing)
TicketAssignR shr prj num -> ( "Assign"
, Just $ TicketR shr prj num
)
TicketUnassignR _shr _prj _num -> ("", Nothing)
TicketDiscussionR shar proj num -> ( "Discussion"
, Just $ TicketR shar proj num
)

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

@ -26,6 +26,9 @@ module Vervis.Handler.Ticket
, postTicketOpenR
, postTicketClaimR
, postTicketUnclaimR
, getTicketAssignR
, postTicketAssignR
, postTicketUnassignR
, getTicketDiscussionR
, postTicketDiscussionR
, getTicketMessageR
@ -41,6 +44,7 @@ import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (logWarn)
import Data.Default.Class (def)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Time.Calendar (Day (..))
import Data.Time.Clock (UTCTime (..), getCurrentTime)
@ -306,6 +310,81 @@ postTicketUnclaimR shr prj num = do
setMessage $ fromMaybe "The ticket is now unassigned." mmsg
redirect $ TicketR shr prj num
getTicketAssignR :: ShrIdent -> PrjIdent -> Int -> Handler Html
getTicketAssignR shr prj num = do
vpid <- requireAuthId
(jid, Entity tid ticket) <- runDB $ do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity j _ <- getBy404 $ UniqueProject prj s
et <- getBy404 $ UniqueTicket j num
return (j, et)
let msg t = do
setMessage t
redirect $ TicketR shr prj num
case (ticketDone ticket, ticketAssignee ticket) of
(True, _) -> msg "The ticket is closed. Can’t assign closed tickets."
(False, Just _) -> msg "The ticket is already assigned to someone."
(False, Nothing) -> do
((_result, widget), enctype) <-
runFormPost $ assignTicketForm vpid jid
defaultLayout $(widgetFile "ticket/assign")
postTicketAssignR :: ShrIdent -> PrjIdent -> Int -> Handler Html
postTicketAssignR shr prj num = do
vpid <- requireAuthId
(jid, Entity tid ticket) <- runDB $ do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity j _ <- getBy404 $ UniqueProject prj s
et <- getBy404 $ UniqueTicket j num
return (j, et)
let msg t = do
setMessage t
redirect $ TicketR shr prj num
case (ticketDone ticket, ticketAssignee ticket) of
(True, _) -> msg "The ticket is closed. Can’t assign closed tickets."
(False, Just _) -> msg "The ticket is already assigned to someone."
(False, Nothing) -> do
((result, widget), enctype) <-
runFormPost $ assignTicketForm vpid jid
case result of
FormSuccess pid -> do
sharer <- runDB $ do
update tid [TicketAssignee =. Just pid]
person <- getJust pid
getJust $ personIdent person
let si = sharerIdent sharer
msg $ toHtml $
"The ticket is now assigned to " <> shr2text si <> "."
FormMissing -> do
setMessage "Field(s) missing."
defaultLayout $(widgetFile "ticket/assign")
FormFailure _l -> do
setMessage "Ticket assignment failed, see errors below."
defaultLayout $(widgetFile "ticket/assign")
postTicketUnassignR :: ShrIdent -> PrjIdent -> Int -> Handler Html
postTicketUnassignR shr prj num = do
pid <- requireAuthId
mmsg <- runDB $ do
Entity tid ticket <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniqueProject prj s
getBy404 $ UniqueTicket p num
case ((== pid) <$> ticketAssignee ticket, ticketDone ticket) of
(Nothing, _) ->
return $ Just "The ticket is already unassigned."
(Just True, _) ->
return $ Just "The ticket is assigned to you, unclaim instead."
(Just False, True) -> do
$logWarn "Found a closed claimed ticket, this is invalid"
return $
Just "The ticket is closed. Can’t unclaim closed tickets."
(Just False, False) -> do
update tid [TicketAssignee =. Nothing]
return Nothing
setMessage $ fromMaybe "The ticket is now unassigned." mmsg
redirect $ TicketR shr prj num
selectDiscussionId :: ShrIdent -> PrjIdent -> Int -> AppDB DiscussionId
selectDiscussionId shar proj tnum = do
Entity sid _sharer <- getBy404 $ UniqueSharer shar

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

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

17
templates/ticket/assign.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=@{TicketAssignR shr prj num} enctype=#{enctype}>
^{widget}
<input type=submit>

2
templates/ticket/edit.hamlet
View file

@ -12,8 +12,6 @@ $# 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/>.
Enter the details and click "Submit" to update the ticket.
<form method=POST action=@{TicketR shar proj num} enctype=#{enctype}>
<input type=hidden name=_method value=PUT>
^{widget}

8
templates/ticket/one.hamlet
View file

@ -33,12 +33,20 @@ $if not $ ticketDone ticket
<input type=submit value="Unclaim this ticket">
$else
Assigned to ^{personLinkW assignee}.
<form method=POST action=@{TicketUnassignR shar proj num}>
<input type=submit value="Unassign this ticket">
$nothing
Not assigned.
<form method=POST action=@{TicketClaimR shar proj num}>
<input type=submit value="Claim this ticket">
or
<a href=@{TicketAssignR shar proj num}>Assign to someone else
.
<p>
Status: #
$if ticketDone ticket

1
vervis.cabal
View file

@ -87,6 +87,7 @@ library
Vervis.Field.Repo
Vervis.Field.Role
Vervis.Field.Sharer
Vervis.Field.Ticket
Vervis.Form.Discussion
Vervis.Form.Group
Vervis.Form.Key