diff --git a/config/models b/config/models
index 3e5ca2f..58ce8f0 100644
--- a/config/models
+++ b/config/models
@@ -335,6 +335,12 @@ TicketParamEnum
UniqueTicketParamEnum ticket field value
+TicketParamClass
+ ticket TicketId
+ field WorkflowFieldId
+
+ UniqueTicketParamClass ticket field
+
Ticket
project ProjectId
number Int
diff --git a/migrations/2020_01_05.model b/migrations/2020_01_05.model
new file mode 100644
index 0000000..61bea50
--- /dev/null
+++ b/migrations/2020_01_05.model
@@ -0,0 +1,5 @@
+TicketParamClass
+ ticket TicketId
+ field WorkflowFieldId
+
+ UniqueTicketParamClass ticket field
diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs
index 2892d09..47056ba 100644
--- a/src/Vervis/Form/Ticket.hs
+++ b/src/Vervis/Form/Ticket.hs
@@ -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 =
diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs
index ec1f5c4..1797034 100644
--- a/src/Vervis/Handler/Client.hs
+++ b/src/Vervis/Handler/Client.hs
@@ -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
diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs
index cfc5d33..477d6af 100644
--- a/src/Vervis/Handler/Ticket.hs
+++ b/src/Vervis/Handler/Ticket.hs
@@ -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
diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs
index e6a301f..d949eac 100644
--- a/src/Vervis/Migration.hs
+++ b/src/Vervis/Migration.hs
@@ -1224,6 +1224,8 @@ changes hLocal ctx =
, renameUnique "WorkflowEnum" "UniqueWorkflowFieldEnum" "UniqueWorkflowEnum"
-- 183
, renameUnique "WorkflowEnumCtor" "UniqueWorkflowFieldEnumCtor" "UniqueWorkflowEnumCtor"
+ -- 184
+ , addEntities model_2020_01_05
]
migrateDB
diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs
index 75af9e2..828f7ec 100644
--- a/src/Vervis/Migration/Model.hs
+++ b/src/Vervis/Migration/Model.hs
@@ -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")
diff --git a/src/Vervis/Model/Workflow.hs b/src/Vervis/Model/Workflow.hs
index 504df04..47f9845 100644
--- a/src/Vervis/Model/Workflow.hs
+++ b/src/Vervis/Model/Workflow.hs
@@ -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"
diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs
index 0a56fef..50422c4 100644
--- a/src/Vervis/Ticket.hs
+++ b/src/Vervis/Ticket.hs
@@ -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
+ )
diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet
index 83e1617..0d3a57d 100644
--- a/templates/ticket/one.hamlet
+++ b/templates/ticket/one.hamlet
@@ -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)}