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 . + - Written in 2016, 2019, 2020 by fr33domlover . - - ♡ 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 . + - Written in 2018, 2019, 2020 by fr33domlover . - - ♡ 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 . + - Written in 2016, 2020 by fr33domlover . - - ♡ 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 . + - Written in 2016, 2018, 2019, 2020 by fr33domlover . - - ♡ 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 . +$# Written in 2016, 2018, 2019, 2020 by fr33domlover . $# $# ♡ 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 +
  • + + #{wfsName field} + : + $maybe _tpcid <- mvalue + Yes + $nothing + No

    ^{buttonW DELETE "Delete this ticket" (TicketR shar proj num)}