forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Implement ticket class params

Browse source
This commit is contained in:
fr33domlover 2020-01-05 14:33:10 +00:00
parent 8fc5e4b3c1
commit d01bc5bad7
10 changed files with 156 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
config/models
View file

@ -335,6 +335,12 @@ TicketParamEnum
UniqueTicketParamEnum ticket field value
TicketParamClass
ticket TicketId
field WorkflowFieldId
UniqueTicketParamClass ticket field
Ticket
project ProjectId
number Int

5
migrations/2020_01_05.model Normal file
View file

@ -0,0 +1,5 @@
TicketParamClass
ticket TicketId
field WorkflowFieldId
UniqueTicketParamClass ticket field

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

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2016, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
@ -27,7 +27,8 @@ where
import Control.Applicative (liftA2, liftA3)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Data.Maybe (catMaybes, mapMaybe)
import Data.Bool
import Data.Maybe
import Data.Text (Text)
import Data.Time.Calendar (Day (..))
import Data.Time.Clock (getCurrentTime, UTCTime (..))
@ -53,6 +54,7 @@ data NewTicket = NewTicket
, ntDesc :: Text
, ntTParams :: [(WorkflowFieldId, Text)]
, ntEParams :: [(WorkflowFieldId, WorkflowEnumCtorId)]
, ntCParams :: [WorkflowFieldId]
}
fieldSettings :: Text -> Bool -> FieldSettings App
@ -92,9 +94,18 @@ efield (Entity fid f) =
then Just <$> areq sel sets Nothing
else aopt sel sets Nothing
cfield :: Entity WorkflowField -> AForm Handler (Maybe WorkflowFieldId)
cfield (Entity fid f) =
let sets = fieldSettings (workflowFieldName f) (workflowFieldRequired f)
mkval False = Nothing
mkval True = Just fid
in if workflowFieldRequired f
then mkval <$> areq checkBoxField sets Nothing
else mkval . fromMaybe False <$> aopt checkBoxField sets Nothing
newTicketForm :: WorkflowId -> Form NewTicket
newTicketForm wid html = do
(tfs, efs) <- lift $ runDB $ do
(tfs, efs, cfs) <- lift $ runDB $ do
tfs <- selectList
[ WorkflowFieldWorkflow ==. wid
, WorkflowFieldType ==. WFTText
@ -108,7 +119,14 @@ newTicketForm wid html = do
, WorkflowFieldFilterNew ==. True
]
[]
return (tfs, efs)
cfs <- selectList
[ WorkflowFieldWorkflow ==. wid
, WorkflowFieldType ==. WFTClass
, WorkflowFieldEnm ==. Nothing
, WorkflowFieldFilterNew ==. True
]
[]
return (tfs, efs, cfs)
flip renderDivs html $ NewTicket
<$> (sanitizeBalance <$> areq textField "Title*" Nothing)
<*> ( maybe "" (T.filter (/= '\r') . unTextarea) <$>
@ -116,6 +134,7 @@ newTicketForm wid html = do
)
<*> (catMaybes <$> traverse tfield tfs)
<*> (fmap catMaybes $ sequenceA $ mapMaybe efield efs)
<*> (catMaybes <$> traverse cfield cfs)
editTicketContentAForm :: Ticket -> AForm Handler Ticket
editTicketContentAForm ticket = Ticket
@ -172,6 +191,13 @@ eEditField (TicketEnumParam (WorkflowFieldSummary fid _ name req _ _) e mv) =
then Just <$> areq sel sets (tepvVal <$> mv)
else aopt sel sets (Just . tepvVal <$> mv)
cEditField
:: TicketClassParam
-> AForm Handler (Maybe TicketParamClassId, Maybe WorkflowFieldId)
cEditField (TicketClassParam (WorkflowFieldSummary fid _ name req _ _) mv) =
let sets = fieldSettings name req
in (mv,) . bool Nothing (Just fid) <$> areq checkBoxField sets (Just $ isJust mv)
editableField :: Ticket -> WorkflowFieldSummary -> Bool
editableField t f =
not (wfsConstant f) &&
@ -194,22 +220,30 @@ editTicketContentForm
, Maybe (WorkflowFieldId, WorkflowEnumCtorId)
)
]
, [ ( Maybe TicketParamClassId
, Maybe WorkflowFieldId
)
]
)
editTicketContentForm tid t wid html = do
(tfs, efs) <-
(tfs, efs, cfs) <-
lift $ runDB $
liftA2 (,)
liftA3 (,,)
( filter (editableField t . ttpField) <$>
getTicketTextParams tid wid
)
( filter (editableField t . tepField) <$>
getTicketEnumParams tid wid
)
( filter (editableField t . tcpField) <$>
getTicketClasses tid wid
)
flip renderDivs html $
liftA3 (,,)
(editTicketContentAForm t)
(traverse tEditField tfs)
(traverse eEditField efs)
(,,,)
<$> editTicketContentAForm t
<*> traverse tEditField tfs
<*> traverse eEditField efs
<*> traverse cEditField cfs
assignTicketAForm :: PersonId -> ProjectId -> AForm Handler PersonId
assignTicketAForm pid jid =

4
src/Vervis/Handler/Client.hs
View file

@ -667,13 +667,13 @@ postTicketsR shr prj = do
runDB $ sharerIdent <$> getJust (personIdent p)
enum <- runExceptT $ do
NewTicket title desc tparams eparams <-
NewTicket title desc tparams eparams cparams <-
case result of
FormMissing -> throwE "Field(s) missing."
FormFailure _l ->
throwE "Ticket submission failed, see errors below."
FormSuccess nt -> return nt
unless (null tparams && null eparams) $
unless (null tparams && null eparams && null cparams) $
throwE "Custom param support currently disabled"
{-
let mktparam (fid, v) = TicketParamText

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

@ -166,7 +166,8 @@ getTicketR :: ShrIdent -> PrjIdent -> Int -> Handler TypedContent
getTicketR shar proj num = do
mpid <- maybeAuthId
( wshr, wfl,
author, massignee, mcloser, ticket, tparams, eparams, deps, rdeps) <-
author, massignee, mcloser, ticket, tparams, eparams, cparams,
deps, rdeps) <-
runDB $ do
(jid, wshr, wid, wfl) <- do
Entity s sharer <- getBy404 $ UniqueSharer shar
@ -217,6 +218,7 @@ getTicketR shar proj num = do
Nothing -> return Nothing
tparams <- getTicketTextParams tid wid
eparams <- getTicketEnumParams tid wid
cparams <- getTicketClasses tid wid
deps <- E.select $ E.from $ \ (dep `E.InnerJoin` t) -> do
E.on $ dep E.^. TicketDependencyChild E.==. t E.^. TicketId
E.where_ $ dep E.^. TicketDependencyParent E.==. E.val tid
@ -227,7 +229,7 @@ getTicketR shar proj num = do
return t
return
( wshr, wfl
, author, massignee, mcloser, ticket, tparams, eparams
, author, massignee, mcloser, ticket, tparams, eparams, cparams
, deps, rdeps
)
encodeHid <- getEncodeKeyHashid
@ -310,7 +312,7 @@ putTicketR shar proj num = do
((result, widget), enctype) <-
runFormPost $ editTicketContentForm tid ticket wid
case result of
FormSuccess (ticket', tparams, eparams) -> do
FormSuccess (ticket', tparams, eparams, cparams) -> do
newDescHtml <-
case renderPandocMarkdown $ ticketSource ticket' of
Left err -> do
@ -346,6 +348,13 @@ putTicketR shar proj num = do
update aid [TicketParamEnumValue =. v]
)
eupd
let (cdel, cins, _ckeep) = partitionMaybePairs cparams
deleteWhere [TicketParamClassId <-. cdel]
let mkcparam fid = TicketParamClass
{ ticketParamClassTicket = tid
, ticketParamClassField = fid
}
insertMany_ $ map mkcparam cins
setMessage "Ticket updated."
redirect $ TicketR shar proj num
FormMissing -> do

2
src/Vervis/Migration.hs
View file

@ -1224,6 +1224,8 @@ changes hLocal ctx =
, renameUnique "WorkflowEnum" "UniqueWorkflowFieldEnum" "UniqueWorkflowEnum"
-- 183
, renameUnique "WorkflowEnumCtor" "UniqueWorkflowFieldEnumCtor" "UniqueWorkflowEnumCtor"
-- 184
, addEntities model_2020_01_05
]
migrateDB

6
src/Vervis/Migration/Model.hs
View file

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2018, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
@ -138,6 +138,7 @@ module Vervis.Migration.Model
, UnfetchedRemoteActor159
, RemoteCollection159Generic (..)
, RemoteCollection159
, model_2020_01_05
)
where
@ -277,3 +278,6 @@ makeEntitiesMigration "152"
makeEntitiesMigration "159"
$(modelFile "migrations/2019_11_05_remote_actor_ident.model")
model_2020_01_05 :: [Entity SqlBackend]
model_2020_01_05 = $(schema "2020_01_05")

4
src/Vervis/Model/Workflow.hs
View file

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2016, 2020 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
@ -26,7 +26,7 @@ data WorkflowScope = WSSharer | WSPublic | WSFeatured
derivePersistField "WorkflowScope"
data WorkflowFieldType = WFTText | WFTEnum
data WorkflowFieldType = WFTText | WFTEnum | WFTClass
deriving (Eq, Show, Read, Bounded, Enum)
derivePersistField "WorkflowFieldType"

69
src/Vervis/Ticket.hs
View file

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2016, 2018, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
@ -25,6 +25,8 @@ module Vervis.Ticket
, TicketEnumParamValue (..)
, TicketEnumParam (..)
, getTicketEnumParams
, TicketClassParam (..)
, getTicketClasses
)
where
@ -314,3 +316,68 @@ getTicketEnumParams tid wid = fmap (map toEParam) $
, c ?. WorkflowEnumCtorId
, c ?. WorkflowEnumCtorName
)
data TicketClassParam = TicketClassParam
{ tcpField :: WorkflowFieldSummary
, tcpValue :: Maybe TicketParamClassId
}
toCParam
:: ( Value WorkflowFieldId
, Value FldIdent
, Value Text
, Value Bool
, Value Bool
, Value Bool
, Value Bool
, Value Bool
, Value (Maybe TicketParamClassId)
)
-> TicketClassParam
toCParam
( Value fid
, Value fld
, Value name
, Value req
, Value con
, Value new
, Value todo
, Value closed
, Value mp
) = TicketClassParam
{ tcpField = WorkflowFieldSummary
{ wfsId = fid
, wfsIdent = fld
, wfsName = name
, wfsRequired = req
, wfsConstant = con
, wfsFilter = WorkflowFieldFilter
{ wffNew = new
, wffTodo = todo
, wffClosed = closed
}
}
, tcpValue = mp
}
getTicketClasses :: TicketId -> WorkflowId -> AppDB [TicketClassParam]
getTicketClasses tid wid = fmap (map toCParam) $
select $ from $ \ (p `RightOuterJoin` f) -> do
on $
p ?. TicketParamClassField ==. just (f ^. WorkflowFieldId) &&.
p ?. TicketParamClassTicket ==. just (val tid)
where_ $
f ^. WorkflowFieldWorkflow ==. val wid &&.
f ^. WorkflowFieldType ==. val WFTClass &&.
isNothing (f ^. WorkflowFieldEnm)
return
( f ^. WorkflowFieldId
, f ^. WorkflowFieldIdent
, f ^. WorkflowFieldName
, f ^. WorkflowFieldRequired
, f ^. WorkflowFieldConstant
, f ^. WorkflowFieldFilterNew
, f ^. WorkflowFieldFilterTodo
, f ^. WorkflowFieldFilterClosed
, p ?. TicketParamClassId
)

11
templates/ticket/one.hamlet
View file

@ -1,6 +1,6 @@
$# This file is part of Vervis.
$#
$# Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
$# Written in 2016, 2018, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
$#
$# ♡ Copying is an act of love. Please copy, reuse and share.
$#
@ -134,6 +134,15 @@ $if ticketStatus ticket /= TSClosed
NO VALUE FOR REQUIRED FIELD
$else
(none)
$forall TicketClassParam field mvalue <- cparams
<li .#{relevant $ wfsFilter field}>
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field}
:
$maybe _tpcid <- mvalue
Yes
$nothing
No
<p>
^{buttonW DELETE "Delete this ticket" (TicketR shar proj num)}