Experimental changes to Vervis.
Clone
HTTPS:
darcs clone https://vervis.peers.community/repos/KrXYo
SSH:
darcs clone USERNAME@vervis.peers.community:KrXYo
Tags
TODO
Ticket.hs
{- 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
, selectTicketDep
)
where
import Prelude
import Control.Arrow ((***))
import Data.Text (Text)
import Database.Esqueleto hiding ((%))
import Formatting
import Yesod.Form.Fields (selectField, optionsPairs, optionsPersistKey)
import Yesod.Form.Functions (checkBool, checkM)
import Yesod.Form.Types (Field)
import Yesod.Persist.Core (runDB)
import qualified Database.Persist as P
import Database.Persist.Sql.Graph.Connects (uconnects)
import Vervis.Foundation (Handler)
import Vervis.GraphProxy (ticketDepGraph)
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
checkNotSelf :: TicketId -> Field Handler TicketId -> Field Handler TicketId
checkNotSelf tidP =
checkBool (/= tidP) ("A ticket can’t depend on itself" :: Text)
checkDep :: TicketId -> Field Handler TicketId -> Field Handler TicketId
checkDep tidP = checkM $ \ tidC -> do
uconn <- runDB $ uconnects tidP tidC Nothing ticketDepGraph
return $ if uconn
then Left ("There is already a dependency between the tickets" :: Text)
else Right tidC
-- | Select a ticket from a project, but exclude the given ticket ID. When
-- processing the form, verify there is no depedndency between the tickets
-- (i.e. neither is reachable from the other).
selectTicketDep :: ProjectId -> TicketId -> Field Handler TicketId
selectTicketDep jid tid =
checkDep tid $
checkNotSelf tid $
selectField $
optionsPersistKey [TicketProject P.==. jid, TicketId P.!=. tid] [] $
\ t -> sformat (int % " :: " % stext) (ticketNumber t) (ticketTitle t)
|