{- This file is part of Vervis. - - Written in 2016, 2018, 2019 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.Ticket ( getTicketSummaries , getTicketDepEdges , WorkflowFieldFilter (..) , WorkflowFieldSummary (..) , TicketTextParamValue (..) , TicketTextParam (..) , getTicketTextParams , WorkflowEnumSummary (..) , TicketEnumParamValue (..) , TicketEnumParam (..) , getTicketEnumParams ) where import Prelude import Control.Arrow ((***)) import Data.Foldable (for_) import Data.Text (Text) import Database.Esqueleto import Vervis.Foundation (AppDB) import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Workflow import Vervis.Widget.Ticket (TicketSummary (..)) -- | Get summaries of all the tickets in the given project. getTicketSummaries :: Maybe (SqlExpr (Entity Ticket) -> SqlExpr (Value Bool)) -> Maybe (SqlExpr (Entity Ticket) -> [SqlExpr OrderBy]) -> ProjectId -> AppDB [TicketSummary] getTicketSummaries mfilt morder jid = do let toSummary (Value n, Entity _ s, Value c, Value t, Value d, Value r) = TicketSummary { tsNumber = n , tsCreatedBy = s , tsCreatedAt = c , tsTitle = t , tsStatus = d , tsComments = r } fmap (map toSummary) $ select $ from $ \ (t `InnerJoin` p `InnerJoin` s `InnerJoin` d `LeftOuterJoin` m) -> do on $ just (d ^. DiscussionId) ==. m ?. MessageRoot on $ t ^. TicketDiscuss ==. d ^. DiscussionId on $ p ^. PersonIdent ==. s ^. SharerId on $ t ^. TicketCreator ==. p ^. PersonId where_ $ t ^. TicketProject ==. val jid groupBy (t ^. TicketId, s ^. SharerId) for_ mfilt $ \ filt -> where_ $ filt t for_ morder $ \ order -> orderBy $ order t return ( t ^. TicketNumber , s , t ^. TicketCreated , t ^. TicketTitle , t ^. TicketStatus , count $ m ?. MessageId ) -- | Get the child-parent ticket number pairs of all the ticket dependencies -- in the given project, in ascending order by child, and then ascending order -- by parent. getTicketDepEdges :: ProjectId -> AppDB [(Int, Int)] getTicketDepEdges jid = fmap (map $ unValue *** unValue) $ select $ from $ \ (t1 `InnerJoin` td `InnerJoin` t2) -> do on $ t2 ^. TicketId ==. td ^. TicketDependencyParent on $ t1 ^. TicketId ==. td ^. TicketDependencyChild where_ $ t1 ^. TicketProject ==. val jid &&. t2 ^. TicketProject ==. val jid orderBy [asc $ t1 ^. TicketNumber, asc $ t2 ^. TicketNumber] return (t1 ^. TicketNumber, t2 ^. TicketNumber) data WorkflowFieldFilter = WorkflowFieldFilter { wffNew :: Bool , wffTodo :: Bool , wffClosed :: Bool } data WorkflowFieldSummary = WorkflowFieldSummary { wfsId :: WorkflowFieldId , wfsIdent :: FldIdent , wfsName :: Text , wfsRequired :: Bool , wfsConstant :: Bool , wfsFilter :: WorkflowFieldFilter } data TicketTextParamValue = TicketTextParamValue { ttpvId :: TicketParamTextId , ttpvVal :: Text } data TicketTextParam = TicketTextParam { ttpField :: WorkflowFieldSummary , ttpValue :: Maybe TicketTextParamValue } toTParam :: ( Value WorkflowFieldId , Value FldIdent , Value Text , Value Bool , Value Bool , Value Bool , Value Bool , Value Bool , Value (Maybe TicketParamTextId) , Value (Maybe Text) ) -> TicketTextParam toTParam ( Value fid , Value fld , Value name , Value req , Value con , Value new , Value todo , Value closed , Value mp , Value mt ) = TicketTextParam { ttpField = WorkflowFieldSummary { wfsId = fid , wfsIdent = fld , wfsName = name , wfsRequired = req , wfsConstant = con , wfsFilter = WorkflowFieldFilter { wffNew = new , wffTodo = todo , wffClosed = closed } } , ttpValue = case (mp, mt) of (Just p, Just t) -> Just TicketTextParamValue { ttpvId = p , ttpvVal = t } (Nothing, Nothing) -> Nothing _ -> error "Impossible" } getTicketTextParams :: TicketId -> WorkflowId -> AppDB [TicketTextParam] getTicketTextParams tid wid = fmap (map toTParam) $ select $ from $ \ (p `RightOuterJoin` f) -> do on $ p ?. TicketParamTextField ==. just (f ^. WorkflowFieldId) &&. p ?. TicketParamTextTicket ==. just (val tid) where_ $ f ^. WorkflowFieldWorkflow ==. val wid &&. f ^. WorkflowFieldType ==. val WFTText &&. isNothing (f ^. WorkflowFieldEnm) return ( f ^. WorkflowFieldId , f ^. WorkflowFieldIdent , f ^. WorkflowFieldName , f ^. WorkflowFieldRequired , f ^. WorkflowFieldConstant , f ^. WorkflowFieldFilterNew , f ^. WorkflowFieldFilterTodo , f ^. WorkflowFieldFilterClosed , p ?. TicketParamTextId , p ?. TicketParamTextValue ) data WorkflowEnumSummary = WorkflowEnumSummary { wesId :: WorkflowFieldEnumId , wesIdent :: EnmIdent } data TicketEnumParamValue = TicketEnumParamValue { tepvId :: TicketParamEnumId , tepvVal :: WorkflowFieldEnumCtorId , tepvName :: Text } data TicketEnumParam = TicketEnumParam { tepField :: WorkflowFieldSummary , tepEnum :: WorkflowEnumSummary , tepValue :: Maybe TicketEnumParamValue } toEParam :: ( Value WorkflowFieldId , Value FldIdent , Value Text , Value Bool , Value Bool , Value Bool , Value Bool , Value Bool , Value WorkflowFieldEnumId , Value EnmIdent , Value (Maybe TicketParamEnumId) , Value (Maybe WorkflowFieldEnumCtorId) , Value (Maybe Text) ) -> TicketEnumParam toEParam ( Value fid , Value fld , Value name , Value req , Value con , Value new , Value todo , Value closed , Value i , Value e , Value mp , Value mc , Value mt ) = TicketEnumParam { tepField = WorkflowFieldSummary { wfsId = fid , wfsIdent = fld , wfsName = name , wfsRequired = req , wfsConstant = con , wfsFilter = WorkflowFieldFilter { wffNew = new , wffTodo = todo , wffClosed = closed } } , tepEnum = WorkflowEnumSummary { wesId = i , wesIdent = e } , tepValue = case (mp, mc, mt) of (Just p, Just c, Just t) -> Just TicketEnumParamValue { tepvId = p , tepvVal = c , tepvName = t } (Nothing, Nothing, Nothing) -> Nothing _ -> error "Impossible" } getTicketEnumParams :: TicketId -> WorkflowId -> AppDB [TicketEnumParam] getTicketEnumParams tid wid = fmap (map toEParam) $ select $ from $ \ (p `InnerJoin` c `RightOuterJoin` f `InnerJoin` e) -> do on $ e ^. WorkflowFieldEnumWorkflow ==. val wid &&. f ^. WorkflowFieldEnm ==. just (e ^. WorkflowFieldEnumId) on $ f ^. WorkflowFieldWorkflow ==. val wid &&. f ^. WorkflowFieldType ==. val WFTEnum &&. p ?. TicketParamEnumField ==. just (f ^. WorkflowFieldId) &&. c ?. WorkflowFieldEnumCtorEnum ==. f ^. WorkflowFieldEnm on $ p ?. TicketParamEnumTicket ==. just (val tid) &&. p ?. TicketParamEnumValue ==. c ?. WorkflowFieldEnumCtorId return ( f ^. WorkflowFieldId , f ^. WorkflowFieldIdent , f ^. WorkflowFieldName , f ^. WorkflowFieldRequired , f ^. WorkflowFieldConstant , f ^. WorkflowFieldFilterNew , f ^. WorkflowFieldFilterTodo , f ^. WorkflowFieldFilterClosed , e ^. WorkflowFieldEnumId , e ^. WorkflowFieldEnumIdent , p ?. TicketParamEnumId , c ?. WorkflowFieldEnumCtorId , c ?. WorkflowFieldEnumCtorName )