forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Custom ticket field relevance filter by ticket status

Browse source
This commit is contained in:
fr33domlover 2016-08-11 09:27:30 +00:00
parent 21192fef26
commit 5909424644
9 changed files with 136 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
config/models
View file

@ -164,14 +164,17 @@ Workflow
UniqueWorkflow sharer ident UniqueWorkflow sharer ident
WorkflowField WorkflowField
workflow WorkflowId workflow WorkflowId
ident FldIdent ident FldIdent
name Text name Text
desc Text Maybe desc Text Maybe
type WorkflowFieldType type WorkflowFieldType
enm WorkflowFieldEnumId Maybe enm WorkflowFieldEnumId Maybe
required Bool required Bool
constant Bool constant Bool
filterNew Bool
filterTodo Bool
filterClosed Bool
UniqueWorkflowField workflow ident UniqueWorkflowField workflow ident

29
src/Vervis/Form/Ticket.hs
View file

@ -42,6 +42,7 @@ import qualified Data.Text as T (snoc)
import Vervis.Field.Ticket import Vervis.Field.Ticket
import Vervis.Foundation (App, Form, Handler) import Vervis.Foundation (App, Form, Handler)
import Vervis.Model import Vervis.Model
import Vervis.Model.Ticket
import Vervis.Model.Workflow import Vervis.Model.Workflow
import Vervis.Ticket import Vervis.Ticket
import Vervis.TicketFilter (TicketFilter (..)) import Vervis.TicketFilter (TicketFilter (..))
@ -96,14 +97,16 @@ newTicketForm :: WorkflowId -> Form NewTicket
newTicketForm wid html = do newTicketForm wid html = do
(tfs, efs) <- lift $ runDB $ do (tfs, efs) <- lift $ runDB $ do
tfs <- selectList tfs <- selectList
[ WorkflowFieldWorkflow ==. wid [ WorkflowFieldWorkflow ==. wid
, WorkflowFieldType ==. WFTText , WorkflowFieldType ==. WFTText
, WorkflowFieldEnm ==. Nothing , WorkflowFieldEnm ==. Nothing
, WorkflowFieldFilterNew ==. True
] ]
[] []
efs <- selectList efs <- selectList
[ WorkflowFieldWorkflow ==. wid [ WorkflowFieldWorkflow ==. wid
, WorkflowFieldType ==. WFTEnum , WorkflowFieldType ==. WFTEnum
, WorkflowFieldFilterNew ==. True
] ]
[] []
return (tfs, efs) return (tfs, efs)
@ -137,7 +140,7 @@ editTicketContentAForm ticket = Ticket
tEditField tEditField
:: TicketTextParam :: TicketTextParam
-> AForm Handler (Maybe TicketParamTextId, Maybe (WorkflowFieldId, Text)) -> AForm Handler (Maybe TicketParamTextId, Maybe (WorkflowFieldId, Text))
tEditField (TicketTextParam (WorkflowFieldSummary fid _ name req _) mv) = tEditField (TicketTextParam (WorkflowFieldSummary fid _ name req _ _) mv) =
let sets = fieldSettings name req let sets = fieldSettings name req
in (ttpvId <$> mv, ) . fmap (fid, ) <$> in (ttpvId <$> mv, ) . fmap (fid, ) <$>
if req if req
@ -151,7 +154,7 @@ eEditField
( Maybe TicketParamEnumId ( Maybe TicketParamEnumId
, Maybe (WorkflowFieldId, WorkflowFieldEnumCtorId) , Maybe (WorkflowFieldId, WorkflowFieldEnumCtorId)
) )
eEditField (TicketEnumParam (WorkflowFieldSummary fid _ name req _) e mv) = eEditField (TicketEnumParam (WorkflowFieldSummary fid _ name req _ _) e mv) =
let sets = fieldSettings name req let sets = fieldSettings name req
sel = sel =
selectField $ selectField $
@ -164,6 +167,14 @@ eEditField (TicketEnumParam (WorkflowFieldSummary fid _ name req _) e mv) =
then Just <$> areq sel sets (tepvVal <$> mv) then Just <$> areq sel sets (tepvVal <$> mv)
else aopt sel sets (Just . tepvVal <$> mv) else aopt sel sets (Just . tepvVal <$> mv)
editableField :: Ticket -> WorkflowFieldSummary -> Bool
editableField t f =
not (wfsConstant f) &&
case ticketStatus t of
TSNew -> wffNew $ wfsFilter f
TSTodo -> wffTodo $ wfsFilter f
TSClosed -> wffClosed $ wfsFilter f
editTicketContentForm editTicketContentForm
:: TicketId :: TicketId
-> Ticket -> Ticket
@ -183,10 +194,10 @@ editTicketContentForm tid t wid html = do
(tfs, efs) <- (tfs, efs) <-
lift $ runDB $ lift $ runDB $
liftA2 (,) liftA2 (,)
( filter (not . wfsConstant . ttpField) <$> ( filter (editableField t . ttpField) <$>
getTicketTextParams tid wid getTicketTextParams tid wid
) )
( filter (not . wfsConstant . tepField) <$> ( filter (editableField t . tepField) <$>
getTicketEnumParams tid wid getTicketEnumParams tid wid
) )
flip renderDivs html $ flip renderDivs html $

30
src/Vervis/Form/Workflow.hs
View file

@ -52,22 +52,28 @@ newWorkflowForm :: SharerId -> Form NewWorkflow
newWorkflowForm sid = renderDivs $ newWorkflowAForm sid newWorkflowForm sid = renderDivs $ newWorkflowAForm sid
data NewField = NewField data NewField = NewField
{ nfIdent :: FldIdent { nfIdent :: FldIdent
, nfName :: Text , nfName :: Text
, nfDesc :: Maybe Text , nfDesc :: Maybe Text
, nfType :: WorkflowFieldType , nfType :: WorkflowFieldType
, nfReq :: Bool , nfReq :: Bool
, nfConst :: Bool , nfConst :: Bool
, nfNew :: Bool
, nfTodo :: Bool
, nfClosed :: Bool
} }
newFieldAForm :: WorkflowId -> AForm Handler NewField newFieldAForm :: WorkflowId -> AForm Handler NewField
newFieldAForm wid = NewField newFieldAForm wid = NewField
<$> areq (newFieldIdentField wid) "Identifier*" Nothing <$> areq (newFieldIdentField wid) "Identifier*" Nothing
<*> areq textField "Name*" Nothing <*> areq textField "Name*" Nothing
<*> aopt textField "Description" Nothing <*> aopt textField "Description" Nothing
<*> areq (selectField optionsEnum) "Type*" Nothing <*> areq (selectField optionsEnum) "Type*" Nothing
<*> areq checkBoxField "Required*" Nothing <*> areq checkBoxField "Required*" Nothing
<*> areq checkBoxField "Constant*" Nothing <*> areq checkBoxField "Constant*" Nothing
<*> areq checkBoxField "Applies to New*" (Just True)
<*> areq checkBoxField "Applies to Todo*" (Just True)
<*> areq checkBoxField "Applies to Closed*" (Just True)
newFieldForm :: WorkflowId -> Form NewField newFieldForm :: WorkflowId -> Form NewField
newFieldForm wid = renderDivs $ newFieldAForm wid newFieldForm wid = renderDivs $ newFieldAForm wid

12
src/Vervis/Handler/Ticket.hs
View file

@ -56,6 +56,7 @@ import Prelude
import Control.Applicative (liftA2) import Control.Applicative (liftA2)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (logWarn) import Control.Monad.Logger (logWarn)
import Data.Bool (bool)
import Data.Default.Class (def) import Data.Default.Class (def)
import Data.Foldable (traverse_) import Data.Foldable (traverse_)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
@ -70,7 +71,7 @@ import Database.Persist hiding ((==.))
import Text.Blaze.Html (Html, toHtml) import Text.Blaze.Html (Html, toHtml)
import Yesod.Auth (requireAuthId, maybeAuthId) import Yesod.Auth (requireAuthId, maybeAuthId)
import Yesod.Core (defaultLayout) import Yesod.Core (defaultLayout)
import Yesod.Core.Handler (setMessage, redirect, lookupPostParam, notFound) import Yesod.Core.Handler hiding (getMessage)
import Yesod.Form.Functions (runFormGet, runFormPost) import Yesod.Form.Functions (runFormGet, runFormPost)
import Yesod.Form.Types (FormResult (..)) import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404) import Yesod.Persist.Core (runDB, get404, getBy404)
@ -91,6 +92,7 @@ import Vervis.Model.Ticket
import Vervis.Model.Workflow import Vervis.Model.Workflow
import Vervis.Render (renderSourceT) import Vervis.Render (renderSourceT)
import Vervis.Settings (widgetFile) import Vervis.Settings (widgetFile)
import Vervis.Style
import Vervis.Ticket import Vervis.Ticket
import Vervis.TicketFilter (filterTickets) import Vervis.TicketFilter (filterTickets)
import Vervis.Time (showDate) import Vervis.Time (showDate)
@ -249,6 +251,14 @@ getTicketR shar proj num = do
(return $ ticketDiscuss ticket) (return $ ticketDiscuss ticket)
(TicketTopReplyR shar proj num) (TicketTopReplyR shar proj num)
(TicketReplyR shar proj num) (TicketReplyR shar proj num)
cRelevant <- newIdent
cIrrelevant <- newIdent
let relevant filt =
bool cIrrelevant cRelevant $
case ticketStatus ticket of
TSNew -> wffNew filt
TSTodo -> wffTodo filt
TSClosed -> wffClosed filt
defaultLayout $(widgetFile "ticket/one") defaultLayout $(widgetFile "ticket/one")
putTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html putTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html

19
src/Vervis/Handler/Workflow.hs
View file

@ -145,14 +145,17 @@ postWorkflowFieldsR shr wfl = do
case result of case result of
FormSuccess nf -> do FormSuccess nf -> do
let field = WorkflowField let field = WorkflowField
{ workflowFieldWorkflow = wid { workflowFieldWorkflow = wid
, workflowFieldIdent = nfIdent nf , workflowFieldIdent = nfIdent nf
, workflowFieldName = nfName nf , workflowFieldName = nfName nf
, workflowFieldDesc = nfDesc nf , workflowFieldDesc = nfDesc nf
, workflowFieldType = nfType nf , workflowFieldType = nfType nf
, workflowFieldEnm = Nothing , workflowFieldEnm = Nothing
, workflowFieldRequired = nfReq nf , workflowFieldRequired = nfReq nf
, workflowFieldConstant = nfConst nf , workflowFieldConstant = nfConst nf
, workflowFieldFilterNew = nfNew nf
, workflowFieldFilterTodo = nfTodo nf
, workflowFieldFilterClosed = nfClosed nf
} }
runDB $ insert_ field runDB $ insert_ field
setMessage "Workflow field added." setMessage "Workflow field added."

36
src/Vervis/Ticket.hs
View file

@ -16,6 +16,7 @@
module Vervis.Ticket module Vervis.Ticket
( getTicketSummaries ( getTicketSummaries
, getTicketDepEdges , getTicketDepEdges
, WorkflowFieldFilter (..)
, WorkflowFieldSummary (..) , WorkflowFieldSummary (..)
, TicketTextParamValue (..) , TicketTextParamValue (..)
, TicketTextParam (..) , TicketTextParam (..)
@ -81,12 +82,19 @@ getTicketDepEdges jid =
orderBy [asc $ t1 ^. TicketNumber, asc $ t2 ^. TicketNumber] orderBy [asc $ t1 ^. TicketNumber, asc $ t2 ^. TicketNumber]
return (t1 ^. TicketNumber, t2 ^. TicketNumber) return (t1 ^. TicketNumber, t2 ^. TicketNumber)
data WorkflowFieldFilter = WorkflowFieldFilter
{ wffNew :: Bool
, wffTodo :: Bool
, wffClosed :: Bool
}
data WorkflowFieldSummary = WorkflowFieldSummary data WorkflowFieldSummary = WorkflowFieldSummary
{ wfsId :: WorkflowFieldId { wfsId :: WorkflowFieldId
, wfsIdent :: FldIdent , wfsIdent :: FldIdent
, wfsName :: Text , wfsName :: Text
, wfsRequired :: Bool , wfsRequired :: Bool
, wfsConstant :: Bool , wfsConstant :: Bool
, wfsFilter :: WorkflowFieldFilter
} }
data TicketTextParamValue = TicketTextParamValue data TicketTextParamValue = TicketTextParamValue
@ -105,6 +113,9 @@ toTParam
, Value Text , Value Text
, Value Bool , Value Bool
, Value Bool , Value Bool
, Value Bool
, Value Bool
, Value Bool
, Value (Maybe TicketParamTextId) , Value (Maybe TicketParamTextId)
, Value (Maybe Text) , Value (Maybe Text)
) )
@ -115,6 +126,9 @@ toTParam
, Value name , Value name
, Value req , Value req
, Value con , Value con
, Value new
, Value todo
, Value closed
, Value mp , Value mp
, Value mt , Value mt
) = ) =
@ -125,6 +139,11 @@ toTParam
, wfsName = name , wfsName = name
, wfsRequired = req , wfsRequired = req
, wfsConstant = con , wfsConstant = con
, wfsFilter = WorkflowFieldFilter
{ wffNew = new
, wffTodo = todo
, wffClosed = closed
}
} }
, ttpValue = , ttpValue =
case (mp, mt) of case (mp, mt) of
@ -153,6 +172,9 @@ getTicketTextParams tid wid = fmap (map toTParam) $
, f ^. WorkflowFieldName , f ^. WorkflowFieldName
, f ^. WorkflowFieldRequired , f ^. WorkflowFieldRequired
, f ^. WorkflowFieldConstant , f ^. WorkflowFieldConstant
, f ^. WorkflowFieldFilterNew
, f ^. WorkflowFieldFilterTodo
, f ^. WorkflowFieldFilterClosed
, p ?. TicketParamTextId , p ?. TicketParamTextId
, p ?. TicketParamTextValue , p ?. TicketParamTextValue
) )
@ -180,6 +202,9 @@ toEParam
, Value Text , Value Text
, Value Bool , Value Bool
, Value Bool , Value Bool
, Value Bool
, Value Bool
, Value Bool
, Value WorkflowFieldEnumId , Value WorkflowFieldEnumId
, Value EnmIdent , Value EnmIdent
, Value (Maybe TicketParamEnumId) , Value (Maybe TicketParamEnumId)
@ -193,6 +218,9 @@ toEParam
, Value name , Value name
, Value req , Value req
, Value con , Value con
, Value new
, Value todo
, Value closed
, Value i , Value i
, Value e , Value e
, Value mp , Value mp
@ -206,6 +234,11 @@ toEParam
, wfsName = name , wfsName = name
, wfsRequired = req , wfsRequired = req
, wfsConstant = con , wfsConstant = con
, wfsFilter = WorkflowFieldFilter
{ wffNew = new
, wffTodo = todo
, wffClosed = closed
}
} }
, tepEnum = WorkflowEnumSummary , tepEnum = WorkflowEnumSummary
{ wesId = i { wesId = i
@ -243,6 +276,9 @@ getTicketEnumParams tid wid = fmap (map toEParam) $
, f ^. WorkflowFieldName , f ^. WorkflowFieldName
, f ^. WorkflowFieldRequired , f ^. WorkflowFieldRequired
, f ^. WorkflowFieldConstant , f ^. WorkflowFieldConstant
, f ^. WorkflowFieldFilterNew
, f ^. WorkflowFieldFilterTodo
, f ^. WorkflowFieldFilterClosed
, e ^. WorkflowFieldEnumId , e ^. WorkflowFieldEnumId
, e ^. WorkflowFieldEnumIdent , e ^. WorkflowFieldEnumIdent
, p ?. TicketParamEnumId , p ?. TicketParamEnumId

19
templates/ticket/one.cassius Normal file
View file

@ -0,0 +1,19 @@
/* 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/>.
*/
.#{cRelevant}
.#{cIrrelevant}
color: #{light gray}

4
templates/ticket/one.hamlet
View file

@ -112,7 +112,7 @@ $if ticketStatus ticket /= TSClosed
<ul> <ul>
$forall TicketTextParam field mvalue <- tparams $forall TicketTextParam field mvalue <- tparams
<li> <li .#{relevant $ wfsFilter field}>
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}> <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field} #{wfsName field}
: :
@ -124,7 +124,7 @@ $if ticketStatus ticket /= TSClosed
$else $else
(none) (none)
$forall TicketEnumParam field enum mvalue <- eparams $forall TicketEnumParam field enum mvalue <- eparams
<li> <li .#{relevant $ wfsFilter field}>
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}> <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field} #{wfsName field}
: :

8
templates/workflow/field/one.hamlet
View file

@ -32,3 +32,11 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
#{workflowFieldEnumName enum} #{workflowFieldEnumName enum}
<li> <li>
Required: #{workflowFieldRequired f} Required: #{workflowFieldRequired f}
<li>
Constant: #{workflowFieldConstant f}
<li>
Applies to New tickets: #{workflowFieldFilterNew f}
<li>
Applies to Todo tickets: #{workflowFieldFilterTodo f}
<li>
Applies to Closed tickets: #{workflowFieldFilterClosed f}