vervis/src/Vervis/Ticket.hs

{- This file is part of Vervis.
 -
 - Written in 2016, 2018, 2019 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.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
            )