diff --git a/config/routes b/config/routes index 72d1949..6617559 100644 --- a/config/routes +++ b/config/routes @@ -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 diff --git a/src/Vervis/Field/Ticket.hs b/src/Vervis/Field/Ticket.hs new file mode 100644 index 0000000..b3eb75f --- /dev/null +++ b/src/Vervis/Field/Ticket.hs @@ -0,0 +1,46 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ 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 + - . + -} + +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 diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs index 62abad8..a63189a 100644 --- a/src/Vervis/Form/Ticket.hs +++ b/src/Vervis/Form/Ticket.hs @@ -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) diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 2128ed2..f1e3339 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -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 ) diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index b74b9bb..8249b43 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -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 diff --git a/src/Vervis/Model/Role.hs b/src/Vervis/Model/Role.hs index 0c1da37..6de11ab 100644 --- a/src/Vervis/Model/Role.hs +++ b/src/Vervis/Model/Role.hs @@ -30,6 +30,8 @@ derivePersistField "RepoOperation" data ProjectOperation = ProjOpClaimTicket | ProjOpUnclaimTicket + | ProjOpAssignTicket + | ProjOpUnassignTicket deriving (Eq, Show, Read, Enum, Bounded) derivePersistField "ProjectOperation" diff --git a/templates/ticket/assign.hamlet b/templates/ticket/assign.hamlet new file mode 100644 index 0000000..9312938 --- /dev/null +++ b/templates/ticket/assign.hamlet @@ -0,0 +1,17 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 by fr33domlover . +$# +$# ♡ 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 +$# . + +
+ ^{widget} + diff --git a/templates/ticket/edit.hamlet b/templates/ticket/edit.hamlet index 6ba643a..9501ca0 100644 --- a/templates/ticket/edit.hamlet +++ b/templates/ticket/edit.hamlet @@ -12,8 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -Enter the details and click "Submit" to update the ticket. - ^{widget} diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet index 4a341c9..80bbb7b 100644 --- a/templates/ticket/one.hamlet +++ b/templates/ticket/one.hamlet @@ -33,12 +33,20 @@ $if not $ ticketDone ticket $else Assigned to ^{personLinkW assignee}. + + + $nothing Not assigned. + or + + Assign to someone else + . +

Status: # $if ticketDone ticket diff --git a/vervis.cabal b/vervis.cabal index 6ce0d16..9312f9e 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -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