naskya/vervis
1
0
Fork 0
mirror of https://code.naskya.net/repos/ndqEd synced 2025-03-20 15:14:54 +09:00
Code 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

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.Foundation (App, Form, Handler)
import Vervis.Model
import Vervis.Model.Ticket
import Vervis.Model.Workflow
import Vervis.Ticket
import Vervis.TicketFilter (TicketFilter (..))
@ -96,14 +97,16 @@ newTicketForm :: WorkflowId -> Form NewTicket
newTicketForm wid html = do
(tfs, efs) <- lift $ runDB $ do
tfs <- selectList
[ WorkflowFieldWorkflow ==. wid
, WorkflowFieldType ==. WFTText
, WorkflowFieldEnm ==. Nothing
[ WorkflowFieldWorkflow ==. wid
, WorkflowFieldType ==. WFTText
, WorkflowFieldEnm ==. Nothing
, WorkflowFieldFilterNew ==. True
]
[]
efs <- selectList
[ WorkflowFieldWorkflow ==. wid
, WorkflowFieldType ==. WFTEnum
[ WorkflowFieldWorkflow ==. wid
, WorkflowFieldType ==. WFTEnum
, WorkflowFieldFilterNew ==. True
]
[]
return (tfs, efs)
@ -137,7 +140,7 @@ editTicketContentAForm ticket = Ticket
tEditField
:: TicketTextParam
-> 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
in (ttpvId <$> mv, ) . fmap (fid, ) <$>
if req
@ -151,7 +154,7 @@ eEditField
( Maybe TicketParamEnumId
, Maybe (WorkflowFieldId, WorkflowFieldEnumCtorId)
)
eEditField (TicketEnumParam (WorkflowFieldSummary fid _ name req _) e mv) =
eEditField (TicketEnumParam (WorkflowFieldSummary fid _ name req _ _) e mv) =
let sets = fieldSettings name req
sel =
selectField $
@ -164,6 +167,14 @@ eEditField (TicketEnumParam (WorkflowFieldSummary fid _ name req _) e mv) =
then Just <$> areq sel sets (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
:: TicketId
-> Ticket
@ -183,10 +194,10 @@ editTicketContentForm tid t wid html = do
(tfs, efs) <-
lift $ runDB $
liftA2 (,)
( filter (not . wfsConstant . ttpField) <$>
( filter (editableField t . ttpField) <$>
getTicketTextParams tid wid
)
( filter (not . wfsConstant . tepField) <$>
( filter (editableField t . tepField) <$>
getTicketEnumParams tid wid
)
flip renderDivs html $

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

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

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

@ -56,6 +56,7 @@ import Prelude
import Control.Applicative (liftA2)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (logWarn)
import Data.Bool (bool)
import Data.Default.Class (def)
import Data.Foldable (traverse_)
import Data.Maybe (fromMaybe)
@ -70,7 +71,7 @@ import Database.Persist hiding ((==.))
import Text.Blaze.Html (Html, toHtml)
import Yesod.Auth (requireAuthId, maybeAuthId)
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.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404)
@ -91,6 +92,7 @@ import Vervis.Model.Ticket
import Vervis.Model.Workflow
import Vervis.Render (renderSourceT)
import Vervis.Settings (widgetFile)
import Vervis.Style
import Vervis.Ticket
import Vervis.TicketFilter (filterTickets)
import Vervis.Time (showDate)
@ -249,6 +251,14 @@ getTicketR shar proj num = do
(return $ ticketDiscuss ticket)
(TicketTopReplyR 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")
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
FormSuccess nf -> do
let field = WorkflowField
{ workflowFieldWorkflow = wid
, workflowFieldIdent = nfIdent nf
, workflowFieldName = nfName nf
, workflowFieldDesc = nfDesc nf
, workflowFieldType = nfType nf
, workflowFieldEnm = Nothing
, workflowFieldRequired = nfReq nf
, workflowFieldConstant = nfConst nf
{ workflowFieldWorkflow = wid
, workflowFieldIdent = nfIdent nf
, workflowFieldName = nfName nf
, workflowFieldDesc = nfDesc nf
, workflowFieldType = nfType nf
, workflowFieldEnm = Nothing
, workflowFieldRequired = nfReq nf
, workflowFieldConstant = nfConst nf
, workflowFieldFilterNew = nfNew nf
, workflowFieldFilterTodo = nfTodo nf
, workflowFieldFilterClosed = nfClosed nf
}
runDB $ insert_ field
setMessage "Workflow field added."

36
src/Vervis/Ticket.hs
View file

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