Eventually-decentralized project hosting and management platform
Clone
HTTPS:
darcs clone https://vervis.peers.community/repos/WvWbo
SSH:
darcs clone USERNAME@vervis.peers.community:WvWbo
Tags
TODO
Ticket.hs
{- This file is part of Vervis.
-
- Written in 2016, 2020, 2022 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 Control.Arrow ((***))
import Data.Bifunctor
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 $
\ (topic `InnerJoin` recip `InnerJoin` person `InnerJoin` sharer) -> do
on $ person ^. PersonIdent ==. sharer ^. SharerId
on $ recip ^. CollabRecipLocalPerson ==. person ^. PersonId
on $ topic ^. CollabTopicLocalProjectCollab ==. recip ^. CollabRecipLocalCollab
where_ $
topic ^. CollabTopicLocalProjectProject ==. 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 $ do
ts <- runDB $ select $ from $ \ (t `InnerJoin` tcl `InnerJoin` tpl) -> do
on $ tcl ^. TicketContextLocalId ==. tpl ^. TicketProjectLocalContext
on $ t ^. TicketId ==. tcl ^. TicketContextLocalTicket
where_ $
tpl ^. TicketProjectLocalProject ==. val jid &&.
t ^. TicketId !=. val tid
orderBy [asc $ t ^. TicketId]
return (t ^. TicketTitle, t ^. TicketId)
optionsPairs $ map (bimap unValue unValue) ts
-}
|